aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorStefan Monnier <[email protected]>2010-09-13 16:40:48 +0200
committerStefan Monnier <[email protected]>2010-09-13 16:40:48 +0200
commitcc390e46c7ba95b76ea133d98fd386214cd01709 (patch)
treeead4400d22bd07214b782ff7e46e79d473fac419 /lisp
parentc566235d981eba73c88bbff00b6a1d88360b6e9f (diff)
parentc5fe4acb5fb456d6e8e147d8bc7981ce56c5c03d (diff)
Merge from trunk
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog.trunk1545
-rw-r--r--lisp/Makefile.in26
-rw-r--r--lisp/abbrev.el1
-rw-r--r--lisp/abbrevlist.el1
-rw-r--r--lisp/align.el6
-rw-r--r--lisp/ansi-color.el4
-rw-r--r--lisp/apropos.el1
-rw-r--r--lisp/bindings.el1
-rw-r--r--lisp/buff-menu.el1
-rw-r--r--lisp/button.el1
-rw-r--r--lisp/calc/calc-aent.el63
-rw-r--r--lisp/calendar/appt.el1
-rw-r--r--lisp/calendar/cal-bahai.el1
-rw-r--r--lisp/calendar/cal-china.el1
-rw-r--r--lisp/calendar/cal-coptic.el1
-rw-r--r--lisp/calendar/cal-dst.el1
-rw-r--r--lisp/calendar/cal-french.el1
-rw-r--r--lisp/calendar/cal-hebrew.el1
-rw-r--r--lisp/calendar/cal-html.el1
-rw-r--r--lisp/calendar/cal-islam.el1
-rw-r--r--lisp/calendar/cal-iso.el1
-rw-r--r--lisp/calendar/cal-julian.el1
-rw-r--r--lisp/calendar/cal-mayan.el1
-rw-r--r--lisp/calendar/cal-menu.el1
-rw-r--r--lisp/calendar/cal-move.el1
-rw-r--r--lisp/calendar/cal-persia.el1
-rw-r--r--lisp/calendar/cal-tex.el1
-rw-r--r--lisp/calendar/cal-x.el1
-rw-r--r--lisp/calendar/diary-lib.el4
-rw-r--r--lisp/calendar/holidays.el1
-rw-r--r--lisp/calendar/icalendar.el2
-rw-r--r--lisp/calendar/lunar.el1
-rw-r--r--lisp/calendar/parse-time.el1
-rw-r--r--lisp/calendar/solar.el1
-rw-r--r--lisp/calendar/time-date.el1
-rw-r--r--lisp/case-table.el1
-rw-r--r--lisp/cedet/cedet-cscope.el1
-rw-r--r--lisp/cedet/cedet-files.el1
-rw-r--r--lisp/cedet/cedet-global.el1
-rw-r--r--lisp/cedet/cedet-idutils.el1
-rw-r--r--lisp/cedet/cedet.el2
-rw-r--r--lisp/cedet/data-debug.el1
-rw-r--r--lisp/cedet/ede.el1
-rw-r--r--lisp/cedet/semantic.el3
-rw-r--r--lisp/cedet/srecode.el1
-rw-r--r--lisp/comint.el1
-rw-r--r--lisp/composite.el22
-rw-r--r--lisp/cus-dep.el1
-rw-r--r--lisp/cus-edit.el21
-rw-r--r--lisp/cus-face.el1
-rw-r--r--lisp/cus-start.el5
-rw-r--r--lisp/cus-theme.el1
-rw-r--r--lisp/custom.el1
-rw-r--r--lisp/desktop.el2
-rw-r--r--lisp/dired-aux.el1
-rw-r--r--lisp/dired-x.el1
-rw-r--r--lisp/dired.el55
-rw-r--r--lisp/disp-table.el28
-rw-r--r--lisp/dnd.el1
-rw-r--r--lisp/dos-fns.el1
-rw-r--r--lisp/dos-vars.el1
-rw-r--r--lisp/dos-w32.el1
-rw-r--r--lisp/dynamic-setting.el6
-rw-r--r--lisp/electric.el144
-rw-r--r--lisp/emacs-lisp/advice.el1
-rw-r--r--lisp/emacs-lisp/authors.el1
-rw-r--r--lisp/emacs-lisp/autoload.el54
-rw-r--r--lisp/emacs-lisp/backquote.el1
-rw-r--r--lisp/emacs-lisp/byte-opt.el1
-rw-r--r--lisp/emacs-lisp/byte-run.el2
-rw-r--r--lisp/emacs-lisp/bytecomp.el35
-rw-r--r--lisp/emacs-lisp/cl-compat.el10
-rw-r--r--lisp/emacs-lisp/cl-extra.el1
-rw-r--r--lisp/emacs-lisp/cl-indent.el1
-rw-r--r--lisp/emacs-lisp/cl-loaddefs.el21
-rw-r--r--lisp/emacs-lisp/cl-macs.el3
-rw-r--r--lisp/emacs-lisp/cl-seq.el13
-rw-r--r--lisp/emacs-lisp/cl-specs.el1
-rw-r--r--lisp/emacs-lisp/copyright.el22
-rw-r--r--lisp/emacs-lisp/debug.el2
-rw-r--r--lisp/emacs-lisp/derived.el1
-rw-r--r--lisp/emacs-lisp/easy-mmode.el31
-rw-r--r--lisp/emacs-lisp/easymenu.el4
-rw-r--r--lisp/emacs-lisp/eieio-base.el1
-rw-r--r--lisp/emacs-lisp/eieio-comp.el3
-rw-r--r--lisp/emacs-lisp/eieio-custom.el1
-rw-r--r--lisp/emacs-lisp/eieio-datadebug.el1
-rw-r--r--lisp/emacs-lisp/eieio-opt.el1
-rw-r--r--lisp/emacs-lisp/eieio-speedbar.el1
-rw-r--r--lisp/emacs-lisp/eieio.el3
-rw-r--r--lisp/emacs-lisp/float-sup.el1
-rw-r--r--lisp/emacs-lisp/generic.el1
-rw-r--r--lisp/emacs-lisp/helper.el1
-rw-r--r--lisp/emacs-lisp/lisp-mnt.el4
-rw-r--r--lisp/emacs-lisp/lisp-mode.el17
-rw-r--r--lisp/emacs-lisp/lisp.el9
-rw-r--r--lisp/emacs-lisp/macroexp.el139
-rw-r--r--lisp/emacs-lisp/package-x.el1
-rw-r--r--lisp/emacs-lisp/package.el871
-rw-r--r--lisp/emacs-lisp/pcase.el38
-rw-r--r--lisp/emacs-lisp/regexp-opt.el2
-rw-r--r--lisp/emacs-lisp/rx.el7
-rw-r--r--lisp/emacs-lisp/smie.el782
-rw-r--r--lisp/emacs-lisp/syntax.el250
-rw-r--r--lisp/emacs-lisp/tcover-ses.el1
-rw-r--r--lisp/emacs-lisp/tcover-unsafep.el1
-rw-r--r--lisp/emacs-lisp/timer.el4
-rw-r--r--lisp/emulation/cua-gmrk.el1
-rw-r--r--lisp/emulation/cua-rect.el1
-rw-r--r--lisp/emulation/edt-lk201.el1
-rw-r--r--lisp/emulation/edt-mapper.el1
-rw-r--r--lisp/emulation/edt-pc.el1
-rw-r--r--lisp/emulation/edt-vt100.el1
-rw-r--r--lisp/emulation/tpu-edt.el2
-rw-r--r--lisp/emulation/tpu-extras.el1
-rw-r--r--lisp/emulation/tpu-mapper.el1
-rw-r--r--lisp/emulation/viper-cmd.el1
-rw-r--r--lisp/emulation/viper-ex.el1
-rw-r--r--lisp/emulation/viper-init.el1
-rw-r--r--lisp/emulation/viper-keym.el1
-rw-r--r--lisp/emulation/viper-macs.el1
-rw-r--r--lisp/emulation/viper-mous.el1
-rw-r--r--lisp/emulation/viper-util.el1
-rw-r--r--lisp/emulation/viper.el1
-rw-r--r--lisp/env.el1
-rw-r--r--lisp/epa-dired.el1
-rw-r--r--lisp/epa-file.el18
-rw-r--r--lisp/epa-hook.el1
-rw-r--r--lisp/epa-mail.el1
-rw-r--r--lisp/epg-config.el1
-rw-r--r--lisp/epg.el1
-rw-r--r--lisp/erc/ChangeLog7
-rw-r--r--lisp/erc/erc-join.el76
-rw-r--r--lisp/erc/erc.el1
-rw-r--r--lisp/eshell/em-term.el3
-rw-r--r--lisp/facemenu.el106
-rw-r--r--lisp/faces.el4
-rw-r--r--lisp/files-x.el1
-rw-r--r--lisp/files.el107
-rw-r--r--lisp/finder.el290
-rw-r--r--lisp/foldout.el2
-rw-r--r--lisp/font-core.el1
-rw-r--r--lisp/font-lock.el125
-rw-r--r--lisp/format-spec.el1
-rw-r--r--lisp/format.el1
-rw-r--r--lisp/frame.el4
-rw-r--r--lisp/fringe.el1
-rw-r--r--lisp/generic-x.el1
-rw-r--r--lisp/gnus/.dir-locals.el1
-rw-r--r--lisp/gnus/ChangeLog652
-rw-r--r--lisp/gnus/auth-source.el1
-rw-r--r--lisp/gnus/canlock.el1
-rw-r--r--lisp/gnus/compface.el1
-rw-r--r--lisp/gnus/deuglify.el1
-rw-r--r--lisp/gnus/earcon.el1
-rw-r--r--lisp/gnus/ecomplete.el3
-rw-r--r--lisp/gnus/flow-fill.el1
-rw-r--r--lisp/gnus/gmm-utils.el1
-rw-r--r--lisp/gnus/gnus-agent.el48
-rw-r--r--lisp/gnus/gnus-art.el64
-rw-r--r--lisp/gnus/gnus-async.el19
-rw-r--r--lisp/gnus/gnus-audio.el1
-rw-r--r--lisp/gnus/gnus-bcklg.el1
-rw-r--r--lisp/gnus/gnus-bookmark.el1
-rw-r--r--lisp/gnus/gnus-cache.el9
-rw-r--r--lisp/gnus/gnus-cite.el159
-rw-r--r--lisp/gnus/gnus-cus.el1
-rw-r--r--lisp/gnus/gnus-delay.el1
-rw-r--r--lisp/gnus/gnus-demon.el1
-rw-r--r--lisp/gnus/gnus-diary.el1
-rw-r--r--lisp/gnus/gnus-dired.el3
-rw-r--r--lisp/gnus/gnus-draft.el1
-rw-r--r--lisp/gnus/gnus-dup.el1
-rw-r--r--lisp/gnus/gnus-eform.el1
-rw-r--r--lisp/gnus/gnus-ems.el44
-rw-r--r--lisp/gnus/gnus-fun.el1
-rw-r--r--lisp/gnus/gnus-group.el251
-rw-r--r--lisp/gnus/gnus-html.el466
-rw-r--r--lisp/gnus/gnus-int.el6
-rw-r--r--lisp/gnus/gnus-kill.el1
-rw-r--r--lisp/gnus/gnus-logic.el1
-rw-r--r--lisp/gnus/gnus-mh.el1
-rw-r--r--lisp/gnus/gnus-ml.el1
-rw-r--r--lisp/gnus/gnus-mlspl.el1
-rw-r--r--lisp/gnus/gnus-move.el181
-rw-r--r--lisp/gnus/gnus-msg.el1
-rw-r--r--lisp/gnus/gnus-nocem.el1
-rw-r--r--lisp/gnus/gnus-picon.el1
-rw-r--r--lisp/gnus/gnus-range.el7
-rw-r--r--lisp/gnus/gnus-registry.el123
-rw-r--r--lisp/gnus/gnus-salt.el1
-rw-r--r--lisp/gnus/gnus-score.el8
-rw-r--r--lisp/gnus/gnus-setup.el1
-rw-r--r--lisp/gnus/gnus-sieve.el1
-rw-r--r--lisp/gnus/gnus-soup.el611
-rw-r--r--lisp/gnus/gnus-spec.el1
-rw-r--r--lisp/gnus/gnus-srvr.el1
-rw-r--r--lisp/gnus/gnus-start.el255
-rw-r--r--lisp/gnus/gnus-sum.el105
-rw-r--r--lisp/gnus/gnus-sync.el233
-rw-r--r--lisp/gnus/gnus-topic.el1
-rw-r--r--lisp/gnus/gnus-undo.el1
-rw-r--r--lisp/gnus/gnus-util.el17
-rw-r--r--lisp/gnus/gnus-uu.el1
-rw-r--r--lisp/gnus/gnus-vm.el1
-rw-r--r--lisp/gnus/gnus-win.el1
-rw-r--r--lisp/gnus/gnus.el45
-rw-r--r--lisp/gnus/html2text.el2
-rw-r--r--lisp/gnus/ietf-drums.el1
-rw-r--r--lisp/gnus/legacy-gnus-agent.el1
-rw-r--r--lisp/gnus/mail-parse.el1
-rw-r--r--lisp/gnus/mail-prsvr.el1
-rw-r--r--lisp/gnus/mail-source.el32
-rw-r--r--lisp/gnus/mailcap.el3
-rw-r--r--lisp/gnus/message.el51
-rw-r--r--lisp/gnus/messcompat.el1
-rw-r--r--lisp/gnus/mm-bodies.el1
-rw-r--r--lisp/gnus/mm-decode.el10
-rw-r--r--lisp/gnus/mm-encode.el1
-rw-r--r--lisp/gnus/mm-extern.el1
-rw-r--r--lisp/gnus/mm-partial.el1
-rw-r--r--lisp/gnus/mm-url.el26
-rw-r--r--lisp/gnus/mm-util.el32
-rw-r--r--lisp/gnus/mm-uu.el3
-rw-r--r--lisp/gnus/mm-view.el1
-rw-r--r--lisp/gnus/mml-sec.el1
-rw-r--r--lisp/gnus/mml-smime.el1
-rw-r--r--lisp/gnus/mml.el5
-rw-r--r--lisp/gnus/mml1991.el1
-rw-r--r--lisp/gnus/mml2015.el1
-rw-r--r--lisp/gnus/nnagent.el5
-rw-r--r--lisp/gnus/nnbabyl.el5
-rw-r--r--lisp/gnus/nndb.el325
-rw-r--r--lisp/gnus/nndiary.el2
-rw-r--r--lisp/gnus/nndir.el1
-rw-r--r--lisp/gnus/nndoc.el36
-rw-r--r--lisp/gnus/nndraft.el3
-rw-r--r--lisp/gnus/nneething.el1
-rw-r--r--lisp/gnus/nnfolder.el5
-rw-r--r--lisp/gnus/nngateway.el1
-rw-r--r--lisp/gnus/nnheader.el8
-rw-r--r--lisp/gnus/nnimap.el100
-rw-r--r--lisp/gnus/nnir.el11
-rw-r--r--lisp/gnus/nnkiboze.el391
-rw-r--r--lisp/gnus/nnlistserv.el152
-rw-r--r--lisp/gnus/nnmail.el10
-rw-r--r--lisp/gnus/nnmaildir.el1
-rw-r--r--lisp/gnus/nnmairix.el3
-rw-r--r--lisp/gnus/nnmbox.el1
-rw-r--r--lisp/gnus/nnmh.el79
-rw-r--r--lisp/gnus/nnml.el60
-rw-r--r--lisp/gnus/nnnil.el2
-rw-r--r--lisp/gnus/nnoo.el1
-rw-r--r--lisp/gnus/nnrss.el5
-rw-r--r--lisp/gnus/nnslashdot.el505
-rw-r--r--lisp/gnus/nnsoup.el812
-rw-r--r--lisp/gnus/nnspool.el1
-rw-r--r--lisp/gnus/nntp.el34
-rw-r--r--lisp/gnus/nnultimate.el480
-rw-r--r--lisp/gnus/nnvirtual.el23
-rw-r--r--lisp/gnus/nnwarchive.el727
-rw-r--r--lisp/gnus/nnweb.el1
-rw-r--r--lisp/gnus/nnwfm.el432
-rw-r--r--lisp/gnus/pop3.el163
-rw-r--r--lisp/gnus/qp.el1
-rw-r--r--lisp/gnus/rfc1843.el1
-rw-r--r--lisp/gnus/rfc2045.el1
-rw-r--r--lisp/gnus/rfc2047.el1
-rw-r--r--lisp/gnus/rfc2104.el1
-rw-r--r--lisp/gnus/rfc2231.el1
-rw-r--r--lisp/gnus/score-mode.el1
-rw-r--r--lisp/gnus/sieve-manage.el3
-rw-r--r--lisp/gnus/sieve-mode.el1
-rw-r--r--lisp/gnus/sieve.el1
-rw-r--r--lisp/gnus/smiley.el5
-rw-r--r--lisp/gnus/smime.el1
-rw-r--r--lisp/gnus/spam-report.el7
-rw-r--r--lisp/gnus/spam-stat.el1
-rw-r--r--lisp/gnus/spam-wash.el1
-rw-r--r--lisp/gnus/spam.el1
-rw-r--r--lisp/gnus/starttls.el1
-rw-r--r--lisp/gnus/utf7.el1
-rw-r--r--lisp/gnus/webmail.el1
-rw-r--r--lisp/gnus/yenc.el1
-rw-r--r--lisp/help-fns.el1
-rw-r--r--lisp/help-macro.el1
-rw-r--r--lisp/help-mode.el1
-rw-r--r--lisp/help.el2
-rw-r--r--lisp/hex-util.el1
-rw-r--r--lisp/hfy-cmap.el1
-rw-r--r--lisp/htmlfontify.el3
-rw-r--r--lisp/ibuf-ext.el1
-rw-r--r--lisp/ibuf-macs.el1
-rw-r--r--lisp/ibuffer.el2
-rw-r--r--lisp/ido.el67
-rw-r--r--lisp/image-mode.el84
-rw-r--r--lisp/image.el31
-rw-r--r--lisp/indent.el1
-rw-r--r--lisp/info.el83
-rw-r--r--lisp/international/fontset.el2
-rw-r--r--lisp/international/mule-cmds.el6
-rw-r--r--lisp/international/mule.el13
-rw-r--r--lisp/international/uni-bidi.elbin9286 -> 9287 bytes
-rw-r--r--lisp/international/uni-category.elbin12451 -> 12450 bytes
-rw-r--r--lisp/international/uni-combining.elbin8881 -> 8881 bytes
-rw-r--r--lisp/international/uni-decimal.elbin2484 -> 2483 bytes
-rw-r--r--lisp/international/uni-mirrored.elbin7904 -> 7904 bytes
-rw-r--r--lisp/international/uni-name.elbin157275 -> 157287 bytes
-rw-r--r--lisp/isearch.el1
-rw-r--r--lisp/iswitchb.el10
-rw-r--r--lisp/jit-lock.el27
-rw-r--r--lisp/jka-cmpr-hook.el4
-rw-r--r--lisp/language/misc-lang.el18
-rw-r--r--lisp/ldefs-boot.el1
-rw-r--r--lisp/linum.el1
-rw-r--r--lisp/loadup.el1
-rw-r--r--lisp/ls-lisp.el1
-rw-r--r--lisp/macros.el1
-rw-r--r--lisp/mail/binhex.el1
-rw-r--r--lisp/mail/blessmail.el1
-rw-r--r--lisp/mail/emacsbug.el54
-rw-r--r--lisp/mail/hashcash.el4
-rw-r--r--lisp/mail/mail-extr.el1
-rw-r--r--lisp/mail/mail-hist.el1
-rw-r--r--lisp/mail/mailheader.el1
-rw-r--r--lisp/mail/rmail-spam-filter.el1
-rw-r--r--lisp/mail/rmail.el25
-rw-r--r--lisp/mail/rmailedit.el1
-rw-r--r--lisp/mail/rmailkwd.el1
-rw-r--r--lisp/mail/rmailmm.el1
-rw-r--r--lisp/mail/rmailmsc.el1
-rw-r--r--lisp/mail/rmailout.el1
-rw-r--r--lisp/mail/rmailsort.el1
-rw-r--r--lisp/mail/rmailsum.el1
-rw-r--r--lisp/mail/uudecode.el1
-rw-r--r--lisp/makefile.w32-in5
-rw-r--r--lisp/md4.el1
-rw-r--r--lisp/menu-bar.el36
-rw-r--r--lisp/minibuffer.el1
-rw-r--r--lisp/misc.el1
-rw-r--r--lisp/mouse-sel.el12
-rw-r--r--lisp/mouse.el783
-rw-r--r--lisp/mwheel.el1
-rw-r--r--lisp/net/browse-url.el36
-rw-r--r--lisp/net/dbus.el59
-rw-r--r--lisp/net/dig.el1
-rw-r--r--lisp/net/dns.el3
-rw-r--r--lisp/net/eudc-bob.el1
-rw-r--r--lisp/net/eudc-export.el1
-rw-r--r--lisp/net/eudc-hotlist.el1
-rw-r--r--lisp/net/eudc-vars.el1
-rw-r--r--lisp/net/eudcb-bbdb.el1
-rw-r--r--lisp/net/eudcb-ldap.el1
-rw-r--r--lisp/net/eudcb-mab.el1
-rw-r--r--lisp/net/eudcb-ph.el1
-rw-r--r--lisp/net/hmac-def.el1
-rw-r--r--lisp/net/hmac-md5.el1
-rw-r--r--lisp/net/imap.el324
-rw-r--r--lisp/net/netrc.el29
-rw-r--r--lisp/net/newst-backend.el1
-rw-r--r--lisp/net/newst-plainview.el1
-rw-r--r--lisp/net/newst-reader.el1
-rw-r--r--lisp/net/newst-ticker.el1
-rw-r--r--lisp/net/newst-treeview.el1
-rw-r--r--lisp/net/newsticker.el1
-rw-r--r--lisp/net/ntlm.el7
-rw-r--r--lisp/net/rcirc.el161
-rw-r--r--lisp/net/sasl-cram.el2
-rw-r--r--lisp/net/sasl-digest.el6
-rw-r--r--lisp/net/sasl-ntlm.el2
-rw-r--r--lisp/net/sasl.el1
-rw-r--r--lisp/net/tls.el1
-rw-r--r--lisp/net/tramp-cache.el75
-rw-r--r--lisp/net/tramp-cmds.el9
-rw-r--r--lisp/net/tramp-compat.el58
-rw-r--r--lisp/net/tramp-fish.el22
-rw-r--r--lisp/net/tramp-ftp.el27
-rw-r--r--lisp/net/tramp-gvfs.el43
-rw-r--r--lisp/net/tramp-gw.el26
-rw-r--r--lisp/net/tramp-imap.el28
-rw-r--r--lisp/net/tramp-smb.el31
-rw-r--r--lisp/net/tramp-uu.el10
-rw-r--r--lisp/net/tramp.el770
-rw-r--r--lisp/net/trampver.el18
-rw-r--r--lisp/newcomment.el11
-rw-r--r--lisp/notifications.el20
-rw-r--r--lisp/nxml/TODO468
-rw-r--r--lisp/org/ChangeLog30
-rw-r--r--lisp/org/ob-R.el2
-rw-r--r--lisp/org/ob-emacs-lisp.el5
-rw-r--r--lisp/org/ob-sh.el4
-rw-r--r--lisp/org/ob.el17
-rw-r--r--lisp/org/org-docview.el4
-rw-r--r--lisp/org/org-list.el3
-rw-r--r--lisp/org/org-macs.el60
-rw-r--r--lisp/org/org.el56
-rw-r--r--lisp/password-cache.el1
-rw-r--r--lisp/paths.el1
-rw-r--r--lisp/pcmpl-cvs.el1
-rw-r--r--lisp/pcmpl-gnu.el2
-rw-r--r--lisp/pcmpl-linux.el2
-rw-r--r--lisp/pcmpl-rpm.el2
-rw-r--r--lisp/pcmpl-unix.el2
-rw-r--r--lisp/pgg-def.el2
-rw-r--r--lisp/pgg-gpg.el4
-rw-r--r--lisp/pgg-parse.el2
-rw-r--r--lisp/pgg-pgp.el2
-rw-r--r--lisp/pgg-pgp5.el2
-rw-r--r--lisp/pgg.el1
-rw-r--r--lisp/play/cookie1.el2
-rw-r--r--lisp/proced.el2
-rw-r--r--lisp/progmodes/ada-mode.el632
-rw-r--r--lisp/progmodes/ada-prj.el1
-rw-r--r--lisp/progmodes/ada-stmt.el1
-rw-r--r--lisp/progmodes/ada-xref.el1
-rw-r--r--lisp/progmodes/antlr-mode.el2
-rw-r--r--lisp/progmodes/autoconf.el7
-rw-r--r--lisp/progmodes/cc-align.el4
-rw-r--r--lisp/progmodes/cc-awk.el1
-rw-r--r--lisp/progmodes/cc-bytecomp.el4
-rw-r--r--lisp/progmodes/cc-cmds.el4
-rw-r--r--lisp/progmodes/cc-compat.el4
-rw-r--r--lisp/progmodes/cc-defs.el4
-rw-r--r--lisp/progmodes/cc-engine.el15
-rw-r--r--lisp/progmodes/cc-fonts.el4
-rw-r--r--lisp/progmodes/cc-langs.el4
-rw-r--r--lisp/progmodes/cc-menus.el4
-rw-r--r--lisp/progmodes/cc-mode.el24
-rw-r--r--lisp/progmodes/cc-styles.el4
-rw-r--r--lisp/progmodes/cc-vars.el4
-rw-r--r--lisp/progmodes/cfengine.el20
-rw-r--r--lisp/progmodes/compile.el49
-rw-r--r--lisp/progmodes/cperl-mode.el8
-rw-r--r--lisp/progmodes/cwarn.el2
-rw-r--r--lisp/progmodes/ebnf-abn.el1
-rw-r--r--lisp/progmodes/ebnf-bnf.el1
-rw-r--r--lisp/progmodes/ebnf-dtd.el1
-rw-r--r--lisp/progmodes/ebnf-ebx.el1
-rw-r--r--lisp/progmodes/ebnf-iso.el1
-rw-r--r--lisp/progmodes/ebnf-otz.el1
-rw-r--r--lisp/progmodes/ebnf-yac.el1
-rw-r--r--lisp/progmodes/etags.el1
-rw-r--r--lisp/progmodes/flymake.el3
-rw-r--r--lisp/progmodes/fortran.el19
-rw-r--r--lisp/progmodes/gud.el24
-rw-r--r--lisp/progmodes/idlw-complete-structtag.el1
-rw-r--r--lisp/progmodes/idlw-help.el3
-rw-r--r--lisp/progmodes/idlw-shell.el3
-rw-r--r--lisp/progmodes/idlw-toolbar.el3
-rw-r--r--lisp/progmodes/idlwave.el2
-rw-r--r--lisp/progmodes/js.el119
-rw-r--r--lisp/progmodes/make-mode.el45
-rw-r--r--lisp/progmodes/mixal-mode.el23
-rw-r--r--lisp/progmodes/octave-inf.el1
-rw-r--r--lisp/progmodes/octave-mod.el1041
-rw-r--r--lisp/progmodes/perl-mode.el334
-rw-r--r--lisp/progmodes/prolog.el2
-rw-r--r--lisp/progmodes/ps-mode.el2
-rw-r--r--lisp/progmodes/python.el195
-rw-r--r--lisp/progmodes/ruby-mode.el395
-rw-r--r--lisp/progmodes/scheme.el2
-rw-r--r--lisp/progmodes/sh-script.el109
-rw-r--r--lisp/progmodes/simula.el28
-rw-r--r--lisp/progmodes/sql.el740
-rw-r--r--lisp/progmodes/tcl.el13
-rw-r--r--lisp/progmodes/vhdl-mode.el18
-rw-r--r--lisp/ps-bdf.el1
-rw-r--r--lisp/ps-def.el1
-rw-r--r--lisp/ps-mule.el1
-rw-r--r--lisp/ps-print.el2
-rw-r--r--lisp/ps-samp.el1
-rw-r--r--lisp/rect.el1
-rw-r--r--lisp/register.el1
-rw-r--r--lisp/repeat.el2
-rw-r--r--lisp/replace.el1
-rw-r--r--lisp/rfn-eshadow.el1
-rw-r--r--lisp/scroll-bar.el1
-rw-r--r--lisp/select.el30
-rw-r--r--lisp/server.el15
-rw-r--r--lisp/sha1.el1
-rw-r--r--lisp/simple.el302
-rw-r--r--lisp/startup.el25
-rw-r--r--lisp/subr.el80
-rw-r--r--lisp/tabify.el1
-rw-r--r--lisp/term.el3
-rw-r--r--lisp/term/ns-win.el27
-rw-r--r--lisp/term/pc-win.el21
-rw-r--r--lisp/term/x-win.el112
-rw-r--r--lisp/textmodes/bibtex.el6
-rw-r--r--lisp/textmodes/dns-mode.el1
-rw-r--r--lisp/textmodes/fill.el1
-rw-r--r--lisp/textmodes/flyspell.el6
-rw-r--r--lisp/textmodes/ispell.el359
-rw-r--r--lisp/textmodes/nroff-mode.el15
-rw-r--r--lisp/textmodes/page.el8
-rw-r--r--lisp/textmodes/paragraphs.el1
-rw-r--r--lisp/textmodes/reftex-auc.el1
-rw-r--r--lisp/textmodes/reftex-cite.el1
-rw-r--r--lisp/textmodes/reftex-dcr.el1
-rw-r--r--lisp/textmodes/reftex-global.el1
-rw-r--r--lisp/textmodes/reftex-index.el1
-rw-r--r--lisp/textmodes/reftex-parse.el1
-rw-r--r--lisp/textmodes/reftex-ref.el1
-rw-r--r--lisp/textmodes/reftex-sel.el1
-rw-r--r--lisp/textmodes/reftex-toc.el1
-rw-r--r--lisp/textmodes/reftex-vars.el1
-rw-r--r--lisp/textmodes/reftex.el1
-rw-r--r--lisp/textmodes/sgml-mode.el11
-rw-r--r--lisp/textmodes/tex-mode.el16
-rw-r--r--lisp/textmodes/texinfo.el15
-rw-r--r--lisp/textmodes/text-mode.el1
-rw-r--r--lisp/tool-bar.el1
-rw-r--r--lisp/tooltip.el1
-rw-r--r--lisp/tutorial.el1
-rw-r--r--lisp/uniquify.el1
-rw-r--r--lisp/url/ChangeLog5
-rw-r--r--lisp/url/url-cache.el8
-rw-r--r--lisp/url/url-gw.el22
-rw-r--r--lisp/url/url-history.el10
-rw-r--r--lisp/url/url-irc.el9
-rw-r--r--lisp/url/url-util.el2
-rw-r--r--lisp/url/url-vars.el40
-rw-r--r--lisp/vc/add-log.el12
-rw-r--r--lisp/vc/ediff-diff.el1
-rw-r--r--lisp/vc/ediff-help.el1
-rw-r--r--lisp/vc/ediff-hook.el1
-rw-r--r--lisp/vc/ediff-init.el1
-rw-r--r--lisp/vc/ediff-merg.el1
-rw-r--r--lisp/vc/ediff-mult.el1
-rw-r--r--lisp/vc/ediff-ptch.el1
-rw-r--r--lisp/vc/ediff-util.el1
-rw-r--r--lisp/vc/ediff-vers.el1
-rw-r--r--lisp/vc/ediff-wind.el1
-rw-r--r--lisp/vc/ediff.el1
-rw-r--r--lisp/vc/pcvs-defs.el1
-rw-r--r--lisp/vc/pcvs-info.el1
-rw-r--r--lisp/vc/pcvs-parse.el1
-rw-r--r--lisp/vc/pcvs-util.el1
-rw-r--r--lisp/vc/vc-annotate.el1
-rw-r--r--lisp/vc/vc-arch.el1
-rw-r--r--lisp/vc/vc-bzr.el3
-rw-r--r--lisp/vc/vc-cvs.el1
-rw-r--r--lisp/vc/vc-dav.el1
-rw-r--r--lisp/vc/vc-dir.el1
-rw-r--r--lisp/vc/vc-dispatcher.el1
-rw-r--r--lisp/vc/vc-git.el1
-rw-r--r--lisp/vc/vc-hg.el1
-rw-r--r--lisp/vc/vc-hooks.el1
-rw-r--r--lisp/vc/vc-mtn.el1
-rw-r--r--lisp/vc/vc-rcs.el1
-rw-r--r--lisp/vc/vc-sccs.el1
-rw-r--r--lisp/vc/vc-svn.el1
-rw-r--r--lisp/version.el1
-rw-r--r--lisp/w32-fns.el29
-rw-r--r--lisp/w32-vars.el1
-rw-r--r--lisp/whitespace.el358
-rw-r--r--lisp/wid-browse.el1
-rw-r--r--lisp/wid-edit.el1
-rw-r--r--lisp/widget.el1
-rw-r--r--lisp/window.el2
-rw-r--r--lisp/woman.el7
-rw-r--r--lisp/x-dnd.el1
562 files changed, 10851 insertions, 11532 deletions
diff --git a/lisp/ChangeLog.trunk b/lisp/ChangeLog.trunk
index 5d005c4e8a..f0e59a6c6a 100644
--- a/lisp/ChangeLog.trunk
+++ b/lisp/ChangeLog.trunk
@@ -1,3 +1,1526 @@
+2010-09-13 Daiki Ueno <[email protected]>
+
+ * epa-file.el (epa-file-insert-file-contents): If visiting, bind
+ buffer-file-name to avoid file-locking. (Bug#7026)
+
+2010-09-13 Julien Danjou <[email protected]>
+
+ * notifications.el (notifications-notify): Add support for
+ image-path and sound-name.
+ (notifications-specification-version): Add this variable.
+
+2010-09-12 Stefan Monnier <[email protected]>
+
+ * subr.el (y-or-n-p): New function, moved from src/fns.c. Use read-key.
+
+2010-09-12 Leo <[email protected]>
+
+ * net/rcirc.el (rcirc-server-commands, rcirc-client-commands)
+ (rcirc-completion-start): New variables.
+ (rcirc-nick-completions): Rename to rcirc-completions.
+ (rcirc-nick-completion-start-offset): Delete.
+ (rcirc-completion-at-point): New function for constructing
+ completion data for both nicks and irc commands. Add to
+ completion-at-point-functions in rcirc mode.
+ (rcirc-complete): Rename from rcirc-nick-complete; use
+ rcirc-completion-at-point.
+ (defun-rcirc-command): Update rcirc-client-commands.
+
+2010-09-11 Glenn Morris <[email protected]>
+
+ * emacs-lisp/bytecomp.el (byte-compile-file): Create .elc files
+ atomically, to avoid parallel build errors. (Bug#4196)
+
+2010-09-11 Michael R. Mauger <[email protected]>
+
+ * progmodes/sql.el: Version 2.6
+ (sql-dialect): Synonym for "sql-product".
+ (sql-find-sqli-buffer, sql-set-sqli-buffer-generally)
+ (sql-set-sqli-buffer, sql-show-sqli-buffer, sql-interactive-mode):
+ Set "sql-buffer" to buffer name not buffer object so multiple sql
+ interactive buffers work properly. Reverts misguided changes in
+ earlier work.
+ (sql-comint): Make sure different buffer name is used if "*SQL*"
+ buffer is for a different product.
+ (sql-make-alternate-buffer-name): Fix bug with "sql-database"
+ login param.
+ (sql-oracle, sql-sybase, sql-informix, sql-sqlite, sql-mysql)
+ (sql-solid, sql-ingres, sql-ms, sql-postgres, sql-interbase)
+ (sql-db2, sql-linter, sql-product-interactive, sql-rename-buffer):
+ Accept new buffer name or prompt for one.
+ (sql-port): Default to zero.
+ (sql-comint-mysql): Handle "sql-port" as a numeric.
+ (sql-port-history): Delete unused variable.
+ (sql-get-login): Default "sql-port" to a number.
+ (sql-product-alist): Correct Postgres prompt and terminator
+ regexp.
+ (sql-sqlite-program): Dynamically detect presence of "sqlite" or
+ "sqlite3" executables.
+ (sql-sqlite-login-params): Add "*.sqlite[23]?" database name
+ pattern.
+ (sql-buffer-live-p): New function.
+ (sql-mode-menu, sql-send-string): Use it.
+ (sql-mode-oracle-font-lock-keywords): Improve SQL*Plus REMARK
+ syntax pattern.
+ (sql-mode-postgres-font-lock-keywords): Support Postgres V9.
+ (sql-mode-sqlite-font-lock-keywords): Hilight sqlite commands.
+
+2010-09-10 Lars Magne Ingebrigtsen <[email protected]>
+
+ * net/netrc.el (netrc-credentials): New conveniency function.
+
+2010-09-10 Stefan Monnier <[email protected]>
+
+ * textmodes/texinfo.el (texinfo-syntax-propertize-function): New fun
+ to replace texinfo-font-lock-syntactic-keywords.
+ (texinfo-mode): Use it.
+
+ * textmodes/tex-mode.el (tex-common-initialization, doctex-mode):
+ Use syntax-propertize-function.
+
+ * textmodes/sgml-mode.el (sgml-syntax-propertize-function): New var to
+ replace sgml-font-lock-syntactic-keywords.
+ (sgml-mode): Use it.
+
+ * textmodes/reftex.el (font-lock-syntactic-keywords): Don't declare
+ since we don't use it.
+
+ * textmodes/bibtex.el (bibtex-mode): Use syntax-propertize-function.
+
+ * progmodes/vhdl-mode.el (vhdl-mode): Use syntax-propertize-function
+ if available.
+ (vhdl-fontify-buffer): Adjust.
+
+ * progmodes/tcl.el (tcl-syntax-propertize-function): New var to
+ replace tcl-font-lock-syntactic-keywords.
+ (tcl-mode): Use it.
+
+ * progmodes/simula.el (simula-syntax-propertize-function): New var to
+ replace simula-font-lock-syntactic-keywords.
+ (simula-mode): Use it.
+
+ * progmodes/sh-script.el (sh-st-symbol): Remove.
+ (sh-font-lock-close-heredoc, sh-font-lock-open-heredoc): Add eol arg.
+ (sh-font-lock-flush-syntax-ppss-cache, sh-font-lock-here-doc): Remove.
+ (sh-font-lock-quoted-subshell): Assume we've already matched $(.
+ (sh-font-lock-paren): Set syntax-multiline.
+ (sh-font-lock-syntactic-keywords): Remove.
+ (sh-syntax-propertize-function): New function to replace it.
+ (sh-mode): Use it.
+
+ * progmodes/ruby-mode.el (ruby-here-doc-beg-re):
+ Define while compiling.
+ (ruby-here-doc-end-re, ruby-here-doc-beg-match)
+ (ruby-font-lock-syntactic-keywords, ruby-comment-beg-syntax)
+ (syntax-ppss, ruby-in-ppss-context-p, ruby-in-here-doc-p)
+ (ruby-here-doc-find-end, ruby-here-doc-beg-syntax)
+ (ruby-here-doc-end-syntax): Only define when
+ syntax-propertize is not available.
+ (ruby-syntax-propertize-function, ruby-syntax-propertize-heredoc):
+ New functions.
+ (ruby-in-ppss-context-p): Update to new syntax of heredocs.
+ (electric-indent-chars): Silence bytecompiler.
+ (ruby-mode): Use prog-mode, syntax-propertize-function, and
+ electric-indent-chars.
+
+ * progmodes/python.el (python-syntax-propertize-function): New var to
+ replace python-font-lock-syntactic-keywords.
+ (python-mode): Use it.
+ (python-quote-syntax): Simplify and adjust to new use.
+
+ * progmodes/perl-mode.el (perl-syntax-propertize-function): New fun to
+ replace perl-font-lock-syntactic-keywords.
+ (perl-syntax-propertize-special-constructs): New fun to replace
+ perl-font-lock-special-syntactic-constructs.
+ (perl-font-lock-syntactic-face-function): New fun.
+ (perl-mode): Use it.
+
+ * progmodes/octave-mod.el (octave-syntax-propertize-sqs): New function
+ to replace octave-font-lock-close-quotes.
+ (octave-syntax-propertize-function): New function to replace
+ octave-font-lock-syntactic-keywords.
+ (octave-mode): Use it.
+
+ * progmodes/mixal-mode.el (mixal-syntax-propertize-function): New var;
+ replaces mixal-font-lock-syntactic-keywords.
+ (mixal-mode): Use it.
+
+ * progmodes/make-mode.el (makefile-syntax-propertize-function):
+ New var; replaces makefile-font-lock-syntactic-keywords.
+ (makefile-mode): Use it.
+ (makefile-imake-mode): Adjust.
+
+ * progmodes/js.el (js--regexp-literal): Define while compiling.
+ (js-syntax-propertize-function): New var; replaces
+ js-font-lock-syntactic-keywords.
+ (js-mode): Use it.
+
+ * progmodes/gud.el (gdb-script-syntax-propertize-function): New var;
+ replaces gdb-script-font-lock-syntactic-keywords.
+ (gdb-script-mode): Use it.
+
+ * progmodes/fortran.el (fortran-mode): Use syntax-propertize-function.
+ (fortran--font-lock-syntactic-keywords): New var.
+ (fortran-line-length): Update syntax-propertize-function and
+ fortran--font-lock-syntactic-keywords.
+
+ * progmodes/cperl-mode.el (cperl-mode): Use syntax-propertize-function.
+
+ * progmodes/cfengine.el (cfengine-mode):
+ Use syntax-propertize-function.
+ (cfengine-font-lock-syntactic-keywords): Remove.
+
+ * progmodes/autoconf.el (autoconf-mode):
+ Use syntax-propertize-function.
+ (autoconf-font-lock-syntactic-keywords): Remove.
+
+ * progmodes/ada-mode.el (ada-set-syntax-table-properties)
+ (ada-after-change-function, ada-initialize-syntax-table-properties)
+ (ada-handle-syntax-table-properties): Only define when
+ syntax-propertize is not available.
+ (ada-mode): Use syntax-propertize-function.
+
+ * font-lock.el (font-lock-syntactic-keywords): Make obsolete.
+ (font-lock-fontify-syntactic-keywords-region): Move handling of
+ font-lock-syntactically-fontified to...
+ (font-lock-default-fontify-region): ...here.
+ Let syntax-propertize-function take precedence.
+ (font-lock-fontify-syntactically-region): Cal syntax-propertize.
+
+ * emacs-lisp/syntax.el (syntax-propertize-function)
+ (syntax-propertize-chunk-size, syntax-propertize--done)
+ (syntax-propertize-extend-region-functions): New vars.
+ (syntax-propertize-wholelines, syntax-propertize-multiline)
+ (syntax-propertize--shift-groups, syntax-propertize-via-font-lock)
+ (syntax-propertize): New functions.
+ (syntax-propertize-rules): New macro.
+ (syntax-ppss-flush-cache): Set syntax-propertize--done.
+ (syntax-ppss): Call syntax-propertize.
+
+ * emacs-lisp/regexp-opt.el (regexp-opt-depth): Skip named groups.
+
+2010-09-10 Agustín Martín <[email protected]>
+
+ * textmodes/ispell.el (ispell-init-process): Improve comments.
+ XEmacs compatibility changes regarding (add-hook) 'local option
+ and (set-process-query-on-exit-flag).
+
+2010-09-09 Michael Albinus <[email protected]>
+
+ * net/tramp-cache.el (tramp-parse-connection-properties):
+ Set tramp-autoload cookie.
+
+2010-09-09 Glenn Morris <[email protected]>
+
+ * image.el (imagemagick-types-inhibit): Add :type, :version, :group.
+ (imagemagick-register-types): Doc fix.
+
+2010-09-08 Stefan Monnier <[email protected]>
+
+ * progmodes/octave-mod.el (electric-indent-chars): Silence bytecomp.
+
+ * progmodes/js.el (require): Require is already "eval-and-compile".
+ (js--re-search-forward): Avoid `eval'. Preserve the error data.
+ (js--re-search-backward): Use js--re-search-forward.
+
+ * progmodes/fortran.el (fortran-line-length): Don't recompute
+ syntactic keywords redundantly a second time.
+
+ * progmodes/ada-mode.el: Replace "(set '" with setq.
+ (ada-mode): Simplify.
+ (ada-create-case-exception, ada-adjust-case-interactive)
+ (ada-adjust-case-region, ada-format-paramlist, ada-indent-current)
+ (ada-search-ignore-string-comment, ada-move-to-start)
+ (ada-move-to-end): Use with-syntax-table.
+
+ * font-lock.el (save-buffer-state): Remove `varlist' arg.
+ (font-lock-unfontify-region, font-lock-default-fontify-region):
+ Update usage correspondingly.
+ (font-lock-fontify-syntactic-keywords-region):
+ Set parse-sexp-lookup-properties buffer-locally here.
+ (font-lock-fontify-syntactically-region): Remove unused `ppss' arg.
+
+ * simple.el (blink-matching-open): Don't burp if we can't find a match.
+
+2010-09-08 Glenn Morris <[email protected]>
+
+ * emacs-lisp/bytecomp.el (byte-compile-report-ops):
+ Error if not compiled with -DBYTE_CODE_METER.
+
+ * emacs-lisp/bytecomp.el (byte-recompile-directory):
+ Ignore dir-locals-file.
+
+2010-09-08 Stefan Monnier <[email protected]>
+
+ * progmodes/compile.el (compilation-error-regexp-alist-alist):
+ Not a const.
+ (compilation-error-regexp-alist-alist): Rule out ": " in file names
+ for the `gnu' messages.
+ (compilation-set-skip-threshold): New command.
+ (compilation-start): Use \' rather than $.
+ (compilation-forget-errors): Use clrhash.
+
+2010-09-08 Agustín Martín <[email protected]>
+
+ * textmodes/ispell.el (ispell-valid-dictionary-list):
+ Simplify logic.
+
+2010-09-08 Michael Albinus <[email protected]>
+
+ Migrate to Tramp 2.2. Rearrange load dependencies.
+ (Bug#1529, Bug#5448, Bug#5705)
+
+ * Makefile.in (TRAMP_DIR, TRAMP_SRC): New variables.
+ ($(TRAMP_DIR)/tramp-loaddefs.el): New target.
+ (LOADDEFS): Add $(lisp)/net/tramp-loaddefs.el.
+
+ * net/tramp.el (top): Remove all other tramp-* loads except
+ tramp-compat.el. Remove all changes to tramp-unload-hook for
+ other tramp-* packages. Rearrange defun order. Change calls of
+ `tramp-compat-call-process', `tramp-compat-decimal-to-octal',
+ `tramp-compat-octal-to-decimal' to new function names.
+ (tramp-terminal-type, tramp-initial-end-of-output)
+ (tramp-methods, tramp-foreign-file-name-handler-alist)
+ (tramp-tramp-file-p, tramp-completion-mode-p)
+ (tramp-send-command-and-check, tramp-get-remote-path)
+ (tramp-get-remote-tmpdir, tramp-get-remote-ln)
+ (tramp-shell-quote-argument): Set tramp-autoload cookie.
+ (with-file-property, with-connection-property): Move to
+ tramp-cache.el.
+ (tramp-local-call-process, tramp-decimal-to-octal)
+ (tramp-octal-to-decimal): Move to tramp-compat.el.
+ (tramp-handle-shell-command): Do not require 'shell.
+ (tramp-compute-multi-hops): No special handling for tramp-gw-*
+ symbols.
+ (tramp-unload-tramp): Do not call `tramp-unload-file-name-handlers'.
+
+ * net/tramp-cache.el (top): Require 'tramp. Add to
+ `tramp-unload-hook'.
+ (tramp-cache-data, tramp-get-file-property)
+ (tramp-set-file-property, tramp-flush-file-property)
+ (tramp-flush-directory-property, tramp-get-connection-property)
+ (tramp-set-connection-property, tramp-flush-connection-property)
+ (tramp-cache-print, tramp-list-connections): Set tramp-autoload
+ cookie.
+ (with-file-property, with-connection-property): New defuns, moved
+ from tramp.el.
+ (tramp-flush-file-function): Use `with-parsed-tramp-file-name'
+ macro.
+
+ * net/tramp-cmds.el (top): Add to `tramp-unload-hook'.
+ (tramp-version): Set tramp-autoload cookie.
+
+ * net/tramp-compat.el (top): Require 'tramp-loaddefs. Remove all
+ changes to tramp-unload-hook for other tramp-* packages. Add to
+ `tramp-unload-hook'.
+ (tramp-compat-decimal-to-octal, tramp-compat-octal-to-decimal)
+ (tramp-compat-call-process): New defuns, moved from tramp.el.
+
+ * net/tramp-fish.el (top) Require just 'tramp. Add objects to
+ `tramp-methods' and `tramp-foreign-file-name-handler-alist'. Add
+ to `tramp-unload-hook'. Change call of
+ `tramp-compat-decimal-to-octal' to new function name.
+ (tramp-fish-method): Make it a defconst.
+ (tramp-fish-file-name-p): Make it a defsubst.
+ (tramp-fish-method, tramp-fish-file-name-handler)
+ (tramp-fish-file-name-p): Set tramp-autoload cookie.
+
+ * net/tramp-ftp.el (top) Add objects to `tramp-methods' and
+ `tramp-foreign-file-name-handler-alist'. Add to
+ `tramp-unload-hook'.
+ (tramp-ftp-method): Make it a defconst.
+ (tramp-ftp-file-name-p): Make it a defsubst.
+ (tramp-ftp-method, tramp-ftp-file-name-handler)
+ (tramp-ftp-file-name-p): Set tramp-autoload cookie.
+
+ * net/tramp-gvfs.el (top) Add objects to `tramp-methods' and
+ `tramp-foreign-file-name-handler-alist'. Add to
+ `tramp-unload-hook'. Change checks, whether package can be
+ loaded.
+ (tramp-gvfs-file-name-p): Make it a defsubst.
+ (tramp-gvfs-methods, tramp-gvfs-file-name-handler)
+ (tramp-gvfs-file-name-p): Set tramp-autoload cookie.
+ (tramp-gvfs-handle-file-directory-p): New defun.
+ (tramp-gvfs-file-name-handler-alist): Use it.
+
+ * net/tramp-gw.el (top) Add objects to `tramp-methods' and
+ `tramp-foreign-file-name-handler-alist'. Add to
+ `tramp-unload-hook'.
+ (tramp-gw-tunnel-method, tramp-gw-default-tunnel-port)
+ (tramp-gw-socks-method, tramp-gw-default-socks-port): Make it a
+ defconst.
+ (tramp-gw-tunnel-method, tramp-gw-socks-method)
+ (tramp-gw-open-connection): Set tramp-autoload cookie.
+
+ * net/tramp-imap.el (top) Require just 'tramp. Add objects to
+ `tramp-methods' and `tramp-foreign-file-name-handler-alist'. Add
+ to `tramp-unload-hook'. Change checks, whether package can be
+ loaded.
+ (tramp-imap-file-name-p): Make it a defsubst.
+ (tramp-imap-method, tramp-imaps-method)
+ (tramp-imap-file-name-handler)
+ (tramp-imap-file-name-p): Set tramp-autoload cookie.
+
+ * net/tramp-smb.el (top) Require just 'tramp. Add objects to
+ `tramp-methods' and `tramp-foreign-file-name-handler-alist'. Add
+ to `tramp-unload-hook'. Change checks, whether package can be
+ loaded. Change call of `tramp-compat-decimal-to-octal' to new
+ function name.
+ (tramp-smb-tunnel-method): Make it a defconst.
+ (tramp-smb-file-name-p): Make it a defsubst.
+ (tramp-smb-method, tramp-smb-file-name-handler)
+ (tramp-smb-file-name-p): Set tramp-autoload cookie.
+
+ * net/tramp-uu.el (top) Add to `tramp-unload-hook'.
+ (tramp-uuencode-region): Set tramp-autoload cookie.
+
+ * net/trampver.el (top) Add to `tramp-unload-hook'.
+ (tramp-version, tramp-bug-report-address): Set tramp-autoload
+ cookie. Update release number.
+
+2010-09-07 Agustín Martín <[email protected]>
+
+ * textmodes/ispell.el (ispell-start-process): Make sure original
+ arg list is properly initialized (Bug#6993, Bug#6994).
+
+2010-09-06 Alexander Klimov <[email protected]> (tiny change)
+
+ * files.el (directory-abbrev-alist): Use \` as default regexp.
+
+ * emacs-lisp/rx.el (rx-any): Don't explode ranges that end in special
+ chars like - or ] (bug#6984).
+ (rx-any-condense-range): Explode 2-char ranges.
+
+2010-09-06 Glenn Morris <[email protected]>
+
+ * desktop.el (desktop-path): Bump :version after 2009-09-15 change.
+
+2010-09-06 Stefan Monnier <[email protected]>
+
+ * textmodes/bibtex.el:
+ * proced.el: Update to new email for Roland Winkler <[email protected]>.
+
+2010-09-05 Lars Magne Ingebrigtsen <[email protected]>
+
+ * net/imap.el (imap-message-map): Remove optional buffer parameter,
+ since no callers use it.
+ (imap-message-get): Ditto.
+ (imap-message-put): Ditto.
+ (imap-mailbox-map): Ditto.
+ (imap-mailbox-put): Ditto.
+ (imap-mailbox-get): Ditto.
+ (imap-mailbox-get): Revert last change for this function.
+
+2010-09-05 Lars Magne Ingebrigtsen <[email protected]>
+
+ * net/imap.el (imap-fetch-safe): Remove function, and alter all
+ callers to use `imap-fetch' instead. According to the comments, this
+ should be safe, since all other IMAP clients use the 1:* syntax.
+ (imap-enable-exchange-bug-workaround): Remove.
+ (imap-debug): Remove -- doesn't seem very useful.
+
+2010-09-05 Lars Magne Ingebrigtsen <[email protected]>
+
+ * net/imap.el (imap-log): New convenience function used throughout
+ instead of repeating the same code all over the place.
+
+2010-09-05 David De La Harpe Golden <[email protected]>
+
+ * mouse.el (mouse-save-then-kill): Save region to kill-ring
+ when mouse-drag-copy-region is non-nil (Bug#6956).
+
+2010-09-05 Chong Yidong <[email protected]>
+
+ * dired.el (dired-ls-sorting-switches, dired-sort-by-name-regexp):
+ Improve regexps (Bug#6987).
+ (dired-sort-toggle): Search more robustly for -t flag.
+
+ * files.el (get-free-disk-space): Search more robustly for
+ "available" column. Suggested by Ehud Karni
+
+2010-09-05 Juanma Barranquero <[email protected]>
+
+ * international/uni-bidi.el:
+ * international/uni-category.el:
+ * international/uni-combining.el:
+ * international/uni-decimal.el:
+ * international/uni-mirrored.el:
+ * international/uni-name.el: Regenerate.
+
+2010-09-04 Stefan Monnier <[email protected]>
+
+ * electric.el (electric-indent-post-self-insert-function):
+ Don't reindent with a sloppy indentation function.
+
+ * emacs-lisp/syntax.el (syntax-ppss): More sanity check to catch
+ border case in change-log-mode.
+
+2010-09-04 Chong Yidong <[email protected]>
+
+ * progmodes/compile.el (compilation-error-regexp-alist-alist):
+ Remove ruby regexp; handle Ruby errors with gcc-include and gnu.
+ Recognize leading tab in gcc-include regexp. Ignore names with
+ leading "from" or "in" in gnu regexp (Bug#6937).
+
+2010-09-04 Stefan Monnier <[email protected]>
+
+ Avoid global recursive calls to kill-buffer-hooks; fit into 80 cols.
+ * textmodes/ispell.el (ispell-process-buffer-name): Remove.
+ (ispell-start-process): Avoid setq and simplify logic.
+ (ispell-init-process): Setup kill-buffer-hook locally when needed.
+ (kill-buffer-hook): Don't use it globally with code that uses
+ expand-file-name since that may call kill-buffer via
+ code_conversion_restore.
+
+2010-09-04 Noorul Islam K M <[email protected]> (tiny change)
+
+ * emacs-lisp/package.el (package-directory-list): Only call
+ file-name-nondirectory on a string.
+
+2010-09-02 Chong Yidong <[email protected]>
+
+ * emacs-lisp/package.el (package--download-one-archive):
+ Ensure that archive-contents is valid before saving it.
+ (package-activate-1, package-mark-obsolete, define-package)
+ (package-compute-transaction, package-list-maybe-add): Use push.
+
+2010-09-03 Stefan Monnier <[email protected]>
+
+ Use SMIE's blink-paren for octave-mode.
+ * progmodes/octave-mod.el (octave-font-lock-close-quotes):
+ Backslashes do not escape single-quotes, single-quotes do.
+ (octave-block-else-regexp, octave-block-end-regexp)
+ (octave-block-match-alist): Remove.
+ (octave-smie-bnf-table): New var, with old content.
+ (octave-smie-op-levels): Use it.
+ (octave-smie-closer-alist): New var.
+ (octave-mode): Use it. Setup smie-blink-matching and electric-indent.
+ (octave-blink-matching-block-open): Remove.
+ (octave-reindent-then-newline-and-indent, octave-electric-semi)
+ (octave-electric-space): Let self-insert-command run expand-abbrev and
+ blink parens.
+
+ * electric.el (electricity): New group.
+ (electric-indent-chars): New var.
+ (electric-indent-post-self-insert-function): New fun.
+ (electric-indent-mode): New minor mode.
+ (electric-pair-skip-self): New custom.
+ (electric-pair-post-self-insert-function): New function.
+ (electric-pair-mode): New minor mode.
+
+ * calc/calc-aent.el (calcAlg-blink-matching-check): New fun, to replace
+ calcAlg-blink-matching-open.
+ (calc-alg-ent-map, calc-alg-ent-esc-map): Initialize in the declaration.
+ (calc-do-alg-entry): Only touch the part of the keymap that varies.
+ Use the new blink-matching-check-function.
+
+ Provide blink-matching support to SMIE.
+ * emacs-lisp/smie.el (smie-bnf-closer-alist): New function.
+ (smie-blink-matching-triggers, smie-blink-matching-inners): New vars.
+ (smie-blink-matching-check, smie-blink-matching-open): New functions.
+
+ * simple.el (newline): Fix last change to properly remove itself from
+ the hook.
+
+2010-09-02 Stefan Monnier <[email protected]>
+
+ * simple.el (newline): Eliminate optimization.
+ Use post-self-insert-hook to set hard-newline and things before
+ running post-self-insert-hook.
+ (blink-matching-check-mismatch): New function.
+ (blink-matching-check-function): New variable.
+ (blink-matching-open): Use them.
+ Skip back forward over prefix chars skipped by forward-sexp.
+ Don't check if the parens are backslash escaped.
+ (blink-paren-post-self-insert-function): Check backslash escaping here.
+
+2010-09-02 Chong Yidong <[email protected]>
+
+ * emacs-lisp/package.el (package-menu-mode-map):
+ Change package-menu-revert bindings to revert-buffer.
+ (package-menu-mode): Set revert-buffer-function.
+ (package-menu-revert): Doc fix.
+
+2010-09-02 Agustín Martín <[email protected]>
+
+ * textmodes/ispell.el (ispell-init-process): Use "~/" as
+ `default-directory' unless using Ispell per-directory personal
+ dictionaries and not in a mini-buffer under XEmacs.
+ (kill-buffer-hook): Do not kill ispell process on exit when
+ `ispell-process-directory' is "~/". (Bug#6143)
+
+2010-09-02 Jan Djärv <[email protected]>
+
+ * simple.el (kill-new): Call interprogram-cut-function with only
+ one argument.
+
+ * term.el (term-mouse-paste): Don't call x-get-cutbuffer.
+ Remove cut buffer from error message.
+
+ * term/x-win.el (x-select-text):
+ * term/pc-win.el (x-selection-value):
+ * term/ns-win.el (x-selection-value):
+ * eshell/em-term.el:
+ * w32-fns.el (x-get-selection-value):
+ * mouse-sel.el (mouse-sel-set-selection-function):
+ * frame.el (display-selections-p): Remove cut-buffer in documentation.
+
+ * term/x-win.el: Update documentation for x-last-selected-text-*.
+ (x-last-selected-text-cut, x-last-selected-text-cut-encoded)
+ (x-last-cut-buffer-coding, x-cut-buffer-max): Remove.
+ (x-select-text): Remove argument PUSH, update documentation. Remove
+ cut-buffer code.
+ (x-selection-value-internal): Was previously x-selection-value.
+ (x-selection-value): Rename from x-cut-buffer-or-selection-value.
+ Update documentation, remove cut-buffer code. Call
+ x-selection-value-internal.
+ (x-clipboard-yank): Call x-selection-value-internal.
+ (x-initialize-window-system): Remove setting of x-cut-buffer-max.
+
+ * term/pc-win.el (x-last-selected-text):
+ x-cut-buffer-or-selection-value renamed to x-selection-value
+ (x-select-text): Remove argument PUSH, update documentation.
+
+ * term/ns-win.el (x-setup-function-keys, ns-last-selected-text):
+ x-cut-buffer-or-selection-value renamed to x-selection-value
+ (x-selection-value): Renamed from x-cut-buffer-or-selection-value.
+ (x-select-text): Remove argument PUSH, update documentation.
+
+ * emacs-lisp/cl-macs.el (x-get-cutbuffer, x-get-cut-buffer): Remove.
+
+ * w32-fns.el (x-last-selected-text):
+ x-cut-buffer-or-selection-value renamed to x-selection-value.
+ (x-cut-buffer-max): Remove.
+ (x-select-text): Remove argument PUSH, update documentation.
+
+ * simple.el (interprogram-cut-function): Remove mention of PUSH.
+
+ * select.el (x-get-cut-buffer, x-set-cut-buffer): Remove.
+
+ * mouse-sel.el (mouse-sel-get-selection-function):
+ x-cut-buffer-or-selection-value renamed to x-selection-value.
+ (x-select-text): Remove optional push.
+
+2010-09-01 Stefan Monnier <[email protected]>
+
+ * simple.el (blink-paren-function): Move from C to here.
+ (blink-paren-post-self-insert-function): New function.
+ (post-self-insert-hook): Use it.
+
+ * emacs-lisp/pcase.el (pcase-split-memq):
+ Fix overenthusiastic optimisation.
+ (pcase-u1): Handle the case of a lambda pred.
+
+2010-08-31 Kenichi Handa <[email protected]>
+
+ * international/mule-cmds.el (standard-display-european-internal):
+ Setup standard-display-table for 8-bit characters by storing 8-bit
+ characters in the element vector.
+
+ * disp-table.el (standard-display-8bit): Setup
+ standard-display-table for 8-bit characters by storing 8-bit
+ characters in the element vector.
+ (standard-display-european): Likewise.
+
+2010-08-31 Masatake YAMATO <[email protected]>
+
+ * textmodes/nroff-mode.el (nroff-view): New command.
+ (nroff-mode-map): Bind it to C-c C-c.
+
+2010-08-31 Stefan Monnier <[email protected]>
+
+ * emacs-lisp/smie.el (smie-down-list): New command.
+
+ Remove old indentation and navigation code on octave-mode.
+ * progmodes/octave-mod.el (octave-mode-map): Remap down-list to
+ smie-down-list rather than add a binding for octave-down-block.
+ (octave-mark-block, octave-blink-matching-block-open):
+ Rely on forward-sexp-function.
+ (octave-fill-paragraph): Don't narrow, so you can use
+ indent-according-to-mode.
+ (octave-block-begin-regexp, octave-block-begin-or-end-regexp): Remove.
+ (octave-in-block-p, octave-re-search-forward-kw)
+ (octave-re-search-backward-kw, octave-indent-calculate)
+ (octave-end-as-array-index-p, octave-block-end-offset)
+ (octave-scan-blocks, octave-forward-block, octave-backward-block)
+ (octave-down-block, octave-backward-up-block, octave-up-block)
+ (octave-before-magic-comment-p, octave-indent-line): Remove.
+
+2010-08-31 Chong Yidong <[email protected]>
+
+ * emacs-lisp/package.el (package--read-archive-file): Just use
+ `read', to avoid copying an additional string.
+ (package-menu-mode): Set header-line-format here.
+ (package-menu-refresh, package-menu-revert): Signal an error if
+ not in the Package Menu.
+ (package-menu-package-list): New var.
+ (package--generate-package-list): Operate on the current buffer;
+ don't assume that it is *Packages*, since the user may rename it.
+ Allow persistent package listings and sort keys using
+ package-menu-package-list and package-menu-package-sort-key.
+ (package-menu--version-predicate): Fix version calculation.
+ (package-menu-sort-by-column): Don't select the window.
+ (package--list-packages): Create the *Packages* buffer.
+ Set package-menu-package-list-key.
+ (list-packages): Sorting by status is now the default.
+ (package-buffer-info): Use match-string-no-properties.
+ (define-package): Add a &rest argument for future proofing, but
+ don't use it yet.
+ (package-install-from-buffer, package-install-buffer-internal):
+ Merge into a single function, package-install-from-buffer.
+ (package-install-file): Change caller.
+
+ * finder.el: Load finder-inf using `require'.
+ (finder-list-matches): Sorting by status is now the default.
+ (finder-compile-keywords): Simpify printing.
+
+2010-08-30 Stefan Monnier <[email protected]>
+
+ * progmodes/octave-mod.el (octave-font-lock-keywords): Use regexp-opt.
+ (octave-mode-map): Remove special bindings for forward/backward-block
+ and octave-backward-up-block. Use smie-close-block.
+ (octave-continuation-marker-regexp): New var.
+ (octave-continuation-regexp): Use it.
+ (octave-operator-table, octave-smie-op-levels)
+ (octave-operator-regexp, octave-smie-indent-rules): New vars.
+ (octave-smie-backward-token, octave-smie-forward-token): New funs.
+ (octave-mode): Use SMIE.
+ (octave-close-block): Delete.
+
+2010-08-30 Eli Zaretskii <[email protected]>
+
+ * menu-bar.el (menu-bar-edit-menu) <"Paste">: Check selection in
+ CLIPBOARD, not in PRIMARY. (Bug#6944)
+
+2010-08-30 Stefan Monnier <[email protected]>
+
+ * emacs-lisp/smie.el (smie-indent-offset-rule): Let :parent take
+ a list of parents.
+ (smie-indent-column): Allow indirection through variables.
+
+ * composite.el (save-buffer-state): Delete, unused.
+ * font-lock.el (save-buffer-state): Use with-silent-modifications.
+ (font-lock-default-fontify-region): Use with-syntax-table.
+ * jit-lock.el (with-buffer-unmodified): Remove.
+ (with-buffer-prepared-for-jit-lock): Use with-silent-modifications.
+
+ Use `declare' in defmacros.
+ * window.el (save-selected-window):
+ * subr.el (with-temp-file, with-temp-message, with-syntax-table):
+ * progmodes/python.el (def-python-skeleton):
+ * net/dbus.el (dbus-ignore-errors):
+ * jka-cmpr-hook.el (with-auto-compression-mode):
+ * international/mule.el (with-category-table):
+ * emacs-lisp/timer.el (with-timeout):
+ * emacs-lisp/lisp-mnt.el (lm-with-file):
+ * emacs-lisp/eieio.el (with-slots):
+ * emacs-lisp/easymenu.el (easy-menu-define):
+ * emacs-lisp/debug.el (debugger-env-macro):
+ * emacs-lisp/cl-compat.el (Multiple-value-bind, Multiple-value-setq)
+ (Multiple-value-call, Multiple-value-prog1):
+ * emacs-lisp/cl-seq.el (cl-parsing-keywords, cl-check-key)
+ (cl-check-test-nokey, cl-check-test, cl-check-match): Move indent and
+ edebug rule to definition.
+ * emacs-lisp/lisp-mode.el (save-selected-window)
+ (with-current-buffer, combine-after-change-calls)
+ (with-output-to-string, with-temp-file, with-temp-buffer)
+ (with-temp-message, with-syntax-table, read-if, eval-after-load)
+ (dolist, dotimes, when, unless):
+ * emacs-lisp/byte-run.el (inline): Remove indent rule, redundant.
+
+2010-08-29 Chong Yidong <[email protected]>
+
+ * finder.el: Require `package'.
+ (finder-known-keywords): Tweak descriptions. Retire `oop' keyword.
+ (finder-package-info): Var deleted.
+ (finder-keywords-hash, finder--builtins-alist): New vars.
+ (finder-compile-keywords): Compute package--builtins and
+ finder-keywords-hash instead of finder-keywords-hash, respecting
+ the "Package" header.
+ (finder-unknown-keywords, finder-list-matches):
+ Use finder-keywords-hash and package--list-packages.
+ (finder-mode): Don't set font-lock-defaults.
+ (finder-exit): We don't use "*Finder-package*" and "*Finder
+ Category*" buffers anymore.
+
+ * emacs-lisp/package.el (package--builtins-base): Var deleted.
+ (package--builtins): Set default value to nil.
+ (package-initialize): Load precomputed value of package--builtins
+ from finder-inf.el.
+ (package-alist, package-compute-transaction)
+ (package-download-transaction): Improve docstring.
+ (package-read-all-archive-contents): Do not change
+ package--builtins here.
+ (list-packages): Make package-list-packages an alias for this.
+ Sort by status by default.
+ (package--list-packages): Add optional PACKAGES arg.
+ (describe-package-1): Use font-lock-face property. For built-in
+ packages, insert file commentary.
+ (package--generate-package-list): Rename from
+ package-list-packages-internal; all callers changed. Add optional
+ PACKAGES arg. Add alphabetical sort fallbacks.
+ (package-menu--version-predicate, package-menu--status-predicate)
+ (package-menu--description-predicate)
+ (package-menu--name-predicate): New functions.
+
+ * info.el (Info-finder-find-node): Search package-alist instead of
+ finder-package-info.
+
+2010-08-29 Chong Yidong <[email protected]>
+
+ * subr.el (version-regexp-alist): Don't use "a" and "b" for
+ "alpha" and "beta".
+ (version-to-list): Handle versions like "10.3d".
+
+2010-08-28 Stefan Monnier <[email protected]>
+
+ * emacs-lisp/macroexp.el (macroexpand-all-1): Use pcase.
+ (macroexp-accumulate): Use `declare'.
+
+2010-08-27 Vinicius Jose Latorre <[email protected]>
+
+ * whitespace.el (whitespace-style): Adjust type declaration.
+
+2010-08-26 Magnus Henoch <[email protected]>
+
+ * net/tramp-gvfs.el (tramp-gvfs-handle-copy-file): Do not pass
+ empty argument to gvfs-copy.
+
+2010-08-26 Chong Yidong <[email protected]>
+
+ * net/tramp-compat.el (tramp-compat-delete-file): Rewrite to
+ handle new TRASH arg of `delete-file'.
+
+2010-08-26 Christian Lynbech <[email protected]> (tiny change)
+
+ * net/tramp.el (tramp-handle-insert-directory): Don't use
+ `forward-word', its default syntax could be changed.
+
+2010-08-26 Toru TSUNEYOSHI <[email protected]>
+ Michael Albinus <[email protected]>
+
+ Implement compression for inline methods.
+
+ * net/tramp.el (tramp-inline-compress-start-size): New defcustom.
+ (tramp-copy-size-limit): Allow also nil.
+ (tramp-inline-compress-commands): New defconst.
+ (tramp-find-inline-compress, tramp-get-inline-compress)
+ (tramp-get-inline-coding): New defuns.
+ (tramp-get-remote-coding, tramp-get-local-coding): Remove,
+ replaced by `tramp-get-inline-coding'.
+ (tramp-handle-file-local-copy, tramp-handle-write-region)
+ (tramp-method-out-of-band-p): Use `tramp-get-inline-coding'.
+
+2010-08-26 Noah Lavine <[email protected]> (tiny change)
+
+ Detect ssh 'ControlMaster' argument automatically in some cases.
+
+ * net/tramp.el (tramp-detect-ssh-controlmaster): New defun.
+ (tramp-default-method): Use it.
+
+2010-08-26 Karel Klíč <[email protected]>
+
+ * net/tramp.el (tramp-file-name-for-operation):
+ Add file-selinux-context.
+
+2010-08-26 Łukasz Stelmach <[email protected]> (tiny change)
+
+ * play/cookie1.el (read-cookie): Fix off-by-one error (bug#6921).
+
+2010-08-26 Chong Yidong <[email protected]>
+
+ * simple.el (beginning-of-buffer, end-of-buffer): Doc fix
+ (Bug#6907).
+
+2010-08-26 Nathan Weizenbaum <[email protected]> (tiny change)
+
+ * progmodes/js.el: Make indentation more customizable (Bug#6914).
+ (js-paren-indent-offset, js-square-indent-offset)
+ (js-curly-indent-offset): New options.
+ (js--proper-indentation): Use them.
+
+2010-08-26 Daniel Colascione <[email protected]>
+
+ * progmodes/sh-script.el (sh-get-indent-info): Use syntax-ppss
+ instead of inspecting font-lock properties (Bug#6916).
+
+2010-08-26 David Reitter <[email protected]>
+
+ * server.el (server-visit-files): Run pre-command-hook and
+ post-command-hook for each buffer while it is current
+ (Bug#6910).
+ (server-execute): Do not run hooks here.
+
+2010-08-26 Michael Albinus <[email protected]>
+
+ Sync with Tramp 2.1.19.
+
+ * net/tramp-cmds.el (tramp-cleanup-all-connections)
+ (tramp-reporter-dump-variable, tramp-load-report-modules)
+ (tramp-append-tramp-buffers): Use `tramp-compat-funcall'.
+ (tramp-bug): Recommend setting of `tramp-verbose' to 9.
+
+ * net/tramp-compat.el (top): Do not autoload
+ `tramp-handle-file-remote-p'. Load tramp-util.el and tramp-vc.el
+ only when `start-file-process' is not bound.
+ (byte-compile-not-obsolete-vars): Define if not bound.
+ (tramp-compat-funcall): New defmacro.
+ (tramp-compat-line-beginning-position)
+ (tramp-compat-line-end-position)
+ (tramp-compat-temporary-file-directory)
+ (tramp-compat-make-temp-file, tramp-compat-file-attributes)
+ (tramp-compat-copy-file, tramp-compat-copy-directory)
+ (tramp-compat-delete-file, tramp-compat-delete-directory)
+ (tramp-compat-number-sequence, tramp-compat-process-running-p):
+ Use it.
+ (tramp-advice-file-expand-wildcards): Do not use
+ `tramp-handle-file-remote-p'.
+ (tramp-compat-make-temp-file): Simplify fallback implementation.
+ (tramp-compat-copy-file): Add PRESERVE-SELINUX-CONTEXT.
+ (tramp-compat-copy-tree): Remove function.
+ (tramp-compat-delete-file): New defun.
+ (tramp-compat-delete-directory): Provide implementation for older
+ Emacsen.
+ (tramp-compat-file-attributes): Handle only
+ `wrong-number-of-arguments' error.
+
+ * net/tramp-fish.el (tramp-fish-handle-copy-file): Add
+ PRESERVE_SELINUX_CONTEXT.
+ (tramp-fish-handle-delete-file): Add TRASH arg.
+ (tramp-fish-handle-directory-files-and-attributes):
+ Do not use `tramp-fish-handle-file-attributes.
+ (tramp-fish-handle-file-local-copy)
+ (tramp-fish-handle-insert-file-contents)
+ (tramp-fish-maybe-open-connection): Use `with-progress-reporter'.
+
+ * net/tramp-gvfs.el (top): Require url-util.
+ (tramp-gvfs-mount-point): Remove.
+ (tramp-gvfs-file-name-handler-alist): Add `file-selinux-context'
+ and `set-file-selinux-context'.
+ (tramp-gvfs-stringify-dbus-message, tramp-gvfs-send-command)
+ (tramp-gvfs-handle-file-selinux-context)
+ (tramp-gvfs-handle-set-file-selinux-context): New defuns.
+ (with-tramp-dbus-call-method): Format trace message.
+ (tramp-gvfs-handle-copy-file): Handle PRESERVE-SELINUX-CONTEXT.
+ (tramp-gvfs-handle-copy-file, tramp-gvfs-handle-rename-file):
+ Implement backup call, when operation on local files fails. Use
+ progress reporter. Flush properties of changed files.
+ (tramp-gvfs-handle-delete-file): Add TRASH arg. Use
+ `tramp-compat-delete-file'.
+ (tramp-gvfs-handle-expand-file-name): Expand "~/".
+ (tramp-gvfs-handle-make-directory): Make more traces.
+ (tramp-gvfs-handle-write-region): Protect deleting tmpfile.
+ (tramp-gvfs-url-file-name): Hexify file name in url.
+ (tramp-gvfs-fuse-file-name): Take also prefix (like dav shares)
+ into account for the resulting file name.
+ (tramp-gvfs-handler-askquestion): Preserve current message, in
+ order to let progress reporter continue afterwards. (Bug#6257)
+ Return dummy mountpoint, when the answer is "no". See
+ `tramp-gvfs-maybe-open-connection'.
+ (tramp-gvfs-handler-mounted-unmounted)
+ (tramp-gvfs-connection-mounted-p): Test also for new mountspec
+ attribute "default_location". Set "prefix" property. Handle
+ default-location.
+ (tramp-gvfs-mount-spec): Return both prefix and mountspec.
+ (tramp-gvfs-maybe-open-connection): Test, whether mountpoint
+ exists. Raise an error, if not (due to a corresponding answer
+ "no" in interactive questions, for example). Use
+ `tramp-compat-funcall'.
+
+ * net/tramp-imap.el (top): Autoload `epg-make-context'.
+ (tramp-imap-handle-copy-file): Add PRESERVE-SELINUX-CONTEXT.
+ (tramp-imap-do-copy-or-rename-file)
+ (tramp-imap-handle-insert-file-contents)
+ (tramp-imap-handle-file-local-copy): Use `with-progress-reporter'.
+ (tramp-imap-handle-delete-file): Add TRASH arg.
+
+ * net/tramp-smb.el (tramp-smb-handle-copy-file): Add
+ PRESERVE-SELINUX-CONTEXT.
+ (tramp-smb-handle-copy-file)
+ (tramp-smb-handle-file-local-copy, tramp-smb-handle-rename-file)
+ (tramp-smb-handle-write-region, tramp-smb-maybe-open-connection):
+ Use `with-progress-reporter'.
+ (tramp-smb-handle-delete-file): Add TRASH arg.
+
+ * net/tramp.el (tramp-methods): Move hostname to the end in all
+ ssh `tramp-login-args'. Add `tramp-async-args' attribute where
+ appropriate.
+ (tramp-verbose): Describe verbose level 9.
+ (tramp-completion-function-alist)
+ (tramp-file-name-regexp, tramp-chunksize)
+ (tramp-local-coding-commands, tramp-remote-coding-commands)
+ (with-connection-property, tramp-completion-mode-p)
+ (tramp-action-process-alive, tramp-action-out-of-band)
+ (tramp-check-for-regexp, tramp-file-name-p, tramp-equal-remote)
+ (tramp-exists-file-name-handler): Fix docstring.
+ (tramp-remote-process-environment): Use `format' instead of
+ `concat'. Protect version string by apostroph.
+ (tramp-shell-prompt-pattern): Do not use a shy group in case of
+ XEmacs.
+ (tramp-file-name-regexp-unified)
+ (tramp-completion-file-name-regexp-unified): On W32 systems, do
+ not regard the volume letter as remote filename. (Bug#5447)
+ (tramp-perl-file-attributes)
+ (tramp-perl-directory-files-and-attributes): Don't pass "$3".
+ (tramp-vc-registered-read-file-names): Read input as
+ here-document, otherwise the command could exceed maximum length
+ of command line.
+ (tramp-file-name-handler-alist): Add `file-selinux-context' and
+ `set-file-selinux-context'.
+ (tramp-debug-message): Add `tramp-compat-funcall' to ignored
+ backtrace functions.
+ (tramp-error-with-buffer): Don't show the connection buffer when
+ we are in completion mode.
+ (tramp-progress-reporter-update, tramp-remote-selinux-p)
+ (tramp-handle-file-selinux-context)
+ (tramp-handle-set-file-selinux-context, tramp-process-sentinel)
+ (tramp-connectable-p, tramp-open-shell, tramp-get-remote-trash):
+ New defuns.
+ (with-progress-reporter): New defmacro.
+ (tramp-debug-outline-regexp): New defconst.
+ (top, tramp-rfn-eshadow-setup-minibuffer)
+ (tramp-rfn-eshadow-update-overlay, tramp-handle-set-file-times)
+ (tramp-handle-dired-compress-file, tramp-handle-shell-command)
+ (tramp-completion-mode-p, tramp-check-for-regexp)
+ (tramp-open-connection-setup-interactive-shell)
+ (tramp-compute-multi-hops, tramp-read-passwd, tramp-clear-passwd)
+ (tramp-time-diff, tramp-coding-system-change-eol-conversion)
+ (tramp-set-process-query-on-exit-flag, tramp-unload-tramp):
+ Use `tramp-compat-funcall'.
+ (tramp-handle-make-symbolic-link): Flush file properties.
+ (tramp-handle-load, tramp-handle-file-local-copy)
+ (tramp-handle-insert-file-contents, tramp-handle-write-region)
+ (tramp-handle-vc-registered, tramp-maybe-send-script)
+ (tramp-find-shell): Use `with-progress-reporter'.
+ (tramp-do-file-attributes-with-stat): Add space in format string,
+ in order to work around a bug in pdksh. Reported by Gilles Pion
+ (tramp-handle-verify-visited-file-modtime): Do not send a command
+ when the connection is not established.
+ (tramp-handle-set-file-times): Simplify the check for utc.
+ (tramp-handle-directory-files-and-attributes)
+ (tramp-get-remote-path): Use `copy-tree'.
+ (tramp-completion-handle-file-name-all-completions): Ensure, that
+ non remote files are still checked. Oops.
+ (tramp-handle-copy-file, tramp-do-copy-or-rename-file): Handle
+ PRESERVE-SELINUX-CONTEXT.
+ (tramp-do-copy-or-rename-file): Add progress reporter.
+ (tramp-do-copy-or-rename-file-directly): Do not use
+ `tramp-handle-file-remote-p'.
+ (tramp-do-copy-or-rename-file-out-of-band):
+ Use `tramp-compat-delete-directory'.
+ (tramp-do-copy-or-rename-file-out-of-band)
+ (tramp-compute-multi-hops, tramp-maybe-open-connection):
+ Use `format-spec-make'.
+ (tramp-handle-delete-file): Add TRASH arg.
+ (tramp-handle-dired-uncache): Flush directory cache, not only file
+ cache.
+ (tramp-handle-expand-file-name)
+ (tramp-completion-handle-file-name-all-completions)
+ (tramp-completion-handle-file-name-completion): Use
+ `tramp-connectable-p'.
+ (tramp-handle-start-file-process): Set connection property "vec".
+ Use it, in order to invalidate file caches. Check only for
+ `remote-tty' process property.
+ Implement tty setting. (Bug#4604, Bug#6360)
+ (tramp-file-name-for-operation): Add `call-process-region' and
+ `set-file-selinux-context'.
+ (tramp-find-foreign-file-name-handler)
+ (tramp-advice-make-auto-save-file-name)
+ (tramp-set-auto-save-file-modes): Remove superfluous check for
+ `stringp'. This is done inside `tramp-tramp-file-p'.
+ (tramp-file-name-handler): Trace 'quit. Catch the error for some
+ operations when we are in completion mode. This gives the user
+ the chance to correct the file name in the minibuffer.
+ (tramp-completion-mode-p): Use `non-essential'.
+ (tramp-handle-file-name-all-completions): Backward/ XEmacs
+ compatibility: Use `completion-ignore-case' if
+ `read-file-name-completion-ignore-case' does not exist.
+ (tramp-get-debug-buffer): Use `tramp-debug-outline-regexp'.
+ (tramp-find-shell, tramp-open-connection-setup-interactive-shell):
+ `tramp-open-shell'.
+ (tramp-action-password): Hide password prompt before next run.
+ (tramp-process-actions): Widen connection buffer for the trace.
+ (tramp-open-connection-setup-interactive-shell): Set `remote-tty'
+ process property. Trace stty settings if `tramp-verbose' >= 9.
+ Apply workaround for IRIX64 bug. Move argument of last
+ `tramp-send-command' where it belongs to.
+ (tramp-maybe-open-connection): Use `async-args' and `gw-args' in
+ front of `login-args'.
+ (tramp-get-ls-command, tramp-get-ls-command-with-dired): Run tests
+ on "/dev/null" instead of "/".
+ (tramp-get-ls-command-with-dired): Make test for "--dired"
+ stronger.
+ (tramp-set-auto-save-file-modes): Adapt version check.
+ (tramp-set-process-query-on-exit-flag): Fix wrong parentheses.
+ (tramp-handle-process-file): Call the program in a subshell, in
+ order to preserve working directory.
+ (tramp-handle-shell-command): Don't use hard-wired "/bin/sh" but
+ `tramp-remote-sh' from `tramp-methods'.
+ (tramp-get-ls-command): Make test for "--color=never" stronger.
+ (tramp-check-for-regexp): Use (forward-line 1).
+
+ * net/trampver.el: Update release number.
+
+2010-08-26 Chong Yidong <[email protected]>
+
+ * help.el (help-map): Bind `C-h P' to describe-package.
+
+ * menu-bar.el (menu-bar-describe-menu): Add describe-package.
+
+ * emacs-lisp/package.el (package-refresh-contents): Catch errors
+ when downloading archives.
+ (describe-package-1): Add package commentary.
+ (package-install-button-action): New function.
+ (package-menu-mode-map): Bind ? to package-menu-describe-package.
+ (package-menu-view-commentary): Function removed.
+ (package-list-packages-internal): Hide the `package' package too.
+
+2010-08-25 Kenichi Handa <[email protected]>
+
+ * language/misc-lang.el ("Arabic"): New language environment.
+ Setup composition-function-table for Arabic characters.
+
+ * international/fontset.el (setup-default-fontset): Fix typo for
+ arabic OTF spec (fini->fina).
+
+2010-08-25 Jan Djärv <[email protected]>
+
+ * menu-bar.el (menu-bar-set-tool-bar-position): Set frame parameter
+ on all frames.
+
+2010-08-24 Vinicius Jose Latorre <[email protected]>
+
+ * whitespace.el: Allow cleaning up blanks without blank
+ visualization (Bug#6651). Adjust help window for
+ whitespace-toggle-options (Bug#6479). Allow to use fill-column
+ instead of whitespace-line-column (from EmacsWiki). New version
+ 13.1.
+ (whitespace-style): Added new value 'face. Adjust docstring.
+ (whitespace-space, whitespace-hspace, whitespace-tab): Adjust
+ foreground property face.
+ (whitespace-line-column): Adjust docstring and type declaration.
+ (whitespace-style-value-list, whitespace-toggle-option-alist)
+ (whitespace-help-text): Adjust const initialization.
+ (whitespace-toggle-options, global-whitespace-toggle-options):
+ Adjust docstring.
+ (whitespace-display-window, whitespace-interactive-char)
+ (whitespace-style-face-p, whitespace-color-on): Adjust code.
+ (whitespace-help-scroll): New fun.
+
+2010-08-24 Chong Yidong <[email protected]>
+
+ * emacs-lisp/package.el (list-packages): Alias for
+ package-list-packages.
+
+2010-08-24 Kevin Ryde <[email protected]>
+
+ * textmodes/flyspell.el (flyspell-check-tex-math-command): Doc fix
+ (Bug#5651).
+
+ * progmodes/ruby-mode.el (ruby): Add defgroup.
+
+2010-08-24 Chong Yidong <[email protected]>
+
+ * progmodes/python.el: Add Ipython support (Bug#5390).
+ (python-shell-prompt-alist)
+ (python-shell-continuation-prompt-alist): New options.
+ (python--set-prompt-regexp): New function.
+ (inferior-python-mode, run-python, python-shell): Require
+ ansi-color. Use python--set-prompt-regexp to set the comint
+ prompt based on the Python interpreter.
+ (python--prompt-regexp): New var.
+ (python-check-comint-prompt)
+ (python-comint-output-filter-function): Use it.
+ (run-python): Use a pipe (Bug#5694).
+
+2010-08-24 Fabian Ezequiel Gallina <[email protected]> (tiny change)
+
+ * progmodes/python.el (python-send-region): Send a different
+ Python command if Ipython is in use.
+ (python-check-version): Use a Python command to find the version.
+
+2010-08-24 Chong Yidong <[email protected]>
+
+ * mouse.el (mouse-yank-primary): Avoid setting primary when
+ deactivating the mark (Bug#6872).
+
+2010-08-23 Chris Foote <[email protected]> (tiny change)
+
+ * progmodes/python.el (python-block-pairs): Allow use of "finally"
+ with "else" (Bug#3991).
+
+2010-08-23 Michael Albinus <[email protected]>
+
+ * net/dbus.el: Accept UNIX domain sockets as bus address.
+ (top): Don't initialize `dbus-registered-objects-table' anymore,
+ this is done in dbusbind,c.
+ (dbus-check-event): Adapt test for bus.
+ (dbus-return-values-table, dbus-unregister-service)
+ (dbus-event-bus-name, dbus-introspect, dbus-register-property):
+ Adapt doc string.
+
+2010-08-23 Juanma Barranquero <[email protected]>
+
+ * ido.el (ido-use-virtual-buffers): Fix typo in docstring.
+
+2010-08-22 Juri Linkov <[email protected]>
+
+ * simple.el (read-extended-command): New function with the logic
+ for `completing-read' moved to Elisp from `execute-extended-command'.
+ Use `function-called-at-point' in `minibuffer-default-add-function'
+ to get a command name for M-n (bug#5364, bug#5214).
+
+2010-08-22 Chong Yidong <[email protected]>
+
+ * startup.el (command-line-1): Issue warning for ignored arguments
+ --unibyte, etc (Bug#6886).
+
+2010-08-22 Leo <[email protected]>
+
+ * net/rcirc.el (rcirc-add-or-remove): Accept a list of elements.
+ (ignore, bright, dim, keyword): Split list of nicknames before
+ passing to rcirc-add-or-remove (Bug#6894).
+
+2010-08-22 Chong Yidong <[email protected]>
+
+ * emacs-lisp/easy-mmode.el (define-minor-mode): Doc fix (Bug#6880).
+
+2010-08-22 Leo <[email protected]>
+
+ Fix buffer-list rename&refresh after killing a buffer in ido.
+ * lisp/ido.el: Revert Óscar's.
+ (ido-kill-buffer-at-head): Exit the minibuffer with ido-exit=refresh.
+ Remember the buffers at head, rather than their name.
+ * lisp/iswitchb.el (iswitchb-kill-buffer): Re-make the list.
+
+2010-08-22 Kirk Kelsey <[email protected]> (tiny change)
+ Stefan Monnier <[email protected]>
+
+ * progmodes/make-mode.el (makefile-fill-paragraph): Account for the
+ extra backslash added to each line (bug#6890).
+
+2010-08-22 Stefan Monnier <[email protected]>
+
+ * subr.el (read-key): Don't echo keystrokes (bug#6883).
+
+2010-08-22 Glenn Morris <[email protected]>
+
+ * menu-bar.el (menu-bar-games-menu): Add landmark.
+
+2010-08-22 Glenn Morris <[email protected]>
+
+ * align.el (align-regexp): Make group and spacing arguments
+ use the interactive defaults when non-interactive. (Bug#6698)
+
+ * mail/rmail.el (rmail-forward): Replace mail-text-start with its
+ expansion, so as not to need sendmail.
+ (mail-text-start): Remove declaration.
+ (rmail-retry-failure): Require sendmail.
+
+2010-08-22 Chong Yidong <[email protected]>
+
+ * subr.el (read-key): Don't hide the menu-bar entries (bug#6881).
+
+2010-08-22 Michael Albinus <[email protected]>
+
+ * progmodes/flymake.el (flymake-start-syntax-check-process):
+ Use `start-file-process' in order to let it run also on remote hosts.
+
+2010-08-22 Kenichi Handa <[email protected]>
+
+ * files.el: Add `word-wrap' as safe local variable.
+
+2010-08-22 Glenn Morris <[email protected]>
+
+ * woman.el (woman-translate): Case matters. (Bug#6849)
+
+2010-08-22 Chong Yidong <[email protected]>
+
+ * simple.el (kill-region): Doc fix (Bug#6787).
+
+2010-08-22 Glenn Morris <[email protected]>
+
+ * calendar/diary-lib.el (diary-header-line-format):
+ Fit it to the window, not the frame.
+
+2010-08-22 Andreas Schwab <[email protected]>
+
+ * subr.el (ignore-errors): Add debug declaration.
+
+2010-08-22 Geoff Gole <[email protected]> (tiny change)
+
+ * whitespace.el (whitespace-color-off): Remove post-command-hook
+ locally.
+
+2010-08-21 Stefan Monnier <[email protected]>
+
+ * vc/add-log.el (add-log-file-name): Don't get confused by symlinks.
+
+2010-08-21 Chong Yidong <[email protected]>
+
+ * cus-edit.el (custom-group-value-create): Add extra newline
+ before end line (Bug#6876).
+
+2010-08-21 Chong Yidong <[email protected]>
+
+ * mouse.el (mouse-save-then-kill): Don't save region to kill ring
+ when extending it. Before killing on the second click, check if
+ the buffer is the correct one. Doc fix.
+ (mouse-secondary-save-then-kill): Allow usage without first
+ calling mouse-start-secondary, by defaulting to point. Don't save
+ an empty secondary selection. Doc fix.
+
+2010-08-21 Vinicius Jose Latorre <[email protected]>
+
+ * whitespace.el: Fix slow cursor movement (Bug#6172). Reported by
+ Christoph Groth <[email protected]> and Liu Xin <[email protected]>.
+ New version 13.0.
+ (whitespace-empty-at-bob-regexp, whitespace-empty-at-eob-regexp):
+ Adjust initialization.
+ (whitespace-bob-marker, whitespace-eob-marker)
+ (whitespace-buffer-changed): New vars.
+ (whitespace-cleanup, whitespace-color-on, whitespace-color-off)
+ (whitespace-empty-at-bob-regexp, whitespace-empty-at-eob-regexp)
+ (whitespace-post-command-hook, whitespace-display-char-on):
+ Adjust code.
+ (whitespace-looking-back, whitespace-buffer-changed): New funs.
+ (whitespace-space-regexp, whitespace-tab-regexp): Fun eliminated.
+
+2010-08-19 Stefan Monnier <[email protected]>
+
+ * files.el (locate-file-completion-table): Only list the .el and .elc
+ extensions if there's no other choice (bug#5955).
+
+ * facemenu.el (facemenu-self-insert-data): New var.
+ (facemenu-post-self-insert-function, facemenu-set-self-insert-face):
+ New functions.
+ (facemenu-add-face): Use them.
+
+ * simple.el (blink-matching-open): Obey forward-sexp-function.
+
+2010-08-18 Stefan Monnier <[email protected]>
+
+ * simple.el (prog-mode-map): New var.
+ (prog-indent-sexp): New command.
+
+ * progmodes/octave-mod.el (octave-mode-menu): Make toggle buttons.
+
+ * progmodes/prolog.el (smie): Require.
+
+ * emacs-lisp/smie.el (smie-default-backward-token)
+ (smie-default-forward-token): Strip properties.
+ (smie-next-sexp): Be more careful with associative operators.
+ (smie-forward-sexp-command): Generalize.
+ (smie-backward-sexp-command): Simplify.
+ (smie-closer-alist): New var.
+ (smie-close-block): New command.
+ (smie-indent-debug-log): New var.
+ (smie-indent-offset-rule): Add a few more cases.
+ (smie-indent-column): New function.
+ (smie-indent-after-keyword): Use it.
+ (smie-indent-keyword): Use it.
+ Fix up the opener code's point position.
+ (smie-indent-comment): Only applies at BOL.
+ (smie-indent-debug): New command.
+
+ * emacs-lisp/autoload.el (make-autoload): Preload the macros's
+ declarations that are useful before running the macro.
+
+2010-08-18 Joakim Verona <[email protected]>
+
+ * image.el (imagemagick-types-inhibit): New variable.
+ (imagemagick-register-types): New function.
+ * image-mode.el (image-transform-properties): New function.
+ (image-transform-set-scale, image-transform-fit-to-height)
+ (image-transform-set-rotation, image-transform-set-resize)
+ (image-transform-fit-to-width, image-transform-fit-to-height):
+ New functions.
+ (image-toggle-display-image): Support image transforms.
+
+2010-08-18 Katsumi Yamaoka <[email protected]>
+
+ * image.el (create-animated-image): Don't add heuristic mask to image
+ (Bug#6839).
+
+2010-08-18 Jan Djärv <[email protected]>
+
+ * term/ns-win.el (ns-get-pasteboard, ns-set-pasteboard):
+ Use QCLIPBOARD instead of QPRIMARY (Bug#6677).
+
+2010-08-17 Stefan Monnier <[email protected]>
+
+ * emacs-lisp/lisp.el (up-list): Obey forward-sexp-function if set.
+
+ Font-lock '...' strings, plus various simplifications and fixes.
+ * progmodes/octave-mod.el (octave-font-lock-keywords): Use regexp-opt.
+ (octave-font-lock-close-quotes): New function.
+ (octave-font-lock-syntactic-keywords): New var.
+ (octave-mode): Use it. Set beginning-of-defun-function.
+ (octave-mode-map): Don't override the <foo>-defun commands.
+ (octave-mode-menu): Pass it directly to easy-menu-define;
+ remove (now generic) <foo>-defun commands; use info-lookup-symbol.
+ (octave-block-match-alist): Fix up last change so that
+ octave-close-block uses the more specific keyword.
+ (info-lookup-mode): Silence byte-compiler.
+ (octave-beginning-of-defun): Not interactive any more.
+ Optimize slightly.
+ (octave-end-of-defun, octave-mark-defun, octave-in-defun-p): Remove.
+ (octave-indent-defun, octave-send-defun): Use mark-defun instead.
+ (octave-completion-at-point-function): Make sure point is within
+ beg..end.
+ (octave-reindent-then-newline-and-indent):
+ Use reindent-then-newline-and-indent.
+ (octave-add-octave-menu): Remove.
+
+2010-08-17 Jan Djärv <[email protected]>
+
+ * mail/emacsbug.el (report-emacs-bug-insert-to-mailer)
+ (report-emacs-bug-can-use-xdg-email): New functions.
+ (report-emacs-bug): Set can-xdg-email to result of
+ report-emacs-bug-can-use-xdg-email. If can-xdg-email bind
+ \C-cm to report-emacs-bug-insert-to-mailer and add help text
+ about it.
+
+ * net/browse-url.el (browse-url-default-browser): Add cond
+ for browse-url-xdg-open.
+ (browse-url-can-use-xdg-open, browse-url-xdg-open): New functions.
+
+2010-08-17 Glenn Morris <[email protected]>
+
+ * progmodes/cc-engine.el (c-new-BEG, c-new-END)
+ (c-fontify-recorded-types-and-refs): Define for compiler.
+ * progmodes/cc-mode.el (c-new-BEG, c-new-END): Move definitions
+ before use.
+
+ * calendar/icalendar.el (icalendar--convert-recurring-to-diary):
+ Fix format call.
+
+2010-08-17 Michael Albinus <[email protected]>
+
+ * net/tramp.el (tramp-handle-make-symbolic-link): Flush file
+ properties.
+ (tramp-handle-process-file): Call the program in a subshell, in
+ order to preserve working directory.
+ (tramp-action-password): Hide password prompt before next run.
+ (tramp-process-actions): Widen connection buffer for the trace.
+
+2010-08-16 Deniz Dogan <[email protected]>
+
+ * net/rcirc.el (rcirc-log-process-buffers): New option.
+ (rcirc-print): Use it.
+ (rcirc-generate-log-filename): New function.
+ (rcirc-log-filename-function): Change default to
+ rcirc-generate-log-filename (Bug#6828).
+
+2010-08-16 Chong Yidong <[email protected]>
+
+ * simple.el (deactivate-mark): If select-active-regions is `only',
+ only set selection for temporarily active regions.
+
+ * cus-start.el: Change defcustom for select-active-regions.
+
+2010-08-15 Chong Yidong <[email protected]>
+
+ * mouse.el (mouse--drag-set-mark-and-point): New function.
+ (mouse-drag-track): Use LOCATION arg to push-mark.
+ Use mouse--drag-set-mark-and-point to take click-count into
+ consideration when updating point and mark (Bug#6840).
+
+2010-08-15 Chong Yidong <[email protected]>
+
+ * progmodes/compile.el (compilation-error-regexp-alist-alist):
+ Give the Ruby rule a lower priority than Gnu (Bug#6778).
+
+2010-08-14 Štěpán Němec <[email protected]> (tiny change)
+
+ * font-lock.el (lisp-font-lock-keywords-2):
+ Add combine-after-change-calls, condition-case-no-debug,
+ with-demoted-errors, and with-silent-modifications (Bug#6025).
+
+2010-08-14 Kevin Ryde <[email protected]>
+
+ * emacs-lisp/copyright.el (copyright-update-year)
+ (copyright-update): Temporary switch-to-buffer to ensure the
+ buffer change being queried is visible (Bug#5394).
+
+2010-08-14 Tom Tromey <[email protected]>
+
+ * progmodes/etags.el (tags-file-name): Mark safe if stringp
+ (Bug#6733).
+
+2010-08-14 Eli Zaretskii <[email protected]>
+
+ * mouse.el (mouse-yank-primary): Fix mouse-2 on MS-Windows and
+ MS-DOS. (Bug#6689)
+
+2010-08-13 Jan Djärv <[email protected]>
+
+ * menu-bar.el (menu-bar-set-tool-bar-position): New function.
+ (menu-bar-showhide-tool-bar-menu-customize-enable-left)
+ (menu-bar-showhide-tool-bar-menu-customize-enable-right)
+ (menu-bar-showhide-tool-bar-menu-customize-enable-top)
+ (menu-bar-showhide-tool-bar-menu-customize-enable-bottom):
+ Call menu-bar-set-tool-bar-position.
+
+2010-08-12 Stefan Monnier <[email protected]>
+
+ * progmodes/octave-mod.el (octave-mode-syntax-table): Use the new "c"
+ comment style (bug#6834).
+ * progmodes/scheme.el (scheme-mode-syntax-table):
+ * emacs-lisp/lisp-mode.el (lisp-mode-syntax-table): Remove spurious
+ "b" flag in "' 14b" syntax.
+
+ * progmodes/octave-mod.el (octave-mode-map): Remove special bindings
+ for (un)commenting the region and performing completion.
+ (octave-mode-menu): Use standard commands for help and completion.
+ (octave-mode-syntax-table): Support %{..%} comments (sort of).
+ (octave-mode): Use define-derived-mode.
+ Set completion-at-point-functions and don't set columns.
+ Don't disable adaptive-fill-regexp.
+ (octave-describe-major-mode, octave-comment-region)
+ (octave-uncomment-region, octave-comment-indent)
+ (octave-indent-for-comment): Remove.
+ (octave-indent-calculate): Rename from calculate-octave-indent.
+ (octave-indent-line, octave-fill-paragraph): Update caller.
+ (octave-initialize-completions): No need to make an alist.
+ (octave-completion-at-point-function): New function.
+ (octave-complete-symbol): Use it.
+ (octave-insert-defun): Use define-skeleton.
+
+ * progmodes/octave-mod.el (octave-mode): Set comment-add.
+ (octave-mode-map): Use comment-dwim (bug#6829).
+
+2010-08-12 Antoine Levitt <[email protected]> (tiny change)
+
+ * cus-edit.el (custom-save-variables, custom-save-faces): Fix up
+ indentation of inserted comment.
+
+2010-08-11 Jan Djärv <[email protected]>
+
+ * faces.el (region): Add type gtk that uses gtk colors.
+
+ * dynamic-setting.el (dynamic-setting-handle-config-changed-event):
+ Handle theme-name change.
+
+2010-08-10 Michael R. Mauger <[email protected]>
+
+ * progmodes/sql.el: Version 2.5
+ (sql-product-alist): Add :prompt-cont-regexp property for several
+ database products.
+ (sql-prompt-cont-regexp): New variable.
+ (sql-output-newline-count, sql-output-by-send):
+ New variables. Record number of newlines in input text.
+ (sql-send-string): Handle multiple filters and count newlines.
+ (sql-send-magic-terminator): Count terminator newline.
+ (sql-interactive-remove-continuation-prompt): Filters output to
+ remove continuation prompts; one for each newline.
+ (sql-interactive-mode): Set up new variables, prompt regexp and
+ output filter.
+ (sql-mode-sqlite-font-lock-keywords): Correct some keywords.
+ (sql-make-alternate-buffer-name): Correct buffer name in edge cases.
+
2010-08-10 Stefan Monnier <[email protected]>
* emacs-lisp/pcase.el: New file.
@@ -79,7 +1602,7 @@
(ctext-standard-encodings): New variable.
(ctext-non-standard-encodings-table): List only elements for
non-standard encodings.
- (ctext-pre-write-conversion): Adjusted for the above change.
+ (ctext-pre-write-conversion): Adjust for the above change.
Check ctext-standard-encodings.
* international/mule-conf.el (compound-text): Doc fix.
@@ -132,7 +1655,7 @@
* align.el (align-default-spacing): Doc fix.
(align-region-heuristic, align-regexp): Fix typos in docstrings.
-2010-08-08 Stephen Peters <[email protected]>
+2010-08-08 Stephen Peters <[email protected]>
* calendar/icalendar.el
(icalendar--split-value): Fixed splitting regexp. (Bug#6766)
@@ -2968,7 +4491,8 @@
* minibuffer.el (tags-completion-at-point-function): New function.
(completion-at-point-functions): Use it.
- * cedet/semantic.el (semantic-completion-at-point-function): New function.
+ * cedet/semantic.el (semantic-completion-at-point-function):
+ New function.
(semantic-mode): Use semantic-completion-at-point-function for
completion-at-point-functions instead.
@@ -3018,8 +4542,8 @@
2010-04-28 Chong Yidong <[email protected]>
- * progmodes/bug-reference.el (bug-reference-url-format): Revert
- 2010-04-27 change due to security risk.
+ * progmodes/bug-reference.el (bug-reference-url-format):
+ Revert 2010-04-27 change due to security risk.
2010-04-28 Stefan Monnier <[email protected]>
@@ -3194,8 +4718,7 @@
* ido.el (ido-init-completion-maps): For ido-switch-buffer, C-o
toggles the use of virtual buffers.
- (ido-buffer-internal): Guard `ido-use-virtual-buffers' global
- value.
+ (ido-buffer-internal): Guard `ido-use-virtual-buffers' global value.
(ido-toggle-virtual-buffers): New function.
2010-04-21 Juanma Barranquero <[email protected]>
@@ -3772,7 +5295,7 @@
Enable recentf-mode if using virtual buffers.
* ido.el (recentf-list): Declare for byte-compiler.
- (ido-virtual-buffers): Move up to silence byte-compiler. Add docstring.
+ (ido-virtual-buffers): Move up to silence byte-compiler. Add docstring.
(ido-make-buffer-list): Simplify.
(ido-add-virtual-buffers-to-list): Simplify. Enable recentf-mode.
@@ -5283,8 +6806,8 @@
2010-01-21 Alan Mackenzie <[email protected]>
Fix a situation where deletion of a cpp construct throws an error.
- * progmodes/cc-engine.el (c-invalidate-state-cache): Before
- invoking c-with-all-but-one-cpps-commented-out, check that the
+ * progmodes/cc-engine.el (c-invalidate-state-cache):
+ Before invoking c-with-all-but-one-cpps-commented-out, check that the
special cpp construct is still in the buffer.
(c-parse-state): Record the special cpp with markers, not numbers.
@@ -6011,7 +7534,7 @@
* ps-print.el (ps-face-attributes): It was not returning the
attribute face for faces specified as string. Reported by harven
+ <[email protected]>. (Bug#5254)
(ps-print-version): New version 7.3.5.
2009-12-18 Ulf Jasper <[email protected]>
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index e6f2a66ec8..391375b2d1 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -33,10 +33,9 @@ VPATH = $(srcdir)
# to use an absolute file name.
EMACS = ${abs_top_builddir}/src/emacs
-# Command line flags for Emacs. This must include --multibyte,
-# otherwise some files will not compile.
+# Command line flags for Emacs.
-EMACSOPT = -batch --no-site-file --multibyte
+EMACSOPT = -batch --no-site-file
# Extra flags to pass to the byte compiler
BYTE_COMPILE_EXTRA_FLAGS =
@@ -57,7 +56,8 @@ ETAGS = ../lib-src/etags
LOADDEFS = $(lisp)/calendar/cal-loaddefs.el \
$(lisp)/calendar/diary-loaddefs.el \
$(lisp)/calendar/hol-loaddefs.el \
- $(lisp)/mh-e/mh-loaddefs.el
+ $(lisp)/mh-e/mh-loaddefs.el \
+ $(lisp)/net/tramp-loaddefs.el
# Elisp files auto-generated.
AUTOGENEL = loaddefs.el \
@@ -340,6 +340,24 @@ $(MH_E_DIR)/mh-loaddefs.el: $(MH_E_SRC)
--eval "(setq make-backup-files nil)" \
-f batch-update-autoloads $(MH_E_DIR)
+# Update TRAMP internal autoloads. Maybe we could move trmp*.el into
+# an own subdirectory. OTOH, it does not hurt to keep them in
+# lisp/net.
+TRAMP_DIR = $(lisp)/net
+TRAMP_SRC = $(TRAMP_DIR)/tramp.el $(TRAMP_DIR)/tramp-cache.el \
+ $(TRAMP_DIR)/tramp-cmds.el $(TRAMP_DIR)/tramp-compat.el \
+ $(TRAMP_DIR)/tramp-fish.el $(TRAMP_DIR)/tramp-ftp.el \
+ $(TRAMP_DIR)/tramp-gvfs.el $(TRAMP_DIR)/tramp-gw.el \
+ $(TRAMP_DIR)/tramp-imap.el $(TRAMP_DIR)/tramp-smb.el \
+ $(TRAMP_DIR)/tramp-uu.el $(TRAMP_DIR)/trampver.el
+
+$(TRAMP_DIR)/tramp-loaddefs.el: $(TRAMP_SRC)
+ $(emacs) -l autoload \
+ --eval "(setq generate-autoload-cookie \";;;###tramp-autoload\")" \
+ --eval "(setq generated-autoload-file \"$@\")" \
+ --eval "(setq make-backup-files nil)" \
+ -f batch-update-autoloads $(TRAMP_DIR)
+
CAL_DIR = $(lisp)/calendar
## Those files that may contain internal calendar autoload cookies.
## Avoids circular dependency warning for *-loaddefs.el.
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index a1fc3f90bf..6e48360587 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -5,6 +5,7 @@
;; Maintainer: FSF
;; Keywords: abbrev convenience
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/abbrevlist.el b/lisp/abbrevlist.el
index bf51a3dc41..5f9cbee2cf 100644
--- a/lisp/abbrevlist.el
+++ b/lisp/abbrevlist.el
@@ -6,6 +6,7 @@
;; Maintainer: FSF
;; Keywords: abbrev
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/align.el b/lisp/align.el
index 9d81132702..0812d36287 100644
--- a/lisp/align.el
+++ b/lisp/align.el
@@ -1,7 +1,7 @@
;;; align.el --- align text to a specific column, by regexp
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+;; 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: John Wiegley <[email protected]>
;; Maintainer: FSF
@@ -944,6 +944,8 @@ region, call `align-regexp' and type in that regular expression."
(list (concat "\\(\\s-*\\)"
(read-string "Align regexp: "))
1 align-default-spacing nil))))
+ (or group (setq group 1))
+ (or spacing (setq spacing align-default-spacing))
(let ((rule
(list (list nil (cons 'regexp regexp)
(cons 'group (abs group))
diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index 00162c9921..6bc95fa8d9 100644
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -244,9 +244,9 @@ A possible way to install this would be:
(when (boundp 'font-lock-syntactic-keywords)
(remove-text-properties beg end '(syntax-table nil)))
;; instead of just using (remove-text-properties beg end '(face
- ;; nil)), we find regions with a non-nil face test-property, skip
+ ;; nil)), we find regions with a non-nil face text-property, skip
;; positions with the ansi-color property set, and remove the
- ;; remaining face test-properties.
+ ;; remaining face text-properties.
(while (setq beg (text-property-not-all beg end 'face nil))
(setq beg (or (text-property-not-all beg end 'ansi-color t) end))
(when (get-text-property beg 'face)
diff --git a/lisp/apropos.el b/lisp/apropos.el
index 09de0c08e1..d62721e157 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -6,6 +6,7 @@
;; Author: Joe Wells <[email protected]>
;; Daniel Pfeiffer <[email protected]> (rewrite)
;; Keywords: help
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/bindings.el b/lisp/bindings.el
index eba6bf7a78..d19db2c779 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -6,6 +6,7 @@
;; Maintainer: FSF
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index 9ec78309f9..e0f00d3553 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -5,6 +5,7 @@
;; Maintainer: FSF
;; Keywords: convenience
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/button.el b/lisp/button.el
index 2a9a49c399..c771474da3 100644
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -5,6 +5,7 @@
;;
;; Author: Miles Bader <[email protected]>
;; Keywords: extensions
+;; Package: emacs
;;
;; This file is part of GNU Emacs.
;;
diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el
index 30f15f0490..472133be84 100644
--- a/lisp/calc/calc-aent.el
+++ b/lisp/calc/calc-aent.el
@@ -315,10 +315,24 @@ The value t means abort and give an error message.")
calc-dollar-used 0)))
(calc-handle-whys))))
-(defvar calc-alg-ent-map nil
+(defvar calc-alg-ent-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map minibuffer-local-map)
+ (define-key map "'" 'calcAlg-previous)
+ (define-key map "`" 'calcAlg-edit)
+ (define-key map "\C-m" 'calcAlg-enter)
+ (define-key map "\C-j" 'calcAlg-enter)
+ map)
"The keymap used for algebraic entry.")
-(defvar calc-alg-ent-esc-map nil
+(defvar calc-alg-ent-esc-map
+ (let ((map (make-keymap))
+ (i 33))
+ (set-keymap-parent map esc-map)
+ (while (< i 127)
+ (define-key map (vector i) 'calcAlg-escape)
+ (setq i (1+ i)))
+ map)
"The keymap used for escapes in algebraic entry.")
(defvar calc-alg-exp)
@@ -326,19 +340,8 @@ The value t means abort and give an error message.")
;;;###autoload
(defun calc-do-alg-entry (&optional initial prompt no-normalize history)
(let* ((calc-buffer (current-buffer))
- (blink-paren-function 'calcAlg-blink-matching-open)
+ (blink-matching-check-function 'calcAlg-blink-matching-check)
(calc-alg-exp 'error))
- (unless calc-alg-ent-map
- (setq calc-alg-ent-map (copy-keymap minibuffer-local-map))
- (define-key calc-alg-ent-map "'" 'calcAlg-previous)
- (define-key calc-alg-ent-map "`" 'calcAlg-edit)
- (define-key calc-alg-ent-map "\C-m" 'calcAlg-enter)
- (define-key calc-alg-ent-map "\C-j" 'calcAlg-enter)
- (let ((i 33))
- (setq calc-alg-ent-esc-map (copy-keymap esc-map))
- (while (< i 127)
- (aset (nth 1 calc-alg-ent-esc-map) i 'calcAlg-escape)
- (setq i (1+ i)))))
(define-key calc-alg-ent-map "\e" nil)
(if (eq calc-algebraic-mode 'total)
(define-key calc-alg-ent-map "\e" calc-alg-ent-esc-map)
@@ -430,18 +433,9 @@ The value t means abort and give an error message.")
exp))
(exit-minibuffer))))
-(defun calcAlg-blink-matching-open ()
- (let ((rightpt (point))
- (leftpt nil)
- (rightchar (preceding-char))
- leftchar
- rightsyntax
- leftsyntax)
- (save-excursion
- (condition-case ()
- (setq leftpt (scan-sexps rightpt -1)
- leftchar (char-after leftpt))
- (error nil)))
+(defun calcAlg-blink-matching-check (leftpt rightpt)
+ (let ((rightchar (char-before rightpt))
+ (leftchar (if leftpt (char-after leftpt))))
(if (and leftpt
(or (and (= rightchar ?\))
(= leftchar ?\[))
@@ -450,20 +444,9 @@ The value t means abort and give an error message.")
(save-excursion
(goto-char leftpt)
(looking-at ".+\\(\\.\\.\\|\\\\dots\\|\\\\ldots\\)")))
- (let ((leftsaved (aref (syntax-table) leftchar))
- (rightsaved (aref (syntax-table) rightchar)))
- (unwind-protect
- (progn
- (cond ((= leftchar ?\[)
- (aset (syntax-table) leftchar (cons 4 ?\)))
- (aset (syntax-table) rightchar (cons 5 ?\[)))
- (t
- (aset (syntax-table) leftchar (cons 4 ?\]))
- (aset (syntax-table) rightchar (cons 5 ?\())))
- (blink-matching-open))
- (aset (syntax-table) leftchar leftsaved)
- (aset (syntax-table) rightchar rightsaved)))
- (blink-matching-open))))
+ ;; [2..5) perfectly valid!
+ nil
+ (blink-matching-check-mismatch leftpt rightpt))))
;;;###autoload
(defun calc-alg-digit-entry ()
diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el
index 7fcaab9da3..ad36531bb4 100644
--- a/lisp/calendar/appt.el
+++ b/lisp/calendar/appt.el
@@ -6,6 +6,7 @@
;; Author: Neil Mager <[email protected]>
;; Maintainer: Glenn Morris <[email protected]>
;; Keywords: calendar
+;; Package: calendar
;; This file is part of GNU Emacs.
diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el
index 7270d42340..7b8f61a7a8 100644
--- a/lisp/calendar/cal-bahai.el
+++ b/lisp/calendar/cal-bahai.el
@@ -6,6 +6,7 @@
;; Author: John Wiegley <[email protected]>
;; Keywords: calendar
;; Human-Keywords: Bahá'í calendar, Bahá'í, Baha'i, Bahai, calendar, diary
+;; Package: calendar
;; This file is part of GNU Emacs.
diff --git a/lisp/calendar/cal-china.el b/lisp/calendar/cal-china.el
index f9946c1804..0fc63e7eaa 100644
--- a/lisp/calendar/cal-china.el
+++ b/lisp/calendar/cal-china.el
@@ -7,6 +7,7 @@
;; Maintainer: Glenn Morris <[email protected]>
;; Keywords: calendar
;; Human-Keywords: Chinese calendar, calendar, holidays, diary
+;; Package: calendar
;; This file is part of GNU Emacs.
diff --git a/lisp/calendar/cal-coptic.el b/lisp/calendar/cal-coptic.el
index 16cc667272..69612edab3 100644
--- a/lisp/calendar/cal-coptic.el
+++ b/lisp/calendar/cal-coptic.el
@@ -7,6 +7,7 @@
;; Maintainer: Glenn Morris <[email protected]>
;; Keywords: calendar
;; Human-Keywords: Coptic calendar, Ethiopic calendar, calendar, diary
+;; Package: calendar
;; This file is part of GNU Emacs.
diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el
index c541caa569..d27bc8480a 100644
--- a/lisp/calendar/cal-dst.el
+++ b/lisp/calendar/cal-dst.el
@@ -8,6 +8,7 @@
;; Maintainer: Glenn Morris <[email protected]>
;; Keywords: calendar
;; Human-Keywords: daylight saving time, calendar, diary, holidays
+;; Package: calendar
;; This file is part of GNU Emacs.
diff --git a/lisp/calendar/cal-french.el b/lisp/calendar/cal-french.el
index 9b252eb3dc..98a118f232 100644
--- a/lisp/calendar/cal-french.el
+++ b/lisp/calendar/cal-french.el
@@ -8,6 +8,7 @@
;; Maintainer: Glenn Morris <[email protected]>
;; Keywords: calendar
;; Human-Keywords: French Revolutionary calendar, calendar, diary
+;; Package: calendar
;; This file is part of GNU Emacs.
diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el
index 2a7556ff32..98c1a29df7 100644
--- a/lisp/calendar/cal-hebrew.el
+++ b/lisp/calendar/cal-hebrew.el
@@ -8,6 +8,7 @@
;; Maintainer: Glenn Morris <[email protected]>
;; Keywords: calendar
;; Human-Keywords: Hebrew calendar, calendar, diary
+;; Package: calendar
;; This file is part of GNU Emacs.
diff --git a/lisp/calendar/cal-html.el b/lisp/calendar/cal-html.el
index 33066b201b..d421002760 100644
--- a/lisp/calendar/cal-html.el
+++ b/lisp/calendar/cal-html.el
@@ -7,6 +7,7 @@
;; Keywords: calendar
;; Human-Keywords: calendar, diary, HTML
;; Created: 23 Aug 2002
+;; Package: calendar
;; This file is part of GNU Emacs.
diff --git a/lisp/calendar/cal-islam.el b/lisp/calendar/cal-islam.el
index 1c09f1db11..da631a9710 100644
--- a/lisp/calendar/cal-islam.el
+++ b/lisp/calendar/cal-islam.el
@@ -7,6 +7,7 @@
;; Maintainer: Glenn Morris <[email protected]>
;; Keywords: calendar
;; Human-Keywords: Islamic calendar, calendar, diary
+;; Package: calendar
;; This file is part of GNU Emacs.
diff --git a/lisp/calendar/cal-iso.el b/lisp/calendar/cal-iso.el
index 0762860b0b..3c5055defb 100644
--- a/lisp/calendar/cal-iso.el
+++ b/lisp/calendar/cal-iso.el
@@ -7,6 +7,7 @@
;; Maintainer: Glenn Morris <[email protected]>
;; Keywords: calendar
;; Human-Keywords: ISO calendar, calendar, diary
+;; Package: calendar
;; This file is part of GNU Emacs.
diff --git a/lisp/calendar/cal-julian.el b/lisp/calendar/cal-julian.el
index d1cea19be4..0cf9388a4b 100644
--- a/lisp/calendar/cal-julian.el
+++ b/lisp/calendar/cal-julian.el
@@ -7,6 +7,7 @@
;; Maintainer: Glenn Morris <[email protected]>
;; Keywords: calendar
;; Human-Keywords: Julian calendar, Julian day number, calendar, diary
+;; Package: calendar
;; This file is part of GNU Emacs.
diff --git a/lisp/calendar/cal-mayan.el b/lisp/calendar/cal-mayan.el
index de079b122c..d2e4810fa8 100644
--- a/lisp/calendar/cal-mayan.el
+++ b/lisp/calendar/cal-mayan.el
@@ -8,6 +8,7 @@
;; Maintainer: Glenn Morris <[email protected]>
;; Keywords: calendar
;; Human-Keywords: Mayan calendar, Maya, calendar, diary
+;; Package: calendar
;; This file is part of GNU Emacs.
diff --git a/lisp/calendar/cal-menu.el b/lisp/calendar/cal-menu.el
index 521cd2dce2..877be9556f 100644
--- a/lisp/calendar/cal-menu.el
+++ b/lisp/calendar/cal-menu.el
@@ -8,6 +8,7 @@
;; Maintainer: Glenn Morris <[email protected]>
;; Keywords: calendar
;; Human-Keywords: calendar, popup menus, menu bar
+;; Package: calendar
;; This file is part of GNU Emacs.
diff --git a/lisp/calendar/cal-move.el b/lisp/calendar/cal-move.el
index 89e45bef77..e569e8c424 100644
--- a/lisp/calendar/cal-move.el
+++ b/lisp/calendar/cal-move.el
@@ -7,6 +7,7 @@
;; Maintainer: Glenn Morris <[email protected]>
;; Keywords: calendar
;; Human-Keywords: calendar
+;; Package: calendar
;; This file is part of GNU Emacs.
diff --git a/lisp/calendar/cal-persia.el b/lisp/calendar/cal-persia.el
index 95ae2f165b..5c624ddcf0 100644
--- a/lisp/calendar/cal-persia.el
+++ b/lisp/calendar/cal-persia.el
@@ -7,6 +7,7 @@
;; Maintainer: Glenn Morris <[email protected]>
;; Keywords: calendar
;; Human-Keywords: Persian calendar, calendar, diary
+;; Package: calendar
;; This file is part of GNU Emacs.
diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el
index 46fb086978..e6ba1ad343 100644
--- a/lisp/calendar/cal-tex.el
+++ b/lisp/calendar/cal-tex.el
@@ -8,6 +8,7 @@
;; Maintainer: Glenn Morris <[email protected]>
;; Keywords: calendar
;; Human-Keywords: Calendar, LaTeX
+;; Package: calendar
;; This file is part of GNU Emacs.
diff --git a/lisp/calendar/cal-x.el b/lisp/calendar/cal-x.el
index 90a4c5d33b..377646147b 100644
--- a/lisp/calendar/cal-x.el
+++ b/lisp/calendar/cal-x.el
@@ -8,6 +8,7 @@
;; Maintainer: Glenn Morris <[email protected]>
;; Keywords: calendar
;; Human-Keywords: calendar, dedicated frames
+;; Package: calendar
;; This file is part of GNU Emacs.
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index 8fb464aa7e..39354bd31e 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -383,14 +383,14 @@ The format of the header is specified by `diary-header-line-format'."
"Some text is hidden - press \"s\" in calendar \
before edit/copy"
"Diary"))
- ?\s (frame-width)))
+ ?\s (window-width)))
"Format of the header line displayed by `diary-simple-display'.
Only used if `diary-header-line-flag' is non-nil."
:group 'diary
:type 'sexp
:initialize 'custom-initialize-default
:set 'diary-set-header
- :version "22.1")
+ :version "23.3") ; frame-width -> window-width
;; The first version of this also checked for diary-selective-display
;; in the non-fancy case. This was an attempt to distinguish between
diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el
index 0cafc85a24..af61fdf149 100644
--- a/lisp/calendar/holidays.el
+++ b/lisp/calendar/holidays.el
@@ -6,6 +6,7 @@
;; Author: Edward M. Reingold <[email protected]>
;; Maintainer: Glenn Morris <[email protected]>
;; Keywords: holidays, calendar
+;; Package: calendar
;; This file is part of GNU Emacs.
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index 2dcf75758c..0be138906b 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -7,6 +7,7 @@
;; Created: August 2002
;; Keywords: calendar
;; Human-Keywords: calendar, diary, iCalendar, vCalendar
+;; Version: 0.19
;; This file is part of GNU Emacs.
@@ -2092,6 +2093,7 @@ END-T is the event's end time in diary format."
(format "(diary-cyclic %d %s) "
(* interval 7)
dtstart-conv))
+ dtstart-conv
(if count until-1-conv until-conv)
))
(setq result
diff --git a/lisp/calendar/lunar.el b/lisp/calendar/lunar.el
index 37a6888885..58111a036d 100644
--- a/lisp/calendar/lunar.el
+++ b/lisp/calendar/lunar.el
@@ -7,6 +7,7 @@
;; Maintainer: Glenn Morris <[email protected]>
;; Keywords: calendar
;; Human-Keywords: moon, lunar phases, calendar, diary
+;; Package: calendar
;; This file is part of GNU Emacs.
diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el
index fd62d909f3..71e32b9db4 100644
--- a/lisp/calendar/parse-time.el
+++ b/lisp/calendar/parse-time.el
@@ -220,5 +220,4 @@ unknown are returned as nil."
(provide 'parse-time)
-;; arch-tag: 07066094-45a8-4c68-b307-86195e2c1103
;;; parse-time.el ends here
diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el
index 3d6ab73e77..8cf831f994 100644
--- a/lisp/calendar/solar.el
+++ b/lisp/calendar/solar.el
@@ -8,6 +8,7 @@
;; Maintainer: Glenn Morris <[email protected]>
;; Keywords: calendar
;; Human-Keywords: sunrise, sunset, equinox, solstice, calendar, diary, holidays
+;; Package: calendar
;; This file is part of GNU Emacs.
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index 914d2d3392..d99d13e431 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -364,5 +364,4 @@ This function does not work for SECONDS greater than `most-positive-fixnum'."
(provide 'time-date)
-;; arch-tag: addcf07b-b20a-465b-af72-550b8ac5190f
;;; time-date.el ends here
diff --git a/lisp/case-table.el b/lisp/case-table.el
index 53d30bf281..1e5974d7d1 100644
--- a/lisp/case-table.el
+++ b/lisp/case-table.el
@@ -6,6 +6,7 @@
;; Author: Howard Gayle
;; Maintainer: FSF
;; Keywords: i18n
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/cedet/cedet-cscope.el b/lisp/cedet/cedet-cscope.el
index bff80222f7..18cb7071d5 100644
--- a/lisp/cedet/cedet-cscope.el
+++ b/lisp/cedet/cedet-cscope.el
@@ -3,6 +3,7 @@
;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <[email protected]>
+;; Package: cedet
;; This file is part of GNU Emacs.
diff --git a/lisp/cedet/cedet-files.el b/lisp/cedet/cedet-files.el
index 9dacf06228..bb7137ddad 100644
--- a/lisp/cedet/cedet-files.el
+++ b/lisp/cedet/cedet-files.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <[email protected]>
+;; Package: cedet
;; This file is part of GNU Emacs.
diff --git a/lisp/cedet/cedet-global.el b/lisp/cedet/cedet-global.el
index 3a34ca44e2..b98bd31693 100644
--- a/lisp/cedet/cedet-global.el
+++ b/lisp/cedet/cedet-global.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <[email protected]>
+;; Package: cedet
;; This file is part of GNU Emacs.
diff --git a/lisp/cedet/cedet-idutils.el b/lisp/cedet/cedet-idutils.el
index 562749dda0..44c325b78c 100644
--- a/lisp/cedet/cedet-idutils.el
+++ b/lisp/cedet/cedet-idutils.el
@@ -5,6 +5,7 @@
;; Author: Eric M. Ludlam <[email protected]>
;; Version: 0.2
;; Keywords: OO, lisp
+;; Package: cedet
;; This file is part of GNU Emacs.
diff --git a/lisp/cedet/cedet.el b/lisp/cedet/cedet.el
index b15745aac7..6a6d09fda6 100644
--- a/lisp/cedet/cedet.el
+++ b/lisp/cedet/cedet.el
@@ -5,7 +5,7 @@
;; Author: David Ponce <[email protected]>
;; Maintainer: Eric M. Ludlam <[email protected]>
-;; Version: 0.2
+;; Version: 1.0pre7
;; Keywords: OO, lisp
;; This file is part of GNU Emacs.
diff --git a/lisp/cedet/data-debug.el b/lisp/cedet/data-debug.el
index ed8441d2df..f48de002fe 100644
--- a/lisp/cedet/data-debug.el
+++ b/lisp/cedet/data-debug.el
@@ -5,6 +5,7 @@
;; Author: Eric M. Ludlam <[email protected]>
;; Version: 0.2
;; Keywords: OO, lisp
+;; Package: cedet
;; This file is part of GNU Emacs.
diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el
index 46fcdb000f..807c779766 100644
--- a/lisp/cedet/ede.el
+++ b/lisp/cedet/ede.el
@@ -5,6 +5,7 @@
;; Author: Eric M. Ludlam <[email protected]>
;; Keywords: project, make
+;; Version: 1.0pre7
;; This file is part of GNU Emacs.
diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el
index 99e594a463..f5d3f54f20 100644
--- a/lisp/cedet/semantic.el
+++ b/lisp/cedet/semantic.el
@@ -4,7 +4,8 @@
;; 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <[email protected]>
-;; Keywords: syntax
+;; Keywords: syntax tools
+;; Version: 2.0pre7
;; This file is part of GNU Emacs.
diff --git a/lisp/cedet/srecode.el b/lisp/cedet/srecode.el
index a903ffd0af..d6c218f2b5 100644
--- a/lisp/cedet/srecode.el
+++ b/lisp/cedet/srecode.el
@@ -4,6 +4,7 @@
;; Author: Eric M. Ludlam <[email protected]>
;; Keywords: codegeneration
+;; Version: 1.0pre7
;; This file is part of GNU Emacs.
diff --git a/lisp/comint.el b/lisp/comint.el
index 128965fc11..641be4f4d2 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -8,6 +8,7 @@
;; Simon Marshall <[email protected]>
;; Maintainer: FSF
;; Keywords: processes
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/composite.el b/lisp/composite.el
index d886be5a46..1ecfec86b5 100644
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -8,6 +8,7 @@
;; Author: Kenichi HANDA <[email protected]>
;; (according to ack.texi)
;; Keywords: mule, multilingual, character composition
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -412,27 +413,6 @@ after a sequence of character events."
;;; Automatic character composition.
-;; Copied from font-lock.el.
-(eval-when-compile
- ;; Borrowed from lazy-lock.el.
- ;; We use this to preserve or protect things when modifying text properties.
- (defmacro save-buffer-state (varlist &rest body)
- "Bind variables according to VARLIST and eval BODY restoring buffer state."
- `(let* ,(append varlist
- '((modified (buffer-modified-p)) (buffer-undo-list t)
- (inhibit-read-only t) (inhibit-point-motion-hooks t)
- (inhibit-modification-hooks t)
- deactivate-mark buffer-file-name buffer-file-truename))
- ,@body
- (unless modified
- (restore-buffer-modified-p nil))))
- ;; Fixme: This makes bootstrapping fail with this error.
- ;; Symbol's function definition is void: eval-defun
- ;;(def-edebug-spec save-buffer-state let)
- )
-
-(put 'save-buffer-state 'lisp-indent-function 1)
-
;; These macros must match with C macros LGSTRING_XXX and LGLYPH_XXX in font.h
(defsubst lgstring-header (gstring) (aref gstring 0))
(defsubst lgstring-set-header (gstring header) (aset gstring 0 header))
diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el
index 249dd51acd..230410772a 100644
--- a/lisp/cus-dep.el
+++ b/lisp/cus-dep.el
@@ -5,6 +5,7 @@
;;
;; Author: Per Abrahamsen <[email protected]>
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index bb2f67422e..a333be289e 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -6,6 +6,7 @@
;; Author: Per Abrahamsen <[email protected]>
;; Maintainer: FSF
;; Keywords: help, faces
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -4097,8 +4098,8 @@ If GROUPS-ONLY non-nil, return only those members that are groups."
(custom-group-state-update widget)
(progress-reporter-done reporter))
;; End line
- (let ((p (point)))
- (insert "\n")
+ (let ((p (1+ (point))))
+ (insert "\n\n")
(put-text-property p (1+ p) 'face '(:underline t))
(overlay-put (make-overlay p (1+ p))
'before-string
@@ -4404,10 +4405,10 @@ This function does not save the buffer."
(unless (bolp)
(princ "\n"))
(princ "(custom-set-variables
- ;; custom-set-variables was added by Custom.
- ;; If you edit it by hand, you could mess it up, so be careful.
- ;; Your init file should contain only one such instance.
- ;; If there is more than one, they won't work right.\n")
+ ;; custom-set-variables was added by Custom.
+ ;; If you edit it by hand, you could mess it up, so be careful.
+ ;; Your init file should contain only one such instance.
+ ;; If there is more than one, they won't work right.\n")
(dolist (symbol saved-list)
(let ((spec (car-safe (get symbol 'theme-value)))
(value (get symbol 'saved-value))
@@ -4480,10 +4481,10 @@ This function does not save the buffer."
(unless (bolp)
(princ "\n"))
(princ "(custom-set-faces
- ;; custom-set-faces was added by Custom.
- ;; If you edit it by hand, you could mess it up, so be careful.
- ;; Your init file should contain only one such instance.
- ;; If there is more than one, they won't work right.\n")
+ ;; custom-set-faces was added by Custom.
+ ;; If you edit it by hand, you could mess it up, so be careful.
+ ;; Your init file should contain only one such instance.
+ ;; If there is more than one, they won't work right.\n")
(dolist (symbol saved-list)
(let ((spec (car-safe (get symbol 'theme-face)))
(value (get symbol 'saved-face))
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index 5cb808c2e3..f6a07507f2 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -5,6 +5,7 @@
;;
;; Author: Per Abrahamsen <[email protected]>
;; Keywords: help, faces
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 10214d39a0..161de5e78e 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -5,6 +5,7 @@
;;
;; Author: Per Abrahamsen <[email protected]>
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -198,8 +199,8 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
(help-event-list keyboard (repeat (sexp :format "%v")))
(menu-prompting menu boolean)
(select-active-regions killing
- (choice (const :tag "lazy" lazy)
- (const :tag "always" t)
+ (choice (const :tag "always" t)
+ (const :tag "only shift-selection or mouse-drag" only)
(const :tag "off" nil))
"24.1")
(suggest-key-bindings keyboard (choice (const :tag "off" nil)
diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el
index 0fb6e485de..77ea09cfe9 100644
--- a/lisp/cus-theme.el
+++ b/lisp/cus-theme.el
@@ -6,6 +6,7 @@
;; Author: Alex Schroeder <[email protected]>
;; Maintainer: FSF
;; Keywords: help, faces
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/custom.el b/lisp/custom.el
index 273c67dc66..d6ecc6dfbd 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -6,6 +6,7 @@
;; Author: Per Abrahamsen <[email protected]>
;; Maintainer: FSF
;; Keywords: help, faces
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/desktop.el b/lisp/desktop.el
index 8f0b8075cd..b4d3dfd55c 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -226,7 +226,7 @@ the normal hook `desktop-not-loaded-hook' is run."
The base name of the file is specified in `desktop-base-file-name'."
:type '(repeat directory)
:group 'desktop
- :version "22.1")
+ :version "23.2") ; user-emacs-directory added
(defcustom desktop-missing-file-warning nil
"If non-nil, offer to recreate the buffer of a deleted file.
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 62d6928c02..f4b79414c6 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -6,6 +6,7 @@
;; Author: Sebastian Kremer <[email protected]>.
;; Maintainer: FSF
;; Keywords: files
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 2dc7475e9e..45fdda7135 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -7,6 +7,7 @@
;; Lawrence R. Dodd <[email protected]>
;; Maintainer: Romain Francoise <[email protected]>
;; Keywords: dired extensions files
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/dired.el b/lisp/dired.el
index fa3a15b97b..3fdb82ca7d 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -7,6 +7,7 @@
;; Author: Sebastian Kremer <[email protected]>
;; Maintainer: FSF
;; Keywords: files
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -3248,12 +3249,16 @@ variable `dired-listing-switches'. To temporarily override the listing
format, use `\\[universal-argument] \\[dired]'.")
(defvar dired-sort-by-date-regexp
- (concat "^-[^" dired-ls-sorting-switches
- "]*t[^" dired-ls-sorting-switches "]*$")
+ (concat "\\(\\`\\| \\)-[^- ]*t"
+ ;; `dired-ls-sorting-switches' after -t overrides -t.
+ "[^ " dired-ls-sorting-switches "]*"
+ "\\(\\(\\`\\| +\\)\\(--[^ ]+\\|-[^- t"
+ dired-ls-sorting-switches "]+\\)\\)* *$")
"Regexp recognized by Dired to set `by date' mode.")
(defvar dired-sort-by-name-regexp
- (concat "^-[^t" dired-ls-sorting-switches "]+$")
+ (concat "\\`\\(\\(\\`\\| +\\)\\(--[^ ]+\\|"
+ "-[^- t" dired-ls-sorting-switches "]+\\)\\)* *$")
"Regexp recognized by Dired to set `by name' mode.")
(defvar dired-sort-inhibit nil
@@ -3279,8 +3284,8 @@ The idea is to set this buffer-locally in special dired buffers.")
(force-mode-line-update)))
(defun dired-sort-toggle-or-edit (&optional arg)
- "Toggle between sort by date/name and refresh the dired buffer.
-With a prefix argument you can edit the current listing switches instead."
+ "Toggle sorting by date, and refresh the Dired buffer.
+With a prefix argument, edit the current listing switches instead."
(interactive "P")
(when dired-sort-inhibit
(error "Cannot sort this dired buffer"))
@@ -3291,24 +3296,24 @@ With a prefix argument you can edit the current listing switches instead."
(defun dired-sort-toggle ()
;; Toggle between sort by date/name. Reverts the buffer.
- (setq dired-actual-switches
- (let (case-fold-search)
- (if (string-match " " dired-actual-switches)
- ;; New toggle scheme: add/remove a trailing " -t"
- (if (string-match " -t\\'" dired-actual-switches)
- (substring dired-actual-switches 0 (match-beginning 0))
- (concat dired-actual-switches " -t"))
- ;; old toggle scheme: look for some 't' switch and add/remove it
- (concat
- "-l"
- (dired-replace-in-string (concat "[-lt"
- dired-ls-sorting-switches "]")
- ""
- dired-actual-switches)
- (if (string-match (concat "[t" dired-ls-sorting-switches "]")
- dired-actual-switches)
- ""
- "t")))))
+ (let ((sorting-by-date (string-match dired-sort-by-date-regexp
+ dired-actual-switches))
+ ;; Regexp for finding (possibly embedded) -t switches.
+ (switch-regexp "\\(\\`\\| \\)-\\([a-su-zA-Z]*\\)\\(t\\)\\([^ ]*\\)")
+ case-fold-search)
+ ;; Remove the -t switch.
+ (while (string-match switch-regexp dired-actual-switches)
+ (if (and (equal (match-string 2 dired-actual-switches) "")
+ (equal (match-string 4 dired-actual-switches) ""))
+ ;; Remove a stand-alone -t switch.
+ (setq dired-actual-switches
+ (replace-match "" t t dired-actual-switches))
+ ;; Remove a switch of the form -XtY for some X and Y.
+ (setq dired-actual-switches
+ (replace-match "" t t dired-actual-switches 3))))
+ ;; Now, if we weren't sorting by date before, add the -t switch.
+ (unless sorting-by-date
+ (setq dired-actual-switches (concat dired-actual-switches " -t"))))
(dired-sort-set-modeline)
(revert-buffer))
@@ -3534,7 +3539,7 @@ Ask means pop up a menu for the user to select one of copy, move or link."
;;;;;; dired-run-shell-command dired-do-shell-command dired-do-async-shell-command
;;;;;; dired-clean-directory dired-do-print dired-do-touch dired-do-chown
;;;;;; dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff
-;;;;;; dired-diff) "dired-aux" "dired-aux.el" "07676ea25af17f5d50cc5db4f53bddc0")
+;;;;;; dired-diff) "dired-aux" "dired-aux.el" "416d272299fd4774c47c2f677ee640a4")
;;; Generated autoloads from dired-aux.el
(autoload 'dired-diff "dired-aux" "\
@@ -3987,7 +3992,7 @@ true then the type of the file linked to by FILE is printed instead.
;;;***
;;;### (autoloads (dired-do-relsymlink dired-jump) "dired-x" "dired-x.el"
-;;;;;; "6c492aba3ca0d36a4cd7b02fb9c1cc10")
+;;;;;; "27c312d6d5d40d8cb4ef8d62e30d5f4a")
;;; Generated autoloads from dired-x.el
(autoload 'dired-jump "dired-x" "\
diff --git a/lisp/disp-table.el b/lisp/disp-table.el
index 286c8f319f..e9bdd3d9be 100644
--- a/lisp/disp-table.el
+++ b/lisp/disp-table.el
@@ -7,6 +7,7 @@
;; Based on a previous version by Howard Gayle
;; Maintainer: FSF
;; Keywords: i18n
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -109,11 +110,27 @@ Valid symbols are `truncation', `wrap', `escape', `control',
;;;###autoload
(defun standard-display-8bit (l h)
- "Display characters in the range L to H literally."
+ "Display characters representing raw bytes in the range L to H literally.
+
+On a terminal display, each character in the range is displayed
+by sending the corresponding byte directly to the terminal.
+
+On a graphic display, each character in the range is displayed
+using the default font by a glyph whose code is the corresponding
+byte.
+
+Note that ASCII printable characters (SPC to TILDA) are displayed
+in the default way after this call."
(or standard-display-table
(setq standard-display-table (make-display-table)))
+ (if (> h 255)
+ (setq h 255))
(while (<= l h)
- (aset standard-display-table l (if (or (< l ?\s) (>= l 127)) (vector l)))
+ (if (< l 128)
+ (aset standard-display-table l
+ (if (or (< l ?\s) (= l 127)) (vector l)))
+ (let ((c (unibyte-char-to-multibyte l)))
+ (aset standard-display-table c (vector c))))
(setq l (1+ l))))
;;;###autoload
@@ -235,9 +252,12 @@ in `.emacs'."
(and (null arg)
(char-table-p standard-display-table)
;; Test 161, because 160 displays as a space.
- (equal (aref standard-display-table 161) [161])))
+ (equal (aref standard-display-table
+ (unibyte-char-to-multibyte 161))
+ (vector (unibyte-char-to-multibyte 161)))))
(progn
- (standard-display-default 160 255)
+ (standard-display-default
+ (unibyte-char-to-multibyte 160) (unibyte-char-to-multibyte 255))
(unless (or (memq window-system '(x w32 ns)))
(and (terminal-coding-system)
(set-terminal-coding-system nil))))
diff --git a/lisp/dnd.el b/lisp/dnd.el
index d7cbb641ba..7b9d0c0786 100644
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -6,6 +6,7 @@
;; Author: Jan Djärv <[email protected]>
;; Maintainer: FSF
;; Keywords: window, drag, drop
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/dos-fns.el b/lisp/dos-fns.el
index e343446a36..b840319113 100644
--- a/lisp/dos-fns.el
+++ b/lisp/dos-fns.el
@@ -5,6 +5,7 @@
;; Maintainer: Morten Welinder <[email protected]>
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/dos-vars.el b/lisp/dos-vars.el
index 8af147e78f..e153df3e74 100644
--- a/lisp/dos-vars.el
+++ b/lisp/dos-vars.el
@@ -5,6 +5,7 @@
;; Maintainer: FSF
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/dos-w32.el b/lisp/dos-w32.el
index 424ea0a701..0962ae5f13 100644
--- a/lisp/dos-w32.el
+++ b/lisp/dos-w32.el
@@ -5,6 +5,7 @@
;; Maintainer: Geoff Voelker <[email protected]>
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/dynamic-setting.el b/lisp/dynamic-setting.el
index f61a0078e1..cfa1053c44 100644
--- a/lisp/dynamic-setting.el
+++ b/lisp/dynamic-setting.el
@@ -5,6 +5,7 @@
;; Author: Jan Djärv <[email protected]>
;; Maintainer: FSF
;; Keywords: font, system-font, tool-bar-style
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -96,6 +97,11 @@ Changes can be
((eq type 'font-render)
(font-setting-change-default-font display-name nil))
+ ;; This is a bit heavy, ideally we would just clear faces
+ ;; on the affected display, and perhaps only the relevant
+ ;; faces. Oh well.
+ ((eq type 'theme-name) (clear-face-cache))
+
((eq type 'tool-bar-style) (force-mode-line-update t)))))
(define-key special-event-map [config-changed-event]
diff --git a/lisp/electric.el b/lisp/electric.el
index fb3e462efb..8e9d23be23 100644
--- a/lisp/electric.el
+++ b/lisp/electric.el
@@ -24,10 +24,23 @@
;;; Commentary:
-; zaaaaaaap
+;; "Electric" has been used in Emacs to refer to different things.
+;; Among them:
+;;
+;; - electric modes and buffers: modes that typically pop-up in a modal kind of
+;; way a transient buffer that automatically disappears as soon as the user
+;; is done with it.
+;;
+;; - electric keys: self inserting keys which additionally perform some side
+;; operation which happens to be often convenient at that time. Examples of
+;; such side operations are: reindenting code, inserting a newline,
+;; ... auto-fill-mode and abbrev-mode can be considered as built-in forms of
+;; electric key behavior.
;;; Code:
+(eval-when-compile (require 'cl))
+
;; This loop is the guts for non-standard modes which retain control
;; until some event occurs. It is a `do-forever', the only way out is
;; to throw. It assumes that you have set up the keymap, window, and
@@ -157,6 +170,135 @@
(fit-window-to-buffer win max-height))
win)))
+;;; Electric keys.
+
+(defgroup electricity ()
+ "Electric behavior for self inserting keys."
+ :group 'editing)
+
+;; Electric indentation.
+
+(defvar electric-indent-chars '(?\n)
+ "Characters that should cause automatic reindentation.")
+
+(defun electric-indent-post-self-insert-function ()
+ ;; FIXME: This reindents the current line, but what we really want instead is
+ ;; to reindent the whole affected text. That's the current line for simple
+ ;; cases, but not all cases. We do take care of the newline case in an
+ ;; ad-hoc fashion, but there are still missing cases such as the case of
+ ;; electric-pair-mode wrapping a region with a pair of parens.
+ ;; There might be a way to get it working by analyzing buffer-undo-list, but
+ ;; it looks challenging.
+ (when (and (memq last-command-event electric-indent-chars)
+ ;; Don't reindent while inserting spaces at beginning of line.
+ (or (not (memq last-command-event '(?\s ?\t)))
+ (save-excursion (skip-chars-backward " \t") (not (bolp))))
+ ;; Not in a string or comment.
+ (not (nth 8 (syntax-ppss))))
+ ;; For newline, we want to reindent both lines and basically behave like
+ ;; reindent-then-newline-and-indent (whose code we hence copied).
+ (when (and (eq last-command-event ?\n)
+ ;; Don't reindent the previous line if the indentation function
+ ;; is not a real one.
+ (not (memq indent-line-function
+ '(indent-relative indent-relative-maybe)))
+ ;; Sanity check.
+ (eq (char-before) last-command-event))
+ (let ((pos (copy-marker (1- (point)) t)))
+ (save-excursion
+ (goto-char pos)
+ (indent-according-to-mode)
+ ;; We are at EOL before the call to indent-according-to-mode, and
+ ;; after it we usually are as well, but not always. We tried to
+ ;; address it with `save-excursion' but that uses a normal marker
+ ;; whereas we need `move after insertion', so we do the
+ ;; save/restore by hand.
+ (goto-char pos)
+ ;; Remove the trailing whitespace after indentation because
+ ;; indentation may (re)introduce the whitespace.
+ (delete-horizontal-space t))))
+ (indent-according-to-mode)))
+
+;;;###autoload
+(define-minor-mode electric-indent-mode
+ "Automatically reindent lines of code when inserting particular chars.
+`electric-indent-chars' specifies the set of chars that should cause reindentation."
+ :global t
+ :group 'electricity
+ (if electric-indent-mode
+ (add-hook 'post-self-insert-hook
+ #'electric-indent-post-self-insert-function)
+ (remove-hook 'post-self-insert-hook
+ #'electric-indent-post-self-insert-function)))
+
+;; Electric pairing.
+
+(defcustom electric-pair-skip-self t
+ "If non-nil, skip char instead of inserting a second closing paren.
+When inserting a closing paren character right before the same character,
+just skip that character instead, so that hitting ( followed by ) results
+in \"()\" rather than \"())\".
+This can be convenient for people who find it easier to hit ) than C-f."
+ :type 'boolean)
+
+(defun electric-pair-post-self-insert-function ()
+ (let* ((syntax (and (eq (char-before) last-command-event) ; Sanity check.
+ (char-syntax last-command-event)))
+ ;; FIXME: when inserting the closer, we should maybe use
+ ;; self-insert-command, although it may prove tricky running
+ ;; post-self-insert-hook recursively, and we wouldn't want to trigger
+ ;; blink-matching-open.
+ (closer (if (eq syntax ?\()
+ (cdr (aref (syntax-table) last-command-event))
+ last-command-event)))
+ (cond
+ ;; Wrap a pair around the active region.
+ ((and (memq syntax '(?\( ?\" ?\$)) (use-region-p))
+ (if (> (mark) (point))
+ (goto-char (mark))
+ ;; We already inserted the open-paren but at the end of the region,
+ ;; so we have to remove it and start over.
+ (delete-char -1)
+ (save-excursion
+ (goto-char (mark))
+ (insert last-command-event)))
+ (insert closer))
+ ;; Backslash-escaped: no pairing, no skipping.
+ ((save-excursion
+ (goto-char (1- (point)))
+ (not (zerop (% (skip-syntax-backward "\\") 2))))
+ nil)
+ ;; Skip self.
+ ((and (memq syntax '(?\) ?\" ?\$))
+ electric-pair-skip-self
+ (eq (char-after) last-command-event))
+ ;; This is too late: rather than insert&delete we'd want to only skip (or
+ ;; insert in overwrite mode). The difference is in what goes in the
+ ;; undo-log and in the intermediate state which might be visible to other
+ ;; post-self-insert-hook. We'll just have to live with it for now.
+ (delete-char 1))
+ ;; Insert matching pair.
+ ((not (or (not (memq syntax `(?\( ?\" ?\$)))
+ overwrite-mode
+ ;; I find it more often preferable not to pair when the
+ ;; same char is next.
+ (eq last-command-event (char-after))
+ (eq last-command-event (char-before (1- (point))))
+ ;; I also find it often preferable not to pair next to a word.
+ (eq (char-syntax (following-char)) ?w)))
+ (save-excursion (insert closer))))))
+
+;;;###autoload
+(define-minor-mode electric-pair-mode
+ "Automatically pair-up parens when inserting an open paren."
+ :global t
+ :group 'electricity
+ (if electric-pair-mode
+ (add-hook 'post-self-insert-hook
+ #'electric-pair-post-self-insert-function)
+ (remove-hook 'post-self-insert-hook
+ #'electric-pair-post-self-insert-function)))
+
(provide 'electric)
;; arch-tag: dae045eb-dc2d-4fb7-9f27-9cc2ce277be8
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index 9267bc8ac9..578e0877d3 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -7,6 +7,7 @@
;; Maintainer: FSF
;; Created: 12 Dec 1992
;; Keywords: extensions, lisp, tools
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/emacs-lisp/authors.el b/lisp/emacs-lisp/authors.el
index 5aea033fc7..3bfa076d71 100644
--- a/lisp/emacs-lisp/authors.el
+++ b/lisp/emacs-lisp/authors.el
@@ -6,6 +6,7 @@
;; Author: Gerd Moellmann <[email protected]>
;; Maintainer: Kim F. Storm <[email protected]>
;; Keywords: maint
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index c5316d0642..30c384aff9 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -6,6 +6,7 @@
;; Author: Roland McGrath <[email protected]>
;; Keywords: maint
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -109,29 +110,48 @@ or macro definition or a defcustom)."
(let* ((macrop (memq car '(defmacro defmacro*)))
(name (nth 1 form))
(args (case car
- ((defun defmacro defun* defmacro*
- define-overloadable-function) (nth 2 form))
- ((define-skeleton) '(&optional str arg))
- ((define-generic-mode define-derived-mode
- define-compilation-mode) nil)
- (t)))
+ ((defun defmacro defun* defmacro*
+ define-overloadable-function) (nth 2 form))
+ ((define-skeleton) '(&optional str arg))
+ ((define-generic-mode define-derived-mode
+ define-compilation-mode) nil)
+ (t)))
(body (nthcdr (get car 'doc-string-elt) form))
(doc (if (stringp (car body)) (pop body))))
(when (listp args)
;; Add the usage form at the end where describe-function-1
;; can recover it.
(setq doc (help-add-fundoc-usage doc args)))
- ;; `define-generic-mode' quotes the name, so take care of that
- (list 'autoload (if (listp name) name (list 'quote name)) file doc
- (or (and (memq car '(define-skeleton define-derived-mode
- define-generic-mode
- easy-mmode-define-global-mode
- define-global-minor-mode
- define-globalized-minor-mode
- easy-mmode-define-minor-mode
- define-minor-mode)) t)
- (eq (car-safe (car body)) 'interactive))
- (if macrop (list 'quote 'macro) nil))))
+ (let ((exp
+ ;; `define-generic-mode' quotes the name, so take care of that
+ (list 'autoload (if (listp name) name (list 'quote name))
+ file doc
+ (or (and (memq car '(define-skeleton define-derived-mode
+ define-generic-mode
+ easy-mmode-define-global-mode
+ define-global-minor-mode
+ define-globalized-minor-mode
+ easy-mmode-define-minor-mode
+ define-minor-mode)) t)
+ (eq (car-safe (car body)) 'interactive))
+ (if macrop (list 'quote 'macro) nil))))
+ (when macrop
+ ;; Special case to autoload some of the macro's declarations.
+ (let ((decls (nth (if (stringp (nth 3 form)) 4 3) form))
+ (exps '()))
+ (when (eq (car decls) 'declare)
+ ;; FIXME: We'd like to reuse macro-declaration-function,
+ ;; but we can't since it doesn't return anything.
+ (dolist (decl decls)
+ (case (car-safe decl)
+ (indent
+ (push `(put ',name 'lisp-indent-function ',(cadr decl))
+ exps))
+ (doc-string
+ (push `(put ',name 'doc-string-elt ',(cadr decl)) exps))))
+ (when exps
+ (setq exp `(progn ,exp ,@exps))))))
+ exp)))
;; For defclass forms, use `eieio-defclass-autoload'.
((eq car 'defclass)
diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el
index 998cee1534..96e2fb41e8 100644
--- a/lisp/emacs-lisp/backquote.el
+++ b/lisp/emacs-lisp/backquote.el
@@ -6,6 +6,7 @@
;; Author: Rick Sladkey <[email protected]>
;; Maintainer: FSF
;; Keywords: extensions, internal
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 4c0094dd78..9ce3c2eb32 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -7,6 +7,7 @@
;; Hallvard Furuseth <[email protected]>
;; Maintainer: FSF
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index dbbf057ae2..6ce141eb8e 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -7,6 +7,7 @@
;; Hallvard Furuseth <[email protected]>
;; Maintainer: FSF
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -65,7 +66,6 @@ The return value of this function is not used."
;; Redefined in byte-optimize.el.
;; This is not documented--it's not clear that we should promote it.
(fset 'inline 'progn)
-(put 'inline 'lisp-indent-function 0)
;;; Interface to inline functions.
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index df93528683..e1b5b402b2 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1,12 +1,14 @@
;;; bytecomp.el --- compilation of Lisp code into byte code
;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002,
-;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+;; Free Software Foundation, Inc.
;; Author: Jamie Zawinski <[email protected]>
;; Hallvard Furuseth <[email protected]>
;; Maintainer: FSF
;; Keywords: lisp
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -1665,6 +1667,9 @@ that already has a `.elc' file."
(if (and (string-match emacs-lisp-file-regexp bytecomp-source)
(file-readable-p bytecomp-source)
(not (auto-save-file-name-p bytecomp-source))
+ (not (string-equal dir-locals-file
+ (file-name-nondirectory
+ bytecomp-source)))
(setq bytecomp-dest
(byte-compile-dest-file bytecomp-source))
(if (file-exists-p bytecomp-dest)
@@ -1811,17 +1816,25 @@ The value is non-nil if there were no errors, nil if errors."
(insert "\n") ; aaah, unix.
(if (file-writable-p target-file)
;; We must disable any code conversion here.
- (let ((coding-system-for-write 'no-conversion))
+ (let ((coding-system-for-write 'no-conversion)
+ ;; Write to a tempfile so that if another Emacs
+ ;; process is trying to load target-file (eg in a
+ ;; parallel bootstrap), it does not risk getting a
+ ;; half-finished file. (Bug#4196)
+ (tempfile (make-temp-name target-file)))
(if (memq system-type '(ms-dos 'windows-nt))
(setq buffer-file-type t))
- (when (file-exists-p target-file)
- ;; Remove the target before writing it, so that any
- ;; hard-links continue to point to the old file (this makes
- ;; it possible for installed files to share disk space with
- ;; the build tree, without causing problems when emacs-lisp
- ;; files in the build tree are recompiled).
- (delete-file target-file))
- (write-region (point-min) (point-max) target-file))
+ (write-region (point-min) (point-max) tempfile nil 1)
+ ;; This has the intentional side effect that any
+ ;; hard-links to target-file continue to
+ ;; point to the old file (this makes it possible
+ ;; for installed files to share disk space with
+ ;; the build tree, without causing problems when
+ ;; emacs-lisp files in the build tree are
+ ;; recompiled). Previously this was accomplished by
+ ;; deleting target-file before writing it.
+ (rename-file tempfile target-file t)
+ (message "Wrote %s" target-file))
;; This is just to give a better error message than write-region
(signal 'file-error
(list "Opening output file"
@@ -4648,6 +4661,8 @@ and corresponding effects."
(defvar byte-code-meter)
(defun byte-compile-report-ops ()
+ (or (boundp 'byte-metering-on)
+ (error "You must build Emacs with -DBYTE_CODE_METER to use this"))
(with-output-to-temp-buffer "*Meter*"
(set-buffer "*Meter*")
(let ((i 0) n op off)
diff --git a/lisp/emacs-lisp/cl-compat.el b/lisp/emacs-lisp/cl-compat.el
index 68d7c0ae3b..f4923b6f8c 100644
--- a/lisp/emacs-lisp/cl-compat.el
+++ b/lisp/emacs-lisp/cl-compat.el
@@ -6,6 +6,7 @@
;; Author: Dave Gillespie <[email protected]>
;; Version: 2.02
;; Keywords: extensions
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -70,11 +71,6 @@
;;; by capitalizing the first letter: Values, Multiple-value-*,
;;; to avoid conflict with the new-style definitions in cl-macs.
-(put 'Multiple-value-bind 'lisp-indent-function 2)
-(put 'Multiple-value-setq 'lisp-indent-function 2)
-(put 'Multiple-value-call 'lisp-indent-function 1)
-(put 'Multiple-value-prog1 'lisp-indent-function 1)
-
(defvar *mvalues-values* nil)
(defun Values (&rest val-forms)
@@ -90,18 +86,22 @@
(list *mvalues-temp*))))
(defmacro Multiple-value-call (function &rest args)
+ (declare (indent 1))
(list 'apply function
(cons 'append
(mapcar (function (lambda (x) (list 'Multiple-value-list x)))
args))))
(defmacro Multiple-value-bind (vars form &rest body)
+ (declare (indent 2))
(list* 'multiple-value-bind vars (list 'Multiple-value-list form) body))
(defmacro Multiple-value-setq (vars form)
+ (declare (indent 2))
(list 'multiple-value-setq vars (list 'Multiple-value-list form)))
(defmacro Multiple-value-prog1 (form &rest body)
+ (declare (indent 1))
(list 'prog1 form (list* 'let '((*mvalues-values* nil)) body)))
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index c6aae37358..b7c908882e 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -5,6 +5,7 @@
;; Author: Dave Gillespie <[email protected]>
;; Keywords: extensions
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el
index e4f605d4fd..4e7ada8851 100644
--- a/lisp/emacs-lisp/cl-indent.el
+++ b/lisp/emacs-lisp/cl-indent.el
@@ -7,6 +7,7 @@
;; Created: July 1987
;; Maintainer: FSF
;; Keywords: lisp, tools
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el
index b14c879fcf..db2ae88b8b 100644
--- a/lisp/emacs-lisp/cl-loaddefs.el
+++ b/lisp/emacs-lisp/cl-loaddefs.el
@@ -10,7 +10,7 @@
;;;;;; ceiling* floor* isqrt lcm gcd cl-progv-before cl-set-frame-visible-p
;;;;;; cl-map-overlays cl-map-intervals cl-map-keymap-recursively
;;;;;; notevery notany every some mapcon mapcan mapl maplist map
-;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "deb3495d75c36a222e5238eadb8e347c")
+;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "20c8c875ff1d11dd819e15a1f25afd73")
;;; Generated autoloads from cl-extra.el
(autoload 'coerce "cl-extra" "\
@@ -277,12 +277,12 @@ Not documented
;;;;;; assert check-type typep deftype cl-struct-setf-expander defstruct
;;;;;; define-modify-macro callf2 callf letf* letf rotatef shiftf
;;;;;; remf cl-do-pop psetf setf get-setf-method defsetf define-setf-method
-;;;;;; declare the locally multiple-value-setq multiple-value-bind
-;;;;;; lexical-let* lexical-let symbol-macrolet macrolet labels
-;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist
-;;;;;; do* do loop return-from return block etypecase typecase ecase
-;;;;;; case load-time-value eval-when destructuring-bind function*
-;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "36cafd5054969b5bb0b1ce6a21605fed")
+;;;;;; declare locally multiple-value-setq multiple-value-bind lexical-let*
+;;;;;; lexical-let symbol-macrolet macrolet labels flet progv psetq
+;;;;;; do-all-symbols do-symbols dotimes dolist do* do loop return-from
+;;;;;; return block etypecase typecase ecase case load-time-value
+;;;;;; eval-when destructuring-bind function* defmacro* defun* gentemp
+;;;;;; gensym) "cl-macs" "cl-macs.el" "c10b5cbebb5267291ef15c782c0271a6")
;;; Generated autoloads from cl-macs.el
(autoload 'gensym "cl-macs" "\
@@ -535,11 +535,6 @@ Not documented
\(fn &rest BODY)" nil (quote macro))
-(autoload 'the "cl-macs" "\
-Not documented
-
-\(fn TYPE FORM)" nil (quote macro))
-
(autoload 'declare "cl-macs" "\
Not documented
@@ -759,7 +754,7 @@ surrounded by (block NAME ...).
;;;;;; find nsubstitute-if-not nsubstitute-if nsubstitute substitute-if-not
;;;;;; substitute-if substitute delete-duplicates remove-duplicates
;;;;;; delete-if-not delete-if delete* remove-if-not remove-if remove*
-;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "ec3ea1c77742734db8496272fe5721be")
+;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "7b7531276ddf8457abecdd487d3cf0b7")
;;; Generated autoloads from cl-seq.el
(autoload 'reduce "cl-seq" "\
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 694a06f833..f6d66c64c7 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -6,6 +6,7 @@
;; Author: Dave Gillespie <[email protected]>
;; Version: 2.02
;; Keywords: extensions
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -1818,8 +1819,6 @@ Example:
(defsetf window-start set-window-start)
(defsetf window-width () (store)
(list 'progn (list 'enlarge-window (list '- store '(window-width)) t) store))
-(defsetf x-get-cutbuffer x-store-cutbuffer t)
-(defsetf x-get-cut-buffer x-store-cut-buffer t) ; groan.
(defsetf x-get-secondary-selection x-own-secondary-selection t)
(defsetf x-get-selection x-own-selection t)
diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
index a823e9015d..a5070e4ace 100644
--- a/lisp/emacs-lisp/cl-seq.el
+++ b/lisp/emacs-lisp/cl-seq.el
@@ -6,6 +6,7 @@
;; Author: Dave Gillespie <[email protected]>
;; Version: 2.02
;; Keywords: extensions
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -47,6 +48,7 @@
;;; this file independent from cl-macs.
(defmacro cl-parsing-keywords (kwords other-keys &rest body)
+ (declare (indent 2) (debug (sexp sexp &rest form)))
(cons
'let*
(cons (mapcar
@@ -83,13 +85,13 @@
(car cl-keys-temp)))
'(setq cl-keys-temp (cdr (cdr cl-keys-temp)))))))
body))))
-(put 'cl-parsing-keywords 'lisp-indent-function 2)
-(put 'cl-parsing-keywords 'edebug-form-spec '(sexp sexp &rest form))
(defmacro cl-check-key (x)
+ (declare (debug edebug-forms))
(list 'if 'cl-key (list 'funcall 'cl-key x) x))
(defmacro cl-check-test-nokey (item x)
+ (declare (debug edebug-forms))
(list 'cond
(list 'cl-test
(list 'eq (list 'not (list 'funcall 'cl-test item x))
@@ -100,20 +102,17 @@
(list 'equal item x) (list 'eq item x)))))
(defmacro cl-check-test (item x)
+ (declare (debug edebug-forms))
(list 'cl-check-test-nokey item (list 'cl-check-key x)))
(defmacro cl-check-match (x y)
+ (declare (debug edebug-forms))
(setq x (list 'cl-check-key x) y (list 'cl-check-key y))
(list 'if 'cl-test
(list 'eq (list 'not (list 'funcall 'cl-test x y)) 'cl-test-not)
(list 'if (list 'numberp x)
(list 'equal x y) (list 'eq x y))))
-(put 'cl-check-key 'edebug-form-spec 'edebug-forms)
-(put 'cl-check-test 'edebug-form-spec 'edebug-forms)
-(put 'cl-check-test-nokey 'edebug-form-spec 'edebug-forms)
-(put 'cl-check-match 'edebug-form-spec 'edebug-forms)
-
(defvar cl-test) (defvar cl-test-not)
(defvar cl-if) (defvar cl-if-not)
(defvar cl-key)
diff --git a/lisp/emacs-lisp/cl-specs.el b/lisp/emacs-lisp/cl-specs.el
index acfd3504ec..776ce5e9ca 100644
--- a/lisp/emacs-lisp/cl-specs.el
+++ b/lisp/emacs-lisp/cl-specs.el
@@ -4,6 +4,7 @@
;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Daniel LaLiberte <[email protected]>
;; Keywords: lisp, tools, maint
+;; Package: emacs
;; LCD Archive Entry:
;; cl-specs.el|Daniel LaLiberte|[email protected]
diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el
index 6f7a43af84..43eb61b0be 100644
--- a/lisp/emacs-lisp/copyright.el
+++ b/lisp/emacs-lisp/copyright.el
@@ -158,13 +158,15 @@ When this is `function', only ask when called non-interactively."
(unless (string= (buffer-substring (- (match-end 3) 2) (match-end 3))
(substring copyright-current-year -2))
(if (or noquery
- ;; Fixes some point-moving oddness (bug#2209).
- (save-excursion
- (y-or-n-p (if replace
- (concat "Replace copyright year(s) by "
- copyright-current-year "? ")
- (concat "Add " copyright-current-year
- " to copyright? ")))))
+ (save-window-excursion
+ (switch-to-buffer (current-buffer))
+ ;; Fixes some point-moving oddness (bug#2209).
+ (save-excursion
+ (y-or-n-p (if replace
+ (concat "Replace copyright year(s) by "
+ copyright-current-year "? ")
+ (concat "Add " copyright-current-year
+ " to copyright? "))))))
(if replace
(replace-match copyright-current-year t t nil 3)
(let ((size (save-excursion (skip-chars-backward "0-9"))))
@@ -224,8 +226,10 @@ version \\([0-9]+\\), or (at"
(string-to-number copyright-current-gpl-version))
(or noquery
(save-match-data
- (y-or-n-p (format "Replace GPL version by %s? "
- copyright-current-gpl-version))))
+ (save-window-excursion
+ (switch-to-buffer (current-buffer))
+ (y-or-n-p (format "Replace GPL version by %s? "
+ copyright-current-gpl-version)))))
(progn
(if (match-end 2)
;; Esperanto bilingual comment in two-column.el
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index b8ff3c03ee..17fcf7ad6c 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -514,9 +514,9 @@ Applies to the frame whose line point is on in the backtrace."
(insert ? )))
(beginning-of-line))
-(put 'debugger-env-macro 'lisp-indent-function 0)
(defmacro debugger-env-macro (&rest body)
"Run BODY in original environment."
+ (declare (indent 0))
`(save-excursion
(if (null (buffer-name debugger-old-buffer))
;; old buffer deleted
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index d6f717ccda..3456d1a63f 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -7,6 +7,7 @@
;; Author: David Megginson ([email protected])
;; Maintainer: FSF
;; Keywords: extensions
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 5a21946183..e11572dfc6 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -5,6 +5,7 @@
;; Author: Georges Brun-Cottan <[email protected]>
;; Maintainer: Stefan Monnier <[email protected]>
+;; Package: emacs
;; Keywords: extensions lisp
@@ -86,25 +87,23 @@ replacing its case-insensitive matches with the literal string in LIGHTER."
;;;###autoload
(defmacro define-minor-mode (mode doc &optional init-value lighter keymap &rest body)
"Define a new minor mode MODE.
-This function defines the associated control variable MODE, keymap MODE-map,
-and toggle command MODE.
-
+This defines the control variable MODE and the toggle command MODE.
DOC is the documentation for the mode toggle command.
+
Optional INIT-VALUE is the initial value of the mode's variable.
Optional LIGHTER is displayed in the modeline when the mode is on.
-Optional KEYMAP is the default (defvar) keymap bound to the mode keymap.
- If it is a list, it is passed to `easy-mmode-define-keymap'
- in order to build a valid keymap. It's generally better to use
- a separate MODE-map variable than to use this argument.
-The above three arguments can be skipped if keyword arguments are
-used (see below).
-
-BODY contains code to execute each time the mode is activated or deactivated.
- It is executed after toggling the mode,
- and before running the hook variable `MODE-hook'.
- Before the actual body code, you can write keyword arguments (alternating
- keywords and values). These following keyword arguments are supported (other
- keywords will be passed to `defcustom' if the minor mode is global):
+Optional KEYMAP is the default keymap bound to the mode keymap.
+ If non-nil, it should be a variable name (whose value is a keymap),
+ a keymap, or a list of arguments for `easy-mmode-define-keymap'.
+ If KEYMAP is a keymap or list, this also defines the variable MODE-map.
+
+BODY contains code to execute each time the mode is enabled or disabled.
+ It is executed after toggling the mode, and before running MODE-hook.
+ Before the actual body code, you can write keyword arguments, i.e.
+ alternating keywords and values. These following special keywords
+ are supported (other keywords are passed to `defcustom' if the minor
+ mode is global):
+
:group GROUP Custom group name to use in all generated `defcustom' forms.
Defaults to MODE without the possible trailing \"-mode\".
Don't use this default group name unless you have written a
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
index 470f0f6777..9992861fc3 100644
--- a/lisp/emacs-lisp/easymenu.el
+++ b/lisp/emacs-lisp/easymenu.el
@@ -5,6 +5,7 @@
;; Keywords: emulations
;; Author: Richard Stallman <[email protected]>
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -43,8 +44,6 @@ menus, turn this variable off, otherwise it is probably better to keep it on.")
(if (stringp s) (intern s) s))
;;;###autoload
-(put 'easy-menu-define 'lisp-indent-function 'defun)
-;;;###autoload
(defmacro easy-menu-define (symbol maps doc menu)
"Define a menu bar submenu in maps MAPS, according to MENU.
@@ -150,6 +149,7 @@ unselectable text. A string consisting solely of hyphens is displayed
as a solid horizontal line.
A menu item can be a list with the same format as MENU. This is a submenu."
+ (declare (indent defun))
`(progn
,(if symbol `(defvar ,symbol nil ,doc))
(easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu)))
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index b573af29ee..91cb5642fb 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -6,6 +6,7 @@
;; Author: Eric M. Ludlam <[email protected]>
;; Version: 0.2
;; Keywords: OO, lisp
+;; Package: eieio
;; This file is part of GNU Emacs.
diff --git a/lisp/emacs-lisp/eieio-comp.el b/lisp/emacs-lisp/eieio-comp.el
index a2b955a280..0e76f4bb33 100644
--- a/lisp/emacs-lisp/eieio-comp.el
+++ b/lisp/emacs-lisp/eieio-comp.el
@@ -5,7 +5,8 @@
;; Author: Eric M. Ludlam <[email protected]>
;; Version: 0.2
-;; Keywords: oop, lisp, tools
+;; Keywords: lisp, tools
+;; Package: eieio
;; This file is part of GNU Emacs.
diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el
index 268d60fc19..12ff23b311 100644
--- a/lisp/emacs-lisp/eieio-custom.el
+++ b/lisp/emacs-lisp/eieio-custom.el
@@ -6,6 +6,7 @@
;; Author: Eric M. Ludlam <[email protected]>
;; Version: 0.2
;; Keywords: OO, lisp
+;; Package: eieio
;; This file is part of GNU Emacs.
diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el
index 5dc54f5c35..b58fbfd3f0 100644
--- a/lisp/emacs-lisp/eieio-datadebug.el
+++ b/lisp/emacs-lisp/eieio-datadebug.el
@@ -4,6 +4,7 @@
;; Author: Eric M. Ludlam <[email protected]>
;; Keywords: OO, lisp
+;; Package: eieio
;; This file is part of GNU Emacs.
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index 375ce0bc6d..ca3850562c 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -6,6 +6,7 @@
;; Author: Eric M. Ludlam <[email protected]>
;; Version: 0.2
;; Keywords: OO, lisp
+;; Package: eieio
;; This file is part of GNU Emacs.
diff --git a/lisp/emacs-lisp/eieio-speedbar.el b/lisp/emacs-lisp/eieio-speedbar.el
index e4c1c50aa8..e16c3a1743 100644
--- a/lisp/emacs-lisp/eieio-speedbar.el
+++ b/lisp/emacs-lisp/eieio-speedbar.el
@@ -6,6 +6,7 @@
;; Author: Eric M. Ludlam <[email protected]>
;; Version: 0.2
;; Keywords: OO, tools
+;; Package: eieio
;; This file is part of GNU Emacs.
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index f5e684e132..34fb5b9c9f 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -1610,6 +1610,7 @@ SPEC-LIST is of a form similar to `let'. For example:
Where each VAR is the local variable given to the associated
SLOT. A slot specified without a variable name is given a
variable name of the same name as the slot."
+ (declare (indent 2))
;; Transform the spec-list into a symbol-macrolet spec-list.
(let ((mappings (mapcar (lambda (entry)
(let ((var (if (listp entry) (car entry) entry))
@@ -1618,8 +1619,6 @@ variable name of the same name as the slot."
spec-list)))
(append (list 'symbol-macrolet mappings)
body)))
-(put 'with-slots 'lisp-indent-function 2)
-
;;; Simple generators, and query functions. None of these would do
;; well embedded into an object.
diff --git a/lisp/emacs-lisp/float-sup.el b/lisp/emacs-lisp/float-sup.el
index 6a05bda82a..6bdc9073dd 100644
--- a/lisp/emacs-lisp/float-sup.el
+++ b/lisp/emacs-lisp/float-sup.el
@@ -5,6 +5,7 @@
;; Maintainer: FSF
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el
index b6e8427ea1..51b23c3f40 100644
--- a/lisp/emacs-lisp/generic.el
+++ b/lisp/emacs-lisp/generic.el
@@ -6,6 +6,7 @@
;; Author: Peter Breton <[email protected]>
;; Created: Fri Sep 27 1996
;; Keywords: generic, comment, font-lock
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/emacs-lisp/helper.el b/lisp/emacs-lisp/helper.el
index b7cb8b93c2..6a59742932 100644
--- a/lisp/emacs-lisp/helper.el
+++ b/lisp/emacs-lisp/helper.el
@@ -6,6 +6,7 @@
;; Author: K. Shane Hartman
;; Maintainer: FSF
;; Keywords: help
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el
index 10b7baf294..7df65acb28 100644
--- a/lisp/emacs-lisp/lisp-mnt.el
+++ b/lisp/emacs-lisp/lisp-mnt.el
@@ -298,6 +298,7 @@ The returned value is a list of strings, one per line."
(defmacro lm-with-file (file &rest body)
"Execute BODY in a buffer containing the contents of FILE.
If FILE is nil, execute BODY in the current buffer."
+ (declare (indent 1) (debug t))
(let ((filesym (make-symbol "file")))
`(let ((,filesym ,file))
(if ,filesym
@@ -311,9 +312,6 @@ If FILE is nil, execute BODY in the current buffer."
(with-syntax-table emacs-lisp-mode-syntax-table
,@body))))))
-(put 'lm-with-file 'lisp-indent-function 1)
-(put 'lm-with-file 'edebug-form-spec t)
-
;; Fixme: Probably this should be amalgamated with copyright.el; also
;; we need a check for ranges in copyright years.
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 1185f79806..b4ac0eebf6 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -5,6 +5,7 @@
;; Maintainer: FSF
;; Keywords: lisp, languages
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -85,7 +86,7 @@
(let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
(modify-syntax-entry ?\[ "_ " table)
(modify-syntax-entry ?\] "_ " table)
- (modify-syntax-entry ?# "' 14b" table)
+ (modify-syntax-entry ?# "' 14" table)
(modify-syntax-entry ?| "\" 23bn" table)
table)
"Syntax table used in `lisp-mode'.")
@@ -1217,31 +1218,17 @@ This function also returns nil meaning don't specify the indentation."
(put 'prog2 'lisp-indent-function 2)
(put 'save-excursion 'lisp-indent-function 0)
(put 'save-window-excursion 'lisp-indent-function 0)
-(put 'save-selected-window 'lisp-indent-function 0)
(put 'save-restriction 'lisp-indent-function 0)
(put 'save-match-data 'lisp-indent-function 0)
(put 'save-current-buffer 'lisp-indent-function 0)
-(put 'with-current-buffer 'lisp-indent-function 1)
-(put 'combine-after-change-calls 'lisp-indent-function 0)
-(put 'with-output-to-string 'lisp-indent-function 0)
-(put 'with-temp-file 'lisp-indent-function 1)
-(put 'with-temp-buffer 'lisp-indent-function 0)
-(put 'with-temp-message 'lisp-indent-function 1)
-(put 'with-syntax-table 'lisp-indent-function 1)
(put 'let 'lisp-indent-function 1)
(put 'let* 'lisp-indent-function 1)
(put 'while 'lisp-indent-function 1)
(put 'if 'lisp-indent-function 2)
-(put 'read-if 'lisp-indent-function 2)
(put 'catch 'lisp-indent-function 1)
(put 'condition-case 'lisp-indent-function 2)
(put 'unwind-protect 'lisp-indent-function 1)
(put 'with-output-to-temp-buffer 'lisp-indent-function 1)
-(put 'eval-after-load 'lisp-indent-function 1)
-(put 'dolist 'lisp-indent-function 1)
-(put 'dotimes 'lisp-indent-function 1)
-(put 'when 'lisp-indent-function 1)
-(put 'unless 'lisp-indent-function 1)
(defun indent-sexp (&optional endpos)
"Indent each line of the list starting just after point.
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index 4ef6dab896..e799dcd77c 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -5,6 +5,7 @@
;; Maintainer: FSF
;; Keywords: lisp, languages
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -142,7 +143,13 @@ This command assumes point is not in a string or comment."
(or arg (setq arg 1))
(let ((inc (if (> arg 0) 1 -1)))
(while (/= arg 0)
- (goto-char (or (scan-lists (point) inc 1) (buffer-end arg)))
+ (if forward-sexp-function
+ (condition-case err
+ (while (let ((pos (point)))
+ (forward-sexp inc)
+ (/= (point) pos)))
+ (scan-error (goto-char (nth 2 err))))
+ (goto-char (or (scan-lists (point) inc 1) (buffer-end arg))))
(setq arg (- arg inc)))))
(defun kill-sexp (&optional arg)
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 876b9a468a..6dfd47b4ad 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -52,6 +52,7 @@ possible (for instance, when BODY just returns VAR unchanged, the
result will be eq to LIST).
\(fn (VAR LIST) BODY...)"
+ (declare (indent 1))
(let ((var (car var+list))
(list (cadr var+list))
(shared (make-symbol "shared"))
@@ -72,7 +73,6 @@ result will be eq to LIST).
(push ,new-el ,unshared))
(setq ,tail (cdr ,tail)))
(nconc (nreverse ,unshared) ,shared))))
-(put 'macroexp-accumulate 'lisp-indent-function 1)
(defun macroexpand-all-forms (forms &optional skip)
"Return FORMS with macros expanded. FORMS is a list of forms.
@@ -107,80 +107,69 @@ Assumes the caller has bound `macroexpand-all-environment'."
macroexpand-all-environment)
;; Normal form; get its expansion, and then expand arguments.
(setq form (macroexpand form macroexpand-all-environment))
- (if (consp form)
- (let ((fun (car form)))
- (cond
- ((eq fun 'cond)
- (maybe-cons fun (macroexpand-all-clauses (cdr form)) form))
- ((eq fun 'condition-case)
- (maybe-cons
- fun
- (maybe-cons (cadr form)
- (maybe-cons (macroexpand-all-1 (nth 2 form))
- (macroexpand-all-clauses (nthcdr 3 form) 1)
- (cddr form))
- (cdr form))
- form))
- ((eq fun 'defmacro)
- (push (cons (cadr form) (cons 'lambda (cddr form)))
- macroexpand-all-environment)
- (macroexpand-all-forms form 3))
- ((eq fun 'defun)
- (macroexpand-all-forms form 3))
- ((memq fun '(defvar defconst))
- (macroexpand-all-forms form 2))
- ((eq fun 'function)
- (if (and (consp (cadr form)) (eq (car (cadr form)) 'lambda))
- (maybe-cons fun
- (maybe-cons (macroexpand-all-forms (cadr form) 2)
- nil
- (cdr form))
- form)
- form))
- ((memq fun '(let let*))
- (maybe-cons fun
- (maybe-cons (macroexpand-all-clauses (cadr form) 1)
- (macroexpand-all-forms (cddr form))
- (cdr form))
- form))
- ((eq fun 'quote)
- form)
- ((and (consp fun) (eq (car fun) 'lambda))
- ;; Embedded lambda in function position.
- (maybe-cons (macroexpand-all-forms fun 2)
- (macroexpand-all-forms (cdr form))
- form))
- ;; The following few cases are for normal function calls that
- ;; are known to funcall one of their arguments. The byte
- ;; compiler has traditionally handled these functions specially
- ;; by treating a lambda expression quoted by `quote' as if it
- ;; were quoted by `function'. We make the same transformation
- ;; here, so that any code that cares about the difference will
- ;; see the same transformation.
- ;; First arg is a function:
- ((and (memq fun '(apply mapcar mapatoms mapconcat mapc))
- (consp (cadr form))
- (eq (car (cadr form)) 'quote))
- ;; We don't use `maybe-cons' since there's clearly a change.
- (cons fun
- (cons (macroexpand-all-1 (cons 'function (cdr (cadr form))))
- (macroexpand-all-forms (cddr form)))))
- ;; Second arg is a function:
- ((and (eq fun 'sort)
- (consp (nth 2 form))
- (eq (car (nth 2 form)) 'quote))
- ;; We don't use `maybe-cons' since there's clearly a change.
- (cons fun
- (cons (macroexpand-all-1 (cadr form))
- (cons (macroexpand-all-1
- (cons 'function (cdr (nth 2 form))))
- (macroexpand-all-forms (nthcdr 3 form))))))
- (t
- ;; For everything else, we just expand each argument (for
- ;; setq/setq-default this works alright because the variable names
- ;; are symbols).
- (macroexpand-all-forms form 1))))
- form)))
+ (pcase form
+ (`(cond . ,clauses)
+ (maybe-cons 'cond (macroexpand-all-clauses clauses) form))
+ (`(condition-case . ,(or `(,err ,body . ,handlers) dontcare))
+ (maybe-cons
+ 'condition-case
+ (maybe-cons err
+ (maybe-cons (macroexpand-all-1 body)
+ (macroexpand-all-clauses handlers 1)
+ (cddr form))
+ (cdr form))
+ form))
+ (`(defmacro ,name . ,args-and-body)
+ (push (cons name (cons 'lambda args-and-body))
+ macroexpand-all-environment)
+ (macroexpand-all-forms form 3))
+ (`(defun . ,_) (macroexpand-all-forms form 3))
+ (`(,(or `defvar `defconst) . ,_) (macroexpand-all-forms form 2))
+ (`(function ,(and f `(lambda . ,_)))
+ (maybe-cons 'function
+ (maybe-cons (macroexpand-all-forms f 2)
+ nil
+ (cdr form))
+ form))
+ (`(,(or `function `quote) . ,_) form)
+ (`(,(and fun (or `let `let*)) . ,(or `(,bindings . ,body) dontcare))
+ (maybe-cons fun
+ (maybe-cons (macroexpand-all-clauses bindings 1)
+ (macroexpand-all-forms body)
+ (cdr form))
+ form))
+ (`(,(and fun `(lambda . ,_)) . ,args)
+ ;; Embedded lambda in function position.
+ (maybe-cons (macroexpand-all-forms fun 2)
+ (macroexpand-all-forms args)
+ form))
+ ;; The following few cases are for normal function calls that
+ ;; are known to funcall one of their arguments. The byte
+ ;; compiler has traditionally handled these functions specially
+ ;; by treating a lambda expression quoted by `quote' as if it
+ ;; were quoted by `function'. We make the same transformation
+ ;; here, so that any code that cares about the difference will
+ ;; see the same transformation.
+ ;; First arg is a function:
+ (`(,(and fun (or `apply `mapcar `mapatoms `mapconcat `mapc)) ',f . ,args)
+ ;; We don't use `maybe-cons' since there's clearly a change.
+ (cons fun
+ (cons (macroexpand-all-1 (list 'function f))
+ (macroexpand-all-forms args))))
+ ;; Second arg is a function:
+ (`(,(and fun (or `sort)) ,arg1 ',f . ,args)
+ ;; We don't use `maybe-cons' since there's clearly a change.
+ (cons fun
+ (cons (macroexpand-all-1 arg1)
+ (cons (macroexpand-all-1
+ (list 'function f))
+ (macroexpand-all-forms args)))))
+ (`(,_ . ,_)
+ ;; For every other list, we just expand each argument (for
+ ;; setq/setq-default this works alright because the variable names
+ ;; are symbols).
+ (macroexpand-all-forms form 1))
+ (t form))))
;;;###autoload
(defun macroexpand-all (form &optional environment)
diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el
index b93950049e..38c4d5bbe3 100644
--- a/lisp/emacs-lisp/package-x.el
+++ b/lisp/emacs-lisp/package-x.el
@@ -6,6 +6,7 @@
;; Created: 10 Mar 2007
;; Version: 0.9
;; Keywords: tools
+;; Package: package
;; This file is part of GNU Emacs.
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 2e8c7dc7d4..54c6a09dd9 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -216,6 +216,7 @@ If VERSION is nil, the package is not loaded (it is \"disabled\")."
(declare-function lm-header "lisp-mnt" (header))
(declare-function lm-commentary "lisp-mnt" (&optional file))
(declare-function dired-delete-file "dired" (file &optional recursive trash))
+(defvar url-http-end-of-headers)
(defcustom package-archives '(("gnu" . "http://elpa.gnu.org/packages/"))
"An alist of archives from which to fetch.
@@ -259,8 +260,9 @@ packages in `package-directory-list'."
;; Defaults are subdirs named "elpa" in the site-lisp dirs.
(let (result)
(dolist (f load-path)
- (if (equal (file-name-nondirectory f) "site-lisp")
- (push (expand-file-name "elpa" f) result)))
+ (and (stringp f)
+ (equal (file-name-nondirectory f) "site-lisp")
+ (push (expand-file-name "elpa" f) result)))
(nreverse result))
"List of additional directories containing Emacs Lisp packages.
Each directory name should be absolute.
@@ -272,46 +274,35 @@ contrast, `package-user-dir' contains packages for personal use."
:group 'package
:version "24.1")
-(defconst package--builtins-base
- ;; We use package-version split here to make sure to pick up the
- ;; minor version.
- `((emacs . [,(version-to-list emacs-version) nil
- "GNU Emacs"])
- (package . [,(version-to-list package-el-version)
- nil "Simple package system for GNU Emacs"]))
- "Packages which are always built-in.")
-
-(defvar package--builtins
- (delq nil
- (append
- package--builtins-base
- (if (>= emacs-major-version 22)
- ;; FIXME: emacs 22 includes tramp, rcirc, maybe
- ;; other things...
- '((erc . [(5 2) nil "Internet Relay Chat client"])
- ;; The external URL is version 1.15, so make sure the
- ;; built-in one looks newer.
- (url . [(1 16) nil "URL handling libary"])))
- (if (>= emacs-major-version 23)
- '(;; Strangely, nxml-version is missing in Emacs 23.
- ;; We pick the merge date as the version.
- (nxml . [(20071123) nil "Major mode for XML documents"])
- (bubbles . [(0 5) nil "A puzzle game"])))))
- "Alist of all built-in packages.
-Maps the package name to a vector [VERSION REQS DOCSTRING].")
+;; The value is precomputed in finder-inf.el, but don't load that
+;; until it's needed (i.e. when `package-intialize' is called).
+(defvar package--builtins nil
+ "Alist of built-in packages.
+Each element has the form (PKG . DESC), where PKG is a package
+name (a symbol) and DESC is a vector that describes the package.
+
+The vector DESC has the form [VERSION REQS DOCSTRING].
+ VERSION is a version list.
+ REQS is a list of packages (symbols) required by the package.
+ DOCSTRING is a brief description of the package.")
(put 'package--builtins 'risky-local-variable t)
-(defvar package-alist package--builtins
+(defvar package-alist nil
"Alist of all packages available for activation.
-This maps the package name to a vector [VERSION REQS DOCSTRING].
+Each element has the form (PKG . DESC), where PKG is a package
+name (a symbol) and DESC is a vector that describes the package.
-The value is generated by `package-load-descriptor', usually
-called via `package-initialize'. For user customizations of
-which packages to load/activate, see `package-load-list'.")
+The vector DESC has the form [VERSION REQS DOCSTRING].
+ VERSION is a version list.
+ REQS is a list of packages (symbols) required by the package.
+ DOCSTRING is a brief description of the package.
+
+This variable is set automatically by `package-load-descriptor',
+called via `package-initialize'. To change which packages are
+loaded and/or activated, customize `package-load-list'.")
(put 'package-archive-contents 'risky-local-variable t)
-(defvar package-activated-list
- (mapcar #'car package-alist)
+(defvar package-activated-list nil
"List of the names of currently activated packages.")
(put 'package-activated-list 'risky-local-variable t)
@@ -416,16 +407,15 @@ updates `package-alist' and `package-obsolete-alist'."
(error "Internal error: could not find directory for %s-%s"
name version-str))
;; Add info node.
- (if (file-exists-p (expand-file-name "dir" pkg-dir))
- (progn
- ;; FIXME: not the friendliest, but simple.
- (require 'info)
- (info-initialize)
- (setq Info-directory-list (cons pkg-dir Info-directory-list))))
+ (when (file-exists-p (expand-file-name "dir" pkg-dir))
+ ;; FIXME: not the friendliest, but simple.
+ (require 'info)
+ (info-initialize)
+ (push pkg-dir Info-directory-list))
;; Add to load path, add autoloads, and activate the package.
- (setq load-path (cons pkg-dir load-path))
+ (push pkg-dir load-path)
(load (expand-file-name (concat name "-autoloads") pkg-dir) nil t)
- (setq package-activated-list (cons package package-activated-list))
+ (push package package-activated-list)
;; Don't return nil.
t))
@@ -476,22 +466,22 @@ Return nil if the package could not be activated."
(setcdr elt (cons (cons (package-desc-vers pkg-vec) pkg-vec)
(cdr elt))))
;; Make a new association.
- (setq package-obsolete-alist
- (cons (cons package (list (cons (package-desc-vers pkg-vec)
- pkg-vec)))
- package-obsolete-alist)))))
+ (push (cons package (list (cons (package-desc-vers pkg-vec)
+ pkg-vec)))
+ package-obsolete-alist))))
-;; (define-package "emacs" "21.4.1" "GNU Emacs core package.")
-;; (define-package "erc" "5.1" "ERC - irc client" '((emacs "21.0")))
(defun define-package (name-str version-string
- &optional docstring requirements)
+ &optional docstring requirements
+ &rest extra-properties)
"Define a new package.
NAME is the name of the package, a string.
VERSION-STRING is the version of the package, a dotted sequence
of integers.
DOCSTRING is the optional description.
REQUIREMENTS is a list of requirements on other packages.
-Each requirement is of the form (OTHER-PACKAGE \"VERSION\")."
+Each requirement is of the form (OTHER-PACKAGE \"VERSION\").
+
+EXTRA-PROPERTIES is currently unused."
(let* ((name (intern name-str))
(pkg-desc (assq name package-alist))
(new-version (version-to-list version-string))
@@ -514,7 +504,7 @@ Each requirement is of the form (OTHER-PACKAGE \"VERSION\")."
(setq package-alist (delq pkg-desc package-alist))
(package-mark-obsolete (car pkg-desc) (cdr pkg-desc)))
;; Add package to the alist.
- (setq package-alist (cons new-pkg-desc package-alist)))
+ (push new-pkg-desc package-alist))
;; You can have two packages with the same version, for instance
;; one in the system package directory and one in your private
;; directory. We just let the first one win.
@@ -672,7 +662,19 @@ It will move point to somewhere in the headers."
(version-list-<= min-version
(package-desc-vers (cdr pkg-desc))))))
-(defun package-compute-transaction (result requirements)
+(defun package-compute-transaction (package-list requirements)
+ "Return a list of packages to be installed, including PACKAGE-LIST.
+PACKAGE-LIST should be a list of package names (symbols).
+
+REQUIREMENTS should be a list of additional requirements; each
+element in this list should have the form (PACKAGE VERSION),
+where PACKAGE is a package name and VERSION is the required
+version of that package (as a list).
+
+This function recursively computes the requirements of the
+packages in REQUIREMENTS, and returns a list of all the packages
+that must be installed. Packages that are already installed are
+not included in this list."
(dolist (elt requirements)
(let* ((next-pkg (car elt))
(next-version (cadr elt)))
@@ -703,25 +705,25 @@ but version %s required"
(symbol-name next-pkg) (package-version-join next-version)
(package-version-join (package-desc-vers (cdr pkg-desc)))))
;; Only add to the transaction if we don't already have it.
- (unless (memq next-pkg result)
- (setq result (cons next-pkg result)))
- (setq result
- (package-compute-transaction result
+ (unless (memq next-pkg package-list)
+ (push next-pkg package-list))
+ (setq package-list
+ (package-compute-transaction package-list
(package-desc-reqs
(cdr pkg-desc))))))))
- result)
+ package-list)
(defun package-read-from-string (str)
"Read a Lisp expression from STR.
Signal an error if the entire string was not used."
(let* ((read-data (read-from-string str))
- (more-left
- (condition-case nil
- ;; The call to `ignore' suppresses a compiler warning.
- (progn (ignore (read-from-string
- (substring str (cdr read-data))))
- t)
- (end-of-file nil))))
+ (more-left
+ (condition-case nil
+ ;; The call to `ignore' suppresses a compiler warning.
+ (progn (ignore (read-from-string
+ (substring str (cdr read-data))))
+ t)
+ (end-of-file nil))))
(if more-left
(error "Can't read whole string")
(car read-data))))
@@ -731,48 +733,33 @@ Signal an error if the entire string was not used."
Will return the data from the file, or nil if the file does not exist.
Will throw an error if the archive version is too new."
(let ((filename (expand-file-name file package-user-dir)))
- (if (file-exists-p filename)
- (with-temp-buffer
- (insert-file-contents-literally filename)
- (let ((contents (package-read-from-string
- (buffer-substring-no-properties (point-min)
- (point-max)))))
- (if (> (car contents) package-archive-version)
- (error "Package archive version %d is greater than %d - upgrade package.el"
- (car contents) package-archive-version))
- (cdr contents))))))
+ (when (file-exists-p filename)
+ (with-temp-buffer
+ (insert-file-contents-literally filename)
+ (let ((contents (read (current-buffer))))
+ (if (> (car contents) package-archive-version)
+ (error "Package archive version %d is higher than %d"
+ (car contents) package-archive-version))
+ (cdr contents))))))
(defun package-read-all-archive-contents ()
- "Re-read `archive-contents' and `builtin-packages', if they exist.
-Set `package-archive-contents' and `package--builtins' if successful.
-Throw an error if the archive version is too new."
+ "Re-read `archive-contents', if it exists.
+If successful, set `package-archive-contents'."
(dolist (archive package-archives)
- (package-read-archive-contents (car archive)))
- (let ((builtins (package--read-archive-file "builtin-packages")))
- (if builtins
- ;; Version 1 of 'builtin-packages' is a list where the car is
- ;; a split emacs version and the cdr is an alist suitable for
- ;; package--builtins.
- (let ((our-version (version-to-list emacs-version))
- (result package--builtins-base))
- (setq package--builtins
- (dolist (elt builtins result)
- (if (version-list-<= (car elt) our-version)
- (setq result (append (cdr elt) result)))))))))
+ (package-read-archive-contents (car archive))))
(defun package-read-archive-contents (archive)
- "Re-read `archive-contents' and `builtin-packages' for ARCHIVE.
-If successful, set `package-archive-contents' and `package--builtins'.
+ "Re-read archive contents for ARCHIVE.
+If successful, set the variable `package-archive-contents'.
If the archive version is too new, signal an error."
- (let ((archive-contents (package--read-archive-file
- (concat "archives/" archive
- "/archive-contents"))))
- (if archive-contents
- ;; Version 1 of 'archive-contents' is identical to our
- ;; internal representation.
- ;; TODO: merge archive lists
- (dolist (package archive-contents)
- (package--add-to-archive-contents package archive)))))
+ ;; Version 1 of 'archive-contents' is identical to our internal
+ ;; representation.
+ (let* ((dir (concat "archives/" archive))
+ (contents-file (concat dir "/archive-contents"))
+ contents)
+ (when (setq contents (package--read-archive-file contents-file))
+ (dolist (package contents)
+ (package--add-to-archive-contents package archive)))))
(defun package--add-to-archive-contents (package archive)
"Add the PACKAGE from the given ARCHIVE if necessary.
@@ -786,9 +773,13 @@ Also, add the originating archive to the end of the package vector."
(version-list-< (aref existing-package 0) version))
(add-to-list 'package-archive-contents entry))))
-(defun package-download-transaction (transaction)
- "Download and install all the packages in the given transaction."
- (dolist (elt transaction)
+(defun package-download-transaction (package-list)
+ "Download and install all the packages in PACKAGE-LIST.
+PACKAGE-LIST should be a list of package names (symbols).
+This function assumes that all package requirements in
+PACKAGE-LIST are satisfied, i.e. that PACKAGE-LIST is computed
+using `package-compute-transaction'."
+ (dolist (elt package-list)
(let* ((desc (cdr (assq elt package-archive-contents)))
;; As an exception, if package is "held" in
;; `package-load-list', download the held version.
@@ -839,61 +830,60 @@ Otherwise return nil."
v-str))))
(defun package-buffer-info ()
- "Return a vector of information about the package in the current buffer.
-The vector looks like [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY]
-FILENAME is the file name, a string. It does not have the \".el\" extension.
+ "Return a vector describing the package in the current buffer.
+The vector has the form
+
+ [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY]
+
+FILENAME is the file name, a string, sans the \".el\" extension.
REQUIRES is a requires list, or nil.
-DESCRIPTION is the package description (a string).
+DESCRIPTION is the package description, a string.
VERSION is the version, a string.
COMMENTARY is the commentary section, a string, or nil if none.
-Throws an exception if the buffer does not contain a conforming package.
-If there is a package, narrows the buffer to the file's boundaries.
-May narrow buffer or move point even on failure."
+
+If the buffer does not contain a conforming package, signal an
+error. If there is a package, narrow the buffer to the file's
+boundaries."
(goto-char (point-min))
- (if (re-search-forward "^;;; \\([^ ]*\\)\\.el --- \\(.*\\)$" nil t)
- (let ((file-name (match-string 1))
- (desc (match-string 2))
- (start (progn (beginning-of-line) (point))))
- (if (search-forward (concat ";;; " file-name ".el ends here"))
- (progn
- ;; Try to include a trailing newline.
- (forward-line)
- (narrow-to-region start (point))
- (require 'lisp-mnt)
- ;; Use some headers we've invented to drive the process.
- (let* ((requires-str (lm-header "package-requires"))
- (requires (if requires-str
- (package-read-from-string requires-str)))
- ;; Prefer Package-Version, because if it is
- ;; defined the package author probably wants us
- ;; to use it. Otherwise try Version.
- (pkg-version
- (or (package-strip-rcs-id (lm-header "package-version"))
- (package-strip-rcs-id (lm-header "version"))))
- (commentary (lm-commentary)))
- (unless pkg-version
- (error
- "Package does not define a usable \"Version\" or \"Package-Version\" header"))
- ;; Turn string version numbers into list form.
- (setq requires
- (mapcar
- (lambda (elt)
- (list (car elt)
- (version-to-list (car (cdr elt)))))
- requires))
- (set-text-properties 0 (length file-name) nil file-name)
- (set-text-properties 0 (length pkg-version) nil pkg-version)
- (set-text-properties 0 (length desc) nil desc)
- (vector file-name requires desc pkg-version commentary)))
- (error "Package missing a terminating comment")))
- (error "No starting comment for package")))
+ (unless (re-search-forward "^;;; \\([^ ]*\\)\\.el --- \\(.*\\)$" nil t)
+ (error "Packages lacks a file header"))
+ (let ((file-name (match-string-no-properties 1))
+ (desc (match-string-no-properties 2))
+ (start (line-beginning-position)))
+ (unless (search-forward (concat ";;; " file-name ".el ends here"))
+ (error "Package lacks a terminating comment"))
+ ;; Try to include a trailing newline.
+ (forward-line)
+ (narrow-to-region start (point))
+ (require 'lisp-mnt)
+ ;; Use some headers we've invented to drive the process.
+ (let* ((requires-str (lm-header "package-requires"))
+ (requires (if requires-str
+ (package-read-from-string requires-str)))
+ ;; Prefer Package-Version; if defined, the package author
+ ;; probably wants us to use it. Otherwise try Version.
+ (pkg-version
+ (or (package-strip-rcs-id (lm-header "package-version"))
+ (package-strip-rcs-id (lm-header "version"))))
+ (commentary (lm-commentary)))
+ (unless pkg-version
+ (error
+ "Package lacks a \"Version\" or \"Package-Version\" header"))
+ ;; Turn string version numbers into list form.
+ (setq requires
+ (mapcar
+ (lambda (elt)
+ (list (car elt)
+ (version-to-list (car (cdr elt)))))
+ requires))
+ (vector file-name requires desc pkg-version commentary))))
(defun package-tar-file-info (file)
"Find package information for a tar file.
FILE is the name of the tar file to examine.
The return result is a vector like `package-buffer-info'."
(unless (string-match "^\\(.+\\)-\\([0-9.]+\\)\\.tar$" file)
- (error "`%s' doesn't have a package-ish name" file))
+ (error "Invalid package name `%s'" file))
(let* ((pkg-name (file-name-nondirectory (match-string-no-properties 1 file)))
(pkg-version (match-string-no-properties 2 file))
;; Extract the package descriptor.
@@ -904,20 +894,19 @@ The return result is a vector like `package-buffer-info'."
pkg-name "-pkg.el")))
(pkg-def-parsed (package-read-from-string pkg-def-contents)))
(unless (eq (car pkg-def-parsed) 'define-package)
- (error "%s-pkg.el doesn't contain `define-package' sexp" pkg-name))
- (let ((name-str (nth 1 pkg-def-parsed))
+ (error "No `define-package' sexp is present in `%s-pkg.el'" pkg-name))
+ (let ((name-str (nth 1 pkg-def-parsed))
(version-string (nth 2 pkg-def-parsed))
- (docstring (nth 3 pkg-def-parsed))
- (requires (nth 4 pkg-def-parsed))
-
+ (docstring (nth 3 pkg-def-parsed))
+ (requires (nth 4 pkg-def-parsed))
(readme (shell-command-to-string
;; Requires GNU tar.
(concat "tar -xOf " file " "
pkg-name "-" pkg-version "/README"))))
(unless (equal pkg-version version-string)
- (error "Inconsistent versions!"))
+ (error "Package has inconsistent versions"))
(unless (equal pkg-name name-str)
- (error "Inconsistent names!"))
+ (error "Package has inconsistent names"))
;; Kind of a hack.
(if (string-match ": Not found in archive" readme)
(setq readme nil))
@@ -925,18 +914,27 @@ The return result is a vector like `package-buffer-info'."
(if (eq (car requires) 'quote)
(setq requires (car (cdr requires))))
(setq requires
- (mapcar
- (lambda (elt)
- (list (car elt)
- (version-to-list (car (cdr elt)))))
- requires))
+ (mapcar (lambda (elt)
+ (list (car elt)
+ (version-to-list (cadr elt))))
+ requires))
(vector pkg-name requires docstring version-string readme))))
-(defun package-install-buffer-internal (pkg-info type)
+;;;###autoload
+(defun package-install-from-buffer (pkg-info type)
+ "Install a package from the current buffer.
+When called interactively, the current buffer is assumed to be a
+single .el file that follows the packaging guidelines; see info
+node `(elisp)Packaging'.
+
+When called from Lisp, PKG-INFO is a vector describing the
+information, of the type returned by `package-buffer-info'; and
+TYPE is the package type (either `single' or `tar')."
+ (interactive (list (package-buffer-info) 'single))
(save-excursion
(save-restriction
(let* ((file-name (aref pkg-info 0))
- (requires (aref pkg-info 1))
+ (requires (aref pkg-info 1))
(desc (if (string= (aref pkg-info 2) "")
"No description available."
(aref pkg-info 2)))
@@ -956,15 +954,6 @@ The return result is a vector like `package-buffer-info'."
(package-initialize)))))
;;;###autoload
-(defun package-install-from-buffer ()
- "Install a package from the current buffer.
-The package is assumed to be a single .el file which
-follows the elisp comment guidelines; see
-info node `(elisp)Library Headers'."
- (interactive)
- (package-install-buffer-internal (package-buffer-info) 'single))
-
-;;;###autoload
(defun package-install-file (file)
"Install a package from a file.
The file can either be a tar file or an Emacs Lisp file."
@@ -972,9 +961,10 @@ The file can either be a tar file or an Emacs Lisp file."
(with-temp-buffer
(insert-file-contents-literally file)
(cond
- ((string-match "\\.el$" file) (package-install-from-buffer))
+ ((string-match "\\.el$" file)
+ (package-install-from-buffer (package-buffer-info) 'single))
((string-match "\\.tar$" file)
- (package-install-buffer-internal (package-tar-file-info file) 'tar))
+ (package-install-from-buffer (package-tar-file-info file) 'tar))
(t (error "Unrecognized extension `%s'" (file-name-extension file))))))
(defun package-delete (name version)
@@ -1001,22 +991,27 @@ The file can either be a tar file or an Emacs Lisp file."
(re-search-forward "^$" nil 'move)
(forward-char)
(delete-region (point-min) (point))
- (make-directory dir t)
- (setq buffer-file-name (expand-file-name file dir))
- (let ((version-control 'never))
- (save-buffer)))
+ ;; Read the retrieved buffer to make sure it is valid (e.g. it
+ ;; may fetch a URL redirect page).
+ (when (listp (read buffer))
+ (make-directory dir t)
+ (setq buffer-file-name (expand-file-name file dir))
+ (let ((version-control 'never))
+ (save-buffer))))
(kill-buffer buffer)))
(defun package-refresh-contents ()
"Download the ELPA archive description if needed.
-Invoking this will ensure that Emacs knows about the latest versions
-of all packages. This will let Emacs make them available for
-download."
+This informs Emacs about the latest versions of all packages, and
+makes them available for download."
(interactive)
(unless (file-exists-p package-user-dir)
(make-directory package-user-dir t))
(dolist (archive package-archives)
- (package--download-one-archive archive "archive-contents"))
+ (condition-case nil
+ (package--download-one-archive archive "archive-contents")
+ (error (message "Failed to download `%s' archive."
+ (car archive)))))
(package-read-all-archive-contents))
;;;###autoload
@@ -1024,6 +1019,9 @@ download."
"Load Emacs Lisp packages, and activate them.
The variable `package-load-list' controls which packages to load."
(interactive)
+ (require 'finder-inf nil t)
+ (setq package-alist package--builtins)
+ (setq package-activated-list (mapcar #'car package-alist))
(setq package-obsolete-alist nil)
(package-load-all-descriptors)
(package-read-all-archive-contents)
@@ -1052,9 +1050,7 @@ The variable `package-load-list' controls which packages to load."
guess)
"Describe package: ")
packages nil t nil nil guess))
- (list (if (equal val "")
- guess
- (intern val)))))
+ (list (if (equal val "") guess (intern val)))))
(if (or (null package) (null (symbolp package)))
(message "You did not specify a package")
(help-setup-xref (list #'describe-package package)
@@ -1064,38 +1060,65 @@ The variable `package-load-list' controls which packages to load."
(describe-package-1 package)))))
(defun describe-package-1 (package)
- (let ((desc (cdr (assq package package-alist)))
- reqs version installable)
+ (require 'lisp-mnt)
+ (let ((package-name (symbol-name package))
+ (built-in (assq package package--builtins))
+ desc pkg-dir reqs version installable)
(prin1 package)
(princ " is ")
- (cond
- (desc
- ;; This package is loaded (i.e. in `package-alist').
- (let (pkg-dir)
- (setq version (package-version-join (package-desc-vers desc)))
- (if (assq package package--builtins)
- (princ "a built-in package.\n\n")
- (setq pkg-dir (package--dir (symbol-name package) version))
- (if pkg-dir
- (progn
- (insert "a package installed in `")
- (help-insert-xref-button (file-name-as-directory pkg-dir)
- 'help-package-def pkg-dir)
- (insert "'.\n\n"))
- ;; This normally does not happen.
- (insert "a deleted package.\n\n")
- (setq version nil)))))
- (t
- ;; An uninstalled package.
- (setq desc (cdr (assq package package-archive-contents))
+ (if (setq desc (cdr (assq package package-alist)))
+ ;; This package is loaded (i.e. in `package-alist').
+ (progn
+ (setq version (package-version-join (package-desc-vers desc)))
+ (cond (built-in
+ (princ "a built-in package.\n\n"))
+ ((setq pkg-dir (package--dir package-name version))
+ (insert "an installed package.\n\n"))
+ (t ;; This normally does not happen.
+ (insert "a deleted package.\n\n")
+ (setq version nil))))
+ ;; This package is not installed.
+ (setq desc (cdr (assq package package-archive-contents))
version (package-version-join (package-desc-vers desc))
installable t)
- (insert "an installable package.\n\n")))
- (if version
- (insert " Version: " version "\n"))
+ (insert "an uninstalled package.\n\n"))
+
+ (insert " " (propertize "Status" 'font-lock-face 'bold) ": ")
+ (cond (pkg-dir
+ (insert (propertize "Installed"
+ 'font-lock-face 'font-lock-comment-face))
+ (insert " in `")
+ ;; Todo: Add button for uninstalling.
+ (help-insert-xref-button (file-name-as-directory pkg-dir)
+ 'help-package-def pkg-dir)
+ (insert "'."))
+ (installable
+ (insert "Available -- ")
+ (let ((button-text (if (display-graphic-p)
+ "Install"
+ "[Install]"))
+ (button-face (if (display-graphic-p)
+ '(:box (:line-width 2 :color "dark grey")
+ :background "light grey"
+ :foreground "black")
+ 'link)))
+ (insert-text-button button-text
+ 'face button-face
+ 'follow-link t
+ 'package-symbol package
+ 'action 'package-install-button-action)))
+ (built-in
+ (insert (propertize "Built-in"
+ 'font-lock-face 'font-lock-builtin-face) "."))
+ (t (insert "Deleted.")))
+ (insert "\n")
+ (and version
+ (> (length version) 0)
+ (insert " "
+ (propertize "Version" 'font-lock-face 'bold) ": " version "\n"))
(setq reqs (package-desc-reqs desc))
(when reqs
- (insert " Requires: ")
+ (insert " " (propertize "Requires" 'font-lock-face 'bold) ": ")
(let ((first t)
name vers text)
(dolist (req reqs)
@@ -1110,28 +1133,53 @@ The variable `package-load-list' controls which packages to load."
(t (insert ", ")))
(help-insert-xref-button text 'help-package name))
(insert "\n")))
- (insert " Description: " (package-desc-doc desc) "\n")
- ;; Todo: button for uninstalling a package.
- (when installable
- (let ((button-text (if (display-graphic-p)
- "Install"
- "[Install]"))
- (button-face (if (display-graphic-p)
- '(:box (:line-width 2 :color "dark grey")
- :background "light grey"
- :foreground "black")
- 'link)))
- (insert "\n")
- (insert-text-button button-text
- 'face button-face
- 'follow-link t
- 'package-symbol package
- 'action (lambda (button)
- (package-install
- (button-get button 'package-symbol))
- (revert-buffer nil t)
- (goto-char (point-min))))
- (insert "\n")))))
+ (insert " " (propertize "Summary" 'font-lock-face 'bold)
+ ": " (package-desc-doc desc) "\n\n")
+
+ (if (assq package package--builtins)
+ ;; For built-in packages, insert the commentary.
+ (let ((fn (locate-file (concat package-name ".el") load-path
+ load-file-rep-suffixes))
+ (opoint (point)))
+ (insert (or (lm-commentary fn) ""))
+ (save-excursion
+ (goto-char opoint)
+ (when (re-search-forward "^;;; Commentary:\n" nil t)
+ (replace-match ""))
+ (while (re-search-forward "^\\(;+ ?\\)" nil t)
+ (replace-match ""))))
+ (let ((readme (expand-file-name (concat package-name "-readme.txt")
+ package-user-dir)))
+ ;; For elpa packages, try downloading the commentary. If that
+ ;; fails, try an existing readme file in `package-user-dir'.
+ (cond ((let ((buffer (ignore-errors
+ (url-retrieve-synchronously
+ (concat (package-archive-url package)
+ package-name "-readme.txt"))))
+ response)
+ (when buffer
+ (with-current-buffer buffer
+ (setq response (url-http-parse-response))
+ (if (or (< response 200) (>= response 300))
+ (setq response nil)
+ (setq buffer-file-name
+ (expand-file-name readme package-user-dir))
+ (delete-region (point-min) (1+ url-http-end-of-headers))
+ (save-buffer)))
+ (when response
+ (insert-buffer-substring buffer)
+ (kill-buffer buffer)
+ t))))
+ ((file-readable-p readme)
+ (insert-file-contents readme)
+ (goto-char (point-max))))))))
+
+(defun package-install-button-action (button)
+ (let ((package (button-get button 'package-symbol)))
+ (when (y-or-n-p (format "Install package `%s'? " package))
+ (package-install package)
+ (revert-buffer nil t)
+ (goto-char (point-min)))))
;;;; Package menu mode.
@@ -1148,12 +1196,14 @@ The variable `package-load-list' controls which packages to load."
(define-key map "\177" 'package-menu-backup-unmark)
(define-key map "d" 'package-menu-mark-delete)
(define-key map "i" 'package-menu-mark-install)
- (define-key map "g" 'package-menu-revert)
+ (define-key map "g" 'revert-buffer)
(define-key map "r" 'package-menu-refresh)
(define-key map "~" 'package-menu-mark-obsolete-for-deletion)
(define-key map "x" 'package-menu-execute)
(define-key map "h" 'package-menu-quick-help)
- (define-key map "?" 'package-menu-view-commentary)
+ (define-key map "?" 'package-menu-describe-package)
+ (define-key map [follow-link] 'mouse-face)
+ (define-key map [mouse-2] 'mouse-select-window)
(define-key map [menu-bar package-menu] (cons "Package" menu-map))
(define-key menu-map [mq]
'(menu-item "Quit" quit-window
@@ -1180,7 +1230,7 @@ The variable `package-load-list' controls which packages to load."
:help "Mark a package for installation and move to the next line"))
(define-key menu-map [s3] '("--"))
(define-key menu-map [mg]
- '(menu-item "Update package list" package-menu-revert
+ '(menu-item "Update package list" revert-buffer
:help "Update the list of packages"))
(define-key menu-map [mr]
'(menu-item "Refresh package list" package-menu-refresh
@@ -1205,6 +1255,7 @@ The variable `package-load-list' controls which packages to load."
(defvar package-menu-sort-button-map
(let ((map (make-sparse-keymap)))
(define-key map [header-line mouse-1] 'package-menu-sort-by-column)
+ (define-key map [header-line mouse-2] 'package-menu-sort-by-column)
(define-key map [follow-link] 'mouse-face)
map)
"Local keymap for package menu sort buttons.")
@@ -1222,25 +1273,52 @@ Letters do not insert themselves; instead, they are commands.
(setq mode-name "Package Menu")
(setq truncate-lines t)
(setq buffer-read-only t)
- ;; Support Emacs 21.
- (if (fboundp 'run-mode-hooks)
- (run-mode-hooks 'package-menu-mode-hook)
- (run-hooks 'package-menu-mode-hook)))
+ (setq revert-buffer-function 'package-menu-revert)
+ (setq header-line-format
+ (mapconcat
+ (lambda (pair)
+ (let ((column (car pair))
+ (name (cdr pair)))
+ (concat
+ ;; Insert a space that aligns the button properly.
+ (propertize " " 'display (list 'space :align-to column)
+ 'face 'fixed-pitch)
+ ;; Set up the column button.
+ (propertize name
+ 'column-name name
+ 'help-echo "mouse-1: sort by column"
+ 'mouse-face 'highlight
+ 'keymap package-menu-sort-button-map))))
+ ;; We take a trick from buff-menu and have a dummy leading
+ ;; space to align the header line with the beginning of the
+ ;; text. This doesn't really work properly on Emacs 21, but
+ ;; it is close enough.
+ '((0 . "")
+ (2 . "Package")
+ (20 . "Version")
+ (32 . "Status")
+ (43 . "Description"))
+ ""))
+ (run-mode-hooks 'package-menu-mode-hook))
(defun package-menu-refresh ()
- "Download the ELPA archive.
-This fetches the file describing the current contents of
-the Emacs Lisp Package Archive, and then refreshes the
-package menu. This lets you see what new packages are
-available for download."
+ "Download the Emacs Lisp package archive.
+This fetches the contents of each archive specified in
+`package-archives', and then refreshes the package menu."
(interactive)
+ (unless (eq major-mode 'package-menu-mode)
+ (error "The current buffer is not a Package Menu"))
(package-refresh-contents)
- (package-list-packages-internal))
+ (package--generate-package-list))
-(defun package-menu-revert ()
- "Update the list of packages."
+(defun package-menu-revert (&optional arg noconfirm)
+ "Update the list of packages.
+This function is the `revert-buffer-function' for Package Menu
+buffers. The arguments are ignored."
(interactive)
- (package-list-packages-internal))
+ (unless (eq major-mode 'package-menu-mode)
+ (error "The current buffer is not a Package Menu"))
+ (package--generate-package-list))
(defun package-menu-describe-package ()
"Describe the package in the current line."
@@ -1297,32 +1375,8 @@ available for download."
(interactive)
(message "n-ext, i-nstall, d-elete, u-nmark, x-ecute, r-efresh, h-elp"))
-(defun package-menu-view-commentary ()
- "Display information about this package.
-For single-file packages, shows the commentary section from the header.
-For larger packages, shows the README file."
- (interactive)
- (let* ((pkg-name (package-menu-get-package))
- (buffer (url-retrieve-synchronously
- (concat (package-archive-url pkg-name)
- pkg-name
- "-readme.txt")))
- start-point ok)
- (with-current-buffer buffer
- ;; FIXME: it would be nice to work with any URL type.
- (setq start-point url-http-end-of-headers)
- (setq ok (eq (url-http-parse-response) 200)))
- (let ((new-buffer (get-buffer-create "*Package Info*")))
- (with-current-buffer new-buffer
- (let ((buffer-read-only nil))
- (erase-buffer)
- (insert "Package information for " pkg-name "\n\n")
- (if ok
- (insert-buffer-substring buffer start-point)
- (insert "This package lacks a README file or commentary.\n"))
- (goto-char (point-min))
- (view-mode)))
- (display-buffer new-buffer t))))
+(define-obsolete-function-alias
+ 'package-menu-view-commentary 'package-menu-describe-package "24.1")
;; Return the name of the package on the current line.
(defun package-menu-get-package ()
@@ -1405,151 +1459,161 @@ Emacs."
(defun package-list-maybe-add (package version status description result)
(unless (assoc (cons package version) result)
- (setq result (cons (list (cons package version) status description)
- result)))
+ (push (list (cons package version) status description) result))
result)
-;; This decides how we should sort; nil means by package name.
-(defvar package-menu-sort-key nil)
+(defvar package-menu-package-list nil
+ "List of packages to display in the Package Menu buffer.
+A value of nil means to display all packages.")
-(defun package-list-packages-internal ()
- (package-initialize) ; FIXME: do this here?
- (with-current-buffer (get-buffer-create "*Packages*")
+(defvar package-menu-sort-key nil
+ "Sort key for the current Package Menu buffer.")
+
+(defun package--generate-package-list ()
+ "Populate the current Package Menu buffer."
+ (package-initialize)
+ (let ((inhibit-read-only t)
+ info-list name desc hold builtin)
(setq buffer-read-only nil)
(erase-buffer)
- (let ((info-list)
- name desc hold
- builtin)
- ;; List installed packages
- (dolist (elt package-alist)
- ;; Ignore the Emacs package.
- (setq name (car elt)
- desc (cdr elt)
- hold (assq name package-load-list))
- (unless (eq name 'emacs)
- (setq info-list
- (package-list-maybe-add
- name (package-desc-vers desc)
- ;; FIXME: it turns out to be tricky to see if this
- ;; package is presently activated.
- (cond ((stringp (cadr hold))
- "held")
- ((and (setq builtin (assq name package--builtins))
- (version-list-=
- (package-desc-vers (cdr builtin))
- (package-desc-vers desc)))
- "built-in")
- (t "installed"))
- (package-desc-doc desc)
- info-list))))
- ;; List available packages
- (dolist (elt package-archive-contents)
- (setq name (car elt)
- desc (cdr elt)
- hold (assq name package-load-list))
- (unless (and hold (stringp (cadr hold))
- (package-installed-p
- name (version-to-list (cadr hold))))
- (setq info-list
- (package-list-maybe-add name
- (package-desc-vers desc)
- (if (and hold (null (cadr hold)))
- "disabled"
- "available")
- (package-desc-doc (cdr elt))
- info-list))))
- ;; List obsolete packages
- (mapc (lambda (elt)
- (mapc (lambda (inner-elt)
- (setq info-list
- (package-list-maybe-add (car elt)
- (package-desc-vers
- (cdr inner-elt))
- "obsolete"
- (package-desc-doc
- (cdr inner-elt))
- info-list)))
- (cdr elt)))
- package-obsolete-alist)
- (let ((selector (cond
- ((string= package-menu-sort-key "Version")
- ;; FIXME this doesn't work.
- #'(lambda (e) (cdr (car e))))
- ((string= package-menu-sort-key "Status")
- #'(lambda (e) (car (cdr e))))
- ((string= package-menu-sort-key "Description")
- #'(lambda (e) (car (cdr (cdr e)))))
- (t ; "Package" is default.
- #'(lambda (e) (symbol-name (car (car e))))))))
+ ;; List installed packages
+ (dolist (elt package-alist)
+ (setq name (car elt))
+ (when (and (not (eq name 'emacs)) ; Hide the `emacs' package.
+ (or (null package-menu-package-list)
+ (memq name package-menu-package-list)))
+ (setq desc (cdr elt)
+ hold (cadr (assq name package-load-list))
+ builtin (cdr (assq name package--builtins)))
+ (setq info-list
+ (package-list-maybe-add
+ name (package-desc-vers desc)
+ ;; FIXME: it turns out to be tricky to see if this
+ ;; package is presently activated.
+ (cond ((stringp hold) "held")
+ ((and builtin
+ (version-list-=
+ (package-desc-vers builtin)
+ (package-desc-vers desc)))
+ "built-in")
+ (t "installed"))
+ (package-desc-doc desc)
+ info-list))))
+
+ ;; List available and disabled packages
+ (dolist (elt package-archive-contents)
+ (setq name (car elt)
+ desc (cdr elt)
+ hold (assq name package-load-list))
+ (when (or (null package-menu-package-list)
+ (memq name package-menu-package-list))
(setq info-list
- (sort info-list
- (lambda (left right)
- (let ((vleft (funcall selector left))
- (vright (funcall selector right)))
- (string< vleft vright))))))
- (mapc (lambda (elt)
- (package-print-package (car (car elt))
- (cdr (car elt))
- (car (cdr elt))
- (car (cdr (cdr elt)))))
- info-list))
+ (package-list-maybe-add name
+ (package-desc-vers desc)
+ (if (and hold (null (cadr hold)))
+ "disabled"
+ "available")
+ (package-desc-doc (cdr elt))
+ info-list))))
+ ;; List obsolete packages
+ (mapc (lambda (elt)
+ (mapc (lambda (inner-elt)
+ (setq info-list
+ (package-list-maybe-add (car elt)
+ (package-desc-vers
+ (cdr inner-elt))
+ "obsolete"
+ (package-desc-doc
+ (cdr inner-elt))
+ info-list)))
+ (cdr elt)))
+ package-obsolete-alist)
+
+ (setq info-list
+ (sort info-list
+ (cond ((string= package-menu-sort-key "Package")
+ 'package-menu--name-predicate)
+ ((string= package-menu-sort-key "Version")
+ 'package-menu--version-predicate)
+ ((string= package-menu-sort-key "Description")
+ 'package-menu--description-predicate)
+ (t ; By default, sort by package status
+ 'package-menu--status-predicate))))
+
+ (dolist (elt info-list)
+ (package-print-package (car (car elt))
+ (cdr (car elt))
+ (car (cdr elt))
+ (car (cdr (cdr elt)))))
(goto-char (point-min))
+ (set-buffer-modified-p nil)
(current-buffer)))
+(defun package-menu--version-predicate (left right)
+ (let ((vleft (or (cdr (car left)) '(0)))
+ (vright (or (cdr (car right)) '(0))))
+ (if (version-list-= vleft vright)
+ (package-menu--name-predicate left right)
+ (version-list-< vleft vright))))
+
+(defun package-menu--status-predicate (left right)
+ (let ((sleft (cadr left))
+ (sright (cadr right)))
+ (cond ((string= sleft sright)
+ (package-menu--name-predicate left right))
+ ((string= sleft "available") t)
+ ((string= sright "available") nil)
+ ((string= sleft "installed") t)
+ ((string= sright "installed") nil)
+ ((string= sleft "held") t)
+ ((string= sright "held") nil)
+ ((string= sleft "built-in") t)
+ ((string= sright "built-in") nil)
+ ((string= sleft "obsolete") t)
+ ((string= sright "obsolete") nil)
+ (t (string< sleft sright)))))
+
+(defun package-menu--description-predicate (left right)
+ (let ((sleft (car (cddr left)))
+ (sright (car (cddr right))))
+ (if (string= sleft sright)
+ (package-menu--name-predicate left right)
+ (string< sleft sright))))
+
+(defun package-menu--name-predicate (left right)
+ (string< (symbol-name (caar left))
+ (symbol-name (caar right))))
+
(defun package-menu-sort-by-column (&optional e)
- "Sort the package menu by the last column clicked on."
- (interactive (list last-input-event))
- (if e (mouse-select-window e))
+ "Sort the package menu by the column of the mouse click E."
+ (interactive "e")
(let* ((pos (event-start e))
(obj (posn-object pos))
(col (if obj
(get-text-property (cdr obj) 'column-name (car obj))
- (get-text-property (posn-point pos) 'column-name))))
- (setq package-menu-sort-key col))
- (package-list-packages-internal))
-
-(defun package--list-packages ()
- "Display a list of packages.
-Helper function that does all the work for the user-facing functions."
- (with-current-buffer (package-list-packages-internal)
+ (get-text-property (posn-point pos) 'column-name)))
+ (buf (window-buffer (posn-window (event-start e)))))
+ (with-current-buffer buf
+ (when (eq major-mode 'package-menu-mode)
+ (setq package-menu-sort-key col)
+ (package--generate-package-list)))))
+
+(defun package--list-packages (&optional packages)
+ "Generate and pop to the *Packages* buffer.
+Optional PACKAGES is a list of names of packages (symbols) to
+list; the default is to display everything in `package-alist'."
+ (with-current-buffer (get-buffer-create "*Packages*")
(package-menu-mode)
- ;; Set up the header line.
- (setq header-line-format
- (mapconcat
- (lambda (pair)
- (let ((column (car pair))
- (name (cdr pair)))
- (concat
- ;; Insert a space that aligns the button properly.
- (propertize " " 'display (list 'space :align-to column)
- 'face 'fixed-pitch)
- ;; Set up the column button.
- (if (string= name "Version")
- name
- (propertize name
- 'column-name name
- 'help-echo "mouse-1: sort by column"
- 'mouse-face 'highlight
- 'keymap package-menu-sort-button-map)))))
- ;; We take a trick from buff-menu and have a dummy leading
- ;; space to align the header line with the beginning of the
- ;; text. This doesn't really work properly on Emacs 21,
- ;; but it is close enough.
- '((0 . "")
- (2 . "Package")
- (20 . "Version")
- (32 . "Status")
- (43 . "Description"))
- ""))
-
+ (set (make-local-variable 'package-menu-package-list) packages)
+ (set (make-local-variable 'package-menu-sort-key) nil)
+ (package--generate-package-list)
;; It's okay to use pop-to-buffer here. The package menu buffer
- ;; has keybindings, and the user just typed 'M-x
- ;; package-list-packages', suggesting that they might want to use
- ;; them.
+ ;; has keybindings, and the user just typed `M-x list-packages',
+ ;; suggesting that they might want to use them.
(pop-to-buffer (current-buffer))))
;;;###autoload
-(defun package-list-packages ()
+(defun list-packages ()
"Display a list of packages.
Fetches the updated list of packages before displaying.
The list is displayed in a buffer named `*Packages*'."
@@ -1557,6 +1621,9 @@ The list is displayed in a buffer named `*Packages*'."
(package-refresh-contents)
(package--list-packages))
+;;;###autoload
+(defalias 'package-list-packages 'list-packages)
+
(defun package-list-packages-no-fetch ()
"Display a list of packages.
Does not fetch the updated list of packages before displaying.
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 03d760b2df..b2b27a0e0d 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -1,6 +1,6 @@
;;; pcase.el --- ML-style pattern-matching macro for Elisp
-;; Copyright (C) 2010 Stefan Monnier
+;; Copyright (C) 2010 Free Software Foundation, Inc.
;; Author: Stefan Monnier <[email protected]>
;; Keywords:
@@ -290,9 +290,13 @@ MATCH is the pattern that needs to be matched, of the form:
(defun pcase-split-memq (elems pat)
;; Based on pcase-split-eq.
(cond
- ;; The same match will give the same result.
+ ;; The same match will give the same result, but we don't know how
+ ;; to check it.
+ ;; (???
+ ;; (cons :pcase-succeed nil))
+ ;; A match for one of the elements may succeed or fail.
((and (eq (car-safe pat) '\`) (member (cadr pat) elems))
- (cons :pcase-succeed nil))
+ nil)
;; A different match will fail if this one succeeds.
((and (eq (car-safe pat) '\`)
;; (or (integerp (cadr pat)) (symbolp (cadr pat))
@@ -383,18 +387,20 @@ and otherwise defers to REST which is a list of branches of the form
`(,(cadr upat) ,sym)
(let* ((exp (cadr upat))
;; `vs' is an upper bound on the vars we need.
- (vs (pcase-fgrep (mapcar #'car vars) exp)))
- (if vs
- ;; Let's not replace `vars' in `exp' since it's
- ;; too difficult to do it right, instead just
- ;; let-bind `vars' around `exp'.
- `(let ,(mapcar (lambda (var)
- (list var (cdr (assq var vars))))
- vs)
- ;; FIXME: `vars' can capture `sym'. E.g.
- ;; (pcase x ((and `(,x . ,y) (pred (fun x)))))
- (,@exp ,sym))
- `(,@exp ,sym))))
+ (vs (pcase-fgrep (mapcar #'car vars) exp))
+ (call (if (functionp exp)
+ `(,exp ,sym) `(,@exp ,sym))))
+ (if (null vs)
+ call
+ ;; Let's not replace `vars' in `exp' since it's
+ ;; too difficult to do it right, instead just
+ ;; let-bind `vars' around `exp'.
+ `(let ,(mapcar (lambda (var)
+ (list var (cdr (assq var vars))))
+ vs)
+ ;; FIXME: `vars' can capture `sym'. E.g.
+ ;; (pcase x ((and `(,x . ,y) (pred (fun x)))))
+ ,call))))
(pcase-u1 matches code vars then-rest)
(pcase-u else-rest))))
((symbolp upat)
@@ -483,7 +489,7 @@ and if not, defers to REST which is a list of branches of the form
(pcase-u1 matches code vars then-rest)
(pcase-u else-rest))))
(t (error "Unkown QPattern %s" qpat))))
-
+
(provide 'pcase)
;;; pcase.el ends here
diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el
index 78eba19a25..a149474157 100644
--- a/lisp/emacs-lisp/regexp-opt.el
+++ b/lisp/emacs-lisp/regexp-opt.el
@@ -120,7 +120,7 @@ This means the number of non-shy regexp grouping constructs
(string-match regexp "")
;; Count the number of open parentheses in REGEXP.
(let ((count 0) start last)
- (while (string-match "\\\\(\\(\\?:\\)?" regexp start)
+ (while (string-match "\\\\(\\(\\?[0-9]*:\\)?" regexp start)
(setq start (match-end 0)) ; Start of next search.
(when (and (not (match-beginning 1))
(subregexp-context-p regexp (match-beginning 0) last))
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index 85fe3514b0..522d452c2d 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -427,7 +427,7 @@ Only both edges of each range is checked."
(mapcar (lambda (e)
(cond
((= (car e) (cdr e)) (list (car e)))
- ;; ((= (1+ (car e)) (cdr e)) (list (car e) (cdr e)))
+ ((= (1+ (car e)) (cdr e)) (list (car e) (cdr e)))
((list e))))
l))
(delete-dups str))))
@@ -545,7 +545,10 @@ ARG is optional."
((numberp e) (string e))
((consp e)
(if (and (= (1+ (car e)) (cdr e))
- (null (memq (car e) '(?\] ?-))))
+ ;; rx-any-condense-range should
+ ;; prevent this case from happening.
+ (null (memq (car e) '(?\] ?-)))
+ (null (memq (cdr e) '(?\] ?-))))
(string (car e) (cdr e))
(string (car e) ?- (cdr e))))
(e)))
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index fb1e4737d3..c6df851b0e 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -65,6 +65,9 @@
;;; Code:
+;; FIXME: I think the behavior on empty lines is wrong. It shouldn't
+;; look at the next token on subsequent lines.
+
(eval-when-compile (require 'cl))
(defvar comment-continue)
@@ -72,6 +75,26 @@
;;; Building precedence level tables from BNF specs.
+;; We have 4 different representations of a "grammar":
+;; - a BNF table, which is a list of BNF rules of the form
+;; (NONTERM RHS1 ... RHSn) where each RHS is a list of terminals (tokens)
+;; or nonterminals. Any element in these lists which does not appear as
+;; the `car' of a BNF rule is taken to be a terminal.
+;; - A list of precedences (key word "precs"), is a list, sorted
+;; from lowest to highest precedence, of precedence classes that
+;; have the form (ASSOCIATIVITY TERMINAL1 .. TERMINALn), where
+;; ASSOCIATIVITY can be `assoc', `left', `right' or `nonassoc'.
+;; - a 2 dimensional precedence table (key word "prec2"), is a 2D
+;; table recording the precedence relation (can be `<', `=', `>', or
+;; nil) between each pair of tokens.
+;; - a precedence-level table (key word "levels"), while is a alist
+;; giving for each token its left and right precedence level (a
+;; number or nil). This is used in `smie-op-levels'.
+;; The prec2 tables are only intermediate data structures: the source
+;; code normally provides a mix of BNF and precs tables, and then
+;; turns them into a levels table, which is what's used by the rest of
+;; the SMIE code.
+
(defun smie-set-prec2tab (table x y val &optional override)
(assert (and x y))
(let* ((key (cons x y))
@@ -155,9 +178,9 @@ one of those elements share the same precedence level and associativity."
(if (not (member (car shr) nts))
(pushnew (car shr) last-ops)
(pushnew (car shr) last-nts)
- (when (consp (cdr shr))
- (assert (not (member (cadr shr) nts)))
- (pushnew (cadr shr) last-ops)))))
+ (when (consp (cdr shr))
+ (assert (not (member (cadr shr) nts)))
+ (pushnew (cadr shr) last-ops)))))
(push (cons nt first-ops) first-ops-table)
(push (cons nt last-ops) last-ops-table)
(push (cons nt first-nts) first-nts-table)
@@ -203,13 +226,105 @@ one of those elements share the same precedence level and associativity."
(setq rhs (cdr rhs)))))
prec2))
+;; (defun smie-prec2-closer-alist (prec2 include-inners)
+;; "Build a closer-alist from a PREC2 table.
+;; The return value is in the same form as `smie-closer-alist'.
+;; INCLUDE-INNERS if non-nil means that inner keywords will be included
+;; in the table, e.g. the table will include things like (\"if\" . \"else\")."
+;; (let* ((non-openers '())
+;; (non-closers '())
+;; ;; For each keyword, this gives the matching openers, if any.
+;; (openers (make-hash-table :test 'equal))
+;; (closers '())
+;; (done nil))
+;; ;; First, find the non-openers and non-closers.
+;; (maphash (lambda (k v)
+;; (unless (or (eq v '<) (member (cdr k) non-openers))
+;; (push (cdr k) non-openers))
+;; (unless (or (eq v '>) (member (car k) non-closers))
+;; (push (car k) non-closers)))
+;; prec2)
+;; ;; Then find the openers and closers.
+;; (maphash (lambda (k _)
+;; (unless (member (car k) non-openers)
+;; (puthash (car k) (list (car k)) openers))
+;; (unless (or (member (cdr k) non-closers)
+;; (member (cdr k) closers))
+;; (push (cdr k) closers)))
+;; prec2)
+;; ;; Then collect the matching elements.
+;; (while (not done)
+;; (setq done t)
+;; (maphash (lambda (k v)
+;; (when (eq v '=)
+;; (let ((aopeners (gethash (car k) openers))
+;; (dopeners (gethash (cdr k) openers))
+;; (new nil))
+;; (dolist (o aopeners)
+;; (unless (member o dopeners)
+;; (setq new t)
+;; (push o dopeners)))
+;; (when new
+;; (setq done nil)
+;; (puthash (cdr k) dopeners openers)))))
+;; prec2))
+;; ;; Finally, dump the resulting table.
+;; (let ((alist '()))
+;; (maphash (lambda (k v)
+;; (when (or include-inners (member k closers))
+;; (dolist (opener v)
+;; (unless (equal opener k)
+;; (push (cons opener k) alist)))))
+;; openers)
+;; alist)))
+
+(defun smie-bnf-closer-alist (bnf &optional no-inners)
+ ;; We can also build this closer-alist table from a prec2 table,
+ ;; but it takes more work, and the order is unpredictable, which
+ ;; is a problem for smie-close-block.
+ ;; More convenient would be to build it from a levels table since we
+ ;; always have this table (contrary to the BNF), but it has all the
+ ;; disadvantages of the prec2 case plus the disadvantage that the levels
+ ;; table has lost some info which would result in extra invalid pairs.
+ "Build a closer-alist from a BNF table.
+The return value is in the same form as `smie-closer-alist'.
+NO-INNERS if non-nil means that inner keywords will be excluded
+from the table, e.g. the table will not include things like (\"if\" . \"else\")."
+ (let ((nts (mapcar #'car bnf)) ;non terminals.
+ (alist '()))
+ (dolist (nt bnf)
+ (dolist (rhs (cdr nt))
+ (unless (or (< (length rhs) 2) (member (car rhs) nts))
+ (if no-inners
+ (let ((last (car (last rhs))))
+ (unless (member last nts)
+ (pushnew (cons (car rhs) last) alist :test #'equal)))
+ ;; Reverse so that the "real" closer gets there first,
+ ;; which is important for smie-close-block.
+ (dolist (term (reverse (cdr rhs)))
+ (unless (member term nts)
+ (pushnew (cons (car rhs) term) alist :test #'equal)))))))
+ (nreverse alist)))
+
+
(defun smie-prec2-levels (prec2)
+ ;; FIXME: Rather than only return an alist of precedence levels, we should
+ ;; also extract other useful data from it:
+ ;; - matching sets of block openers&closers (which can otherwise become
+ ;; collapsed into a single equivalence class in smie-op-levels) for
+ ;; smie-close-block as well as to detect mismatches in smie-next-sexp
+ ;; or in blink-paren (as well as to do the blink-paren for inner
+ ;; keywords like the "in" of "let..in..end").
+ ;; - better default indentation rules (i.e. non-zero indentation after inner
+ ;; keywords like the "in" of "let..in..end") for smie-indent-after-keyword.
+ ;; Of course, maybe those things would be even better handled in the
+ ;; bnf->prec function.
"Take a 2D precedence table and turn it into an alist of precedence levels.
PREC2 is a table as returned by `smie-precs-precedence-table' or
`smie-bnf-precedence-table'."
;; For each operator, we create two "variables" (corresponding to
;; the left and right precedence level), which are represented by
- ;; cons cells. Those are the vary cons cells that appear in the
+ ;; cons cells. Those are the very cons cells that appear in the
;; final `table'. The value of each "variable" is kept in the `car'.
(let ((table ())
(csts ())
@@ -268,7 +383,7 @@ PREC2 is a table as returned by `smie-precs-precedence-table' or
;; distinguish associative operators (which will have
;; left = right).
(unless (caar cst)
- (setcar (car cst) i)
+ (setcar (car cst) i)
(incf i))
(setq csts (delq cst csts))))
(unless progress
@@ -321,32 +436,30 @@ it should move backward to the beginning of the previous token.")
(defun smie-default-backward-token ()
(forward-comment (- (point)))
- (buffer-substring (point)
- (progn (if (zerop (skip-syntax-backward "."))
- (skip-syntax-backward "w_'"))
- (point))))
+ (buffer-substring-no-properties
+ (point)
+ (progn (if (zerop (skip-syntax-backward "."))
+ (skip-syntax-backward "w_'"))
+ (point))))
(defun smie-default-forward-token ()
(forward-comment (point-max))
- (buffer-substring (point)
- (progn (if (zerop (skip-syntax-forward "."))
- (skip-syntax-forward "w_'"))
- (point))))
+ (buffer-substring-no-properties
+ (point)
+ (progn (if (zerop (skip-syntax-forward "."))
+ (skip-syntax-forward "w_'"))
+ (point))))
(defun smie-associative-p (toklevels)
;; in "a + b + c" we want to stop at each +, but in
- ;; "if a then b else c" we don't want to stop at each keyword.
+ ;; "if a then b elsif c then d else c" we don't want to stop at each keyword.
;; To distinguish the two cases, we made smie-prec2-levels choose
;; different levels for each part of "if a then b else c", so that
;; by checking if the left-level is equal to the right level, we can
;; figure out that it's an associative operator.
- ;; This is not 100% foolproof, tho, since a grammar like
- ;; (exp ("A" exp "C") ("A" exp "B" exp "C"))
- ;; will cause "B" to have equal left and right levels, even though
- ;; it is not an associative operator.
- ;; A better check would be the check the actual previous operator
- ;; against this one to see if it's the same, but we'd have to change
- ;; `levels' to keep a stack of operators rather than only levels.
+ ;; This is not 100% foolproof, tho, since the "elsif" will have to have
+ ;; equal left and right levels (since it's optional), so smie-next-sexp
+ ;; has to be careful to distinguish those different cases.
(eq (smie-op-left toklevels) (smie-op-right toklevels)))
(defun smie-next-sexp (next-token next-sexp op-forw op-back halfsexp)
@@ -371,51 +484,71 @@ Possible return values:
(let* ((pos (point))
(token (funcall next-token))
(toklevels (cdr (assoc token smie-op-levels))))
-
(cond
((null toklevels)
(when (zerop (length token))
- (condition-case err
- (progn (goto-char pos) (funcall next-sexp 1) nil)
- (scan-error (throw 'return (list t (caddr err)))))
+ (condition-case err
+ (progn (goto-char pos) (funcall next-sexp 1) nil)
+ (scan-error (throw 'return
+ (list t (caddr err)
+ (buffer-substring-no-properties
+ (caddr err)
+ (+ (caddr err)
+ (if (< (point) (caddr err))
+ -1 1)))))))
(if (eq pos (point))
;; We did not move, so let's abort the loop.
(throw 'return (list t (point))))))
((null (funcall op-back toklevels))
;; A token like a paren-close.
(assert (funcall op-forw toklevels)) ;Otherwise, why mention it?
- (push (funcall op-forw toklevels) levels))
+ (push toklevels levels))
(t
- (while (and levels (< (funcall op-back toklevels) (car levels)))
+ (while (and levels (< (funcall op-back toklevels)
+ (funcall op-forw (car levels))))
(setq levels (cdr levels)))
(cond
((null levels)
(if (and halfsexp (funcall op-forw toklevels))
- (push (funcall op-forw toklevels) levels)
+ (push toklevels levels)
(throw 'return
(prog1 (list (or (car toklevels) t) (point) token)
(goto-char pos)))))
(t
- (if (and levels (= (funcall op-back toklevels) (car levels)))
- (setq levels (cdr levels)))
- (cond
- ((null levels)
+ (let ((lastlevels levels))
+ (if (and levels (= (funcall op-back toklevels)
+ (funcall op-forw (car levels))))
+ (setq levels (cdr levels)))
+ ;; We may have found a match for the previously pending
+ ;; operator. Is this the end?
(cond
+ ;; Keep looking as long as we haven't matched the
+ ;; topmost operator.
+ (levels
+ (if (funcall op-forw toklevels)
+ (push toklevels levels)))
+ ;; We matched the topmost operator. If the new operator
+ ;; is the last in the corresponding BNF rule, we're done.
((null (funcall op-forw toklevels))
+ ;; It is the last element, let's stop here.
(throw 'return (list nil (point) token)))
- ((smie-associative-p toklevels)
+ ;; If the new operator is not the last in the BNF rule,
+ ;; ans is not associative, it's one of the inner operators
+ ;; (like the "in" in "let .. in .. end"), so keep looking.
+ ((not (smie-associative-p toklevels))
+ (push toklevels levels))
+ ;; The new operator is associative. Two cases:
+ ;; - it's really just an associative operator (like + or ;)
+ ;; in which case we should have stopped right before.
+ ((and lastlevels
+ (smie-associative-p (car lastlevels)))
(throw 'return
(prog1 (list (or (car toklevels) t) (point) token)
(goto-char pos))))
- ;; We just found a match to the previously pending operator
- ;; but this new operator is still part of a larger RHS.
- ;; E.g. we're now looking at the "then" in
- ;; "if a then b else c". So we have to keep parsing the
- ;; rest of the construct.
- (t (push (funcall op-forw toklevels) levels))))
- (t
- (if (funcall op-forw toklevels)
- (push (funcall op-forw toklevels) levels))))))))
+ ;; - it's an associative operator within a larger construct
+ ;; (e.g. an "elsif"), so we should just ignore it and keep
+ ;; looking for the closing element.
+ (t (setq levels lastlevels))))))))
levels)
(setq halfsexp nil)))))
@@ -430,11 +563,11 @@ Possible return values:
(t POS TOKEN): same thing but for an open-paren or the beginning of buffer.
(nil POS TOKEN): we skipped over a paren-like pair.
nil: we skipped over an identifier, matched parentheses, ..."
- (smie-next-sexp
- (indirect-function smie-backward-token-function)
- (indirect-function 'backward-sexp)
- (indirect-function 'smie-op-left)
- (indirect-function 'smie-op-right)
+ (smie-next-sexp
+ (indirect-function smie-backward-token-function)
+ (indirect-function 'backward-sexp)
+ (indirect-function 'smie-op-left)
+ (indirect-function 'smie-op-right)
halfsexp))
(defun smie-forward-sexp (&optional halfsexp)
@@ -448,44 +581,196 @@ Possible return values:
(t POS TOKEN): same thing but for an open-paren or the beginning of buffer.
(nil POS TOKEN): we skipped over a paren-like pair.
nil: we skipped over an identifier, matched parentheses, ..."
- (smie-next-sexp
- (indirect-function smie-forward-token-function)
- (indirect-function 'forward-sexp)
- (indirect-function 'smie-op-right)
- (indirect-function 'smie-op-left)
+ (smie-next-sexp
+ (indirect-function smie-forward-token-function)
+ (indirect-function 'forward-sexp)
+ (indirect-function 'smie-op-right)
+ (indirect-function 'smie-op-left)
halfsexp))
+;;; Miscellanous commands using the precedence parser.
+
(defun smie-backward-sexp-command (&optional n)
"Move backward through N logical elements."
- (interactive "p")
- (if (< n 0)
- (smie-forward-sexp-command (- n))
- (let ((forward-sexp-function nil))
- (while (> n 0)
- (decf n)
- (let ((pos (point))
- (res (smie-backward-sexp 'halfsexp)))
- (if (and (car res) (= pos (point)) (not (bolp)))
- (signal 'scan-error
- (list "Containing expression ends prematurely"
- (cadr res) (cadr res)))
- nil))))))
+ (interactive "^p")
+ (smie-forward-sexp-command (- n)))
(defun smie-forward-sexp-command (&optional n)
"Move forward through N logical elements."
+ (interactive "^p")
+ (let ((forw (> n 0))
+ (forward-sexp-function nil))
+ (while (/= n 0)
+ (setq n (- n (if forw 1 -1)))
+ (let ((pos (point))
+ (res (if forw
+ (smie-forward-sexp 'halfsexp)
+ (smie-backward-sexp 'halfsexp))))
+ (if (and (car res) (= pos (point)) (not (if forw (eobp) (bobp))))
+ (signal 'scan-error
+ (list "Containing expression ends prematurely"
+ (cadr res) (cadr res)))
+ nil)))))
+
+(defvar smie-closer-alist nil
+ "Alist giving the closer corresponding to an opener.")
+
+(defun smie-close-block ()
+ "Close the closest surrounding block."
+ (interactive)
+ (let ((closer
+ (save-excursion
+ (backward-up-list 1)
+ (if (looking-at "\\s(")
+ (string (cdr (syntax-after (point))))
+ (let* ((open (funcall smie-forward-token-function))
+ (closer (cdr (assoc open smie-closer-alist)))
+ (levels (list (assoc open smie-op-levels)))
+ (seen '())
+ (found '()))
+ (cond
+ ;; Even if we improve the auto-computation of closers,
+ ;; there are still cases where we need manual
+ ;; intervention, e.g. for Octave's use of `until'
+ ;; as a pseudo-closer of `do'.
+ (closer)
+ ((or (equal levels '(nil)) (nth 1 (car levels)))
+ (error "Doesn't look like a block"))
+ (t
+ ;; FIXME: With grammars like Octave's, every closer ("end",
+ ;; "endif", "endwhile", ...) has the same level, so we'd need
+ ;; to look at the BNF or at least at the 2D prec-table, in
+ ;; order to find the right closer for a given opener.
+ (while levels
+ (let ((level (pop levels)))
+ (dolist (other smie-op-levels)
+ (when (and (eq (nth 2 level) (nth 1 other))
+ (not (memq other seen)))
+ (push other seen)
+ (if (nth 2 other)
+ (push other levels)
+ (push (car other) found))))))
+ (cond
+ ((null found) (error "No known closer for opener %s" open))
+ ;; FIXME: what should we do if there are various closers?
+ (t (car found))))))))))
+ (unless (save-excursion (skip-chars-backward " \t") (bolp))
+ (newline))
+ (insert closer)
+ (if (save-excursion (skip-chars-forward " \t") (eolp))
+ (indent-according-to-mode)
+ (reindent-then-newline-and-indent))))
+
+(defun smie-down-list (&optional arg)
+ "Move forward down one level paren-like blocks. Like `down-list'.
+With argument ARG, do this that many times.
+A negative argument means move backward but still go down a level.
+This command assumes point is not in a string or comment."
(interactive "p")
- (if (< n 0)
- (smie-backward-sexp-command (- n))
- (let ((forward-sexp-function nil))
- (while (> n 0)
- (decf n)
- (let ((pos (point))
- (res (smie-forward-sexp 'halfsexp)))
- (if (and (car res) (= pos (point)) (not (bolp)))
- (signal 'scan-error
- (list "Containing expression ends prematurely"
- (cadr res) (cadr res)))
- nil))))))
+ (let ((start (point))
+ (inc (if (< arg 0) -1 1))
+ (offset (if (< arg 0) 1 0))
+ (next-token (if (< arg 0)
+ smie-backward-token-function
+ smie-forward-token-function)))
+ (while (/= arg 0)
+ (setq arg (- arg inc))
+ (while
+ (let* ((pos (point))
+ (token (funcall next-token))
+ (levels (assoc token smie-op-levels)))
+ (cond
+ ((zerop (length token))
+ (if (if (< inc 0) (looking-back "\\s(\\|\\s)" (1- (point)))
+ (looking-at "\\s(\\|\\s)"))
+ ;; Go back to `start' in case of an error. This presumes
+ ;; none of the token we've found until now include a ( or ).
+ (progn (goto-char start) (down-list inc) nil)
+ (forward-sexp inc)
+ (/= (point) pos)))
+ ((and levels (null (nth (+ 1 offset) levels))) nil)
+ ((and levels (null (nth (- 2 offset) levels)))
+ (let ((end (point)))
+ (goto-char start)
+ (signal 'scan-error
+ (list "Containing expression ends prematurely"
+ pos end))))
+ (t)))))))
+
+(defvar smie-blink-matching-triggers '(?\s ?\n)
+ "Chars which might trigger `blink-matching-open'.
+These can include the final chars of end-tokens, or chars that are
+typically inserted right after an end token.
+I.e. a good choice can be:
+ (delete-dups
+ (mapcar (lambda (kw) (aref (cdr kw) (1- (length (cdr kw)))))
+ smie-closer-alist))")
+
+(defcustom smie-blink-matching-inners t
+ "Whether SMIE should blink to matching opener for inner keywords.
+If non-nil, it will blink not only for \"begin..end\" but also for \"if...else\"."
+ :type 'boolean)
+
+(defun smie-blink-matching-check (start end)
+ (save-excursion
+ (goto-char end)
+ (let ((ender (funcall smie-backward-token-function)))
+ (cond
+ ((not (and ender (rassoc ender smie-closer-alist)))
+ ;; This not is one of the begin..end we know how to check.
+ (blink-matching-check-mismatch start end))
+ ((not start) t)
+ (t
+ (goto-char start)
+ (let ((starter (funcall smie-forward-token-function)))
+ (not (member (cons starter ender) smie-closer-alist))))))))
+
+(defun smie-blink-matching-open ()
+ "Blink the matching opener when applicable.
+This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'."
+ (when (and blink-matching-paren
+ smie-closer-alist ; Optimization.
+ (eq (char-before) last-command-event) ; Sanity check.
+ (memq last-command-event smie-blink-matching-triggers)
+ (save-excursion
+ ;; FIXME: Here we assume that closers all end
+ ;; with a word-syntax char.
+ (unless (eq ?\w (char-syntax last-command-event))
+ (forward-char -1))
+ (and (looking-at "\\>")
+ (not (nth 8 (syntax-ppss))))))
+ (save-excursion
+ (let ((pos (point))
+ (token (funcall smie-backward-token-function)))
+ (if (= 1 (length token))
+ ;; The trigger char is itself a token but is not
+ ;; one of the closers (e.g. ?\; in Octave mode),
+ ;; so go back to the previous token
+ (setq token (save-excursion
+ (funcall smie-backward-token-function)))
+ (goto-char pos))
+ ;; Here we assume that smie-backward-token-function
+ ;; returns a token that is a string and whose content
+ ;; match the buffer's representation of this token.
+ (when (and (> (length token) 1) (stringp token)
+ (memq (aref token (1- (length token)))
+ smie-blink-matching-triggers)
+ (not (eq (aref token (1- (length token)))
+ last-command-event)))
+ ;; Token ends with a trigger char, so don't blink for
+ ;; anything else than this trigger char, lest we'd blink
+ ;; both when inserting the trigger char and when inserting a
+ ;; subsequent SPC.
+ (setq token nil))
+ (when (and (rassoc token smie-closer-alist)
+ (or smie-blink-matching-inners
+ (null (nth 2 (assoc token smie-op-levels)))))
+ ;; The major mode might set blink-matching-check-function
+ ;; buffer-locally so that interactive calls to
+ ;; blink-matching-open work right, but let's not presume
+ ;; that's the case.
+ (let ((blink-matching-check-function #'smie-blink-matching-check))
+ (blink-matching-open)))))))
;;; The indentation engine.
@@ -505,24 +790,36 @@ Possible return values:
"Rules of the following form.
\((:before . TOK) . OFFSET-RULES) how to indent TOK itself.
\(TOK . OFFSET-RULES) how to indent right after TOK.
-\((T1 . T2) . OFFSET) how to indent token T2 w.r.t T1.
-\((t . TOK) . OFFSET) how to indent TOK with respect to its parent.
\(list-intro . TOKENS) declare TOKENS as being followed by what may look like
a funcall but is just a sequence of expressions.
\(t . OFFSET) basic indentation step.
\(args . OFFSET) indentation of arguments.
+\((T1 . T2) OFFSET) like ((:before . T2) (:parent T1 OFFSET)).
OFFSET-RULES is a list of elements which can each either be:
\(:hanging . OFFSET-RULES) if TOK is hanging, use OFFSET-RULES.
\(:parent PARENT . OFFSET-RULES) if TOK's parent is PARENT, use OFFSET-RULES.
\(:next TOKEN . OFFSET-RULES) if TOK is followed by TOKEN, use OFFSET-RULES.
-\(:prev TOKEN . OFFSET-RULES) if TOK is preceded by TOKEN, use OFFSET-RULES.
-a number the offset to use.
+\(:prev TOKEN . OFFSET-RULES) if TOK is preceded by TOKEN, use
+\(:bolp . OFFSET-RULES) If TOK is first on a line, use OFFSET-RULES.
+OFFSET the offset to use.
+
+PARENT can be either the name of the parent or a list of such names.
+
+OFFSET can be of the form:
`point' align with the token.
`parent' align with the parent.
+NUMBER offset by NUMBER.
+\(+ OFFSETS...) use the sum of OFFSETS.
+VARIABLE use the value of VARIABLE as offset.
+
+The precise meaning of `point' depends on various details: it can
+either mean the position of the token we're indenting, or the
+position of its parent, or the position right after its parent.
-A nil offset for indentation after a token defaults to `smie-indent-basic'.")
+A nil offset for indentation after an opening token defaults
+to `smie-indent-basic'.")
(defun smie-indent-hanging-p ()
;; A hanging keyword is one that's at the end of a line except it's not at
@@ -543,21 +840,33 @@ A nil offset for indentation after a token defaults to `smie-indent-basic'.")
(cdr (assq t smie-indent-rules))
smie-indent-basic))
-(defun smie-indent-offset-rule (tokinfo &optional after)
+(defvar smie-indent-debug-log)
+
+(defun smie-indent-offset-rule (tokinfo &optional after parent)
"Apply the OFFSET-RULES in TOKINFO.
Point is expected to be right in front of the token corresponding to TOKINFO.
If computing the indentation after the token, then AFTER is the position
-after the token."
+after the token, otherwise it should be nil.
+PARENT if non-nil should be the parent info returned by `smie-backward-sexp'."
(let ((rules (cdr tokinfo))
- parent next prev
+ next prev
offset)
(while (consp rules)
(let ((rule (pop rules)))
(cond
((not (consp rule)) (setq offset rule))
+ ((eq (car rule) '+) (setq offset rule))
((eq (car rule) :hanging)
(when (smie-indent-hanging-p)
(setq rules (cdr rule))))
+ ((eq (car rule) :bolp)
+ (when (smie-bolp)
+ (setq rules (cdr rule))))
+ ((eq (car rule) :eolp)
+ (unless after
+ (error "Can't use :eolp in :before indentation rules"))
+ (when (> after (line-end-position))
+ (setq rules (cdr rule))))
((eq (car rule) :prev)
(unless prev
(save-excursion
@@ -578,12 +887,63 @@ after the token."
(save-excursion
(if after (goto-char after))
(setq parent (smie-backward-sexp 'halfsexp))))
- (when (equal (nth 2 parent) (cadr rule))
+ (when (if (listp (cadr rule))
+ (member (nth 2 parent) (cadr rule))
+ (equal (nth 2 parent) (cadr rule)))
(setq rules (cddr rule))))
(t (error "Unknown rule %s for indentation of %s"
rule (car tokinfo))))))
+ ;; If `offset' is not set yet, use `rules' to handle the case where
+ ;; the tokinfo uses the old-style ((PARENT . TOK). OFFSET).
+ (unless offset (setq offset rules))
+ (when (boundp 'smie-indent-debug-log)
+ (push (list (point) offset tokinfo) smie-indent-debug-log))
offset))
+(defun smie-indent-column (offset &optional base parent virtual-point)
+ "Compute the actual column to use for a given OFFSET.
+BASE is the base position to use, and PARENT is the parent info, if any.
+If VIRTUAL-POINT is non-nil, then `point' is virtual."
+ (cond
+ ((eq (car-safe offset) '+)
+ (apply '+ (mapcar (lambda (offset) (smie-indent-column offset nil parent))
+ (cdr offset))))
+ ((integerp offset)
+ (+ offset
+ (case base
+ ((nil) 0)
+ (parent (goto-char (cadr parent))
+ (smie-indent-virtual))
+ (t
+ (goto-char base)
+ ;; For indentation after "(let" in SML-mode, we end up accumulating
+ ;; the offset of "(" and the offset of "let", so we use `min' to try
+ ;; and get it right either way.
+ (min (smie-indent-virtual) (current-column))))))
+ ((eq offset 'point)
+ ;; In indent-keyword, if we're indenting `then' wrt `if', we want to use
+ ;; indent-virtual rather than use just current-column, so that we can
+ ;; apply the (:before . "if") rule which does the "else if" dance in SML.
+ ;; But in other cases, we do not want to use indent-virtual
+ ;; (e.g. indentation of "*" w.r.t "+", or ";" wrt "("). We could just
+ ;; always use indent-virtual and then have indent-rules say explicitly
+ ;; to use `point' after things like "(" or "+" when they're not at EOL,
+ ;; but you'd end up with lots of those rules.
+ ;; So we use a heuristic here, which is that we only use virtual if
+ ;; the parent is tightly linked to the child token (they're part of
+ ;; the same BNF rule).
+ (if (and virtual-point (null (car parent))) ;Black magic :-(
+ (smie-indent-virtual) (current-column)))
+ ((eq offset 'parent)
+ (unless parent
+ (setq parent (or (smie-backward-sexp 'halfsexp) :notfound)))
+ (if (consp parent) (goto-char (cadr parent)))
+ (smie-indent-virtual))
+ ((eq offset nil) nil)
+ ((and (symbolp offset) (boundp 'offset))
+ (smie-indent-column (symbol-value offset) base parent virtual-point))
+ (t (error "Unknown indentation offset %s" offset))))
+
(defun smie-indent-forward-token ()
"Skip token forward and return it, along with its levels."
(let ((tok (funcall smie-forward-token-function)))
@@ -620,13 +980,13 @@ in order to figure out the indentation of some other (further down) point."
;; Obey the `fixindent' special comment.
(and (smie-bolp)
(save-excursion
- (comment-normalize-vars)
- (re-search-forward (concat comment-start-skip
- "fixindent"
- comment-end-skip)
- ;; 1+ to account for the \n comment termination.
- (1+ (line-end-position)) t))
- (current-column)))
+ (comment-normalize-vars)
+ (re-search-forward (concat comment-start-skip
+ "fixindent"
+ comment-end-skip)
+ ;; 1+ to account for the \n comment termination.
+ (1+ (line-end-position)) t))
+ (current-column)))
(defun smie-indent-bob ()
;; Start the file at column 0.
@@ -655,85 +1015,130 @@ in order to figure out the indentation of some other (further down) point."
(toklevels (smie-indent-forward-token))
(token (pop toklevels)))
(if (null (car toklevels))
- ;; Different case:
- ;; - smie-bolp: "indent according to others".
- ;; - common hanging: "indent according to others".
- ;; - SML-let hanging: "indent like parent".
- ;; - if-after-else: "indent-like parent".
- ;; - middle-of-line: "trust current position".
- (cond
- ((null (cdr toklevels)) nil) ;Not a keyword.
- ((smie-bolp)
- ;; For an open-paren-like thingy at BOL, always indent only
- ;; based on other rules (typically smie-indent-after-keyword).
- nil)
- (t
- (let* ((tokinfo (or (assoc (cons :before token) smie-indent-rules)
- ;; By default use point unless we're hanging.
- (cons (cons :before token)
- '((:hanging nil) point))))
- (after (prog1 (point) (goto-char pos)))
- (offset (smie-indent-offset-rule tokinfo)))
- (cond
- ((eq offset 'point) (current-column))
- ((eq offset 'parent)
- (let ((parent (smie-backward-sexp 'halfsexp)))
- (if parent (goto-char (cadr parent))))
- (smie-indent-virtual))
- ((eq offset nil) nil)
- (t (error "Unhandled offset %s in %s"
- offset (cons :before token)))))))
+ (save-excursion
+ (goto-char pos)
+ ;; Different cases:
+ ;; - smie-bolp: "indent according to others".
+ ;; - common hanging: "indent according to others".
+ ;; - SML-let hanging: "indent like parent".
+ ;; - if-after-else: "indent-like parent".
+ ;; - middle-of-line: "trust current position".
+ (cond
+ ((null (cdr toklevels)) nil) ;Not a keyword.
+ ((smie-bolp)
+ ;; For an open-paren-like thingy at BOL, always indent only
+ ;; based on other rules (typically smie-indent-after-keyword).
+ nil)
+ (t
+ ;; We're only ever here for virtual-indent, which is why
+ ;; we can use (current-column) as answer for `point'.
+ (let* ((tokinfo (or (assoc (cons :before token)
+ smie-indent-rules)
+ ;; By default use point unless we're hanging.
+ `((:before . ,token) (:hanging nil) point)))
+ ;; (after (prog1 (point) (goto-char pos)))
+ (offset (smie-indent-offset-rule tokinfo)))
+ (smie-indent-column offset)))))
;; FIXME: This still looks too much like black magic!!
;; FIXME: Rather than a bunch of rules like (PARENT . TOKEN), we
;; want a single rule for TOKEN with different cases for each PARENT.
- (let ((res (smie-backward-sexp 'halfsexp)) tmp)
+ (let* ((parent (smie-backward-sexp 'halfsexp))
+ (tokinfo
+ (or (assoc (cons (caddr parent) token)
+ smie-indent-rules)
+ (assoc (cons :before token) smie-indent-rules)
+ ;; Default rule.
+ `((:before . ,token)
+ ;; (:parent open 0)
+ point)))
+ (offset (save-excursion
+ (goto-char pos)
+ (smie-indent-offset-rule tokinfo nil parent))))
+ ;; Different behaviors:
+ ;; - align with parent.
+ ;; - parent + offset.
+ ;; - after parent's column + offset (actually, after or before
+ ;; depending on where backward-sexp stopped).
+ ;; ? let it drop to some other indentation function (almost never).
+ ;; ? parent + offset + parent's own offset.
+ ;; Different cases:
+ ;; - bump into a same-level operator.
+ ;; - bump into a specific known parent.
+ ;; - find a matching open-paren thingy.
+ ;; - bump into some random parent.
+ ;; ? borderline case (almost never).
+ ;; ? bump immediately into a parent.
(cond
((not (or (< (point) pos)
- (and (cadr res) (< (cadr res) pos))))
+ (and (cadr parent) (< (cadr parent) pos))))
;; If we didn't move at all, that means we didn't really skip
- ;; what we wanted.
+ ;; what we wanted. Should almost never happen, other than
+ ;; maybe when an infix or close-paren is at the beginning
+ ;; of a buffer.
nil)
- ((eq (car res) (car toklevels))
+ ((eq (car parent) (car toklevels))
;; We bumped into a same-level operator. align with it.
- (goto-char (cadr res))
- ;; Don't use (smie-indent-virtual :not-hanging) here, because we
- ;; want to jump back over a sequence of same-level ops such as
- ;; a -> b -> c
- ;; -> d
- ;; So as to align with the earliest appropriate place.
- (smie-indent-virtual))
- ((setq tmp (assoc (cons (caddr res) token)
- smie-indent-rules))
- (goto-char (cadr res))
- (+ (cdr tmp) (smie-indent-virtual))) ;:not-hanging
- ;; FIXME: The rules ((t . TOK) . OFFSET) either indent
- ;; relative to "before the parent" or "after the parent",
- ;; depending on details of the grammar.
- ((null (car res))
- (assert (eq (point) (cadr res)))
- (goto-char (cadr res))
- (+ (or (cdr (assoc (cons t token) smie-indent-rules)) 0)
- (smie-indent-virtual))) ;:not-hanging
- ((and (= (point) pos) (smie-bolp))
- ;; Since we started at BOL, we're not computing a virtual
- ;; indentation, and we're still at the starting point, so the
- ;; next (default) rule can't be used since it uses `current-column'
- ;; which would cause. indentation to depend on itself.
- ;; We could just return nil, but OTOH that's not good enough in
- ;; some cases. Instead, we want to combine the offset-rules for
- ;; the current token with the offset-rules of the previous one.
- (+ (or (cdr (assoc (cons t token) smie-indent-rules)) 0)
- ;; FIXME: This is odd. Can't we make it use
- ;; smie-indent-(calculate|virtual) somehow?
- (smie-indent-after-keyword)))
- (t
- (+ (or (cdr (assoc (cons t token) smie-indent-rules)) 0)
- (current-column)))))))))
+ (if (and (smie-bolp) (/= (point) pos)
+ (save-excursion
+ (goto-char (goto-char (cadr parent)))
+ (not (smie-bolp)))
+ ;; Check the offset of `token' rather then its parent
+ ;; because its parent may have used a special rule. E.g.
+ ;; function foo;
+ ;; line2;
+ ;; line3;
+ ;; The ; on the first line had a special rule, but when
+ ;; indenting line3, we don't care about it and want to
+ ;; align with line2.
+ (memq offset '(point nil)))
+ ;; If the parent is at EOL and its children are indented like
+ ;; itself, then we can just obey the indentation chosen for the
+ ;; child.
+ ;; This is important for operators like ";" which
+ ;; are usually at EOL (and have an offset of 0): otherwise we'd
+ ;; always go back over all the statements, which is
+ ;; a performance problem and would also mean that fixindents
+ ;; in the middle of such a sequence would be ignored.
+ ;;
+ ;; This is a delicate point!
+ ;; Even if the offset is not 0, we could follow the same logic
+ ;; and subtract the offset from the child's indentation.
+ ;; But that would more often be a bad idea: OT1H we generally
+ ;; want to reuse the closest similar indentation point, so that
+ ;; the user's choice (or the fixindents) are obeyed. But OTOH
+ ;; we don't want this to affect "unrelated" parts of the code.
+ ;; E.g. a fixindent in the body of a "begin..end" should not
+ ;; affect the indentation of the "end".
+ (current-column)
+ (goto-char (cadr parent))
+ ;; Don't use (smie-indent-virtual :not-hanging) here, because we
+ ;; want to jump back over a sequence of same-level ops such as
+ ;; a -> b -> c
+ ;; -> d
+ ;; So as to align with the earliest appropriate place.
+ (smie-indent-virtual)))
+ (tokinfo
+ (if (and (= (point) pos) (smie-bolp)
+ (or (eq offset 'point)
+ (and (consp offset) (memq 'point offset))))
+ ;; Since we started at BOL, we're not computing a virtual
+ ;; indentation, and we're still at the starting point, so
+ ;; we can't use `current-column' which would cause
+ ;; indentation to depend on itself.
+ nil
+ (smie-indent-column offset 'parent parent
+ ;; If we're still at pos, indent-virtual
+ ;; will inf-loop.
+ (unless (= (point) pos) 'virtual))))))))))
(defun smie-indent-comment ()
- ;; Indentation of a comment.
- (and (looking-at comment-start-skip)
+ "Compute indentation of a comment."
+ ;; Don't do it for virtual indentations. We should normally never be "in
+ ;; front of a comment" when doing virtual-indentation anyway. And if we are
+ ;; (as can happen in octave-mode), moving forward can lead to inf-loops.
+ (and (smie-bolp)
+ (looking-at comment-start-skip)
(save-excursion
(forward-comment (point-max))
(skip-chars-forward " \t\r\n")
@@ -745,12 +1150,12 @@ in order to figure out the indentation of some other (further down) point."
(comment-string-strip comment-continue t t))))
(and (< 0 (length continue))
(looking-at (regexp-quote continue)) (nth 4 (syntax-ppss))
- (let ((ppss (syntax-ppss)))
- (save-excursion
- (forward-line -1)
- (if (<= (point) (nth 8 ppss))
- (progn (goto-char (1+ (nth 8 ppss))) (current-column))
- (skip-chars-forward " \t")
+ (let ((ppss (syntax-ppss)))
+ (save-excursion
+ (forward-line -1)
+ (if (<= (point) (nth 8 ppss))
+ (progn (goto-char (1+ (nth 8 ppss))) (current-column))
+ (skip-chars-forward " \t")
(if (looking-at (regexp-quote continue))
(current-column))))))))
@@ -761,26 +1166,25 @@ in order to figure out the indentation of some other (further down) point."
(toklevel (smie-indent-backward-token))
(tok (car toklevel))
(tokinfo (assoc tok smie-indent-rules)))
+ ;; Set some default indent rules.
(if (and toklevel (null (cadr toklevel)) (null tokinfo))
(setq tokinfo (list (car toklevel))))
;; (if (and tokinfo (null toklevel))
;; (error "Token %S has indent rule but has no parsing info" tok))
(when toklevel
+ (unless tokinfo
+ ;; The default indentation after a keyword/operator is 0 for
+ ;; infix and t for prefix.
+ ;; Using the BNF syntax, we could come up with better
+ ;; defaults, but we only have the precedence levels here.
+ (setq tokinfo (list tok 'default-rule
+ (if (cadr toklevel) 0 (smie-indent-offset t)))))
(let ((offset
- (cond
- (tokinfo (or (smie-indent-offset-rule tokinfo pos)
- (smie-indent-offset t)))
- ;; The default indentation after a keyword/operator
- ;; is 0 for infix and t for prefix.
- ;; Using the BNF syntax, we could come up with
- ;; better defaults, but we only have the
- ;; precedence levels here.
- ((null (cadr toklevel)) (smie-indent-offset t))
- (t 0))))
- ;; For indentation after "(let" in SML-mode, we end up accumulating
- ;; the offset of "(" and the offset of "let", so we use `min' to try
- ;; and get it right either way.
- (+ (min (smie-indent-virtual) (current-column)) offset))))))
+ (or (smie-indent-offset-rule tokinfo pos)
+ (smie-indent-offset t))))
+ (let ((before (point)))
+ (goto-char pos)
+ (smie-indent-column offset before)))))))
(defun smie-indent-exps ()
;; Indentation of sequences of simple expressions without
@@ -828,6 +1232,7 @@ in order to figure out the indentation of some other (further down) point."
(positions
;; We're the first arg.
(goto-char (car positions))
+ ;; FIXME: Use smie-indent-column.
(+ (smie-indent-offset 'args)
;; We used to use (smie-indent-virtual), but that
;; doesn't seem right since it might then indent args less than
@@ -836,8 +1241,8 @@ in order to figure out the indentation of some other (further down) point."
(defvar smie-indent-functions
'(smie-indent-fixindent smie-indent-bob smie-indent-close smie-indent-comment
- smie-indent-comment-continue smie-indent-keyword smie-indent-after-keyword
- smie-indent-exps)
+ smie-indent-comment-continue smie-indent-keyword smie-indent-after-keyword
+ smie-indent-exps)
"Functions to compute the indentation.
Each function is called with no argument, shouldn't move point, and should
return either nil if it has no opinion, or an integer representing the column
@@ -851,7 +1256,7 @@ to which that point should be aligned, if we were to reindent it.")
"Indent current line using the SMIE indentation engine."
(interactive)
(let* ((savep (point))
- (indent (condition-case nil
+ (indent (condition-case-no-debug nil
(save-excursion
(forward-line 0)
(skip-chars-forward " \t")
@@ -866,7 +1271,14 @@ to which that point should be aligned, if we were to reindent it.")
(save-excursion (indent-line-to indent))
(indent-line-to indent)))))
-;;;###autoload
+(defun smie-indent-debug ()
+ "Show the rules used to compute indentation of current line."
+ (interactive)
+ (let ((smie-indent-debug-log '()))
+ (smie-indent-calculate)
+ ;; FIXME: please improve!
+ (message "%S" smie-indent-debug-log)))
+
(defun smie-setup (op-levels indent-rules)
(set (make-local-variable 'smie-indent-rules) indent-rules)
(set (make-local-variable 'smie-op-levels) op-levels)
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index 5cc89596ef..ad0166e7af 100644
--- a/lisp/emacs-lisp/syntax.el
+++ b/lisp/emacs-lisp/syntax.el
@@ -34,7 +34,6 @@
;; - do something about the case where the syntax-table is changed.
;; This typically happens with tex-mode and its `$' operator.
-;; - move font-lock-syntactic-keywords in here. Then again, maybe not.
;; - new functions `syntax-state', ... to replace uses of parse-partial-state
;; with something higher-level (similar to syntax-ppss-context).
;; - interaction with mmm-mode.
@@ -47,6 +46,249 @@
(defvar font-lock-beginning-of-syntax-function)
+;;; Applying syntax-table properties where needed.
+
+(defvar syntax-propertize-function nil
+ ;; Rather than a -functions hook, this is a -function because it's easier
+ ;; to do a single scan than several scans: with multiple scans, one cannot
+ ;; assume that the text before point has been propertized, so syntax-ppss
+ ;; gives unreliable results (and stores them in its cache to boot, so we'd
+ ;; have to flush that cache between each function, and we couldn't use
+ ;; syntax-ppss-flush-cache since that would not only flush the cache but also
+ ;; reset syntax-propertize--done which should not be done in this case).
+ "Mode-specific function to apply the syntax-table properties.
+Called with 2 arguments: START and END.")
+
+(defvar syntax-propertize-chunk-size 500)
+
+(defvar syntax-propertize-extend-region-functions
+ '(syntax-propertize-wholelines)
+ "Special hook run just before proceeding to propertize a region.
+This is used to allow major modes to help `syntax-propertize' find safe buffer
+positions as beginning and end of the propertized region. Its most common use
+is to solve the problem of /identification/ of multiline elements by providing
+a function that tries to find such elements and move the boundaries such that
+they do not fall in the middle of one.
+Each function is called with two arguments (START and END) and it should return
+either a cons (NEW-START . NEW-END) or nil if no adjustment should be made.
+These functions are run in turn repeatedly until they all return nil.
+Put first the functions more likely to cause a change and cheaper to compute.")
+;; Mark it as a special hook which doesn't use any global setting
+;; (i.e. doesn't obey the element t in the buffer-local value).
+(make-variable-buffer-local 'syntax-propertize-extend-region-functions)
+
+(defun syntax-propertize-wholelines (start end)
+ (goto-char start)
+ (cons (line-beginning-position)
+ (progn (goto-char end)
+ (if (bolp) (point) (line-beginning-position 2)))))
+
+(defun syntax-propertize-multiline (beg end)
+ "Let `syntax-propertize' pay attention to the syntax-multiline property."
+ (when (and (> beg (point-min))
+ (get-text-property (1- beg) 'syntax-multiline))
+ (setq beg (or (previous-single-property-change beg 'syntax-multiline)
+ (point-min))))
+ ;;
+ (when (get-text-property end 'font-lock-multiline)
+ (setq end (or (text-property-any end (point-max)
+ 'syntax-multiline nil)
+ (point-max))))
+ (cons beg end))
+
+(defvar syntax-propertize--done -1
+ "Position upto which syntax-table properties have been set.")
+(make-variable-buffer-local 'syntax-propertize--done)
+
+(defun syntax-propertize--shift-groups (re n)
+ (replace-regexp-in-string
+ "\\\\(\\?\\([0-9]+\\):"
+ (lambda (s)
+ (replace-match
+ (number-to-string (+ n (string-to-number (match-string 1 s))))
+ t t s 1))
+ re t t))
+
+(defmacro syntax-propertize-rules (&rest rules)
+ "Make a function that applies RULES for use in `syntax-propertize-function'.
+The function will scan the buffer, applying the rules where they match.
+The buffer is scanned a single time, like \"lex\" would, rather than once
+per rule.
+
+Each rule has the form (REGEXP HIGHLIGHT1 ... HIGHLIGHTn), where REGEXP
+is an expression (evaluated at time of macro-expansion) that returns a regexp,
+and where HIGHLIGHTs have the form (NUMBER SYNTAX) which means to
+apply the property SYNTAX to the chars matched by the subgroup NUMBER
+of the regular expression, if NUMBER did match.
+SYNTAX is an expression that returns a value to apply as `syntax-table'
+property. Some expressions are handled specially:
+- if SYNTAX is a string, then it is converted with `string-to-syntax';
+- if SYNTAX has the form (prog1 EXP . EXPS) then the value returned by EXP
+ will be applied to the buffer before running EXPS and if EXP is a string it
+ is also converted with `string-to-syntax'.
+The SYNTAX expression is responsible to save the `match-data' if needed
+for subsequent HIGHLIGHTs.
+Also SYNTAX is free to move point, in which case RULES may not be applied to
+some parts of the text or may be applied several times to other parts.
+
+Note: back-references in REGEXPs do not work."
+ (declare (debug (&rest (form &rest
+ (numberp
+ [&or stringp
+ ("prog1" [&or stringp def-form] def-body)
+ def-form])))))
+ (let* ((offset 0)
+ (branches '())
+ ;; We'd like to use a real DFA-based lexer, usually, but since Emacs
+ ;; doesn't have one yet, we fallback on building one large regexp
+ ;; and use groups to determine which branch of the regexp matched.
+ (re
+ (mapconcat
+ (lambda (rule)
+ (let ((re (eval (car rule))))
+ (when (and (assq 0 rule) (cdr rules))
+ ;; If there's more than 1 rule, and the rule want to apply
+ ;; highlight to match 0, create an extra group to be able to
+ ;; tell when *this* match 0 has succeeded.
+ (incf offset)
+ (setq re (concat "\\(" re "\\)")))
+ (setq re (syntax-propertize--shift-groups re offset))
+ (let ((code '())
+ (condition
+ (cond
+ ((assq 0 rule) (if (zerop offset) t
+ `(match-beginning ,offset)))
+ ((null (cddr rule))
+ `(match-beginning ,(+ offset (car (cadr rule)))))
+ (t
+ `(or ,@(mapcar
+ (lambda (case)
+ `(match-beginning ,(+ offset (car case))))
+ (cdr rule))))))
+ (nocode t)
+ (offset offset))
+ ;; If some of the subgroup rules include Elisp code, then we
+ ;; need to set the match-data so it's consistent with what the
+ ;; code expects. If not, then we can simply use shifted
+ ;; offset in our own code.
+ (unless (zerop offset)
+ (dolist (case (cdr rule))
+ (unless (stringp (cadr case))
+ (setq nocode nil)))
+ (unless nocode
+ (push `(let ((md (match-data 'ints)))
+ ;; Keep match 0 as is, but shift everything else.
+ (setcdr (cdr md) (nthcdr ,(* (1+ offset) 2) md))
+ (set-match-data md))
+ code)
+ (setq offset 0)))
+ ;; Now construct the code for each subgroup rules.
+ (dolist (case (cdr rule))
+ (assert (null (cddr case)))
+ (let* ((gn (+ offset (car case)))
+ (action (nth 1 case))
+ (thiscode
+ (cond
+ ((stringp action)
+ `((put-text-property
+ (match-beginning ,gn) (match-end ,gn)
+ 'syntax-table
+ ',(string-to-syntax action))))
+ ((eq (car-safe action) 'ignore)
+ (cdr action))
+ ((eq (car-safe action) 'prog1)
+ (if (stringp (nth 1 action))
+ `((put-text-property
+ (match-beginning ,gn) (match-end ,gn)
+ 'syntax-table
+ ',(string-to-syntax (nth 1 action)))
+ ,@(nthcdr 2 action))
+ `((let ((mb (match-beginning ,gn))
+ (me (match-end ,gn))
+ (syntax ,(nth 1 action)))
+ (if syntax
+ (put-text-property
+ mb me 'syntax-table syntax))
+ ,@(nthcdr 2 action)))))
+ (t
+ `((let ((mb (match-beginning ,gn))
+ (me (match-end ,gn))
+ (syntax ,action))
+ (if syntax
+ (put-text-property
+ mb me 'syntax-table syntax))))))))
+
+ (if (or (not (cddr rule)) (zerop gn))
+ (setq code (nconc (nreverse thiscode) code))
+ (push `(if (match-beginning ,gn)
+ ;; Try and generate clean code with no
+ ;; extraneous progn.
+ ,(if (null (cdr thiscode))
+ (car thiscode)
+ `(progn ,@thiscode)))
+ code))))
+ (push (cons condition (nreverse code))
+ branches))
+ (incf offset (regexp-opt-depth re))
+ re))
+ rules
+ "\\|")))
+ `(lambda (start end)
+ (goto-char start)
+ (while (and (< (point) end)
+ (re-search-forward ,re end t))
+ (cond ,@(nreverse branches))))))
+
+(defun syntax-propertize-via-font-lock (keywords)
+ "Propertize for syntax in START..END using font-lock syntax.
+KEYWORDS obeys the format used in `font-lock-syntactic-keywords'.
+The return value is a function suitable for `syntax-propertize-function'."
+ (lexical-let ((keywords keywords))
+ (lambda (start end)
+ (with-no-warnings
+ (let ((font-lock-syntactic-keywords keywords))
+ (font-lock-fontify-syntactic-keywords-region start end)
+ ;; In case it was eval'd/compiled.
+ (setq keywords font-lock-syntactic-keywords))))))
+
+(defun syntax-propertize (pos)
+ "Ensure that syntax-table properties are set upto POS."
+ (when (and syntax-propertize-function
+ (< syntax-propertize--done pos))
+ ;; (message "Needs to syntax-propertize from %s to %s"
+ ;; syntax-propertize--done pos)
+ (set (make-local-variable 'parse-sexp-lookup-properties) t)
+ (save-excursion
+ (with-silent-modifications
+ (let* ((start (max syntax-propertize--done (point-min)))
+ (end (max pos
+ (min (point-max)
+ (+ start syntax-propertize-chunk-size))))
+ (funs syntax-propertize-extend-region-functions))
+ (while funs
+ (let ((new (funcall (pop funs) start end)))
+ (if (or (null new)
+ (and (>= (car new) start) (<= (cdr new) end)))
+ nil
+ (setq start (car new))
+ (setq end (cdr new))
+ ;; If there's been a change, we should go through the
+ ;; list again since this new position may
+ ;; warrant a different answer from one of the funs we've
+ ;; already seen.
+ (unless (eq funs
+ (cdr syntax-propertize-extend-region-functions))
+ (setq funs syntax-propertize-extend-region-functions)))))
+ ;; Move the limit before calling the function, so the function
+ ;; can use syntax-ppss.
+ (setq syntax-propertize--done end)
+ ;; (message "syntax-propertizing from %s to %s" start end)
+ (remove-text-properties start end
+ '(syntax-table nil syntax-multiline nil))
+ (funcall syntax-propertize-function start end))))))
+
+;;; Incrementally compute and memoize parser state.
+
(defsubst syntax-ppss-depth (ppss)
(nth 0 ppss))
@@ -92,6 +334,8 @@ point (where the PPSS is equivalent to nil).")
(defalias 'syntax-ppss-after-change-function 'syntax-ppss-flush-cache)
(defun syntax-ppss-flush-cache (beg &rest ignored)
"Flush the cache of `syntax-ppss' starting at position BEG."
+ ;; Set syntax-propertize to refontify anything past beg.
+ (setq syntax-propertize--done (min beg syntax-propertize--done))
;; Flush invalid cache entries.
(while (and syntax-ppss-cache (> (caar syntax-ppss-cache) beg))
(setq syntax-ppss-cache (cdr syntax-ppss-cache)))
@@ -128,6 +372,7 @@ the 2nd and 6th values of the returned state cannot be relied upon.
Point is at POS when this function returns."
;; Default values.
(unless pos (setq pos (point)))
+ (syntax-propertize pos)
;;
(let ((old-ppss (cdr syntax-ppss-last))
(old-pos (car syntax-ppss-last))
@@ -209,7 +454,8 @@ Point is at POS when this function returns."
(funcall syntax-begin-function)
;; Make sure it's better.
(> (point) pt-best))
- ;; Simple sanity check.
+ ;; Simple sanity checks.
+ (< (point) pos) ; backward-paragraph can fail here.
(not (memq (get-text-property (point) 'face)
'(font-lock-string-face font-lock-doc-face
font-lock-comment-face))))
diff --git a/lisp/emacs-lisp/tcover-ses.el b/lisp/emacs-lisp/tcover-ses.el
index cf5e79d2a2..8df70f4d97 100644
--- a/lisp/emacs-lisp/tcover-ses.el
+++ b/lisp/emacs-lisp/tcover-ses.el
@@ -6,6 +6,7 @@
;; Author: Jonathan Yavner <[email protected]>
;; Maintainer: Jonathan Yavner <[email protected]>
;; Keywords: spreadsheet lisp utility
+;; Package: testcover
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
diff --git a/lisp/emacs-lisp/tcover-unsafep.el b/lisp/emacs-lisp/tcover-unsafep.el
index b300ee6dce..47f931bf9d 100644
--- a/lisp/emacs-lisp/tcover-unsafep.el
+++ b/lisp/emacs-lisp/tcover-unsafep.el
@@ -5,6 +5,7 @@
;; Author: Jonathan Yavner <[email protected]>
;; Maintainer: Jonathan Yavner <[email protected]>
;; Keywords: safety lisp utility
+;; Package: testcover
;; This file is part of GNU Emacs.
diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index 94f39940b6..6ae6a86857 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -4,6 +4,7 @@
;; 2009, 2010 Free Software Foundation, Inc.
;; Maintainer: FSF
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -442,8 +443,6 @@ This function returns a timer object which you can use in `cancel-timer'."
"This is the timer function used for the timer made by `with-timeout'."
(throw tag 'timeout))
-(put 'with-timeout 'lisp-indent-function 1)
-
(defvar with-timeout-timers nil
"List of all timers used by currently pending `with-timeout' calls.")
@@ -455,6 +454,7 @@ event (such as keyboard input, input from subprocesses, or a certain time);
if the program loops without waiting in any way, the timeout will not
be detected.
\n(fn (SECONDS TIMEOUT-FORMS...) BODY)"
+ (declare (indent 1))
(let ((seconds (car list))
(timeout-forms (cdr list)))
`(let ((with-timeout-tag (cons nil nil))
diff --git a/lisp/emulation/cua-gmrk.el b/lisp/emulation/cua-gmrk.el
index b67d09c04c..761a3d5ec2 100644
--- a/lisp/emulation/cua-gmrk.el
+++ b/lisp/emulation/cua-gmrk.el
@@ -5,6 +5,7 @@
;; Author: Kim F. Storm <[email protected]>
;; Keywords: keyboard emulations convenience cua mark
+;; Package: cua-base
;; This file is part of GNU Emacs.
diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el
index 5d50d6f48d..2cbf443886 100644
--- a/lisp/emulation/cua-rect.el
+++ b/lisp/emulation/cua-rect.el
@@ -5,6 +5,7 @@
;; Author: Kim F. Storm <[email protected]>
;; Keywords: keyboard emulations convenience CUA
+;; Package: cua-base
;; This file is part of GNU Emacs.
diff --git a/lisp/emulation/edt-lk201.el b/lisp/emulation/edt-lk201.el
index 6cce36e42a..e50e064077 100644
--- a/lisp/emulation/edt-lk201.el
+++ b/lisp/emulation/edt-lk201.el
@@ -6,6 +6,7 @@
;; Author: Kevin Gallagher <[email protected]>
;; Maintainer: Kevin Gallagher <[email protected]>
;; Keywords: emulations
+;; Package: edt
;; This file is part of GNU Emacs.
diff --git a/lisp/emulation/edt-mapper.el b/lisp/emulation/edt-mapper.el
index e5c0ceecf1..6bf50db544 100644
--- a/lisp/emulation/edt-mapper.el
+++ b/lisp/emulation/edt-mapper.el
@@ -6,6 +6,7 @@
;; Author: Kevin Gallagher <[email protected]>
;; Maintainer: Kevin Gallagher <[email protected]>
;; Keywords: emulations
+;; Package: edt
;; This file is part of GNU Emacs.
diff --git a/lisp/emulation/edt-pc.el b/lisp/emulation/edt-pc.el
index 0cd421620a..04128ac00b 100644
--- a/lisp/emulation/edt-pc.el
+++ b/lisp/emulation/edt-pc.el
@@ -6,6 +6,7 @@
;; Author: Kevin Gallagher <[email protected]>
;; Maintainer: Kevin Gallagher <[email protected]>
;; Keywords: emulations
+;; Package: edt
;; This file is part of GNU Emacs.
diff --git a/lisp/emulation/edt-vt100.el b/lisp/emulation/edt-vt100.el
index f14bdfc79c..9416a9ad48 100644
--- a/lisp/emulation/edt-vt100.el
+++ b/lisp/emulation/edt-vt100.el
@@ -6,6 +6,7 @@
;; Author: Kevin Gallagher <[email protected]>
;; Maintainer: Kevin Gallagher <[email protected]>
;; Keywords: emulations
+;; Package: edt
;; This file is part of GNU Emacs.
diff --git a/lisp/emulation/tpu-edt.el b/lisp/emulation/tpu-edt.el
index c5dd9b3cf3..bcd67d4aff 100644
--- a/lisp/emulation/tpu-edt.el
+++ b/lisp/emulation/tpu-edt.el
@@ -2438,7 +2438,7 @@ If FILE is nil, try to load a default file. The default file names are
;;;### (autoloads (tpu-set-cursor-bound tpu-set-cursor-free tpu-set-scroll-margins
-;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "d003e4c2f1291eccc629926bb0f88e17")
+;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "78abc50917c93d2b35596d307fc638c4")
;;; Generated autoloads from tpu-extras.el
(autoload 'tpu-cursor-free-mode "tpu-extras" "\
diff --git a/lisp/emulation/tpu-extras.el b/lisp/emulation/tpu-extras.el
index 2fc9ce516f..dbad4f787a 100644
--- a/lisp/emulation/tpu-extras.el
+++ b/lisp/emulation/tpu-extras.el
@@ -6,6 +6,7 @@
;; Author: Rob Riepel <[email protected]>
;; Maintainer: Rob Riepel <[email protected]>
;; Keywords: emulations
+;; Package: tpu-edt
;; This file is part of GNU Emacs.
diff --git a/lisp/emulation/tpu-mapper.el b/lisp/emulation/tpu-mapper.el
index ed42824a8b..b4942564eb 100644
--- a/lisp/emulation/tpu-mapper.el
+++ b/lisp/emulation/tpu-mapper.el
@@ -6,6 +6,7 @@
;; Author: Rob Riepel <[email protected]>
;; Maintainer: Rob Riepel <[email protected]>
;; Keywords: emulations
+;; Package: tpu-edt
;; This file is part of GNU Emacs.
diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el
index 602b442a04..07719ba45b 100644
--- a/lisp/emulation/viper-cmd.el
+++ b/lisp/emulation/viper-cmd.el
@@ -4,6 +4,7 @@
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Michael Kifer <[email protected]>
+;; Package: viper
;; This file is part of GNU Emacs.
diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el
index 80853fd568..be387d7724 100644
--- a/lisp/emulation/viper-ex.el
+++ b/lisp/emulation/viper-ex.el
@@ -4,6 +4,7 @@
;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Michael Kifer <[email protected]>
+;; Package: viper
;; This file is part of GNU Emacs.
diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el
index 68f729e8b4..ebd18d47e1 100644
--- a/lisp/emulation/viper-init.el
+++ b/lisp/emulation/viper-init.el
@@ -4,6 +4,7 @@
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Michael Kifer <[email protected]>
+;; Package: viper
;; This file is part of GNU Emacs.
diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el
index cfc84956da..d75573673d 100644
--- a/lisp/emulation/viper-keym.el
+++ b/lisp/emulation/viper-keym.el
@@ -4,6 +4,7 @@
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Michael Kifer <[email protected]>
+;; Package: viper
;; This file is part of GNU Emacs.
diff --git a/lisp/emulation/viper-macs.el b/lisp/emulation/viper-macs.el
index ec31aeef42..71d565632e 100644
--- a/lisp/emulation/viper-macs.el
+++ b/lisp/emulation/viper-macs.el
@@ -4,6 +4,7 @@
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Michael Kifer <[email protected]>
+;; Package: viper
;; This file is part of GNU Emacs.
diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el
index dd1cd5362c..9bea921e16 100644
--- a/lisp/emulation/viper-mous.el
+++ b/lisp/emulation/viper-mous.el
@@ -4,6 +4,7 @@
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Michael Kifer <[email protected]>
+;; Package: viper
;; This file is part of GNU Emacs.
diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el
index 99dd305cb4..1ad24da1ef 100644
--- a/lisp/emulation/viper-util.el
+++ b/lisp/emulation/viper-util.el
@@ -4,6 +4,7 @@
;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Michael Kifer <[email protected]>
+;; Package: viper
;; This file is part of GNU Emacs.
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index 302cfa8295..04833a836a 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -8,6 +8,7 @@
;; Author: Michael Kifer <[email protected]>
;; Keywords: emulations
+;; Version: 3.14.1
;; Yoni Rabkin <[email protected]> contacted the maintainer of this
;; file on 20/3/2008, and the maintainer agreed that when a bug is
diff --git a/lisp/env.el b/lisp/env.el
index 0699e907fa..b69f2d2b0e 100644
--- a/lisp/env.el
+++ b/lisp/env.el
@@ -5,6 +5,7 @@
;; Maintainer: FSF
;; Keywords: processes, unix
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/epa-dired.el b/lisp/epa-dired.el
index 7ba414da2f..80ecef6f54 100644
--- a/lisp/epa-dired.el
+++ b/lisp/epa-dired.el
@@ -3,6 +3,7 @@
;; Author: Daiki Ueno <[email protected]>
;; Keywords: PGP, GnuPG
+;; Package: epa
;; This file is part of GNU Emacs.
diff --git a/lisp/epa-file.el b/lisp/epa-file.el
index af016eb20b..3c6cf07ea1 100644
--- a/lisp/epa-file.el
+++ b/lisp/epa-file.el
@@ -3,6 +3,7 @@
;; Author: Daiki Ueno <[email protected]>
;; Keywords: PGP, GnuPG
+;; Package: epa
;; This file is part of GNU Emacs.
@@ -157,12 +158,17 @@ way."
(if (or beg end)
(setq string (substring string (or beg 0) end)))
(save-excursion
- (save-restriction
- (narrow-to-region (point) (point))
- (epa-file-decode-and-insert string file visit beg end replace)
- (setq length (- (point-max) (point-min))))
- (if replace
- (delete-region (point) (point-max)))
+ ;; If visiting, bind off buffer-file-name so that
+ ;; file-locking will not ask whether we should
+ ;; really edit the buffer.
+ (let ((buffer-file-name
+ (if visit nil buffer-file-name)))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (epa-file-decode-and-insert string file visit beg end replace)
+ (setq length (- (point-max) (point-min))))
+ (if replace
+ (delete-region (point) (point-max))))
(if visit
(set-visited-file-modtime))))
(if (and local-copy
diff --git a/lisp/epa-hook.el b/lisp/epa-hook.el
index 9ed2feb15b..5fb7e2c0bf 100644
--- a/lisp/epa-hook.el
+++ b/lisp/epa-hook.el
@@ -3,6 +3,7 @@
;; Author: Daiki Ueno <[email protected]>
;; Keywords: PGP, GnuPG
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el
index 69fb6d7d7e..09b3086811 100644
--- a/lisp/epa-mail.el
+++ b/lisp/epa-mail.el
@@ -3,6 +3,7 @@
;; Author: Daiki Ueno <[email protected]>
;; Keywords: PGP, GnuPG, mail, message
+;; Package: epa
;; This file is part of GNU Emacs.
diff --git a/lisp/epg-config.el b/lisp/epg-config.el
index ddbdd3541a..37c5d01fb1 100644
--- a/lisp/epg-config.el
+++ b/lisp/epg-config.el
@@ -4,6 +4,7 @@
;; Author: Daiki Ueno <[email protected]>
;; Keywords: PGP, GnuPG
+;; Package: epg
;; This file is part of GNU Emacs.
diff --git a/lisp/epg.el b/lisp/epg.el
index 9a75560704..fae896c4ae 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -4,6 +4,7 @@
;; Author: Daiki Ueno <[email protected]>
;; Keywords: PGP, GnuPG
+;; Version: 1.0.0
;; This file is part of GNU Emacs.
diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog
index 6591db6cd9..90b3131ebd 100644
--- a/lisp/erc/ChangeLog
+++ b/lisp/erc/ChangeLog
@@ -1,3 +1,10 @@
+2010-08-14 Vivek Dasmohapatra <[email protected]>
+
+ * erc-join.el (erc-autojoin-timing, erc-autojoin-delay): New vars.
+ (erc-autojoin-channels-delayed, erc-autojoin-after-ident): New
+ functions.
+ (erc-autojoin-channels): Allow autojoining after ident (Bug#5521).
+
2010-08-08 Fran Litterio <[email protected]>
* erc-backend.el (erc-server-filter-function): Call
diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el
index 7081d97fc4..c54c2c534f 100644
--- a/lisp/erc/erc-join.el
+++ b/lisp/erc/erc-join.el
@@ -42,9 +42,11 @@
(define-erc-module autojoin nil
"Makes ERC autojoin on connects and reconnects."
((add-hook 'erc-after-connect 'erc-autojoin-channels)
+ (add-hook 'erc-nickserv-identified-hook 'erc-autojoin-after-ident)
(add-hook 'erc-server-JOIN-functions 'erc-autojoin-add)
(add-hook 'erc-server-PART-functions 'erc-autojoin-remove))
((remove-hook 'erc-after-connect 'erc-autojoin-channels)
+ (remove-hook 'erc-nickserv-identified-hook 'erc-autojoin-after-ident)
(remove-hook 'erc-server-JOIN-functions 'erc-autojoin-add)
(remove-hook 'erc-server-PART-functions 'erc-autojoin-remove)))
@@ -66,6 +68,24 @@ time is used again."
(repeat :tag "Channels"
(string :tag "Name")))))
+(defcustom erc-autojoin-timing 'connect
+ "When ERC should attempt to autojoin a channel.
+If the value is `connect', autojoin immediately on connecting.
+If the value is `ident', autojoin after successful NickServ
+identification, or after `erc-autojoin-delay' seconds.
+Any other value means the same as `connect'."
+ :group 'erc-autojoin
+ :type '(choice (const :tag "On Connection" 'connect)
+ (const :tag "When Identified" 'ident)))
+
+(defcustom erc-autojoin-delay 30
+ "Number of seconds to wait before attempting to autojoin channels.
+This only takes effect if `erc-autojoin-timing' is `ident'.
+If NickServ identification occurs before this delay expires, ERC
+autojoins immediately at that time."
+ :group 'erc-autojoin
+ :type 'integer)
+
(defcustom erc-autojoin-domain-only t
"Truncate host name to the domain name when joining a server.
If non-nil, and a channel on the server a.b.c is joined, then
@@ -75,12 +95,60 @@ servers, presumably in the same domain."
:group 'erc-autojoin
:type 'boolean)
+(defvar erc--autojoin-timer nil)
+(make-variable-buffer-local 'erc--autojoin-timer)
+
+(defun erc-autojoin-channels-delayed (server nick buffer)
+ "Attempt to autojoin channels.
+This is called from a timer set up by `erc-autojoin-channels'."
+ (if erc--autojoin-timer
+ (setq erc--autojoin-timer
+ (erc-cancel-timer erc--autojoin-timer)))
+ (with-current-buffer buffer
+ ;; Don't kick of another delayed autojoin or try to wait for
+ ;; another ident response:
+ (let ((erc-autojoin-delay -1)
+ (erc-autojoin-timing 'connect))
+ (erc-log "Delayed autojoin started (no ident success detected yet)")
+ (erc-autojoin-channels server nick))))
+
+(defun erc-autojoin-after-ident (network nick)
+ "Autojoin channels in `erc-autojoin-channels-alist'.
+This function is run from `erc-nickserv-identified-hook'."
+ (if erc--autojoin-timer
+ (setq erc--autojoin-timer
+ (erc-cancel-timer erc--autojoin-timer)))
+ (when (eq erc-autojoin-timing 'ident)
+ (let ((server (or erc-server-announced-name erc-session-server))
+ (joined (mapcar (lambda (buf)
+ (with-current-buffer buf (erc-default-target)))
+ (erc-channel-list erc-server-process))))
+ ;; We may already be in these channels, e.g. because the
+ ;; autojoin timer went off.
+ (dolist (l erc-autojoin-channels-alist)
+ (when (string-match (car l) server)
+ (dolist (chan (cdr l))
+ (unless (erc-member-ignore-case chan joined)
+ (erc-server-send (concat "join " chan))))))))
+ nil)
+
(defun erc-autojoin-channels (server nick)
"Autojoin channels in `erc-autojoin-channels-alist'."
- (dolist (l erc-autojoin-channels-alist)
- (when (string-match (car l) server)
- (dolist (chan (cdr l))
- (erc-server-send (concat "join " chan))))))
+ (if (eq erc-autojoin-timing 'ident)
+ ;; Prepare the delayed autojoin timer, in case ident doesn't
+ ;; happen within the allotted time limit:
+ (when (> erc-autojoin-delay 0)
+ (setq erc--autojoin-timer
+ (run-with-timer erc-autojoin-delay nil
+ 'erc-autojoin-channels-delayed
+ server nick (current-buffer))))
+ ;; `erc-autojoin-timing' is `connect':
+ (dolist (l erc-autojoin-channels-alist)
+ (when (string-match (car l) server)
+ (dolist (chan (cdr l))
+ (erc-server-send (concat "join " chan))))))
+ ;; Return nil to avoid stomping on any other hook funcs.
+ nil)
(defun erc-autojoin-add (proc parsed)
"Add the channel being joined to `erc-autojoin-channels-alist'."
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index ce4c9a46f5..54f87982f8 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -12,6 +12,7 @@
;; David Edmondson ([email protected])
;; Maintainer: Michael Olson ([email protected])
;; Keywords: IRC, chat, client, Internet
+;; Version: 5.3
;; This file is part of GNU Emacs.
diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el
index 8662dd9fff..826e7ec0d0 100644
--- a/lisp/eshell/em-term.el
+++ b/lisp/eshell/em-term.el
@@ -187,8 +187,7 @@ allowed."
; (if (boundp 'xemacs-logo)
; (eshell-term-send-raw-string
; (or (condition-case () (x-get-selection) (error ()))
-; (x-get-cutbuffer)
-; (error "No selection or cut buffer available")))
+; (error "No selection available")))
; ;; Give temporary modes such as isearch a chance to turn off.
; (run-hooks 'mouse-leave-buffer-hook)
; (setq this-command 'yank)
diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index 20b86676ea..5249538d71 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -5,6 +5,7 @@
;; Author: Boris Goldowsky <[email protected]>
;; Keywords: faces
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -699,6 +700,22 @@ determine the correct answer."
(cond ((equal a b) t)
((equal (color-values a) (color-values b)))))
+
+(defvar facemenu-self-insert-data nil)
+
+(defun facemenu-post-self-insert-function ()
+ (when (and (car facemenu-self-insert-data)
+ (eq last-command (cdr facemenu-self-insert-data)))
+ (put-text-property (1- (point)) (point)
+ 'face (car facemenu-self-insert-data))
+ (setq facemenu-self-insert-data nil))
+ (remove-hook 'post-self-insert-hook 'facemenu-post-self-insert-function))
+
+(defun facemenu-set-self-insert-face (face)
+ "Arrange for the next self-inserted char to have face `face'."
+ (setq facemenu-self-insert-data (cons face this-command))
+ (add-hook 'post-self-insert-hook 'facemenu-post-self-insert-function))
+
(defun facemenu-add-face (face &optional start end)
"Add FACE to text between START and END.
If START is nil or START to END is empty, add FACE to next typed character
@@ -712,51 +729,52 @@ As a special case, if FACE is `default', then the region is left with NO face
text property. Otherwise, selecting the default face would not have any
effect. See `facemenu-remove-face-function'."
(interactive "*xFace: \nr")
- (if (and (eq face 'default)
- (not (eq facemenu-remove-face-function t)))
- (if facemenu-remove-face-function
- (funcall facemenu-remove-face-function start end)
- (if (and start (< start end))
- (remove-text-properties start end '(face default))
- (setq self-insert-face 'default
- self-insert-face-command this-command)))
- (if facemenu-add-face-function
- (save-excursion
- (if end (goto-char end))
- (save-excursion
- (if start (goto-char start))
- (insert-before-markers
- (funcall facemenu-add-face-function face end)))
- (if facemenu-end-add-face
- (insert (if (stringp facemenu-end-add-face)
- facemenu-end-add-face
- (funcall facemenu-end-add-face face)))))
+ (cond
+ ((and (eq face 'default)
+ (not (eq facemenu-remove-face-function t)))
+ (if facemenu-remove-face-function
+ (funcall facemenu-remove-face-function start end)
(if (and start (< start end))
- (let ((part-start start) part-end)
- (while (not (= part-start end))
- (setq part-end (next-single-property-change part-start 'face
- nil end))
- (let ((prev (get-text-property part-start 'face)))
- (put-text-property part-start part-end 'face
- (if (null prev)
- face
- (facemenu-active-faces
- (cons face
- (if (listp prev)
- prev
- (list prev)))
- ;; Specify the selected frame
- ;; because nil would mean to use
- ;; the new-frame default settings,
- ;; and those are usually nil.
- (selected-frame)))))
- (setq part-start part-end)))
- (setq self-insert-face (if (eq last-command self-insert-face-command)
- (cons face (if (listp self-insert-face)
- self-insert-face
- (list self-insert-face)))
- face)
- self-insert-face-command this-command))))
+ (remove-text-properties start end '(face default))
+ (facemenu-set-self-insert-face 'default))))
+ (facemenu-add-face-function
+ (save-excursion
+ (if end (goto-char end))
+ (save-excursion
+ (if start (goto-char start))
+ (insert-before-markers
+ (funcall facemenu-add-face-function face end)))
+ (if facemenu-end-add-face
+ (insert (if (stringp facemenu-end-add-face)
+ facemenu-end-add-face
+ (funcall facemenu-end-add-face face))))))
+ ((and start (< start end))
+ (let ((part-start start) part-end)
+ (while (not (= part-start end))
+ (setq part-end (next-single-property-change part-start 'face
+ nil end))
+ (let ((prev (get-text-property part-start 'face)))
+ (put-text-property part-start part-end 'face
+ (if (null prev)
+ face
+ (facemenu-active-faces
+ (cons face
+ (if (listp prev)
+ prev
+ (list prev)))
+ ;; Specify the selected frame
+ ;; because nil would mean to use
+ ;; the new-frame default settings,
+ ;; and those are usually nil.
+ (selected-frame)))))
+ (setq part-start part-end))))
+ (t
+ (facemenu-set-self-insert-face
+ (if (eq last-command (cdr facemenu-self-insert-data))
+ (cons face (if (listp (car facemenu-self-insert-data))
+ (car facemenu-self-insert-data)
+ (list (car facemenu-self-insert-data))))
+ face))))
(unless (facemenu-enable-faces-p)
(message "Font-lock mode will override any faces you set in this buffer")))
diff --git a/lisp/faces.el b/lisp/faces.el
index b7c238e14f..400a0f1c96 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -6,6 +6,7 @@
;; Maintainer: FSF
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -2281,6 +2282,9 @@ terminal type to a different value."
(defface region
'((((class color) (min-colors 88) (background dark))
:background "blue3")
+ (((class color) (min-colors 88) (background light) (type gtk))
+ :foreground "gtk_selection_fg_color"
+ :background "gtk_selection_bg_color")
(((class color) (min-colors 88) (background light) (type ns))
:background "ns_selection_color")
(((class color) (min-colors 88) (background light))
diff --git a/lisp/files-x.el b/lisp/files-x.el
index 096f302820..222141bd35 100644
--- a/lisp/files-x.el
+++ b/lisp/files-x.el
@@ -5,6 +5,7 @@
;; Author: Juri Linkov <[email protected]>
;; Maintainer: FSF
;; Keywords: files
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/files.el b/lisp/files.el
index 8b131e04eb..ef74b54ca6 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1,3 +1,18 @@
+;; (defun auto-save-mode (arg)
+;; "Toggle auto-saving of contents of current buffer.
+;; With prefix argument ARG, turn auto-saving on if positive, else off."
+;; (interactive)
+;; (if (> arg 0) auto-save (null auto-save)))
+
+
+;; (defun auto-fill-mode (arg)
+;; "Toggle Auto Fill mode.
+;; With ARG, turn Auto Fill mode on if and only if ARG is positive.
+;; In Auto Fill mode, inserting a space at a column beyond `current-fill-column'
+;; automatically breaks the line at a previous space."
+;; (interactive)
+;; (if (> arg 0) auto-fill (null auto-fill)))
+
;;; files.el --- file input and output commands for Emacs
;; Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994, 1995, 1996,
@@ -5,6 +20,7 @@
;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Maintainer: FSF
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -66,9 +82,9 @@ Use this feature when you have directories which you normally refer to
via absolute symbolic links. Make TO the name of the link, and FROM
the name it is linked to."
:type '(repeat (cons :format "%v"
- :value ("" . "")
+ :value ("\\`" . "")
(regexp :tag "From")
- (regexp :tag "To")))
+ (string :tag "To")))
:group 'abbrev
:group 'find-file)
@@ -757,21 +773,44 @@ one or more of those symbols."
(let ((x (file-name-directory suffix)))
(if x (1- (length x)) (length suffix))))))
(t
- (let ((names nil)
+ (let ((names '())
+ ;; If we have files like "foo.el" and "foo.elc", we could load one of
+ ;; them with "foo.el", "foo.elc", or "foo", where just "foo" is the
+ ;; preferred way. So if we list all 3, that gives a lot of redundant
+ ;; entries for the poor soul looking just for "foo". OTOH, sometimes
+ ;; the user does want to pay attention to the extension. We try to
+ ;; diffuse this tension by stripping the suffix, except when the
+ ;; result is a single element (i.e. usually we only list "foo" unless
+ ;; it's the only remaining element in the list, in which case we do
+ ;; list "foo", "foo.elc" and "foo.el").
+ (fullnames '())
(suffix (concat (regexp-opt suffixes t) "\\'"))
(string-dir (file-name-directory string))
(string-file (file-name-nondirectory string)))
(dolist (dir dirs)
- (unless dir
- (setq dir default-directory))
- (if string-dir (setq dir (expand-file-name string-dir dir)))
- (when (file-directory-p dir)
- (dolist (file (file-name-all-completions
- string-file dir))
- (push file names)
- (when (string-match suffix file)
- (setq file (substring file 0 (match-beginning 0)))
- (push file names)))))
+ (unless dir
+ (setq dir default-directory))
+ (if string-dir (setq dir (expand-file-name string-dir dir)))
+ (when (file-directory-p dir)
+ (dolist (file (file-name-all-completions
+ string-file dir))
+ (if (not (string-match suffix file))
+ (push file names)
+ (push file fullnames)
+ (push (substring file 0 (match-beginning 0)) names)))))
+ ;; Switching from names to names+fullnames creates a non-monotonicity
+ ;; which can cause problems with things like partial-completion.
+ ;; To minimize the problem, filter out completion-regexp-list, so that
+ ;; M-x load-library RET t/x.e TAB finds some files.
+ (if completion-regexp-list
+ (setq names (all-completions "" names)))
+ ;; Remove duplicates of the first element, so that we can easily check
+ ;; if `names' really only contains a single element.
+ (when (cdr names) (setcdr names (delete (car names) (cdr names))))
+ (unless (cdr names)
+ ;; There's no more than one matching non-suffixed element, so expand
+ ;; the list by adding the suffixed elements as well.
+ (setq names (nconc names fullnames)))
(completion-table-with-context
string-dir names string-file pred action)))))
@@ -2782,6 +2821,7 @@ asking you for confirmation."
(no-update-autoloads . booleanp)
(tab-width . integerp) ;; C source code
(truncate-lines . booleanp) ;; C source code
+ (word-wrap . booleanp) ;; C source code
(bidi-display-reordering . booleanp))) ;; C source code
(put 'bidi-paragraph-direction 'safe-local-variable
@@ -5538,12 +5578,14 @@ preference to the program given by this variable."
(defun get-free-disk-space (dir)
"Return the amount of free space on directory DIR's file system.
-The result is a string that gives the number of free 1KB blocks,
-or nil if the system call or the program which retrieve the information
-fail. It returns also nil when DIR is a remote directory.
-
-This function calls `file-system-info' if it is available, or invokes the
-program specified by `directory-free-space-program' if that is non-nil."
+The return value is a string describing the amount of free
+space (normally, the number of free 1KB blocks).
+
+This function calls `file-system-info' if it is available, or
+invokes the program specified by `directory-free-space-program'
+and `directory-free-space-args'. If the system call or program
+is unsuccessful, or if DIR is a remote directory, this function
+returns nil."
(unless (file-remote-p dir)
;; Try to find the number of free blocks. Non-Posix systems don't
;; always have df, but might have an equivalent system call.
@@ -5563,19 +5605,22 @@ program specified by `directory-free-space-program' if that is non-nil."
directory-free-space-args
dir)
0)))
- ;; Usual format is a header line followed by a line of
- ;; numbers.
+ ;; Usual format is as follows:
+ ;; Filesystem ... Used Available Capacity ...
+ ;; /dev/sda6 ...48106535 35481255 10669850 ...
(goto-char (point-min))
- (forward-line 1)
- (if (not (eobp))
- (progn
- ;; Move to the end of the "available blocks" number.
- (skip-chars-forward "^ \t")
- (forward-word 3)
- ;; Copy it into AVAILABLE.
- (let ((end (point)))
- (forward-word -1)
- (buffer-substring (point) end))))))))))
+ (when (re-search-forward " +Avail[^ \n]*"
+ (line-end-position) t)
+ (let ((beg (match-beginning 0))
+ (end (match-end 0))
+ str)
+ (forward-line 1)
+ (setq str
+ (buffer-substring-no-properties
+ (+ beg (point) (- (point-min)))
+ (+ end (point) (- (point-min)))))
+ (when (string-match "\\` *\\([^ ]+\\)" str)
+ (match-string 1 str))))))))))
;; The following expression replaces `dired-move-to-filename-regexp'.
(defvar directory-listing-before-filename-regexp
diff --git a/lisp/finder.el b/lisp/finder.el
index b7eccf3ac7..0c12a08d10 100644
--- a/lisp/finder.el
+++ b/lisp/finder.el
@@ -30,55 +30,50 @@
;;; Code:
+(require 'package)
(require 'lisp-mnt)
-(require 'find-func) ;for find-library(-suffixes)
-;; Use `load' rather than `require' so that it doesn't get loaded
-;; during byte-compilation (at which point it might be missing).
-(load "finder-inf" t t)
+(require 'find-func) ;for find-library(-suffixes)
+(require 'finder-inf nil t)
;; These are supposed to correspond to top-level customization groups,
;; says rms.
(defvar finder-known-keywords
- '(
- (abbrev . "abbreviation handling, typing shortcuts, macros")
- ;; Too specific:
- (bib . "code related to the `bib' bibliography processor")
- (c . "support for the C language and related languages")
- (calendar . "calendar and time management support")
- (comm . "communications, networking, remote access to files")
+ '((abbrev . "abbreviation handling, typing shortcuts, and macros")
+ (bib . "bibliography processors")
+ (c . "C and related programming languages")
+ (calendar . "calendar and time management tools")
+ (comm . "communications, networking, and remote file access")
(convenience . "convenience features for faster editing")
- (data . "support for editing files of data")
- (docs . "support for Emacs documentation")
+ (data . "editing data (non-text) files")
+ (docs . "Emacs documentation facilities")
(emulations . "emulations of other editors")
(extensions . "Emacs Lisp language extensions")
- (faces . "support for multiple fonts")
- (files . "support for editing and manipulating files")
- (frames . "support for Emacs frames and window systems")
+ (faces . "fonts and colors for text")
+ (files . "file editing and manipulation")
+ (frames . "Emacs frames and window systems")
(games . "games, jokes and amusements")
- (hardware . "support for interfacing with exotic hardware")
- (help . "support for on-line help systems")
- (hypermedia . "support for links between text or other media types")
- (i18n . "internationalization and alternate character-set support")
+ (hardware . "interfacing with system hardware")
+ (help . "on-line help systems")
+ (hypermedia . "links between text or other media types")
+ (i18n . "internationalization and character-set support")
(internal . "code for Emacs internals, build process, defaults")
(languages . "specialized modes for editing programming languages")
(lisp . "Lisp support, including Emacs Lisp")
(local . "code local to your site")
- (maint . "maintenance aids for the Emacs development group")
- (mail . "modes for electronic-mail handling")
- (matching . "various sorts of searching and matching")
+ (maint . "Emacs development tools and aids")
+ (mail . "email reading and posting")
+ (matching . "searching, matching, and sorting")
(mouse . "mouse support")
- (multimedia . "images and sound support")
- (news . "support for netnews reading and posting")
- (oop . "support for object-oriented programming")
- (outlines . "support for hierarchical outlining")
- (processes . "process, subshell, compilation, and job control support")
- (terminals . "support for terminal types")
- (tex . "supporting code for the TeX formatter")
+ (multimedia . "images and sound")
+ (news . "USENET news reading and posting")
+ (outlines . "hierarchical outlining and note taking")
+ (processes . "processes, subshells, and compilation")
+ (terminals . "text terminals (ttys)")
+ (tex . "the TeX document formatter")
(tools . "programming tools")
- (unix . "front-ends/assistants for, or emulators of, UNIX-like features")
+ (unix . "UNIX feature interfaces and emulators")
(vc . "version control")
- (wp . "word processing")
- ))
+ (wp . "word processing")))
(defvar finder-mode-map
(let ((map (make-sparse-keymap))
@@ -125,8 +120,9 @@
;;; Code for regenerating the keyword list.
-(defvar finder-package-info nil
- "Assoc list mapping file names to description & keyword lists.")
+(defvar finder-keywords-hash nil
+ "Hash table mapping keywords to lists of package names.
+Keywords and package names both should be symbols.")
(defvar generated-finder-keywords-file "finder-inf.el"
"The function `finder-compile-keywords' writes keywords into this file.")
@@ -142,10 +138,91 @@ cus-load\\|finder-inf\\|esh-groups\\|subdirs\\)\\.el$\\)"
(autoload 'autoload-rubric "autoload")
+(defvar finder--builtins-alist
+ '(("calc" . calc)
+ ("ede" . ede)
+ ("erc" . erc)
+ ("eshell" . eshell)
+ ("gnus" . gnus)
+ ("international" . emacs)
+ ("language" . emacs)
+ ("mh-e" . mh-e)
+ ("semantic" . semantic)
+ ("analyze" . semantic)
+ ("bovine" . semantic)
+ ("decorate" . semantic)
+ ("symref" . semantic)
+ ("wisent" . semantic)
+ ("nxml" . nxml)
+ ("org" . org)
+ ("srecode" . srecode)
+ ("term" . emacs)
+ ("url" . url))
+ "Alist of built-in package directories.
+Each element should have the form (DIR . PACKAGE), where DIR is a
+directory name and PACKAGE is the name of a package (a symbol).
+When generating `package--builtins', Emacs assumes any file in
+DIR is part of the package PACKAGE.")
+
(defun finder-compile-keywords (&rest dirs)
- "Regenerate the keywords association list into `generated-finder-keywords-file'.
-Optional arguments DIRS are a list of Emacs Lisp directories to compile from;
-no arguments compiles from `load-path'."
+ "Regenerate list of built-in Emacs packages.
+This recomputes `package--builtins' and `finder-keywords-hash',
+and prints them into the file `generated-finder-keywords-file'.
+
+Optional DIRS is a list of Emacs Lisp directories to compile
+from; the default is `load-path'."
+ ;; Allow compressed files also.
+ (setq package--builtins nil)
+ (setq finder-keywords-hash (make-hash-table :test 'eq))
+ (let ((el-file-regexp "^\\([^=].*\\)\\.el\\(\\.\\(gz\\|Z\\)\\)?$")
+ package-override files base-name processed
+ summary keywords package version entry desc)
+ (dolist (d (or dirs load-path))
+ (when (file-exists-p (directory-file-name d))
+ (message "Directory %s" d)
+ (setq package-override
+ (intern-soft
+ (cdr-safe
+ (assoc (file-name-nondirectory (directory-file-name d))
+ finder--builtins-alist))))
+ (setq files (directory-files d nil el-file-regexp))
+ (dolist (f files)
+ (unless (or (string-match finder-no-scan-regexp f)
+ (null (setq base-name
+ (and (string-match el-file-regexp f)
+ (intern (match-string 1 f)))))
+ (memq base-name processed))
+ (push base-name processed)
+ (with-temp-buffer
+ (insert-file-contents (expand-file-name f d))
+ (setq summary (lm-synopsis)
+ keywords (mapcar 'intern (lm-keywords-list))
+ package (or package-override
+ (intern-soft (lm-header "package"))
+ base-name)
+ version (lm-header "version")))
+ (when summary
+ (setq version (ignore-errors (version-to-list version)))
+ (setq entry (assq package package--builtins))
+ (cond ((null entry)
+ (push (cons package (vector version nil summary))
+ package--builtins))
+ ((eq base-name package)
+ (setq desc (cdr entry))
+ (aset desc 0 version)
+ (aset desc 2 summary)))
+ (dolist (kw keywords)
+ (puthash kw
+ (cons package
+ (delq package
+ (gethash kw finder-keywords-hash)))
+ finder-keywords-hash))))))))
+
+ (setq package--builtins
+ (sort package--builtins
+ (lambda (a b) (string< (symbol-name (car a))
+ (symbol-name (car b))))))
+
(save-excursion
(find-file generated-finder-keywords-file)
(setq buffer-undo-list t)
@@ -153,40 +230,16 @@ no arguments compiles from `load-path'."
(insert (autoload-rubric generated-finder-keywords-file
"keyword-to-package mapping" t))
(search-backward " ")
- (insert "(setq finder-package-info '(\n")
- (let (processed summary keywords)
- (mapc
- (lambda (d)
- (when (file-exists-p (directory-file-name d))
- (message "Directory %s" d)
- (mapc
- (lambda (f)
- ;; FIXME should this not be using (expand-file-name f d)?
- (unless (or (member f processed)
- (string-match finder-no-scan-regexp f))
- (setq processed (cons f processed))
- (with-temp-buffer
- (insert-file-contents (expand-file-name f d))
- (setq summary (lm-synopsis)
- keywords (lm-keywords-list)))
- (insert
- (format " (\"%s\"\n "
- (if (string-match "\\.\\(gz\\|Z\\)$" f)
- (file-name-sans-extension f)
- f)))
- (prin1 summary (current-buffer))
- (insert "\n ")
- (prin1 (mapcar 'intern keywords) (current-buffer))
- (insert ")\n")))
- (directory-files d nil
- ;; Allow compressed files also. FIXME:
- ;; generalize this, especially for
- ;; MS-DOG-type filenames.
- "^[^=].*\\.el\\(\\.\\(gz\\|Z\\)\\)?$"
- ))))
- (or dirs load-path)))
- (insert " ))\n")
- (eval-buffer) ; so we get the new keyword list immediately
+ (insert "(setq package--builtins '(\n")
+ (dolist (package package--builtins)
+ (insert " ")
+ (prin1 package (current-buffer))
+ (insert "\n"))
+ (insert "))\n\n")
+ ;; Insert hash table.
+ (insert "(setq finder-keywords-hash\n ")
+ (prin1 finder-keywords-hash (current-buffer))
+ (insert ")\n")
(basic-save-buffer)))
(defun finder-compile-keywords-make-dist ()
@@ -226,26 +279,14 @@ no arguments compiles from `load-path'."
(defun finder-unknown-keywords ()
"Return an alist of unknown keywords and number of their occurences.
-Unknown are keywords that are present in `finder-package-info'
-but absent in `finder-known-keywords'."
- (let ((unknown-keywords-hash (make-hash-table)))
- ;; Prepare a hash where key is a keyword
- ;; and value is the number of keyword occurences.
- (mapc (lambda (package)
- (mapc (lambda (keyword)
- (unless (assq keyword finder-known-keywords)
- (puthash keyword
- (1+ (gethash keyword unknown-keywords-hash 0))
- unknown-keywords-hash)))
- (nth 2 package)))
- finder-package-info)
- ;; Make an alist from the hash and sort by the keyword name.
- (sort (let (unknown-keywords-list)
- (maphash (lambda (key value)
- (push (cons key value) unknown-keywords-list))
- unknown-keywords-hash)
- unknown-keywords-list)
- (lambda (a b) (string< (car a) (car b))))))
+Unknown keywords are those present in `finder-keywords-hash' but
+not `finder-known-keywords'."
+ (let (alist)
+ (maphash (lambda (kw packages)
+ (unless (assq kw finder-known-keywords)
+ (push (cons kw (length packages)) alist)))
+ finder-keywords-hash)
+ (sort alist (lambda (a b) (string< (car a) (car b))))))
;;;###autoload
(defun finder-list-keywords ()
@@ -255,46 +296,27 @@ but absent in `finder-known-keywords'."
(pop-to-buffer "*Finder*")
(pop-to-buffer (get-buffer-create "*Finder*"))
(finder-mode)
- (setq buffer-read-only nil
- buffer-undo-list t)
- (erase-buffer)
- (mapc
- (lambda (assoc)
- (let ((keyword (car assoc)))
- (insert (symbol-name keyword))
- (finder-insert-at-column 14 (concat (cdr assoc) "\n"))
- (finder-mouse-face-on-line)))
- finder-known-keywords)
- (goto-char (point-min))
- (setq finder-headmark (point)
- buffer-read-only t)
- (set-buffer-modified-p nil)
- (balance-windows)
- (finder-summary)))
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (dolist (assoc finder-known-keywords)
+ (let ((keyword (car assoc)))
+ (insert (propertize (symbol-name keyword)
+ 'font-lock-face 'font-lock-constant-face))
+ (finder-insert-at-column 14 (concat (cdr assoc) "\n"))
+ (finder-mouse-face-on-line)))
+ (goto-char (point-min))
+ (setq finder-headmark (point)
+ buffer-read-only t)
+ (set-buffer-modified-p nil)
+ (balance-windows)
+ (finder-summary))))
(defun finder-list-matches (key)
- (pop-to-buffer (set-buffer (get-buffer-create "*Finder Category*")))
- (finder-mode)
- (setq buffer-read-only nil
- buffer-undo-list t)
- (erase-buffer)
- (let ((id (intern key)))
- (insert
- "The following packages match the keyword `" key "':\n\n")
- (setq finder-headmark (point))
- (mapc
- (lambda (x)
- (when (memq id (cadr (cdr x)))
- (insert (car x))
- (finder-insert-at-column 16 (concat (cadr x) "\n"))
- (finder-mouse-face-on-line)))
- finder-package-info)
- (goto-char (point-min))
- (forward-line)
- (setq buffer-read-only t)
- (set-buffer-modified-p nil)
- (shrink-window-if-larger-than-buffer)
- (finder-summary)))
+ (let* ((id (intern key))
+ (packages (gethash id finder-keywords-hash)))
+ (unless packages
+ (error "No packages matching key `%s'" key))
+ (package--list-packages packages)))
(define-button-type 'finder-xref 'action #'finder-goto-xref)
@@ -381,8 +403,8 @@ FILE should be in a form suitable for passing to `locate-library'."
\\[finder-select] more help for the item on the current line
\\[finder-exit] exit Finder mode and kill the Finder buffer."
:syntax-table finder-mode-syntax-table
- (setq font-lock-defaults '(finder-font-lock-keywords nil nil
- (("+-*/.<>=!?$%_&~^:@" . "w")) nil))
+ (setq buffer-read-only t
+ buffer-undo-list t)
(set (make-local-variable 'finder-headmark) nil))
(defun finder-summary ()
@@ -399,8 +421,8 @@ finder directory, \\[finder-exit] = quit, \\[finder-summary] = help")))
Delete the window and kill all Finder-related buffers."
(interactive)
(ignore-errors (delete-window))
- (dolist (buff '("*Finder*" "*Finder-package*" "*Finder Category*"))
- (and (get-buffer buff) (kill-buffer buff))))
+ (let ((buf "*Finder*"))
+ (and (get-buffer buf) (kill-buffer buf))))
(provide 'finder)
diff --git a/lisp/foldout.el b/lisp/foldout.el
index bee9227639..4c7ef29a07 100644
--- a/lisp/foldout.el
+++ b/lisp/foldout.el
@@ -6,7 +6,7 @@
;; Author: Kevin Broadey <[email protected]>
;; Maintainer: FSF
;; Created: 27 Jan 1994
-;; Version: foldout.el 1.10 dated 94/05/19 at 17:09:12
+;; Version: 1.10
;; Keywords: folding, outlines
;; This file is part of GNU Emacs.
diff --git a/lisp/font-core.el b/lisp/font-core.el
index d33295b3c3..a8b72539d5 100644
--- a/lisp/font-core.el
+++ b/lisp/font-core.el
@@ -6,6 +6,7 @@
;; Maintainer: FSF
;; Keywords: languages, faces
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index db665857fd..92c6201084 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -9,6 +9,7 @@
;; Stefan Monnier
;; Maintainer: FSF
;; Keywords: languages, faces
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -543,6 +544,8 @@ and what they do:
contexts will not be affected.
This is normally set via `font-lock-defaults'.")
+(make-obsolete-variable 'font-lock-syntactic-keywords
+ 'syntax-propertize-function "24.1")
(defvar font-lock-syntax-table nil
"Non-nil means use this syntax table for fontifying.
@@ -611,24 +614,12 @@ Major/minor modes can set this variable if they know which option applies.")
;;
;; Borrowed from lazy-lock.el.
;; We use this to preserve or protect things when modifying text properties.
- (defmacro save-buffer-state (varlist &rest body)
+ (defmacro save-buffer-state (&rest body)
"Bind variables according to VARLIST and eval BODY restoring buffer state."
- (declare (indent 1) (debug let))
- (let ((modified (make-symbol "modified")))
- `(let* ,(append varlist
- `((,modified (buffer-modified-p))
- (buffer-undo-list t)
- (inhibit-read-only t)
- (inhibit-point-motion-hooks t)
- (inhibit-modification-hooks t)
- deactivate-mark
- buffer-file-name
- buffer-file-truename))
- (unwind-protect
- (progn
- ,@body)
- (unless ,modified
- (restore-buffer-modified-p nil))))))
+ (declare (indent 0) (debug t))
+ `(let ((inhibit-point-motion-hooks t))
+ (with-silent-modifications
+ ,@body)))
;;
;; Shut up the byte compiler.
(defvar font-lock-face-attributes)) ; Obsolete but respected if set.
@@ -1030,7 +1021,7 @@ The region it returns may start or end in the middle of a line.")
(funcall font-lock-fontify-region-function beg end loudly))
(defun font-lock-unfontify-region (beg end)
- (save-buffer-state nil
+ (save-buffer-state
(funcall font-lock-unfontify-region-function beg end)))
(defun font-lock-default-fontify-buffer ()
@@ -1123,39 +1114,38 @@ Put first the functions more likely to cause a change and cheaper to compute.")
(defun font-lock-default-fontify-region (beg end loudly)
(save-buffer-state
- ((parse-sexp-lookup-properties
- (or parse-sexp-lookup-properties font-lock-syntactic-keywords))
- (old-syntax-table (syntax-table)))
- (unwind-protect
- (save-restriction
- (unless font-lock-dont-widen (widen))
- ;; Use the fontification syntax table, if any.
- (when font-lock-syntax-table
- (set-syntax-table font-lock-syntax-table))
- ;; Extend the region to fontify so that it starts and ends at
- ;; safe places.
- (let ((funs font-lock-extend-region-functions)
- (font-lock-beg beg)
- (font-lock-end end))
- (while funs
- (setq funs (if (or (not (funcall (car funs)))
- (eq funs font-lock-extend-region-functions))
- (cdr funs)
- ;; If there's been a change, we should go through
- ;; the list again since this new position may
- ;; warrant a different answer from one of the fun
- ;; we've already seen.
- font-lock-extend-region-functions)))
- (setq beg font-lock-beg end font-lock-end))
- ;; Now do the fontification.
- (font-lock-unfontify-region beg end)
- (when font-lock-syntactic-keywords
- (font-lock-fontify-syntactic-keywords-region beg end))
- (unless font-lock-keywords-only
- (font-lock-fontify-syntactically-region beg end loudly))
- (font-lock-fontify-keywords-region beg end loudly))
- ;; Clean up.
- (set-syntax-table old-syntax-table))))
+ ;; Use the fontification syntax table, if any.
+ (with-syntax-table (or font-lock-syntax-table (syntax-table))
+ (save-restriction
+ (unless font-lock-dont-widen (widen))
+ ;; Extend the region to fontify so that it starts and ends at
+ ;; safe places.
+ (let ((funs font-lock-extend-region-functions)
+ (font-lock-beg beg)
+ (font-lock-end end))
+ (while funs
+ (setq funs (if (or (not (funcall (car funs)))
+ (eq funs font-lock-extend-region-functions))
+ (cdr funs)
+ ;; If there's been a change, we should go through
+ ;; the list again since this new position may
+ ;; warrant a different answer from one of the fun
+ ;; we've already seen.
+ font-lock-extend-region-functions)))
+ (setq beg font-lock-beg end font-lock-end))
+ ;; Now do the fontification.
+ (font-lock-unfontify-region beg end)
+ (when (and font-lock-syntactic-keywords
+ (null syntax-propertize-function))
+ ;; Ensure the beginning of the file is properly syntactic-fontified.
+ (let ((start beg))
+ (when (< font-lock-syntactically-fontified start)
+ (setq start (max font-lock-syntactically-fontified (point-min)))
+ (setq font-lock-syntactically-fontified end))
+ (font-lock-fontify-syntactic-keywords-region start end)))
+ (unless font-lock-keywords-only
+ (font-lock-fontify-syntactically-region beg end loudly))
+ (font-lock-fontify-keywords-region beg end loudly)))))
;; The following must be rethought, since keywords can override fontification.
;; ;; Now scan for keywords, but not if we are inside a comment now.
@@ -1451,11 +1441,10 @@ LIMIT can be modified by the value of its PRE-MATCH-FORM."
(defun font-lock-fontify-syntactic-keywords-region (start end)
"Fontify according to `font-lock-syntactic-keywords' between START and END.
START should be at the beginning of a line."
- ;; Ensure the beginning of the file is properly syntactic-fontified.
- (when (and font-lock-syntactically-fontified
- (< font-lock-syntactically-fontified start))
- (setq start (max font-lock-syntactically-fontified (point-min)))
- (setq font-lock-syntactically-fontified end))
+ (unless parse-sexp-lookup-properties
+ ;; We wouldn't go through so much trouble if we didn't intend to use those
+ ;; properties, would we?
+ (set (make-local-variable 'parse-sexp-lookup-properties) t))
;; If `font-lock-syntactic-keywords' is a symbol, get the real keywords.
(when (symbolp font-lock-syntactic-keywords)
(setq font-lock-syntactic-keywords (font-lock-eval-keywords
@@ -1498,19 +1487,18 @@ START should be at the beginning of a line."
(defvar font-lock-comment-end-skip nil
"If non-nil, Font Lock mode uses this instead of `comment-end'.")
-(defun font-lock-fontify-syntactically-region (start end &optional loudly ppss)
+(defun font-lock-fontify-syntactically-region (start end &optional loudly)
"Put proper face on each string and comment between START and END.
START should be at the beginning of a line."
+ (syntax-propertize end) ; Apply any needed syntax-table properties.
(let ((comment-end-regexp
(or font-lock-comment-end-skip
(regexp-quote
(replace-regexp-in-string "^ *" "" comment-end))))
- state face beg)
+ ;; Find the `start' state.
+ (state (syntax-ppss start))
+ face beg)
(if loudly (message "Fontifying %s... (syntactically...)" (buffer-name)))
- (goto-char start)
- ;;
- ;; Find the `start' state.
- (setq state (or ppss (syntax-ppss start)))
;;
;; Find each interesting place between here and `end'.
(while
@@ -2283,14 +2271,17 @@ in which C preprocessor directives are used. e.g. `asm-mode' and
"inline" "lambda" "save-restriction" "save-excursion"
"save-selected-window" "save-window-excursion"
"save-match-data" "save-current-buffer"
- "unwind-protect" "condition-case" "track-mouse"
- "eval-after-load" "eval-and-compile" "eval-when-compile"
- "eval-when" "eval-next-after-load"
+ "combine-after-change-calls" "unwind-protect"
+ "condition-case" "condition-case-no-debug"
+ "track-mouse" "eval-after-load" "eval-and-compile"
+ "eval-when-compile" "eval-when" "eval-next-after-load"
"with-case-table" "with-category-table"
- "with-current-buffer" "with-electric-help"
+ "with-current-buffer" "with-demoted-errors"
+ "with-electric-help"
"with-local-quit" "with-no-warnings"
"with-output-to-string" "with-output-to-temp-buffer"
- "with-selected-window" "with-selected-frame" "with-syntax-table"
+ "with-selected-window" "with-selected-frame"
+ "with-silent-modifications" "with-syntax-table"
"with-temp-buffer" "with-temp-file" "with-temp-message"
"with-timeout" "with-timeout-handler") t)
"\\>")
diff --git a/lisp/format-spec.el b/lisp/format-spec.el
index f5bc3e51b4..d177a43cc1 100644
--- a/lisp/format-spec.el
+++ b/lisp/format-spec.el
@@ -76,5 +76,4 @@ starting with a character."
(provide 'format-spec)
-;; arch-tag: c22d49cf-d167-445d-b7f1-2504d4173f53
;;; format-spec.el ends here
diff --git a/lisp/format.el b/lisp/format.el
index d4262e2d0e..0436187d98 100644
--- a/lisp/format.el
+++ b/lisp/format.el
@@ -4,6 +4,7 @@
;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Boris Goldowsky <[email protected]>
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/frame.el b/lisp/frame.el
index 8b5be93791..7a12c9fc2e 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -5,6 +5,7 @@
;; Maintainer: FSF
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -1209,8 +1210,7 @@ frame's display)."
(defun display-selections-p (&optional display)
"Return non-nil if DISPLAY supports selections.
A selection is a way to transfer text or other data between programs
-via special system buffers called `selection' or `cut buffer' or
-`clipboard'.
+via special system buffers called `selection' or `clipboard'.
DISPLAY can be a display name, a frame, or nil (meaning the selected
frame's display)."
(let ((frame-type (framep-on-display display)))
diff --git a/lisp/fringe.el b/lisp/fringe.el
index 18a89cddd7..600ef7ca1e 100644
--- a/lisp/fringe.el
+++ b/lisp/fringe.el
@@ -6,6 +6,7 @@
;; Author: Simon Josefsson <[email protected]>
;; Maintainer: FSF
;; Keywords: frames
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/generic-x.el b/lisp/generic-x.el
index 0083989c75..8c2e8b4bc9 100644
--- a/lisp/generic-x.el
+++ b/lisp/generic-x.el
@@ -6,6 +6,7 @@
;; Author: Peter Breton <[email protected]>
;; Created: Tue Oct 08 1996
;; Keywords: generic, comment, font-lock
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/gnus/.dir-locals.el b/lisp/gnus/.dir-locals.el
new file mode 100644
index 0000000000..45abc391e6
--- /dev/null
+++ b/lisp/gnus/.dir-locals.el
@@ -0,0 +1 @@
+((emacs-lisp-mode . ((show-trailing-whitespace . t))))
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index fb4f6e64d0..7dca773082 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,653 @@
+2010-09-10 Lars Magne Ingebrigtsen <[email protected]>
+
+ * gnus-start.el (gnus-read-active-file-1): If gnus-agent isn't set,
+ then do request scans from the backends.
+
+ * gnus-sum.el (gnus-summary-update-hook): Change default to nil, to
+ avoid running a hook per line, since this takes a lot of time,
+ profiling shows.
+ (gnus-summary-prepare-threads): Call `gnus-summary-highlight-line'
+ directly if gnus-visual-p is true.
+
+2010-09-10 Katsumi Yamaoka <[email protected]>
+
+ * gnus-start.el (gnus-read-active-for-groups): Check only subscribed
+ groups; replace mapcar with dolist which is a bit faster; pass groups
+ info to gnus-read-active-file-1.
+ (gnus-read-active-file-1): Scan only specified groups if the new
+ optional arg `infos' is given.
+
+2010-09-09 Lars Magne Ingebrigtsen <[email protected]>
+
+ * mail-source.el (mail-source-fetch-pop): Use pop3-movemail again.
+
+ * pop3.el (pop3-movemail): Removed.
+ (pop3-streaming-movemail): Renamed to pop3-movemail.
+
+ * gnus-html.el (gnus-html-wash-tags): Refactor out the image bit, and
+ don't restrict end-tag searches to the end of the line.
+
+2010-09-09 Katsumi Yamaoka <[email protected]>
+
+ * gnus-start.el (gnus-get-unread-articles): Set the number of unread
+ articles of every unchecked group to t, which means unknown since the
+ server has never been opened.
+
+2010-09-08 Lars Magne Ingebrigtsen <[email protected]>
+
+ * gnus-html.el (gnus-html-show-alt-text): New command.
+ (gnus-html-browse-image): Ditto.
+ (gnus-html-wash-tags): Add the data to allow showing the ALT text and
+ to browse the image directly.
+ (gnus-html-wash-tags): Search for images first, so that <a><img> works
+ better.
+
+ * gnus-async.el (gnus-async-article-callback): Call
+ `gnus-html-prefetch-images' unconditionally.
+
+ * gnus-html.el (gnus-html-schedule-image-fetching): Decode entities
+ before feeding URLs to curl.
+
+2010-09-07 Katsumi Yamaoka <[email protected]>
+
+ * gnus-html.el (gnus-html-wash-tags, gnus-html-put-image): Mark cid and
+ internal images as deletable by `W D D'.
+
+ * gnus-async.el (gnus-html-prefetch-images): Autoload it when compiling.
+ (gnus-async-article-callback): Fix typo.
+
+2010-09-06 Lars Magne Ingebrigtsen <[email protected]>
+
+ * gnus-html.el (gnus-html-wash-tags): Limit end-tag matching to the
+ current line to work around bugs in the output from w3m.
+
+ * gnus-async.el (gnus-async-article-callback): Always prefetch images
+ for groups that want that.
+
+ * nntp.el (nntp-wait-for-string): Supply a timeout for
+ accept-process-output to ensure progress.
+
+ * gnus-start.el (gnus-get-unread-articles): If being given an explicit
+ level to get unread articles from, then use that for foreign groups,
+ too.
+
+ * gnus-html.el (gnus-html-wash-tags): Remove <a name...> tags, which
+ confuses the rest of the function.
+
+ * gnus-start.el (gnus-read-active-for-groups): Do a `gnus-request-scan'
+ for the methods that support -retrieve-groups, too.
+
+ * nnml.el (nnml-save-nov): Remove some debugging-related messages.
+
+2010-09-06 Katsumi Yamaoka <[email protected]>
+
+ * pop3.el: Require cl when compiling.
+ (pop3-number-of-responses): Search for "+OK", not "+OK ".
+
+2010-09-05 Lars Magne Ingebrigtsen <[email protected]>
+
+ * gnus-start.el (gnus-get-unread-articles): Don't bother with groups
+ that aren't going to be activated.
+ (gnus-get-unread-articles): Fix up the last commit.
+
+ * gnus-html.el (gnus-article-html): Allow calling without specifying
+ the handle. In that case, dissect the buffer first.
+
+ * gnus-sum.el (gnus-set-mode-line): Don't pad the mode line string.
+
+ * nnimap.el (nnimap-open-connection): Revert the change that would look
+ into authinfo for imaps instead of imap.
+
+ * gnus-start.el (gnus-activate-group): Take an optional parameter to
+ say that you don't want to call gnus-request-group with don-check, but
+ do check the reponse. This is for virtual groups only.
+ (gnus-get-unread-articles): Count the archive groups as secondary, so
+ that they're activated the same way as before.
+
+ * nnimap.el (nnimap-request-list): Servers may return \NoSelect
+ case-insensitively.
+ (nnimap-debug): Removed.
+
+ * mail-source.el (mail-source-fetch): Don't message if we're fetching
+ mail from a file, and the file doesn't exist.
+
+ * pop3.el (pop3-streaming-movemail): Return t for success.
+
+ * nnimap.el (nnimap-open-connection): Look for the "imaps" entry in the
+ .authinfo if we're using ssl connection.
+
+ * nnvirtual.el (nnvirtual-create-mapping): Use the active info we
+ already have if we're in a main Gnus `g' run.
+
+ * gnus-start.el (gnus-method-rank): Get info for virtual groups last.
+
+2010-09-05 Katsumi Yamaoka <[email protected]>
+
+ * gnus-start.el (gnus-method-rank): Replace equalp with equal.
+
+ * nnmh.el (nnmh-request-list-1): Bind `file'.
+
+ * pop3.el (pop3-set-process-query-on-exit-flag): New function that's an
+ alias to set-process-query-on-exit-flag or process-kill-without-query.
+ (pop3-open-server): Use it.
+
+2010-09-04 Lars Magne Ingebrigtsen <[email protected]>
+
+ * mail-source.el (mail-source-delete-crash-box): Always move the crash
+ box to the Incoming file. Fixes mistake in previous checkin.
+
+ * pop3.el (pop3-send-streaming-command): Off-by-one error on the
+ request loop (for debugging purposes) removed.
+
+ * nnml.el (nnml-save-nov): Message around nnml-save-nov so that the
+ culprit is more visible.
+ (nnml-save-incremental-nov, nnml-open-incremental-nov)
+ (nnml-add-incremental-nov): New functions to do "incremental" nov
+ updates, where we just append to the end of the existing nov files
+ without reading/writing them in full.
+
+ * mail-source.el (mail-source-delete-crash-box): Really only check the
+ incoming files once in a while.
+
+ * pop3.el (pop3-streaming-movemail): Always close the pop3 connection.
+
+ * mail-source.el (mail-source-delete-crash-box): Only check the
+ incoming files for deletion once per day to save a lot of file
+ accesses.
+
+ * pop3.el (pop3-logon): Fix up unbound variable typo.
+
+ * mail-source.el (pop3-streaming-movemail): Autoload.
+
+ * pop3.el (pop3-streaming-movemail): Respect
+ pop3-leave-mail-on-server.
+
+ * mail-source.el (mail-source-fetch-pop): Use streaming pop3
+ retrieval.
+
+ * pop3.el (pop3-process-filter): Removed unused function.
+ (pop3-streaming-movemail, pop3-send-streaming-command)
+ (pop3-wait-for-messages, pop3-write-to-file)
+ (pop3-number-of-responses): New functions for streaming pop3
+ retrieval.
+
+ * gnus-start.el (gnus-get-unread-articles): Protect against groups that
+ come from no known methods.
+ (gnus-make-hashtable-from-newsrc-alist): Remove duplicates from .newsrc
+ list.
+
+ * pop3.el (pop3-display-message-size-flag): Removed -- everybody wants
+ message sizes.
+ (pop3-movemail): Use erase-buffer instead of looping and deleting
+ regions, which seems rather odd.
+
+ * gnus-agent.el (gnus-agent-load-local): Only read the agent.lib/local
+ file once per `g' run.
+
+ * nnmh.el (nnmh-request-list-1): Output active lines also for empty
+ directories. This makes the draft queue directory work.
+
+ * gnus-start.el (gnus-get-unread-articles): Rewrite the way we request
+ data from the backends, so that we only request the list of groups from
+ each method once. This should speed things up considerably.
+
+ * nnvirtual.el (nnvirtual-request-list): Remove function so that we can
+ detect that it's not implemented.
+
+ * nnmh.el (nnmh-request-list-1): Fix up the recursion behavior so that
+ we actually do recurse down into the tree, but don't stat all leaf
+ nodes.
+
+ * gnus-html.el (gnus-html-show-images): If there are no images to show,
+ then say so instead of bugging out.
+
+ * gnus-agent.el (gnus-agent-load-alist): Check whether the agentview
+ files exist before trying to read them.
+
+ * gnus-html.el (gnus-html-wash-tags): Remove even more white space
+ around <pre_int>.
+
+ * gnus-art.el (gnus-article-copy-string): Say what data we copied.
+
+ * nnmh.el (nnmh-request-list-1): Optimize for speed.
+
+2010-09-03 Lars Magne Ingebrigtsen <[email protected]>
+
+ * mm-util.el (mm-image-load-path): Just return the image directories,
+ not all directories in the path in addition to the image directories.
+ (mm-image-load-path): Maintain a cache of the image directories so that
+ the `g' command in Gnus doesn't have to stat dozens of directories each
+ time.
+
+ * gnus-html.el (gnus-html-put-image): Allow images to be removed.
+ (gnus-html-wash-tags): Add a new `i' command to insert images.
+ (gnus-html-insert-image): New command and keystroke.
+ (gnus-html-redisplay-with-images): New command and keystroke.
+ (gnus-html-show-images): Renamed command.
+ (gnus-html-wash-tags): Remove more white space before <pre_int> image
+ spacers.
+ (gnus-html-wash-tags): Decode entities at the end, so that entities
+ inside the tags don't mess up the rest of the "parsing".
+
+ * gnus-agent.el (gnus-agent-auto-agentize-methods): Change the default
+ so that nnimap methods aren't agentized by default. There's apparently
+ many problems related to agent/imap behaviour.
+
+ * gnus-art.el (gnus-article-copy-string): New command and key binding.
+
+ * gnus-html.el: Doc fix.
+
+2010-09-03 Katsumi Yamaoka <[email protected]>
+
+ * gnus-html.el (gnus-html-put-image): Use gnus-graphic-display-p,
+ glyph-width and glyph-height instead of display-graphic-p and
+ image-size; make avoidance of displaying small images work for XEmacs.
+
+ * gnus-util.el (gnus-graphic-display-p): Use device-on-window-system-p
+ for XEmacs.
+
+ * gnus-ems.el (gnus-set-process-plist, gnus-process-plist): Change name
+ of symbol that holds plist data.
+ (gnus-process-plist): Remove plist of process after getting it.
+
+2010-09-02 Lars Magne Ingebrigtsen <[email protected]>
+
+ * message.el (message-generate-hashcash): Change default to
+ 'opportunistic if hashcash is installed.
+
+ * gnus-html.el (gnus-html-rescale-image): Fix up typo in rescaling.
+ (gnus-html-put-image): Only call image-size once, since it's somewhat
+ time-consuming on remote X servers.
+
+2010-09-02 Katsumi Yamaoka <[email protected]>
+
+ * gnus-html.el (gnus-article-html): Make work buffer multibyte for
+ decoded contents.
+ (gnus-html-put-image, gnus-html-rescale-image): Pass `file' argument.
+
+2010-09-02 Lars Magne Ingebrigtsen <[email protected]>
+
+ * gnus-group.el (gnus-group-line-format): Remove %O (moderated) from
+ group line format, since it isn't very interesting.
+
+ * gnus-agent.el (gnus-agent-short-article),
+ (gnus-agent-long-article): Increase values for these two variables,
+ since most people are likely to have more network connection and
+ storage than before.
+
+ * gnus.el (gnus-refer-article-method): Change default to 'current.
+ When referring an article, the common behaviour is to refer it from the
+ current select method, not the native select method. The chances of
+ the native select method having the message in question is rather slim
+ these days.
+
+ * gnus-sum.el (gnus-auto-select-subject): Change default to
+ `unseen-or-unread'. I think it's likely that most people want to
+ select an unseen article over a previously seen, but unread one.
+
+ * gnus.el (gnus-mode-non-string-length): Change default to 30. nil
+ means that in the article buffer none of the minor mode elements will
+ be shown, usually, and this is not desirable in most cases.
+
+ * gnus-sum.el (gnus-summary-goto-unread): Change default to nil, so
+ that commands like `d' (and the like) go to the next line in the
+ buffer, instead of the next unread article. I think this is the
+ behaviour that is most natural for most users.
+ (gnus-single-article-buffer): Change default to nil, so that people can
+ have as many article buffers open as they have summary buffer. I think
+ this is the most natural way for the groups to behave.
+
+ * message.el (message-generate-new-buffers): Change default to
+ `unsent', so that all new message buffers start their names with the
+ string "*unsent", and it's easier to find the buffers if you move from
+ them.
+
+2010-09-01 Lars Magne Ingebrigtsen <[email protected]>
+
+ * gnus-html.el (gnus-html-wash-tags): Don't show images that are really
+ small. They're probably tracking images.
+ (gnus-html-wash-tags): Remove all <pre_int> place holders.
+ (gnus-html-rescale-image): Yet another try at getting the image sizing
+ right.
+
+ * nntp.el (nntp-request-set-mark): Refuse to do marks if
+ nntp-marks-file-name is nil.
+
+2010-09-01 Teodor Zlatanov <[email protected]>
+
+ * gnus-html.el (gnus-html-wash-tags)
+ (gnus-html-schedule-image-fetching, gnus-html-image-url-blocked-p):
+ Better logging.
+
+2010-09-01 Lars Magne Ingebrigtsen <[email protected]>
+
+ * nndoc.el (nndoc-type-alist): Added a new type for Google digests.
+
+ * gnus-html.el (gnus-html-wash-tags): Check the value of
+ gnus-blocked-images in the summary buffer.
+
+2010-09-01 Teodor Zlatanov <[email protected]>
+
+ * gnus-html.el (gnus-html-image-url-blocked-p): Doc fix.
+
+2010-09-01 Lars Magne Ingebrigtsen <[email protected]>
+
+ * gnus-html.el (gnus-html-wash-tags): "A" is also used for links, just
+ like "a", it seems like.
+ (gnus-html-image-url-blocked-p): Take a parameter for blocked-images
+ since it needs to be picked from the correct buffer.
+
+ * nnwfm.el: Removed.
+
+ * nnlistserv.el: Removed.
+
+2010-09-01 Teodor Zlatanov <[email protected]>
+
+ * gnus-html.el (gnus-html-image-url-blocked-p): New function.
+ (gnus-html-prefetch-images, gnus-html-wash-tags): Use it.
+
+2010-09-01 Lars Magne Ingebrigtsen <[email protected]>
+
+ * nnkiboze.el: Removed.
+
+ * nndb.el: Removed.
+
+ * gnus-html.el (gnus-html-put-image): Use the deleted text as the image
+ alt text.
+ (gnus-html-rescale-image): Try to get the rescaling logic right for
+ images that are just wide and not tall.
+
+ * gnus.el (gnus-string-or): Fix the syntax to not use eval or
+ overshadow variable bindings.
+
+2010-09-01 Teodor Zlatanov <[email protected]>
+
+ * gnus-html.el (gnus-html-wash-tags)
+ (gnus-html-schedule-image-fetching, gnus-html-prefetch-images): Add
+ extra logging.
+
+2010-09-01 Lars Magne Ingebrigtsen <[email protected]>
+
+ * gnus-html.el (gnus-html-wash-tags): Delete the IMG_ALT region.
+ (gnus-max-image-proportion): New variable.
+ (gnus-html-rescale-image): New function.
+ (gnus-html-put-image): Rescale images.
+
+2010-09-01 Stefan Monnier <[email protected]>
+
+ Fix up some byte-compiler warnings.
+ * gnus.el (gnus-group-find-parameter, gnus-kill-save-kill-buffer):
+ * gnus-cite.el (gnus-article-highlight-citation, gnus-dissect-cited-text)
+ (gnus-article-fill-cited-article, gnus-article-hide-citation)
+ (gnus-article-hide-citation-in-followups, gnus-cite-toggle):
+ * gnus-group.el (gnus-group-set-mode-line, gnus-group-quit)
+ (gnus-group-set-info, gnus-add-mark): Use with-current-buffer.
+ (gnus-group-update-group): Use save-excursion and with-current-buffer.
+
+2010-09-01 Katsumi Yamaoka <[email protected]>
+
+ * gnus-html.el (gnus-article-html): Decode contents by charset.
+
+2010-09-01 Katsumi Yamaoka <[email protected]>
+
+ * gnus-html.el (gnus-html-cache-directory, gnus-html-cache-size)
+ (gnus-html-frame-width, gnus-blocked-images)
+ * message.el (message-prune-recipient-rules): Add custom version.
+ * gnus-sum.el (gnus-auto-expirable-marks): Bump custom version.
+
+ * gnus-ems.el (gnus-process-get, gnus-process-put): New compatibility
+ functions.
+
+ * gnus-html.el (gnus-html-curl-sentinel): Replace process-get with
+ gnus-process-get.
+
+2010-08-31 Julien Danjou <[email protected]> (tiny change)
+
+ * nnimap.el (nnimap-request-newgroups): Use nnimap-request-list-method
+ instead of lsub directly.
+
+2010-08-31 Lars Magne Ingebrigtsen <[email protected]>
+
+ * nnwarchive.el: Removed.
+
+ * gnus-soup.el: Removed.
+
+ * nnsoup.el: Removed.
+
+ * nnultimate.el: Removed.
+
+ * gnus-html.el (gnus-blocked-images): New variable.
+
+ * message.el (message-prune-recipients): New function.
+ (message-prune-recipient-rules): New variable.
+
+ * gnus-cite.el (gnus-article-natural-long-line-p): New function to
+ guess whether a long line is natural text or not.
+
+ * gnus-html.el (gnus-html-schedule-image-fetching): Use
+ gnus-process-plist and friends for compatibility.
+
+2010-08-31 Stefan Monnier <[email protected]>
+
+ * gnus-html.el: Require packages that define macros used in this file.
+ (gnus-article-mouse-face): Declare to silence byte-compiler.
+ (gnus-html-curl-sentinel): Use with-current-buffer, inhibit-read-only, and
+ process-get.
+ (gnus-html-put-image): Use plist-get to avoid getf.
+ (gnus-html-prefetch-images): Use with-current-buffer.
+
+2010-08-31 Katsumi Yamaoka <[email protected]>
+
+ * gnus-ems.el: Provide compatibility functions for
+ gnus-set-process-plist.
+
+ * gnus-sum.el (gnus-summary-stop-at-end-of-message)
+ * gnus.el (gnus-valid-select-methods)
+ * message.el (message-send-mail-partially-limit)
+ * mm-decode.el (mm-text-html-renderer)
+ * mml.el (mml-insert-mime-headers-always)
+ * smiley.el (smiley-regexp-alist): Bump custom version.
+
+2010-08-31 Lars Magne Ingebrigtsen <[email protected]>
+
+ * gnus-html.el: require mm-url.
+ (gnus-html-wash-tags): Clarify the code a bit by renaming the variable
+ with the url to `url'.
+ (gnus-html-wash-tags): Support cid: URLs/images.
+
+2010-08-30 Lars Magne Ingebrigtsen <[email protected]>
+
+ * gnus-sum.el: As per discussion 3 years, 8 weeks, 3 days, 9 hours, 57
+ minutes, 56 seconds ago on the ding list, remove the `w' and `i'
+ bindings, as they aren't useful at all. `w' is moved to `W w'.
+
+ * gnus-move.el: Removed file, since it doesn't really work.
+
+ * gnus-html.el (gnus-article-html): Tell w3m that the input is
+ UTF-8. This seems to fix problems with some German web feeds.
+
+ * gnus.el (gnus-group-startup-message): Put the xpm version of the logo
+ at the top so that the proper colours are applied.
+
+ * gnus-art.el (gnus-article-view-part): Doc fix.
+
+ * gnus-html.el (gnus-html-put-image): Use gnus-create-image to be
+ XEmacs-compatible.
+ (gnus-html-put-image): Don't do images on non-graphic displays.
+
+ * nnslashdot.el: Removed this unused backend.
+
+ * gnus-undo.el (gnus-undo-register-1): Limit the undo actions to 100
+ actions.
+ (gnus-undo-register-1): Revert last change.
+
+ * gnus-group.el (gnus-group-completing-read): Protect against not
+ having completion-styles bound.
+
+ * mml.el (mml-insert-mime-headers-always): Change the default to t, to
+ make broken recipients happier.
+
+ * gnus-html.el (gnus-html-put-image): Use gnus-put-image.
+
+ * gnus-ems.el (gnus-put-image): Have gnus-put-image take an optional
+ point parameter.
+
+ * gnus-group.el (gnus-group-completing-read): Add 'substring to
+ completion-styles for group selection.
+
+2009-02-04 Andreas Schwab <[email protected]>
+
+ * gnus-score.el (gnus-score-string): Fix regex for matching extra
+ headers and regexp-quote the match if necessary.
+
+2009-03-24 Miles Bader <[email protected]>
+
+ * smiley.el (smiley-regexp-alist): Don't delete the semicolon before
+ the blinking smiley.
+
+2009-03-24 Simon Josefsson <[email protected]>
+
+ * smiley.el (smiley-regexp-alist): Disallow ;;) from being treated as a
+ blink smiley.
+
+2010-08-29 Lars Magne Ingebrigtsen <[email protected]>
+
+ * gnus-start.el (gnus-dribble-read-file): Ensure that the directory
+ where the dribbel file lives exists.
+
+ * message.el (message-send-mail-partially-limit): Change the default to
+ nil, since most people don't want this.
+
+ * mm-url.el (mm-url-decode-entities): Also decode entities like
+ &#x3212.
+
+2009-07-16 Kevin Ryde <[email protected]> (tiny change)
+
+ * gnus-sum.el (gnus-summary-idna-message):
+ * nnrss.el (nnrss-normalize-date, nnrss-discover-feed):
+ Hyperlink urls in docstrings with URL `...'.
+
+2010-08-29 Adam Sjøgren <[email protected]>
+
+ * gnus-html.el (gnus-html-put-image): Use XEmacs-compatible image
+ functions.
+
+2010-08-29 Lars Magne Ingebrigtsen <[email protected]>
+
+ * gnus-art.el (gnus-article-add-button): Take an optional parameter to
+ say what the mouseover text should be.
+
+ * gnus-html.el (gnus-html-prefetch-images): Use the summary-local
+ version of the mm-w3m-safe-url-regexp variable to only download images
+ in the groups where we want that to happen.
+
+ * gnus-sum.el (gnus-summary-stop-at-end-of-message): New variable.
+
+ * gnus-art.el (gnus-article-beginning-of-window): Make into defun for
+ easier debugging.
+ (gnus-article-beginning-of-window): Add kludge to allow spacing past
+ big pictures in the article buffer.
+
+ * mm-decode.el (mm-text-html-renderer): Default the html renderer to
+ gnus-article-html.
+ (mm-text-html-renderer): gnus-article-html needs curl in addition to
+ w3m.
+
+ * gnus-html.el: Start a new super-simple HTML renderer based on w3m.
+
+2010-08-28 Lars Magne Ingebrigtsen <[email protected]>
+
+ * gnus.el (gnus-valid-select-methods): Remove reference to nngoogle,
+ which doesn't exist.
+
+ * message.el (message-inhibit-ecomplete): New variable to allow some
+ function to inhibit ecomplete address storage.
+ (message-resend): Disable ecomplete message storage when resending
+ messages.
+
+ * nntp.el (nntp-async-kluge): Remove the Emacs 20.3-related kluge.
+
+2010-08-27 Katsumi Yamaoka <[email protected]>
+
+ * gnus-sum.el (gnus-summary-move-article, gnus-summary-delete-article):
+ Save excursion while copying, moving, and deleting articles in order to
+ prevent the cursor from jumping to unforeseen place.
+
+2010-08-17 Glenn Morris <[email protected]>
+
+ * gnus-sync.el: Require gnus components whose functions are used.
+
+ * gnus-art.el (bookmark-make-record-function):
+ * gnus-sum.el (bookmark-yank-point, bookmark-current-bookmark):
+ Declare for compiler.
+
+ * mm-url.el (mml-compute-boundary): Autoload.
+
+2010-08-15 Katsumi Yamaoka <[email protected]>
+
+ * gnus-start.el (gnus-start-draft-setup): Move doc string forward.
+
+2010-08-14 Teodor Zlatanov <[email protected]>
+
+ Typo fix "hoo4a" -> "hook".
+
+ * gnus-sync.el (gnus-sync-install-hooks): Typo fix.
+
+2010-08-14 Glenn Morris <[email protected]>
+
+ * gnus-sync.el (gnus-sync): Fix defgroup version.
+
+2010-08-13 Teodor Zlatanov <[email protected]>
+
+ Doc fixes and keep unknown groups (ammended for nunion bug fix).
+
+ * gnus-sync.el: Fix docs.
+ (gnus-sync-save): Keep unknown groups in `gnus-sync-newsrc-loader'.
+ (gnus-sync-read): Don't wipe `gnus-sync-newsrc-loader' after reading.
+
+2010-08-12 Teodor Zlatanov <[email protected]>
+
+ Optimizations for gnus-sync.el.
+
+ * gnus-sync.el: Add docs about gnus-sync-backend
+ possibilities.
+ (gnus-sync-save): Remove unnecessary message.
+ (gnus-sync-read): Optimize and show what groups were skipped.
+
+2010-08-12 Teodor Zlatanov <[email protected]>
+
+ Minor bug fixes for gnus-sync.el.
+
+ * gnus-sync.el (gnus-sync-unload-hook, gnus-sync-install-hooks): Don't
+ read the sync on get-new-news.
+
+ * gnus-sync.el (gnus-sync-save): Define `variable' so the compiler is
+ quiet.
+
+ * gnus-sync.el (gnus-sync-read): Use `gnus-sync-newsrc-offsets' (fix typo).
+
+2010-07-30 Lawrence Mitchell <[email protected]>
+
+ Make saving and restoring of hidden threads work with overlays.
+ Patch applied by Ted Zlatanov.
+
+ * gnus-sum.el (gnus-hidden-threads-configuration)
+ (gnus-restore-hidden-threads-configuration): Update to deal with text
+ properties, rather than searching for a magic character.
+
+2010-08-12 Teodor Zlatanov <[email protected]>
+
+ New gnus-sync.el library for synchronization of marks.
+
+ * gnus-sync.el: New library for synchronization of marks.
+
+ * gnus-util.el (gnus-grep-in-list): Moved from gnus-registry.el and
+ renamed from `gnus-registry-grep-in-list'.
+
+ * gnus-registry.el (gnus-registry-follow-group-p): Use `gnus-grep-in-list'.
+
+ * gnus-start.el (gnus-start-draft-setup): Make it interactive.
+
2010-08-06 Katsumi Yamaoka <[email protected]>
* rfc2047.el (rfc2047-encode): Use utf-8 as a last resort if
@@ -14447,5 +15097,3 @@ See ChangeLog.2 for earlier changes.
;; fill-column: 79
;; add-log-time-zone-rule: t
;; End:
-
-;;; arch-tag: 3f33a3e7-090d-492b-bedd-02a1417d32b4
diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el
index e43f09e5ed..5b44c0b993 100644
--- a/lisp/gnus/auth-source.el
+++ b/lisp/gnus/auth-source.el
@@ -465,5 +465,4 @@ MODE can be \"login\" or \"password\"."
(provide 'auth-source)
-;; arch-tag: ff1afe78-06e9-42c2-b693-e9f922cbe4ab
;;; auth-source.el ends here
diff --git a/lisp/gnus/canlock.el b/lisp/gnus/canlock.el
index 7f7f7694e0..4298bc901c 100644
--- a/lisp/gnus/canlock.el
+++ b/lisp/gnus/canlock.el
@@ -247,5 +247,4 @@ it fails."
(provide 'canlock)
-;; arch-tag: 033c4f09-b9f1-459d-bd0d-254430283f78
;;; canlock.el ends here
diff --git a/lisp/gnus/compface.el b/lisp/gnus/compface.el
index 371d3467ec..8c26341a6e 100644
--- a/lisp/gnus/compface.el
+++ b/lisp/gnus/compface.el
@@ -58,5 +58,4 @@ or `faces-xface' and `netpbm' or `libgr-progs', for instance."
(provide 'compface)
-;; arch-tag: f9c78e84-98c0-4142-9682-8ba4cf4c3441
;;; compface.el ends here
diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el
index d4b94a77e2..60f8c95bb2 100644
--- a/lisp/gnus/deuglify.el
+++ b/lisp/gnus/deuglify.el
@@ -476,5 +476,4 @@ NODISPLAY is non-nil, don't redisplay the article buffer."
;; coding: iso-8859-1
;; End:
-;; arch-tag: 5f895cc9-51a9-487c-b42e-28844d79eb73
;;; deuglify.el ends here
diff --git a/lisp/gnus/earcon.el b/lisp/gnus/earcon.el
index c2ec52e21c..2578abc073 100644
--- a/lisp/gnus/earcon.el
+++ b/lisp/gnus/earcon.el
@@ -229,5 +229,4 @@ If N is negative, move backward instead."
(run-hooks 'earcon-load-hook)
-;; arch-tag: 844dfeea-980c-4ed0-907f-a30bf139691c
;;; earcon.el ends here
diff --git a/lisp/gnus/ecomplete.el b/lisp/gnus/ecomplete.el
index 7952c37f39..1e9769f757 100644
--- a/lisp/gnus/ecomplete.el
+++ b/lisp/gnus/ecomplete.el
@@ -95,7 +95,7 @@
(let* ((elems (cdr (assq type ecomplete-database)))
(match (regexp-quote match))
(candidates
- (sort
+ (sort
(loop for (key count time text) in elems
when (string-match match text)
collect (list count time text))
@@ -156,5 +156,4 @@
(provide 'ecomplete)
-;; arch-tag: 34622935-bb81-4711-a600-57b89c2ece72
;;; ecomplete.el ends here
diff --git a/lisp/gnus/flow-fill.el b/lisp/gnus/flow-fill.el
index 69066de2c4..c4c64db7ed 100644
--- a/lisp/gnus/flow-fill.el
+++ b/lisp/gnus/flow-fill.el
@@ -221,5 +221,4 @@ RFC 2646 suggests 66 characters for readability."
(provide 'flow-fill)
-;; arch-tag: addc0040-bc53-4f17-b4bc-1eb44eed6f0b
;;; flow-fill.el ends here
diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el
index 640eb50a02..533d9a951b 100644
--- a/lisp/gnus/gmm-utils.el
+++ b/lisp/gnus/gmm-utils.el
@@ -433,5 +433,4 @@ coding-system."
(provide 'gmm-utils)
-;; arch-tag: e0b60920-2ce6-40c1-bfc0-cadbbe26b602
;;; gmm-utils.el ends here
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index edc4e0f3be..bbfdc66af9 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -184,7 +184,7 @@ When found, offer to remove them."
:type 'boolean
:group 'gnus-agent)
-(defcustom gnus-agent-auto-agentize-methods '(nntp nnimap)
+(defcustom gnus-agent-auto-agentize-methods '(nntp)
"Initially, all servers from these methods are agentized.
The user may remove or add servers using the Server buffer.
See Info node `(gnus)Server Buffer'."
@@ -1788,7 +1788,7 @@ and that there are no duplicates."
(while alist
(let ((entry (pop alist)))
(when (gnus-methods-equal-p gnus-command-method (gnus-info-method entry))
- (gnus-agent-flush-group (gnus-info-group entry)))))))
+ (gnus-agent-flush-group (gnus-info-group entry)))))))
(defun gnus-agent-flush-group (group)
"Flush the agent's index files such that the GROUP no longer
@@ -2108,13 +2108,15 @@ doesn't exist, to valid the overview buffer."
(defun gnus-agent-load-alist (group)
"Load the article-state alist for GROUP."
;; Bind free variable that's used in `gnus-agent-read-agentview'.
- (let ((gnus-agent-read-agentview group)
- (file-name-coding-system nnmail-pathname-coding-system))
- (setq gnus-agent-article-alist
- (gnus-cache-file-contents
- (gnus-agent-article-name ".agentview" group)
- 'gnus-agent-file-loading-cache
- 'gnus-agent-read-agentview))))
+ (let* ((gnus-agent-read-agentview group)
+ (file-name-coding-system nnmail-pathname-coding-system)
+ (agentview (gnus-agent-article-name ".agentview" group)))
+ (when (file-exists-p agentview)
+ (setq gnus-agent-article-alist
+ (gnus-cache-file-contents
+ agentview
+ 'gnus-agent-file-loading-cache
+ 'gnus-agent-read-agentview)))))
(defun gnus-agent-read-agentview (file)
"Load FILE and do a `read' there."
@@ -2162,13 +2164,13 @@ doesn't exist, to valid the overview buffer."
(gnus-agent-save-alist gnus-agent-read-agentview)))
alist))
((end-of-file file-error)
- ;; The agentview file is missing.
+ ;; The agentview file is missing.
(condition-case nil
;; If the agent directory exists, attempt to perform a brute-force
;; reconstruction of its contents.
(let* (alist
(file-name-coding-system nnmail-pathname-coding-system)
- (file-attributes (directory-files-and-attributes
+ (file-attributes (directory-files-and-attributes
(gnus-agent-article-name ""
gnus-agent-read-agentview) nil "^[0-9]+$" t)))
(while file-attributes
@@ -2230,23 +2232,28 @@ doesn't exist, to valid the overview buffer."
(gnus-agent-update-view-total-fetched-for group nil)))
(defvar gnus-agent-article-local nil)
+(defvar gnus-agent-article-local-times nil)
(defvar gnus-agent-file-loading-local nil)
(defun gnus-agent-load-local (&optional method)
"Load the METHOD'S local file. The local file contains min/max
article counts for each of the method's subscribed groups."
(let ((gnus-command-method (or method gnus-command-method)))
- (setq gnus-agent-article-local
- (gnus-cache-file-contents
- (gnus-agent-lib-file "local")
- 'gnus-agent-file-loading-local
- 'gnus-agent-read-and-cache-local))))
+ (when (or (null gnus-agent-article-local-times)
+ (zerop gnus-agent-article-local-times))
+ (setq gnus-agent-article-local
+ (gnus-cache-file-contents
+ (gnus-agent-lib-file "local")
+ 'gnus-agent-file-loading-local
+ 'gnus-agent-read-and-cache-local))
+ (when gnus-agent-article-local-times
+ (incf gnus-agent-article-local-times)))
+ gnus-agent-article-local))
(defun gnus-agent-read-and-cache-local (file)
"Load and read FILE then bind its contents to
gnus-agent-article-local. If that variable had `dirty' (also known as
modified) original contents, they are first saved to their own file."
-
(if (and gnus-agent-article-local
(symbol-value (intern "+dirty" gnus-agent-article-local)))
(gnus-agent-save-local))
@@ -2644,10 +2651,10 @@ General format specifiers can also be used. See Info node
(defvar gnus-agent-predicate 'false
"The selection predicate used when no other source is available.")
-(defvar gnus-agent-short-article 100
+(defvar gnus-agent-short-article 500
"Articles that have fewer lines than this are short.")
-(defvar gnus-agent-long-article 200
+(defvar gnus-agent-long-article 1000
"Articles that have more lines than this are long.")
(defvar gnus-agent-low-score 0
@@ -3258,7 +3265,7 @@ FORCE is equivalent to setting the expiration predicates to true."
(gnus-message 7 "gnus-agent-expire: Loading overview...")
(nnheader-insert-file-contents nov-file)
(goto-char (point-min))
-
+
(let (p)
(while (< (setq p (point)) (point-max))
(condition-case nil
@@ -4227,5 +4234,4 @@ modified."
(provide 'gnus-agent)
-;; arch-tag: b0ba4afc-5229-4cee-ad25-9956daa4e91e
;;; gnus-agent.el ends here
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 51be4517a7..bfdb9bd6b6 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -4414,6 +4414,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is
(gnus-run-hooks 'gnus-article-menu-hook)))
+(defvar bookmark-make-record-function)
+
(defun gnus-article-mode ()
"Major mode for displaying an article.
@@ -4821,6 +4823,22 @@ General format specifiers can also be used. See Info node
(vector (caddr c) (car c) :active t))
gnus-mime-button-commands)))
+(defvar gnus-url-button-commands
+ '((gnus-article-copy-string "u" "Copy URL to kill ring")))
+
+(defvar gnus-url-button-map
+ (let ((map (make-sparse-keymap)))
+ (dolist (c gnus-url-button-commands)
+ (define-key map (cadr c) (car c)))
+ map))
+
+(easy-menu-define
+ gnus-url-button-menu gnus-url-button-map "URL button menu."
+ `("Url Button"
+ ,@(mapcar (lambda (c)
+ (vector (caddr c) (car c) :active t))
+ gnus-url-button-commands)))
+
(defmacro gnus-bind-safe-url-regexp (&rest body)
"Bind `mm-w3m-safe-url-regexp' according to `gnus-safe-html-newsgroups'."
`(let ((mm-w3m-safe-url-regexp
@@ -5547,7 +5565,9 @@ N is the numerical prefix."
1))
(defun gnus-article-view-part (&optional n)
- "View MIME part N, which is the numerical prefix."
+ "View MIME part N, which is the numerical prefix.
+If the part is already shown, hide the part. If N is nil, view
+all parts."
(interactive "P")
(with-current-buffer gnus-article-buffer
(or (numberp n) (setq n (gnus-article-mime-match-handle-first
@@ -6281,18 +6301,22 @@ Argument LINES specifies lines to be scrolled up."
(gnus-article-next-page-1 lines)
nil))
-(defmacro gnus-article-beginning-of-window ()
+(defun gnus-article-beginning-of-window ()
"Move point to the beginning of the window.
In Emacs, the point is placed at the line number which `scroll-margin'
specifies."
(if (featurep 'xemacs)
- '(move-to-window-line 0)
- '(move-to-window-line
- (min (max 0 scroll-margin)
- (max 1 (- (window-height)
- (if mode-line-format 1 0)
- (if header-line-format 1 0)
- 2))))))
+ (move-to-window-line 0)
+ ;; There is an obscure bug in Emacs that makes it impossible to
+ ;; scroll past big pictures in the article buffer. Try to fix
+ ;; this by adding a sanity check by counting the lines visible.
+ (when (> (count-lines (window-start) (window-end)) 30)
+ (move-to-window-line
+ (min (max 0 scroll-margin)
+ (max 1 (- (window-height)
+ (if mode-line-format 1 0)
+ (if header-line-format 1 0)
+ 2)))))))
(defun gnus-article-next-page-1 (lines)
(unless (featurep 'xemacs)
@@ -7805,7 +7829,11 @@ specified by `gnus-button-alist'."
(unless (and (eq (car entry) 'gnus-button-url-regexp)
(gnus-article-extend-url-button from start end))
(gnus-article-add-button start end
- 'gnus-button-push from)))))))))
+ 'gnus-button-push from)
+ (gnus-put-text-property
+ start end
+ 'gnus-string (buffer-substring-no-properties
+ start end))))))))))
(defun gnus-article-extend-url-button (beg start end)
"Extend url button if url is folded into two or more lines.
@@ -7897,7 +7925,7 @@ url is put as the `gnus-button-url' overlay property on the button."
;;; External functions:
-(defun gnus-article-add-button (from to fun &optional data)
+(defun gnus-article-add-button (from to fun &optional data text)
"Create a button between FROM and TO with callback FUN and data DATA."
(when gnus-article-button-face
(gnus-overlay-put (gnus-make-overlay from to nil t)
@@ -7909,8 +7937,21 @@ url is put as the `gnus-button-url' overlay property on the button."
(list 'gnus-callback fun)
(and data (list 'gnus-data data))))
(widget-convert-button 'link from to :action 'gnus-widget-press-button
+ :help-echo (or text "Follow the link")
+ :keymap gnus-url-button-map
:button-keymap gnus-widget-button-keymap))
+(defun gnus-article-copy-string ()
+ "Copy the string in the button to the kill ring."
+ (interactive)
+ (gnus-article-check-buffer)
+ (let ((data (get-text-property (point) 'gnus-string)))
+ (when data
+ (with-temp-buffer
+ (insert data)
+ (copy-region-as-kill (point-min) (point-max))
+ (message "Copied %s" data)))))
+
;;; Internal functions:
(defun gnus-article-set-globals ()
@@ -8723,5 +8764,4 @@ For example:
(run-hooks 'gnus-art-load-hook)
-;; arch-tag: 2654516f-6279-48f9-a83b-05c1fa450c33
;;; gnus-art.el ends here
diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el
index 432990e3c2..979e67120d 100644
--- a/lisp/gnus/gnus-async.el
+++ b/lisp/gnus/gnus-async.el
@@ -71,6 +71,13 @@ It should return non-nil if the article is to be prefetched."
:group 'gnus-asynchronous
:type 'function)
+(defcustom gnus-async-post-fetch-function nil
+ "Function called after an article has been prefetched.
+The function will be called narrowed to the region of the article
+that was fetched."
+ :group 'gnus-asynchronous
+ :type 'function)
+
;;; Internal variables.
(defvar gnus-async-prefetch-article-buffer " *Async Prefetch Article*")
@@ -221,12 +228,23 @@ It should return non-nil if the article is to be prefetched."
`(lambda (arg)
(gnus-async-article-callback arg ,group ,article ,mark ,summary ,next)))
+(eval-when-compile
+ (autoload 'gnus-html-prefetch-images "gnus-html"))
+
(defun gnus-async-article-callback (arg group article mark summary next)
"Function called when an async article is done being fetched."
(save-excursion
(setq gnus-async-current-prefetch-article nil)
(when arg
(gnus-async-set-buffer)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region mark (point-max))
+ ;; Prefetch images for the groups that want that.
+ (when (fboundp 'gnus-html-prefetch-images)
+ (gnus-html-prefetch-images summary))
+ (when gnus-async-post-fetch-function
+ (funcall gnus-async-post-fetch-function summary))))
(gnus-async-with-semaphore
(setq
gnus-async-article-alist
@@ -372,5 +390,4 @@ It should return non-nil if the article is to be prefetched."
(provide 'gnus-async)
-;; arch-tag: fee61de5-3ea2-4de6-8578-2f90ce89391d
;;; gnus-async.el ends here
diff --git a/lisp/gnus/gnus-audio.el b/lisp/gnus/gnus-audio.el
index a3ba977664..c89faef702 100644
--- a/lisp/gnus/gnus-audio.el
+++ b/lisp/gnus/gnus-audio.el
@@ -146,5 +146,4 @@
(run-hooks 'gnus-audio-load-hook)
-;; arch-tag: 6f129e78-3416-4fc9-973f-6cf5ac8d654b
;;; gnus-audio.el ends here
diff --git a/lisp/gnus/gnus-bcklg.el b/lisp/gnus/gnus-bcklg.el
index f490d8a37d..b385185851 100644
--- a/lisp/gnus/gnus-bcklg.el
+++ b/lisp/gnus/gnus-bcklg.el
@@ -159,5 +159,4 @@
(provide 'gnus-bcklg)
-;; arch-tag: 66259e56-505a-4bba-8a0d-3552c5b94e39
;;; gnus-bcklg.el ends here
diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el
index a85c1af44b..aa3e2d70df 100644
--- a/lisp/gnus/gnus-bookmark.el
+++ b/lisp/gnus/gnus-bookmark.el
@@ -828,5 +828,4 @@ probably because we were called from there."
(provide 'gnus-bookmark)
-;; arch-tag: 779df694-366f-46e8-84b2-1d0340e6f525
;;; gnus-bookmark.el ends here
diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el
index 113233c1d3..e3f33be881 100644
--- a/lisp/gnus/gnus-cache.el
+++ b/lisp/gnus/gnus-cache.el
@@ -868,7 +868,7 @@ supported."
(while (setq file (pop files))
(setq attrs (file-attributes file))
(unless (nth 0 attrs)
- (incf size (float (nth 7 attrs)))))))
+ (incf size (float (nth 7 attrs)))))))
(setq gnus-cache-need-update-total-fetched-for t)
@@ -879,10 +879,10 @@ supported."
(gnus-cache-with-refreshed-group
group
(let* ((entry (or (gnus-gethash group gnus-cache-total-fetched-hashtb)
- (gnus-sethash group (make-list 2 0)
+ (gnus-sethash group (make-list 2 0)
gnus-cache-total-fetched-hashtb)))
(file-name-coding-system nnmail-pathname-coding-system)
- (size (or (nth 7 (file-attributes
+ (size (or (nth 7 (file-attributes
(or file
(gnus-cache-file-name group ".overview"))))
0)))
@@ -911,11 +911,10 @@ supported."
(if entry
(apply '+ entry)
(let ((gnus-cache-inhibit-update-total-fetched-for (not no-inhibit)))
- (+
+ (+
(gnus-cache-update-overview-total-fetched-for group nil)
(gnus-cache-update-file-total-fetched-for group nil)))))))
(provide 'gnus-cache)
-;; arch-tag: 05a79442-8c58-4e65-bd0a-3cbb1b89a33a
;;; gnus-cache.el ends here
diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el
index adec9cfd72..7419cedac5 100644
--- a/lisp/gnus/gnus-cite.el
+++ b/lisp/gnus/gnus-cite.el
@@ -407,9 +407,7 @@ lines matches `message-cite-prefix-regexp' with the same prefix.
Lines matching `gnus-cite-attribution-suffix' and perhaps
`gnus-cite-attribution-prefix' are considered attribution lines."
(interactive (list 'force))
- (save-excursion
- (unless same-buffer
- (set-buffer gnus-article-buffer))
+ (with-current-buffer (if same-buffer (current-buffer) gnus-article-buffer)
(gnus-cite-parse-maybe force)
(let ((buffer-read-only nil)
(alist gnus-cite-prefix-alist)
@@ -462,8 +460,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps
(defun gnus-dissect-cited-text ()
"Dissect the article buffer looking for cited text."
- (save-excursion
- (set-buffer gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
(gnus-cite-parse-maybe nil t)
(let ((alist gnus-cite-prefix-alist)
prefix numbers number marks m)
@@ -523,8 +520,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps
"Do word wrapping in the current article.
If WIDTH (the numerical prefix), use that text width when filling."
(interactive (list t current-prefix-arg))
- (save-excursion
- (set-buffer gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
(let ((buffer-read-only nil)
(inhibit-point-motion-hooks t)
(marks (gnus-dissect-cited-text))
@@ -552,6 +548,24 @@ If WIDTH (the numerical prefix), use that text width when filling."
gnus-cite-loose-attribution-alist nil
gnus-cite-article nil)))))
+(defun gnus-article-natural-long-line-p ()
+ "Return true if the current line is long, and it's natural text."
+ (save-excursion
+ (beginning-of-line)
+ (and
+ ;; The line is long.
+ (> (- (line-end-position) (line-beginning-position))
+ (frame-width))
+ ;; It doesn't start with spaces.
+ (not (looking-at " "))
+ ;; Not cited text.
+ (let ((line-number (1+ (count-lines (point-min) (point))))
+ citep)
+ (dolist (elem gnus-cite-prefix-alist)
+ (when (member line-number (cdr elem))
+ (setq citep t)))
+ (not citep)))))
+
(defun gnus-article-hide-citation (&optional arg force)
"Toggle hiding of all cited text except attribution lines.
See the documentation for `gnus-article-highlight-citation'.
@@ -560,67 +574,66 @@ always hide."
(interactive (append (gnus-article-hidden-arg) (list 'force)))
(gnus-set-format 'cited-opened-text-button t)
(gnus-set-format 'cited-closed-text-button t)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (let ((buffer-read-only nil)
- marks
- (inhibit-point-motion-hooks t)
- (props (nconc (list 'article-type 'cite)
- gnus-hidden-properties))
- (point (point-min))
- found beg end start)
- (while (setq point
- (text-property-any point (point-max)
- 'gnus-callback
- 'gnus-article-toggle-cited-text))
- (setq found t)
- (goto-char point)
- (gnus-article-toggle-cited-text
- (get-text-property point 'gnus-data) arg)
- (forward-line 1)
- (setq point (point)))
- (unless found
- (setq marks (gnus-dissect-cited-text))
- (while marks
- (setq beg nil
- end nil)
- (while (and marks (string= (cdar marks) ""))
- (setq marks (cdr marks)))
- (when marks
- (setq beg (caar marks)))
- (while (and marks (not (string= (cdar marks) "")))
- (setq marks (cdr marks)))
- (when marks
+ (with-current-buffer gnus-article-buffer
+ (let ((buffer-read-only nil)
+ marks
+ (inhibit-point-motion-hooks t)
+ (props (nconc (list 'article-type 'cite)
+ gnus-hidden-properties))
+ (point (point-min))
+ found beg end start)
+ (while (setq point
+ (text-property-any point (point-max)
+ 'gnus-callback
+ 'gnus-article-toggle-cited-text))
+ (setq found t)
+ (goto-char point)
+ (gnus-article-toggle-cited-text
+ (get-text-property point 'gnus-data) arg)
+ (forward-line 1)
+ (setq point (point)))
+ (unless found
+ (setq marks (gnus-dissect-cited-text))
+ (while marks
+ (setq beg nil
+ end nil)
+ (while (and marks (string= (cdar marks) ""))
+ (setq marks (cdr marks)))
+ (when marks
+ (setq beg (caar marks)))
+ (while (and marks (not (string= (cdar marks) "")))
+ (setq marks (cdr marks)))
+ (when marks
(setq end (caar marks)))
- ;; Skip past lines we want to leave visible.
- (when (and beg end gnus-cited-lines-visible)
- (goto-char beg)
- (forward-line (if (consp gnus-cited-lines-visible)
- (car gnus-cited-lines-visible)
- gnus-cited-lines-visible))
- (if (>= (point) end)
- (setq beg nil)
- (setq beg (point-marker))
- (when (consp gnus-cited-lines-visible)
- (goto-char end)
- (forward-line (- (cdr gnus-cited-lines-visible)))
- (if (<= (point) beg)
- (setq beg nil)
+ ;; Skip past lines we want to leave visible.
+ (when (and beg end gnus-cited-lines-visible)
+ (goto-char beg)
+ (forward-line (if (consp gnus-cited-lines-visible)
+ (car gnus-cited-lines-visible)
+ gnus-cited-lines-visible))
+ (if (>= (point) end)
+ (setq beg nil)
+ (setq beg (point-marker))
+ (when (consp gnus-cited-lines-visible)
+ (goto-char end)
+ (forward-line (- (cdr gnus-cited-lines-visible)))
+ (if (<= (point) beg)
+ (setq beg nil)
(setq end (point-marker))))))
- (when (and beg end)
- (gnus-add-wash-type 'cite)
- ;; We use markers for the end-points to facilitate later
- ;; wrapping and mangling of text.
- (setq beg (set-marker (make-marker) beg)
- end (set-marker (make-marker) end))
- (gnus-add-text-properties-when 'article-type nil beg end props)
- (goto-char beg)
- (when (and gnus-cite-blank-line-after-header
- (not (save-excursion (search-backward "\n\n" nil t))))
- (insert "\n"))
- (put-text-property
- (setq start (point-marker))
- (progn
+ (when (and beg end)
+ (gnus-add-wash-type 'cite)
+ ;; We use markers for the end-points to facilitate later
+ ;; wrapping and mangling of text.
+ (setq beg (set-marker (make-marker) beg)
+ end (set-marker (make-marker) end))
+ (gnus-add-text-properties-when 'article-type nil beg end props)
+ (goto-char beg)
+ (when (and gnus-cite-blank-line-after-header
+ (not (save-excursion (search-backward "\n\n" nil t))))
+ (insert "\n"))
+ (put-text-property
+ (setq start (point-marker))
+ (progn
(gnus-article-add-button
(point)
(progn (eval gnus-cited-closed-text-button-line-format-spec)
@@ -628,8 +641,8 @@ always hide."
`gnus-article-toggle-cited-text
(list (cons beg end) start))
(point))
- 'article-type 'annotation)
- (set-marker beg (point))))))))
+ 'article-type 'annotation)
+ (set-marker beg (point))))))))
(defun gnus-article-toggle-cited-text (args &optional arg)
"Toggle hiding the text in REGION.
@@ -732,11 +745,9 @@ See also the documentation for `gnus-article-highlight-citation'."
(defun gnus-article-hide-citation-in-followups ()
"Hide cited text in non-root articles."
(interactive)
- (save-excursion
- (set-buffer gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
(let ((article (cdr gnus-article-current)))
- (unless (save-excursion
- (set-buffer gnus-summary-buffer)
+ (unless (with-current-buffer gnus-summary-buffer
(gnus-article-displayed-root-p article))
(gnus-article-hide-citation)))))
@@ -1079,8 +1090,7 @@ See also the documentation for `gnus-article-highlight-citation'."
(gnus-overlay-put overlay 'face face))))))
(defun gnus-cite-toggle (prefix)
- (save-excursion
- (set-buffer gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
(gnus-cite-parse-maybe nil t)
(let ((buffer-read-only nil)
(numbers (cdr (assoc prefix gnus-cite-prefix-alist)))
@@ -1248,5 +1258,4 @@ is turned on."
;; coding: iso-8859-1
;; End:
-;; arch-tag: 1997b044-6067-471e-8c8f-dc903093098a
;;; gnus-cite.el ends here
diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el
index eb0dc51936..89b893090b 100644
--- a/lisp/gnus/gnus-cus.el
+++ b/lisp/gnus/gnus-cus.el
@@ -1118,5 +1118,4 @@ articles in the thread.
(provide 'gnus-cus)
-;; arch-tag: a37c285a-49bc-4235-8244-804536effeaf
;;; gnus-cus.el ends here
diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el
index e9d1a13106..05bbaf5346 100644
--- a/lisp/gnus/gnus-delay.el
+++ b/lisp/gnus/gnus-delay.el
@@ -192,5 +192,4 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil."
;; coding: iso-8859-1
;; End:
-;; arch-tag: fb2ad634-a897-4142-a503-f5991ec2349d
;;; gnus-delay.el ends here
diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el
index 74aebf73b1..caf9f8784b 100644
--- a/lisp/gnus/gnus-demon.el
+++ b/lisp/gnus/gnus-demon.el
@@ -319,5 +319,4 @@ minutes, the connection is closed."
(provide 'gnus-demon)
-;; arch-tag: 8dd5cd3d-6ae4-46b4-9b15-f5fca09fd392
;;; gnus-demon.el ends here
diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el
index 8bd4cfde3f..18130bbb0f 100644
--- a/lisp/gnus/gnus-diary.el
+++ b/lisp/gnus/gnus-diary.el
@@ -401,5 +401,4 @@ If ARG (or prefix) is non-nil, force prompting for all fields."
(provide 'gnus-diary)
-;; arch-tag: 98467e70-337e-4ddc-b92d-45d403ff1b4b
;;; gnus-diary.el ends here
diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el
index e5c886d867..f9502b43c0 100644
--- a/lisp/gnus/gnus-dired.el
+++ b/lisp/gnus/gnus-dired.el
@@ -204,7 +204,7 @@ If ARG is non-nil, open it in a new buffer."
(setq method
(cdr (assoc 'viewer
(car (mailcap-mime-info mime-type
- 'all
+ 'all
'no-decode)))))))
(let ((view-command (mm-mailcap-command method file-name nil)))
(message "viewing via %s" view-command)
@@ -261,5 +261,4 @@ file to save in."
(provide 'gnus-dired)
-;; arch-tag: 44737731-e445-4638-a31e-713c7590ec76
;;; gnus-dired.el ends here
diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el
index c04ea13b3a..d53873045f 100644
--- a/lisp/gnus/gnus-draft.el
+++ b/lisp/gnus/gnus-draft.el
@@ -325,5 +325,4 @@ Obeys the standard process/prefix convention."
(provide 'gnus-draft)
-;; arch-tag: 3d92af58-8c97-4a5c-9db4-a98e85198022
;;; gnus-draft.el ends here
diff --git a/lisp/gnus/gnus-dup.el b/lisp/gnus/gnus-dup.el
index 71f6a39d7d..be909ccd79 100644
--- a/lisp/gnus/gnus-dup.el
+++ b/lisp/gnus/gnus-dup.el
@@ -159,5 +159,4 @@ seen in the same session."
(provide 'gnus-dup)
-;; arch-tag: 903e94db-7b00-4d19-83ee-cf34a81fa5fb
;;; gnus-dup.el ends here
diff --git a/lisp/gnus/gnus-eform.el b/lisp/gnus/gnus-eform.el
index c8f43aed79..96b645686e 100644
--- a/lisp/gnus/gnus-eform.el
+++ b/lisp/gnus/gnus-eform.el
@@ -130,5 +130,4 @@ The optional LAYOUT overrides the `edit-form' window layout."
(provide 'gnus-eform)
-;; arch-tag: ef50678c-2c28-49ef-affc-e53b3b2c0bf6
;;; gnus-eform.el ends here
diff --git a/lisp/gnus/gnus-ems.el b/lisp/gnus/gnus-ems.el
index efa74146a9..7bc59bf1b6 100644
--- a/lisp/gnus/gnus-ems.el
+++ b/lisp/gnus/gnus-ems.el
@@ -276,7 +276,7 @@
(defun gnus-put-image (glyph &optional string category)
(let ((point (point)))
- (insert-image glyph (or string " "))
+ (insert-image glyph (or string "*"))
(put-text-property point (point) 'gnus-image-category category)
(unless string
(put-text-property (1- (point)) (point)
@@ -305,7 +305,47 @@
(setq start end
end nil))))))
+(eval-and-compile
+ (if (fboundp 'set-process-plist)
+ (progn
+ (defalias 'gnus-set-process-plist 'set-process-plist)
+ (defalias 'gnus-process-plist 'process-plist)
+ (defalias 'gnus-process-get 'process-get)
+ (defalias 'gnus-process-put 'process-put))
+ (defun gnus-set-process-plist (process plist)
+ "Replace the plist of PROCESS with PLIST. Returns PLIST."
+ (put 'gnus-process-plist-internal process plist))
+
+ (defun gnus-process-plist (process)
+ "Return the plist of PROCESS."
+ ;; This form works but can't prevent the plist data from
+ ;; growing infinitely.
+ ;;(get 'gnus-process-plist-internal process)
+ (let* ((plist (symbol-plist 'gnus-process-plist-internal))
+ (tem (memq process plist)))
+ (prog1
+ (cadr tem)
+ ;; Remove it from the plist data.
+ (when tem
+ (if (eq plist tem)
+ (progn
+ (setcar plist (caddr plist))
+ (setcdr plist (or (cdddr plist) '(nil))))
+ (setcdr (nthcdr (- (length plist) (length tem) 1) plist)
+ (cddr tem)))))))
+
+ (defun gnus-process-get (process propname)
+ "Return the value of PROCESS' PROPNAME property.
+This is the last value stored with `(gnus-process-put PROCESS PROPNAME VALUE)'."
+ (plist-get (gnus-process-plist process) propname))
+
+ (defun gnus-process-put (process propname value)
+ "Change PROCESS' PROPNAME property to VALUE.
+It can be retrieved with `(gnus-process-get PROCESS PROPNAME)'."
+ (gnus-set-process-plist process
+ (plist-put (gnus-process-plist process)
+ propname value)))))
+
(provide 'gnus-ems)
-;; arch-tag: e7360b45-14b5-4171-aa39-69a44aed3cdb
;;; gnus-ems.el ends here
diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el
index 5ca707c5a3..bc1ebd4a85 100644
--- a/lisp/gnus/gnus-fun.el
+++ b/lisp/gnus/gnus-fun.el
@@ -290,5 +290,4 @@ colors of the displayed X-Faces."
(provide 'gnus-fun)
-;; arch-tag: 9d000a69-15cc-4491-9dc0-4627484f50c1
;;; gnus-fun.el ends here
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 7a887735fe..5cc4ef68bd 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -169,7 +169,7 @@ list."
(function-item gnus-group-sort-by-rank)
(function :tag "other" nil))))
-(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)%O\n"
+(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)\n"
"*Format of group lines.
It works along the same lines as a normal formatting string,
with some simple extensions.
@@ -660,7 +660,6 @@ simple manner.")
"h" gnus-group-make-help-group
"u" gnus-group-make-useful-group
"a" gnus-group-make-archive-group
- "k" gnus-group-make-kiboze-group
"l" gnus-group-nnimap-edit-acl
"m" gnus-group-make-group
"E" gnus-group-edit-group
@@ -680,13 +679,6 @@ simple manner.")
"\177" gnus-group-delete-group
[delete] gnus-group-delete-group)
-(gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map)
- "b" gnus-group-brew-soup
- "w" gnus-soup-save-areas
- "s" gnus-soup-send-replies
- "p" gnus-soup-pack-packet
- "r" nnsoup-pack-replies)
-
(gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
"s" gnus-group-sort-groups
"a" gnus-group-sort-groups-by-alphabet
@@ -938,7 +930,6 @@ simple manner.")
["Add the archive group" gnus-group-make-archive-group t]
["Make a doc group..." gnus-group-make-doc-group t]
["Make a web group..." gnus-group-make-web-group t]
- ["Make a kiboze group..." gnus-group-make-kiboze-group t]
["Make a virtual group..." gnus-group-make-empty-virtual t]
["Add a group to a virtual..." gnus-group-add-to-virtual t]
["Make an ephemeral group..." gnus-group-read-ephemeral-group t]
@@ -972,13 +963,6 @@ simple manner.")
(easy-menu-define
gnus-group-misc-menu gnus-group-mode-map ""
`("Gnus"
- ("SOUP"
- ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)]
- ["Send replies" gnus-soup-send-replies
- (fboundp 'gnus-soup-pack-packet)]
- ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)]
- ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)]
- ["Brew SOUP" gnus-group-brew-soup (fboundp 'gnus-soup-pack-packet)])
["Send a mail" gnus-group-mail t]
["Send a message (mail or news)" gnus-group-post-news t]
["Create a local message" gnus-group-news t]
@@ -996,7 +980,6 @@ simple manner.")
["Browse foreign server..." gnus-group-browse-foreign-server t]
["Enter server buffer" gnus-group-enter-server-mode t]
["Expire all expirable articles" gnus-group-expire-all-groups t]
- ["Generate any kiboze groups" nnkiboze-generate-groups t]
["Gnus version" gnus-version t]
["Save .newsrc files" gnus-group-save-newsrc t]
["Suspend Gnus" gnus-group-suspend t]
@@ -1705,72 +1688,66 @@ if it is a string, only list groups matching REGEXP."
"Update all lines where GROUP appear.
If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
already."
- ;; Can't use `save-excursion' here, so we do it manually.
- (let ((buf (current-buffer))
- mark)
- (set-buffer gnus-group-buffer)
- (setq mark (point-marker))
- ;; The buffer may be narrowed.
- (save-restriction
- (widen)
- (let ((ident (gnus-intern-safe group gnus-active-hashtb))
- (loc (point-min))
- found buffer-read-only)
- ;; Enter the current status into the dribble buffer.
- (let ((entry (gnus-group-entry group)))
- (when (and entry
- (not (gnus-ephemeral-group-p group)))
- (gnus-dribble-enter
- (concat "(gnus-group-set-info '"
- (gnus-prin1-to-string (nth 2 entry))
- ")"))))
- ;; Find all group instances. If topics are in use, each group
- ;; may be listed in more than once.
- (while (setq loc (text-property-any
- loc (point-max) 'gnus-group ident))
- (setq found t)
- (goto-char loc)
- (let ((gnus-group-indentation (gnus-group-group-indentation)))
- (gnus-delete-line)
- (gnus-group-insert-group-line-info group)
- (save-excursion
- (forward-line -1)
- (gnus-run-hooks 'gnus-group-update-group-hook)))
- (setq loc (1+ loc)))
- (unless (or found visible-only)
- ;; No such line in the buffer, find out where it's supposed to
- ;; go, and insert it there (or at the end of the buffer).
- (if gnus-goto-missing-group-function
- (funcall gnus-goto-missing-group-function group)
- (let ((entry (cddr (gnus-group-entry group))))
- (while (and entry (car entry)
- (not
- (gnus-goto-char
- (text-property-any
- (point-min) (point-max)
- 'gnus-group (gnus-intern-safe
- (caar entry) gnus-active-hashtb)))))
- (setq entry (cdr entry)))
- (or entry (goto-char (point-max)))))
- ;; Finally insert the line.
- (let ((gnus-group-indentation (gnus-group-group-indentation)))
- (gnus-group-insert-group-line-info group)
- (save-excursion
- (forward-line -1)
- (gnus-run-hooks 'gnus-group-update-group-hook))))
- (when gnus-group-update-group-function
- (funcall gnus-group-update-group-function group))
- (gnus-group-set-mode-line)))
- (goto-char mark)
- (set-marker mark nil)
- (set-buffer buf)))
+ (with-current-buffer gnus-group-buffer
+ (save-excursion
+ ;; The buffer may be narrowed.
+ (save-restriction
+ (widen)
+ (let ((ident (gnus-intern-safe group gnus-active-hashtb))
+ (loc (point-min))
+ found buffer-read-only)
+ ;; Enter the current status into the dribble buffer.
+ (let ((entry (gnus-group-entry group)))
+ (when (and entry
+ (not (gnus-ephemeral-group-p group)))
+ (gnus-dribble-enter
+ (concat "(gnus-group-set-info '"
+ (gnus-prin1-to-string (nth 2 entry))
+ ")"))))
+ ;; Find all group instances. If topics are in use, each group
+ ;; may be listed in more than once.
+ (while (setq loc (text-property-any
+ loc (point-max) 'gnus-group ident))
+ (setq found t)
+ (goto-char loc)
+ (let ((gnus-group-indentation (gnus-group-group-indentation)))
+ (gnus-delete-line)
+ (gnus-group-insert-group-line-info group)
+ (save-excursion
+ (forward-line -1)
+ (gnus-run-hooks 'gnus-group-update-group-hook)))
+ (setq loc (1+ loc)))
+ (unless (or found visible-only)
+ ;; No such line in the buffer, find out where it's supposed to
+ ;; go, and insert it there (or at the end of the buffer).
+ (if gnus-goto-missing-group-function
+ (funcall gnus-goto-missing-group-function group)
+ (let ((entry (cddr (gnus-group-entry group))))
+ (while (and entry (car entry)
+ (not
+ (gnus-goto-char
+ (text-property-any
+ (point-min) (point-max)
+ 'gnus-group (gnus-intern-safe
+ (caar entry)
+ gnus-active-hashtb)))))
+ (setq entry (cdr entry)))
+ (or entry (goto-char (point-max)))))
+ ;; Finally insert the line.
+ (let ((gnus-group-indentation (gnus-group-group-indentation)))
+ (gnus-group-insert-group-line-info group)
+ (save-excursion
+ (forward-line -1)
+ (gnus-run-hooks 'gnus-group-update-group-hook))))
+ (when gnus-group-update-group-function
+ (funcall gnus-group-update-group-function group))
+ (gnus-group-set-mode-line))))))
(defun gnus-group-set-mode-line ()
"Update the mode line in the group buffer."
(when (memq 'group gnus-updated-mode-lines)
;; Yes, we want to keep this mode line updated.
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(let* ((gformat (or gnus-group-mode-line-format-spec
(gnus-set-format 'group-mode)))
(gnus-tmp-news-server (cadr gnus-select-method))
@@ -1783,8 +1760,7 @@ already."
(and gnus-dribble-buffer
(buffer-name gnus-dribble-buffer)
(buffer-modified-p gnus-dribble-buffer)
- (save-excursion
- (set-buffer gnus-dribble-buffer)
+ (with-current-buffer gnus-dribble-buffer
(not (zerop (buffer-size))))))
(mode-string (eval gformat)))
;; Say whether the dribble buffer has been modified.
@@ -2202,7 +2178,10 @@ be permanent."
The arguments are the same as `completing-read' except that COLLECTION
and HIST default to `gnus-active-hashtb' and `gnus-group-history'
respectively if they are omitted."
- (let (group)
+ (let ((completion-styles (and (boundp 'completion-styles)
+ completion-styles))
+ group)
+ (push 'substring completion-styles)
(mapatoms (lambda (symbol)
(setq group (symbol-name symbol))
(set (intern (if (string-match "[^\000-\177]" group)
@@ -3094,42 +3073,6 @@ If there is, use Gnus to create an nnrss group"
(nnrss-save-server-data nil))
(error "No feeds found for %s" url))))
-(defvar nnwarchive-type-definition)
-(defvar gnus-group-warchive-type-history nil)
-(defvar gnus-group-warchive-login-history nil)
-(defvar gnus-group-warchive-address-history nil)
-
-(defun gnus-group-make-warchive-group ()
- "Create a nnwarchive group."
- (interactive)
- (require 'nnwarchive)
- (let* ((group (gnus-read-group "Group name: "))
- (default-type (or (car gnus-group-warchive-type-history)
- (symbol-name (caar nnwarchive-type-definition))))
- (type
- (gnus-string-or
- (completing-read
- (format "Warchive type (default %s): " default-type)
- (mapcar (lambda (elem) (list (symbol-name (car elem))))
- nnwarchive-type-definition)
- nil t nil 'gnus-group-warchive-type-history)
- default-type))
- (address (read-string "Warchive address: "
- nil 'gnus-group-warchive-address-history))
- (default-login (or (car gnus-group-warchive-login-history)
- user-mail-address))
- (login
- (gnus-string-or
- (read-string
- (format "Warchive login (default %s): " user-mail-address)
- default-login 'gnus-group-warchive-login-history)
- user-mail-address))
- (method
- `(nnwarchive ,address
- (nnwarchive-type ,(intern type))
- (nnwarchive-login ,login))))
- (gnus-group-make-group group method)))
-
(defun gnus-group-make-archive-group (&optional all)
"Create the (ding) Gnus archive group of the most recent articles.
Given a prefix, create a full group."
@@ -3170,41 +3113,6 @@ mail messages or news articles in files that have numeric names."
(gnus-group-real-name group)
(list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir)))))
-(defvar nnkiboze-score-file)
-(declare-function nnkiboze-score-file "nnkiboze" (group))
-
-(defun gnus-group-make-kiboze-group (group address scores)
- "Create an nnkiboze group.
-The user will be prompted for a name, a regexp to match groups, and
-score file entries for articles to include in the group."
- (interactive
- (list
- (read-string "nnkiboze group name: ")
- (read-string "Source groups (regexp): ")
- (let ((headers (mapcar 'list
- '("subject" "from" "number" "date" "message-id"
- "references" "chars" "lines" "xref"
- "followup" "all" "body" "head")))
- scores header regexp regexps)
- (while (not (equal "" (setq header (completing-read
- "Match on header: " headers nil t))))
- (setq regexps nil)
- (while (not (equal "" (setq regexp (read-string
- (format "Match on %s (regexp): "
- header)))))
- (push (list regexp nil nil 'r) regexps))
- (push (cons header regexps) scores))
- scores)))
- (gnus-group-make-group group "nnkiboze" address)
- (let* ((nnkiboze-current-group group)
- (score-file (car (nnkiboze-score-file "")))
- (score-dir (file-name-directory score-file)))
- (unless (file-exists-p score-dir)
- (make-directory score-dir))
- (with-temp-file score-file
- (let (emacs-lisp-mode-hook)
- (gnus-pp scores)))))
-
(defun gnus-group-add-to-virtual (n vgroup)
"Add the current group to a virtual group."
(interactive
@@ -4074,23 +3982,13 @@ re-scanning. If ARG is non-nil and not a number, this will force
(>= arg gnus-use-nocem))
(not arg)))
(gnus-nocem-scan-groups))
- ;; If ARG is not a number, then we read the active file.
- (when (and arg (not (numberp arg)))
- (let ((gnus-read-active-file t))
- (gnus-read-active-file))
- (setq arg nil)
-
- ;; If the user wants it, we scan for new groups.
- (when (eq gnus-check-new-newsgroups 'always)
- (gnus-find-new-newsgroups)))
-
- (setq arg (gnus-group-default-level arg t))
- (if (and gnus-read-active-file (not arg))
- (progn
- (gnus-read-active-file)
- (gnus-get-unread-articles arg))
- (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
- (gnus-get-unread-articles arg)))
+
+ (gnus-get-unread-articles arg)
+
+ ;; If the user wants it, we scan for new groups.
+ (when (eq gnus-check-new-newsgroups 'always)
+ (gnus-find-new-newsgroups))
+
(gnus-check-reasonable-setup)
(gnus-run-hooks 'gnus-after-getting-new-news-hook)
(gnus-group-list-groups (and (numberp arg)
@@ -4480,8 +4378,7 @@ The hook `gnus-exit-gnus-hook' is called before actually exiting."
(gnus-run-hooks 'gnus-exit-gnus-hook)
(gnus-configure-windows 'group t)
(when (and (gnus-buffer-live-p gnus-dribble-buffer)
- (not (zerop (save-excursion
- (set-buffer gnus-dribble-buffer)
+ (not (zerop (with-current-buffer gnus-dribble-buffer
(buffer-size)))))
(gnus-dribble-enter
";;; Gnus was exited on purpose without saving the .newsrc files."))
@@ -4542,13 +4439,11 @@ and the second element is the address."
(setcar (nthcdr (1- total) info) part-info)))
(unless entry
;; This is a new group, so we just create it.
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(setq method (gnus-info-method info))
(when (gnus-server-equal method "native")
(setq method nil))
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(if method
;; It's a foreign group...
(gnus-group-make-group
@@ -4612,8 +4507,7 @@ and the second element is the address."
"Mark ARTICLE in GROUP with MARK, whether the group is displayed or not."
(let ((buffer (gnus-summary-buffer-name group)))
(if (gnus-buffer-live-p buffer)
- (save-excursion
- (set-buffer (get-buffer buffer))
+ (with-current-buffer (get-buffer buffer)
(gnus-summary-add-mark article mark))
(gnus-add-marked-articles group (cdr (assq mark gnus-article-mark-lists))
(list article)))))
@@ -4813,5 +4707,4 @@ Compacting group %s... (this may take a long time)"
(provide 'gnus-group)
-;; arch-tag: 2eb5440f-0bca-4091-814c-e37817536af6
;;; gnus-group.el ends here
diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el
new file mode 100644
index 0000000000..8bfbaaa527
--- /dev/null
+++ b/lisp/gnus/gnus-html.el
@@ -0,0 +1,466 @@
+;;; gnus-html.el --- Render HTML in a buffer.
+
+;; Copyright (C) 2010 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <[email protected]>
+;; Keywords: html, web
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; The idea is to provide a simple, fast and pretty minimal way to
+;; render HTML (including links and images) in a buffer, based on an
+;; external HTML renderer (i.e., w3m).
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'mm-decode))
+(require 'mm-url)
+
+(defcustom gnus-html-cache-directory (nnheader-concat gnus-directory "html-cache/")
+ "Where Gnus will cache images it downloads from the web."
+ :version "24.1"
+ :group 'gnus-art
+ :type 'directory)
+
+(defcustom gnus-html-cache-size 500000000
+ "The size of the Gnus image cache."
+ :version "24.1"
+ :group 'gnus-art
+ :type 'integer)
+
+(defcustom gnus-html-frame-width 70
+ "What width to use when rendering HTML."
+ :version "24.1"
+ :group 'gnus-art
+ :type 'integer)
+
+(defcustom gnus-blocked-images "."
+ "Images that have URLs matching this regexp will be blocked."
+ :version "24.1"
+ :group 'gnus-art
+ :type 'regexp)
+
+(defcustom gnus-max-image-proportion 0.7
+ "How big pictures displayed are in relation to the window they're in.
+A value of 0.7 means that they are allowed to take up 70% of the
+width and height of the window. If they are larger than this,
+and Emacs supports it, then the images will be rescaled down to
+fit these criteria."
+ :version "24.1"
+ :group 'gnus-art
+ :type 'float)
+
+(defvar gnus-html-image-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "u" 'gnus-article-copy-string)
+ (define-key map "i" 'gnus-html-insert-image)
+ map))
+
+(defvar gnus-html-displayed-image-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "a" 'gnus-html-show-alt-text)
+ (define-key map "i" 'gnus-html-browse-image)
+ (define-key map "\r" 'gnus-html-browse-url)
+ (define-key map "u" 'gnus-article-copy-string)
+ (define-key map [tab] 'widget-forward)
+ map))
+
+;;;###autoload
+(defun gnus-article-html (&optional handle)
+ (let ((article-buffer (current-buffer)))
+ (unless handle
+ (setq handle (mm-dissect-buffer t)))
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (save-excursion
+ (mm-with-part handle
+ (let* ((coding-system-for-read 'utf-8)
+ (coding-system-for-write 'utf-8)
+ (default-process-coding-system
+ (cons coding-system-for-read coding-system-for-write))
+ (charset (mail-content-type-get (mm-handle-type handle)
+ 'charset)))
+ (when (and charset
+ (setq charset (mm-charset-to-coding-system charset))
+ (not (eq charset 'ascii)))
+ (insert (prog1
+ (mm-decode-coding-string (buffer-string) charset)
+ (erase-buffer)
+ (mm-enable-multibyte))))
+ (call-process-region (point-min) (point-max)
+ "w3m"
+ nil article-buffer nil
+ "-halfdump"
+ "-no-cookie"
+ "-I" "UTF-8"
+ "-O" "UTF-8"
+ "-o" "ext_halfdump=1"
+ "-o" "pre_conv=1"
+ "-t" (format "%s" tab-width)
+ "-cols" (format "%s" gnus-html-frame-width)
+ "-o" "display_image=on"
+ "-T" "text/html"))))
+ (gnus-html-wash-tags))))
+
+(defvar gnus-article-mouse-face)
+
+(defun gnus-html-pre-wash ()
+ (goto-char (point-min))
+ (while (re-search-forward " *<pre_int> *</pre_int> *\n" nil t)
+ (replace-match "" t t))
+ (goto-char (point-min))
+ (while (re-search-forward "<a name[^\n>]+>" nil t)
+ (replace-match "" t t)))
+
+(defun gnus-html-wash-images ()
+ (let (tag parameters string start end images url)
+ (goto-char (point-min))
+ ;; Search for all the images first.
+ (while (re-search-forward "<img_alt \\([^>]*\\)>" nil t)
+ (setq parameters (match-string 1)
+ start (match-beginning 0))
+ (delete-region start (point))
+ (when (search-forward "</img_alt>" (line-end-position) t)
+ (delete-region (match-beginning 0) (match-end 0)))
+ (setq end (point))
+ (when (string-match "src=\"\\([^\"]+\\)" parameters)
+ (setq url (match-string 1 parameters))
+ (gnus-message 8 "gnus-html-wash-tags: fetching image URL %s" url)
+ (if (string-match "^cid:\\(.*\\)" url)
+ ;; URLs with cid: have their content stashed in other
+ ;; parts of the MIME structure, so just insert them
+ ;; immediately.
+ (let ((handle (mm-get-content-id
+ (setq url (match-string 1 url))))
+ image)
+ (when handle
+ (mm-with-part handle
+ (setq image (gnus-create-image (buffer-string)
+ nil t))))
+ (when image
+ (let ((string (buffer-substring start end)))
+ (delete-region start end)
+ (gnus-put-image image (gnus-string-or string "*") 'cid)
+ (gnus-add-image 'cid image))))
+ ;; Normal, external URL.
+ (if (gnus-html-image-url-blocked-p
+ url
+ (if (buffer-live-p gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
+ gnus-blocked-images)
+ gnus-blocked-images))
+ (progn
+ (widget-convert-button
+ 'link start end
+ :action 'gnus-html-insert-image
+ :help-echo url
+ :keymap gnus-html-image-map
+ :button-keymap gnus-html-image-map)
+ (let ((overlay (gnus-make-overlay start end))
+ (spec (list url
+ (set-marker (make-marker) start)
+ (set-marker (make-marker) end))))
+ (gnus-overlay-put overlay 'local-map gnus-html-image-map)
+ (gnus-overlay-put overlay 'gnus-image spec)
+ (gnus-put-text-property
+ start end
+ 'gnus-image spec)))
+ (let ((file (gnus-html-image-id url))
+ width height alt-text)
+ (when (string-match "height=\"?\\([0-9]+\\)" parameters)
+ (setq height (string-to-number (match-string 1 parameters))))
+ (when (string-match "width=\"?\\([0-9]+\\)" parameters)
+ (setq width (string-to-number (match-string 1 parameters))))
+ (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)"
+ parameters)
+ (setq alt-text (match-string 2 parameters)))
+ ;; Don't fetch images that are really small. They're
+ ;; probably tracking pictures.
+ (when (and (or (null height)
+ (> height 4))
+ (or (null width)
+ (> width 4)))
+ (if (file-exists-p file)
+ ;; It's already cached, so just insert it.
+ (let ((string (buffer-substring start end)))
+ ;; Delete the IMG text.
+ (delete-region start end)
+ (gnus-html-put-image file (point) string url alt-text))
+ ;; We don't have it, so schedule it for fetching
+ ;; asynchronously.
+ (push (list url
+ (set-marker (make-marker) start)
+ (point-marker))
+ images))))))))
+ (when images
+ (gnus-html-schedule-image-fetching (current-buffer) (nreverse images)))))
+
+(defun gnus-html-wash-tags ()
+ (let (tag parameters string start end images url)
+ (gnus-html-pre-wash)
+ (gnus-html-wash-images)
+
+ (goto-char (point-min))
+ ;; Then do the other tags.
+ (while (re-search-forward "<\\([^ />]+\\)\\([^>]*\\)>" nil t)
+ (setq tag (match-string 1)
+ parameters (match-string 2)
+ start (match-beginning 0))
+ (when (plusp (length parameters))
+ (set-text-properties 0 (1- (length parameters)) nil parameters))
+ (delete-region start (point))
+ (when (search-forward (concat "</" tag ">") nil t)
+ (delete-region (match-beginning 0) (match-end 0)))
+ (setq end (point))
+ (cond
+ ;; Fetch and insert a picture.
+ ((equal tag "img_alt"))
+ ;; Add a link.
+ ((or (equal tag "a")
+ (equal tag "A"))
+ (when (string-match "href=\"\\([^\"]+\\)" parameters)
+ (setq url (match-string 1 parameters))
+ (gnus-message 8 "gnus-html-wash-tags: fetching link URL %s" url)
+ (gnus-article-add-button start end
+ 'browse-url url
+ url)
+ (let ((overlay (gnus-make-overlay start end)))
+ (gnus-overlay-put overlay 'evaporate t)
+ (gnus-overlay-put overlay 'gnus-button-url url)
+ (gnus-put-text-property start end 'gnus-string url)
+ (when gnus-article-mouse-face
+ (gnus-overlay-put overlay 'mouse-face gnus-article-mouse-face)))))
+ ;; The upper-case IMG_ALT is apparently just an artifact that
+ ;; should be deleted.
+ ((equal tag "IMG_ALT")
+ (delete-region start end))
+ ;; Whatever. Just ignore the tag.
+ (t
+ ))
+ (goto-char start))
+ (goto-char (point-min))
+ ;; The output from -halfdump isn't totally regular, so strip
+ ;; off any </pre_int>s that were left over.
+ (while (re-search-forward "</pre_int>\\|</internal>" nil t)
+ (replace-match "" t t))
+ (mm-url-decode-entities)))
+
+(defun gnus-html-insert-image ()
+ "Fetch and insert the image under point."
+ (interactive)
+ (gnus-html-schedule-image-fetching
+ (current-buffer) (list (get-text-property (point) 'gnus-image))))
+
+(defun gnus-html-show-alt-text ()
+ "Show the ALT text of the image under point."
+ (interactive)
+ (message "%s" (get-text-property (point) 'gnus-alt-text)))
+
+(defun gnus-html-browse-image ()
+ "Browse the image under point."
+ (interactive)
+ (browse-url (get-text-property (point) 'gnus-image)))
+
+(defun gnus-html-browse-url ()
+ "Browse the image under point."
+ (interactive)
+ (let ((url (get-text-property (point) 'gnus-string)))
+ (if (not url)
+ (message "No URL at point")
+ (browse-url url))))
+
+(defun gnus-html-schedule-image-fetching (buffer images)
+ (gnus-message 8 "gnus-html-schedule-image-fetching: buffer %s, images %s"
+ buffer images)
+ (let* ((url (caar images))
+ (process (start-process
+ "images" nil "curl"
+ "-s" "--create-dirs"
+ "--location"
+ "--max-time" "60"
+ "-o" (gnus-html-image-id url)
+ (mm-url-decode-entities-string url))))
+ (process-kill-without-query process)
+ (set-process-sentinel process 'gnus-html-curl-sentinel)
+ (gnus-set-process-plist process (list 'images images
+ 'buffer buffer))))
+
+(defun gnus-html-image-id (url)
+ (expand-file-name (sha1 url) gnus-html-cache-directory))
+
+(defun gnus-html-curl-sentinel (process event)
+ (when (string-match "finished" event)
+ (let* ((images (gnus-process-get process 'images))
+ (buffer (gnus-process-get process 'buffer))
+ (spec (pop images))
+ (file (gnus-html-image-id (car spec))))
+ (when (and (buffer-live-p buffer)
+ ;; If the position of the marker is 1, then that
+ ;; means that the text it was in has been deleted;
+ ;; i.e., that the user has selected a different
+ ;; article before the image arrived.
+ (not (= (marker-position (cadr spec)) (point-min))))
+ (with-current-buffer buffer
+ (let ((inhibit-read-only t)
+ (string (buffer-substring (cadr spec) (caddr spec))))
+ (delete-region (cadr spec) (caddr spec))
+ (gnus-html-put-image file (cadr spec) string))))
+ (when images
+ (gnus-html-schedule-image-fetching buffer images)))))
+
+(defun gnus-html-put-image (file point string &optional url alt-text)
+ (when (gnus-graphic-display-p)
+ (let* ((image (ignore-errors
+ (gnus-create-image file)))
+ (size (and image
+ (if (featurep 'xemacs)
+ (cons (glyph-width image) (glyph-height image))
+ (image-size image t)))))
+ (save-excursion
+ (goto-char point)
+ (if (and image
+ ;; Kludge to avoid displaying 30x30 gif images, which
+ ;; seems to be a signal of a broken image.
+ (not (and (if (featurep 'xemacs)
+ (glyphp image)
+ (listp image))
+ (eq (if (featurep 'xemacs)
+ (let ((data (cdadar (specifier-spec-list
+ (glyph-image image)))))
+ (and (vectorp data)
+ (aref data 0)))
+ (plist-get (cdr image) :type))
+ 'gif)
+ (= (car size) 30)
+ (= (cdr size) 30))))
+ (let ((start (point)))
+ (setq image (gnus-html-rescale-image image file size))
+ (gnus-put-image image
+ (gnus-string-or string "*")
+ 'external)
+ (let ((overlay (gnus-make-overlay start (point))))
+ (gnus-overlay-put overlay 'local-map
+ gnus-html-displayed-image-map)
+ (gnus-put-text-property start (point) 'gnus-alt-text alt-text)
+ (when url
+ (gnus-put-text-property start (point) 'gnus-image url)))
+ (gnus-add-image 'external image)
+ t)
+ (insert string)
+ (when (fboundp 'find-image)
+ (setq image (find-image '((:type xpm :file "lock-broken.xpm"))))
+ (gnus-put-image image
+ (gnus-string-or string "*")
+ 'internal)
+ (gnus-add-image 'internal image))
+ nil)))))
+
+(defun gnus-html-rescale-image (image file size)
+ (if (or (not (fboundp 'imagemagick-types))
+ (not (get-buffer-window (current-buffer))))
+ image
+ (let* ((width (car size))
+ (height (cdr size))
+ (edges (window-pixel-edges (get-buffer-window (current-buffer))))
+ (window-width (truncate (* gnus-max-image-proportion
+ (- (nth 2 edges) (nth 0 edges)))))
+ (window-height (truncate (* gnus-max-image-proportion
+ (- (nth 3 edges) (nth 1 edges)))))
+ scaled-image)
+ (when (> height window-height)
+ (setq image (or (create-image file 'imagemagick nil
+ :height window-height)
+ image))
+ (setq size (image-size image t)))
+ (when (> (car size) window-width)
+ (setq image (or
+ (create-image file 'imagemagick nil
+ :width window-width)
+ image)))
+ image)))
+
+(defun gnus-html-prune-cache ()
+ (let ((total-size 0)
+ files)
+ (dolist (file (directory-files gnus-html-cache-directory t nil t))
+ (let ((attributes (file-attributes file)))
+ (unless (nth 0 attributes)
+ (incf total-size (nth 7 attributes))
+ (push (list (time-to-seconds (nth 5 attributes))
+ (nth 7 attributes) file)
+ files))))
+ (when (> total-size gnus-html-cache-size)
+ (setq files (sort files (lambda (f1 f2)
+ (< (car f1) (car f2)))))
+ (dolist (file files)
+ (when (> total-size gnus-html-cache-size)
+ (decf total-size (cadr file))
+ (delete-file (nth 2 file)))))))
+
+(defun gnus-html-image-url-blocked-p (url blocked-images)
+ "Find out if URL is blocked by BLOCKED-IMAGES."
+ (let ((ret (and blocked-images
+ (string-match blocked-images url))))
+ (if ret
+ (gnus-message 8 "gnus-html-image-url-blocked-p: %s blocked by regex %s"
+ url blocked-images)
+ (gnus-message 9 "gnus-html-image-url-blocked-p: %s passes regex %s"
+ url blocked-images))
+ ret))
+
+(defun gnus-html-show-images ()
+ "Show any images that are in the HTML-rendered article buffer.
+This only works if the article in question is HTML."
+ (interactive)
+ (gnus-with-article-buffer
+ (let ((overlays (overlays-in (point-min) (point-max)))
+ overlay images)
+ (while (setq overlay (pop overlays))
+ (when (overlay-get overlay 'gnus-image)
+ (push (overlay-get overlay 'gnus-image) images)))
+ (if (not images)
+ (message "No images to show")
+ (gnus-html-schedule-image-fetching (current-buffer) images)))))
+
+;;;###autoload
+(defun gnus-html-prefetch-images (summary)
+ (let (blocked-images urls)
+ (when (buffer-live-p summary)
+ (with-current-buffer summary
+ (setq blocked-images gnus-blocked-images))
+ (save-match-data
+ (while (re-search-forward "<img.*src=[\"']\\([^\"']+\\)" nil t)
+ (let ((url (match-string 1)))
+ (unless (gnus-html-image-url-blocked-p url blocked-images)
+ (unless (file-exists-p (gnus-html-image-id url))
+ (push (mm-url-decode-entities-string url) urls)
+ (push (gnus-html-image-id url) urls)
+ (push "-o" urls)))))
+ (let ((process
+ (apply 'start-process
+ "images" nil "curl"
+ "-s" "--create-dirs"
+ "--location"
+ "--max-time" "60"
+ urls)))
+ (process-kill-without-query process))))))
+
+(provide 'gnus-html)
+
+;;; gnus-html.el ends here
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index a0795916ea..d805f3104d 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -365,7 +365,7 @@ If it is down, start it up (again)."
(when (stringp gnus-command-method)
(setq gnus-command-method
(inline (gnus-server-to-method gnus-command-method))))
- (funcall (inline (gnus-get-function gnus-command-method 'request-group))
+ (funcall (inline (gnus-get-function gnus-command-method 'request-group))
(gnus-group-real-name group) (nth 1 gnus-command-method)
dont-check)))
@@ -544,7 +544,8 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
(if group (gnus-find-method-for-group group) gnus-command-method))
(gnus-inhibit-demon t)
(mail-source-plugged gnus-plugged))
- (when (or gnus-plugged (not (gnus-agent-method-p gnus-command-method)))
+ (when (or gnus-plugged
+ (not (gnus-agent-method-p gnus-command-method)))
(setq gnus-internal-registry-spool-current-method gnus-command-method)
(funcall (gnus-get-function gnus-command-method 'request-scan)
(and group (gnus-group-real-name group))
@@ -716,5 +717,4 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
(provide 'gnus-int)
-;; arch-tag: bbc90087-9b7f-4017-a92c-3abf180ac86d
;;; gnus-int.el ends here
diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el
index e81d03207c..fc564490fc 100644
--- a/lisp/gnus/gnus-kill.el
+++ b/lisp/gnus/gnus-kill.el
@@ -715,5 +715,4 @@ Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score"
(provide 'gnus-kill)
-;; arch-tag: b30c0f53-df1a-490b-b81e-17b13474f395
;;; gnus-kill.el ends here
diff --git a/lisp/gnus/gnus-logic.el b/lisp/gnus/gnus-logic.el
index 6875c324cb..e6d28ae26a 100644
--- a/lisp/gnus/gnus-logic.el
+++ b/lisp/gnus/gnus-logic.el
@@ -225,5 +225,4 @@
(provide 'gnus-logic)
-;; arch-tag: 9651a100-4a59-4b69-a55b-e511e67c0f8d
;;; gnus-logic.el ends here
diff --git a/lisp/gnus/gnus-mh.el b/lisp/gnus/gnus-mh.el
index 67548d7cac..7df4b46629 100644
--- a/lisp/gnus/gnus-mh.el
+++ b/lisp/gnus/gnus-mh.el
@@ -109,5 +109,4 @@ Otherwise, it is like +news/group."
(provide 'gnus-mh)
-;; arch-tag: 2d5696d3-b363-48e5-8749-c256be56acca
;;; gnus-mh.el ends here
diff --git a/lisp/gnus/gnus-ml.el b/lisp/gnus/gnus-ml.el
index 30c1bfedce..5c42ef515f 100644
--- a/lisp/gnus/gnus-ml.el
+++ b/lisp/gnus/gnus-ml.el
@@ -180,5 +180,4 @@ ADDRESS is specified by a \"mailto:\" URL."
(provide 'gnus-ml)
-;; arch-tag: 936c0fe6-acce-4c16-87d0-eded88078896
;;; gnus-ml.el ends here
diff --git a/lisp/gnus/gnus-mlspl.el b/lisp/gnus/gnus-mlspl.el
index fb2fa3511a..509e391480 100644
--- a/lisp/gnus/gnus-mlspl.el
+++ b/lisp/gnus/gnus-mlspl.el
@@ -227,5 +227,4 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\") returns:
(provide 'gnus-mlspl)
-;; arch-tag: 62b3381f-1e45-4b61-be1a-29fb27703322
;;; gnus-mlspl.el ends here
diff --git a/lisp/gnus/gnus-move.el b/lisp/gnus/gnus-move.el
deleted file mode 100644
index 2c7a9585fe..0000000000
--- a/lisp/gnus/gnus-move.el
+++ /dev/null
@@ -1,181 +0,0 @@
-;;; gnus-move.el --- commands for moving Gnus from one server to another
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <[email protected]>
-;; Keywords: news
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus)
-(require 'gnus-start)
-(require 'gnus-int)
-(require 'gnus-range)
-
-;;;
-;;; Moving by comparing Message-ID's.
-;;;
-
-;;;###autoload
-(defun gnus-change-server (from-server to-server)
- "Move from FROM-SERVER to TO-SERVER.
-Update the .newsrc.eld file to reflect the change of nntp server."
- (interactive
- (list gnus-select-method (gnus-read-method "Move to method: ")))
-
- ;; First start Gnus.
- (let ((gnus-activate-level 0)
- (mail-sources nil))
- (gnus))
-
- (save-excursion
- ;; Go through all groups and translate.
- (let ((nntp-nov-gap nil))
- (dolist (info gnus-newsrc-alist)
- (when (gnus-group-native-p (gnus-info-group info))
- (gnus-move-group-to-server info from-server to-server))))))
-
-(defun gnus-move-group-to-server (info from-server to-server)
- "Move group INFO from FROM-SERVER to TO-SERVER."
- (let ((group (gnus-info-group info))
- to-active hashtb type mark marks
- to-article to-reads to-marks article
- act-articles)
- (gnus-message 7 "Translating %s..." group)
- (when (gnus-request-group group nil to-server)
- (setq to-active (gnus-parse-active)
- hashtb (gnus-make-hashtable 1024)
- act-articles (gnus-uncompress-range to-active))
- ;; Fetch the headers from the `to-server'.
- (when (and to-active
- act-articles
- (setq type (gnus-retrieve-headers
- act-articles
- group to-server)))
- ;; Convert HEAD headers. I don't care.
- (when (eq type 'headers)
- (nnvirtual-convert-headers))
- ;; Create a mapping from Message-ID to article number.
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (while (looking-at
- "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t")
- (gnus-sethash
- (buffer-substring (match-beginning 1) (match-end 1))
- (read (current-buffer))
- hashtb)
- (forward-line 1))
- ;; Then we read the headers from the `from-server'.
- (when (and (gnus-request-group group nil from-server)
- (gnus-active group)
- (gnus-uncompress-range
- (gnus-active group))
- (setq type (gnus-retrieve-headers
- (gnus-uncompress-range
- (gnus-active group))
- group from-server)))
- ;; Make it easier to map marks.
- (let ((mark-lists (gnus-info-marks info))
- ms type m)
- (while mark-lists
- (setq type (caar mark-lists)
- ms (gnus-uncompress-range (cdr (pop mark-lists))))
- (while ms
- (if (setq m (assq (car ms) marks))
- (setcdr m (cons type (cdr m)))
- (push (list (car ms) type) marks))
- (pop ms))))
- ;; Convert.
- (when (eq type 'headers)
- (nnvirtual-convert-headers))
- ;; Go through the headers and map away.
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (while (looking-at
- "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t")
- (when (setq to-article
- (gnus-gethash
- (buffer-substring (match-beginning 1) (match-end 1))
- hashtb))
- ;; Add this article to the list of read articles.
- (push to-article to-reads)
- ;; See if there are any marks and then add them.
- (when (setq mark (assq (read (current-buffer)) marks))
- (setq marks (delq mark marks))
- (setcar mark to-article)
- (push mark to-marks))
- (forward-line 1)))
- ;; Now we know what the read articles are and what the
- ;; article marks are. We transform the information
- ;; into the Gnus info format.
- (setq to-reads
- (gnus-range-add
- (gnus-compress-sequence
- (and (setq to-reads (delq nil to-reads))
- (sort to-reads '<))
- t)
- (cons 1 (1- (car to-active)))))
- (gnus-info-set-read info to-reads)
- ;; Do the marks. I'm sure y'all understand what's
- ;; going on down below, so I won't bother with any
- ;; further comments. <duck>
- (let ((mlists gnus-article-mark-lists)
- lists ms a)
- (while mlists
- (push (list (cdr (pop mlists))) lists))
- (while (setq ms (pop marks))
- (setq article (pop ms))
- (while ms
- (setcdr (setq a (assq (pop ms) lists))
- (cons article (cdr a)))))
- (setq a lists)
- (while a
- (setcdr (car a) (gnus-compress-sequence
- (and (cdar a) (sort (cdar a) '<))))
- (pop a))
- (gnus-info-set-marks info lists t)))))
- (gnus-message 7 "Translating %s...done" group)))
-
-(defun gnus-group-move-group-to-server (info from-server to-server)
- "Move the group on the current line from FROM-SERVER to TO-SERVER."
- (interactive
- (let ((info (gnus-get-info (gnus-group-group-name))))
- (list info (gnus-find-method-for-group (gnus-info-group info))
- (gnus-read-method (format "Move group %s to method: "
- (gnus-info-group info))))))
- (save-excursion
- (gnus-move-group-to-server info from-server to-server)
- ;; We have to update the group info to point use the right server.
- (gnus-info-set-method info to-server t)
- ;; We also have to change the name of the group and stuff.
- (let* ((group (gnus-info-group info))
- (new-name (gnus-group-prefixed-name
- (gnus-group-real-name group) to-server)))
- (gnus-info-set-group info new-name)
- (gnus-sethash new-name (gnus-group-entry group) gnus-newsrc-hashtb)
- (gnus-sethash group nil gnus-newsrc-hashtb))))
-
-(provide 'gnus-move)
-
-;; arch-tag: 503742b8-7d66-4d79-bb31-4a698070707b
-;;; gnus-move.el ends here
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index f314d33c6d..a2a2652b08 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -1989,5 +1989,4 @@ this is a reply."
(provide 'gnus-msg)
-;; arch-tag: 9f22b2f5-1c0a-49de-916e-4c88e984852b
;;; gnus-msg.el ends here
diff --git a/lisp/gnus/gnus-nocem.el b/lisp/gnus/gnus-nocem.el
index c6c396d7af..0364c963a2 100644
--- a/lisp/gnus/gnus-nocem.el
+++ b/lisp/gnus/gnus-nocem.el
@@ -449,5 +449,4 @@ valid issuer, which is much faster if you are selective about the issuers."
(provide 'gnus-nocem)
-;; arch-tag: 0e0c74ea-2f8e-4f3e-8fff-09f767c1adef
;;; gnus-nocem.el ends here
diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el
index 0b3b3b5c6a..d319fd3f76 100644
--- a/lisp/gnus/gnus-picon.el
+++ b/lisp/gnus/gnus-picon.el
@@ -319,5 +319,4 @@ If picons are already displayed, remove them."
(provide 'gnus-picon)
-;; arch-tag: fe9aede0-1b1b-463a-b4ab-807f98bcb31f
;;; gnus-picon.el ends here
diff --git a/lisp/gnus/gnus-range.el b/lisp/gnus/gnus-range.el
index 78b05929de..5eb8080ac0 100644
--- a/lisp/gnus/gnus-range.el
+++ b/lisp/gnus/gnus-range.el
@@ -187,7 +187,7 @@ LIST1 and LIST2 have to be sorted over <."
RANGE1 and RANGE2 have to be sorted over <."
(let* (out
(min1 (car range1))
- (max1 (if (numberp min1)
+ (max1 (if (numberp min1)
(if (numberp (cdr range1))
(prog1 (cdr range1)
(setq range1 nil)) min1)
@@ -196,8 +196,8 @@ RANGE1 and RANGE2 have to be sorted over <."
(min2 (car range2))
(max2 (if (numberp min2)
(if (numberp (cdr range2))
- (prog1 (cdr range2)
- (setq range2 nil)) min2)
+ (prog1 (cdr range2)
+ (setq range2 nil)) min2)
(prog1 (cdr min2)
(setq min2 (car min2))))))
(setq range1 (cdr range1)
@@ -654,5 +654,4 @@ LIST is a sorted list."
(provide 'gnus-range)
-;; arch-tag: 4780bdd8-5a15-4aff-be28-18727895b6ad
;;; gnus-range.el ends here
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index db10440116..5f94582694 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -1,6 +1,6 @@
;;; gnus-registry.el --- article registry for Gnus
-;;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+;;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
;;; Free Software Foundation, Inc.
;; Author: Ted Zlatanov <[email protected]>
@@ -72,7 +72,7 @@
:version "22.1"
:group 'gnus)
-(defvar gnus-registry-hashtb (make-hash-table
+(defvar gnus-registry-hashtb (make-hash-table
:size 256
:test 'equal)
"*The article registry by Message ID.")
@@ -97,7 +97,7 @@
"List of registry marks and their options.
`gnus-registry-mark-article' will offer symbols from this list
-for completion.
+for completion.
Each entry must have a character to be useful for summary mode
line display and for keyboard shortcuts.
@@ -121,7 +121,7 @@ display."
:group 'gnus-registry
:type 'symbol)
-(defcustom gnus-registry-unfollowed-groups
+(defcustom gnus-registry-unfollowed-groups
'("delayed$" "drafts$" "queue$" "INBOX$")
"List of groups that gnus-registry-split-fancy-with-parent won't return.
The group names are matched, they don't have to be fully
@@ -206,9 +206,9 @@ considered precious) will not be trimmed."
:group 'gnus-registry
:type '(repeat symbol))
-(defcustom gnus-registry-cache-file
- (nnheader-concat
- (or gnus-dribble-directory gnus-home-directory "~/")
+(defcustom gnus-registry-cache-file
+ (nnheader-concat
+ (or gnus-dribble-directory gnus-home-directory "~/")
".gnus.registry.eld")
"File where the Gnus registry will be stored."
:group 'gnus-registry
@@ -253,7 +253,7 @@ considered precious) will not be trimmed."
(if gnus-save-startup-file-via-temp-buffer
(let ((coding-system-for-write gnus-ding-file-coding-system)
(standard-output (current-buffer)))
- (gnus-gnus-to-quick-newsrc-format
+ (gnus-gnus-to-quick-newsrc-format
t "gnus registry startup file" 'gnus-registry-alist)
(gnus-registry-cache-whitespace file)
(save-buffer))
@@ -276,7 +276,7 @@ considered precious) will not be trimmed."
(unwind-protect
(progn
(gnus-with-output-to-file working-file
- (gnus-gnus-to-quick-newsrc-format
+ (gnus-gnus-to-quick-newsrc-format
t "gnus registry startup file" 'gnus-registry-alist))
;; These bindings will mislead the current buffer
@@ -326,7 +326,7 @@ considered precious) will not be trimmed."
(when gnus-registry-clean-empty
(gnus-registry-clean-empty-function))
;; now trim and clean text properties from the registry appropriately
- (setq gnus-registry-alist
+ (setq gnus-registry-alist
(gnus-registry-remove-alist-text-properties
(gnus-registry-trim
(gnus-hashtable-to-alist
@@ -346,7 +346,7 @@ considered precious) will not be trimmed."
(dolist (group (gnus-registry-fetch-groups key))
(when (gnus-parameter-registry-ignore group)
(gnus-message
- 10
+ 10
"gnus-registry: deleted ignored group %s from key %s"
group key)
(gnus-registry-delete-group key group)))
@@ -361,14 +361,14 @@ considered precious) will not be trimmed."
(gnus-registry-fetch-extra key 'label))
(incf count)
(gnus-registry-delete-id key))
-
+
(unless (stringp key)
- (gnus-message
- 10
- "gnus-registry key %s was not a string, removing"
+ (gnus-message
+ 10
+ "gnus-registry key %s was not a string, removing"
key)
(gnus-registry-delete-id key))))
-
+
gnus-registry-hashtb)
count))
@@ -391,7 +391,7 @@ considered precious) will not be trimmed."
(defun gnus-registry-trim (alist)
"Trim alist to size, using gnus-registry-max-entries.
Any entries with extra data (marks, currently) are left alone."
- (if (null gnus-registry-max-entries)
+ (if (null gnus-registry-max-entries)
alist ; just return the alist
;; else, when given max-entries, trim the alist
(let* ((timehash (make-hash-table
@@ -420,25 +420,25 @@ Any entries with extra data (marks, currently) are left alone."
(push item precious-list)
(push item junk-list))))
- (sort
+ (sort
junk-list
(lambda (a b)
- (let ((t1 (or (cdr (gethash (car a) timehash))
+ (let ((t1 (or (cdr (gethash (car a) timehash))
'(0 0 0)))
- (t2 (or (cdr (gethash (car b) timehash))
+ (t2 (or (cdr (gethash (car b) timehash))
'(0 0 0))))
(time-less-p t1 t2))))
;; we use the return value of this setq, which is the trimmed alist
(setq alist (append precious-list
(nthcdr trim-length junk-list))))))
-
+
(defun gnus-registry-action (action data-header from &optional to method)
(let* ((id (mail-header-id data-header))
(subject (gnus-string-remove-all-properties
(gnus-registry-simplify-subject
(mail-header-subject data-header))))
- (sender (gnus-string-remove-all-properties
+ (sender (gnus-string-remove-all-properties
(mail-header-from data-header)))
(from (gnus-group-guess-full-name-from-command-method from))
(to (if to (gnus-group-guess-full-name-from-command-method to) nil))
@@ -489,7 +489,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
(let* ((refstr (or (message-fetch-field "references") "")) ; guaranteed
(reply-to (message-fetch-field "in-reply-to")) ; may be nil
;; now, if reply-to is valid, append it to the References
- (refstr (if reply-to
+ (refstr (if reply-to
(concat refstr " " reply-to)
refstr))
;; these may not be used, but the code is cleaner having them up here
@@ -517,8 +517,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
9
"%s is looking for matches for reference %s from [%s]"
log-agent reference refstr)
- (dolist (group (gnus-registry-fetch-groups
- reference
+ (dolist (group (gnus-registry-fetch-groups
+ reference
gnus-registry-max-track-groups))
(when (and group (gnus-registry-follow-group-p group))
(gnus-message
@@ -528,9 +528,9 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
(push group found))))
;; filter the found groups and return them
;; the found groups are the full groups
- (setq found (gnus-registry-post-process-groups
+ (setq found (gnus-registry-post-process-groups
"references" refstr found found)))
-
+
;; else: there were no matches, now try the extra tracking by sender
((and (gnus-registry-track-sender-p)
sender
@@ -543,7 +543,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
matches)
(when (and this-sender
(equal sender this-sender))
- (let ((groups (gnus-registry-fetch-groups
+ (let ((groups (gnus-registry-fetch-groups
key
gnus-registry-max-track-groups)))
(dolist (group groups)
@@ -558,9 +558,9 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
gnus-registry-hashtb)
;; filter the found groups and return them
;; the found groups are NOT the full groups
- (setq found (gnus-registry-post-process-groups
+ (setq found (gnus-registry-post-process-groups
"sender" sender found found-full)))
-
+
;; else: there were no matches, now try the extra tracking by subject
((and (gnus-registry-track-subject-p)
subject
@@ -572,7 +572,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
matches)
(when (and this-subject
(equal subject this-subject))
- (let ((groups (gnus-registry-fetch-groups
+ (let ((groups (gnus-registry-fetch-groups
key
gnus-registry-max-track-groups)))
(dolist (group groups)
@@ -587,7 +587,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
gnus-registry-hashtb)
;; filter the found groups and return them
;; the found groups are NOT the full groups
- (setq found (gnus-registry-post-process-groups
+ (setq found (gnus-registry-post-process-groups
"subject" subject found found-full))))
;; after the (cond) we extract the actual value safely
(car-safe found)))
@@ -627,7 +627,7 @@ necessary."
(lambda (a b)
(> (gethash a freq 0)
(gethash b freq 0)))))))))
-
+
(if gnus-registry-use-long-group-names
(dolist (group groups)
(let ((m1 (gnus-find-method-for-group group))
@@ -661,10 +661,10 @@ necessary."
"Determines if a group name should be followed.
Consults `gnus-registry-unfollowed-groups' and
`nnmail-split-fancy-with-parent-ignore-groups'."
- (not (or (gnus-registry-grep-in-list
+ (not (or (gnus-grep-in-list
group
gnus-registry-unfollowed-groups)
- (gnus-registry-grep-in-list
+ (gnus-grep-in-list
group
nnmail-split-fancy-with-parent-ignore-groups))))
@@ -708,8 +708,8 @@ Consults `gnus-registry-unfollowed-groups' and
(unless (member gnus-newsgroup-name (gnus-registry-fetch-groups id))
(gnus-message 9 "Registry: Registering article %d with group %s"
article gnus-newsgroup-name)
- (gnus-registry-add-group
- id
+ (gnus-registry-add-group
+ id
gnus-newsgroup-name
(gnus-registry-fetch-simplified-message-subject-fast article)
(gnus-registry-fetch-sender-fast article)))))))
@@ -745,14 +745,6 @@ Consults `gnus-registry-unfollowed-groups' and
(assoc article (gnus-data-list nil)))))
nil))
-(defun gnus-registry-grep-in-list (word list)
-"Find if a WORD matches any regular expression in the given LIST."
- (when (and word list)
- (catch 'found
- (dolist (r list)
- (when (string-match r word)
- (throw 'found r))))))
-
(defun gnus-registry-do-marks (type function)
"For each known mark, call FUNCTION for each cell of type TYPE.
@@ -793,18 +785,18 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
(shortcut (if remove (upcase shortcut) shortcut)))
(unintern function-name)
(eval
- `(defun
+ `(defun
;; function name
- ,(intern function-name)
+ ,(intern function-name)
;; parameter definition
(&rest articles)
;; documentation
- ,(format
+ ,(format
"%s the %s mark over process-marked ARTICLES."
(upcase-initials variant-name)
mark)
;; interactive definition
- (interactive
+ (interactive
(gnus-summary-work-articles current-prefix-arg))
;; actual code
@@ -815,49 +807,49 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
;; now the user is asked if gnus-registry-install is 'ask
(when (gnus-registry-install-p)
- (gnus-registry-set-article-mark-internal
+ (gnus-registry-set-article-mark-internal
;; all this just to get the mark, I must be doing it wrong
(intern ,(symbol-name mark))
articles ,remove t)
(gnus-message
- 9
+ 9
"Applying mark %s to %d articles"
,(symbol-name mark) (length articles))
(dolist (article articles)
- (gnus-summary-update-article
+ (gnus-summary-update-article
article
(assoc article (gnus-data-list nil)))))))
(push (intern function-name) keys-plist)
- (push shortcut keys-plist)
+ (push shortcut keys-plist)
(push (vector (format "%s %s"
(upcase-initials variant-name)
(symbol-name mark))
(intern function-name) t)
gnus-registry-misc-menus)
(gnus-message
- 9
- "Defined mark handling function %s"
+ 9
+ "Defined mark handling function %s"
function-name))))))
(gnus-define-keys-1
'(gnus-registry-mark-map "M" gnus-summary-mark-map)
keys-plist)
(add-hook 'gnus-summary-menu-hook
(lambda ()
- (easy-menu-add-item
+ (easy-menu-add-item
gnus-summary-misc-menu
- nil
+ nil
(cons "Registry Marks" gnus-registry-misc-menus))))))
;;; use like this:
-;;; (defalias 'gnus-user-format-function-M
+;;; (defalias 'gnus-user-format-function-M
;;; 'gnus-registry-user-format-function-M)
(defun gnus-registry-user-format-function-M (headers)
(let* ((id (mail-header-message-id headers))
(marks (when id (gnus-registry-fetch-extra-marks id))))
(apply 'concat (mapcar (lambda(mark)
- (let ((c
+ (let ((c
(plist-get
- (cdr-safe
+ (cdr-safe
(assoc mark gnus-registry-marks))
:char)))
(if c
@@ -867,9 +859,9 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
(defun gnus-registry-read-mark ()
"Read a mark name from the user with completion."
- (let ((mark (gnus-completing-read-with-default
+ (let ((mark (gnus-completing-read-with-default
(symbol-name gnus-registry-default-mark)
- "Label"
+ "Label"
(mapcar (lambda (x) ; completion list
(cons (symbol-name (car-safe x)) (car-safe x)))
gnus-registry-marks))))
@@ -904,7 +896,7 @@ Uses `gnus-registry-marks' to find what shortcuts to install."
(gnus-message 1 "%s mark %s with message ID %s, resulting in %S"
(if remove "Removing" "Adding")
mark id new-marks))
-
+
(apply 'gnus-registry-store-extra-marks ; set the extra marks
id ; for the message ID
new-marks)))))
@@ -1015,7 +1007,7 @@ The message must have at least one group name."
"Put a specific entry in the extras field of the registry entry for id."
(let* ((extra (gnus-registry-fetch-extra id))
;; all the entries except the one for `key'
- (the-rest (gnus-assq-delete-all key (gnus-registry-fetch-extra id)))
+ (the-rest (gnus-assq-delete-all key (gnus-registry-fetch-extra id)))
(alist (if value
(gnus-registry-remove-alist-text-properties
(cons (cons key value)
@@ -1042,7 +1034,7 @@ Returns the first place where the trail finds a group name."
(dolist (crumb trail)
(when (stringp crumb)
;; push the group name into the list
- (setq
+ (setq
groups
(cons
(if (or (not (stringp crumb)) gnus-registry-use-long-group-names)
@@ -1191,5 +1183,4 @@ Returns the first place where the trail finds a group name."
(provide 'gnus-registry)
-;; arch-tag: 5cba0a32-718a-4a97-8c91-0a15af21da94
;;; gnus-registry.el ends here
diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el
index 52f307d7fd..21b9d8954f 100644
--- a/lisp/gnus/gnus-salt.el
+++ b/lisp/gnus/gnus-salt.el
@@ -1045,5 +1045,4 @@ The following commands are available:
(provide 'gnus-salt)
-;; arch-tag: 35449164-77b3-4398-bcbd-a2e3e998f810
;;; gnus-salt.el ends here
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index 26c01229e3..bd4a39eb7b 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -2055,8 +2055,11 @@ score in `gnus-newsgroup-scored' by SCORE."
;; Evil hackery to make match usable in non-standard headers.
(when extra
- (setq match (concat "[ (](" extra " \\. \"[^)]*"
- match "[^\"]*\")[ )]")
+ (setq match (concat "[ (](" extra " \\. \"\\([^\"]*\\\\\"\\)*[^\"]*"
+ (if (eq search-func 're-search-forward)
+ match
+ (regexp-quote match))
+ "\\([^\"]*\\\\\"\\)*[^\"]*\")[ )]")
search-func 're-search-forward)) ; XXX danger?!?
(cond
@@ -3119,5 +3122,4 @@ See Info node `(gnus)Scoring Tips' for examples of good regular expressions."
(provide 'gnus-score)
-;; arch-tag: d3922589-764d-46ae-9954-9330fd192634
;;; gnus-score.el ends here
diff --git a/lisp/gnus/gnus-setup.el b/lisp/gnus/gnus-setup.el
index 9cfa658417..d5578ff693 100644
--- a/lisp/gnus/gnus-setup.el
+++ b/lisp/gnus/gnus-setup.el
@@ -189,5 +189,4 @@ score the alt hierarchy, you'd say \"!alt.all\"." t nil))
(run-hooks 'gnus-setup-load-hook)
-;; arch-tag: 08e4af93-8565-46bf-905c-36229400609d
;;; gnus-setup.el ends here
diff --git a/lisp/gnus/gnus-sieve.el b/lisp/gnus/gnus-sieve.el
index abc63c1d1c..a7ddbf08f7 100644
--- a/lisp/gnus/gnus-sieve.el
+++ b/lisp/gnus/gnus-sieve.el
@@ -235,5 +235,4 @@ This is returned as a string."
(provide 'gnus-sieve)
-;; arch-tag: 3b906527-c7f3-4c86-9e82-62e2697998a3
;;; gnus-sieve.el ends here
diff --git a/lisp/gnus/gnus-soup.el b/lisp/gnus/gnus-soup.el
deleted file mode 100644
index 13271a9c15..0000000000
--- a/lisp/gnus/gnus-soup.el
+++ /dev/null
@@ -1,611 +0,0 @@
-;;; gnus-soup.el --- SOUP packet writing support for Gnus
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
-
-;; Author: Per Abrahamsen <[email protected]>
-;; Lars Magne Ingebrigtsen <[email protected]>
-;; Keywords: news, mail
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus)
-(require 'gnus-art)
-(require 'message)
-(require 'gnus-start)
-(require 'gnus-range)
-
-(defgroup gnus-soup nil
- "SOUP packet writing support for Gnus."
- :group 'gnus)
-
-;;; User Variables:
-
-(defcustom gnus-soup-directory (nnheader-concat gnus-home-directory "SoupBrew/")
- "Directory containing an unpacked SOUP packet."
- :version "22.1" ;; Gnus 5.10.9
- :type 'directory
- :group 'gnus-soup)
-
-(defcustom gnus-soup-replies-directory
- (nnheader-concat gnus-soup-directory "SoupReplies/")
- "Directory where Gnus will do processing of replies."
- :version "22.1" ;; Gnus 5.10.9
- :type 'directory
- :group 'gnus-soup)
-
-(defcustom gnus-soup-prefix-file "gnus-prefix"
- "Name of the file where Gnus stores the last used prefix."
- :version "22.1" ;; Gnus 5.10.9
- :type 'file
- :group 'gnus-soup)
-
-(defcustom gnus-soup-packer "tar cf - %s | gzip > $HOME/Soupout%d.tgz"
- "Format string command for packing a SOUP packet.
-The SOUP files will be inserted where the %s is in the string.
-This string MUST contain both %s and %d. The file number will be
-inserted where %d appears."
- :version "22.1" ;; Gnus 5.10.9
- :type 'string
- :group 'gnus-soup)
-
-(defcustom gnus-soup-unpacker "gunzip -c %s | tar xvf -"
- "Format string command for unpacking a SOUP packet.
-The SOUP packet file name will be inserted at the %s."
- :version "22.1" ;; Gnus 5.10.9
- :type 'string
- :group 'gnus-soup)
-
-(defcustom gnus-soup-packet-directory gnus-home-directory
- "Where gnus-soup will look for REPLIES packets."
- :version "22.1" ;; Gnus 5.10.9
- :type 'directory
- :group 'gnus-soup)
-
-(defcustom gnus-soup-packet-regexp "Soupin"
- "Regular expression matching SOUP REPLIES packets in `gnus-soup-packet-directory'."
- :version "22.1" ;; Gnus 5.10.9
- :type 'regexp
- :group 'gnus-soup)
-
-(defcustom gnus-soup-ignored-headers "^Xref:"
- "Regexp to match headers to be removed when brewing SOUP packets."
- :version "22.1" ;; Gnus 5.10.9
- :type 'regexp
- :group 'gnus-soup)
-
-;;; Internal Variables:
-
-(defvar gnus-soup-encoding-type ?u
- "*Soup encoding type.
-`u' is USENET news format, `m' is Unix mbox format, and `M' is MMDF mailbox
-format.")
-
-(defvar gnus-soup-index-type ?c
- "*Soup index type.
-`n' means no index file and `c' means standard Cnews overview
-format.")
-
-(defvar gnus-soup-areas nil)
-(defvar gnus-soup-last-prefix nil)
-(defvar gnus-soup-prev-prefix nil)
-(defvar gnus-soup-buffers nil)
-
-;;; Access macros:
-
-(defmacro gnus-soup-area-prefix (area)
- `(aref ,area 0))
-(defmacro gnus-soup-set-area-prefix (area prefix)
- `(aset ,area 0 ,prefix))
-(defmacro gnus-soup-area-name (area)
- `(aref ,area 1))
-(defmacro gnus-soup-area-encoding (area)
- `(aref ,area 2))
-(defmacro gnus-soup-area-description (area)
- `(aref ,area 3))
-(defmacro gnus-soup-area-number (area)
- `(aref ,area 4))
-(defmacro gnus-soup-area-set-number (area value)
- `(aset ,area 4 ,value))
-
-(defmacro gnus-soup-encoding-format (encoding)
- `(aref ,encoding 0))
-(defmacro gnus-soup-encoding-index (encoding)
- `(aref ,encoding 1))
-(defmacro gnus-soup-encoding-kind (encoding)
- `(aref ,encoding 2))
-
-(defmacro gnus-soup-reply-prefix (reply)
- `(aref ,reply 0))
-(defmacro gnus-soup-reply-kind (reply)
- `(aref ,reply 1))
-(defmacro gnus-soup-reply-encoding (reply)
- `(aref ,reply 2))
-
-;;; Commands:
-
-(defun gnus-soup-send-replies ()
- "Unpack and send all replies in the reply packet."
- (interactive)
- (let ((packets (directory-files
- gnus-soup-packet-directory t gnus-soup-packet-regexp)))
- (while packets
- (when (gnus-soup-send-packet (car packets))
- (delete-file (car packets)))
- (setq packets (cdr packets)))))
-
-(defun gnus-soup-add-article (n)
- "Add the current article to SOUP packet.
-If N is a positive number, add the N next articles.
-If N is a negative number, add the N previous articles.
-If N is nil and any articles have been marked with the process mark,
-move those articles instead."
- (interactive "P")
- (let* ((articles (gnus-summary-work-articles n))
- (tmp-buf (gnus-get-buffer-create "*soup work*"))
- (area (gnus-soup-area gnus-newsgroup-name))
- (prefix (gnus-soup-area-prefix area))
- headers)
- (buffer-disable-undo tmp-buf)
- (save-excursion
- (while articles
- ;; Put the article in a buffer.
- (set-buffer tmp-buf)
- (when (gnus-request-article-this-buffer
- (car articles) gnus-newsgroup-name)
- (setq headers (nnheader-parse-head t))
- (save-restriction
- (message-narrow-to-head)
- (message-remove-header gnus-soup-ignored-headers t))
- (gnus-soup-store gnus-soup-directory prefix headers
- gnus-soup-encoding-type
- gnus-soup-index-type)
- (gnus-soup-area-set-number
- area (1+ (or (gnus-soup-area-number area) 0)))
- ;; Mark article as read.
- (set-buffer gnus-summary-buffer)
- (gnus-summary-mark-as-read (car articles) gnus-souped-mark))
- (gnus-summary-remove-process-mark (car articles))
- (setq articles (cdr articles)))
- (kill-buffer tmp-buf))
- (gnus-soup-save-areas)
- (gnus-set-mode-line 'summary)))
-
-(defun gnus-soup-pack-packet ()
- "Make a SOUP packet from the SOUP areas."
- (interactive)
- (gnus-soup-read-areas)
- (if (file-exists-p gnus-soup-directory)
- (if (directory-files gnus-soup-directory nil "\\.MSG$")
- (gnus-soup-pack gnus-soup-directory gnus-soup-packer)
- (message "No files to pack."))
- (message "No such directory: %s" gnus-soup-directory)))
-
-(defun gnus-group-brew-soup (n)
- "Make a soup packet from the current group.
-Uses the process/prefix convention."
- (interactive "P")
- (let ((groups (gnus-group-process-prefix n)))
- (while groups
- (gnus-group-remove-mark (car groups))
- (gnus-soup-group-brew (car groups) t)
- (setq groups (cdr groups)))
- (gnus-soup-save-areas)))
-
-(defun gnus-brew-soup (&optional level)
- "Go through all groups on LEVEL or less and make a soup packet."
- (interactive "P")
- (let ((level (or level gnus-level-subscribed))
- (newsrc (cdr gnus-newsrc-alist)))
- (while newsrc
- (when (<= (nth 1 (car newsrc)) level)
- (gnus-soup-group-brew (caar newsrc) t))
- (setq newsrc (cdr newsrc)))
- (gnus-soup-save-areas)))
-
-;;;###autoload
-(defun gnus-batch-brew-soup ()
- "Brew a SOUP packet from groups mention on the command line.
-Will use the remaining command line arguments as regular expressions
-for matching on group names.
-
-For instance, if you want to brew on all the nnml groups, as well as
-groups with \"emacs\" in the name, you could say something like:
-
-$ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\"
-
-Note -- this function hasn't been implemented yet."
- (interactive)
- nil)
-
-;;; Internal Functions:
-
-;; Store the current buffer.
-(defun gnus-soup-store (directory prefix headers format index)
- ;; Create the directory, if needed.
- (gnus-make-directory directory)
- (let* ((msg-buf (nnheader-find-file-noselect
- (concat directory prefix ".MSG")))
- (idx-buf (if (= index ?n)
- nil
- (nnheader-find-file-noselect
- (concat directory prefix ".IDX"))))
- (article-buf (current-buffer))
- from head-line beg type)
- (setq gnus-soup-buffers (cons msg-buf (delq msg-buf gnus-soup-buffers)))
- (buffer-disable-undo msg-buf)
- (when idx-buf
- (push idx-buf gnus-soup-buffers)
- (buffer-disable-undo idx-buf))
- (save-excursion
- ;; Make sure the last char in the buffer is a newline.
- (goto-char (point-max))
- (unless (= (current-column) 0)
- (insert "\n"))
- ;; Find the "from".
- (goto-char (point-min))
- (setq from
- (gnus-mail-strip-quoted-names
- (or (mail-fetch-field "from")
- (mail-fetch-field "really-from")
- (mail-fetch-field "sender"))))
- (goto-char (point-min))
- ;; Depending on what encoding is supposed to be used, we make
- ;; a soup header.
- (setq head-line
- (cond
- ((or (= gnus-soup-encoding-type ?u)
- (= gnus-soup-encoding-type ?n)) ;;Gnus back compatibility.
- (format "#! rnews %d\n" (buffer-size)))
- ((= gnus-soup-encoding-type ?m)
- (while (search-forward "\nFrom " nil t)
- (replace-match "\n>From " t t))
- (concat "From " (or from "unknown")
- " " (current-time-string) "\n"))
- ((= gnus-soup-encoding-type ?M)
- "\^a\^a\^a\^a\n")
- (t (error "Unsupported type: %c" gnus-soup-encoding-type))))
- ;; Insert the soup header and the article in the MSG buf.
- (set-buffer msg-buf)
- (goto-char (point-max))
- (insert head-line)
- (setq beg (point))
- (insert-buffer-substring article-buf)
- ;; Insert the index in the IDX buf.
- (cond ((= index ?c)
- (set-buffer idx-buf)
- (gnus-soup-insert-idx beg headers))
- ((/= index ?n)
- (error "Unknown index type: %c" type)))
- ;; Return the MSG buf.
- msg-buf)))
-
-(defun gnus-soup-group-brew (group &optional not-all)
- "Enter GROUP and add all articles to a SOUP package.
-If NOT-ALL, don't pack ticked articles."
- (let ((gnus-expert-user t)
- (gnus-large-newsgroup nil)
- (entry (gnus-group-entry group)))
- (when (or (null entry)
- (eq (car entry) t)
- (and (car entry)
- (> (car entry) 0))
- (and (not not-all)
- (gnus-range-length (cdr (assq 'tick (gnus-info-marks
- (nth 2 entry)))))))
- (when (gnus-summary-read-group group nil t)
- (setq gnus-newsgroup-processable
- (reverse
- (if (not not-all)
- (append gnus-newsgroup-marked gnus-newsgroup-unreads)
- gnus-newsgroup-unreads)))
- (gnus-soup-add-article nil)
- (gnus-summary-exit)))))
-
-(defun gnus-soup-insert-idx (offset header)
- ;; [number subject from date id references chars lines xref]
- (goto-char (point-max))
- (insert
- (format "%d\t%s\t%s\t%s\t%s\t%s\t%d\t%s\t\t\n"
- offset
- (or (mail-header-subject header) "(none)")
- (or (mail-header-from header) "(nobody)")
- (or (mail-header-date header) "")
- (or (mail-header-id header)
- (concat "soup-dummy-id-"
- (mapconcat
- (lambda (time) (int-to-string time))
- (current-time) "-")))
- (or (mail-header-references header) "")
- (or (mail-header-chars header) 0)
- (or (mail-header-lines header) "0"))))
-
-(defun gnus-soup-save-areas ()
- "Write all SOUP buffers."
- (interactive)
- (gnus-soup-write-areas)
- (save-excursion
- (let (buf)
- (while gnus-soup-buffers
- (setq buf (car gnus-soup-buffers)
- gnus-soup-buffers (cdr gnus-soup-buffers))
- (if (not (buffer-name buf))
- ()
- (set-buffer buf)
- (when (buffer-modified-p)
- (save-buffer))
- (kill-buffer (current-buffer)))))
- (gnus-soup-write-prefixes)))
-
-(defun gnus-soup-write-prefixes ()
- (let ((prefixes gnus-soup-last-prefix)
- prefix)
- (save-excursion
- (gnus-set-work-buffer)
- (while (setq prefix (pop prefixes))
- (erase-buffer)
- (insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdr prefix)))
- (let ((coding-system-for-write mm-text-coding-system))
- (gnus-write-buffer (concat (car prefix) gnus-soup-prefix-file)))))))
-
-(defun gnus-soup-pack (dir packer)
- (let* ((files (mapconcat 'identity
- '("AREAS" "*.MSG" "*.IDX" "INFO"
- "LIST" "REPLIES" "COMMANDS" "ERRORS")
- " "))
- (packer (if (< (string-match "%s" packer)
- (string-match "%d" packer))
- (format packer files
- (string-to-number (gnus-soup-unique-prefix dir)))
- (format packer
- (string-to-number (gnus-soup-unique-prefix dir))
- files)))
- (dir (expand-file-name dir)))
- (gnus-make-directory dir)
- (setq gnus-soup-areas nil)
- (gnus-message 4 "Packing %s..." packer)
- (if (eq 0 (call-process shell-file-name
- nil nil nil shell-command-switch
- (concat "cd " dir " ; " packer)))
- (progn
- (call-process shell-file-name nil nil nil shell-command-switch
- (concat "cd " dir " ; rm " files))
- (gnus-message 4 "Packing...done" packer))
- (error "Couldn't pack packet"))))
-
-(defun gnus-soup-parse-areas (file)
- "Parse soup area file FILE.
-The result is a of vectors, each containing one entry from the AREA file.
-The vector contain five strings,
- [prefix name encoding description number]
-though the two last may be nil if they are missing."
- (let (areas)
- (when (file-exists-p file)
- (save-excursion
- (set-buffer (nnheader-find-file-noselect file 'force))
- (buffer-disable-undo)
- (goto-char (point-min))
- (while (not (eobp))
- (push (vector (gnus-soup-field)
- (gnus-soup-field)
- (gnus-soup-field)
- (and (eq (preceding-char) ?\t)
- (gnus-soup-field))
- (and (eq (preceding-char) ?\t)
- (string-to-number (gnus-soup-field))))
- areas)
- (when (eq (preceding-char) ?\t)
- (beginning-of-line 2)))
- (kill-buffer (current-buffer))))
- areas))
-
-(defun gnus-soup-parse-replies (file)
- "Parse soup REPLIES file FILE.
-The result is a of vectors, each containing one entry from the REPLIES
-file. The vector contain three strings, [prefix name encoding]."
- (let (replies)
- (save-excursion
- (set-buffer (nnheader-find-file-noselect file))
- (buffer-disable-undo)
- (goto-char (point-min))
- (while (not (eobp))
- (push (vector (gnus-soup-field) (gnus-soup-field)
- (gnus-soup-field))
- replies)
- (when (eq (preceding-char) ?\t)
- (beginning-of-line 2)))
- (kill-buffer (current-buffer)))
- replies))
-
-(defun gnus-soup-field ()
- (prog1
- (buffer-substring (point) (progn (skip-chars-forward "^\t\n") (point)))
- (forward-char 1)))
-
-(defun gnus-soup-read-areas ()
- (or gnus-soup-areas
- (setq gnus-soup-areas
- (gnus-soup-parse-areas (concat gnus-soup-directory "AREAS")))))
-
-(defun gnus-soup-write-areas ()
- "Write the AREAS file."
- (interactive)
- (when gnus-soup-areas
- (with-temp-file (concat gnus-soup-directory "AREAS")
- (let ((areas gnus-soup-areas)
- area)
- (while (setq area (pop areas))
- (insert
- (format
- "%s\t%s\t%s%s\n"
- (gnus-soup-area-prefix area)
- (gnus-soup-area-name area)
- (gnus-soup-area-encoding area)
- (if (or (gnus-soup-area-description area)
- (gnus-soup-area-number area))
- (concat "\t" (or (gnus-soup-area-description
- area) "")
- (if (gnus-soup-area-number area)
- (concat "\t" (int-to-string
- (gnus-soup-area-number area)))
- "")) ""))))))))
-
-(defun gnus-soup-write-replies (dir areas)
- "Write a REPLIES file in DIR containing AREAS."
- (with-temp-file (concat dir "REPLIES")
- (let (area)
- (while (setq area (pop areas))
- (insert (format "%s\t%s\t%s\n"
- (gnus-soup-reply-prefix area)
- (gnus-soup-reply-kind area)
- (gnus-soup-reply-encoding area)))))))
-
-(defun gnus-soup-area (group)
- (gnus-soup-read-areas)
- (let ((areas gnus-soup-areas)
- (real-group (gnus-group-real-name group))
- area result)
- (while areas
- (setq area (car areas)
- areas (cdr areas))
- (when (equal (gnus-soup-area-name area) real-group)
- (setq result area)))
- (unless result
- (setq result
- (vector (gnus-soup-unique-prefix)
- real-group
- (format "%c%c%c"
- gnus-soup-encoding-type
- gnus-soup-index-type
- (if (gnus-member-of-valid 'mail group) ?m ?n))
- nil nil)
- gnus-soup-areas (cons result gnus-soup-areas)))
- result))
-
-(defun gnus-soup-unique-prefix (&optional dir)
- (let* ((dir (file-name-as-directory (or dir gnus-soup-directory)))
- (entry (assoc dir gnus-soup-last-prefix))
- gnus-soup-prev-prefix)
- (if entry
- ()
- (when (file-exists-p (concat dir gnus-soup-prefix-file))
- (ignore-errors
- (load (concat dir gnus-soup-prefix-file) nil t t)))
- (push (setq entry (cons dir (or gnus-soup-prev-prefix 0)))
- gnus-soup-last-prefix))
- (setcdr entry (1+ (cdr entry)))
- (gnus-soup-write-prefixes)
- (int-to-string (cdr entry))))
-
-(defun gnus-soup-unpack-packet (dir unpacker packet)
- "Unpack PACKET into DIR using UNPACKER.
-Return whether the unpacking was successful."
- (gnus-make-directory dir)
- (gnus-message 4 "Unpacking: %s" (format unpacker packet))
- (prog1
- (eq 0 (call-process
- shell-file-name nil nil nil shell-command-switch
- (format "cd %s ; %s" (expand-file-name dir)
- (format unpacker packet))))
- (gnus-message 4 "Unpacking...done")))
-
-(defun gnus-soup-send-packet (packet)
- (gnus-soup-unpack-packet
- gnus-soup-replies-directory gnus-soup-unpacker packet)
- (let ((replies (gnus-soup-parse-replies
- (concat gnus-soup-replies-directory "REPLIES"))))
- (save-excursion
- (while replies
- (let* ((msg-file (concat gnus-soup-replies-directory
- (gnus-soup-reply-prefix (car replies))
- ".MSG"))
- (msg-buf (and (file-exists-p msg-file)
- (nnheader-find-file-noselect msg-file)))
- (tmp-buf (gnus-get-buffer-create " *soup send*"))
- beg end)
- (cond
- ((and (/= (gnus-soup-encoding-format
- (gnus-soup-reply-encoding (car replies)))
- ?u)
- (/= (gnus-soup-encoding-format
- (gnus-soup-reply-encoding (car replies)))
- ?n)) ;; Gnus back compatibility.
- (error "Unsupported encoding"))
- ((null msg-buf)
- t)
- (t
- (buffer-disable-undo msg-buf)
- (set-buffer msg-buf)
- (goto-char (point-min))
- (while (not (eobp))
- (unless (looking-at "#! *rnews +\\([0-9]+\\)")
- (error "Bad header"))
- (forward-line 1)
- (setq beg (point)
- end (+ (point) (string-to-number
- (buffer-substring
- (match-beginning 1) (match-end 1)))))
- (switch-to-buffer tmp-buf)
- (erase-buffer)
- (mm-disable-multibyte)
- (insert-buffer-substring msg-buf beg end)
- (cond
- ((string= (gnus-soup-reply-kind (car replies)) "news")
- (gnus-message 5 "Sending news message to %s..."
- (mail-fetch-field "newsgroups"))
- (sit-for 1)
- (let ((message-syntax-checks
- 'dont-check-for-anything-just-trust-me)
- (method (if (functionp message-post-method)
- (funcall message-post-method)
- message-post-method))
- result)
- (run-hooks 'message-send-news-hook)
- (gnus-open-server method)
- (message "Sending news via %s..."
- (gnus-server-string method))
- (unless (let ((mail-header-separator ""))
- (gnus-request-post method))
- (message "Couldn't send message via news: %s"
- (nnheader-get-report (car method))))))
- ((string= (gnus-soup-reply-kind (car replies)) "mail")
- (gnus-message 5 "Sending mail to %s..."
- (mail-fetch-field "to"))
- (sit-for 1)
- (let ((mail-header-separator ""))
- (funcall (or message-send-mail-real-function
- message-send-mail-function))))
- (t
- (error "Unknown reply kind")))
- (set-buffer msg-buf)
- (goto-char end))
- (delete-file (buffer-file-name))
- (kill-buffer msg-buf)
- (kill-buffer tmp-buf)
- (gnus-message 4 "Sent packet"))))
- (setq replies (cdr replies)))
- t)))
-
-(provide 'gnus-soup)
-
-;; arch-tag: eddfa69d-13e8-4aea-84ef-62a526ef185c
-;;; gnus-soup.el ends here
diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el
index 1c5fa4741a..91a1784ca2 100644
--- a/lisp/gnus/gnus-spec.el
+++ b/lisp/gnus/gnus-spec.el
@@ -767,5 +767,4 @@ If PROPS, insert the result."
;; coding: iso-8859-1
;; End:
-;; arch-tag: a4328fa1-1f84-4b09-97ad-4b5767cfd50f
;;; gnus-spec.el ends here
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index ba5609efc9..dd5e51885c 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -1033,5 +1033,4 @@ Requesting compaction of %s... (this may take a long time)"
(provide 'gnus-srvr)
-;; arch-tag: c0117f64-27ca-475d-9406-8da6854c7a25
;;; gnus-srvr.el ends here
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 9ef251f214..1c06a77420 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -765,7 +765,7 @@ prompt the user for the name of an NNTP server to use."
(when gnus-select-method
(push (cons "native" gnus-select-method)
gnus-predefined-server-alist))
-
+
(if gnus-agent
(gnus-agentize))
@@ -814,6 +814,7 @@ prompt the user for the name of an NNTP server to use."
(defun gnus-start-draft-setup ()
"Make sure the draft group exists."
+ (interactive)
(gnus-request-create-group "drafts" '(nndraft ""))
(unless (gnus-group-entry "nndraft:drafts")
(let ((gnus-level-default-subscribed 1))
@@ -868,6 +869,8 @@ prompt the user for the name of an NNTP server to use."
(defun gnus-dribble-read-file ()
"Read the dribble file from disk."
(let ((dribble-file (gnus-dribble-file-name)))
+ (unless (file-exists-p (file-name-directory dribble-file))
+ (make-directory (file-name-directory dribble-file) t))
(save-excursion
(set-buffer (setq gnus-dribble-buffer
(gnus-get-buffer-create
@@ -1523,7 +1526,8 @@ newsgroup."
(when (> (cdr cache-active) (cdr active))
(setcdr active (cdr cache-active))))))))
-(defun gnus-activate-group (group &optional scan dont-check method)
+(defun gnus-activate-group (group &optional scan dont-check method
+ dont-sub-check)
"Check whether a group has been activated or not.
If SCAN, request a scan of that group as well."
(let ((method (or method (inline (gnus-find-method-for-group group))))
@@ -1538,9 +1542,11 @@ If SCAN, request a scan of that group as well."
(gnus-request-scan group method))
t)
(if (or debug-on-error debug-on-quit)
- (inline (gnus-request-group group dont-check method))
+ (inline (gnus-request-group group (or dont-sub-check dont-check)
+ method))
(condition-case nil
- (inline (gnus-request-group group dont-check method))
+ (inline (gnus-request-group group (or dont-sub-check dont-check)
+ method))
;;(error nil)
(quit
(message "Quit activating %s" group)
@@ -1671,18 +1677,22 @@ If SCAN, request a scan of that group as well."
(let* ((newsrc (cdr gnus-newsrc-alist))
(alevel (or level gnus-activate-level (1+ gnus-level-subscribed)))
(foreign-level
- (min
- (cond ((and gnus-activate-foreign-newsgroups
- (not (numberp gnus-activate-foreign-newsgroups)))
- (1+ gnus-level-subscribed))
- ((numberp gnus-activate-foreign-newsgroups)
- gnus-activate-foreign-newsgroups)
- (t 0))
- alevel))
+ (or
+ level
+ (min
+ (cond ((and gnus-activate-foreign-newsgroups
+ (not (numberp gnus-activate-foreign-newsgroups)))
+ (1+ gnus-level-subscribed))
+ ((numberp gnus-activate-foreign-newsgroups)
+ gnus-activate-foreign-newsgroups)
+ (t 0))
+ alevel)))
(methods-cache nil)
(type-cache nil)
- scanned-methods info group active method retrieve-groups cmethod
- method-type)
+ (gnus-agent-article-local-times 0)
+ (archive-method (gnus-server-to-method "archive"))
+ infos info group active method cmethod
+ method-type method-group-list entry)
(gnus-message 6 "Checking new news...")
(while newsrc
@@ -1701,115 +1711,109 @@ If SCAN, request a scan of that group as well."
;; nil for non-foreign groups that the user has requested not be checked
;; t for unchecked foreign groups or bogus groups, or groups that can't
;; be checked, for one reason or other.
- (when (setq method (gnus-info-method info))
+
+ ;; First go through all the groups, see what select methods they
+ ;; belong to, and then collect them into lists per unique select
+ ;; method.
+ (if (not (setq method (gnus-info-method info)))
+ (setq method gnus-select-method)
(if (setq cmethod (assoc method methods-cache))
(setq method (cdr cmethod))
(setq cmethod (inline (gnus-server-get-method nil method)))
(push (cons method cmethod) methods-cache)
(setq method cmethod)))
- (when (and method
- (not (setq method-type (cdr (assoc method type-cache)))))
+ (setq method-group-list (assoc method type-cache))
+ (unless method-group-list
(setq method-type
(cond
- ((gnus-secondary-method-p method)
+ ((or (gnus-secondary-method-p method)
+ (and (gnus-archive-server-wanted-p)
+ (gnus-methods-equal-p archive-method method)))
'secondary)
((inline (gnus-server-equal gnus-select-method method))
'primary)
(t
'foreign)))
- (push (cons method method-type) type-cache))
-
- (cond ((and method (eq method-type 'foreign))
- ;; These groups are foreign. Check the level.
- (if (<= (gnus-info-level info) foreign-level)
- (when (setq active (gnus-activate-group group 'scan))
- ;; Let the Gnus agent save the active file.
- (when (and gnus-agent active (gnus-online method))
- (gnus-agent-save-group-info
- method (gnus-group-real-name group) active))
- (unless (inline (gnus-virtual-group-p group))
- (inline (gnus-close-group group)))
- (when (fboundp (intern (concat (symbol-name (car method))
- "-request-update-info")))
- (inline (gnus-request-update-info info method))))
- (if (and level
- ;; If `active' is nil that means the group has
- ;; never been read, the group should be marked
- ;; as having never been checked (see below).
- active
- (> (gnus-info-level info) level))
- ;; Don't check groups of which levels are higher
- ;; than the one that a user specified.
- (setq active 'ignore))))
- ;; These groups are native or secondary.
- ((> (gnus-info-level info) alevel)
- ;; We don't want these groups.
- (setq active 'ignore))
- ;; Activate groups.
- ((not gnus-read-active-file)
- (if (gnus-check-backend-function 'retrieve-groups group)
- ;; if server support gnus-retrieve-groups we push
- ;; the group onto retrievegroups for later checking
- (if (assoc method retrieve-groups)
- (setcdr (assoc method retrieve-groups)
- (cons group (cdr (assoc method retrieve-groups))))
- (push (list method group) retrieve-groups))
- ;; hack: `nnmail-get-new-mail' changes the mail-source depending
- ;; on the group, so we must perform a scan for every group
- ;; if the users has any directory mail sources.
- ;; hack: if `nnmail-scan-directory-mail-source-once' is non-nil,
- ;; for it scan all spool files even when the groups are
- ;; not required.
- (if (and
- (or nnmail-scan-directory-mail-source-once
- (null (assq 'directory mail-sources)))
- (member method scanned-methods))
- (setq active (gnus-activate-group group))
- (setq active (gnus-activate-group group 'scan))
- (push method scanned-methods))
- (when active
- (gnus-close-group group)))))
-
- ;; Get the number of unread articles in the group.
- (cond
- ((eq active 'ignore)
- ;; Don't do anything.
- )
- (active
- (inline (gnus-get-unread-articles-in-group info active t)))
- (t
- ;; The group couldn't be reached, so we nix out the number of
- ;; unread articles and stuff.
- (gnus-set-active group nil)
- (let ((tmp (gnus-group-entry group)))
- (when tmp
- (setcar tmp t))))))
-
- ;; iterate through groups on methods which support gnus-retrieve-groups
- ;; and fetch a partial active file and use it to find new news.
- (dolist (rg retrieve-groups)
- (let ((method (or (car rg) gnus-select-method))
- (groups (cdr rg)))
- (when (gnus-check-server method)
- ;; Request that the backend scan its incoming messages.
- (when (gnus-check-backend-function 'request-scan (car method))
- (gnus-request-scan nil method))
- (gnus-read-active-file-2
- (mapcar (lambda (group) (gnus-group-real-name group)) groups)
- method)
- (dolist (group groups)
- (cond
- ((setq active (gnus-active (gnus-info-group
- (setq info (gnus-get-info group)))))
- (inline (gnus-get-unread-articles-in-group info active t)))
- (t
- ;; The group couldn't be reached, so we nix out the number of
- ;; unread articles and stuff.
- (gnus-set-active group nil)
- (setcar (gnus-group-entry group) t)))))))
+ (push (setq method-group-list (list method method-type nil))
+ type-cache))
+ ;; Only add groups that need updating.
+ (if (<= (gnus-info-level info)
+ (if (eq (cadr method-group-list) 'foreign)
+ foreign-level
+ alevel))
+ (setcar (nthcdr 2 method-group-list)
+ (cons info (nth 2 method-group-list)))
+ ;; The group is inactive, so we nix out the number of unread articles.
+ ;; It leads `(gnus-group-unread group)' to return t. See also
+ ;; `gnus-group-prepare-flat'.
+ (unless active
+ (when (setq entry (gnus-group-entry group))
+ (setcar entry t)))))
+
+ ;; Sort the methods based so that the primary and secondary
+ ;; methods come first. This is done for legacy reasons to try to
+ ;; ensure that side-effect behaviour doesn't change from previous
+ ;; Gnus versions.
+ (setq type-cache
+ (sort (nreverse type-cache)
+ (lambda (c1 c2)
+ (< (gnus-method-rank (cadr c1) (car c1))
+ (gnus-method-rank (cadr c2) (car c2))))))
+
+ (while type-cache
+ (setq method (nth 0 (car type-cache))
+ method-type (nth 1 (car type-cache))
+ infos (nth 2 (car type-cache)))
+ (pop type-cache)
+ (when (and method
+ infos)
+ ;; See if any of the groups from this method require updating.
+ (gnus-read-active-for-groups method infos)
+ (dolist (info infos)
+ (inline (gnus-get-unread-articles-in-group
+ info (gnus-active (gnus-info-group info)))))))
(gnus-message 6 "Checking new news...done")))
+(defun gnus-method-rank (type method)
+ (cond
+ ;; Get info for virtual groups last.
+ ((eq (car method) 'nnvirtual)
+ 200)
+ ((eq type 'primary)
+ 1)
+ ;; Compute the rank of the secondary methods based on where they
+ ;; are in the secondary select list.
+ ((eq type 'secondary)
+ (let ((i 2))
+ (block nil
+ (dolist (smethod gnus-secondary-select-methods)
+ (when (equal method smethod)
+ (return i))
+ (incf i))
+ i)))
+ ;; Just say that all foreign groups have the same rank.
+ (t
+ 100)))
+
+(defun gnus-read-active-for-groups (method infos)
+ (with-current-buffer nntp-server-buffer
+ (cond
+ ((gnus-check-backend-function 'retrieve-groups (car method))
+ (when (gnus-check-backend-function 'request-scan (car method))
+ (dolist (info infos)
+ (gnus-request-scan (gnus-info-group info) method)))
+ (let (groups)
+ (gnus-read-active-file-2
+ (dolist (info infos (nreverse groups))
+ (push (gnus-group-real-name (gnus-info-group info)) groups))
+ method)))
+ ((gnus-check-backend-function 'request-list (car method))
+ (gnus-read-active-file-1 method nil infos))
+ (t
+ (dolist (info infos)
+ (gnus-activate-group (gnus-info-group info) nil nil method t))))))
+
;; Create a hash table out of the newsrc alist. The `car's of the
;; alist elements are used as keys.
(defun gnus-make-hashtable-from-newsrc-alist ()
@@ -1830,14 +1834,18 @@ If SCAN, request a scan of that group as well."
(if (setq rest (member method methods))
(gnus-info-set-method info (car rest))
(push method methods)))
- (gnus-sethash
- (car info)
- ;; Preserve number of unread articles in groups.
- (cons (and ohashtb (car (gnus-gethash (car info) ohashtb)))
- prev)
- gnus-newsrc-hashtb)
- (setq prev alist
- alist (cdr alist)))
+ ;; Check for duplicates.
+ (if (gnus-gethash (car info) gnus-newsrc-hashtb)
+ ;; Remove this entry from the alist.
+ (setcdr prev (cddr prev))
+ (gnus-sethash
+ (car info)
+ ;; Preserve number of unread articles in groups.
+ (cons (and ohashtb (car (gnus-gethash (car info) ohashtb)))
+ prev)
+ gnus-newsrc-hashtb)
+ (setq prev alist))
+ (setq alist (cdr alist)))
;; Make the same select-methods in `gnus-server-alist' identical
;; as well.
(while methods
@@ -2030,7 +2038,7 @@ If SCAN, request a scan of that group as well."
(message "Quit reading the active file")
nil))))))))
-(defun gnus-read-active-file-1 (method force)
+(defun gnus-read-active-file-1 (method force &optional infos)
(let (where mesg)
(setq where (nth 1 method)
mesg (format "Reading active file%s via %s..."
@@ -2040,8 +2048,14 @@ If SCAN, request a scan of that group as well."
(gnus-message 5 mesg)
(when (gnus-check-server method)
;; Request that the backend scan its incoming messages.
- (when (gnus-check-backend-function 'request-scan (car method))
- (gnus-request-scan nil method))
+ (when (and (or (and gnus-agent
+ (gnus-online method))
+ (not gnus-agent))
+ (gnus-check-backend-function 'request-scan (car method)))
+ (if infos
+ (dolist (info infos)
+ (gnus-request-scan (gnus-info-group info) method))
+ (gnus-request-scan nil method)))
(cond
((and (eq gnus-read-active-file 'some)
(gnus-check-backend-function 'retrieve-groups (car method))
@@ -3192,7 +3206,4 @@ If this variable is nil, don't do anything."
(provide 'gnus-start)
-;; arch-tag: f4584a22-b7b7-4853-abfc-a637329af5d2
;;; gnus-start.el ends here
-
-
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 93024e0728..df20456b27 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -76,6 +76,13 @@ See `gnus-group-goto-unread'."
:version "23.1" ;; No Gnus
:type 'boolean)
+(defcustom gnus-summary-stop-at-end-of-message nil
+ "If non-nil, don't select the next message when using `SPC'."
+ :link '(custom-manual "(gnus)Group Maneuvering")
+ :group 'gnus-summary-maneuvering
+ :version "24.1"
+ :type 'boolean)
+
(defcustom gnus-fetch-old-headers nil
"*Non-nil means that Gnus will try to build threads by grabbing old headers.
If an unread article in the group refers to an older, already
@@ -214,7 +221,7 @@ This variable will only be used if the value of
:group 'gnus-summary-format
:type 'string)
-(defcustom gnus-summary-goto-unread t
+(defcustom gnus-summary-goto-unread nil
"*If t, many commands will go to the next unread article.
This applies to marking commands as well as other commands that
\"naturally\" select the next article, like, for instance, `SPC' at
@@ -224,6 +231,7 @@ If nil, the marking commands do NOT go to the next unread article
\(they go to the next article instead). If `never', commands that
usually go to the next unread article, will go to the next article,
whether it is read or not."
+ :version "24.1"
:group 'gnus-summary-marks
:link '(custom-manual "(gnus)Setting Marks")
:type '(choice (const :tag "off" nil)
@@ -342,7 +350,7 @@ newsgroups, set the variable to nil in `gnus-select-group-hook'."
:type '(choice (const :tag "none" nil)
(sexp :menu-tag "first" t)))
-(defcustom gnus-auto-select-subject 'unread
+(defcustom gnus-auto-select-subject 'unseen-or-unread
"*Says what subject to place under point when entering a group.
This variable can either be the symbols `first' (place point on the
@@ -353,7 +361,7 @@ the first unseen article), `unseen-or-unread' (place point on the subject
line of the first unseen article or, if all article have been seen, on the
subject line of the first unread article), or a function to be called to
place point on some subject line."
- :version "22.1"
+ :version "24.1"
:group 'gnus-group-select
:type '(choice (const best)
(const unread)
@@ -457,9 +465,10 @@ and non-`vertical', do both horizontal and vertical recentering."
:group 'gnus-summary
:type 'boolean)
-(defcustom gnus-single-article-buffer t
+(defcustom gnus-single-article-buffer nil
"*If non-nil, display all articles in the same buffer.
If nil, each group will get its own article buffer."
+ :version "24.1"
:group 'gnus-article-various
:type 'boolean)
@@ -531,11 +540,6 @@ string with the suggested prefix."
:group 'gnus-summary-marks
:type 'character)
-(defcustom gnus-souped-mark ?F
- "*Mark used for souped articles."
- :group 'gnus-summary-marks
- :type 'character)
-
(defcustom gnus-kill-file-mark ?X
"*Mark used for articles killed by kill files."
:group 'gnus-summary-marks
@@ -659,9 +663,9 @@ string with the suggested prefix."
(defcustom gnus-auto-expirable-marks
(list gnus-killed-mark gnus-del-mark gnus-catchup-mark
gnus-low-score-mark gnus-ancient-mark gnus-read-mark
- gnus-souped-mark gnus-duplicate-mark)
+ gnus-duplicate-mark)
"*The list of marks converted into expiration if a group is auto-expirable."
- :version "21.1"
+ :version "24.1"
:group 'gnus-summary
:type '(repeat character))
@@ -981,8 +985,7 @@ This hook is not called from the non-updating exit commands like `Q'."
:group 'gnus-various
:type 'hook)
-(defcustom gnus-summary-update-hook
- (list 'gnus-summary-highlight-line)
+(defcustom gnus-summary-update-hook nil
"*A hook called when a summary line is changed.
The hook will not be called if `gnus-visual' is nil.
@@ -1251,7 +1254,7 @@ type of files to save."
"Whether Gnus should parse all headers made available to it.
This is mostly relevant for slow back ends where the user may
wish to widen the summary buffer to include all headers
-that were fetched. Say, for nnultimate groups."
+that were fetched."
:version "22.1"
:group 'gnus-summary
:type '(choice boolean regexp))
@@ -1853,7 +1856,6 @@ increase the score of each group you read."
"=" gnus-summary-expand-window
"\C-x\C-s" gnus-summary-reselect-current-group
"\M-g" gnus-summary-rescan-group
- "w" gnus-summary-stop-page-breaking
"\C-c\C-r" gnus-summary-caesar-message
"f" gnus-summary-followup
"F" gnus-summary-followup-with-original
@@ -1875,7 +1877,6 @@ increase the score of each group you read."
[follow-link] mouse-face
"m" gnus-summary-mail-other-window
"a" gnus-summary-post-news
- "i" gnus-summary-news-other-window
"x" gnus-summary-limit-to-unread
"s" gnus-summary-isearch-article
"t" gnus-summary-toggle-header
@@ -2108,6 +2109,7 @@ increase the score of each group you read."
"d" gnus-article-display-face
"s" gnus-treat-smiley
"D" gnus-article-remove-images
+ "W" gnus-html-show-images
"f" gnus-treat-from-picon
"m" gnus-treat-mail-picon
"n" gnus-treat-newsgroups-picon)
@@ -2175,8 +2177,7 @@ increase the score of each group you read."
"h" gnus-summary-save-article-folder
"v" gnus-summary-save-article-vm
"p" gnus-summary-pipe-output
- "P" gnus-summary-muttprint
- "s" gnus-soup-add-article)
+ "P" gnus-summary-muttprint)
(gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map)
"b" gnus-summary-display-buttonized
@@ -2440,7 +2441,6 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
["Save in RMAIL mbox..." gnus-summary-save-article-rmail t]
["Save body in file..." gnus-summary-save-article-body-file t]
["Pipe through a filter..." gnus-summary-pipe-output t]
- ["Add to SOUP packet" gnus-soup-add-article t]
["Print with Muttprint..." gnus-summary-muttprint t]
["Print" gnus-summary-print-article
,@(if (featurep 'xemacs) '(t)
@@ -3406,8 +3406,10 @@ marks of articles."
(save-excursion
(let (config)
(goto-char (point-min))
- (while (search-forward "\r" nil t)
- (push (1- (point)) config))
+ (while (not (eobp))
+ (when (eq (get-char-property (point-at-eol) 'invisible) 'gnus-sum)
+ (push (save-excursion (forward-line 0) (point)) config))
+ (forward-line 1))
config)))
(defun gnus-restore-hidden-threads-configuration (config)
@@ -3415,10 +3417,8 @@ marks of articles."
(save-excursion
(let (point (inhibit-read-only t))
(while (setq point (pop config))
- (when (and (< point (point-max))
- (goto-char point)
- (eq (char-after) ?\n))
- (subst-char-in-region point (1+ point) ?\n ?\r))))))
+ (goto-char point)
+ (gnus-summary-hide-thread)))))
;; Various summary mode internalish functions.
@@ -3752,6 +3752,7 @@ buffer that was in action when the last article was fetched."
(error (gnus-message 5 "Error updating the summary line")))
(when (gnus-visual-p 'summary-highlight 'highlight)
(forward-line -1)
+ (gnus-summary-highlight-line)
(gnus-run-hooks 'gnus-summary-update-hook)
(forward-line 1))))
@@ -3784,6 +3785,7 @@ buffer that was in action when the last article was fetched."
'score))
;; Do visual highlighting.
(when (gnus-visual-p 'summary-highlight 'highlight)
+ (gnus-summary-highlight-line)
(gnus-run-hooks 'gnus-summary-update-hook)))))
(defvar gnus-tmp-new-adopts nil)
@@ -5362,7 +5364,9 @@ or a straight list of headers."
'gnus-number number)
(when gnus-visual-p
(forward-line -1)
- (gnus-run-hooks 'gnus-summary-update-hook)
+ (gnus-summary-highlight-line)
+ (when gnus-summary-update-hook
+ (gnus-run-hooks 'gnus-summary-update-hook))
(forward-line 1))
(setq gnus-tmp-prev-subject simp-subject)))
@@ -6050,9 +6054,7 @@ If WHERE is `summary', the summary mode line format will be used."
(when (> (length mode-string) max-len)
(setq mode-string
(concat (truncate-string-to-width mode-string (- max-len 3))
- "...")))
- ;; Pad the mode string a bit.
- (setq mode-string (format (format "%%-%ds" max-len) mode-string))))
+ "...")))))
;; Update the mode line.
(setq mode-line-buffer-identification
(gnus-mode-line-buffer-identification (list mode-string)))
@@ -7781,7 +7783,7 @@ Also see the variable `gnus-article-skip-boring'."
(setq endp (or (gnus-article-next-page lines)
(gnus-article-only-boring-p))))
(when endp
- (cond (stop
+ (cond ((or stop gnus-summary-stop-at-end-of-message)
(gnus-message 3 "End of message"))
(circular
(gnus-summary-beginning-of-article))
@@ -8300,7 +8302,7 @@ If ALL is non-nil, limit strictly to unread articles."
gnus-killed-mark gnus-spam-mark gnus-kill-file-mark
gnus-low-score-mark gnus-expirable-mark
gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark
- gnus-duplicate-mark gnus-souped-mark)
+ gnus-duplicate-mark)
'reverse)))
(defun gnus-summary-limit-to-headers (match &optional reverse)
@@ -9518,7 +9520,7 @@ IDNA encoded domain names looks like `xn--bar'. If a string
remain unencoded after running this function, it is likely an
invalid IDNA string (`xn--bar' is invalid).
-You must have GNU Libidn (`http://www.gnu.org/software/libidn/')
+You must have GNU Libidn (URL `http://www.gnu.org/software/libidn/')
installed for this command to work."
(interactive "P")
(if (not (and (condition-case nil (require 'idna)
@@ -9848,12 +9850,14 @@ ACTION can be either `move' (the default), `crosspost' or `copy'."
;;;!!!Why is this necessary?
(set-buffer gnus-summary-buffer)
- (gnus-summary-goto-subject article)
(when (eq action 'move)
- (gnus-summary-mark-article article gnus-canceled-mark))))
+ (save-excursion
+ (gnus-summary-goto-subject article)
+ (gnus-summary-mark-article article gnus-canceled-mark)))))
(push article articles-to-update-marks))
- (apply 'gnus-summary-remove-process-mark articles-to-update-marks)
+ (save-excursion
+ (apply 'gnus-summary-remove-process-mark articles-to-update-marks))
;; Re-activate all groups that have been moved to.
(with-current-buffer gnus-group-buffer
(let ((gnus-group-marked to-groups))
@@ -10109,19 +10113,20 @@ confirmation before the articles are deleted."
;; Delete the articles.
(setq not-deleted (gnus-request-expire-articles
articles gnus-newsgroup-name 'force))
- (while articles
- (gnus-summary-remove-process-mark (car articles))
- ;; The backend might not have been able to delete the article
- ;; after all.
- (unless (memq (car articles) not-deleted)
- (gnus-summary-mark-article (car articles) gnus-canceled-mark))
- (let* ((article (car articles))
- (ghead (gnus-data-header
- (assoc article (gnus-data-list nil)))))
- (run-hook-with-args 'gnus-summary-article-delete-hook
- 'delete ghead gnus-newsgroup-name nil
- nil))
- (setq articles (cdr articles)))
+ (save-excursion
+ (while articles
+ (gnus-summary-remove-process-mark (car articles))
+ ;; The backend might not have been able to delete the article
+ ;; after all.
+ (unless (memq (car articles) not-deleted)
+ (gnus-summary-mark-article (car articles) gnus-canceled-mark))
+ (let* ((article (car articles))
+ (ghead (gnus-data-header
+ (assoc article (gnus-data-list nil)))))
+ (run-hook-with-args 'gnus-summary-article-delete-hook
+ 'delete ghead gnus-newsgroup-name nil
+ nil))
+ (setq articles (cdr articles))))
(when not-deleted
(gnus-message 4 "Couldn't delete articles %s" not-deleted)))
(gnus-summary-position-point)
@@ -10732,6 +10737,7 @@ If NO-EXPIRE, auto-expiry will be inhibited."
(t gnus-no-mark))
'replied)
(when (gnus-visual-p 'summary-highlight 'highlight)
+ (gnus-summary-highlight-line)
(gnus-run-hooks 'gnus-summary-update-hook))
t)
@@ -12626,6 +12632,8 @@ If ALL is a number, fetch this number of articles."
(declare-function bookmark-prop-get "bookmark" (bookmark prop))
(declare-function bookmark-default-handler "bookmark" (bmk))
(declare-function bookmark-get-bookmark-record "bookmark" (bmk))
+(defvar bookmark-yank-point)
+(defvar bookmark-current-buffer)
(defun gnus-summary-bookmark-make-record ()
"Make a bookmark entry for a Gnus summary buffer."
@@ -12688,5 +12696,4 @@ BOOKMARK is a bookmark name or a bookmark record."
;; coding: iso-8859-1
;; End:
-;; arch-tag: 17c6748f-6d00-4d36-bf01-835c42f31235
;;; gnus-sum.el ends here
diff --git a/lisp/gnus/gnus-sync.el b/lisp/gnus/gnus-sync.el
new file mode 100644
index 0000000000..c0e52b6a8b
--- /dev/null
+++ b/lisp/gnus/gnus-sync.el
@@ -0,0 +1,233 @@
+;;; gnus-sync.el --- synchronization facility for Gnus
+
+;; Copyright (C) 2010 Free Software Foundation, Inc.
+
+;; Author: Ted Zlatanov <[email protected]>
+;; Keywords: news synchronization nntp nnrss
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This is the gnus-sync.el package.
+
+;; Put this in your startup file (~/.gnus.el for instance)
+
+;; possibilities for gnus-sync-backend:
+;; Tramp over SSH: /ssh:user@host:/path/to/filename
+;; Tramp over IMAP: /imaps:[email protected]:/INBOX.test/filename
+;; ...or any other file Tramp and Emacs can handle...
+
+;; (setq gnus-sync-backend "/remote:/path.gpg" ; will use Tramp+EPA if loaded
+;; gnus-sync-global-vars `(gnus-newsrc-last-checked-date)
+;; gnus-sync-newsrc-groups `("nntp" "nnrss")
+;; gnus-sync-newsrc-offsets `(2 3))
+
+;; TODO:
+
+;; - after gnus-sync-read, the message counts are wrong
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'gnus)
+(require 'gnus-start)
+(require 'gnus-util)
+
+(defgroup gnus-sync nil
+ "The Gnus synchronization facility."
+ :version "24.1"
+ :group 'gnus)
+
+(defcustom gnus-sync-newsrc-groups `("nntp" "nnrss")
+ "List of groups to be synchronized in the gnus-newsrc-alist.
+The group names are matched, they don't have to be fully
+qualified. Typically you would choose all of these. That's the
+default because there is no active sync backend by default, so
+this setting is harmless until the user chooses a sync backend."
+ :group 'gnus-sync
+ :type '(repeat regexp))
+
+(defcustom gnus-sync-newsrc-offsets '(2 3)
+ "List of per-group data to be synchronized."
+ :group 'gnus-sync
+ :type '(set (const :tag "Read ranges" 2)
+ (const :tag "Marks" 3)))
+
+(defcustom gnus-sync-global-vars nil
+ "List of global variables to be synchronized.
+You may want to sync `gnus-newsrc-last-checked-date' but pretty
+much any symbol is fair game. You could additionally sync
+`gnus-newsrc-alist', `gnus-server-alist', `gnus-topic-topology',
+and `gnus-topic-alist' to cover all the variables in
+newsrc.eld (except for `gnus-format-specs' which should not be
+synchronized, I believe). Also see `gnus-variable-list'."
+ :group 'gnus-sync
+ :type '(repeat (choice (variable :tag "A known variable")
+ (symbol :tag "Any symbol"))))
+
+(defcustom gnus-sync-backend nil
+ "The synchronization backend."
+ :group 'gnus-sync
+ :type '(radio (const :format "None" nil)
+ (string :tag "Sync to a file")))
+
+(defvar gnus-sync-newsrc-loader nil
+ "Carrier for newsrc data")
+
+(defun gnus-sync-save ()
+"Save the Gnus sync data to the backend."
+ (interactive)
+ (cond
+ ((stringp gnus-sync-backend)
+ (gnus-message 7 "gnus-sync: saving to backend %s" gnus-sync-backend)
+ ;; populate gnus-sync-newsrc-loader from all but the first dummy
+ ;; entry in gnus-newsrc-alist whose group matches any of the
+ ;; gnus-sync-newsrc-groups
+ ;; TODO: keep the old contents for groups we don't have!
+ (let ((gnus-sync-newsrc-loader
+ (loop for entry in (cdr gnus-newsrc-alist)
+ when (gnus-grep-in-list
+ (car entry) ;the group name
+ gnus-sync-newsrc-groups)
+ collect (cons (car entry)
+ (mapcar (lambda (offset)
+ (cons offset (nth offset entry)))
+ gnus-sync-newsrc-offsets)))))
+ (with-temp-file gnus-sync-backend
+ (progn
+ (let ((coding-system-for-write gnus-ding-file-coding-system)
+ (standard-output (current-buffer)))
+ (princ (format ";; -*- mode:emacs-lisp; coding: %s; -*-\n"
+ gnus-ding-file-coding-system))
+ (princ ";; Gnus sync data v. 0.0.1\n")
+ (let* ((print-quoted t)
+ (print-readably t)
+ (print-escape-multibyte nil)
+ (print-escape-nonascii t)
+ (print-length nil)
+ (print-level nil)
+ (print-circle nil)
+ (print-escape-newlines t)
+ (variables (cons 'gnus-sync-newsrc-loader
+ gnus-sync-global-vars))
+ variable)
+ (while variables
+ (if (and (boundp (setq variable (pop variables)))
+ (symbol-value variable))
+ (progn
+ (princ "\n(setq ")
+ (princ (symbol-name variable))
+ (princ " '")
+ (prin1 (symbol-value variable))
+ (princ ")\n"))
+ (princ "\n;;; skipping empty variable ")
+ (princ (symbol-name variable)))))
+ (gnus-message
+ 7
+ "gnus-sync: stored variables %s and %d groups in %s"
+ gnus-sync-global-vars
+ (length gnus-sync-newsrc-loader)
+ gnus-sync-backend)
+
+ ;; Idea from Dan Christensen <[email protected]>
+ ;; Save the .eld file with extra line breaks.
+ (gnus-message 8 "gnus-sync: adding whitespace to %s"
+ gnus-sync-backend)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "^(\\|(\\\"" nil t)
+ (replace-match "\n\\&" t))
+ (goto-char (point-min))
+ (while (re-search-forward " $" nil t)
+ (replace-match "" t t))))))))
+ ;; the pass-through case: gnus-sync-backend is not a known choice
+ (nil)))
+
+(defun gnus-sync-read ()
+"Load the Gnus sync data from the backend."
+ (interactive)
+ (when gnus-sync-backend
+ (gnus-message 7 "gnus-sync: loading from backend %s" gnus-sync-backend)
+ (cond ((stringp gnus-sync-backend)
+ ;; read data here...
+ (if (or debug-on-error debug-on-quit)
+ (load gnus-sync-backend nil t)
+ (condition-case var
+ (load gnus-sync-backend nil t)
+ (error
+ (error "Error in %s: %s" gnus-sync-backend (cadr var)))))
+ (let ((valid-count 0)
+ invalid-groups)
+ (dolist (node gnus-sync-newsrc-loader)
+ (if (gnus-gethash (car node) gnus-newsrc-hashtb)
+ (progn
+ (incf valid-count)
+ (loop for store in (cdr node)
+ do (setf (nth (car store)
+ (assoc (car node) gnus-newsrc-alist))
+ (cdr store))))
+ (push (car node) invalid-groups)))
+ (gnus-message
+ 7
+ "gnus-sync: loaded %d groups (out of %d) from %s"
+ valid-count (length gnus-sync-newsrc-loader)
+ gnus-sync-backend)
+ (when invalid-groups
+ (gnus-message
+ 7
+ "gnus-sync: skipped %d groups (out of %d) from %s"
+ (length invalid-groups)
+ (length gnus-sync-newsrc-loader)
+ gnus-sync-backend)
+ (gnus-message 9 "gnus-sync: skipped groups: %s"
+ (mapconcat 'identity invalid-groups ", ")))))
+ (nil))
+ ;; make the hashtable again because the newsrc-alist may have been modified
+ (when gnus-sync-newsrc-offsets
+ (gnus-message 9 "gnus-sync: remaking the newsrc hashtable")
+ (gnus-make-hashtable-from-newsrc-alist))))
+
+;;;###autoload
+(defun gnus-sync-initialize ()
+"Initialize the Gnus sync facility."
+ (interactive)
+ (gnus-message 5 "Initializing the sync facility")
+ (gnus-sync-install-hooks))
+
+;;;###autoload
+(defun gnus-sync-install-hooks ()
+ "Install the sync hooks."
+ (interactive)
+ ;; (add-hook 'gnus-get-new-news-hook 'gnus-sync-read)
+ (add-hook 'gnus-save-newsrc-hook 'gnus-sync-save)
+ (add-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read))
+
+(defun gnus-sync-unload-hook ()
+ "Uninstall the sync hooks."
+ (interactive)
+ ;; (remove-hook 'gnus-get-new-news-hook 'gnus-sync-read)
+ (remove-hook 'gnus-save-newsrc-hook 'gnus-sync-save)
+ (remove-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read))
+
+(add-hook 'gnus-sync-unload-hook 'gnus-sync-unload-hook)
+
+;; this is harmless by default, until the gnus-sync-backend is set
+(gnus-sync-initialize)
+
+(provide 'gnus-sync)
+
+;;; gnus-sync.el ends here
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el
index b99f1772d5..89e61bcb59 100644
--- a/lisp/gnus/gnus-topic.el
+++ b/lisp/gnus/gnus-topic.el
@@ -1779,5 +1779,4 @@ If REVERSE, reverse the sorting order."
(provide 'gnus-topic)
-;; arch-tag: bf176856-f30c-40f0-ae77-e41529a1134c
;;; gnus-topic.el ends here
diff --git a/lisp/gnus/gnus-undo.el b/lisp/gnus/gnus-undo.el
index d11b778f35..5c45d3241d 100644
--- a/lisp/gnus/gnus-undo.el
+++ b/lisp/gnus/gnus-undo.el
@@ -188,5 +188,4 @@ A numeric argument serves as a repeat count."
(provide 'gnus-undo)
-;; arch-tag: 0d787bc7-787d-499a-837f-211d2cb07f2e
;;; gnus-undo.el ends here
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index b8a1c266c9..7cdb70a358 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -1297,6 +1297,14 @@ Return the modified alist."
(setq alist (delq entry alist)))
alist)))
+(defun gnus-grep-in-list (word list)
+ "Find if a WORD matches any regular expression in the given LIST."
+ (when (and word list)
+ (catch 'found
+ (dolist (r list)
+ (when (string-match r word)
+ (throw 'found r))))))
+
(defmacro gnus-pull (key alist &optional assoc-p)
"Modify ALIST to be without KEY."
(unless (symbolp alist)
@@ -1572,11 +1580,9 @@ SPEC is a predicate specifier that contains stuff like `or', `and',
(car (symbol-value history))))
(defun gnus-graphic-display-p ()
- (or (and (fboundp 'display-graphic-p)
- (display-graphic-p))
- ;;;!!!This is bogus. Fixme!
- (and (featurep 'xemacs)
- t)))
+ (if (featurep 'xemacs)
+ (device-on-window-system-p)
+ (display-graphic-p)))
(put 'gnus-parse-without-error 'lisp-indent-function 0)
(put 'gnus-parse-without-error 'edebug-form-spec '(body))
@@ -1891,5 +1897,4 @@ is allowed once again. (Immediately, if `inhibit-quit' is nil.)"
(provide 'gnus-util)
-;; arch-tag: f94991af-d32b-4c97-8c26-ca12a934de49
;;; gnus-util.el ends here
diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el
index 86cd78cefa..35120eae76 100644
--- a/lisp/gnus/gnus-uu.el
+++ b/lisp/gnus/gnus-uu.el
@@ -2170,5 +2170,4 @@ If no file has been included, the user will be asked for a file."
(provide 'gnus-uu)
-;; arch-tag: 05312384-0a83-4720-9a58-b3160b888853
;;; gnus-uu.el ends here
diff --git a/lisp/gnus/gnus-vm.el b/lisp/gnus/gnus-vm.el
index 2684ecc8c0..9ca7813702 100644
--- a/lisp/gnus/gnus-vm.el
+++ b/lisp/gnus/gnus-vm.el
@@ -103,5 +103,4 @@ save those articles instead."
(provide 'gnus-vm)
-;; arch-tag: 42ca7f88-a12f-461d-be3e-cac7efb44866
;;; gnus-vm.el ends here
diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el
index 93f77634b7..4956be9fd8 100644
--- a/lisp/gnus/gnus-win.el
+++ b/lisp/gnus/gnus-win.el
@@ -590,5 +590,4 @@ should have point."
(provide 'gnus-win)
-;; arch-tag: ccd5a394-2ddf-4397-b8f8-6d80d3e46e2b
;;; gnus-win.el ends here
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index b07dfc648c..797f8a44bd 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -7,6 +7,7 @@
;; Author: Masanobu UMEDA <[email protected]>
;; Lars Magne Ingebrigtsen <[email protected]>
;; Keywords: news, mail
+;; Version: 5.13
;; This file is part of GNU Emacs.
@@ -1057,14 +1058,14 @@ be set in `.emacs' instead."
(symbol-value 'image-load-path))
(t load-path)))
(image (find-image
- `((:type svg :file "gnus.svg")
- (:type png :file "gnus.png")
- (:type xpm :file "gnus.xpm"
+ `((:type xpm :file "gnus.xpm"
:color-symbols
(("thing" . ,(car gnus-logo-colors))
("shadow" . ,(cadr gnus-logo-colors))
("oort" . "#eeeeee")
("background" . ,(face-background 'default))))
+ (:type svg :file "gnus.svg")
+ (:type png :file "gnus.png")
(:type pbm :file "gnus.pbm"
;; Account for the pbm's blackground.
:background ,(face-foreground 'gnus-splash)
@@ -1442,7 +1443,7 @@ Obsolete variable; use `message-user-organization' instead.")
;; Customization variables
-(defcustom gnus-refer-article-method nil
+(defcustom gnus-refer-article-method 'current
"Preferred method for fetching an article by Message-ID.
If you are reading news from the local spool (with nnspool), fetching
articles by Message-ID is painfully slow. By setting this method to an
@@ -1454,6 +1455,7 @@ in the documentation of `gnus-select-method'.
It can also be a list of select methods, as well as the special symbol
`current', which means to use the current select method. If it is a
list, Gnus will try all the methods in the list until it finds a match."
+ :version "24.1"
:group 'gnus-server
:type '(choice (const :tag "default" nil)
(const current)
@@ -1739,19 +1741,11 @@ slower."
("nneething" none address prompt-address physical-address)
("nndoc" none address prompt-address)
("nnbabyl" mail address respool)
- ("nnkiboze" post virtual)
- ("nnsoup" post-mail address)
("nndraft" post-mail)
("nnfolder" mail respool address)
("nngateway" post-mail address prompt-address physical-address)
("nnweb" none)
- ("nngoogle" post)
- ("nnslashdot" post)
- ("nnultimate" none)
("nnrss" none)
- ("nnwfm" none)
- ("nnwarchive" none)
- ("nnlistserv" none)
("nnagent" post-mail)
("nnimap" post-mail address prompt-address physical-address)
("nnmaildir" mail respool address)
@@ -1774,7 +1768,8 @@ this variable. I think."
(const :format "%v " prompt-address)
(const :format "%v " physical-address)
(const :format "%v " virtual)
- (const respool)))))
+ (const respool))))
+ :version "24.1")
(defun gnus-redefine-select-method-widget ()
"Recomputes the select-method widget based on the value of
@@ -1810,12 +1805,11 @@ If this variable is nil, screen refresh may be quicker."
(const summary)
(const tree)))
-;; Added by Keinonen Kari <[email protected]>.
-(defcustom gnus-mode-non-string-length nil
+(defcustom gnus-mode-non-string-length 30
"*Max length of mode-line non-string contents.
If this is nil, Gnus will take space as is needed, leaving the rest
-of the mode line intact. Note that the default of nil is unlikely
-to be desirable; see the manual for further details."
+of the mode line intact."
+ :version "24.1"
:group 'gnus-various
:type '(choice (const nil)
integer))
@@ -2892,10 +2886,6 @@ gnus-registry.el will populate this if it's loaded.")
("rmailsum" rmail-update-summary)
("gnus-audio" :interactive t gnus-audio-play)
("gnus-xmas" gnus-xmas-splash)
- ("gnus-soup" :interactive t
- gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
- gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
- ("nnsoup" nnsoup-pack-replies)
("score-mode" :interactive t gnus-score-mode)
("gnus-mh" gnus-summary-save-article-folder
gnus-Folder-save-name gnus-folder-save-name)
@@ -3027,8 +3017,6 @@ gnus-registry.el will populate this if it's loaded.")
gnus-dup-enter-articles)
("gnus-range" gnus-copy-sequence)
("gnus-eform" gnus-edit-form)
- ("gnus-move" :interactive t
- gnus-group-move-group-to-server gnus-change-server)
("gnus-logic" gnus-score-advanced)
("gnus-undo" gnus-undo-mode gnus-undo-register)
("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next
@@ -3298,12 +3286,12 @@ with a `subscribed' parameter."
(defmacro gnus-string-or (&rest strings)
"Return the first element of STRINGS that is a non-blank string.
STRINGS will be evaluated in normal `or' order."
- `(gnus-string-or-1 ',strings))
+ `(gnus-string-or-1 (list ,@strings)))
(defun gnus-string-or-1 (strings)
(let (string)
(while strings
- (setq string (eval (pop strings)))
+ (setq string (pop strings))
(if (string-match "^[ \t]*$" string)
(setq string nil)
(setq strings nil)))
@@ -3946,8 +3934,7 @@ If SYMBOL, return the value of that symbol in the group parameters.
If you call this function inside a loop, consider using the faster
`gnus-group-fast-parameter' instead."
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(if symbol
(gnus-group-fast-parameter group symbol allow-list)
(nconc
@@ -4106,8 +4093,7 @@ Returns the number of articles marked as read."
(defun gnus-kill-save-kill-buffer ()
(let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
(when (get-file-buffer file)
- (save-excursion
- (set-buffer (get-file-buffer file))
+ (with-current-buffer (get-file-buffer file)
(when (buffer-modified-p)
(save-buffer))
(kill-buffer (current-buffer))))))
@@ -4420,5 +4406,4 @@ prompt the user for the name of an NNTP server to use."
(provide 'gnus)
-;; arch-tag: acebeeab-f331-4f8f-a7ea-89c58c84f636
;;; gnus.el ends here
diff --git a/lisp/gnus/html2text.el b/lisp/gnus/html2text.el
index 1aec654faf..6411eb6256 100644
--- a/lisp/gnus/html2text.el
+++ b/lisp/gnus/html2text.el
@@ -508,5 +508,5 @@ See the documentation for that variable."
;; </Interactive functions>
;;
(provide 'html2text)
-;; arch-tag: e9e57b79-35d4-4de1-a647-e7e01fe56d1e
+
;;; html2text.el ends here
diff --git a/lisp/gnus/ietf-drums.el b/lisp/gnus/ietf-drums.el
index ffcb6fa60e..f72b09c572 100644
--- a/lisp/gnus/ietf-drums.el
+++ b/lisp/gnus/ietf-drums.el
@@ -295,5 +295,4 @@ a list of address strings."
(provide 'ietf-drums)
-;; arch-tag: 379a0191-dbae-4ca6-a0f5-d4202c209ef9
;;; ietf-drums.el ends here
diff --git a/lisp/gnus/legacy-gnus-agent.el b/lisp/gnus/legacy-gnus-agent.el
index b13033b635..3b55220ace 100644
--- a/lisp/gnus/legacy-gnus-agent.el
+++ b/lisp/gnus/legacy-gnus-agent.el
@@ -250,5 +250,4 @@ possible that the hook was persistently saved."
(provide 'legacy-gnus-agent)
-;; arch-tag: 845c7b8a-88f7-4468-b8d7-94e8fc72cf1a
;;; legacy-gnus-agent.el ends here
diff --git a/lisp/gnus/mail-parse.el b/lisp/gnus/mail-parse.el
index a774f82963..e6977705f2 100644
--- a/lisp/gnus/mail-parse.el
+++ b/lisp/gnus/mail-parse.el
@@ -74,5 +74,4 @@
(provide 'mail-parse)
-;; arch-tag: 3e63d75c-c962-4784-ab01-7ba07ca9d2d4
;;; mail-parse.el ends here
diff --git a/lisp/gnus/mail-prsvr.el b/lisp/gnus/mail-prsvr.el
index 5e386f94e2..fb63e58a04 100644
--- a/lisp/gnus/mail-prsvr.el
+++ b/lisp/gnus/mail-prsvr.el
@@ -41,5 +41,4 @@ what the desired charsets is to be ignored.")
(provide 'mail-prsvr)
-;; arch-tag: 9ba878cc-8b43-4f7a-85b1-69b1a9a5d9f5
;;; mail-prsvr.el ends here
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index 46f9169a6a..662b999c28 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -466,10 +466,10 @@ the `mail-source-keyword-map' variable."
;; 1) the auth-sources user and password override everything
;; 2) it avoids macros, so it's cleaner
;; 3) it falls through to the mail-sources and then default values
- (cond
+ (cond
((and
(eq keyword :user)
- (setq user-auth
+ (setq user-auth
(nth 0 (auth-source-user-or-password
'("login" "password")
;; this is "host" in auth-sources
@@ -536,7 +536,7 @@ See `mail-source-bind'."
(t
value)))
-(defun mail-source-fetch (source callback)
+(defun mail-source-fetch (source callback &optional method)
"Fetch mail from SOURCE and call CALLBACK zero or more times.
CALLBACK will be called with the name of the file where (some of)
the mail from SOURCE is put.
@@ -544,6 +544,16 @@ Return the number of files that were found."
(mail-source-bind-common source
(if (or mail-source-plugged plugged)
(save-excursion
+ ;; Special-case the `file' handler since it's so common and
+ ;; just adds noise.
+ (when (or (not (eq (car source) 'file))
+ (mail-source-bind (file source)
+ (file-exists-p path)))
+ (nnheader-message 4 "%sReading incoming mail from %s..."
+ (if method
+ (format "%s: " method)
+ "")
+ (car source)))
(let ((function (cadr (assq (car source) mail-source-fetcher-alist)))
(found 0))
(unless function
@@ -619,6 +629,8 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
0)
(funcall callback mail-source-crash-box info)))
+(defvar mail-source-incoming-last-checked-time nil)
+
(defun mail-source-delete-crash-box ()
(when (file-exists-p mail-source-crash-box)
;; Delete or move the incoming mail out of the way.
@@ -634,9 +646,16 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
(rename-file mail-source-crash-box incoming t)
;; remove old incoming files?
(when (natnump mail-source-delete-incoming)
- (mail-source-delete-old-incoming
- mail-source-delete-incoming
- mail-source-delete-old-incoming-confirm))))))
+ ;; Don't check for old incoming files more than once per day to
+ ;; save a lot of file accesses.
+ (when (or (null mail-source-incoming-last-checked-time)
+ (> (time-to-seconds
+ (time-since mail-source-incoming-last-checked-time))
+ (* 24 60 60)))
+ (setq mail-source-incoming-last-checked-time (current-time))
+ (mail-source-delete-old-incoming
+ mail-source-delete-incoming
+ mail-source-delete-old-incoming-confirm)))))))
(defun mail-source-movemail (from to)
"Move FROM to TO using movemail."
@@ -1145,5 +1164,4 @@ This only works when `display-time' is enabled."
(provide 'mail-source)
-;; arch-tag: 72948025-1d17-4d6c-bb12-ef1aa2c490fd
;;; mail-source.el ends here
diff --git a/lisp/gnus/mailcap.el b/lisp/gnus/mailcap.el
index e725dfcea8..71ffd1225b 100644
--- a/lisp/gnus/mailcap.el
+++ b/lisp/gnus/mailcap.el
@@ -335,7 +335,7 @@ nil means your home directory."
:group 'mailcap)
(defvar mailcap-poor-system-types
- '(ms-dos ms-windows windows-nt win32 w32 mswindows)
+ '(ms-dos windows-nt)
"Systems that don't have a Unix-like directory hierarchy.")
;;;
@@ -1069,5 +1069,4 @@ If FORCE, re-parse even if already parsed."
(provide 'mailcap)
-;; arch-tag: 1fd4f9c9-c305-4d2e-9747-3a4d45baa0bd
;;; mailcap.el ends here
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 947b1bd53e..13706ae55f 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -249,6 +249,15 @@ included. Organization and User-Agent are optional."
:link '(custom-manual "(message)Message Headers")
:type '(repeat sexp))
+(defcustom message-prune-recipient-rules nil
+ "Rules for how to prune the list of recipients when doing wide replies.
+This is a list of regexps and regexp matches."
+ :version "24.1"
+ :group 'message-mail
+ :group 'message-headers
+ :link '(custom-manual "(message)Wide Reply")
+ :type '(repeat regexp))
+
(defcustom message-deletable-headers '(Message-ID Date Lines)
"Headers to be deleted if they already exist and were generated by message previously."
:group 'message-headers
@@ -455,7 +464,7 @@ A value of nil means let mailer mail back a message to report errors."
:link '(custom-manual "(message)Sending Variables")
:type 'boolean)
-(defcustom message-generate-new-buffers 'unique
+(defcustom message-generate-new-buffers 'unsent
"*Say whether to create a new message buffer to compose a message.
Valid values include:
@@ -478,6 +487,7 @@ function
If this is a function, call that function with three parameters:
The type, the To address and the group name (any of these may be nil).
The function should return the new buffer name."
+ :version "24.1"
:group 'message-buffers
:link '(custom-manual "(message)Message Buffers")
:type '(choice (const nil)
@@ -1620,11 +1630,11 @@ If you'd like to make it possible to share draft files between XEmacs
and Emacs, you may use `iso-2022-7bit' for this value at your own risk.
Note that the coding-system `iso-2022-7bit' isn't suitable to all data.")
-(defcustom message-send-mail-partially-limit 1000000
+(defcustom message-send-mail-partially-limit nil
"The limitation of messages sent as message/partial.
The lower bound of message size in characters, beyond which the message
should be sent in several parts. If it is nil, the size is unlimited."
- :version "21.1"
+ :version "24.1"
:group 'message-buffers
:link '(custom-manual "(message)Mail Variables")
:type '(choice (const :tag "unlimited" nil)
@@ -1716,13 +1726,14 @@ functionality to work."
(const :tag "Never" nil)
(const :tag "Always" t)))
-(defcustom message-generate-hashcash (if (executable-find "hashcash") t)
+(defcustom message-generate-hashcash (if (executable-find "hashcash") 'opportunistic)
"*Whether to generate X-Hashcash: headers.
If t, always generate hashcash headers. If `opportunistic',
only generate hashcash headers if it can be done without the user
waiting (i.e., only asynchronously).
You must have the \"hashcash\" binary installed, see `hashcash-path'."
+ :version "24.1"
:group 'message-headers
:link '(custom-manual "(message)Mail Headers")
:type '(choice (const :tag "Always" t)
@@ -1739,6 +1750,7 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'."
(defvar message-mime-part nil)
(defvar message-posting-charset nil)
(defvar message-inserted-headers nil)
+(defvar message-inhibit-ecomplete nil)
;; Byte-compiler warning
(defvar gnus-active-hashtb)
@@ -4091,7 +4103,8 @@ It should typically alter the sending method in some way or other."
(run-hooks 'message-sent-hook))
(message "Sending...done")
;; Do ecomplete address snarfing.
- (when (message-mail-alias-type-p 'ecomplete)
+ (when (and (message-mail-alias-type-p 'ecomplete)
+ (not message-inhibit-ecomplete))
(message-put-addresses-in-ecomplete))
;; Mark the buffer as unmodified and delete auto-save.
(set-buffer-modified-p nil)
@@ -5431,7 +5444,7 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'."
(* 25 25)))
(let ((tm (current-time)))
(concat
- (if (or (memq system-type '(ms-dos emx))
+ (if (or (eq system-type 'ms-dos)
;; message-number-base36 doesn't handle bigints.
(floatp (user-uid)))
(let ((user (downcase (user-login-name))))
@@ -6449,9 +6462,7 @@ are not included."
(setq buffer-file-name (expand-file-name
(concat
(if (memq system-type
- '(ms-dos ms-windows windows-nt
- cygwin cygwin32 win32 w32
- mswindows))
+ '(ms-dos windows-nt cygwin))
"message"
"*message*")
(format-time-string "-%Y%m%d-%H%M%S"))
@@ -6551,7 +6562,7 @@ The function is called with one parameter, a cons cell ..."
(defun message-get-reply-headers (wide &optional to-address address-headers)
(let (follow-to mct never-mct to cc author mft recipients extra)
- ;; Find all relevant headers we need.
+ ;; Find all relevant headers we need.
(save-restriction
(message-narrow-to-headers-or-head)
;; Gmane renames "To". Look at "Original-To", too, if it is present in
@@ -6677,6 +6688,8 @@ want to get rid of this query permanently.")))
(if recip
(setq recipients (delq recip recipients))))))))
+ (setq recipients (message-prune-recipients recipients))
+
;; Build the header alist. Allow the user to be asked whether
;; or not to reply to all recipients in a wide reply.
(setq follow-to (list (cons 'To (cdr (pop recipients)))))
@@ -6690,6 +6703,22 @@ want to get rid of this query permanently.")))
(push (cons 'Cc recipients) follow-to)))
follow-to))
+(defun message-prune-recipients (recipients)
+ (dolist (rule message-prune-recipient-rules)
+ (let ((match (car rule))
+ dup-match
+ address)
+ (dolist (recipient recipients)
+ (setq address (car recipient))
+ (when (string-match match address)
+ (setq dup-match (replace-match (cadr rule) nil nil address))
+ (dolist (recipient recipients)
+ ;; Don't delete the address that triggered this.
+ (when (and (not (eq address (car recipient)))
+ (string-match dup-match (car recipient)))
+ (setq recipients (delq recipient recipients))))))))
+ recipients)
+
(defcustom message-simplify-subject-functions
'(message-strip-list-identifiers
message-strip-subject-re
@@ -7425,6 +7454,7 @@ is for the internal use."
(replace-match "X-From-Line: "))
;; Send it.
(let ((message-inhibit-body-encoding t)
+ (message-inhibit-ecomplete t)
message-required-mail-headers
message-generate-hashcash
rfc2047-encode-encoded-words)
@@ -8230,5 +8260,4 @@ Used in `message-simplify-recipients'."
;; coding: iso-8859-1
;; End:
-;; arch-tag: 94b32cac-4504-4b6c-8181-030ebf380ee0
;;; message.el ends here
diff --git a/lisp/gnus/messcompat.el b/lisp/gnus/messcompat.el
index 1ad63627bb..de67d8ce7e 100644
--- a/lisp/gnus/messcompat.el
+++ b/lisp/gnus/messcompat.el
@@ -89,5 +89,4 @@ variable `mail-header-separator'.")
(provide 'messcompat)
-;; arch-tag: a76673be-905e-4bbd-8966-615370494a7b
;;; messcompat.el ends here
diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el
index fd42abc0ab..5756e46b86 100644
--- a/lisp/gnus/mm-bodies.el
+++ b/lisp/gnus/mm-bodies.el
@@ -302,5 +302,4 @@ decoding. If it is nil, default to `mail-parse-charset'."
(provide 'mm-bodies)
-;; arch-tag: 41104bb6-4443-4ca9-8d5c-ff87ecf27d8d
;;; mm-bodies.el ends here
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 410b4f045d..725adcf559 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -105,10 +105,9 @@
,disposition ,description ,cache ,id))
(defcustom mm-text-html-renderer
- (cond ((executable-find "w3m")
- (if (locate-library "w3m")
- 'w3m
- 'w3m-standalone))
+ (cond ((and (executable-find "w3m")
+ (executable-find "curl"))
+ 'gnus-article-html)
((executable-find "links") 'links)
((executable-find "lynx") 'lynx)
((locate-library "w3") 'w3)
@@ -124,7 +123,7 @@ The defined renderer types are:
`w3' : use Emacs/W3;
`html2text' : use html2text;
nil : use external viewer (default web browser)."
- :version "23.0" ;; No Gnus
+ :version "24.1"
:type '(choice (const w3)
(const w3m :tag "emacs-w3m")
(const w3m-standalone :tag "standalone w3m" )
@@ -1671,5 +1670,4 @@ If RECURSIVE, search recursively."
(provide 'mm-decode)
-;; arch-tag: 4f35d360-56b8-4030-9388-3ed82d359b9b
;;; mm-decode.el ends here
diff --git a/lisp/gnus/mm-encode.el b/lisp/gnus/mm-encode.el
index 0d609e56cb..c6ca4c40d0 100644
--- a/lisp/gnus/mm-encode.el
+++ b/lisp/gnus/mm-encode.el
@@ -223,5 +223,4 @@ This is either `base64' or `quoted-printable'."
(provide 'mm-encode)
-;; arch-tag: 7d01bba4-d469-4851-952b-dc863f84ed66
;;; mm-encode.el ends here
diff --git a/lisp/gnus/mm-extern.el b/lisp/gnus/mm-extern.el
index f40f798789..eee741f7f6 100644
--- a/lisp/gnus/mm-extern.el
+++ b/lisp/gnus/mm-extern.el
@@ -167,5 +167,4 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing."
(provide 'mm-extern)
-;; arch-tag: 9653808e-14d9-4172-86e6-adceaa05378e
;;; mm-extern.el ends here
diff --git a/lisp/gnus/mm-partial.el b/lisp/gnus/mm-partial.el
index f9ee64da10..3fec4a2a97 100644
--- a/lisp/gnus/mm-partial.el
+++ b/lisp/gnus/mm-partial.el
@@ -150,5 +150,4 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing."
(provide 'mm-partial)
-;; arch-tag: 460e7424-05f2-4a1d-a0f2-70ec081eff7d
;;; mm-partial.el ends here
diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el
index c72f520d60..0da136e1ef 100644
--- a/lisp/gnus/mm-url.el
+++ b/lisp/gnus/mm-url.el
@@ -365,15 +365,20 @@ If FOLLOW-REFRESH is non-nil, redirect refresh url in META."
(defun mm-url-decode-entities ()
"Decode all HTML entities."
(goto-char (point-min))
- (while (re-search-forward "&\\(#[0-9]+\\|[a-z]+[0-9]*\\);" nil t)
- (let ((elem (if (eq (aref (match-string 1) 0) ?\#)
- (let ((c (mm-ucs-to-char
- (string-to-number
- (substring (match-string 1) 1)))))
- (if (mm-char-or-char-int-p c) c ?#))
- (or (cdr (assq (intern (match-string 1))
- mm-url-html-entities))
- ?#))))
+ (while (re-search-forward "&\\(#[0-9]+\\|#x[0-9a-f]+\\|[a-z]+[0-9]*\\);" nil t)
+ (let* ((entity (match-string 1))
+ (elem (if (eq (aref entity 0) ?\#)
+ (let ((c (mm-ucs-to-char
+ ;; Hex number: &#x3212
+ (if (eq (aref entity 1) ?x)
+ (string-to-number (substring entity 2)
+ 16)
+ ;; Decimal number: &#23
+ (string-to-number (substring entity 1))))))
+ (if (mm-char-or-char-int-p c) c ?#))
+ (or (cdr (assq (intern entity)
+ mm-url-html-entities))
+ ?#))))
(unless (stringp elem)
(setq elem (char-to-string elem)))
(replace-match elem t t))))
@@ -418,6 +423,8 @@ spaces. Die Die Die."
(mm-url-form-encode-xwfu (cdr data))))
pairs "&"))
+(autoload 'mml-compute-boundary "mml")
+
(defun mm-url-encode-multipart-form-data (pairs &optional boundary)
"Return PAIRS encoded in multipart/form-data."
;; RFC1867
@@ -494,5 +501,4 @@ spaces. Die Die Die."
(provide 'mm-url)
-;; arch-tag: 0594f9b3-417c-48b0-adc2-5082e1e7917f
;;; mm-url.el ends here
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index f657000205..588915a1ab 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -680,7 +680,7 @@ superset of iso-8859-1."
"100% binary coding system.")
(defvar mm-text-coding-system
- (or (if (memq system-type '(windows-nt ms-dos ms-windows))
+ (or (if (memq system-type '(windows-nt ms-dos))
(and (mm-coding-system-p 'raw-text-dos) 'raw-text-dos)
(and (mm-coding-system-p 'raw-text) 'raw-text))
mm-binary-coding-system)
@@ -692,12 +692,12 @@ superset of iso-8859-1."
(defvar mm-auto-save-coding-system
(cond
((mm-coding-system-p 'utf-8-emacs) ; Mule 7
- (if (memq system-type '(windows-nt ms-dos ms-windows))
+ (if (memq system-type '(windows-nt ms-dos))
(if (mm-coding-system-p 'utf-8-emacs-dos)
'utf-8-emacs-dos mm-binary-coding-system)
'utf-8-emacs))
((mm-coding-system-p 'emacs-mule)
- (if (memq system-type '(windows-nt ms-dos ms-windows))
+ (if (memq system-type '(windows-nt ms-dos))
(if (mm-coding-system-p 'emacs-mule-dos)
'emacs-mule-dos mm-binary-coding-system)
'emacs-mule))
@@ -1429,16 +1429,23 @@ If SUFFIX is non-nil, add that at the end of the file name."
;; Reset the umask.
(set-default-file-modes umask)))))
+(defvar mm-image-load-path-cache nil)
+
(defun mm-image-load-path (&optional package)
- (let (dir result)
- (dolist (path load-path (nreverse result))
- (when (and path
- (file-directory-p
- (setq dir (concat (file-name-directory
- (directory-file-name path))
- "etc/images/" (or package "gnus/")))))
- (push dir result))
- (push path result))))
+ (if (and mm-image-load-path-cache
+ (equal load-path (car mm-image-load-path-cache)))
+ (cdr mm-image-load-path-cache)
+ (let (dir result)
+ (dolist (path load-path)
+ (when (and path
+ (file-directory-p
+ (setq dir (concat (file-name-directory
+ (directory-file-name path))
+ "etc/images/" (or package "gnus/")))))
+ (push dir result)))
+ (setq result (nreverse result)
+ mm-image-load-path-cache (cons load-path result))
+ result)))
;; Fixme: This doesn't look useful where it's used.
(if (fboundp 'detect-coding-region)
@@ -1653,5 +1660,4 @@ gzip, bzip2, etc. are allowed."
(provide 'mm-util)
-;; arch-tag: 94dc5388-825d-4fd1-bfa5-2100aa351238
;;; mm-util.el ends here
diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el
index 5ae9205e2f..83b38c8ae1 100644
--- a/lisp/gnus/mm-uu.el
+++ b/lisp/gnus/mm-uu.el
@@ -441,7 +441,7 @@ apply the face `mm-uu-extract'."
(defun mm-uu-yenc-extract ()
;; This might not be exactly correct, but we sure can't get the
;; binary data from the article buffer, since that's already in a
- ;; non-binary charset. So get it from the original article buffer.
+ ;; non-binary charset. So get it from the original article buffer.
(mm-make-handle (with-current-buffer gnus-original-article-buffer
(mm-uu-copy-to-buffer start-point end-point))
(list (or (and file-name
@@ -729,5 +729,4 @@ Assume text has been decoded if DECODED is non-nil."
(provide 'mm-uu)
-;; arch-tag: 7db076bf-53db-4320-aa19-ca76a1d2ab2c
;;; mm-uu.el ends here
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index 42e21cad51..1a2d940e2e 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -688,5 +688,4 @@
(provide 'mm-view)
-;; arch-tag: b60e749a-d05c-47f2-bccd-bdaa59327cb2
;;; mm-view.el ends here
diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el
index 41abfcdc9b..267f6483d2 100644
--- a/lisp/gnus/mml-sec.el
+++ b/lisp/gnus/mml-sec.el
@@ -380,5 +380,4 @@ If called with a prefix argument, only encrypt (do NOT sign)."
(provide 'mml-sec)
-;; arch-tag: 111c56e7-df5e-4287-87d7-93ed2911ec6c
;;; mml-sec.el ends here
diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el
index 827003f8ec..17732997e6 100644
--- a/lisp/gnus/mml-smime.el
+++ b/lisp/gnus/mml-smime.el
@@ -554,5 +554,4 @@ Content-Disposition: attachment; filename=smime.p7m
(provide 'mml-smime)
-;; arch-tag: f1bf94d4-f2cd-4c6f-b059-ad69492817e2
;;; mml-smime.el ends here
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index 2ebd7996d7..15b1bb7096 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -120,10 +120,10 @@ match found will be used."
,dispositions))))
:group 'message)
-(defcustom mml-insert-mime-headers-always nil
+(defcustom mml-insert-mime-headers-always t
"If non-nil, always put Content-Type: text/plain at top of empty parts.
It is necessary to work against a bug in certain clients."
- :version "22.1"
+ :version "24.1"
:type 'boolean
:group 'message)
@@ -1570,5 +1570,4 @@ or the `pop-to-buffer' function."
(provide 'mml)
-;; arch-tag: 583c96cf-1ffe-451b-a5e5-4733ae9ddd12
;;; mml.el ends here
diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el
index 3ba479574f..8f9076cbc3 100644
--- a/lisp/gnus/mml1991.el
+++ b/lisp/gnus/mml1991.el
@@ -521,5 +521,4 @@ If no one is selected, default secret key is used. "
;; coding: iso-8859-1
;; End:
-;; arch-tag: e542be18-ab28-4393-9b33-97fe9cf30706
;;; mml1991.el ends here
diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el
index 977f4dabb6..838813e0f1 100644
--- a/lisp/gnus/mml2015.el
+++ b/lisp/gnus/mml2015.el
@@ -1420,5 +1420,4 @@ If no one is selected, default secret key is used. "
(provide 'mml2015)
-;; arch-tag: b04701d5-0b09-44d8-bed8-de901bf435f2
;;; mml2015.el ends here
diff --git a/lisp/gnus/nnagent.el b/lisp/gnus/nnagent.el
index afacb61c3b..263d721dad 100644
--- a/lisp/gnus/nnagent.el
+++ b/lisp/gnus/nnagent.el
@@ -121,7 +121,7 @@
(deffoo nnagent-request-set-mark (group action server)
(mm-with-unibyte-buffer
(insert "(gnus-agent-synchronize-group-flags \""
- group
+ group
"\" '")
(gnus-pp action)
(insert " \""
@@ -151,7 +151,7 @@
;; Assume that articles with smaller numbers than the first one
;; Agent knows are gone.
(setq first (caar gnus-agent-article-alist))
- (when first
+ (when first
(while (and arts (< (car arts) first))
(pop arts)))
(set-buffer nntp-server-buffer)
@@ -261,5 +261,4 @@
(provide 'nnagent)
-;; arch-tag: af710b77-f816-4969-af31-6fd94fb42245
;;; nnagent.el ends here
diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el
index 121dbbda78..58e848bcb5 100644
--- a/lisp/gnus/nnbabyl.el
+++ b/lisp/gnus/nnbabyl.el
@@ -344,7 +344,7 @@
(while (re-search-backward "^X-Gnus-Newsgroup: " beg t)
(delete-region (point) (progn (forward-line 1) (point)))))
(when nnmail-cache-accepted-message-ids
- (nnmail-cache-insert (nnmail-fetch-field "message-id")
+ (nnmail-cache-insert (nnmail-fetch-field "message-id")
group
(nnmail-fetch-field "subject")
(nnmail-fetch-field "from")))
@@ -363,7 +363,7 @@
(insert-buffer-substring buf)
(when last
(when nnmail-cache-accepted-message-ids
- (nnmail-cache-insert (nnmail-fetch-field "message-id")
+ (nnmail-cache-insert (nnmail-fetch-field "message-id")
group
(nnmail-fetch-field "subject")
(nnmail-fetch-field "from")))
@@ -663,5 +663,4 @@
(provide 'nnbabyl)
-;; arch-tag: aa7ddedb-8c07-4c0e-beb0-58e795c2b81b
;;; nnbabyl.el ends here
diff --git a/lisp/gnus/nndb.el b/lisp/gnus/nndb.el
deleted file mode 100644
index 2ba7f2901a..0000000000
--- a/lisp/gnus/nndb.el
+++ /dev/null
@@ -1,325 +0,0 @@
-;;; nndb.el --- nndb access for Gnus
-
-;; Copyright (C) 1997, 1998, 2000, 2002, 2003, 2004, 2005, 2006, 2007,
-;; 2008, 2009, 2010 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <[email protected]>
-;; Kai Grossjohann <[email protected]>
-;; Joe Hildebrand <[email protected]>
-;; David Blacka <[email protected]>
-;; Keywords: news
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; This was based upon Kai Grossjohan's shamessly snarfed code and
-;;; further modified by Joe Hildebrand. It has been updated for Red
-;;; Gnus.
-
-;; TODO:
-;;
-;; * Fix bug where server connection can be lost and impossible to regain
-;; This hasn't happened to me in a while; think it was fixed in Rgnus
-;;
-;; * make it handle different nndb servers seemlessly
-;;
-;; * Optimize expire if FORCE
-;;
-;; * Optimize move (only expire once)
-;;
-;; * Deal with add/deletion of groups
-;;
-;; * make the backend TOUCH an article when marked as expireable (will
-;; make article expire 'expiry' days after that moment).
-
-;;; Code:
-
-;; For Emacs < 22.2.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
-;;-
-;; Register nndb with known select methods.
-
-(require 'gnus-start)
-(unless (assoc "nndb" gnus-valid-select-methods)
- (gnus-declare-backend "nndb" 'mail 'respool 'address 'prompt-address))
-
-(require 'nnmail)
-(require 'nnheader)
-(require 'nntp)
-(eval-when-compile (require 'cl))
-
-;; Declare nndb as derived from nntp
-
-(nnoo-declare nndb nntp)
-
-;; Variables specific to nndb
-
-;;- currently not used but just in case...
-(defvoo nndb-deliver-program "nndel"
- "*The program used to put a message in an NNDB group.")
-
-(defvoo nndb-server-side-expiry nil
- "If t, expiry calculation will occur on the server side.")
-
-(defvoo nndb-set-expire-date-on-mark nil
- "If t, the expiry date for a given article will be set to the time
-it was marked as expireable; otherwise the date will be the time the
-article was posted to nndb")
-
-;; Variables copied from nntp
-
-(defvoo nndb-server-opened-hook '(nntp-send-authinfo-from-file)
- "Like nntp-server-opened-hook."
- nntp-server-opened-hook)
-
-(defvoo nndb-address "localhost"
- "*The name of the NNDB server."
- nntp-address)
-
-(defvoo nndb-port-number 9000
- "*Port number to connect to."
- nntp-port-number)
-
-;; change to 'news if you are actually using nndb for news
-(defvoo nndb-article-type 'mail)
-
-(defvoo nndb-status-string nil "" nntp-status-string)
-
-
-
-(defconst nndb-version "nndb 0.7"
- "Version numbers of this version of NNDB.")
-
-
-;;; Interface functions.
-
-(nnoo-define-basics nndb)
-
-;;------------------------------------------------------------------
-
-;; this function turns the lisp list into a string list. There is
-;; probably a more efficient way to do this.
-(defun nndb-build-article-string (articles)
- (let (art-string art)
- (while articles
- (setq art (pop articles))
- (setq art-string (concat art-string art " ")))
- art-string))
-
-(defun nndb-build-expire-rest-list (total expire)
- (let (art rest)
- (while total
- (setq art (pop total))
- (if (memq art expire)
- ()
- (push art rest)))
- rest))
-
-
-;;
-(deffoo nndb-request-type (group &optional article)
- nndb-article-type)
-
-;; nndb-request-update-info does not exist and is not needed
-
-;; nndb-request-update-mark does not exist; it should be used to TOUCH
-;; articles as they are marked exipirable
-(defun nndb-touch-article (group article)
- (nntp-send-command nil "X-TOUCH" article))
-
-(deffoo nndb-request-update-mark
- (group article mark)
- "Sets the expiry date for ARTICLE in GROUP to now, if the mark is 'E'"
- (if (and nndb-set-expire-date-on-mark (string-equal mark "E"))
- (nndb-touch-article group article))
- mark)
-
-;; nndb-request-create-group -- currently this isn't necessary; nndb
-;; creates groups on demand.
-
-;; todo -- use some other time than the creation time of the article
-;; best is time since article has been marked as expirable
-
-(defun nndb-request-expire-articles-local
- (articles &optional group server force)
- "Let gnus do the date check and issue the delete commands."
- (let (msg art delete-list (num-delete 0) rest)
- (nntp-possibly-change-group group server)
- (while articles
- (setq art (pop articles))
- (nntp-send-command "^\\([23]\\|^423\\).*\n" "X-DATE" art)
- (setq msg (nndb-status-message))
- (if (string-match "^423" msg)
- ()
- (or (string-match "'\\(.+\\)'" msg)
- (error "Not a valid response for X-DATE command: %s"
- msg))
- (if (nnmail-expired-article-p
- group
- (date-to-time (substring msg (match-beginning 1) (match-end 1)))
- force)
- (progn
- (setq delete-list (concat delete-list " " (int-to-string art)))
- (setq num-delete (1+ num-delete)))
- (push art rest))))
- (if (> (length delete-list) 0)
- (progn
- (nnheader-message 5 "Deleting %s article(s) from %s"
- (int-to-string num-delete) group)
- (nntp-send-command "^[23].*\n" "X-DELETE" delete-list))
- )
-
- (nnheader-message 5 "")
- (nconc rest articles)))
-
-(defun nndb-get-remote-expire-response ()
- (let (list)
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (if (looking-at "^[34]")
- ;; x-expire returned error--presume no articles were expirable)
- (setq list nil)
- ;; otherwise, pull all of the following numbers into the list
- (re-search-forward "follows\r?\n?" nil t)
- (while (re-search-forward "^[0-9]+$" nil t)
- (push (string-to-number (match-string 0)) list)))
- list))
-
-(defun nndb-request-expire-articles-remote
- (articles &optional group server force)
- "Let the nndb backend expire articles"
- (let (days art-string delete-list (num-delete 0))
- (nntp-possibly-change-group group server)
-
- ;; first calculate the wait period in days
- (setq days (or (and nnmail-expiry-wait-function
- (funcall nnmail-expiry-wait-function group))
- nnmail-expiry-wait))
- ;; now handle the special cases
- (cond (force
- (setq days 0))
- ((eq days 'never)
- ;; This isn't an expirable group.
- (setq days -1))
- ((eq days 'immediate)
- (setq days 0)))
-
-
- ;; build article string
- (setq art-string (concat days " " (nndb-build-article-string articles)))
- (nntp-send-command "^\.\r?\n\\|^[345].*\n" "X-EXPIRE" art-string)
-
- (setq delete-list (nndb-get-remote-expire-response))
- (setq num-delete (length delete-list))
- (if (> num-delete 0)
- (nnheader-message 5 "Deleting %s article(s) from %s"
- (int-to-string num-delete) group))
-
- (nndb-build-expire-rest-list articles delete-list)))
-
-(deffoo nndb-request-expire-articles
- (articles &optional group server force)
- "Expires ARTICLES from GROUP on SERVER.
-If FORCE, delete regardless of exiration date, otherwise use normal
-expiry mechanism."
- (if nndb-server-side-expiry
- (nndb-request-expire-articles-remote articles group server force)
- (nndb-request-expire-articles-local articles group server force)))
-
-;; _Something_ defines it...
-(declare-function nndb-request-article "nndb" t t)
-
-(deffoo nndb-request-move-article
- (article group server accept-form &optional last move-is-internal)
- "Move ARTICLE (a number) from GROUP on SERVER.
-Evals ACCEPT-FORM in current buffer, where the article is.
-Optional LAST is ignored."
- ;; we guess that the second arg in accept-form is the new group,
- ;; which it will be for nndb, which is all that matters anyway
- (let ((new-group (nth 1 accept-form)) result)
- (nntp-possibly-change-group group server)
-
- ;; use the move command for nndb-to-nndb moves
- (if (string-match "^nndb" new-group)
- (let ((new-group-name (gnus-group-real-name new-group)))
- (nntp-send-command "^[23].*\n" "X-MOVE" article new-group-name)
- (cons new-group article))
- ;; else move normally
- (let ((artbuf (get-buffer-create " *nndb move*")))
- (and
- (nndb-request-article article group server artbuf)
- (save-excursion
- (set-buffer artbuf)
- (insert-buffer-substring nntp-server-buffer)
- (setq result (eval accept-form))
- (kill-buffer (current-buffer))
- result)
- (nndb-request-expire-articles (list article)
- group
- server
- t))
- result)
- )))
-
-(deffoo nndb-request-accept-article (group server &optional last)
- "The article in the current buffer is put into GROUP."
- (nntp-possibly-change-group group server)
- (let (art msg)
- (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group)
- (nnheader-insert "")
- (nntp-send-buffer "^[23].*\n"))
-
- (set-buffer nntp-server-buffer)
- (setq msg (buffer-string))
- (or (string-match "^\\([0-9]+\\)" msg)
- (error "nndb: %s" msg))
- (setq art (substring msg (match-beginning 1) (match-end 1)))
- (nnheader-message 5 "nndb: accepted %s" art)
- (list art)))
-
-(deffoo nndb-request-replace-article (article group buffer)
- "ARTICLE is the number of the article in GROUP to be replaced with the contents of the BUFFER."
- (set-buffer buffer)
- (when (nntp-send-command "^[23].*\r?\n" "X-REPLACE" (int-to-string article))
- (nnheader-insert "")
- (nntp-send-buffer "^[23.*\n")
- (list (int-to-string article))))
-
- ; nndb-request-delete-group does not exist
- ; todo -- maybe later
-
- ; nndb-request-rename-group does not exist
- ; todo -- maybe later
-
-;; -- standard compatibility functions
-
-(deffoo nndb-status-message (&optional server)
- "Return server status as a string."
- (set-buffer nntp-server-buffer)
- (buffer-string))
-
-;; Import stuff from nntp
-
-(nnoo-import nndb
- (nntp))
-
-(provide 'nndb)
-
-;; arch-tag: 83bd6fb4-58d9-4fed-a901-c6c625ad5f8a
-;;; nndb.el ends here
diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el
index 62a5db6ea3..3189d33dd5 100644
--- a/lisp/gnus/nndiary.el
+++ b/lisp/gnus/nndiary.el
@@ -1584,6 +1584,4 @@ all. This may very well take some time.")
(provide 'nndiary)
-
-;; arch-tag: 9c542b95-92e7-4ace-a038-330ab296e203
;;; nndiary.el ends here
diff --git a/lisp/gnus/nndir.el b/lisp/gnus/nndir.el
index dd86fba693..b6de7afa01 100644
--- a/lisp/gnus/nndir.el
+++ b/lisp/gnus/nndir.el
@@ -96,5 +96,4 @@
(provide 'nndir)
-;; arch-tag: 56f09f68-0e4e-4816-818a-df80b4a394c8
;;; nndir.el ends here
diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el
index 375e300a1e..ddeac7f952 100644
--- a/lisp/gnus/nndoc.el
+++ b/lisp/gnus/nndoc.el
@@ -100,7 +100,7 @@ from the document.")
(head-end . "^\t")
(generate-head-function . nndoc-generate-clari-briefs-head)
(article-transform-function . nndoc-transform-clari-briefs))
-
+
(standard-digest
(first-article . ,(concat "^" (make-string 70 ?-) "\n *\n+"))
(article-begin . ,(concat "^\n" (make-string 30 ?-) "\n *\n+"))
@@ -118,6 +118,16 @@ from the document.")
(file-end . "^End of")
(prepare-body-function . nndoc-unquote-dashes)
(subtype digest guess))
+ (google
+ (pre-dissection-function . nndoc-decode-content-transfer-encoding)
+ (article-begin . "^== [0-9]+ of [0-9]+ ==$")
+ (head-begin . "^Date:")
+ (head-end . "^$")
+ (body-end-function . nndoc-digest-body-end)
+ (body-begin . "^$")
+ (file-end . "^==============================================================================$")
+ (prepare-body-function . nndoc-unquote-dashes)
+ (subtype digest guess))
(lanl-gov-announce
(article-begin . "^\\\\\\\\\n")
(head-begin . "^\\(Paper.*:\\|arXiv:\\)")
@@ -186,6 +196,7 @@ from the document.")
(defvoo nndoc-article-begin-function nil)
(defvoo nndoc-generate-article-function nil)
(defvoo nndoc-dissection-function nil)
+(defvoo nndoc-pre-dissection-function nil)
(defvoo nndoc-status-string "")
(defvoo nndoc-group-alist nil)
@@ -363,7 +374,8 @@ from the document.")
nndoc-generate-head-function nndoc-body-begin-function
nndoc-head-begin-function
nndoc-generate-article-function
- nndoc-dissection-function)))
+ nndoc-dissection-function
+ nndoc-pre-dissection-function)))
(while vars
(set (pop vars) nil)))
(let (defs)
@@ -445,6 +457,22 @@ from the document.")
(forward-line 1)
(goto-char (+ (point) (string-to-number (match-string 1))))))
+(defun nndoc-google-type-p ()
+ (when (re-search-forward "^=3D=3D 1 of [0-9]+ =3D=3D$" nil t)
+ t))
+
+(defun nndoc-decode-content-transfer-encoding ()
+ (let ((encoding
+ (save-restriction
+ (message-narrow-to-head)
+ (message-fetch-field "content-transfer-encoding"))))
+ (when (and encoding
+ (search-forward "\n\n" nil t))
+ (save-restriction
+ (narrow-to-region (point) (point-max))
+ (mm-decode-content-transfer-encoding
+ (intern (downcase (mail-header-strip encoding))))))))
+
(defun nndoc-babyl-type-p ()
(when (re-search-forward "\^_\^L *\n" nil t)
t))
@@ -807,6 +835,9 @@ from the document.")
;; Remove blank lines.
(while (eq (following-char) ?\n)
(delete-char 1))
+ (when nndoc-pre-dissection-function
+ (save-excursion
+ (funcall nndoc-pre-dissection-function)))
(if nndoc-dissection-function
(funcall nndoc-dissection-function)
;; Find the beginning of the file.
@@ -1025,5 +1056,4 @@ symbol in the alist."
(provide 'nndoc)
-;; arch-tag: f5c2970e-0387-47ac-a0b3-6cc317dffabe
;;; nndoc.el ends here
diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el
index 7afded2abf..dd2b8a6b48 100644
--- a/lisp/gnus/nndraft.el
+++ b/lisp/gnus/nndraft.el
@@ -202,7 +202,7 @@ are generated if and only if they are also in `message-draft-headers'.")
'nnmh-request-group
(list group server dont-check)))
-(deffoo nndraft-request-move-article (article group server accept-form
+(deffoo nndraft-request-move-article (article group server accept-form
&optional last move-is-internal)
(nndraft-possibly-change-group group)
(let ((buf (get-buffer-create " *nndraft move*"))
@@ -313,5 +313,4 @@ are generated if and only if they are also in `message-draft-headers'.")
(provide 'nndraft)
-;; arch-tag: 3ce26ca0-41cb-48b1-8703-4dad35e188aa
;;; nndraft.el ends here
diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el
index 2a80d867e5..2f05c7e790 100644
--- a/lisp/gnus/nneething.el
+++ b/lisp/gnus/nneething.el
@@ -427,5 +427,4 @@ included.")
(provide 'nneething)
-;; arch-tag: 1277f386-88f2-4459-bb24-f3f45962a6c5
;;; nneething.el ends here
diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el
index 19fe8c61b7..6413e98cc1 100644
--- a/lisp/gnus/nnfolder.el
+++ b/lisp/gnus/nnfolder.el
@@ -494,7 +494,7 @@ the group. Then the marks file will be regenerated properly by Gnus.")
(nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
(gnus-sorted-difference articles (nreverse deleted-articles)))))
-(deffoo nnfolder-request-move-article (article group server accept-form
+(deffoo nnfolder-request-move-article (article group server accept-form
&optional last move-is-internal)
(save-excursion
(let ((buf (get-buffer-create " *nnfolder move*"))
@@ -552,7 +552,7 @@ the group. Then the marks file will be regenerated properly by Gnus.")
(while (re-search-backward (concat "^" nnfolder-article-marker) nil t)
(delete-region (point) (progn (forward-line 1) (point))))
(when nnmail-cache-accepted-message-ids
- (nnmail-cache-insert (nnmail-fetch-field "message-id")
+ (nnmail-cache-insert (nnmail-fetch-field "message-id")
group
(nnmail-fetch-field "subject")
(nnmail-fetch-field "from")))
@@ -1301,5 +1301,4 @@ This command does not work if you use short group names."
(provide 'nnfolder)
-;; arch-tag: a040d0f4-4f4e-445f-8972-839575c5f7e6
;;; nnfolder.el ends here
diff --git a/lisp/gnus/nngateway.el b/lisp/gnus/nngateway.el
index 163aa357b2..1c0d7753ef 100644
--- a/lisp/gnus/nngateway.el
+++ b/lisp/gnus/nngateway.el
@@ -89,5 +89,4 @@ parameter -- the gateway address.")
(provide 'nngateway)
-;; arch-tag: f7ecb92e-b10c-43d5-9a9b-1314233341fc
;;; nngateway.el ends here
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index 6a24f21efc..9a90a76f7a 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -77,7 +77,7 @@ Integer values will in effect be rounded up to the nearest multiple of
"*Length of each read operation when trying to fetch HEAD headers.")
(defvar nnheader-read-timeout
- (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin"
+ (if (string-match "windows-nt\\|os/2\\|cygwin"
(symbol-name system-type))
;; http://thread.gmane.org/[email protected]
;;
@@ -102,7 +102,7 @@ Shorter values mean quicker response, but are more CPU intensive.")
(defvar nnheader-file-name-translation-alist
(let ((case-fold-search t))
(cond
- ((string-match "windows-nt\\|os/2\\|emx\\|cygwin"
+ ((string-match "windows-nt\\|os/2\\|cygwin"
(symbol-name system-type))
(append (mapcar (lambda (c) (cons c ?_))
'(?: ?* ?\" ?< ?> ??))
@@ -786,8 +786,7 @@ If FULL, translate everything."
;; We translate -- but only the file name. We leave the directory
;; alone.
(if (and (featurep 'xemacs)
- (memq system-type '(cygwin32 win32 w32 mswindows windows-nt
- cygwin)))
+ (memq system-type '(windows-nt cygwin)))
;; This is needed on NT and stuff, because
;; file-name-nondirectory is not enough to split
;; file names, containing ':', e.g.
@@ -1086,5 +1085,4 @@ See `find-file-noselect' for the arguments."
(provide 'nnheader)
-;; arch-tag: a9c4b7d9-52ae-4ec9-b196-dfd93124d202
;;; nnheader.el ends here
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index c76169cb2b..d412af46d0 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -588,11 +588,12 @@ If EXAMINE is non-nil the group is selected read-only."
(imap-mailbox-select decoded-group examine))
(let (minuid maxuid)
(when (> (imap-mailbox-get 'exists) 0)
- (imap-fetch-safe '("1,*" . "1,*:*") "UID" nil 'nouidfetch)
- (imap-message-map (lambda (uid Uid)
- (setq minuid (if minuid (min minuid uid) uid)
- maxuid (if maxuid (max maxuid uid) uid)))
- 'UID))
+ (imap-fetch "1:*" "UID" nil 'nouidfetch)
+ (imap-message-map
+ (lambda (uid Uid)
+ (setq minuid (if minuid (min minuid uid) uid)
+ maxuid (if maxuid (max maxuid uid) uid)))
+ 'UID))
(list (imap-mailbox-get 'exists) minuid maxuid))))))
(defun nnimap-possibly-change-group (group &optional server)
@@ -833,8 +834,8 @@ If EXAMINE is non-nil the group is selected read-only."
nnimap-authinfo-file)
(netrc-parse nnimap-authinfo-file)))
(port (if nnimap-server-port
- (int-to-string nnimap-server-port)
- "imap"))
+ (int-to-string nnimap-server-port)
+ "imap"))
(auth-info
(auth-source-user-or-password '("login" "password") server port))
(auth-user (nth 0 auth-info))
@@ -1114,14 +1115,16 @@ function is generally only called when Gnus is shutting down."
(dolist (pattern (nnimap-pattern-to-list-arguments nnimap-list-pattern))
(dolist (mbx (funcall nnimap-request-list-method
(cdr pattern) (car pattern)))
- (or (member "\\NoSelect" (imap-mailbox-get 'list-flags mbx))
- (let* ((encoded-mbx (nnimap-encode-group-name mbx))
- (info (nnimap-find-minmax-uid encoded-mbx 'examine)))
- (when info
- (with-current-buffer nntp-server-buffer
- (insert (format "\"%s\" %d %d y\n"
- encoded-mbx (or (nth 2 info) 0)
- (max 1 (or (nth 1 info) 1)))))))))))
+ (unless (member "\\noselect"
+ (mapcar #'downcase
+ (imap-mailbox-get 'list-flags mbx)))
+ (let* ((encoded-mbx (nnimap-encode-group-name mbx))
+ (info (nnimap-find-minmax-uid encoded-mbx 'examine)))
+ (when info
+ (with-current-buffer nntp-server-buffer
+ (insert (format "\"%s\" %d %d y\n"
+ encoded-mbx (or (nth 2 info) 0)
+ (max 1 (or (nth 1 info) 1)))))))))))
(gnus-message 5 "nnimap: Generating active list%s...done"
(if (> (length server) 0) (concat " for " server) ""))
t))
@@ -1499,8 +1502,8 @@ function is generally only called when Gnus is shutting down."
(nnimap-before-find-minmax-bugworkaround)
(dolist (pattern (nnimap-pattern-to-list-arguments
nnimap-list-pattern))
- (dolist (mbx (imap-mailbox-lsub (cdr pattern) (car pattern) nil
- nnimap-server-buffer))
+ (dolist (mbx (funcall nnimap-request-list-method (cdr pattern) (car pattern) nil
+ nnimap-server-buffer))
(or (catch 'found
(dolist (mailbox (imap-mailbox-get 'list-flags mbx
nnimap-server-buffer))
@@ -1807,69 +1810,6 @@ be used in a STORE FLAGS command."
"Return t if MARK can be permanently (between IMAP sessions) saved on articles, in GROUP."
(imap-message-flag-permanent-p (nnimap-mark-to-flag mark)))
-(when nnimap-debug
- (require 'trace)
- (buffer-disable-undo (get-buffer-create nnimap-debug-buffer))
- (mapc (lambda (f) (trace-function-background f nnimap-debug-buffer))
- '(
- nnimap-possibly-change-server
- nnimap-verify-uidvalidity
- nnimap-find-minmax-uid
- nnimap-before-find-minmax-bugworkaround
- nnimap-possibly-change-group
- ;;nnimap-replace-whitespace
- nnimap-retrieve-headers-progress
- nnimap-retrieve-which-headers
- nnimap-group-overview-filename
- nnimap-retrieve-headers-from-file
- nnimap-retrieve-headers-from-server
- nnimap-retrieve-headers
- nnimap-open-connection
- nnimap-open-server
- nnimap-server-opened
- nnimap-close-server
- nnimap-request-close
- nnimap-status-message
- ;;nnimap-demule
- nnimap-request-article-part
- nnimap-request-article
- nnimap-request-head
- nnimap-request-body
- nnimap-request-group
- nnimap-close-group
- nnimap-pattern-to-list-arguments
- nnimap-request-list
- nnimap-request-post
- nnimap-retrieve-groups
- nnimap-request-update-info-internal
- nnimap-request-type
- nnimap-request-set-mark
- nnimap-split-to-groups
- nnimap-split-find-rule
- nnimap-split-find-inbox
- nnimap-split-articles
- nnimap-request-scan
- nnimap-request-newgroups
- nnimap-request-create-group
- nnimap-time-substract
- nnimap-date-days-ago
- nnimap-request-expire-articles-progress
- nnimap-request-expire-articles
- nnimap-request-move-article
- nnimap-request-accept-article
- nnimap-request-delete-group
- nnimap-request-rename-group
- gnus-group-nnimap-expunge
- gnus-group-nnimap-edit-acl
- gnus-group-nnimap-edit-acl-done
- nnimap-group-mode-hook
- nnimap-mark-to-predicate
- nnimap-mark-to-flag-1
- nnimap-mark-to-flag
- nnimap-mark-permanent-p
- )))
-
(provide 'nnimap)
-;; arch-tag: 2b001f20-3ff9-4094-a0ad-46807c1ba70b
;;; nnimap.el ends here
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el
index c14d9a1b6a..6096c6fb37 100644
--- a/lisp/gnus/nnir.el
+++ b/lisp/gnus/nnir.el
@@ -263,10 +263,10 @@
;; I have tried to make the code expandable. Basically, it is divided
;; into two layers. The upper layer is somewhat like the `nnvirtual'
-;; or `nnkiboze' backends: given a specification of what articles to
-;; show from another backend, it creates a group containing exactly
-;; those articles. The lower layer issues a query to a search engine
-;; and produces such a specification of what articles to show from the
+;; backend: given a specification of what articles to show from
+;; another backend, it creates a group containing exactly those
+;; articles. The lower layer issues a query to a search engine and
+;; produces such a specification of what articles to show from the
;; other backend.
;; The interface between the two layers consists of the single
@@ -792,7 +792,7 @@ and show thread that contains this article."
(setq novitem (funcall nnir-get-article-nov-override-function
artitem))
;; else, set novitem through nnheader-parse-nov/nnheader-parse-head
- (case (setq foo (gnus-retrieve-headers (list artno)
+ (case (setq foo (gnus-retrieve-headers (list artno)
artfullgroup nil))
(nov
(goto-char (point-min))
@@ -1697,5 +1697,4 @@ The Gnus backend/server information is added."
;; The end.
(provide 'nnir)
-;; arch-tag: 9b3fecf8-4397-4bbb-bf3c-6ac3cbbc6664
;;; nnir.el ends here
diff --git a/lisp/gnus/nnkiboze.el b/lisp/gnus/nnkiboze.el
deleted file mode 100644
index 17a10e6619..0000000000
--- a/lisp/gnus/nnkiboze.el
+++ /dev/null
@@ -1,391 +0,0 @@
-;;; nnkiboze.el --- select virtual news access for Gnus
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <[email protected]>
-;; Keywords: news
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; The other access methods (nntp, nnspool, etc) are general news
-;; access methods. This module relies on Gnus and can't be used
-;; separately.
-
-;;; Code:
-
-(require 'nntp)
-(require 'nnheader)
-(require 'gnus)
-(require 'gnus-score)
-(require 'nnoo)
-(require 'mm-util)
-(eval-when-compile (require 'cl))
-
-(nnoo-declare nnkiboze)
-(defvoo nnkiboze-directory (nnheader-concat gnus-directory "kiboze/")
- "nnkiboze will put its files in this directory.")
-
-(defvoo nnkiboze-level 9
- "The maximum level to be searched for articles.")
-
-(defvoo nnkiboze-remove-read-articles t
- "If non-nil, nnkiboze will remove read articles from the kiboze group.")
-
-(defvoo nnkiboze-ephemeral nil
- "If non-nil, don't store any data anywhere.")
-
-(defvoo nnkiboze-scores nil
- "Score rules for generating the nnkiboze group.")
-
-(defvoo nnkiboze-regexp nil
- "Regexp for matching component groups.")
-
-(defvoo nnkiboze-file-coding-system mm-text-coding-system
- "Coding system for nnkiboze files.")
-
-
-
-(defconst nnkiboze-version "nnkiboze 1.0")
-
-(defvoo nnkiboze-current-group nil)
-(defvoo nnkiboze-status-string "")
-
-(defvoo nnkiboze-headers nil)
-
-
-
-;;; Interface functions.
-
-(nnoo-define-basics nnkiboze)
-
-(deffoo nnkiboze-retrieve-headers (articles &optional group server fetch-old)
- (nnkiboze-possibly-change-group group)
- (unless gnus-nov-is-evil
- (if (stringp (car articles))
- 'headers
- (let ((nov (nnkiboze-nov-file-name)))
- (when (file-exists-p nov)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (let ((nnheader-file-coding-system nnkiboze-file-coding-system))
- (nnheader-insert-file-contents nov))
- (nnheader-nov-delete-outside-range
- (car articles) (car (last articles)))
- 'nov))))))
-
-(deffoo nnkiboze-request-article (article &optional newsgroup server buffer)
- (nnkiboze-possibly-change-group newsgroup)
- (if (not (numberp article))
- ;; This is a real kludge. It might not work at times, but it
- ;; does no harm I think. The only alternative is to offer no
- ;; article fetching by message-id at all.
- (nntp-request-article article newsgroup gnus-nntp-server buffer)
- (let* ((header (gnus-summary-article-header article))
- (xref (mail-header-xref header))
- num group)
- (unless xref
- (error "nnkiboze: No xref"))
- (unless (string-match " \\([^ ]+\\):\\([0-9]+\\)" xref)
- (error "nnkiboze: Malformed xref"))
- (setq num (string-to-number (match-string 2 xref))
- group (match-string 1 xref))
- (or (with-current-buffer buffer
- (or (and gnus-use-cache (gnus-cache-request-article num group))
- (gnus-agent-request-article num group)))
- (gnus-request-article num group buffer)))))
-
-(deffoo nnkiboze-request-scan (&optional group server)
- (nnkiboze-possibly-change-group group)
- (nnkiboze-generate-group (concat "nnkiboze:" group)))
-
-(deffoo nnkiboze-request-group (group &optional server dont-check)
- "Make GROUP the current newsgroup."
- (nnkiboze-possibly-change-group group)
- (if dont-check
- t
- (let ((nov-file (nnkiboze-nov-file-name))
- beg end total)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (unless (file-exists-p nov-file)
- (nnkiboze-request-scan group))
- (if (not (file-exists-p nov-file))
- (nnheader-report 'nnkiboze "Can't select group %s" group)
- (let ((nnheader-file-coding-system nnkiboze-file-coding-system))
- (nnheader-insert-file-contents nov-file))
- (if (zerop (buffer-size))
- (nnheader-insert "211 0 0 0 %s\n" group)
- (goto-char (point-min))
- (when (looking-at "[0-9]+")
- (setq beg (read (current-buffer))))
- (goto-char (point-max))
- (when (re-search-backward "^[0-9]" nil t)
- (setq end (read (current-buffer))))
- (setq total (count-lines (point-min) (point-max)))
- (nnheader-insert "211 %d %d %d %s\n" total beg end group)))))))
-
-(deffoo nnkiboze-close-group (group &optional server)
- (nnkiboze-possibly-change-group group)
- ;; Remove NOV lines of articles that are marked as read.
- (when (and (file-exists-p (nnkiboze-nov-file-name))
- nnkiboze-remove-read-articles)
- (let ((coding-system-for-write nnkiboze-file-coding-system))
- (with-temp-file (nnkiboze-nov-file-name)
- (let ((cur (current-buffer))
- (nnheader-file-coding-system nnkiboze-file-coding-system))
- (nnheader-insert-file-contents (nnkiboze-nov-file-name))
- (goto-char (point-min))
- (while (not (eobp))
- (if (not (gnus-article-read-p (read cur)))
- (forward-line 1)
- (gnus-delete-line))))))
- (setq nnkiboze-current-group nil)))
-
-(deffoo nnkiboze-open-server (server &optional defs)
- (unless (assq 'nnkiboze-regexp defs)
- (push `(nnkiboze-regexp ,server)
- defs))
- (nnoo-change-server 'nnkiboze server defs))
-
-(deffoo nnkiboze-request-delete-group (group &optional force server)
- (nnkiboze-possibly-change-group group)
- (when force
- (let ((files (nconc
- (nnkiboze-score-file group)
- (list (nnkiboze-nov-file-name)
- (nnkiboze-nov-file-name ".newsrc")))))
- (while files
- (and (file-exists-p (car files))
- (file-writable-p (car files))
- (delete-file (car files)))
- (setq files (cdr files)))))
- (setq nnkiboze-current-group nil)
- t)
-
-(nnoo-define-skeleton nnkiboze)
-
-
-;;; Internal functions.
-
-(defun nnkiboze-possibly-change-group (group)
- (setq nnkiboze-current-group group))
-
-(defun nnkiboze-prefixed-name (group)
- (gnus-group-prefixed-name group '(nnkiboze "")))
-
-;;;###autoload
-(defun nnkiboze-generate-groups ()
- "\"Usage: emacs -batch -l nnkiboze -f nnkiboze-generate-groups\".
-Finds out what articles are to be part of the nnkiboze groups."
- (interactive)
- (let ((mail-sources nil)
- (gnus-use-dribble-file nil)
- (gnus-read-active-file t)
- (gnus-expert-user t))
- (gnus))
- (let* ((gnus-newsrc-alist (gnus-copy-sequence gnus-newsrc-alist))
- (newsrc (cdr gnus-newsrc-alist))
- gnus-newsrc-hashtb info)
- (gnus-make-hashtable-from-newsrc-alist)
- ;; We have copied all the newsrc alist info over to local copies
- ;; so that we can mess all we want with these lists.
- (while (setq info (pop newsrc))
- (when (string-match "nnkiboze" (gnus-info-group info))
- ;; For each kiboze group, we call this function to generate
- ;; it.
- (nnkiboze-generate-group (gnus-info-group info) t))))
- (save-excursion
- (set-buffer gnus-group-buffer)
- (gnus-group-list-groups)))
-
-(defun nnkiboze-score-file (group)
- (list (expand-file-name
- (concat (file-name-as-directory gnus-kill-files-directory)
- (nnheader-translate-file-chars
- (concat (nnkiboze-prefixed-name nnkiboze-current-group)
- "." gnus-score-file-suffix))))))
-
-(defun nnkiboze-generate-group (group &optional inhibit-list-groups)
- (let* ((info (gnus-get-info group))
- (newsrc-file (concat nnkiboze-directory
- (nnheader-translate-file-chars
- (concat group ".newsrc"))))
- (nov-file (concat nnkiboze-directory
- (nnheader-translate-file-chars
- (concat group ".nov"))))
- method nnkiboze-newsrc gname newsrc active
- ginfo lowest glevel orig-info nov-buffer
- ;; Bind various things to nil to make group entry faster.
- (gnus-expert-user t)
- (gnus-large-newsgroup nil)
- (gnus-score-find-score-files-function 'nnkiboze-score-file)
- ;; Use only nnkiboze-score-file!
- (gnus-score-use-all-scores nil)
- (gnus-use-scoring t)
- (gnus-verbose (min gnus-verbose 3))
- gnus-select-group-hook gnus-summary-prepare-hook
- gnus-thread-sort-functions gnus-show-threads
- gnus-visual gnus-suppress-duplicates num-unread)
- (unless info
- (error "No such group: %s" group))
- ;; Load the kiboze newsrc file for this group.
- (when (file-exists-p newsrc-file)
- (load newsrc-file))
- (let ((coding-system-for-write nnkiboze-file-coding-system))
- (gnus-make-directory (file-name-directory nov-file))
- (with-temp-file nov-file
- (mm-disable-multibyte)
- (when (file-exists-p nov-file)
- (insert-file-contents nov-file))
- (setq nov-buffer (current-buffer))
- ;; Go through the active hashtb and add new all groups that match the
- ;; kiboze regexp.
- (mapatoms
- (lambda (group)
- (and (string-match nnkiboze-regexp
- (setq gname (symbol-name group))) ; Match
- (not (assoc gname nnkiboze-newsrc)) ; It isn't registered
- (numberp (car (symbol-value group))) ; It is active
- (or (> nnkiboze-level 7)
- (and (setq glevel
- (gnus-info-level (gnus-get-info gname)))
- (>= nnkiboze-level glevel)))
- (not (string-match "^nnkiboze:" gname)) ; Exclude kibozes
- (push (cons gname (1- (car (symbol-value group))))
- nnkiboze-newsrc)))
- gnus-active-hashtb)
- ;; `newsrc' is set to the list of groups that possibly are
- ;; component groups to this kiboze group. This list has elements
- ;; on the form `(GROUP . NUMBER)', where NUMBER is the highest
- ;; number that has been kibozed in GROUP in this kiboze group.
- (setq newsrc nnkiboze-newsrc)
- (while newsrc
- (if (not (setq active (gnus-active (caar newsrc))))
- ;; This group isn't active after all, so we remove it from
- ;; the list of component groups.
- (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc))
- (setq lowest (cdar newsrc))
- ;; Ok, we have a valid component group, so we jump to it.
- (switch-to-buffer gnus-group-buffer)
- (gnus-group-jump-to-group (caar newsrc))
- (gnus-message 3 "nnkiboze: Checking %s..." (caar newsrc))
- (setq ginfo (gnus-get-info (gnus-group-group-name))
- orig-info (gnus-copy-sequence ginfo)
- num-unread (gnus-group-unread (caar newsrc)))
- (unwind-protect
- (progn
- ;; We set all list of article marks to nil. Since we operate
- ;; on copies of the real lists, we can destroy anything we
- ;; want here.
- (when (nth 3 ginfo)
- (setcar (nthcdr 3 ginfo) nil))
- ;; We set the list of read articles to be what we expect for
- ;; this kiboze group -- either nil or `(1 . LOWEST)'.
- (when ginfo
- (setcar (nthcdr 2 ginfo)
- (and (not (= lowest 1)) (cons 1 lowest))))
- (when (and (or (not ginfo)
- (> (length (gnus-list-of-unread-articles
- (car ginfo)))
- 0))
- (progn
- (ignore-errors
- (gnus-group-select-group nil))
- (eq major-mode 'gnus-summary-mode)))
- ;; We are now in the group where we want to be.
- (setq method (gnus-find-method-for-group
- gnus-newsgroup-name))
- (when (eq method gnus-select-method)
- (setq method nil))
- ;; We go through the list of scored articles.
- (while gnus-newsgroup-scored
- (when (> (caar gnus-newsgroup-scored) lowest)
- ;; If it has a good score, then we enter this article
- ;; into the kiboze group.
- (nnkiboze-enter-nov
- nov-buffer
- (gnus-summary-article-header
- (caar gnus-newsgroup-scored))
- gnus-newsgroup-name))
- (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored)))
- ;; That's it. We exit this group.
- (when (eq major-mode 'gnus-summary-mode)
- (kill-buffer (current-buffer)))))
- ;; Restore the proper info.
- (when ginfo
- (setcdr ginfo (cdr orig-info)))
- (setcar (gnus-group-entry (caar newsrc)) num-unread)))
- (setcdr (car newsrc) (cdr active))
- (gnus-message 3 "nnkiboze: Checking %s...done" (caar newsrc))
- (setq newsrc (cdr newsrc)))))
- ;; We save the kiboze newsrc for this group.
- (gnus-make-directory (file-name-directory newsrc-file))
- (with-temp-file newsrc-file
- (mm-disable-multibyte)
- (insert "(setq nnkiboze-newsrc '")
- (gnus-prin1 nnkiboze-newsrc)
- (insert ")\n"))
- (unless inhibit-list-groups
- (save-excursion
- (set-buffer gnus-group-buffer)
- (gnus-group-list-groups)))
- t))
-
-(defun nnkiboze-enter-nov (buffer header group)
- (save-excursion
- (set-buffer buffer)
- (goto-char (point-max))
- (let ((prefix (gnus-group-real-prefix group))
- (oheader (copy-sequence header))
- article)
- (if (zerop (forward-line -1))
- (progn
- (setq article (1+ (read (current-buffer))))
- (forward-line 1))
- (setq article 1))
- (mail-header-set-number oheader article)
- (with-temp-buffer
- (insert (or (mail-header-xref oheader) ""))
- (goto-char (point-min))
- (if (re-search-forward " [^ ]+:[0-9]+" nil t)
- (goto-char (match-beginning 0))
- (or (eobp) (forward-char 1)))
- ;; The first Xref has to be the group this article
- ;; really came for - this is the article nnkiboze
- ;; will request when it is asked for the article.
- (insert " " group ":"
- (int-to-string (mail-header-number header)) " ")
- (while (re-search-forward " [^ ]+:[0-9]+" nil t)
- (goto-char (1+ (match-beginning 0)))
- (insert prefix))
- (mail-header-set-xref oheader (buffer-string)))
- (nnheader-insert-nov oheader))))
-
-(defun nnkiboze-nov-file-name (&optional suffix)
- (concat (file-name-as-directory nnkiboze-directory)
- (nnheader-translate-file-chars
- (concat (nnkiboze-prefixed-name nnkiboze-current-group)
- (or suffix ".nov")))))
-
-(provide 'nnkiboze)
-
-;; arch-tag: 66068271-bdc9-4801-bcde-779702e73a05
-;;; nnkiboze.el ends here
diff --git a/lisp/gnus/nnlistserv.el b/lisp/gnus/nnlistserv.el
deleted file mode 100644
index 3e53001cec..0000000000
--- a/lisp/gnus/nnlistserv.el
+++ /dev/null
@@ -1,152 +0,0 @@
-;;; nnlistserv.el --- retrieving articles via web mailing list archives
-
-;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <[email protected]>
-;; Keywords: news, mail
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'nnoo)
-(require 'mm-url)
-(require 'nnweb)
-
-(nnoo-declare nnlistserv
- nnweb)
-
-(defvoo nnlistserv-directory (nnheader-concat gnus-directory "nnlistserv/")
- "Where nnlistserv will save its files."
- nnweb-directory)
-
-(defvoo nnlistserv-name 'kk
- "What search engine type is being used."
- nnweb-type)
-
-(defvoo nnlistserv-type-definition
- '((kk
- (article . nnlistserv-kk-wash-article)
- (map . nnlistserv-kk-create-mapping)
- (search . nnlistserv-kk-search)
- (address . "http://www.itk.ntnu.no/ansatte/Andresen_Trond/kk-f/%s/")
- (pages "fra160396" "fra160796" "fra061196" "fra160197"
- "fra090997" "fra040797" "fra130397" "nye")
- (index . "date.html")
- (identifier . nnlistserv-kk-identity)))
- "Type-definition alist."
- nnweb-type-definition)
-
-(defvoo nnlistserv-search nil
- "Search string to feed to DejaNews."
- nnweb-search)
-
-(defvoo nnlistserv-ephemeral-p nil
- "Whether this nnlistserv server is ephemeral."
- nnweb-ephemeral-p)
-
-;;; Internal variables
-
-;;; Interface functions
-
-(nnoo-define-basics nnlistserv)
-
-(nnoo-import nnlistserv
- (nnweb))
-
-;;; Internal functions
-
-;;;
-;;; KK functions.
-;;;
-
-(defun nnlistserv-kk-create-mapping ()
- "Perform the search and create a number-to-url alist."
- (save-excursion
- (set-buffer nnweb-buffer)
- (let ((case-fold-search t)
- (active (or (cadr (assoc nnweb-group nnweb-group-alist))
- (cons 1 0)))
- (pages (nnweb-definition 'pages))
- map url page subject from )
- (while (setq page (pop pages))
- (erase-buffer)
- (when (funcall (nnweb-definition 'search) page)
- ;; Go through all the article hits on this page.
- (goto-char (point-min))
- (mm-url-decode-entities)
- (goto-char (point-min))
- (while (re-search-forward "^<li> *<a href=\"\\([^\"]+\\)\"><b>\\([^\\>]+\\)</b></a> *<[^>]+><i>\\([^>]+\\)<" nil t)
- (setq url (match-string 1)
- subject (match-string 2)
- from (match-string 3))
- (setq url (concat (format (nnweb-definition 'address) page) url))
- (unless (nnweb-get-hashtb url)
- (push
- (list
- (incf (cdr active))
- (make-full-mail-header
- (cdr active) subject from ""
- (concat "<" (nnweb-identifier url) "@kk>")
- nil 0 0 url))
- map)
- (nnweb-set-hashtb (cadar map) (car map))
- (nnheader-message 5 "%s %s %s" (cdr active) (point) pages)))))
- ;; Return the articles in the right order.
- (setq nnweb-articles
- (sort (nconc nnweb-articles map) 'car-less-than-car)))))
-
-(defun nnlistserv-kk-wash-article ()
- (let ((case-fold-search t)
- (headers '(sent name email subject id))
- sent name email subject id)
- (mm-url-decode-entities)
- (while headers
- (goto-char (point-min))
- (re-search-forward (format "<!-- %s=\"\\([^\"]+\\)" (car headers)) nil t)
- (set (pop headers) (match-string 1)))
- (goto-char (point-min))
- (search-forward "<!-- body" nil t)
- (delete-region (point-min) (progn (forward-line 1) (point)))
- (goto-char (point-max))
- (search-backward "<!-- body" nil t)
- (delete-region (point-max) (progn (beginning-of-line) (point)))
- (mm-url-remove-markup)
- (goto-char (point-min))
- (insert (format "From: %s <%s>\n" name email)
- (format "Subject: %s\n" subject)
- (format "Message-ID: %s\n" id)
- (format "Date: %s\n\n" sent))))
-
-(defun nnlistserv-kk-search (search)
- (mm-url-insert
- (concat (format (nnweb-definition 'address) search)
- (nnweb-definition 'index)))
- t)
-
-(defun nnlistserv-kk-identity (url)
- "Return an unique identifier based on URL."
- url)
-
-(provide 'nnlistserv)
-
-;; arch-tag: 7705176f-d332-4a5e-a520-d0d319445617
-;;; nnlistserv.el ends here
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index 8bf0cbf5de..b7d834ecd8 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -265,7 +265,7 @@ It scans low-level sorted spools even when not required."
:type 'function)
(defcustom nnmail-crosspost-link-function
- (if (string-match "windows-nt\\|emx" (symbol-name system-type))
+ (if (string-match "windows-nt" (symbol-name system-type))
'copy-file
'add-name-to-file)
"*Function called to create a copy of a file.
@@ -1823,8 +1823,6 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
;; The we go through all the existing mail source specification
;; and fetch the mail from each.
(while (setq source (pop fetching-sources))
- (nnheader-message 4 "%s: Reading incoming mail from %s..."
- method (car source))
(when (setq new
(mail-source-fetch
source
@@ -1842,8 +1840,9 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
(incf i)))
;; If we did indeed read any incoming spools, we save all info.
(if (zerop total)
- (nnheader-message 4 "%s: Reading incoming mail (no new mail)...done"
- method (car source))
+ (when mail-source-plugged
+ (nnheader-message 4 "%s: Reading incoming mail (no new mail)...done"
+ method (car source)))
(nnmail-save-active
(nnmail-get-value "%s-group-alist" method)
(nnmail-get-value "%s-active-file" method))
@@ -2052,5 +2051,4 @@ Doesn't change point."
(provide 'nnmail)
-;; arch-tag: fe8f671a-50db-428a-bb5d-f00462f72ed7
;;; nnmail.el ends here
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index 628b4c5d2a..827eafdc7e 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -1667,5 +1667,4 @@ by nnmaildir-request-article.")
;; fill-column: 77
;; End:
-;; arch-tag: 0c4e44cd-dfde-4040-888e-5597ec771849
;;; nnmaildir.el ends here
diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el
index e39149b996..04db76b942 100644
--- a/lisp/gnus/nnmairix.el
+++ b/lisp/gnus/nnmairix.el
@@ -556,7 +556,7 @@ Other back ends might or might not work.")
(mapcar
(lambda (arg) (- arg numcorr))
articles)))
- (setq rval
+ (setq rval
(if (eq nnmairix-backend 'nnimap)
(let ((gnus-nov-is-evil t))
(nnmairix-call-backend
@@ -2044,5 +2044,4 @@ VALUES may contain values for editable fields from current article."
(provide 'nnmairix)
-;; arch-tag: bb187498-b229-4a55-8c07-6d3f80713e94
;;; nnmairix.el ends here
diff --git a/lisp/gnus/nnmbox.el b/lisp/gnus/nnmbox.el
index 5ead1c9604..7d71dc1c1e 100644
--- a/lisp/gnus/nnmbox.el
+++ b/lisp/gnus/nnmbox.el
@@ -718,5 +718,4 @@
(provide 'nnmbox)
-;; arch-tag: 611dd95f-be37-413a-b3ae-8b059ba93659
;;; nnmbox.el ends here
diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el
index 2289eb6081..131861e03e 100644
--- a/lisp/gnus/nnmh.el
+++ b/lisp/gnus/nnmh.el
@@ -207,40 +207,48 @@ as unread by Gnus.")
(defun nnmh-request-list-1 (dir)
(setq dir (expand-file-name dir))
;; Recurse down all directories.
- (let ((dirs (and (file-readable-p dir)
- (nnheader-directory-files dir t nil t)))
- rdir)
+ (let ((files (nnheader-directory-files dir t nil t))
+ (max 0)
+ min rdir num subdirectoriesp file)
;; Recurse down directories.
- (while (setq rdir (pop dirs))
- (when (and (file-directory-p rdir)
- (file-readable-p rdir)
- (not (equal (file-truename rdir)
- (file-truename dir))))
- (nnmh-request-list-1 rdir))))
- ;; For each directory, generate an active file line.
- (unless (string= (expand-file-name nnmh-toplev) dir)
- (let ((files (mapcar 'string-to-number
- (directory-files dir nil "^[0-9]+$" t))))
- (when files
- (with-current-buffer nntp-server-buffer
- (goto-char (point-max))
- (insert
- (format
- "%s %.0f %.0f y\n"
- (progn
- (string-match
- (regexp-quote
- (file-truename (file-name-as-directory
- (expand-file-name nnmh-toplev))))
- dir)
- (mm-string-to-multibyte ;Why? Isn't it multibyte already?
- (mm-encode-coding-string
- (nnheader-replace-chars-in-string
- (substring dir (match-end 0))
- ?/ ?.)
- nnmail-pathname-coding-system)))
- (apply 'max files)
- (apply 'min files)))))))
+ (setq subdirectoriesp (> (nth 1 (file-attributes dir)) 2))
+ (dolist (rdir files)
+ (if (or (not subdirectoriesp)
+ (file-regular-p rdir))
+ (progn
+ (setq file (file-name-nondirectory rdir))
+ (when (string-match "^[0-9]+$" file)
+ (setq num (string-to-number file))
+ (setq max (max max num))
+ (when (or (null min)
+ (< num min))
+ (setq min num))))
+ ;; This is a directory.
+ (when (and (file-readable-p rdir)
+ (not (equal (file-truename rdir)
+ (file-truename dir))))
+ (nnmh-request-list-1 rdir))))
+ ;; For each directory, generate an active file line.
+ (unless (string= (expand-file-name nnmh-toplev) dir)
+ (with-current-buffer nntp-server-buffer
+ (goto-char (point-max))
+ (insert
+ (format
+ "%s %.0f %.0f y\n"
+ (progn
+ (string-match
+ (regexp-quote
+ (file-truename (file-name-as-directory
+ (expand-file-name nnmh-toplev))))
+ dir)
+ (mm-string-to-multibyte ;Why? Isn't it multibyte already?
+ (mm-encode-coding-string
+ (nnheader-replace-chars-in-string
+ (substring dir (match-end 0))
+ ?/ ?.)
+ nnmail-pathname-coding-system)))
+ (or max 0)
+ (or min 1))))))
t)
(deffoo nnmh-request-newgroups (date &optional server)
@@ -287,7 +295,7 @@ as unread by Gnus.")
(deffoo nnmh-close-group (group &optional server)
t)
-(deffoo nnmh-request-move-article (article group server accept-form
+(deffoo nnmh-request-move-article (article group server accept-form
&optional last move-is-internal)
(let ((buf (get-buffer-create " *nnmh move*"))
result)
@@ -312,7 +320,7 @@ as unread by Gnus.")
(nnmh-possibly-change-directory group server)
(nnmail-check-syntax)
(when nnmail-cache-accepted-message-ids
- (nnmail-cache-insert (nnmail-fetch-field "message-id")
+ (nnmail-cache-insert (nnmail-fetch-field "message-id")
group
(nnmail-fetch-field "subject")
(nnmail-fetch-field "from")))
@@ -574,5 +582,4 @@ as unread by Gnus.")
(provide 'nnmh)
-;; arch-tag: 36c12a98-3bad-44b3-9953-628078ef0e04
;;; nnmh.el ends here
diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el
index 238e0221b9..6d676bb851 100644
--- a/lisp/gnus/nnml.el
+++ b/lisp/gnus/nnml.el
@@ -283,7 +283,7 @@ non-nil.")
(deffoo nnml-request-scan (&optional group server)
(setq nnml-article-file-alist nil)
(nnml-possibly-change-directory group server)
- (nnmail-get-new-mail 'nnml 'nnml-save-nov nnml-directory group))
+ (nnmail-get-new-mail 'nnml 'nnml-save-incremental-nov nnml-directory group))
(deffoo nnml-close-group (group &optional server)
(setq nnml-article-file-alist nil)
@@ -438,7 +438,7 @@ non-nil.")
(setq result (car (nnml-save-mail
(list (cons group (nnml-active-number group
server)))
- server)))
+ server t)))
(progn
(nnmail-save-active nnml-group-alist nnml-active-file)
(and last (nnml-save-nov))))
@@ -449,7 +449,7 @@ non-nil.")
(nnml-active-number group ,server)))))
(yes-or-no-p "Moved to `junk' group; delete article? "))
(setq result 'junk)
- (setq result (car (nnml-save-mail result server))))
+ (setq result (car (nnml-save-mail result server t))))
(when last
(nnmail-save-active nnml-group-alist nnml-active-file)
(when nnmail-cache-accepted-message-ids
@@ -691,7 +691,7 @@ non-nil.")
(make-directory (directory-file-name dir) t)
(nnheader-message 5 "Creating mail directory %s" dir))))
-(defun nnml-save-mail (group-art &optional server)
+(defun nnml-save-mail (group-art &optional server full-nov)
"Save a mail into the groups GROUP-ART in the nnml server SERVER.
GROUP-ART is a list that each element is a cons of a group name and an
article number. This function is called narrowed to an article."
@@ -742,11 +742,14 @@ article number. This function is called narrowed to an article."
;; header.
(setq headers (nnml-parse-head chars))
;; Output the nov line to all nov databases that should have it.
- (if nnmail-group-names-not-encoded-p
+ (let ((func (if full-nov
+ 'nnml-add-nov
+ 'nnml-add-incremental-nov)))
+ (if nnmail-group-names-not-encoded-p
+ (dolist (ga group-art)
+ (funcall func (pop dec) (cdr ga) headers))
(dolist (ga group-art)
- (nnml-add-nov (pop dec) (cdr ga) headers))
- (dolist (ga group-art)
- (nnml-add-nov (car ga) (cdr ga) headers))))
+ (funcall func (car ga) (cdr ga) headers)))))
group-art)
(defun nnml-active-number (group &optional server)
@@ -778,6 +781,35 @@ article number. This function is called narrowed to an article."
(setcdr active (1+ (cdr active))))
(cdr active)))
+(defvar nnml-incremental-nov-buffer-alist nil)
+
+(defun nnml-save-incremental-nov ()
+ (save-excursion
+ (while nnml-incremental-nov-buffer-alist
+ (when (buffer-name (cdar nnml-incremental-nov-buffer-alist))
+ (set-buffer (cdar nnml-incremental-nov-buffer-alist))
+ (when (buffer-modified-p)
+ (nnmail-write-region (point-min) (point-max)
+ nnml-nov-buffer-file-name t 'nomesg))
+ (set-buffer-modified-p nil)
+ (kill-buffer (current-buffer)))
+ (setq nnml-incremental-nov-buffer-alist
+ (cdr nnml-incremental-nov-buffer-alist)))))
+
+(defun nnml-open-incremental-nov (group)
+ (or (cdr (assoc group nnml-incremental-nov-buffer-alist))
+ (let ((buffer (nnml-get-nov-buffer group t)))
+ (push (cons group buffer) nnml-incremental-nov-buffer-alist)
+ buffer)))
+
+(defun nnml-add-incremental-nov (group article headers)
+ "Add a nov line for the GROUP nov headers, incrementally."
+ (save-excursion
+ (set-buffer (nnml-open-incremental-nov group))
+ (goto-char (point-max))
+ (mail-header-set-number headers article)
+ (nnheader-insert-nov headers)))
+
(defun nnml-add-nov (group article headers)
"Add a nov line for the GROUP base."
(save-excursion
@@ -804,16 +836,21 @@ article number. This function is called narrowed to an article."
(mail-header-set-number headers number)
headers))))
-(defun nnml-get-nov-buffer (group)
+(defun nnml-get-nov-buffer (group &optional incrementalp)
(let* ((decoded (nnml-decoded-group-name group))
- (buffer (get-buffer-create (format " *nnml overview %s*" decoded)))
+ (buffer (get-buffer-create (format " *nnml %soverview %s*"
+ (if incrementalp
+ "incremental "
+ "")
+ decoded)))
(file-name-coding-system nnmail-pathname-coding-system))
(save-excursion
(set-buffer buffer)
(set (make-local-variable 'nnml-nov-buffer-file-name)
(nnmail-group-pathname decoded nnml-directory nnml-nov-file-name))
(erase-buffer)
- (when (file-exists-p nnml-nov-buffer-file-name)
+ (when (and (not incrementalp)
+ (file-exists-p nnml-nov-buffer-file-name))
(nnheader-insert-file-contents nnml-nov-buffer-file-name)))
buffer))
@@ -1306,5 +1343,4 @@ Use the nov database for the current group if available."
(provide 'nnml)
-;; arch-tag: 52c97dc3-9735-45de-b439-9e4d23b52004
;;; nnml.el ends here
diff --git a/lisp/gnus/nnnil.el b/lisp/gnus/nnnil.el
index f20d63e70a..f6bc35aec3 100644
--- a/lisp/gnus/nnnil.el
+++ b/lisp/gnus/nnnil.el
@@ -79,4 +79,4 @@
(provide 'nnnil)
-;; arch-tag: a982a1a3-bc5e-4fb1-a233-d7657a3e3257
+;;; nnnil.el ends here
diff --git a/lisp/gnus/nnoo.el b/lisp/gnus/nnoo.el
index c57af29fb6..083bedc6e1 100644
--- a/lisp/gnus/nnoo.el
+++ b/lisp/gnus/nnoo.el
@@ -322,5 +322,4 @@ All functions will return nil and report an error."
(provide 'nnoo)
-;; arch-tag: 0196b5ed-6f34-4778-a455-73a971f837e7
;;; nnoo.el ends here
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
index db1df33757..8d8a40d002 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -498,7 +498,7 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
(defun nnrss-normalize-date (date)
"Return a date string of DATE in the RFC822 style.
This function handles the ISO 8601 date format described in
-<URL:http://www.w3.org/TR/NOTE-datetime>, and also the RFC822 style
+URL `http://www.w3.org/TR/NOTE-datetime', and also the RFC822 style
which RSS 2.0 allows."
(let (case-fold-search vector year month day time zone cts given)
(cond ((null date)) ; do nothing for this case
@@ -1012,7 +1012,7 @@ whether they are `offsite' or `onsite'."
(defun nnrss-discover-feed (url)
"Given a page, find an RSS feed using Mark Pilgrim's
-`ultra-liberal rss locator' (http://diveintomark.org/2002/08/15.html)."
+`ultra-liberal rss locator' (URL `http://diveintomark.org/2002/08/15.html')."
(let ((parsed-page (nnrss-fetch url)))
@@ -1134,5 +1134,4 @@ prefix), return the prefix."
(provide 'nnrss)
-;; arch-tag: 12910c07-0cdf-44fb-8d2c-416ded64c267
;;; nnrss.el ends here
diff --git a/lisp/gnus/nnslashdot.el b/lisp/gnus/nnslashdot.el
deleted file mode 100644
index 3a0d6077ad..0000000000
--- a/lisp/gnus/nnslashdot.el
+++ /dev/null
@@ -1,505 +0,0 @@
-;;; nnslashdot.el --- interfacing with Slashdot
-
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <[email protected]>
-;; Keywords: news
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'nnoo)
-(require 'message)
-(require 'gnus-util)
-(require 'gnus)
-(require 'nnmail)
-(require 'mm-util)
-(require 'mm-url)
-
-(nnoo-declare nnslashdot)
-
-(defvoo nnslashdot-directory (nnheader-concat gnus-directory "slashdot/")
- "Where nnslashdot will save its files.")
-
-(defvoo nnslashdot-active-url "http://slashdot.org/search.pl?section=&min=%d"
- "Where nnslashdot will fetch the active file from.")
-
-(defvoo nnslashdot-comments-url "http://slashdot.org/comments.pl?sid=%s&threshold=%d&commentsort=%d&mode=flat&startat=%d"
- "Where nnslashdot will fetch comments from.")
-
-(defvoo nnslashdot-article-url
- "http://slashdot.org/article.pl?sid=%s&mode=nocomment"
- "Where nnslashdot will fetch the article from.")
-
-(defvoo nnslashdot-backslash-url "http://slashdot.org/slashdot.xml"
- "Where nnslashdot will fetch the stories from.")
-
-(defvoo nnslashdot-use-front-page nil
- "Use the front page in addition to the backslash page.")
-
-(defvoo nnslashdot-threshold -1
- "The article threshold.")
-
-(defvoo nnslashdot-threaded t
- "Whether the nnslashdot groups should be threaded or not.")
-
-(defvoo nnslashdot-group-number 0
- "The number of non-fresh groups to keep updated.")
-
-(defvoo nnslashdot-login-name ""
- "The login name to use when posting.")
-
-(defvoo nnslashdot-password ""
- "The password to use when posting.")
-
-;;; Internal variables
-
-(defvar nnslashdot-groups nil)
-(defvar nnslashdot-buffer nil)
-(defvar nnslashdot-headers nil)
-
-;;; Interface functions
-
-(nnoo-define-basics nnslashdot)
-
-(deffoo nnslashdot-retrieve-headers (articles &optional group server fetch-old)
- (nnslashdot-possibly-change-server group server)
- (condition-case why
- (unless gnus-nov-is-evil
- (nnslashdot-retrieve-headers-1 articles group))
- (search-failed (nnslashdot-lose why))))
-
-(deffoo nnslashdot-retrieve-headers-1 (articles group)
- (let* ((last (car (last articles)))
- (start (if nnslashdot-threaded 1 (pop articles)))
- (entry (assoc group nnslashdot-groups))
- (sid (nth 2 entry))
- (first-comments t)
- headers article subject score from date lines parent point cid
- s startats changed)
- (save-excursion
- (set-buffer nnslashdot-buffer)
- (let ((case-fold-search t))
- (erase-buffer)
- (when (= start 1)
- (mm-url-insert (format nnslashdot-article-url sid) t)
- (goto-char (point-min))
- (if (eobp)
- (error "Couldn't open connection to slashdot"))
- (re-search-forward "Posted by[ \t\r\n]+")
- (when (looking-at "\\(<a[^>]+>\\)?[ \t\r\n]*\\([^<\r\n]+\\)")
- (setq from (mm-url-decode-entities-string (match-string 2))))
- (search-forward "on ")
- (setq date (nnslashdot-date-to-date
- (buffer-substring (point) (1- (search-forward "<")))))
- (setq lines (/ (- (point)
- (progn (forward-line 1) (point)))
- 60))
- (push
- (cons
- 1
- (make-full-mail-header
- 1 group from date
- (concat "<" sid "%1@slashdot>")
- "" 0 lines nil nil))
- headers)
- (setq start (if nnslashdot-threaded 2 (pop articles))))
- (while (and start (<= start last))
- (setq point (goto-char (point-max)))
- (mm-url-insert
- (format nnslashdot-comments-url sid
- nnslashdot-threshold 0 (- start 2))
- t)
- (when (and nnslashdot-threaded first-comments)
- (setq first-comments nil)
- (goto-char (point-max))
- (while (re-search-backward "startat=\\([0-9]+\\)" nil t)
- (setq s (string-to-number (match-string 1)))
- (unless (memq s startats)
- (push s startats)))
- (setq startats (sort startats '<)))
- (setq article (if (and article (< start article)) article start))
- (goto-char point)
- (while (re-search-forward
- "<a name=\"\\([0-9]+\\)\">\\([^<]+\\)\\(?:.*\n\\)\\{2,10\\}.*score:\\([^)]+\\))"
- nil t)
- (setq cid (match-string 1)
- subject (match-string 2)
- score (match-string 3))
- (unless (assq article (nth 4 entry))
- (setcar (nthcdr 4 entry) (cons (cons article cid) (nth 4 entry)))
- (setq changed t))
- (when (string-match "^Re: *" subject)
- (setq subject (concat "Re: " (substring subject (match-end 0)))))
- (setq subject (mm-url-decode-entities-string subject)
- from "")
- (when (re-search-forward "by[ \t\n]+<[^>]+>\\([^<(]+\\)" nil t)
- (setq from
- (concat
- (mm-url-decode-entities-string (match-string 1))
- (search-forward "on ")
- (setq date
- (nnslashdot-date-to-date
- (buffer-substring
- (point) (progn (skip-chars-forward "^()<>\n\r") (point)))))
- (setq lines (/ (abs (- (search-forward "<div")
- (search-forward "</div>")))
- 70))
- (if (not
- (re-search-forward ".*cid=\\([0-9]+\\)\">Parent</A>" nil t))
- (setq parent nil)
- (setq parent (match-string 1))
- (when (string= parent "0")
- (setq parent nil)))
- (push
- (cons
- article
- (make-full-mail-header
- article
- (concat subject " (" score ")")
- from date
- (concat "<" sid "%" cid "@slashdot>")
- (if parent
- (concat "<" sid "%" parent "@slashdot>")
- "")
- 0 lines nil nil))
- headers)
- (while (and articles (<= (car articles) article))
- (pop articles))
- (setq article (1+ article)))
- (if nnslashdot-threaded
- (progn
- (setq start (pop startats))
- (if start (setq start (+ start 2))))
- (setq start (pop articles))))))
- (if changed (nnslashdot-write-groups))
- (setq nnslashdot-headers (sort headers 'car-less-than-car))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (mm-with-unibyte-current-buffer
- (dolist (header nnslashdot-headers)
- (nnheader-insert-nov (cdr header)))))
- 'nov))
-
-(deffoo nnslashdot-request-group (group &optional server dont-check)
- (nnslashdot-possibly-change-server nil server)
- (let ((elem (assoc group nnslashdot-groups)))
- (cond
- ((not elem)
- (nnheader-report 'nnslashdot "Group does not exist"))
- (t
- (nnheader-report 'nnslashdot "Opened group %s" group)
- (nnheader-insert
- "211 %d %d %d %s\n" (cadr elem) 1 (cadr elem)
- (prin1-to-string group))))))
-
-(deffoo nnslashdot-close-group (group &optional server)
- (nnslashdot-possibly-change-server group server)
- (when (gnus-buffer-live-p nnslashdot-buffer)
- (save-excursion
- (set-buffer nnslashdot-buffer)
- (kill-buffer nnslashdot-buffer)))
- t)
-
-(deffoo nnslashdot-request-article (article &optional group server buffer)
- (nnslashdot-possibly-change-server group server)
- (let (contents cid)
- (condition-case why
- (save-excursion
- (set-buffer nnslashdot-buffer)
- (let ((case-fold-search t))
- (goto-char (point-min))
- (when (and (stringp article)
- (string-match "%\\([0-9]+\\)@" article))
- (setq cid (match-string 1 article))
- (let ((map (nth 4 (assoc group nnslashdot-groups))))
- (while map
- (if (equal (cdar map) cid)
- (setq article (caar map)
- map nil)
- (setq map (cdr map))))))
- (when (numberp article)
- (if (= article 1)
- (progn
- (search-forward "Posted by")
- (search-forward "<div class=\"intro\">")
- (setq contents
- (buffer-substring
- (point)
- (progn
- (search-forward "commentwrap")
- (match-beginning 0)))))
- (setq cid (cdr (assq article
- (nth 4 (assoc group nnslashdot-groups)))))
- (search-forward (format "<a name=\"%s\">" cid))
- (setq contents
- (buffer-substring
- (search-forward "<div class=\"commentBody\">")
- (progn
- (search-forward "<div class=\"commentSub\"")
- (match-beginning 0))))))))
- (search-failed (nnslashdot-lose why)))
-
- (when contents
- (save-excursion
- (set-buffer (or buffer nntp-server-buffer))
- (erase-buffer)
- (mm-with-unibyte-current-buffer
- (insert contents)
- (goto-char (point-min))
- (while (re-search-forward "\\(<br>\r?\\)+" nil t)
- (replace-match "<p>" t t))
- (goto-char (point-min))
- (insert "Content-Type: text/html\nMIME-Version: 1.0\n")
- (insert "Newsgroups: " (caddr (assoc group nnslashdot-groups))
- "\n")
- (let ((header (cdr (assq article nnslashdot-headers))))
- (nnheader-insert-header header))
- (nnheader-report 'nnslashdot "Fetched article %s" article))
- (cons group article)))))
-
-(deffoo nnslashdot-close-server (&optional server)
- (when (and (nnslashdot-server-opened server)
- (gnus-buffer-live-p nnslashdot-buffer))
- (save-excursion
- (set-buffer nnslashdot-buffer)
- (kill-buffer nnslashdot-buffer)))
- (nnoo-close-server 'nnslashdot server))
-
-(deffoo nnslashdot-request-list (&optional server)
- (nnslashdot-possibly-change-server nil server)
- (let ((number 0)
- (first nnslashdot-use-front-page)
- sid elem description articles gname)
- (condition-case why
- ;; First we do the Ultramode to get info on all the latest groups.
- (progn
- (mm-with-unibyte-buffer
- (mm-url-insert nnslashdot-backslash-url t)
- (goto-char (point-min))
- (if (eobp)
- (error "Couldn't open connection to slashdot"))
- (while (search-forward "<story>" nil t)
- (narrow-to-region (point) (search-forward "</story>"))
- (goto-char (point-min))
- (re-search-forward "<title>\\([^<]+\\)</title>")
- (setq description
- (mm-url-decode-entities-string (match-string 1)))
- (re-search-forward "<url>\\([^<]+\\)</url>")
- (setq sid (match-string 1))
- (string-match "sid=\\([0-9/]+\\)\\(.shtml\\|$\\)" sid)
- (setq sid (match-string 1 sid))
- (re-search-forward "<comments>\\([^<]+\\)</comments>")
- (setq articles (string-to-number (match-string 1)))
- (setq gname (concat description " (" sid ")"))
- (if (setq elem (assoc gname nnslashdot-groups))
- (setcar (cdr elem) articles)
- (push (list gname articles sid (current-time) nil)
- nnslashdot-groups))
- (goto-char (point-max))
- (widen)))
- ;; Then do the older groups.
- (while (or first
- (> (- nnslashdot-group-number number) 0))
- (setq first nil)
- (mm-with-unibyte-buffer
- (let ((case-fold-search t))
- (mm-url-insert (format nnslashdot-active-url number) t)
- (goto-char (point-min))
- (while (re-search-forward
- "article.pl\\?sid=\\([^&]+\\).*>\\([^<]+\\)</a>"
- nil t)
- (setq sid (match-string 1)
- description
- (mm-url-decode-entities-string (match-string 2)))
- (forward-line 1)
- (when (re-search-forward "with \\([0-9]+\\) comment" nil t)
- (setq articles (1+ (string-to-number (match-string 1)))))
- (setq gname (concat description " (" sid ")"))
- (if (setq elem (assoc gname nnslashdot-groups))
- (setcar (cdr elem) articles)
- (push (list gname articles sid (current-time) nil)
- nnslashdot-groups)))))
- (incf number 30)))
- (search-failed (nnslashdot-lose why)))
- (nnslashdot-write-groups)
- (nnslashdot-generate-active)
- t))
-
-(deffoo nnslashdot-request-newgroups (date &optional server)
- (nnslashdot-possibly-change-server nil server)
- (nnslashdot-generate-active)
- t)
-
-(deffoo nnslashdot-request-post (&optional server)
- (nnslashdot-possibly-change-server nil server)
- (let ((sid (message-fetch-field "newsgroups"))
- (subject (message-fetch-field "subject"))
- (references (car (last (split-string
- (message-fetch-field "references")))))
- body quoted pid)
- (string-match "%\\([0-9]+\\)@slashdot" references)
- (setq pid (match-string 1 references))
- (message-goto-body)
- (narrow-to-region (point) (progn (message-goto-signature) (point)))
- (goto-char (point-min))
- (while (not (eobp))
- (if (looking-at "> ")
- (progn
- (delete-region (point) (+ (point) 2))
- (unless quoted
- (insert "<blockquote>\n"))
- (setq quoted t))
- (when quoted
- (insert "</blockquote>\n")
- (setq quoted nil)))
- (forward-line 1))
- (goto-char (point-min))
- (while (re-search-forward "^ *\n" nil t)
- (replace-match "<p>\n"))
- (widen)
- (when (message-goto-signature)
- (forward-line -1)
- (insert "<p>\n")
- (while (not (eobp))
- (end-of-line)
- (insert "<br>")
- (forward-line 1)))
- (message-goto-body)
- (setq body (buffer-substring (point) (point-max)))
- (erase-buffer)
- (mm-url-fetch-form
- "http://slashdot.org/comments.pl"
- `(("sid" . ,sid)
- ("pid" . ,pid)
- ("rlogin" . "userlogin")
- ("unickname" . ,nnslashdot-login-name)
- ("upasswd" . ,nnslashdot-password)
- ("postersubj" . ,subject)
- ("op" . "Submit")
- ("postercomment" . ,body)
- ("posttype" . "html")))))
-
-(deffoo nnslashdot-request-delete-group (group &optional force server)
- (nnslashdot-possibly-change-server group server)
- (setq nnslashdot-groups (delq (assoc group nnslashdot-groups)
- nnslashdot-groups))
- (nnslashdot-write-groups))
-
-(deffoo nnslashdot-request-close ()
- (setq nnslashdot-headers nil
- nnslashdot-groups nil))
-
-(deffoo nnslashdot-request-expire-articles
- (articles group &optional server force)
- (nnslashdot-possibly-change-server group server)
- (let ((item (assoc group nnslashdot-groups)))
- (when item
- (if (fourth item)
- (when (and (>= (length articles) (cadr item)) ;; All are expirable.
- (nnmail-expired-article-p
- group
- (fourth item)
- force))
- (setq nnslashdot-groups (delq item nnslashdot-groups))
- (nnslashdot-write-groups)
- (setq articles nil)) ;; all expired.
- (setcdr (cddr item) (list (current-time)))
- (nnslashdot-write-groups))))
- articles)
-
-(nnoo-define-skeleton nnslashdot)
-
-;;; Internal functions
-
-(defun nnslashdot-possibly-change-server (&optional group server)
- (nnslashdot-init server)
- (when (and server
- (not (nnslashdot-server-opened server)))
- (nnslashdot-open-server server))
- (unless nnslashdot-groups
- (nnslashdot-read-groups)))
-
-(defun nnslashdot-make-tuple (tuple n)
- (prog1
- tuple
- (while (> n 1)
- (unless (cdr tuple)
- (setcdr tuple (list nil)))
- (setq tuple (cdr tuple)
- n (1- n)))))
-
-(defun nnslashdot-read-groups ()
- (let ((file (expand-file-name "groups" nnslashdot-directory)))
- (when (file-exists-p file)
- (mm-with-unibyte-buffer
- (insert-file-contents file)
- (goto-char (point-min))
- (setq nnslashdot-groups (read (current-buffer))))
- (when (and nnslashdot-groups (< (length (car nnslashdot-groups)) 5))
- (dolist (group nnslashdot-groups)
- (nnslashdot-make-tuple group 5))))))
-
-(defun nnslashdot-write-groups ()
- (with-temp-file (expand-file-name "groups" nnslashdot-directory)
- (gnus-prin1 nnslashdot-groups)))
-
-(defun nnslashdot-init (server)
- "Initialize buffers and such."
- (unless (file-exists-p nnslashdot-directory)
- (gnus-make-directory nnslashdot-directory))
- (unless (gnus-buffer-live-p nnslashdot-buffer)
- (setq nnslashdot-buffer
- (save-excursion
- (nnheader-set-temp-buffer
- (format " *nnslashdot %s*" server))))
- (push nnslashdot-buffer gnus-buffers)))
-
-(defun nnslashdot-date-to-date (sdate)
- (condition-case err
- (let ((elem (delete "" (split-string sdate))))
- (concat (substring (nth 0 elem) 0 3) " "
- (substring (nth 1 elem) 0 3) " "
- (substring (nth 2 elem) 0 2) " "
- (substring (nth 3 elem) 1 6) " "
- (format-time-string "%Y") " "
- (nth 4 elem)))
- (error "")))
-
-(defun nnslashdot-generate-active ()
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (dolist (elem nnslashdot-groups)
- (when (numberp (cadr elem))
- (insert (prin1-to-string (car elem))
- " " (number-to-string (cadr elem)) " 1 y\n")))))
-
-(defun nnslashdot-lose (why)
- (error "Slashdot HTML has changed; please get a new version of nnslashdot"))
-
-(provide 'nnslashdot)
-
-;; arch-tag: aa73df7a-f7e6-4eef-bdea-5ce2f8c691b3
-;;; nnslashdot.el ends here
diff --git a/lisp/gnus/nnsoup.el b/lisp/gnus/nnsoup.el
deleted file mode 100644
index 3cb453818b..0000000000
--- a/lisp/gnus/nnsoup.el
+++ /dev/null
@@ -1,812 +0,0 @@
-;;; nnsoup.el --- SOUP access for Gnus
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <[email protected]>
-;; Masanobu UMEDA <[email protected]>
-;; Keywords: news, mail
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'nnheader)
-(require 'nnmail)
-(require 'gnus-soup)
-(require 'gnus-msg)
-(require 'nnoo)
-(eval-when-compile (require 'cl))
-
-(nnoo-declare nnsoup)
-
-(defvoo nnsoup-directory (nnheader-concat gnus-home-directory "SOUP/")
- "*SOUP packet directory.")
-
-(defvoo nnsoup-tmp-directory
- (cond ((fboundp 'temp-directory) (temp-directory))
- ((boundp 'temporary-file-directory) temporary-file-directory)
- ("/tmp/"))
- "*Where nnsoup will store temporary files.")
-
-(defvoo nnsoup-replies-directory (expand-file-name "replies/" nnsoup-directory)
- "*Directory where outgoing packets will be composed.")
-
-(defvoo nnsoup-replies-format-type ?u ;; u is USENET news format.
- "*Format of the replies packages.")
-
-(defvoo nnsoup-replies-index-type ?n
- "*Index type of the replies packages.")
-
-(defvoo nnsoup-active-file (expand-file-name "active" nnsoup-directory)
- "Active file.")
-
-(defvoo nnsoup-packer (concat "tar cf - %s | gzip > "
- (expand-file-name gnus-home-directory)
- "Soupin%d.tgz")
- "Format string command for packing a SOUP packet.
-The SOUP files will be inserted where the %s is in the string.
-This string MUST contain both %s and %d. The file number will be
-inserted where %d appears.")
-
-(defvoo nnsoup-unpacker "gunzip -c %s | tar xvf -"
- "*Format string command for unpacking a SOUP packet.
-The SOUP packet file name will be inserted at the %s.")
-
-(defvoo nnsoup-packet-directory gnus-home-directory
- "*Where nnsoup will look for incoming packets.")
-
-(defvoo nnsoup-packet-regexp "Soupout"
- "*Regular expression matching SOUP packets in `nnsoup-packet-directory'.")
-
-(defvoo nnsoup-always-save t
- "If non-nil commit the reply buffer on each message send.
-This is necessary if using message mode outside Gnus with nnsoup as a
-backend for the messages.")
-
-
-
-(defconst nnsoup-version "nnsoup 0.0"
- "nnsoup version.")
-
-(defvoo nnsoup-status-string "")
-(defvoo nnsoup-group-alist nil)
-(defvoo nnsoup-current-prefix 0)
-(defvoo nnsoup-replies-list nil)
-(defvoo nnsoup-buffers nil)
-(defvoo nnsoup-current-group nil)
-(defvoo nnsoup-group-alist-touched nil)
-(defvoo nnsoup-article-alist nil)
-
-
-;;; Interface functions.
-
-(nnoo-define-basics nnsoup)
-
-(deffoo nnsoup-retrieve-headers (sequence &optional group server fetch-old)
- (nnsoup-possibly-change-group group)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (let ((areas (cddr (assoc nnsoup-current-group nnsoup-group-alist)))
- (articles sequence)
- (use-nov t)
- useful-areas this-area-seq msg-buf)
- (if (stringp (car sequence))
- ;; We don't support fetching by Message-ID.
- 'headers
- ;; We go through all the areas and find which files the
- ;; articles in SEQUENCE come from.
- (while (and areas sequence)
- ;; Peel off areas that are below sequence.
- (while (and areas (< (cdar (car areas)) (car sequence)))
- (setq areas (cdr areas)))
- (when areas
- ;; This is a useful area.
- (push (car areas) useful-areas)
- (setq this-area-seq nil)
- ;; We take note whether this MSG has a corresponding IDX
- ;; for later use.
- (when (or (= (gnus-soup-encoding-index
- (gnus-soup-area-encoding (nth 1 (car areas)))) ?n)
- (not (file-exists-p
- (nnsoup-file
- (gnus-soup-area-prefix (nth 1 (car areas)))))))
- (setq use-nov nil))
- ;; We assign the portion of `sequence' that is relevant to
- ;; this MSG packet to this packet.
- (while (and sequence (<= (car sequence) (cdar (car areas))))
- (push (car sequence) this-area-seq)
- (setq sequence (cdr sequence)))
- (setcar useful-areas (cons (nreverse this-area-seq)
- (car useful-areas)))))
-
- ;; We now have a list of article numbers and corresponding
- ;; areas.
- (setq useful-areas (nreverse useful-areas))
-
- ;; Two different approaches depending on whether all the MSG
- ;; files have corresponding IDX files. If they all do, we
- ;; simply return the relevant IDX files and let Gnus sort out
- ;; what lines are relevant. If some of the IDX files are
- ;; missing, we must return HEADs for all the articles.
- (if use-nov
- ;; We have IDX files for all areas.
- (progn
- (while useful-areas
- (goto-char (point-max))
- (let ((b (point))
- (number (car (nth 1 (car useful-areas))))
- (index-buffer (nnsoup-index-buffer
- (gnus-soup-area-prefix
- (nth 2 (car useful-areas))))))
- (when index-buffer
- (insert-buffer-substring index-buffer)
- (goto-char b)
- ;; We have to remove the index number entries and
- ;; insert article numbers instead.
- (while (looking-at "[0-9]+")
- (replace-match (int-to-string number) t t)
- (incf number)
- (forward-line 1))))
- (setq useful-areas (cdr useful-areas)))
- 'nov)
- ;; We insert HEADs.
- (while useful-areas
- (setq articles (caar useful-areas)
- useful-areas (cdr useful-areas))
- (while articles
- (when (setq msg-buf
- (nnsoup-narrow-to-article
- (car articles) (cdar useful-areas) 'head))
- (goto-char (point-max))
- (insert (format "221 %d Article retrieved.\n" (car articles)))
- (insert-buffer-substring msg-buf)
- (goto-char (point-max))
- (insert ".\n"))
- (setq articles (cdr articles))))
-
- (nnheader-fold-continuation-lines)
- 'headers)))))
-
-(deffoo nnsoup-open-server (server &optional defs)
- (nnoo-change-server 'nnsoup server defs)
- (when (not (file-exists-p nnsoup-directory))
- (condition-case ()
- (make-directory nnsoup-directory t)
- (error t)))
- (cond
- ((not (file-exists-p nnsoup-directory))
- (nnsoup-close-server)
- (nnheader-report 'nnsoup "Couldn't create directory: %s" nnsoup-directory))
- ((not (file-directory-p (file-truename nnsoup-directory)))
- (nnsoup-close-server)
- (nnheader-report 'nnsoup "Not a directory: %s" nnsoup-directory))
- (t
- (nnsoup-read-active-file)
- (nnheader-report 'nnsoup "Opened server %s using directory %s"
- server nnsoup-directory)
- t)))
-
-(deffoo nnsoup-request-close ()
- (nnsoup-write-active-file)
- (nnsoup-write-replies)
- (gnus-soup-save-areas)
- ;; Kill all nnsoup buffers.
- (let (buffer)
- (while nnsoup-buffers
- (setq buffer (cdr (pop nnsoup-buffers)))
- (and buffer
- (buffer-name buffer)
- (kill-buffer buffer))))
- (setq nnsoup-group-alist nil
- nnsoup-group-alist-touched nil
- nnsoup-current-group nil
- nnsoup-replies-list nil)
- (nnoo-close-server 'nnoo)
- t)
-
-(deffoo nnsoup-request-article (id &optional newsgroup server buffer)
- (nnsoup-possibly-change-group newsgroup)
- (let (buf)
- (save-excursion
- (set-buffer (or buffer nntp-server-buffer))
- (erase-buffer)
- (when (and (not (stringp id))
- (setq buf (nnsoup-narrow-to-article id)))
- (insert-buffer-substring buf)
- t))))
-
-(deffoo nnsoup-request-group (group &optional server dont-check)
- (nnsoup-possibly-change-group group)
- (if dont-check
- t
- (let ((active (cadr (assoc group nnsoup-group-alist))))
- (if (not active)
- (nnheader-report 'nnsoup "No such group: %s" group)
- (nnheader-insert
- "211 %d %d %d %s\n"
- (max (1+ (- (cdr active) (car active))) 0)
- (car active) (cdr active) group)))))
-
-(deffoo nnsoup-request-type (group &optional article)
- (nnsoup-possibly-change-group group)
- ;; Try to guess the type based on the first article in the group.
- (when (not article)
- (setq article
- (cdar (car (cddr (assoc group nnsoup-group-alist))))))
- (if (not article)
- 'unknown
- (let ((kind (gnus-soup-encoding-kind
- (gnus-soup-area-encoding
- (nth 1 (nnsoup-article-to-area
- article nnsoup-current-group))))))
- (cond ((= kind ?m) 'mail)
- ((= kind ?n) 'news)
- (t 'unknown)))))
-
-(deffoo nnsoup-close-group (group &optional server)
- ;; Kill all nnsoup buffers.
- (let ((buffers nnsoup-buffers)
- elem)
- (while buffers
- (when (equal (car (setq elem (pop buffers))) group)
- (setq nnsoup-buffers (delq elem nnsoup-buffers))
- (and (cdr elem) (buffer-name (cdr elem))
- (kill-buffer (cdr elem))))))
- t)
-
-(deffoo nnsoup-request-list (&optional server)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (unless nnsoup-group-alist
- (nnsoup-read-active-file))
- (let ((alist nnsoup-group-alist)
- (standard-output (current-buffer))
- entry)
- (while (setq entry (pop alist))
- (insert (car entry) " ")
- (princ (cdadr entry))
- (insert " ")
- (princ (caadr entry))
- (insert " y\n"))
- t)))
-
-(deffoo nnsoup-request-scan (group &optional server)
- (nnsoup-unpack-packets))
-
-(deffoo nnsoup-request-newgroups (date &optional server)
- (nnsoup-request-list))
-
-(deffoo nnsoup-request-list-newsgroups (&optional server)
- nil)
-
-(deffoo nnsoup-request-post (&optional server)
- (nnsoup-store-reply "news")
- t)
-
-(deffoo nnsoup-request-mail (&optional server)
- (nnsoup-store-reply "mail")
- t)
-
-(deffoo nnsoup-request-expire-articles (articles group &optional server force)
- (nnsoup-possibly-change-group group)
- (let* ((total-infolist (assoc group nnsoup-group-alist))
- (active (cadr total-infolist))
- (infolist (cddr total-infolist))
- info range-list mod-time prefix)
- (while infolist
- (setq info (pop infolist)
- range-list (gnus-uncompress-range (car info))
- prefix (gnus-soup-area-prefix (nth 1 info)))
- (when;; All the articles in this file are marked for expiry.
- (and (or (setq mod-time (nth 5 (file-attributes
- (nnsoup-file prefix))))
- (setq mod-time (nth 5 (file-attributes
- (nnsoup-file prefix t)))))
- (gnus-sublist-p articles range-list)
- ;; This file is old enough.
- (nnmail-expired-article-p group mod-time force))
- ;; Ok, we delete this file.
- (when (ignore-errors
- (nnheader-message
- 5 "Deleting %s in group %s..." (nnsoup-file prefix)
- group)
- (when (file-exists-p (nnsoup-file prefix))
- (delete-file (nnsoup-file prefix)))
- (nnheader-message
- 5 "Deleting %s in group %s..." (nnsoup-file prefix t)
- group)
- (when (file-exists-p (nnsoup-file prefix t))
- (delete-file (nnsoup-file prefix t)))
- t)
- (setcdr (cdr total-infolist) (delq info (cddr total-infolist)))
- (setq articles (gnus-sorted-difference articles range-list))))
- (when (not mod-time)
- (setcdr (cdr total-infolist) (delq info (cddr total-infolist)))))
- (if (cddr total-infolist)
- (setcar active (caaadr (cdr total-infolist)))
- (setcar active (1+ (cdr active))))
- (nnsoup-write-active-file t)
- ;; Return the articles that weren't expired.
- articles))
-
-
-;;; Internal functions
-
-(defun nnsoup-possibly-change-group (group &optional force)
- (when (and group
- (not (equal nnsoup-current-group group)))
- (setq nnsoup-article-alist nil)
- (setq nnsoup-current-group group))
- t)
-
-(defun nnsoup-read-active-file ()
- (setq nnsoup-group-alist nil)
- (when (file-exists-p nnsoup-active-file)
- (ignore-errors
- (load nnsoup-active-file t t t))
- ;; Be backwards compatible.
- (when (and nnsoup-group-alist
- (not (atom (caadar nnsoup-group-alist))))
- (let ((alist nnsoup-group-alist)
- entry e min max)
- (while (setq e (cdr (setq entry (pop alist))))
- (setq min (caaar e))
- (setq max (cdar (car (last e))))
- (setcdr entry (cons (cons min max) (cdr entry)))))
- (setq nnsoup-group-alist-touched t))
- nnsoup-group-alist))
-
-(defun nnsoup-write-active-file (&optional force)
- (when (and nnsoup-group-alist
- (or force
- nnsoup-group-alist-touched))
- (setq nnsoup-group-alist-touched nil)
- (with-temp-file nnsoup-active-file
- (gnus-prin1 `(setq nnsoup-group-alist ',nnsoup-group-alist))
- (insert "\n")
- (gnus-prin1 `(setq nnsoup-current-prefix ,nnsoup-current-prefix))
- (insert "\n"))))
-
-(defun nnsoup-next-prefix ()
- "Return the next free prefix."
- (let (prefix)
- (while (or (file-exists-p
- (nnsoup-file (setq prefix (int-to-string
- nnsoup-current-prefix))))
- (file-exists-p (nnsoup-file prefix t)))
- (incf nnsoup-current-prefix))
- (incf nnsoup-current-prefix)
- prefix))
-
-(defun nnsoup-file-name (dir file)
- "Return the full name of FILE (in any case) in DIR."
- (let* ((case-fold-search t)
- (files (directory-files dir t))
- (regexp (concat (regexp-quote file) "$")))
- (car (delq nil
- (mapcar
- (lambda (file)
- (if (string-match regexp file)
- file
- nil))
- files)))))
-
-(defun nnsoup-read-areas ()
- (let ((areas-file (nnsoup-file-name nnsoup-tmp-directory "areas")))
- (when areas-file
- (save-excursion
- (set-buffer nntp-server-buffer)
- (let ((areas (gnus-soup-parse-areas areas-file))
- entry number area lnum cur-prefix file)
- ;; Go through all areas in the new AREAS file.
- (while (setq area (pop areas))
- ;; Change the name to the permanent name and move the files.
- (setq cur-prefix (nnsoup-next-prefix))
- (nnheader-message 5 "Incorporating file %s..." cur-prefix)
- (when (file-exists-p
- (setq file
- (expand-file-name
- (concat (gnus-soup-area-prefix area) ".IDX")
- nnsoup-tmp-directory)))
- (rename-file file (nnsoup-file cur-prefix)))
- (when (file-exists-p
- (setq file (expand-file-name
- (concat (gnus-soup-area-prefix area) ".MSG")
- nnsoup-tmp-directory)))
- (rename-file file (nnsoup-file cur-prefix t))
- (gnus-soup-set-area-prefix area cur-prefix)
- ;; Find the number of new articles in this area.
- (setq number (nnsoup-number-of-articles area))
- (if (not (setq entry (assoc (gnus-soup-area-name area)
- nnsoup-group-alist)))
- ;; If this is a new area (group), we just add this info to
- ;; the group alist.
- (push (list (gnus-soup-area-name area)
- (cons 1 number)
- (list (cons 1 number) area))
- nnsoup-group-alist)
- ;; There are already articles in this group, so we add this
- ;; info to the end of the entry.
- (nconc entry (list (list (cons (1+ (setq lnum (cdadr entry)))
- (+ lnum number))
- area)))
- (setcdr (cadr entry) (+ lnum number))))))
- (nnsoup-write-active-file t)
- (delete-file areas-file)))))
-
-(defun nnsoup-number-of-articles (area)
- (save-excursion
- (cond
- ;; If the number is in the area info, we just return it.
- ((gnus-soup-area-number area)
- (gnus-soup-area-number area))
- ;; If there is an index file, we just count the lines.
- ((/= (gnus-soup-encoding-index (gnus-soup-area-encoding area)) ?n)
- (set-buffer (nnsoup-index-buffer (gnus-soup-area-prefix area)))
- (count-lines (point-min) (point-max)))
- ;; We do it the hard way - re-searching through the message
- ;; buffer.
- (t
- (set-buffer (nnsoup-message-buffer (gnus-soup-area-prefix area)))
- (unless (assoc (gnus-soup-area-prefix area) nnsoup-article-alist)
- (nnsoup-dissect-buffer area))
- (length (cdr (assoc (gnus-soup-area-prefix area)
- nnsoup-article-alist)))))))
-
-(defun nnsoup-dissect-buffer (area)
- (let ((mbox-delim (concat "^" message-unix-mail-delimiter))
- (format (gnus-soup-encoding-format (gnus-soup-area-encoding area)))
- (i 0)
- alist len)
- (goto-char (point-min))
- (cond
- ;; rnews batch format
- ((or (= format ?u)
- (= format ?n)) ;; Gnus back compatibility.
- (while (looking-at "^#! *rnews \\(+[0-9]+\\) *$")
- (forward-line 1)
- (push (list
- (incf i) (point)
- (progn
- (forward-char (string-to-number (match-string 1)))
- (point)))
- alist)))
- ;; Unix mbox format
- ((= format ?m)
- (while (looking-at mbox-delim)
- (forward-line 1)
- (push (list
- (incf i) (point)
- (progn
- (if (re-search-forward mbox-delim nil t)
- (beginning-of-line)
- (goto-char (point-max)))
- (point)))
- alist)))
- ;; MMDF format
- ((= format ?M)
- (while (looking-at "\^A\^A\^A\^A\n")
- (forward-line 1)
- (push (list
- (incf i) (point)
- (progn
- (if (search-forward "\n\^A\^A\^A\^A\n" nil t)
- (beginning-of-line)
- (goto-char (point-max)))
- (point)))
- alist)))
- ;; Binary format
- ((or (= format ?B) (= format ?b))
- (while (not (eobp))
- (setq len (+ (* (char-after (point)) (expt 2.0 24))
- (* (char-after (+ (point) 1)) (expt 2 16))
- (* (char-after (+ (point) 2)) (expt 2 8))
- (char-after (+ (point) 3))))
- (push (list
- (incf i) (+ (point) 4)
- (progn
- (forward-char (floor (+ len 4)))
- (point)))
- alist)))
- (t
- (error "Unknown format: %c" format)))
- (push (cons (gnus-soup-area-prefix area) alist) nnsoup-article-alist)))
-
-(defun nnsoup-index-buffer (prefix &optional message)
- (let* ((file (concat prefix (if message ".MSG" ".IDX")))
- (buffer-name (concat " *nnsoup " file "*")))
- (or (get-buffer buffer-name) ; File already loaded.
- (when (file-exists-p (expand-file-name file nnsoup-directory))
- (save-excursion ; Load the file.
- (set-buffer (get-buffer-create buffer-name))
- (buffer-disable-undo)
- (push (cons nnsoup-current-group (current-buffer)) nnsoup-buffers)
- (nnheader-insert-file-contents
- (expand-file-name file nnsoup-directory))
- (current-buffer))))))
-
-(defun nnsoup-file (prefix &optional message)
- (expand-file-name
- (concat prefix (if message ".MSG" ".IDX"))
- nnsoup-directory))
-
-(defun nnsoup-message-buffer (prefix)
- (nnsoup-index-buffer prefix 'msg))
-
-(defun nnsoup-unpack-packets ()
- "Unpack all packets in `nnsoup-packet-directory'."
- (let ((packets (directory-files
- nnsoup-packet-directory t nnsoup-packet-regexp)))
- (dolist (packet packets)
- (nnheader-message 5 "nnsoup: unpacking %s..." packet)
- (if (not (gnus-soup-unpack-packet
- nnsoup-tmp-directory nnsoup-unpacker packet))
- (nnheader-message 5 "Couldn't unpack %s" packet)
- (delete-file packet)
- (nnsoup-read-areas)
- (nnheader-message 5 "Unpacking...done")))))
-
-(defun nnsoup-narrow-to-article (article &optional area head)
- (let* ((area (or area (nnsoup-article-to-area article nnsoup-current-group)))
- (prefix (and area (gnus-soup-area-prefix (nth 1 area))))
- (msg-buf (and prefix (nnsoup-index-buffer prefix 'msg)))
- beg end)
- (when area
- (save-excursion
- (cond
- ;; There is no MSG file.
- ((null msg-buf)
- nil)
- ;; We use the index file to find out where the article
- ;; begins and ends.
- ((and (= (gnus-soup-encoding-index
- (gnus-soup-area-encoding (nth 1 area)))
- ?c)
- (file-exists-p (nnsoup-file prefix)))
- (set-buffer (nnsoup-index-buffer prefix))
- (widen)
- (goto-char (point-min))
- (forward-line (- article (caar area)))
- (setq beg (read (current-buffer)))
- (forward-line 1)
- (if (looking-at "[0-9]+")
- (progn
- (setq end (read (current-buffer)))
- (set-buffer msg-buf)
- (widen)
- (let ((format (gnus-soup-encoding-format
- (gnus-soup-area-encoding (nth 1 area)))))
- (goto-char end)
- (when (or (= format ?u) (= format ?n) (= format ?m))
- (setq end (progn (forward-line -1) (point))))))
- (set-buffer msg-buf))
- (widen)
- (narrow-to-region beg (or end (point-max))))
- (t
- (set-buffer msg-buf)
- (widen)
- (unless (assoc (gnus-soup-area-prefix (nth 1 area))
- nnsoup-article-alist)
- (nnsoup-dissect-buffer (nth 1 area)))
- (let ((entry (assq article (cdr (assoc (gnus-soup-area-prefix
- (nth 1 area))
- nnsoup-article-alist)))))
- (when entry
- (narrow-to-region (cadr entry) (caddr entry))))))
- (goto-char (point-min))
- (if (not head)
- ()
- (narrow-to-region
- (point-min)
- (if (search-forward "\n\n" nil t)
- (1- (point))
- (point-max))))
- msg-buf))))
-
-;;;###autoload
-(defun nnsoup-pack-replies ()
- "Make an outbound package of SOUP replies."
- (interactive)
- (unless (file-exists-p nnsoup-replies-directory)
- (nnheader-message 5 "No such directory: %s" nnsoup-replies-directory))
- ;; Write all data buffers.
- (gnus-soup-save-areas)
- ;; Write the active file.
- (nnsoup-write-active-file)
- ;; Write the REPLIES file.
- (nnsoup-write-replies)
- ;; Check whether there is anything here.
- (when (null (directory-files nnsoup-replies-directory nil "\\.MSG$"))
- (error "No files to pack"))
- ;; Pack all these files into a SOUP packet.
- (gnus-soup-pack nnsoup-replies-directory nnsoup-packer))
-
-(defun nnsoup-write-replies ()
- "Write the REPLIES file."
- (when nnsoup-replies-list
- (gnus-soup-write-replies nnsoup-replies-directory nnsoup-replies-list)
- (setq nnsoup-replies-list nil)))
-
-(defun nnsoup-article-to-area (article group)
- "Return the area that ARTICLE in GROUP is located in."
- (let ((areas (cddr (assoc group nnsoup-group-alist))))
- (while (and areas (< (cdar (car areas)) article))
- (setq areas (cdr areas)))
- (and areas (car areas))))
-
-(defvar nnsoup-old-functions
- (list message-send-mail-real-function message-send-news-function))
-
-;;;###autoload
-(defun nnsoup-set-variables ()
- "Use the SOUP methods for posting news and mailing mail."
- (interactive)
- (setq message-send-news-function 'nnsoup-request-post)
- (setq message-send-mail-real-function 'nnsoup-request-mail))
-
-;;;###autoload
-(defun nnsoup-revert-variables ()
- "Revert posting and mailing methods to the standard Emacs methods."
- (interactive)
- (setq message-send-mail-real-function (car nnsoup-old-functions))
- (setq message-send-news-function (cadr nnsoup-old-functions)))
-
-(defun nnsoup-store-reply (kind)
- ;; Mostly stolen from `message.el'.
- (require 'mail-utils)
- (let ((tembuf (generate-new-buffer " message temp"))
- (case-fold-search nil)
- delimline
- (mailbuf (current-buffer)))
- (unwind-protect
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (if (equal kind "mail")
- (message-generate-headers message-required-mail-headers)
- (message-generate-headers message-required-news-headers)))
- (set-buffer tembuf)
- (erase-buffer)
- (insert-buffer-substring mailbuf)
- ;; Remove some headers.
- (save-restriction
- (message-narrow-to-headers)
- ;; Remove some headers.
- (message-remove-header message-ignored-mail-headers t))
- (goto-char (point-max))
- ;; require one newline at the end.
- (or (= (preceding-char) ?\n)
- (insert ?\n))
- (let ((case-fold-search t))
- ;; Change header-delimiter to be what sendmail expects.
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "\n"))
- (replace-match "\n")
- (backward-char 1)
- (setq delimline (point-marker))
- (goto-char (1+ delimline))
- (let ((msg-buf
- (gnus-soup-store
- nnsoup-replies-directory
- (nnsoup-kind-to-prefix kind) nil nnsoup-replies-format-type
- nnsoup-replies-index-type))
- (num 0))
- (when (and msg-buf (bufferp msg-buf))
- (save-excursion
- (set-buffer msg-buf)
- (goto-char (point-min))
- (while (re-search-forward "^#! *rnews" nil t)
- (incf num))
- (when nnsoup-always-save
- (save-buffer)))
- (nnheader-message 5 "Stored %d messages" num)))
- (nnsoup-write-replies)
- (kill-buffer tembuf))))))
-
-(defun nnsoup-kind-to-prefix (kind)
- (unless nnsoup-replies-list
- (setq nnsoup-replies-list
- (gnus-soup-parse-replies
- (expand-file-name "REPLIES" nnsoup-replies-directory))))
- (let ((replies nnsoup-replies-list))
- (while (and replies
- (not (string= kind (gnus-soup-reply-kind (car replies)))))
- (setq replies (cdr replies)))
- (if replies
- (gnus-soup-reply-prefix (car replies))
- (push (vector (gnus-soup-unique-prefix nnsoup-replies-directory)
- kind
- (format "%c%c%c"
- nnsoup-replies-format-type
- nnsoup-replies-index-type
- (if (string= kind "news")
- ?n ?m)))
- nnsoup-replies-list)
- (gnus-soup-reply-prefix (car nnsoup-replies-list)))))
-
-(defun nnsoup-make-active ()
- "(Re-)create the SOUP active file."
- (interactive)
- (let ((files (sort (directory-files nnsoup-directory t "IDX$")
- (lambda (f1 f2)
- (< (progn (string-match "/\\([0-9]+\\)\\." f1)
- (string-to-number (match-string 1 f1)))
- (progn (string-match "/\\([0-9]+\\)\\." f2)
- (string-to-number (match-string 1 f2)))))))
- active group lines ident elem min)
- (set-buffer (get-buffer-create " *nnsoup work*"))
- (dolist (file files)
- (nnheader-message 5 "Doing %s..." file)
- (erase-buffer)
- (nnheader-insert-file-contents file)
- (goto-char (point-min))
- (if (not (re-search-forward "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t *\\(Xref: \\)? *[^ ]* \\([^ ]+\\):[0-9]" nil t))
- (setq group "unknown")
- (setq group (match-string 2)))
- (setq lines (count-lines (point-min) (point-max)))
- (setq ident (progn (string-match
- "/\\([0-9]+\\)\\." file)
- (match-string 1 file)))
- (if (not (setq elem (assoc group active)))
- (push (list group (cons 1 lines)
- (list (cons 1 lines)
- (vector ident group "ucm" "" lines)))
- active)
- (nconc elem
- (list
- (list (cons (1+ (setq min (cdadr elem)))
- (+ min lines))
- (vector ident group "ucm" "" lines))))
- (setcdr (cadr elem) (+ min lines))))
- (nnheader-message 5 "")
- (setq nnsoup-group-alist active)
- (nnsoup-write-active-file t)))
-
-(defun nnsoup-delete-unreferenced-message-files ()
- "Delete any *.MSG and *.IDX files that aren't known by nnsoup."
- (interactive)
- (let* ((known (apply 'nconc (mapcar
- (lambda (ga)
- (mapcar
- (lambda (area)
- (gnus-soup-area-prefix (cadr area)))
- (cddr ga)))
- nnsoup-group-alist)))
- (regexp "\\.MSG$\\|\\.IDX$")
- (files (directory-files nnsoup-directory nil regexp))
- non-files)
- ;; Find all files that aren't known by nnsoup.
- (dolist (file files)
- (string-match regexp file)
- (unless (member (substring file 0 (match-beginning 0)) known)
- (push file non-files)))
- ;; Sort and delete the files.
- (setq non-files (sort non-files 'string<))
- (map-y-or-n-p "Delete file %s? "
- (lambda (file) (delete-file
- (expand-file-name file nnsoup-directory)))
- non-files)))
-
-(provide 'nnsoup)
-
-;; arch-tag: b0451389-5703-4450-9425-f66f6b38c828
-;;; nnsoup.el ends here
diff --git a/lisp/gnus/nnspool.el b/lisp/gnus/nnspool.el
index cf79613ad0..cdf2b829ec 100644
--- a/lisp/gnus/nnspool.el
+++ b/lisp/gnus/nnspool.el
@@ -458,5 +458,4 @@ there.")
(provide 'nnspool)
-;; arch-tag: bdac8d27-2934-4eee-bad0-49e6b90c0d05
;;; nnspool.el ends here
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index 03e0168de4..3cdd63084e 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -298,13 +298,6 @@ to insert Cancel-Lock headers.")
(defvoo nntp-server-xover 'try)
(defvoo nntp-server-list-active-group 'try)
-(defvar nntp-async-needs-kluge
- (string-match "^GNU Emacs 20\\.3\\." (emacs-version))
- "*When non-nil, nntp will poll asynchronous connections
-once a second. By default, this is turned on only for Emacs
-20.3, which has a bug that breaks nntp's normal method of
-noticing asynchronous data.")
-
(defvar nntp-async-timer nil)
(defvar nntp-async-process-list nil)
@@ -316,8 +309,8 @@ port number on server. The program should accept IMAP commands on
stdin and return responses to stdout.")
(defvar nntp-authinfo-rejected nil
-"A custom error condition used to report 'Authentication Rejected' errors.
-Condition handlers that match just this condition ensure that the nntp
+"A custom error condition used to report 'Authentication Rejected' errors.
+Condition handlers that match just this condition ensure that the nntp
backend doesn't catch this error.")
(put 'nntp-authinfo-rejected 'error-conditions '(error nntp-authinfo-rejected))
(put 'nntp-authinfo-rejected 'error-message "Authorization Rejected")
@@ -1116,7 +1109,8 @@ command whose response triggered the error."
t)
(deffoo nntp-request-set-mark (group actions &optional server)
- (unless nntp-marks-is-evil
+ (when (and (not nntp-marks-is-evil)
+ nntp-marks-file-name)
(nntp-possibly-create-directory group server)
(nntp-open-marks group server)
(dolist (action actions)
@@ -1136,7 +1130,8 @@ command whose response triggered the error."
nil)
(deffoo nntp-request-update-info (group info &optional server)
- (unless nntp-marks-is-evil
+ (when (and (not nntp-marks-is-evil)
+ nntp-marks-file-name)
(nntp-possibly-create-directory group server)
(when (nntp-marks-changed-p group server)
(nnheader-message 8 "Updating marks for %s..." group)
@@ -1368,17 +1363,7 @@ password contained in '~/.nntp-authinfo'."
nntp-process-decode decode
nntp-process-callback callback
nntp-process-start-point (point-max))
- (setq after-change-functions '(nntp-after-change-function))
- (if nntp-async-needs-kluge
- (nntp-async-kluge process))))
-
-(defun nntp-async-kluge (process)
- ;; emacs 20.3 bug: process output with encoding 'binary
- ;; doesn't trigger after-change-functions.
- (unless nntp-async-timer
- (setq nntp-async-timer
- (run-at-time 1 1 'nntp-async-timer-handler)))
- (add-to-list 'nntp-async-process-list process))
+ (setq after-change-functions '(nntp-after-change-function))))
(defun nntp-async-timer-handler ()
(mapcar
@@ -1783,7 +1768,7 @@ password contained in '~/.nntp-authinfo'."
(while (and (setq proc (get-buffer-process buf))
(memq (process-status proc) '(open run))
(not (re-search-forward regexp nil t)))
- (accept-process-output proc)
+ (accept-process-output proc 0.1)
(set-buffer buf)
(goto-char (point-min)))))
@@ -2028,7 +2013,7 @@ Please refer to the following variables to customize the connection:
(and nntp-pre-command (push nntp-pre-command command))
(let ((process-connection-type nil)) ;See `nntp-open-via-rlogin-and-netcat'.
(apply 'start-process "nntpd" buffer command))))
-
+
(defun nntp-open-via-telnet-and-telnet (buffer)
"Open a connection to an nntp server through an intermediate host.
@@ -2195,5 +2180,4 @@ Please refer to the following variables to customize the connection:
(provide 'nntp)
-;; arch-tag: 8655466a-b1b5-4929-9c45-7b1b2e767271
;;; nntp.el ends here
diff --git a/lisp/gnus/nnultimate.el b/lisp/gnus/nnultimate.el
deleted file mode 100644
index e65d30f275..0000000000
--- a/lisp/gnus/nnultimate.el
+++ /dev/null
@@ -1,480 +0,0 @@
-;;; nnultimate.el --- interfacing with the Ultimate Bulletin Board system
-
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <[email protected]>
-;; Keywords: news
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Note: You need to have `url' and `w3' installed for this
-;; backend to work.
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'nnoo)
-(require 'message)
-(require 'gnus-util)
-(require 'gnus)
-(require 'nnmail)
-(require 'mm-util)
-(require 'mm-url)
-(require 'nnweb)
-(require 'parse-time)
-(autoload 'w3-parse-buffer "w3-parse")
-
-(nnoo-declare nnultimate)
-
-(defvoo nnultimate-directory (nnheader-concat gnus-directory "ultimate/")
- "Where nnultimate will save its files.")
-
-(defvoo nnultimate-address ""
- "The address of the Ultimate bulletin board.")
-
-;;; Internal variables
-
-(defvar nnultimate-groups-alist nil)
-(defvoo nnultimate-groups nil)
-(defvoo nnultimate-headers nil)
-(defvoo nnultimate-articles nil)
-(defvar nnultimate-table-regexp
- "postings.*editpost\\|forumdisplay\\|Forum[0-9]+/HTML\\|getbio")
-
-;;; Interface functions
-
-(nnoo-define-basics nnultimate)
-
-(deffoo nnultimate-retrieve-headers (articles &optional group server fetch-old)
- (nnultimate-possibly-change-server group server)
- (unless gnus-nov-is-evil
- (let* ((last (car (last articles)))
- (did nil)
- (start 1)
- (entry (assoc group nnultimate-groups))
- (sid (nth 2 entry))
- (topics (nth 4 entry))
- (mapping (nth 5 entry))
- (old-total (or (nth 6 entry) 1))
- (furl "forumdisplay.cgi?action=topics&number=%d&DaysPrune=1000")
- (furls (list (concat nnultimate-address (format furl sid))))
- (nnultimate-table-regexp
- "postings.*editpost\\|forumdisplay\\|getbio")
- headers article subject score from date lines parent point
- contents tinfo fetchers map elem a href garticles topic old-max
- inc datel table current-page total-contents pages
- farticles forum-contents parse furl-fetched mmap farticle)
- (setq map mapping)
- (while (and (setq article (car articles))
- map)
- ;; Skip past the articles in the map until we reach the
- ;; article we're looking for.
- (while (and map
- (or (> article (caar map))
- (< (cadar map) (caar map))))
- (pop map))
- (when (setq mmap (car map))
- (setq farticle -1)
- (while (and article
- (<= article (nth 1 mmap)))
- ;; Do we already have a fetcher for this topic?
- (if (setq elem (assq (nth 2 mmap) fetchers))
- ;; Yes, so we just add the spec to the end.
- (nconc elem (list (cons article
- (+ (nth 3 mmap) (incf farticle)))))
- ;; No, so we add a new one.
- (push (list (nth 2 mmap)
- (cons article
- (+ (nth 3 mmap) (incf farticle))))
- fetchers))
- (pop articles)
- (setq article (car articles)))))
- ;; Now we have the mapping from/to Gnus/nnultimate article numbers,
- ;; so we start fetching the topics that we need to satisfy the
- ;; request.
- (if (not fetchers)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer))
- (setq nnultimate-articles nil)
- (mm-with-unibyte-buffer
- (dolist (elem fetchers)
- (setq pages 1
- current-page 1
- total-contents nil)
- (while (<= current-page pages)
- (erase-buffer)
- (setq subject (nth 2 (assq (car elem) topics)))
- (setq href (nth 3 (assq (car elem) topics)))
- (if (= current-page 1)
- (mm-url-insert href)
- (string-match "\\.html$" href)
- (mm-url-insert (concat (substring href 0 (match-beginning 0))
- "-" (number-to-string current-page)
- (match-string 0 href))))
- (goto-char (point-min))
- (setq contents
- (ignore-errors (w3-parse-buffer (current-buffer))))
- (setq table (nnultimate-find-forum-table contents))
- (goto-char (point-min))
- (when (re-search-forward "topic is \\([0-9]+\\) pages" nil t)
- (setq pages (string-to-number (match-string 1))))
- (setq contents (cdr (nth 2 (car (nth 2 table)))))
- (setq total-contents (nconc total-contents contents))
- (incf current-page))
- (when t
- (let ((i 0))
- (dolist (co total-contents)
- (push (list (or (nnultimate-topic-article-to-article
- group (car elem) (incf i))
- 1)
- co subject)
- nnultimate-articles))))
- (when nil
- (dolist (art (cdr elem))
- (when (nth (1- (cdr art)) total-contents)
- (push (list (car art)
- (nth (1- (cdr art)) total-contents)
- subject)
- nnultimate-articles))))))
- (setq nnultimate-articles
- (sort nnultimate-articles 'car-less-than-car))
- ;; Now we have all the articles, conveniently in an alist
- ;; where the key is the Gnus article number.
- (dolist (articlef nnultimate-articles)
- (setq article (nth 0 articlef)
- contents (nth 1 articlef)
- subject (nth 2 articlef))
- (setq from (mapconcat 'identity
- (nnweb-text (car (nth 2 contents)))
- " ")
- datel (nnweb-text (nth 2 (car (cdr (nth 2 contents))))))
- (while datel
- (when (string-match "Posted" (car datel))
- (setq date (substring (car datel) (match-end 0))
- datel nil))
- (pop datel))
- (when date
- (setq date (delete "" (split-string date "[-, \n\t\r ���]")))
- (setq date
- (if (or (member "AM" date)
- (member "PM" date))
- (format
- "%s %s %s %s"
- (nth 1 date)
- (if (and (>= (length (nth 0 date)) 3)
- (assoc (downcase
- (substring (nth 0 date) 0 3))
- parse-time-months))
- (substring (nth 0 date) 0 3)
- (car (rassq (string-to-number (nth 0 date))
- parse-time-months)))
- (nth 2 date) (nth 3 date))
- (format "%s %s %s %s"
- (car (rassq (string-to-number (nth 1 date))
- parse-time-months))
- (nth 0 date) (nth 2 date) (nth 3 date)))))
- (push
- (cons
- article
- (make-full-mail-header
- article subject
- from (or date "")
- (concat "<" (number-to-string sid) "%"
- (number-to-string article)
- "@ultimate." server ">")
- "" 0
- (/ (length (mapconcat
- 'identity
- (nnweb-text
- (cdr (nth 2 (nth 1 (nth 2 contents)))))
- ""))
- 70)
- nil nil))
- headers))
- (setq nnultimate-headers (sort headers 'car-less-than-car))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (mm-with-unibyte-current-buffer
- (erase-buffer)
- (dolist (header nnultimate-headers)
- (nnheader-insert-nov (cdr header))))))
- 'nov)))
-
-(defun nnultimate-topic-article-to-article (group topic article)
- (catch 'found
- (dolist (elem (nth 5 (assoc group nnultimate-groups)))
- (when (and (= topic (nth 2 elem))
- (>= article (nth 3 elem))
- (< article (+ (- (nth 1 elem) (nth 0 elem)) 1
- (nth 3 elem))))
- (throw 'found
- (+ (nth 0 elem) (- article (nth 3 elem))))))))
-
-(deffoo nnultimate-request-group (group &optional server dont-check)
- (nnultimate-possibly-change-server nil server)
- (when (not nnultimate-groups)
- (nnultimate-request-list))
- (unless dont-check
- (nnultimate-create-mapping group))
- (let ((elem (assoc group nnultimate-groups)))
- (cond
- ((not elem)
- (nnheader-report 'nnultimate "Group does not exist"))
- (t
- (nnheader-report 'nnultimate "Opened group %s" group)
- (nnheader-insert
- "211 %d %d %d %s\n" (cadr elem) 1 (cadr elem)
- (prin1-to-string group))))))
-
-(deffoo nnultimate-request-close ()
- (setq nnultimate-groups-alist nil
- nnultimate-groups nil))
-
-(deffoo nnultimate-request-article (article &optional group server buffer)
- (nnultimate-possibly-change-server group server)
- (let ((contents (cdr (assq article nnultimate-articles))))
- (setq contents (cddr (nth 2 (nth 1 (nth 2 (car contents))))))
- (when contents
- (save-excursion
- (set-buffer (or buffer nntp-server-buffer))
- (erase-buffer)
- (nnweb-insert-html (cons 'p (cons nil (list contents))))
- (goto-char (point-min))
- (insert "Content-Type: text/html\nMIME-Version: 1.0\n")
- (let ((header (cdr (assq article nnultimate-headers))))
- (mm-with-unibyte-current-buffer
- (nnheader-insert-header header)))
- (nnheader-report 'nnultimate "Fetched article %s" article)
- (cons group article)))))
-
-(deffoo nnultimate-request-list (&optional server)
- (nnultimate-possibly-change-server nil server)
- (mm-with-unibyte-buffer
- (mm-url-insert
- (if (string-match "/$" nnultimate-address)
- (concat nnultimate-address "Ultimate.cgi")
- nnultimate-address))
- (let ((contents (nth 2 (car (nth 2
- (nnultimate-find-forum-table
- (w3-parse-buffer (current-buffer)))))))
- sid elem description articles a href group forum
- a1 a2)
- (dolist (row contents)
- (setq row (nth 2 row))
- (when (setq a (nnweb-parse-find 'a row))
- (setq group (car (last (nnweb-text a)))
- href (cdr (assq 'href (nth 1 a))))
- (setq description (car (last (nnweb-text (nth 1 row)))))
- (setq a1 (car (last (nnweb-text (nth 2 row)))))
- (setq a2 (car (last (nnweb-text (nth 3 row)))))
- (when (string-match "^[0-9]+$" a1)
- (setq articles (string-to-number a1)))
- (when (and a2 (string-match "^[0-9]+$" a2))
- (setq articles (max articles (string-to-number a2))))
- (when href
- (string-match "number=\\([0-9]+\\)" href)
- (setq forum (string-to-number (match-string 1 href)))
- (if (setq elem (assoc group nnultimate-groups))
- (setcar (cdr elem) articles)
- (push (list group articles forum description nil nil nil nil)
- nnultimate-groups))))))
- (nnultimate-write-groups)
- (nnultimate-generate-active)
- t))
-
-(deffoo nnultimate-request-newgroups (date &optional server)
- (nnultimate-possibly-change-server nil server)
- (nnultimate-generate-active)
- t)
-
-(nnoo-define-skeleton nnultimate)
-
-;;; Internal functions
-
-(defun nnultimate-prune-days (group time)
- "Compute the number of days to fetch info for."
- (let ((old-time (nth 7 (assoc group nnultimate-groups))))
- (if (null old-time)
- 1000
- (- (time-to-days time) (time-to-days old-time)))))
-
-(defun nnultimate-create-mapping (group)
- (let* ((entry (assoc group nnultimate-groups))
- (sid (nth 2 entry))
- (topics (nth 4 entry))
- (mapping (nth 5 entry))
- (old-total (or (nth 6 entry) 1))
- (current-time (current-time))
- (furl
- (concat "forumdisplay.cgi?action=topics&number=%d&DaysPrune="
- (number-to-string
- (nnultimate-prune-days group current-time))))
- (furls (list (concat nnultimate-address (format furl sid))))
- contents forum-contents furl-fetched a subject href
- garticles topic tinfo old-max inc parse)
- (mm-with-unibyte-buffer
- (while furls
- (erase-buffer)
- (mm-url-insert (pop furls))
- (goto-char (point-min))
- (setq parse (w3-parse-buffer (current-buffer)))
- (setq contents
- (cdr (nth 2 (car (nth 2 (nnultimate-find-forum-table
- parse))))))
- (setq forum-contents (nconc contents forum-contents))
- (unless furl-fetched
- (setq furl-fetched t)
- ;; On the first time through this loop, we find all the
- ;; forum URLs.
- (dolist (a (nnweb-parse-find-all 'a parse))
- (let ((href (cdr (assq 'href (nth 1 a)))))
- (when (and href
- (string-match "forumdisplay.*startpoint" href))
- (push href furls))))
- (setq furls (nreverse furls))))
- ;; The main idea here is to map Gnus article numbers to
- ;; nnultimate article numbers. Say there are three topics in
- ;; this forum, the first with 4 articles, the seconds with 2,
- ;; and the third with 1. Then this will translate into 7 Gnus
- ;; article numbers, where 1-4 comes from the first topic, 5-6
- ;; from the second and 7 from the third. Now, then next time
- ;; the group is entered, there's 2 new articles in topic one
- ;; and 1 in topic three. Then Gnus article number 8-9 be 5-6
- ;; in topic one and 10 will be the 2 in topic three.
- (dolist (row (nreverse forum-contents))
- (setq row (nth 2 row))
- (when (setq a (nnweb-parse-find 'a row))
- (setq subject (car (last (nnweb-text a)))
- href (cdr (assq 'href (nth 1 a))))
- (let ((artlist (nreverse (nnweb-text row)))
- art)
- (while (and (not art)
- artlist)
- (when (string-match "^[0-9]+$" (car artlist))
- (setq art (1+ (string-to-number (car artlist)))))
- (pop artlist))
- (setq garticles art))
- (when garticles
- (string-match "/\\([0-9]+\\).html" href)
- (setq topic (string-to-number (match-string 1 href)))
- (if (setq tinfo (assq topic topics))
- (progn
- (setq old-max (cadr tinfo))
- (setcar (cdr tinfo) garticles))
- (setq old-max 0)
- (push (list topic garticles subject href) topics)
- (setcar (nthcdr 4 entry) topics))
- (when (not (= old-max garticles))
- (setq inc (- garticles old-max))
- (setq mapping (nconc mapping
- (list
- (list
- old-total (1- (incf old-total inc))
- topic (1+ old-max)))))
- (incf old-max inc)
- (setcar (nthcdr 5 entry) mapping)
- (setcar (nthcdr 6 entry) old-total))))))
- (setcar (nthcdr 7 entry) current-time)
- (setcar (nthcdr 1 entry) (1- old-total))
- (nnultimate-write-groups)
- mapping))
-
-(defun nnultimate-possibly-change-server (&optional group server)
- (nnultimate-init server)
- (when (and server
- (not (nnultimate-server-opened server)))
- (nnultimate-open-server server))
- (unless nnultimate-groups-alist
- (nnultimate-read-groups)
- (setq nnultimate-groups (cdr (assoc nnultimate-address
- nnultimate-groups-alist)))))
-
-(deffoo nnultimate-open-server (server &optional defs connectionless)
- (nnheader-init-server-buffer)
- (if (nnultimate-server-opened server)
- t
- (unless (assq 'nnultimate-address defs)
- (setq defs (append defs (list (list 'nnultimate-address server)))))
- (nnoo-change-server 'nnultimate server defs)))
-
-(defun nnultimate-read-groups ()
- (setq nnultimate-groups-alist nil)
- (let ((file (expand-file-name "groups" nnultimate-directory)))
- (when (file-exists-p file)
- (mm-with-unibyte-buffer
- (insert-file-contents file)
- (goto-char (point-min))
- (setq nnultimate-groups-alist (read (current-buffer)))))))
-
-(defun nnultimate-write-groups ()
- (setq nnultimate-groups-alist
- (delq (assoc nnultimate-address nnultimate-groups-alist)
- nnultimate-groups-alist))
- (push (cons nnultimate-address nnultimate-groups)
- nnultimate-groups-alist)
- (with-temp-file (expand-file-name "groups" nnultimate-directory)
- (prin1 nnultimate-groups-alist (current-buffer))))
-
-(defun nnultimate-init (server)
- "Initialize buffers and such."
- (unless (file-exists-p nnultimate-directory)
- (gnus-make-directory nnultimate-directory)))
-
-(defun nnultimate-generate-active ()
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (dolist (elem nnultimate-groups)
- (insert (prin1-to-string (car elem))
- " " (number-to-string (cadr elem)) " 1 y\n"))))
-
-(defun nnultimate-find-forum-table (contents)
- (catch 'found
- (nnultimate-find-forum-table-1 contents)))
-
-(defun nnultimate-find-forum-table-1 (contents)
- (dolist (element contents)
- (unless (stringp element)
- (when (and (eq (car element) 'table)
- (nnultimate-forum-table-p element))
- (throw 'found element))
- (when (nth 2 element)
- (nnultimate-find-forum-table-1 (nth 2 element))))))
-
-(defun nnultimate-forum-table-p (parse)
- (when (not (apply 'gnus-or
- (mapcar
- (lambda (p)
- (nnweb-parse-find 'table p))
- (nth 2 parse))))
- (let ((href (cdr (assq 'href (nth 1 (nnweb-parse-find 'a parse 20)))))
- case-fold-search)
- (when (and href (string-match nnultimate-table-regexp href))
- t))))
-
-(provide 'nnultimate)
-
-;; Local Variables:
-;; coding: iso-8859-1
-;; End:
-
-;; arch-tag: ab6bfc45-8fe1-4647-9c78-41050eb152b8
-;;; nnultimate.el ends here
diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el
index 87cfd14d82..c94d1837fa 100644
--- a/lisp/gnus/nnvirtual.el
+++ b/lisp/gnus/nnvirtual.el
@@ -260,13 +260,11 @@ component group will show up when you enter the virtual group.")
(nnheader-report 'nnvirtual "No component groups in %s" group))
(t
(setq nnvirtual-current-group group)
- (when (or (not dont-check)
- nnvirtual-always-rescan)
- (nnvirtual-create-mapping)
- (when nnvirtual-always-rescan
- (nnvirtual-request-update-info
- (nnvirtual-current-group)
- (gnus-get-info (nnvirtual-current-group)))))
+ (nnvirtual-create-mapping dont-check)
+ (when nnvirtual-always-rescan
+ (nnvirtual-request-update-info
+ (nnvirtual-current-group)
+ (gnus-get-info (nnvirtual-current-group))))
(nnheader-insert "211 %d 1 %d %s\n"
nnvirtual-mapping-len nnvirtual-mapping-len group))))
@@ -300,10 +298,6 @@ component group will show up when you enter the virtual group.")
t)
-(deffoo nnvirtual-request-list (&optional server)
- (nnheader-report 'nnvirtual "LIST is not implemented."))
-
-
(deffoo nnvirtual-request-newgroups (date &optional server)
(nnheader-report 'nnvirtual "NEWGROUPS is not supported."))
@@ -674,7 +668,7 @@ the result."
carticles))
-(defun nnvirtual-create-mapping ()
+(defun nnvirtual-create-mapping (dont-check)
"Build the tables necessary to map between component (group, article) to virtual article.
Generate the set of read messages and marks for the virtual group
based on the marks on the component groups."
@@ -693,7 +687,9 @@ based on the marks on the component groups."
;; Into all-marks we put (g marks).
;; We also increment cnt and tot here, and compute M (max of sizes).
(mapc (lambda (g)
- (setq active (gnus-activate-group g)
+ (setq active (or (and dont-check
+ (gnus-active g))
+ (gnus-activate-group g))
min (car active)
max (cdr active))
(when (and active (>= max min) (not (zerop max)))
@@ -809,5 +805,4 @@ based on the marks on the component groups."
(provide 'nnvirtual)
-;; arch-tag: ca8c8ad9-1bd8-4b0f-9722-90dc645a45f5
;;; nnvirtual.el ends here
diff --git a/lisp/gnus/nnwarchive.el b/lisp/gnus/nnwarchive.el
deleted file mode 100644
index 9b4e804d48..0000000000
--- a/lisp/gnus/nnwarchive.el
+++ /dev/null
@@ -1,727 +0,0 @@
-;;; nnwarchive.el --- interfacing with web archives
-
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
-
-;; Author: Shenghuo Zhu <[email protected]>
-;; Keywords: news egroups mail-archive
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Note: You need to have `url' (w3 0.46) or greater version
-;; installed for some functions of this backend to work.
-
-;; Todo:
-;; 1. To support more web archives.
-;; 2. Generalize webmail to other MHonArc archive.
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'nnoo)
-(require 'message)
-(require 'gnus-util)
-(require 'gnus)
-(require 'gnus-bcklg)
-(require 'nnmail)
-(require 'mm-util)
-(require 'mm-url)
-
-(nnoo-declare nnwarchive)
-
-(defvar nnwarchive-type-definition
- '((egroups
- (address . "www.egroups.com")
- (open-url
- "http://www.egroups.com/login.cgi?&login_email=%s&login_password=%s"
- nnwarchive-login nnwarchive-passwd)
- (list-url
- "http://www.egroups.com/mygroups")
- (list-dissect . nnwarchive-egroups-list)
- (list-groups . nnwarchive-egroups-list-groups)
- (xover-url
- "http://www.egroups.com/messages/%s/%d" group aux)
- (xover-last-url
- "http://www.egroups.com/messages/%s/" group)
- (xover-page-size . 13)
- (xover-dissect . nnwarchive-egroups-xover)
- (article-url
- "http://www.egroups.com/message/%s/%d?source=1" group article)
- (article-dissect . nnwarchive-egroups-article)
- (authentication . t)
- (article-offset . 0)
- (xover-files . nnwarchive-egroups-xover-files))
- (mail-archive
- (address . "www.mail-archive.com")
- (open-url)
- (list-url
- "http://www.mail-archive.com/lists.html")
- (list-dissect . nnwarchive-mail-archive-list)
- (list-groups . nnwarchive-mail-archive-list-groups)
- (xover-url
- "http://www.mail-archive.com/%s/mail%d.html" group aux)
- (xover-last-url
- "http://www.mail-archive.com/%s/maillist.html" group)
- (xover-page-size)
- (xover-dissect . nnwarchive-mail-archive-xover)
- (article-url
- "http://www.mail-archive.com/%s/msg%05d.html" group article1)
- (article-dissect . nnwarchive-mail-archive-article)
- (xover-files . nnwarchive-mail-archive-xover-files)
- (authentication)
- (article-offset . 1))))
-
-(defvar nnwarchive-default-type 'egroups)
-
-(defvoo nnwarchive-directory (nnheader-concat gnus-directory "warchive/")
- "Where nnwarchive will save its files.")
-
-(defvoo nnwarchive-type nil
- "The type of nnwarchive.")
-
-(defvoo nnwarchive-address ""
- "The address of nnwarchive.")
-
-(defvoo nnwarchive-login nil
- "Your login name for the group.")
-
-(defvoo nnwarchive-passwd nil
- "Your password for the group.")
-
-(defvoo nnwarchive-groups nil)
-
-(defvoo nnwarchive-headers-cache nil)
-
-(defvoo nnwarchive-authentication nil)
-
-(defvoo nnwarchive-nov-is-evil nil)
-
-(defconst nnwarchive-version "nnwarchive 1.0")
-
-;;; Internal variables
-
-(defvoo nnwarchive-open-url nil)
-(defvoo nnwarchive-open-dissect nil)
-
-(defvoo nnwarchive-list-url nil)
-(defvoo nnwarchive-list-dissect nil)
-(defvoo nnwarchive-list-groups nil)
-
-(defvoo nnwarchive-xover-files nil)
-(defvoo nnwarchive-xover-url nil)
-(defvoo nnwarchive-xover-last-url nil)
-(defvoo nnwarchive-xover-dissect nil)
-(defvoo nnwarchive-xover-page-size nil)
-
-(defvoo nnwarchive-article-url nil)
-(defvoo nnwarchive-article-dissect nil)
-(defvoo nnwarchive-xover-files nil)
-(defvoo nnwarchive-article-offset 0)
-
-(defvoo nnwarchive-buffer nil)
-
-(defvoo nnwarchive-keep-backlog 300)
-(defvar nnwarchive-backlog-articles nil)
-(defvar nnwarchive-backlog-hashtb nil)
-
-(defvoo nnwarchive-headers nil)
-
-
-;;; Interface functions
-
-(nnoo-define-basics nnwarchive)
-
-(defun nnwarchive-set-default (type)
- (let ((defs (cdr (assq type nnwarchive-type-definition)))
- def)
- (dolist (def defs)
- (set (intern (concat "nnwarchive-" (symbol-name (car def))))
- (cdr def)))))
-
-(defmacro nnwarchive-backlog (&rest form)
- `(let ((gnus-keep-backlog nnwarchive-keep-backlog)
- (gnus-backlog-buffer
- (format " *nnwarchive backlog %s*" nnwarchive-address))
- (gnus-backlog-articles nnwarchive-backlog-articles)
- (gnus-backlog-hashtb nnwarchive-backlog-hashtb))
- (unwind-protect
- (progn ,@form)
- (setq nnwarchive-backlog-articles gnus-backlog-articles
- nnwarchive-backlog-hashtb gnus-backlog-hashtb))))
-(put 'nnwarchive-backlog 'lisp-indent-function 0)
-(put 'nnwarchive-backlog 'edebug-form-spec '(form body))
-
-(defun nnwarchive-backlog-enter-article (group number buffer)
- (nnwarchive-backlog
- (gnus-backlog-enter-article group number buffer)))
-
-(defun nnwarchive-get-article (article &optional group server buffer)
- (if (numberp article)
- (if (nnwarchive-backlog
- (gnus-backlog-request-article group article
- (or buffer nntp-server-buffer)))
- (cons group article)
- (let (contents)
- (save-excursion
- (set-buffer nnwarchive-buffer)
- (goto-char (point-min))
- (let ((article1 (- article nnwarchive-article-offset)))
- (nnwarchive-url nnwarchive-article-url))
- (setq contents (funcall nnwarchive-article-dissect group article)))
- (when contents
- (save-excursion
- (set-buffer (or buffer nntp-server-buffer))
- (erase-buffer)
- (insert contents)
- (nnwarchive-backlog-enter-article group article (current-buffer))
- (nnheader-report 'nnwarchive "Fetched article %s" article)
- (cons group article)))))
- nil))
-
-(deffoo nnwarchive-retrieve-headers (articles &optional group server fetch-old)
- (nnwarchive-possibly-change-server group server)
- (if (or gnus-nov-is-evil nnwarchive-nov-is-evil)
- (with-temp-buffer
- (with-current-buffer nntp-server-buffer
- (erase-buffer))
- (let ((buf (current-buffer)) b e)
- (dolist (art articles)
- (nnwarchive-get-article art group server buf)
- (setq b (goto-char (point-min)))
- (if (search-forward "\n\n" nil t)
- (forward-char -1)
- (goto-char (point-max)))
- (setq e (point))
- (with-current-buffer nntp-server-buffer
- (insert (format "221 %d Article retrieved.\n" art))
- (insert-buffer-substring buf b e)
- (insert ".\n"))))
- 'headers)
- (setq nnwarchive-headers (cdr (assoc group nnwarchive-headers-cache)))
- (save-excursion
- (set-buffer nnwarchive-buffer)
- (erase-buffer)
- (funcall nnwarchive-xover-files group articles))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (let (header)
- (dolist (art articles)
- (if (setq header (assq art nnwarchive-headers))
- (nnheader-insert-nov (cdr header))))))
- (let ((elem (assoc group nnwarchive-headers-cache)))
- (if elem
- (setcdr elem nnwarchive-headers)
- (push (cons group nnwarchive-headers) nnwarchive-headers-cache)))
- 'nov))
-
-(deffoo nnwarchive-request-group (group &optional server dont-check)
- (nnwarchive-possibly-change-server nil server)
- (when (and (not dont-check) nnwarchive-list-groups)
- (funcall nnwarchive-list-groups (list group))
- (nnwarchive-write-groups))
- (let ((elem (assoc group nnwarchive-groups)))
- (cond
- ((not elem)
- (nnheader-report 'nnwarchive "Group does not exist"))
- (t
- (nnheader-report 'nnwarchive "Opened group %s" group)
- (nnheader-insert
- "211 %d %d %d %s\n" (or (cadr elem) 0) 1 (or (cadr elem) 0)
- (prin1-to-string group))
- t))))
-
-(deffoo nnwarchive-request-article (article &optional group server buffer)
- (nnwarchive-possibly-change-server group server)
- (nnwarchive-get-article article group server buffer))
-
-(deffoo nnwarchive-close-server (&optional server)
- (when (and (nnwarchive-server-opened server)
- (gnus-buffer-live-p nnwarchive-buffer))
- (save-excursion
- (set-buffer nnwarchive-buffer)
- (kill-buffer nnwarchive-buffer)))
- (nnwarchive-backlog
- (gnus-backlog-shutdown))
- (nnoo-close-server 'nnwarchive server))
-
-(deffoo nnwarchive-request-list (&optional server)
- (nnwarchive-possibly-change-server nil server)
- (save-excursion
- (set-buffer nnwarchive-buffer)
- (erase-buffer)
- (if nnwarchive-list-url
- (nnwarchive-url nnwarchive-list-url))
- (if nnwarchive-list-dissect
- (funcall nnwarchive-list-dissect))
- (nnwarchive-write-groups)
- (nnwarchive-generate-active))
- t)
-
-(deffoo nnwarchive-open-server (server &optional defs connectionless)
- (nnoo-change-server 'nnwarchive server defs)
- (nnwarchive-init server)
- (when nnwarchive-authentication
- (setq nnwarchive-login
- (or nnwarchive-login
- (read-string
- (format "Login at %s: " server)
- user-mail-address)))
- (setq nnwarchive-passwd
- (or nnwarchive-passwd
- (read-passwd
- (format "Password for %s at %s: "
- nnwarchive-login server)))))
- (unless nnwarchive-groups
- (nnwarchive-read-groups))
- (save-excursion
- (set-buffer nnwarchive-buffer)
- (erase-buffer)
- (if nnwarchive-open-url
- (nnwarchive-url nnwarchive-open-url))
- (if nnwarchive-open-dissect
- (funcall nnwarchive-open-dissect)))
- t)
-
-(nnoo-define-skeleton nnwarchive)
-
-;;; Internal functions
-
-(defun nnwarchive-possibly-change-server (&optional group server)
- (nnwarchive-init server)
- (when (and server
- (not (nnwarchive-server-opened server)))
- (nnwarchive-open-server server)))
-
-(defun nnwarchive-read-groups ()
- (let ((file (expand-file-name (concat "groups-" nnwarchive-address)
- nnwarchive-directory)))
- (when (file-exists-p file)
- (with-temp-buffer
- (insert-file-contents file)
- (goto-char (point-min))
- (setq nnwarchive-groups (read (current-buffer)))))))
-
-(defun nnwarchive-write-groups ()
- (with-temp-file (expand-file-name (concat "groups-" nnwarchive-address)
- nnwarchive-directory)
- (prin1 nnwarchive-groups (current-buffer))))
-
-(defun nnwarchive-init (server)
- "Initialize buffers and such."
- (let ((type (intern server)) (defs nnwarchive-type-definition) def)
- (cond
- ((equal server "")
- (setq type nnwarchive-default-type))
- ((assq type nnwarchive-type-definition) t)
- (t
- (setq type nil)
- (while (setq def (pop defs))
- (when (equal (cdr (assq 'address (cdr def))) server)
- (setq defs nil)
- (setq type (car def))))
- (unless type
- (error "Undefined server %s" server))))
- (setq nnwarchive-type type))
- (unless (file-exists-p nnwarchive-directory)
- (gnus-make-directory nnwarchive-directory))
- (unless (gnus-buffer-live-p nnwarchive-buffer)
- (setq nnwarchive-buffer
- (save-excursion
- (nnheader-set-temp-buffer
- (format " *nnwarchive %s %s*" nnwarchive-type server)))))
- (nnwarchive-set-default nnwarchive-type))
-
-(defun nnwarchive-eval (expr)
- (cond
- ((consp expr)
- (cons (nnwarchive-eval (car expr)) (nnwarchive-eval (cdr expr))))
- ((symbolp expr)
- (eval expr))
- (t
- expr)))
-
-(defun nnwarchive-url (xurl)
- (mm-with-unibyte-current-buffer
- (let ((url-confirmation-func 'identity) ;; Some hacks.
- (url-cookie-multiple-line nil))
- (cond
- ((eq (car xurl) 'post)
- (pop xurl)
- (mm-url-fetch-form (car xurl) (nnwarchive-eval (cdr xurl))))
- (t
- (mm-url-insert (apply 'format (nnwarchive-eval xurl))))))))
-
-(defun nnwarchive-generate-active ()
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (dolist (elem nnwarchive-groups)
- (insert (prin1-to-string (car elem))
- " " (number-to-string (or (cadr elem) 0)) " 1 y\n"))))
-
-(defun nnwarchive-paged (articles)
- (let (art narts next)
- (while (setq art (pop articles))
- (when (and (>= art (or next 0))
- (not (assq art nnwarchive-headers)))
- (push art narts)
- (setq next (+ art nnwarchive-xover-page-size))))
- narts))
-
-;; egroups
-
-(defun nnwarchive-egroups-list-groups (groups)
- (save-excursion
- (let (articles)
- (set-buffer nnwarchive-buffer)
- (dolist (group groups)
- (erase-buffer)
- (nnwarchive-url nnwarchive-xover-last-url)
- (goto-char (point-min))
- (when (re-search-forward "of \\([0-9]+\\)[ \t\n\r]*</title>" nil t)
- (setq articles (string-to-number (match-string 1))))
- (let ((elem (assoc group nnwarchive-groups)))
- (if elem
- (setcar (cdr elem) articles)
- (push (list group articles "") nnwarchive-groups)))
- (setq nnwarchive-headers (cdr (assoc group nnwarchive-headers-cache)))
- (nnwarchive-egroups-xover group)
- (let ((elem (assoc group nnwarchive-headers-cache)))
- (if elem
- (setcdr elem nnwarchive-headers)
- (push (cons group nnwarchive-headers) nnwarchive-headers-cache)))))))
-
-(defun nnwarchive-egroups-list ()
- (let ((case-fold-search t)
- group description elem articles)
- (goto-char (point-min))
- (while
- (re-search-forward "href=\"/group/\\([^/\"\> ]+\\)" nil t)
- (setq group (match-string 1)
- description (match-string 2))
- (if (setq elem (assoc group nnwarchive-groups))
- (setcar (cdr elem) 0)
- (push (list group articles description) nnwarchive-groups))))
- t)
-
-(defun nnwarchive-egroups-xover (group)
- (let (article subject from date)
- (goto-char (point-min))
- (while (re-search-forward
- "<a href=\"/group/\\([^/]+\\)/\\([0-9]+\\)[^>]+>\\([^<]+\\)<"
- nil t)
- (setq group (match-string 1)
- article (string-to-number (match-string 2))
- subject (match-string 3))
- (forward-line 1)
- (unless (assq article nnwarchive-headers)
- (if (looking-at "<td[^>]+><font[^>]+>\\([^<]+\\)</font>")
- (setq from (match-string 1)))
- (forward-line 1)
- (if (looking-at "<td[^>]+><font[^>]+>\\([^<]+\\)</font>")
- (setq date (identity (match-string 1))))
- (push (cons
- article
- (make-full-mail-header
- article
- (mm-url-decode-entities-string subject)
- (mm-url-decode-entities-string from)
- date
- (concat "<" group "%"
- (number-to-string article)
- "@egroup.com>")
- ""
- 0 0 "")) nnwarchive-headers))))
- nnwarchive-headers)
-
-(defun nnwarchive-egroups-article (group articles)
- (goto-char (point-min))
- (if (search-forward "<pre>" nil t)
- (delete-region (point-min) (point)))
- (goto-char (point-max))
- (if (search-backward "</pre>" nil t)
- (delete-region (point) (point-max)))
- (goto-char (point-min))
- (while (re-search-forward "<a[^>]+>\\([^<]+\\)</a>" nil t)
- (replace-match "\\1"))
- (mm-url-decode-entities)
- (buffer-string))
-
-(defun nnwarchive-egroups-xover-files (group articles)
- (let (aux auxs)
- (setq auxs (nnwarchive-paged (sort articles '<)))
- (while (setq aux (pop auxs))
- (goto-char (point-max))
- (nnwarchive-url nnwarchive-xover-url))
- (if nnwarchive-xover-dissect
- (nnwarchive-egroups-xover group))))
-
-;; mail-archive
-
-(defun nnwarchive-mail-archive-list-groups (groups)
- (save-excursion
- (let (articles)
- (set-buffer nnwarchive-buffer)
- (dolist (group groups)
- (erase-buffer)
- (nnwarchive-url nnwarchive-xover-last-url)
- (goto-char (point-min))
- (when (re-search-forward "msg\\([0-9]+\\)\\.html" nil t)
- (setq articles (1+ (string-to-number (match-string 1)))))
- (let ((elem (assoc group nnwarchive-groups)))
- (if elem
- (setcar (cdr elem) articles)
- (push (list group articles "") nnwarchive-groups)))
- (setq nnwarchive-headers (cdr (assoc group nnwarchive-headers-cache)))
- (nnwarchive-mail-archive-xover group)
- (let ((elem (assoc group nnwarchive-headers-cache)))
- (if elem
- (setcdr elem nnwarchive-headers)
- (push (cons group nnwarchive-headers)
- nnwarchive-headers-cache)))))))
-
-(defun nnwarchive-mail-archive-list ()
- (let ((case-fold-search t)
- group description elem articles)
- (goto-char (point-min))
- (while (re-search-forward "<a href=\"\\([^/]+\\)/\">\\([^>]+\\)<" nil t)
- (setq group (match-string 1)
- description (match-string 2))
- (forward-line 1)
- (setq articles 0)
- (if (setq elem (assoc group nnwarchive-groups))
- (setcar (cdr elem) articles)
- (push (list group articles description) nnwarchive-groups))))
- t)
-
-(defun nnwarchive-mail-archive-xover (group)
- (let (article subject from date)
- (goto-char (point-min))
- (while (re-search-forward
- "<A[^>]*HREF=\"msg\\([0-9]+\\)\\.html[^>]+>\\([^<]+\\)<"
- nil t)
- (setq article (1+ (string-to-number (match-string 1)))
- subject (match-string 2))
- (forward-line 1)
- (unless (assq article nnwarchive-headers)
- (if (looking-at "<UL><LI><EM>From</EM>: *\\([^<]*[^< ]\\) *&lt;\\([^&]+\\)&gt;")
- (progn
- (setq from (match-string 1)
- date (identity (match-string 2))))
- (setq from "" date ""))
- (push (cons
- article
- (make-full-mail-header
- article
- (mm-url-decode-entities-string subject)
- (mm-url-decode-entities-string from)
- date
- (format "<%05d%%%s>\n" (1- article) group)
- ""
- 0 0 "")) nnwarchive-headers))))
- nnwarchive-headers)
-
-(defun nnwarchive-mail-archive-xover-files (group articles)
- (unless nnwarchive-headers
- (erase-buffer)
- (nnwarchive-url nnwarchive-xover-last-url)
- (goto-char (point-min))
- (nnwarchive-mail-archive-xover group))
- (let ((minart (apply 'min articles))
- (min (apply 'min (mapcar 'car nnwarchive-headers)))
- (aux 2))
- (while (> min minart)
- (erase-buffer)
- (nnwarchive-url nnwarchive-xover-url)
- (nnwarchive-mail-archive-xover group)
- (setq min (apply 'min (mapcar 'car nnwarchive-headers))))))
-
-(defvar nnwarchive-caesar-translation-table nil
- "Modified rot13 table. tr/@A-Z[a-z/N-Z[@A-Mn-za-m/.")
-
-(defun nnwarchive-make-caesar-translation-table ()
- "Create modified rot13 table. tr/@A-Z[a-z/N-Z[@A-Mn-za-m/."
- (let ((i -1)
- (table (make-string 256 0))
- (a (mm-char-int ?a))
- (A (mm-char-int ?A)))
- (while (< (incf i) 256)
- (aset table i i))
- (concat
- (substring table 0 (1- A))
- (substring table (+ A 13) (+ A 27))
- (substring table (1- A) (+ A 13))
- (substring table (+ A 27) a)
- (substring table (+ a 13) (+ a 26))
- (substring table a (+ a 13))
- (substring table (+ a 26) 255))))
-
-(defun nnwarchive-from-r13 (from-r13)
- (when from-r13
- (with-temp-buffer
- (insert from-r13)
- (let ((message-caesar-translation-table
- (or nnwarchive-caesar-translation-table
- (setq nnwarchive-caesar-translation-table
- (nnwarchive-make-caesar-translation-table)))))
- (message-caesar-region (point-min) (point-max))
- (buffer-string)))))
-
-(defun nnwarchive-mail-archive-article (group article)
- (let (p refs url mime e
- from subject date id
- done
- (case-fold-search t))
- (save-restriction
- (goto-char (point-min))
- (when (search-forward "X-Head-End" nil t)
- (beginning-of-line)
- (narrow-to-region (point-min) (point))
- (mm-url-decode-entities)
- (goto-char (point-min))
- (while (search-forward "<!--X-" nil t)
- (replace-match ""))
- (goto-char (point-min))
- (while (search-forward " -->" nil t)
- (replace-match ""))
- (setq from
- (or (mail-fetch-field "from")
- (nnwarchive-from-r13
- (mail-fetch-field "from-r13"))))
- (setq date (mail-fetch-field "date"))
- (setq id (mail-fetch-field "message-id"))
- (setq subject (mail-fetch-field "subject"))
- (goto-char (point-max))
- (widen))
- (when (search-forward "<ul>" nil t)
- (forward-line)
- (delete-region (point-min) (point))
- (search-forward "</ul>" nil t)
- (end-of-line)
- (narrow-to-region (point-min) (point))
- (mm-url-remove-markup)
- (mm-url-decode-entities)
- (goto-char (point-min))
- (delete-blank-lines)
- (when from
- (message-remove-header "from")
- (goto-char (point-max))
- (insert "From: " from "\n"))
- (when subject
- (message-remove-header "subject")
- (goto-char (point-max))
- (insert "Subject: " subject "\n"))
- (when id
- (goto-char (point-max))
- (insert "X-Message-ID: <" id ">\n"))
- (when date
- (message-remove-header "date")
- (goto-char (point-max))
- (insert "Date: " date "\n"))
- (goto-char (point-max))
- (widen)
- (insert "\n"))
- (setq p (point))
- (when (search-forward "X-Body-of-Message" nil t)
- (forward-line)
- (delete-region p (point))
- (search-forward "X-Body-of-Message-End" nil t)
- (beginning-of-line)
- (save-restriction
- (narrow-to-region p (point))
- (goto-char (point-min))
- (if (> (skip-chars-forward "\040\n\r\t") 0)
- (delete-region (point-min) (point)))
- (while (not (eobp))
- (cond
- ((looking-at "<PRE>\r?\n?")
- (delete-region (match-beginning 0) (match-end 0))
- (setq p (point))
- (when (search-forward "</PRE>" nil t)
- (delete-region (match-beginning 0) (match-end 0))
- (save-restriction
- (narrow-to-region p (point))
- (mm-url-remove-markup)
- (mm-url-decode-entities)
- (goto-char (point-max)))))
- ((looking-at "<P><A HREF=\"\\([^\"]+\\)")
- (setq url (match-string 1))
- (delete-region (match-beginning 0)
- (progn (forward-line) (point)))
- ;; I hate to download the url encode it, then immediately
- ;; decode it.
- (insert "<#external"
- " type="
- (or (and url
- (string-match "\\.[^\\.]+$" url)
- (mailcap-extension-to-mime
- (match-string 0 url)))
- "application/octet-stream")
- (format " url=\"http://www.mail-archive.com/%s/%s\""
- group url)
- ">\n"
- "<#/external>")
- (setq mime t))
- (t
- (setq p (point))
- (insert "<#part type=\"text/html\" disposition=inline>")
- (goto-char
- (if (re-search-forward
- "[\040\n\r\t]*<PRE>\\|[\040\n\r\t]*<P><A HREF=\""
- nil t)
- (match-beginning 0)
- (point-max)))
- (insert "<#/part>")
- (setq mime t)))
- (setq p (point))
- (if (> (skip-chars-forward "\040\n\r\t") 0)
- (delete-region p (point))))
- (goto-char (point-max))))
- (setq p (point))
- (when (search-forward "X-References-End" nil t)
- (setq e (point))
- (beginning-of-line)
- (search-backward "X-References" p t)
- (while (re-search-forward "msg\\([0-9]+\\)\\.html" e t)
- (push (concat "<" (match-string 1) "%" group ">") refs)))
- (delete-region p (point-max))
- (goto-char (point-min))
- (insert (format "Message-ID: <%05d%%%s>\n" (1- article) group))
- (when refs
- (insert "References:")
- (while refs
- (insert " " (pop refs)))
- (insert "\n"))
- (when mime
- (unless (looking-at "$")
- (search-forward "\n\n" nil t)
- (forward-line -1))
- (narrow-to-region (point) (point-max))
- (insert "MIME-Version: 1.0\n"
- (prog1
- (mml-generate-mime)
- (delete-region (point-min) (point-max))))
- (widen)))
- (buffer-string)))
-
-(provide 'nnwarchive)
-
-;; arch-tag: 1ab7a15c-777a-40e0-95c0-0c41b3963578
-;;; nnwarchive.el ends here
diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el
index fcb8e93a05..3b4f71c80a 100644
--- a/lisp/gnus/nnweb.el
+++ b/lisp/gnus/nnweb.el
@@ -612,5 +612,4 @@ Valid types include `google', `dejanews', and `gmane'.")
(provide 'nnweb)
-;; arch-tag: f59307eb-c90f-479f-b7d2-dbd8bf51b697
;;; nnweb.el ends here
diff --git a/lisp/gnus/nnwfm.el b/lisp/gnus/nnwfm.el
deleted file mode 100644
index fceb3ccd6a..0000000000
--- a/lisp/gnus/nnwfm.el
+++ /dev/null
@@ -1,432 +0,0 @@
-;;; nnwfm.el --- interfacing with a web forum
-
-;; Copyright (C) 2000, 2002, 2003, 2004, 2005,
-;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <[email protected]>
-;; Keywords: news
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Note: You need to have `url' and `w3' installed for this
-;; backend to work.
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'nnoo)
-(require 'message)
-(require 'gnus-util)
-(require 'gnus)
-(require 'nnmail)
-(require 'mm-util)
-(require 'mm-url)
-(require 'nnweb)
-(autoload 'w3-parse-buffer "w3-parse")
-
-(nnoo-declare nnwfm)
-
-(defvoo nnwfm-directory (nnheader-concat gnus-directory "wfm/")
- "Where nnwfm will save its files.")
-
-(defvoo nnwfm-address ""
- "The address of the Ultimate bulletin board.")
-
-;;; Internal variables
-
-(defvar nnwfm-groups-alist nil)
-(defvoo nnwfm-groups nil)
-(defvoo nnwfm-headers nil)
-(defvoo nnwfm-articles nil)
-(defvar nnwfm-table-regexp
- "postings.*editpost\\|forumdisplay\\|Forum[0-9]+/HTML\\|getbio")
-
-;;; Interface functions
-
-(nnoo-define-basics nnwfm)
-
-(deffoo nnwfm-retrieve-headers (articles &optional group server fetch-old)
- (nnwfm-possibly-change-server group server)
- (unless gnus-nov-is-evil
- (let* ((last (car (last articles)))
- (did nil)
- (start 1)
- (entry (assoc group nnwfm-groups))
- (sid (nth 2 entry))
- (topics (nth 4 entry))
- (mapping (nth 5 entry))
- (old-total (or (nth 6 entry) 1))
- (nnwfm-table-regexp "Thread.asp")
- headers article subject score from date lines parent point
- contents tinfo fetchers map elem a href garticles topic old-max
- inc datel table string current-page total-contents pages
- farticles forum-contents parse furl-fetched mmap farticle
- thread-id tables hstuff bstuff time)
- (setq map mapping)
- (while (and (setq article (car articles))
- map)
- (while (and map
- (or (> article (caar map))
- (< (cadar map) (caar map))))
- (pop map))
- (when (setq mmap (car map))
- (setq farticle -1)
- (while (and article
- (<= article (nth 1 mmap)))
- ;; Do we already have a fetcher for this topic?
- (if (setq elem (assq (nth 2 mmap) fetchers))
- ;; Yes, so we just add the spec to the end.
- (nconc elem (list (cons article
- (+ (nth 3 mmap) (incf farticle)))))
- ;; No, so we add a new one.
- (push (list (nth 2 mmap)
- (cons article
- (+ (nth 3 mmap) (incf farticle))))
- fetchers))
- (pop articles)
- (setq article (car articles)))))
- ;; Now we have the mapping from/to Gnus/nnwfm article numbers,
- ;; so we start fetching the topics that we need to satisfy the
- ;; request.
- (if (not fetchers)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer))
- (setq nnwfm-articles nil)
- (mm-with-unibyte-buffer
- (dolist (elem fetchers)
- (erase-buffer)
- (setq subject (nth 2 (assq (car elem) topics))
- thread-id (nth 0 (assq (car elem) topics)))
- (mm-url-insert
- (concat nnwfm-address
- (format "Item.asp?GroupID=%d&ThreadID=%d" sid
- thread-id)))
- (goto-char (point-min))
- (setq tables (caddar
- (caddar
- (cdr (caddar
- (caddar
- (ignore-errors
- (w3-parse-buffer (current-buffer)))))))))
- (setq tables (cdr (caddar (memq (assq 'div tables) tables))))
- (setq contents nil)
- (dolist (table tables)
- (when (eq (car table) 'table)
- (setq table (caddar (caddar (caddr table)))
- hstuff (delete ":link" (nnweb-text (car table)))
- bstuff (car (caddar (cdr table)))
- from (car hstuff))
- (when (nth 2 hstuff)
- (setq time (nnwfm-date-to-time (nth 2 hstuff)))
- (push (list from time bstuff) contents))))
- (setq contents (nreverse contents))
- (dolist (art (cdr elem))
- (push (list (car art)
- (nth (1- (cdr art)) contents)
- subject)
- nnwfm-articles))))
- (setq nnwfm-articles
- (sort nnwfm-articles 'car-less-than-car))
- ;; Now we have all the articles, conveniently in an alist
- ;; where the key is the Gnus article number.
- (dolist (articlef nnwfm-articles)
- (setq article (nth 0 articlef)
- contents (nth 1 articlef)
- subject (nth 2 articlef))
- (setq from (nth 0 contents)
- date (message-make-date (nth 1 contents)))
- (push
- (cons
- article
- (make-full-mail-header
- article subject
- from (or date "")
- (concat "<" (number-to-string sid) "%"
- (number-to-string article)
- "@wfm>")
- "" 0
- (/ (length (mapconcat 'identity (nnweb-text (nth 2 contents)) ""))
- 70)
- nil nil))
- headers))
- (setq nnwfm-headers (sort headers 'car-less-than-car))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (mm-with-unibyte-current-buffer
- (erase-buffer)
- (dolist (header nnwfm-headers)
- (nnheader-insert-nov (cdr header))))))
- 'nov)))
-
-(deffoo nnwfm-request-group (group &optional server dont-check)
- (nnwfm-possibly-change-server nil server)
- (when (not nnwfm-groups)
- (nnwfm-request-list))
- (unless dont-check
- (nnwfm-create-mapping group))
- (let ((elem (assoc group nnwfm-groups)))
- (cond
- ((not elem)
- (nnheader-report 'nnwfm "Group does not exist"))
- (t
- (nnheader-report 'nnwfm "Opened group %s" group)
- (nnheader-insert
- "211 %d %d %d %s\n" (cadr elem) 1 (cadr elem)
- (prin1-to-string group))))))
-
-(deffoo nnwfm-request-close ()
- (setq nnwfm-groups-alist nil
- nnwfm-groups nil))
-
-(deffoo nnwfm-request-article (article &optional group server buffer)
- (nnwfm-possibly-change-server group server)
- (let ((contents (cdr (assq article nnwfm-articles))))
- (when (setq contents (nth 2 (car contents)))
- (save-excursion
- (set-buffer (or buffer nntp-server-buffer))
- (erase-buffer)
- (nnweb-insert-html contents)
- (goto-char (point-min))
- (insert "Content-Type: text/html\nMIME-Version: 1.0\n")
- (let ((header (cdr (assq article nnwfm-headers))))
- (mm-with-unibyte-current-buffer
- (nnheader-insert-header header)))
- (nnheader-report 'nnwfm "Fetched article %s" article)
- (cons group article)))))
-
-(deffoo nnwfm-request-list (&optional server)
- (nnwfm-possibly-change-server nil server)
- (mm-with-unibyte-buffer
- (mm-url-insert
- (if (string-match "/$" nnwfm-address)
- (concat nnwfm-address "Group.asp")
- nnwfm-address))
- (let* ((nnwfm-table-regexp "Thread.asp")
- (contents (w3-parse-buffer (current-buffer)))
- sid elem description articles a href group forum
- a1 a2)
- (dolist (row (cdr (nth 2 (car (nth 2 (nnwfm-find-forum-table
- contents))))))
- (setq row (nth 2 row))
- (when (setq a (nnweb-parse-find 'a row))
- (setq group (car (last (nnweb-text a)))
- href (cdr (assq 'href (nth 1 a))))
- (setq description (car (last (nnweb-text (nth 1 row)))))
- (setq articles
- (string-to-number
- (gnus-replace-in-string
- (car (last (nnweb-text (nth 3 row)))) "," "")))
- (when (and href
- (string-match "GroupId=\\([0-9]+\\)" href))
- (setq forum (string-to-number (match-string 1 href)))
- (if (setq elem (assoc group nnwfm-groups))
- (setcar (cdr elem) articles)
- (push (list group articles forum description nil nil nil nil)
- nnwfm-groups))))))
- (nnwfm-write-groups)
- (nnwfm-generate-active)
- t))
-
-(deffoo nnwfm-request-newgroups (date &optional server)
- (nnwfm-possibly-change-server nil server)
- (nnwfm-generate-active)
- t)
-
-(nnoo-define-skeleton nnwfm)
-
-;;; Internal functions
-
-(defun nnwfm-new-threads-p (group time)
- "See whether we want to fetch the threads for GROUP written before TIME."
- (let ((old-time (nth 7 (assoc group nnwfm-groups))))
- (or (null old-time)
- (time-less-p old-time time))))
-
-(defun nnwfm-create-mapping (group)
- (let* ((entry (assoc group nnwfm-groups))
- (sid (nth 2 entry))
- (topics (nth 4 entry))
- (mapping (nth 5 entry))
- (old-total (or (nth 6 entry) 1))
- (current-time (current-time))
- (nnwfm-table-regexp "Thread.asp")
- (furls (list (concat nnwfm-address
- (format "Thread.asp?GroupId=%d" sid))))
- fetched-urls
- contents forum-contents a subject href
- garticles topic tinfo old-max inc parse elem date
- url time)
- (mm-with-unibyte-buffer
- (while furls
- (erase-buffer)
- (push (car furls) fetched-urls)
- (mm-url-insert (pop furls))
- (goto-char (point-min))
- (while (re-search-forward " wr(" nil t)
- (forward-char -1)
- (setq elem (message-tokenize-header
- (gnus-replace-in-string
- (buffer-substring
- (1+ (point))
- (progn
- (forward-sexp 1)
- (1- (point))))
- "\\\\[\"\\\\]" "")))
- (push (list
- (string-to-number (nth 1 elem))
- (gnus-replace-in-string (nth 2 elem) "\"" "")
- (string-to-number (nth 5 elem)))
- forum-contents))
- (when (re-search-forward "href=\"\\(Thread.*DateLast=\\([^\"]+\\)\\)"
- nil t)
- (setq url (match-string 1)
- time (nnwfm-date-to-time (gnus-url-unhex-string
- (match-string 2))))
- (when (and (nnwfm-new-threads-p group time)
- (not (member
- (setq url (concat
- nnwfm-address
- (mm-url-decode-entities-string url)))
- fetched-urls)))
- (push url furls))))
- ;; The main idea here is to map Gnus article numbers to
- ;; nnwfm article numbers. Say there are three topics in
- ;; this forum, the first with 4 articles, the seconds with 2,
- ;; and the third with 1. Then this will translate into 7 Gnus
- ;; article numbers, where 1-4 comes from the first topic, 5-6
- ;; from the second and 7 from the third. Now, then next time
- ;; the group is entered, there's 2 new articles in topic one
- ;; and 1 in topic three. Then Gnus article number 8-9 be 5-6
- ;; in topic one and 10 will be the 2 in topic three.
- (dolist (elem (nreverse forum-contents))
- (setq subject (nth 1 elem)
- topic (nth 0 elem)
- garticles (nth 2 elem))
- (if (setq tinfo (assq topic topics))
- (progn
- (setq old-max (cadr tinfo))
- (setcar (cdr tinfo) garticles))
- (setq old-max 0)
- (push (list topic garticles subject) topics)
- (setcar (nthcdr 4 entry) topics))
- (when (not (= old-max garticles))
- (setq inc (- garticles old-max))
- (setq mapping (nconc mapping
- (list
- (list
- old-total (1- (incf old-total inc))
- topic (1+ old-max)))))
- (incf old-max inc)
- (setcar (nthcdr 5 entry) mapping)
- (setcar (nthcdr 6 entry) old-total))))
- (setcar (nthcdr 7 entry) current-time)
- (setcar (nthcdr 1 entry) (1- old-total))
- (nnwfm-write-groups)
- mapping))
-
-(defun nnwfm-possibly-change-server (&optional group server)
- (nnwfm-init server)
- (when (and server
- (not (nnwfm-server-opened server)))
- (nnwfm-open-server server))
- (unless nnwfm-groups-alist
- (nnwfm-read-groups)
- (setq nnwfm-groups (cdr (assoc nnwfm-address
- nnwfm-groups-alist)))))
-
-(deffoo nnwfm-open-server (server &optional defs connectionless)
- (nnheader-init-server-buffer)
- (if (nnwfm-server-opened server)
- t
- (unless (assq 'nnwfm-address defs)
- (setq defs (append defs (list (list 'nnwfm-address server)))))
- (nnoo-change-server 'nnwfm server defs)))
-
-(defun nnwfm-read-groups ()
- (setq nnwfm-groups-alist nil)
- (let ((file (expand-file-name "groups" nnwfm-directory)))
- (when (file-exists-p file)
- (mm-with-unibyte-buffer
- (insert-file-contents file)
- (goto-char (point-min))
- (setq nnwfm-groups-alist (read (current-buffer)))))))
-
-(defun nnwfm-write-groups ()
- (setq nnwfm-groups-alist
- (delq (assoc nnwfm-address nnwfm-groups-alist)
- nnwfm-groups-alist))
- (push (cons nnwfm-address nnwfm-groups)
- nnwfm-groups-alist)
- (with-temp-file (expand-file-name "groups" nnwfm-directory)
- (prin1 nnwfm-groups-alist (current-buffer))))
-
-(defun nnwfm-init (server)
- "Initialize buffers and such."
- (unless (file-exists-p nnwfm-directory)
- (gnus-make-directory nnwfm-directory)))
-
-(defun nnwfm-generate-active ()
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (dolist (elem nnwfm-groups)
- (insert (prin1-to-string (car elem))
- " " (number-to-string (cadr elem)) " 1 y\n"))))
-
-(defun nnwfm-find-forum-table (contents)
- (catch 'found
- (nnwfm-find-forum-table-1 contents)))
-
-(defun nnwfm-find-forum-table-1 (contents)
- (dolist (element contents)
- (unless (stringp element)
- (when (and (eq (car element) 'table)
- (nnwfm-forum-table-p element))
- (throw 'found element))
- (when (nth 2 element)
- (nnwfm-find-forum-table-1 (nth 2 element))))))
-
-(defun nnwfm-forum-table-p (parse)
- (when (not (apply 'gnus-or
- (mapcar
- (lambda (p)
- (nnweb-parse-find 'table p))
- (nth 2 parse))))
- (let ((href (cdr (assq 'href (nth 1 (nnweb-parse-find 'a parse 20)))))
- case-fold-search)
- (when (and href (string-match nnwfm-table-regexp href))
- t))))
-
-(defun nnwfm-date-to-time (date)
- (let ((time (mapcar #'string-to-number (split-string date "[\\.\\+ :]"))))
- (encode-time 0 (nth 4 time) (nth 3 time)
- (nth 0 time) (nth 1 time)
- (if (< (nth 2 time) 70)
- (+ 2000 (nth 2 time))
- (+ 1900 (nth 2 time))))))
-
-(provide 'nnwfm)
-
-;; Local Variables:
-;; coding: iso-8859-1
-;; End:
-
-;; arch-tag: d813966a-4211-4557-ad11-d1ac2bc86536
-;;; nnwfm.el ends here
diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el
index 20f7ba34b3..4f28dcdca4 100644
--- a/lisp/gnus/pop3.el
+++ b/lisp/gnus/pop3.el
@@ -33,6 +33,7 @@
;;; Code:
+(eval-when-compile (require 'cl))
(require 'mail-utils)
(defvar parse-time-months)
@@ -98,12 +99,6 @@ thing can fall apart and leave you with a corrupt mailbox."
:type 'boolean
:group 'pop3)
-(defcustom pop3-display-message-size-flag t
- "*If non-nil, display the size of the message that is being fetched."
- :version "22.1" ;; Oort Gnus
- :type 'boolean
- :group 'pop3)
-
(defvar pop3-timestamp nil
"Timestamp returned when initially connected to the POP server.
Used for APOP authentication.")
@@ -120,7 +115,7 @@ Used for APOP authentication.")
(defalias 'pop3-accept-process-output 'nnheader-accept-process-output)
;; Borrowed from `nnheader.el':
(defvar pop3-read-timeout
- (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin"
+ (if (string-match "windows-nt\\|os/2\\|cygwin"
(symbol-name system-type))
1.0
0.01)
@@ -134,15 +129,92 @@ Shorter values mean quicker response, but are more CPU intensive.")
(truncate pop3-read-timeout))
1000))))))
-(defun pop3-movemail (&optional crashbox)
- "Transfer contents of a maildrop to the specified CRASHBOX."
- (or crashbox (setq crashbox (expand-file-name "~/.crashbox")))
+;;;###autoload
+(defun pop3-movemail (file)
+ "Transfer contents of a maildrop to the specified FILE.
+Use streaming commands."
(let* ((process (pop3-open-server pop3-mailhost pop3-port))
- (crashbuf (get-buffer-create " *pop3-retr*"))
- (n 1)
- message-count
- message-sizes
- (pop3-password pop3-password))
+ message-count message-total-size)
+ (pop3-logon process)
+ (with-current-buffer (process-buffer process)
+ (let ((size (pop3-stat process)))
+ (setq message-count (car size)
+ message-total-size (cadr size)))
+ (when (plusp message-count)
+ (pop3-send-streaming-command
+ process "RETR" message-count message-total-size)
+ (pop3-write-to-file file)
+ (unless pop3-leave-mail-on-server
+ (pop3-send-streaming-command
+ process "DELE" message-count nil))))
+ (pop3-quit process)
+ t))
+
+(defun pop3-send-streaming-command (process command count total-size)
+ (erase-buffer)
+ (let ((i 1))
+ (while (>= count i)
+ (process-send-string process (format "%s %d\r\n" command i))
+ ;; Only do 100 messages at a time to avoid pipe stalls.
+ (when (zerop (% i 100))
+ (pop3-wait-for-messages process i total-size))
+ (incf i)))
+ (pop3-wait-for-messages process count total-size))
+
+(defun pop3-wait-for-messages (process count total-size)
+ (while (< (pop3-number-of-responses total-size) count)
+ (when total-size
+ (message "pop3 retrieved %dKB (%d%%)"
+ (truncate (/ (buffer-size) 1000))
+ (truncate (* (/ (* (buffer-size) 1.0)
+ total-size) 100))))
+ (nnheader-accept-process-output process)))
+
+(defun pop3-write-to-file (file)
+ (let ((pop-buffer (current-buffer))
+ (start (point-min))
+ beg end
+ temp-buffer)
+ (with-temp-buffer
+ (setq temp-buffer (current-buffer))
+ (with-current-buffer pop-buffer
+ (goto-char (point-min))
+ (while (re-search-forward "^\\+OK" nil t)
+ (forward-line 1)
+ (setq beg (point))
+ (when (re-search-forward "^\\.\r?\n" nil t)
+ (setq start (point))
+ (forward-line -1)
+ (setq end (point)))
+ (with-current-buffer temp-buffer
+ (goto-char (point-max))
+ (let ((hstart (point)))
+ (insert-buffer-substring pop-buffer beg end)
+ (pop3-clean-region hstart (point))
+ (goto-char (point-max))
+ (pop3-munge-message-separator hstart (point))
+ (goto-char (point-max))))))
+ (let ((coding-system-for-write 'binary))
+ (goto-char (point-min))
+ ;; Check whether something inserted a newline at the start and
+ ;; delete it.
+ (when (eolp)
+ (delete-char 1))
+ (write-region (point-min) (point-max) file nil 'nomesg)))))
+
+(defun pop3-number-of-responses (endp)
+ (let ((responses 0))
+ (save-excursion
+ (goto-char (point-min))
+ (while (or (and (re-search-forward "^\\+OK" nil t)
+ (or (not endp)
+ (re-search-forward "^\\.\r?\n" nil t)))
+ (re-search-forward "^-ERR " nil t))
+ (incf responses)))
+ responses))
+
+(defun pop3-logon (process)
+ (let ((pop3-password pop3-password))
;; for debugging only
(if pop3-debug (switch-to-buffer (process-buffer process)))
;; query for password
@@ -154,42 +226,7 @@ Shorter values mean quicker response, but are more CPU intensive.")
((equal 'pass pop3-authentication-scheme)
(pop3-user process pop3-maildrop)
(pop3-pass process))
- (t (error "Invalid POP3 authentication scheme")))
- (setq message-count (car (pop3-stat process)))
- (when (and pop3-display-message-size-flag
- (> message-count 0))
- (setq message-sizes (pop3-list process)))
- (unwind-protect
- (while (<= n message-count)
- (if pop3-display-message-size-flag
- (message "Retrieving message %d of %d from %s... (%.1fk)"
- n message-count pop3-mailhost
- (/ (cdr (assoc n message-sizes))
- 1024.0))
- (message "Retrieving message %d of %d from %s..."
- n message-count pop3-mailhost))
- (pop3-retr process n crashbuf)
- (save-excursion
- (set-buffer crashbuf)
- (let ((coding-system-for-write 'binary))
- (write-region (point-min) (point-max) crashbox t 'nomesg))
- (set-buffer (process-buffer process))
- (while (> (buffer-size) 5000)
- (goto-char (point-min))
- (forward-line 50)
- (delete-region (point-min) (point))))
- (unless pop3-leave-mail-on-server
- (pop3-dele process n))
- (setq n (+ 1 n))
- (pop3-accept-process-output process))
- (when (and pop3-leave-mail-on-server
- (> n 1))
- (message "pop3.el doesn't support UIDL. Setting `pop3-leave-mail-on-server'
-to %s might not give the result you'd expect." pop3-leave-mail-on-server)
- (sit-for 1))
- (pop3-quit process))
- (kill-buffer crashbuf))
- t)
+ (t (error "Invalid POP3 authentication scheme")))))
(defun pop3-get-message-count ()
"Return the number of messages in the maildrop."
@@ -229,6 +266,13 @@ this is nil, `ssl' is assumed for connexions to port
(const :tag "SSL/TLS" ssl)
(const starttls)))
+(eval-and-compile
+ (if (fboundp 'set-process-query-on-exit-flag)
+ (defalias 'pop3-set-process-query-on-exit-flag
+ 'set-process-query-on-exit-flag)
+ (defalias 'pop3-set-process-query-on-exit-flag
+ 'process-kill-without-query)))
+
(defun pop3-open-server (mailhost port)
"Open TCP connection to MAILHOST on PORT.
Returns the process associated with the connection."
@@ -283,22 +327,17 @@ Returns the process associated with the connection."
(pop3-quit process)
(error "POP server doesn't support starttls")))
process))
- (t
+ (t
(open-network-stream "POP" (current-buffer) mailhost port))))
(let ((response (pop3-read-response process t)))
(setq pop3-timestamp
(substring response (or (string-match "<" response) 0)
(+ 1 (or (string-match ">" response) -1)))))
+ (pop3-set-process-query-on-exit-flag process nil)
process)))
;; Support functions
-(defun pop3-process-filter (process output)
- (save-excursion
- (set-buffer (process-buffer process))
- (goto-char (point-max))
- (insert output)))
-
(defun pop3-send-command (process command)
(set-buffer (process-buffer process))
(goto-char (point-max))
@@ -415,10 +454,7 @@ If NOW, use that time instead."
nil
(goto-char (point-max))
(insert "\n"))
- (narrow-to-region (point) (point-max))
- (let ((size (- (point-max) (point-min))))
- (goto-char (point-min))
- (widen)
+ (let ((size (- (point-max) (point))))
(forward-line -1)
(insert (format "Content-Length: %s\n" size)))
)))))
@@ -468,7 +504,7 @@ If NOW, use that time instead."
(defun pop3-list (process &optional msg)
"If MSG is nil, return an alist of (MESSAGE-ID . SIZE) pairs.
Otherwise, return the size of the message-id MSG"
- (pop3-send-command process (if msg
+ (pop3-send-command process (if msg
(format "LIST %d" msg)
"LIST"))
(let ((response (pop3-read-response process t)))
@@ -643,5 +679,4 @@ and close the connection."
(provide 'pop3)
-;; arch-tag: 2facc142-1d74-498e-82af-4659b64cac12
;;; pop3.el ends here
diff --git a/lisp/gnus/qp.el b/lisp/gnus/qp.el
index 1b9b4ce01e..90975c48cd 100644
--- a/lisp/gnus/qp.el
+++ b/lisp/gnus/qp.el
@@ -164,5 +164,4 @@ encode lines starting with \"From\"."
(provide 'qp)
-;; arch-tag: db89e52a-e4a1-4b69-926f-f434f04216ba
;;; qp.el ends here
diff --git a/lisp/gnus/rfc1843.el b/lisp/gnus/rfc1843.el
index b491a76b9c..9826455832 100644
--- a/lisp/gnus/rfc1843.el
+++ b/lisp/gnus/rfc1843.el
@@ -192,5 +192,4 @@ ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc"
(provide 'rfc1843)
-;; arch-tag: 5149c301-a6ca-4731-9c9d-ba616e2cb687
;;; rfc1843.el ends here
diff --git a/lisp/gnus/rfc2045.el b/lisp/gnus/rfc2045.el
index b3eaefbf69..0263129c20 100644
--- a/lisp/gnus/rfc2045.el
+++ b/lisp/gnus/rfc2045.el
@@ -39,5 +39,4 @@
(provide 'rfc2045)
-;; arch-tag: 9ca54127-97bc-432c-b6e2-8c59cadba306
;;; rfc2045.el ends here
diff --git a/lisp/gnus/rfc2047.el b/lisp/gnus/rfc2047.el
index 27d34ee529..628423050b 100644
--- a/lisp/gnus/rfc2047.el
+++ b/lisp/gnus/rfc2047.el
@@ -1175,5 +1175,4 @@ strings are stripped."
(provide 'rfc2047)
-;; arch-tag: a07fe3d4-22b5-4c4a-bd89-b1f82d5d36f6
;;; rfc2047.el ends here
diff --git a/lisp/gnus/rfc2104.el b/lisp/gnus/rfc2104.el
index 84cb64dfd2..c1d0723197 100644
--- a/lisp/gnus/rfc2104.el
+++ b/lisp/gnus/rfc2104.el
@@ -122,5 +122,4 @@ In XEmacs return just STRING."
(provide 'rfc2104)
-;; arch-tag: cf671d5c-a45f-4a09-815e-704e59e43950
;;; rfc2104.el ends here
diff --git a/lisp/gnus/rfc2231.el b/lisp/gnus/rfc2231.el
index bb38c021cf..7cb1740c63 100644
--- a/lisp/gnus/rfc2231.el
+++ b/lisp/gnus/rfc2231.el
@@ -296,5 +296,4 @@ the result of this function."
(provide 'rfc2231)
-;; arch-tag: c3ab751d-d108-406a-b301-68882ad8cd63
;;; rfc2231.el ends here
diff --git a/lisp/gnus/score-mode.el b/lisp/gnus/score-mode.el
index 9ae3e4e9ac..04eae85bac 100644
--- a/lisp/gnus/score-mode.el
+++ b/lisp/gnus/score-mode.el
@@ -116,5 +116,4 @@ This mode is an extended emacs-lisp mode.
(provide 'score-mode)
-;; arch-tag: a74a416b-2505-4ad4-bc4e-a418c96b8845
;;; score-mode.el ends here
diff --git a/lisp/gnus/sieve-manage.el b/lisp/gnus/sieve-manage.el
index bd8741fe85..0f16444ca3 100644
--- a/lisp/gnus/sieve-manage.el
+++ b/lisp/gnus/sieve-manage.el
@@ -335,7 +335,7 @@ Returns t if login was successful, nil otherwise."
(defun sieve-sasl-auth (buffer mech)
"Login to server using the SASL MECH method."
(message "sieve: Authenticating using %s..." mech)
- (if (sieve-manage-interactive-login
+ (if (sieve-manage-interactive-login
buffer
(lambda (user passwd)
(let (client step tag data rsp)
@@ -701,5 +701,4 @@ password is remembered in the buffer."
(provide 'sieve-manage)
-;; arch-tag: 321c4640-1371-4495-9baf-8ccb71dd5bd1
;; sieve-manage.el ends here
diff --git a/lisp/gnus/sieve-mode.el b/lisp/gnus/sieve-mode.el
index f765589e7a..78927009fc 100644
--- a/lisp/gnus/sieve-mode.el
+++ b/lisp/gnus/sieve-mode.el
@@ -216,5 +216,4 @@ Turning on Sieve mode runs `sieve-mode-hook'."
(provide 'sieve-mode)
-;; arch-tag: 3b8ab76d-065d-4c52-b1e8-ab2ec21f2ace
;; sieve-mode.el ends here
diff --git a/lisp/gnus/sieve.el b/lisp/gnus/sieve.el
index 1b0322064d..7b014da2f8 100644
--- a/lisp/gnus/sieve.el
+++ b/lisp/gnus/sieve.el
@@ -380,5 +380,4 @@ Server : " server ":" (or port "2000") "
(provide 'sieve)
-;; arch-tag: 7f6a6d94-94e1-4654-ab9a-aee21b9b8a94
;; sieve.el ends here
diff --git a/lisp/gnus/smiley.el b/lisp/gnus/smiley.el
index fbe71e7725..afffc64f12 100644
--- a/lisp/gnus/smiley.el
+++ b/lisp/gnus/smiley.el
@@ -102,7 +102,8 @@ is nil, use `smiley-style'."
;; The XEmacs version has a baroque, if not rococo, set of these.
(defcustom smiley-regexp-alist
- '(("\\(;-?)\\)\\W" 1 "blink")
+ '(("\\(;-)\\)\\W" 1 "blink")
+ ("[^;]\\(;)\\)\\W" 1 "blink")
("\\(:-]\\)\\W" 1 "forced")
("\\(8-)\\)\\W" 1 "braindamaged")
("\\(:-|\\)\\W" 1 "indifferent")
@@ -119,6 +120,7 @@ is nil, use `smiley-style'."
The elements are (REGEXP MATCH IMAGE), where MATCH is the submatch in
regexp to replace with IMAGE. IMAGE is the name of an image file in
`smiley-data-directory'."
+ :version "24.1"
:type '(repeat (list regexp
(integer :tag "Regexp match number")
(string :tag "Image name")))
@@ -226,5 +228,4 @@ With arg, turn displaying on if and only if arg is positive."
(provide 'smiley)
-;; arch-tag: 5beb161b-4321-40af-8ac9-876afb8ee818
;;; smiley.el ends here
diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el
index b60acee445..d836f32016 100644
--- a/lisp/gnus/smime.el
+++ b/lisp/gnus/smime.el
@@ -729,5 +729,4 @@ The following commands are available:
(provide 'smime)
-;; arch-tag: e3f9b938-5085-4510-8a11-6625269c9a9e
;;; smime.el ends here
diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el
index 45ca4b0397..0e32e93404 100644
--- a/lisp/gnus/spam-report.el
+++ b/lisp/gnus/spam-report.el
@@ -95,12 +95,12 @@ undo that change.")
"Report an article as spam by resending via email.
Reports is as ham when HAM is set."
(dolist (article articles)
- (gnus-message 6
+ (gnus-message 6
"Reporting %s article %d to <%s>..."
(if ham "ham" "spam")
article spam-report-resend-to)
(unless spam-report-resend-to
- (customize-set-variable
+ (customize-set-variable
spam-report-resend-to
(read-from-minibuffer "email address to resend SPAM/HAM to? ")))
;; This is ganked from the `gnus-summary-resend-message' function.
@@ -267,7 +267,7 @@ This is initialized based on `user-mail-address'."
(gnus-message 7 "Waiting for response from %s..." host)
(while (and (memq (process-status tcp-connection) '(open run))
(zerop (buffer-size)))
- (accept-process-output tcp-connection))
+ (accept-process-output tcp-connection 1))
(gnus-message 7 "Waiting for response from %s... done" host)))))
;;;###autoload
@@ -385,5 +385,4 @@ Process queued spam reports."
(provide 'spam-report)
-;; arch-tag: f6683295-ec89-4ab5-8803-8cc842293022
;;; spam-report.el ends here.
diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el
index 69fc2016a6..d6b20df78b 100644
--- a/lisp/gnus/spam-stat.el
+++ b/lisp/gnus/spam-stat.el
@@ -674,5 +674,4 @@ COUNT defaults to 5"
(provide 'spam-stat)
-;; arch-tag: ff1d2200-8ddb-42fb-bb7b-1b5e20448554
;;; spam-stat.el ends here
diff --git a/lisp/gnus/spam-wash.el b/lisp/gnus/spam-wash.el
index 2ef7452a0e..d201c9eddf 100644
--- a/lisp/gnus/spam-wash.el
+++ b/lisp/gnus/spam-wash.el
@@ -69,5 +69,4 @@
(provide 'spam-wash)
-;; arch-tag: 3c7f94a7-c96d-4c77-bb59-950df12bc85f
;;; spam-wash.el ends here
diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el
index 10304c00c8..d079be2fcd 100644
--- a/lisp/gnus/spam.el
+++ b/lisp/gnus/spam.el
@@ -2941,5 +2941,4 @@ installed through `spam-necessary-extra-headers'."
(provide 'spam)
-;; arch-tag: 07e6e0ca-ab0a-4412-b445-1f6c72a4f27f
;;; spam.el ends here
diff --git a/lisp/gnus/starttls.el b/lisp/gnus/starttls.el
index 18c05bfc50..02a557de5c 100644
--- a/lisp/gnus/starttls.el
+++ b/lisp/gnus/starttls.el
@@ -311,5 +311,4 @@ GNUTLS requires a port number."
(provide 'starttls)
-;; arch-tag: 648b3bd8-63bd-47f5-904c-7c819aea2297
;;; starttls.el ends here
diff --git a/lisp/gnus/utf7.el b/lisp/gnus/utf7.el
index ec8111fe33..cca647d94b 100644
--- a/lisp/gnus/utf7.el
+++ b/lisp/gnus/utf7.el
@@ -228,5 +228,4 @@ Characters are in raw byte pairs in narrowed buffer."
(provide 'utf7)
-;; arch-tag: 96078b55-85c7-4161-aed2-932c24b282c7
;;; utf7.el ends here
diff --git a/lisp/gnus/webmail.el b/lisp/gnus/webmail.el
index 106445d052..86d443aa90 100644
--- a/lisp/gnus/webmail.el
+++ b/lisp/gnus/webmail.el
@@ -1148,5 +1148,4 @@
(provide 'webmail)
-;; arch-tag: f75a4558-a8f6-46ec-b1c3-7a6434b3dd71
;;; webmail.el ends here
diff --git a/lisp/gnus/yenc.el b/lisp/gnus/yenc.el
index 2d56d66058..9fdf62d43b 100644
--- a/lisp/gnus/yenc.el
+++ b/lisp/gnus/yenc.el
@@ -136,5 +136,4 @@
(provide 'yenc)
-;; arch-tag: 74df17e8-6fa8-4071-9f7d-54d548d79d9a
;;; yenc.el ends here
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index b02a8dcb71..af08b66b1e 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -6,6 +6,7 @@
;; Maintainer: FSF
;; Keywords: help, internal
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/help-macro.el b/lisp/help-macro.el
index 12fa29abf5..2e0f7fad53 100644
--- a/lisp/help-macro.el
+++ b/lisp/help-macro.el
@@ -7,6 +7,7 @@
;; Maintainer: FSF
;; Created: Mon Oct 1 11:42:39 1990
;; Adapted-By: ESR
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index 7a7a1ddaf7..9d10d5170b 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -5,6 +5,7 @@
;; Maintainer: FSF
;; Keywords: help, internal
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/help.el b/lisp/help.el
index 9434201797..a2e721dd6b 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -5,6 +5,7 @@
;; Maintainer: FSF
;; Keywords: help, internal
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -103,6 +104,7 @@
(define-key map "m" 'describe-mode)
(define-key map "n" 'view-emacs-news)
(define-key map "p" 'finder-by-keyword)
+ (define-key map "P" 'describe-package)
(define-key map "r" 'info-emacs-manual)
(define-key map "s" 'describe-syntax)
(define-key map "t" 'help-with-tutorial)
diff --git a/lisp/hex-util.el b/lisp/hex-util.el
index 10142896f1..932a7fe354 100644
--- a/lisp/hex-util.el
+++ b/lisp/hex-util.el
@@ -69,5 +69,4 @@
(provide 'hex-util)
-;; arch-tag: fe8aaa79-6c86-400e-813f-5a8cc4cb3859
;;; hex-util.el ends here
diff --git a/lisp/hfy-cmap.el b/lisp/hfy-cmap.el
index 0eff90d229..7aefc36224 100644
--- a/lisp/hfy-cmap.el
+++ b/lisp/hfy-cmap.el
@@ -13,6 +13,7 @@
;; Description: fallback code for colour name -> rgb mapping
;; URL: http://rtfm.etla.org/emacs/htmlfontify/
;; Last-Updated: Sat 2003-02-15 03:49:32 +0000
+;; Package: htmlfontify
;; This file is part of GNU Emacs.
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index 035b6d384e..bfa8159508 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -15,6 +15,7 @@
;; Compatibility: Emacs23, Emacs22
;; Incompatibility: Emacs19, Emacs20, Emacs21
;; Last Updated: Thu 2009-11-19 01:31:21 +0000
+;; Version: 0.21
;; This file is part of GNU Emacs.
@@ -2348,7 +2349,7 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'."
;;;### (autoloads (hfy-fallback-colour-values htmlfontify-load-rgb-file)
-;;;;;; "hfy-cmap" "hfy-cmap.el" "3de2db2d213813bb3afe170ffd66cdde")
+;;;;;; "hfy-cmap" "hfy-cmap.el" "7e622e4b131ea5efbe9d258f719822d6")
;;; Generated autoloads from hfy-cmap.el
(autoload 'htmlfontify-load-rgb-file "hfy-cmap" "\
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index dcea1e5747..196838f248 100644
--- a/lisp/ibuf-ext.el
+++ b/lisp/ibuf-ext.el
@@ -7,6 +7,7 @@
;; Maintainer: John Paul Wallington <[email protected]>
;; Created: 2 Dec 2001
;; Keywords: buffer, convenience
+;; Package: ibuffer
;; This file is part of GNU Emacs.
diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el
index 60fb7e3b82..684cfe8f51 100644
--- a/lisp/ibuf-macs.el
+++ b/lisp/ibuf-macs.el
@@ -7,6 +7,7 @@
;; Maintainer: John Paul Wallington <[email protected]>
;; Created: 6 Dec 2001
;; Keywords: buffer, convenience
+;; Package: ibuffer
;; This file is part of GNU Emacs.
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index 44e59a5c8b..c2492818b4 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -2641,7 +2641,7 @@ will be inserted before the group at point."
;;;;;; ibuffer-backward-filter-group ibuffer-forward-filter-group
;;;;;; ibuffer-toggle-filter-group ibuffer-mouse-toggle-filter-group
;;;;;; ibuffer-interactive-filter-by-mode ibuffer-mouse-filter-by-mode
-;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "e1272bfdc7c3b6e926b2a68155217303")
+;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "fa9822b5ef905f06d8a03dc9ce3a2894")
;;; Generated autoloads from ibuf-ext.el
(autoload 'ibuffer-auto-mode "ibuf-ext" "\
diff --git a/lisp/ido.el b/lisp/ido.el
index d34893d708..858ee3ed5b 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -780,7 +780,7 @@ Essentially it works as follows: Say you are visiting a file and
the buffer gets cleaned up by mignight.el. Later, you want to
switch to that buffer, but find it's no longer open. With
virtual buffers enabled, the buffer name stays in the buffer
-list (using the ido-virtual face, and always at the end), and if
+list (using the `ido-virtual' face, and always at the end), and if
you select it, it opens the file back up again. This allows you
to think less about whether recently opened files are still open
or not. Most of the time you can quit Emacs, restart, and then
@@ -1070,11 +1070,11 @@ Only used if `ido-use-virtual-buffers' is non-nil.")
;; Stores the current list of items that will be searched through.
;; The list is ordered, so that the most interesting item comes first,
;; although by default, the files visible in the current frame are put
-;; at the end of the list.
-(defvar ido-cur-list nil)
+;; at the end of the list. Created by `ido-make-item-list'.
+(defvar ido-cur-list)
;; Stores the choice list for ido-completing-read
-(defvar ido-choice-list nil)
+(defvar ido-choice-list)
;; Stores the list of items which are ignored when building
;; `ido-cur-list'. It is in no specific order.
@@ -3400,11 +3400,9 @@ for first matching file."
(if ido-temp-list
(nconc ido-temp-list ido-current-buffers)
(setq ido-temp-list ido-current-buffers))
- (when (and default (buffer-live-p (get-buffer default)))
- (setq ido-temp-list
- (cons default (delete default ido-temp-list))))
- (if ido-use-virtual-buffers
- (ido-add-virtual-buffers-to-list))
+ (if default
+ (setq ido-temp-list
+ (cons default (delete default ido-temp-list))))
(run-hooks 'ido-make-buffer-list-hook)
ido-temp-list))
@@ -3672,7 +3670,6 @@ This is to make them appear as if they were \"virtual buffers\"."
;; Used by `ido-get-buffers-in-frames' to walk through all windows
(let ((buf (buffer-name (window-buffer win))))
(unless (or (member buf ido-bufs-in-frame)
- (minibufferp buf)
(member buf ido-ignore-item-temp-list))
;; Only add buf if it is not already in list.
;; This prevents same buf in two different windows being
@@ -3913,27 +3910,6 @@ This is to make them appear as if they were \"virtual buffers\"."
;;(add-hook 'completion-setup-hook 'completion-setup-function)
(display-completion-list completion-list)))))))
-(defun ido-kill-buffer-internal (buf)
- "Kill buffer BUF and rebuild ido's buffer list if needed."
- (if (not (kill-buffer buf))
- ;; buffer couldn't be killed.
- (setq ido-rescan t)
- ;; else buffer was killed so remove name from list.
- (setq ido-cur-list (delq buf ido-cur-list))
- ;; Some packages, like uniquify.el, may rename buffers when one
- ;; is killed, so we need to test this condition to avoid using
- ;; an outdated list of buffer names. We don't want to always
- ;; rebuild the list of buffers, as this alters the previous
- ;; buffer order that the user was seeing on the prompt. However,
- ;; when we rebuild the list, we try to keep the previous second
- ;; buffer as the first one.
- (catch 'update
- (dolist (b ido-cur-list)
- (unless (get-buffer b)
- (setq ido-cur-list (ido-make-buffer-list (cadr ido-matches)))
- (setq ido-rescan t)
- (throw 'update nil))))))
-
;;; KILL CURRENT BUFFER
(defun ido-kill-buffer-at-head ()
"Kill the buffer at the head of `ido-matches'.
@@ -3942,15 +3918,26 @@ If cursor is not at the end of the user input, delete to end of input."
(if (not (eobp))
(delete-region (point) (line-end-position))
(let ((enable-recursive-minibuffers t)
- (buf (ido-name (car ido-matches))))
- (when buf
- (ido-kill-buffer-internal buf)
- ;; Check if buffer still exists.
- (if (get-buffer buf)
- ;; buffer couldn't be killed.
+ (buf (ido-name (car ido-matches)))
+ (nextbuf (cadr ido-matches)))
+ (when (get-buffer buf)
+ ;; If next match names a buffer use the buffer object; buffer
+ ;; name may be changed by packages such as uniquify; mindful
+ ;; of virtual buffers.
+ (when (and nextbuf (get-buffer nextbuf))
+ (setq nextbuf (get-buffer nextbuf)))
+ (if (null (kill-buffer buf))
+ ;; Buffer couldn't be killed.
(setq ido-rescan t)
- ;; else buffer was killed so remove name from list.
- (setq ido-cur-list (delq buf ido-cur-list)))))))
+ ;; Else `kill-buffer' succeeds so re-make the buffer list
+ ;; taking into account packages like uniquify may rename
+ ;; buffers.
+ (if (bufferp nextbuf)
+ (setq nextbuf (buffer-name nextbuf)))
+ (setq ido-default-item nextbuf
+ ido-text-init ido-text
+ ido-exit 'refresh)
+ (exit-minibuffer))))))
;;; DELETE CURRENT FILE
(defun ido-delete-file-at-head ()
@@ -3988,7 +3975,7 @@ Record command in `command-history' if optional RECORD is non-nil."
((eq method 'kill)
(if record
(ido-record-command 'kill-buffer buffer))
- (ido-kill-buffer-internal buffer))
+ (kill-buffer buffer))
((eq method 'other-window)
(if record
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index a34989171b..6e67847857 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -4,6 +4,7 @@
;;
;; Author: Richard Stallman <[email protected]>
;; Keywords: multimedia
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -493,7 +494,10 @@ was inserted."
(buffer-substring-no-properties (point-min) (point-max)))
filename))
(type (image-type file-or-data nil data-p))
- (image (create-animated-image file-or-data type data-p))
+ (image0 (create-animated-image file-or-data type data-p))
+ (image (append image0
+ (image-transform-properties image0)
+ ))
(props
`(display ,image
intangible ,image
@@ -556,6 +560,84 @@ the image file and `image-mode' showing the image as an image."
(when (not (string= image-type (bookmark-prop-get bmk 'image-type)))
(image-toggle-display))))
+
+(defvar image-transform-minor-mode-map
+ (let ((map (make-sparse-keymap)))
+; (define-key map [(control ?+)] 'image-scale-in)
+; (define-key map [(control ?-)] 'image-scale-out)
+; (define-key map [(control ?=)] 'image-scale-none)
+;; (define-key map "c f h" 'image-scale-fit-height)
+;; (define-key map "c ]" 'image-rotate-right)
+ map)
+ "Minor mode keymap for transforming the view of images Image mode.")
+
+(define-minor-mode image-transform-mode
+ "minor mode for scaleing and rotation"
+ nil "image-transform"
+ image-transform-minor-mode-map)
+
+(defvar image-transform-resize nil
+ "The image resize operation. See the command
+ `image-transform-set-scale' for more information." )
+
+(defvar image-transform-rotation 0.0)
+
+
+(defun image-transform-properties (display)
+ "Calculate the display properties for transformations; scaling
+and rotation. "
+ (let*
+ ((size (image-size display t))
+ (height
+ (cond
+ ((and (numberp image-transform-resize) (eq 100 image-transform-resize))
+ nil)
+ ((numberp image-transform-resize)
+ (* image-transform-resize (cdr size)))
+ ((eq image-transform-resize 'fit-height)
+ (- (nth 3 (window-inside-pixel-edges)) (nth 1 (window-inside-pixel-edges))))
+ (t nil)))
+ (width (if (eq image-transform-resize 'fit-width)
+ (- (nth 2 (window-inside-pixel-edges)) (nth 0 (window-inside-pixel-edges))))))
+
+ `(,@(if height (list :height height))
+ ,@(if width (list :width width))
+ ,@(if (not (equal 0.0 image-transform-rotation))
+ (list :rotation image-transform-rotation))
+ ;;TODO fit-to-* should consider the rotation angle
+ )))
+
+(defun image-transform-set-scale (scale)
+ "SCALE sets the scaling for images. "
+ (interactive "nscale:")
+ (image-transform-set-resize (float scale)))
+
+(defun image-transform-fit-to-height ()
+ "Fit image height to window height. "
+ (interactive)
+ (image-transform-set-resize 'fit-height))
+
+(defun image-transform-fit-to-width ()
+ "Fit image width to window width. "
+ (interactive)
+ (image-transform-set-resize 'fit-width))
+
+(defun image-transform-set-resize (resize)
+ "Set the resize mode for images. The RESIZE value can be the
+symbol fit-height which fits the image to the window height. The
+symbol fit-width fits the image to the window width. A number
+indicates a scaling factor. nil indicates scale to 100%. "
+ (setq image-transform-resize resize)
+ (if (eq 'image-mode major-mode) (image-toggle-display-image)))
+
+(defun image-transform-set-rotation (rotation)
+ "Set the image ROTATION angle. "
+ (interactive "nrotation:")
+ ;;TODO 0 90 180 270 degrees are the only reasonable angles here
+ ;;otherwise combining with rescaling will get very awkward
+ (setq image-transform-rotation (float rotation))
+ (if (eq major-mode 'image-mode) (image-toggle-display-image)))
+
(provide 'image-mode)
;; arch-tag: b5b2b7e6-26a7-4b79-96e3-1546b5c4c6cb
diff --git a/lisp/image.el b/lisp/image.el
index 287cca8157..2ca2971b4a 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -5,6 +5,7 @@
;; Maintainer: FSF
;; Keywords: multimedia
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -616,7 +617,7 @@ Images should not be larger than specified by `max-image-size'."
(let* ((animate (memq type image-animated-types))
(image
(append (list 'image :type type (if data-p :data :file) file-or-data)
- (if animate '(:index 0 :mask heuristic))
+ (if animate '(:index 0))
props)))
(if animate
(image-animate-start image))
@@ -694,6 +695,34 @@ shall be displayed."
(cons images tmo))))))
+(defcustom imagemagick-types-inhibit
+ '(C HTML HTM TXT PDF)
+ ;; FIXME what are the possible options?
+ ;; Are these actually file-name extensions?
+ ;; Why are these upper-case when eg image-types is lower-case?
+ "Types the ImageMagick loader should not try to handle."
+ :type '(choice (const :tag "Let ImageMagick handle all the types it can" nil)
+ (repeat symbol))
+ :version "24.1"
+ :group 'image)
+
+;;;###autoload
+(defun imagemagick-register-types ()
+ "Register the file types that ImageMagick is able to handle."
+ (let ((im-types (imagemagick-types)))
+ (dolist (im-inhibit imagemagick-types-inhibit)
+ (setq im-types (remove im-inhibit im-types)))
+ (dolist (im-type im-types)
+ (let ((extension (downcase (symbol-name im-type))))
+ (push
+ (cons (concat "\\." extension "\\'") 'image-mode)
+ auto-mode-alist)
+ (push
+ (cons (concat "\\." extension "\\'") 'imagemagick)
+ image-type-file-name-regexps)))))
+
+
+
(provide 'image)
;; arch-tag: 8e76a07b-eb48-4f3e-a7a0-1a7ba9f096b3
diff --git a/lisp/indent.el b/lisp/indent.el
index c1da4a46b9..7116b705af 100644
--- a/lisp/indent.el
+++ b/lisp/indent.el
@@ -4,6 +4,7 @@
;; 2008, 2009, 2010 Free Software Foundation, Inc.
;; Maintainer: FSF
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/info.el b/lisp/info.el
index 65b9492e35..4fa9503b14 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -3372,7 +3372,6 @@ Build a menu of the possible matches."
filename)
(defvar finder-known-keywords)
-(defvar finder-package-info)
(declare-function find-library-name "find-func" (library))
(declare-function finder-unknown-keywords "finder" ())
(declare-function lm-commentary "lisp-mnt" (&optional file))
@@ -3388,15 +3387,14 @@ Build a menu of the possible matches."
(insert "Finder Keywords\n")
(insert "***************\n\n")
(insert "* Menu:\n\n")
- (mapc
- (lambda (assoc)
- (let ((keyword (car assoc)))
- (insert (format "* %-14s %s.\n"
- (concat (symbol-name keyword) "::")
- (cdr assoc)))))
- (append '((all . "All package info")
- (unknown . "unknown keywords"))
- finder-known-keywords)))
+ (dolist (assoc (append '((all . "All package info")
+ (unknown . "unknown keywords"))
+ finder-known-keywords))
+ (let ((keyword (car assoc)))
+ (insert (format "* %s %s.\n"
+ (concat (symbol-name keyword) ": "
+ "kw:" (symbol-name keyword) ".")
+ (cdr assoc))))))
((equal nodename "unknown")
;; Display unknown keywords
(insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n"
@@ -3416,17 +3414,36 @@ Build a menu of the possible matches."
Info-finder-file nodename))
(insert "Finder Package Info\n")
(insert "*******************\n\n")
- (mapc (lambda (package)
- (insert (format "%s - %s\n"
- (format "*Note %s::" (nth 0 package))
- (nth 1 package)))
- (insert "Keywords: "
- (mapconcat (lambda (keyword)
- (format "*Note %s::" (symbol-name keyword)))
- (nth 2 package) ", ")
- "\n\n"))
- finder-package-info))
- ((string-match-p "\\.el\\'" nodename)
+ (dolist (package package-alist)
+ (insert (format "%s - %s\n"
+ (format "*Note %s::" (nth 0 package))
+ (nth 1 package)))))
+ ((string-match "\\`kw:" nodename)
+ (setq nodename (substring nodename (match-end 0)))
+ ;; Display packages that match the keyword
+ ;; or the list of keywords separated by comma.
+ (insert (format "\n\^_\nFile: %s, Node: kw:%s, Up: Top\n\n"
+ Info-finder-file nodename))
+ (insert "Finder Packages\n")
+ (insert "***************\n\n")
+ (insert
+ "The following packages match the keyword `" nodename "':\n\n")
+ (insert "* Menu:\n\n")
+ (let ((keywords
+ (mapcar 'intern (if (string-match-p "," nodename)
+ (split-string nodename ",[ \t\n]*" t)
+ (list nodename))))
+ hits desc)
+ (dolist (kw keywords)
+ (push (copy-tree (gethash kw finder-keywords-hash)) hits))
+ (setq hits (delete-dups (apply 'append hits)))
+ (dolist (package hits)
+ (setq desc (cdr-safe (assq package package-alist)))
+ (when (vectorp desc)
+ (insert (format "* %-16s %s.\n"
+ (concat (symbol-name package) "::")
+ (aref desc 2)))))))
+ (t
;; Display commentary section
(insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n"
Info-finder-file nodename))
@@ -3447,29 +3464,7 @@ Build a menu of the possible matches."
(goto-char (point-min))
(while (re-search-forward "^;+ ?" nil t)
(replace-match "" nil nil))
- (buffer-string))))))
- (t
- ;; Display packages that match the keyword
- ;; or the list of keywords separated by comma.
- (insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n"
- Info-finder-file nodename))
- (insert "Finder Packages\n")
- (insert "***************\n\n")
- (insert
- "The following packages match the keyword `" nodename "':\n\n")
- (insert "* Menu:\n\n")
- (let ((keywords
- (mapcar 'intern (if (string-match-p "," nodename)
- (split-string nodename ",[ \t\n]*" t)
- (list nodename)))))
- (mapc
- (lambda (package)
- (unless (memq nil (mapcar (lambda (k) (memq k (nth 2 package)))
- keywords))
- (insert (format "* %-16s %s.\n"
- (concat (nth 0 package) "::")
- (nth 1 package)))))
- finder-package-info)))))
+ (buffer-string))))))))
;;;###autoload
(defun info-finder (&optional keywords)
diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el
index ecb2088de8..753b1ab25e 100644
--- a/lisp/international/fontset.el
+++ b/lisp/international/fontset.el
@@ -433,7 +433,7 @@
(nil . "koi8-r"))
(arabic ,(font-spec :registry "iso10646-1"
- :otf '(arab nil (init medi fini liga)))
+ :otf '(arab nil (init medi fina liga)))
(nil . "MuleArabic-0")
(nil . "MuleArabic-1")
(nil . "MuleArabic-2")
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index c961decfed..a3609c0ccf 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -1952,7 +1952,7 @@ See `set-language-info-alist' for use in programs."
(> (aref (number-to-string (nth 2 (x-server-version))) 0)
?3))
;; Make non-line-break space display as a plain space.
- (aset standard-display-table 160 [32]))
+ (aset standard-display-table (unibyte-char-to-multibyte 160) [32]))
;; Most Windows programs send out apostrophes as \222. Most X fonts
;; don't contain a character at that position. Map it to the ASCII
;; apostrophe. [This is actually RIGHT SINGLE QUOTATION MARK,
@@ -1960,7 +1960,7 @@ See `set-language-info-alist' for use in programs."
;; fonts probably have the appropriate glyph at this position,
;; so they could use standard-display-8bit. It's better to use a
;; proper windows-1252 coding system. --fx]
- (aset standard-display-table 146 [39]))))
+ (aset standard-display-table (unibyte-char-to-multibyte 146) [39]))))
(defun set-language-environment-coding-systems (language-name)
"Do various coding system setups for language environment LANGUAGE-NAME."
@@ -2179,7 +2179,7 @@ See `set-language-info-alist' for use in programs."
("af" . "Latin-1") ; Afrikaans
("am" "Ethiopic" utf-8) ; Amharic
("an" . "Latin-9") ; Aragonese
- ; ar Arabic glibc uses 8859-6
+ ("ar" . "Arabic")
; as Assamese
; ay Aymara
("az" . "UTF-8") ; Azerbaijani
diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index 59d6ff42c9..9f1833924b 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -326,8 +326,7 @@ Return t if file exists."
(with-current-buffer buffer
;; So that we don't get completely screwed if the
;; file is encoded in some complicated character set,
- ;; read it with real decoding, as a multibyte buffer,
- ;; even if this is a --unibyte Emacs session.
+ ;; read it with real decoding, as a multibyte buffer.
(set-buffer-multibyte t)
;; Don't let deactivate-mark remain set.
(let (deactivate-mark)
@@ -346,12 +345,7 @@ Return t if file exists."
(eval-buffer buffer nil
;; This is compatible with what `load' does.
(if purify-flag file fullname)
- ;; If this Emacs is running with --unibyte,
- ;; convert multibyte strings to unibyte
- ;; after reading them.
-;; (not (default-value 'enable-multibyte-characters))
- nil t
- ))
+ nil t))
(let (kill-buffer-hook kill-buffer-query-functions)
(kill-buffer buffer)))
(do-after-load-evaluation fullname)
@@ -2303,13 +2297,12 @@ It returns the number of characters changed."
(setq table val)))
(translate-region-internal start end table))
-(put 'with-category-table 'lisp-indent-function 1)
-
(defmacro with-category-table (table &rest body)
"Execute BODY like `progn' with TABLE the current category table.
The category table of the current buffer is saved, BODY is evaluated,
then the saved table is restored, even in case of an abnormal exit.
Value is what BODY returns."
+ (declare (indent 1) (debug t))
(let ((old-table (make-symbol "old-table"))
(old-buffer (make-symbol "old-buffer")))
`(let ((,old-table (category-table))
diff --git a/lisp/international/uni-bidi.el b/lisp/international/uni-bidi.el
index 7902810442..9e571ef9d0 100644
--- a/lisp/international/uni-bidi.el
+++ b/lisp/international/uni-bidi.el
Binary files differ
diff --git a/lisp/international/uni-category.el b/lisp/international/uni-category.el
index b81045f1a0..80538f7b41 100644
--- a/lisp/international/uni-category.el
+++ b/lisp/international/uni-category.el
Binary files differ
diff --git a/lisp/international/uni-combining.el b/lisp/international/uni-combining.el
index 1aca7ee1d1..2ee74d8b81 100644
--- a/lisp/international/uni-combining.el
+++ b/lisp/international/uni-combining.el
Binary files differ
diff --git a/lisp/international/uni-decimal.el b/lisp/international/uni-decimal.el
index 517280885b..22207a224b 100644
--- a/lisp/international/uni-decimal.el
+++ b/lisp/international/uni-decimal.el
Binary files differ
diff --git a/lisp/international/uni-mirrored.el b/lisp/international/uni-mirrored.el
index a1e2e69dfa..5129a93396 100644
--- a/lisp/international/uni-mirrored.el
+++ b/lisp/international/uni-mirrored.el
Binary files differ
diff --git a/lisp/international/uni-name.el b/lisp/international/uni-name.el
index 335957e954..5b9e8323d2 100644
--- a/lisp/international/uni-name.el
+++ b/lisp/international/uni-name.el
Binary files differ
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 6f89e0ee81..f18a74c59b 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -7,6 +7,7 @@
;; Author: Daniel LaLiberte <[email protected]>
;; Maintainer: FSF
;; Keywords: matching
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/iswitchb.el b/lisp/iswitchb.el
index ea4b00dc90..081897a89b 100644
--- a/lisp/iswitchb.el
+++ b/lisp/iswitchb.el
@@ -1027,8 +1027,8 @@ Return the modified list with the last element prepended to it."
(defun iswitchb-kill-buffer ()
"Kill the buffer at the head of `iswitchb-matches'."
(interactive)
- (let ( (enable-recursive-minibuffers t)
- buf)
+ (let ((enable-recursive-minibuffers t)
+ buf)
(setq buf (car iswitchb-matches))
;; check to see if buf is non-nil.
@@ -1042,8 +1042,10 @@ Return the modified list with the last element prepended to it."
(if (get-buffer buf)
;; buffer couldn't be killed.
(setq iswitchb-rescan t)
- ;; else buffer was killed so remove name from list.
- (setq iswitchb-buflist (delq buf iswitchb-buflist)))))))
+ ;; Else `kill-buffer' succeeds so re-make the buffer list
+ ;; taking into account packages like uniquify may rename
+ ;; buffers
+ (iswitchb-make-buflist iswitchb-default))))))
;;; VISIT CHOSEN BUFFER
(defun iswitchb-visit-buffer (buffer)
diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index dbe1cbe23e..cc250567ad 100644
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -5,6 +5,7 @@
;; Author: Gerd Moellmann <[email protected]>
;; Keywords: faces files
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -31,33 +32,13 @@
(eval-when-compile
(require 'cl)
- (defmacro with-buffer-unmodified (&rest body)
- "Eval BODY, preserving the current buffer's modified state."
- (declare (debug t))
- (let ((modified (make-symbol "modified")))
- `(let ((,modified (buffer-modified-p)))
- (unwind-protect
- (progn ,@body)
- (unless ,modified
- (restore-buffer-modified-p nil))))))
-
(defmacro with-buffer-prepared-for-jit-lock (&rest body)
"Execute BODY in current buffer, overriding several variables.
Preserves the `buffer-modified-p' state of the current buffer."
(declare (debug t))
- `(let ((buffer-undo-list t)
- (inhibit-read-only t)
- (inhibit-point-motion-hooks t)
- (inhibit-modification-hooks t)
- deactivate-mark
- buffer-file-name
- buffer-file-truename)
- ;; Do reset the modification status from within the let, since
- ;; otherwise set-buffer-modified-p may try to unlock the file.
- (with-buffer-unmodified
- ,@body))))
-
-
+ `(let ((inhibit-point-motion-hooks t))
+ (with-silent-modifications
+ ,@body))))
;;; Customization.
diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el
index da8512d7fb..68f564c488 100644
--- a/lisp/jka-cmpr-hook.el
+++ b/lisp/jka-cmpr-hook.el
@@ -6,6 +6,7 @@
;; Author: [email protected] (Jay K. Adams)
;; Maintainer: FSF
;; Keywords: data
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -334,6 +335,7 @@ Return the new status of auto compression (non-nil means on)."
(defmacro with-auto-compression-mode (&rest body)
"Evalute BODY with automatic file compression and uncompression enabled."
+ (declare (indent 0))
(let ((already-installed (make-symbol "already-installed")))
`(let ((,already-installed (jka-compr-installed-p)))
(unwind-protect
@@ -343,8 +345,6 @@ Return the new status of auto compression (non-nil means on)."
,@body)
(unless ,already-installed
(jka-compr-uninstall))))))
-(put 'with-auto-compression-mode 'lisp-indent-function 0)
-
;; This is what we need to know about jka-compr-handler
;; in order to decide when to call it.
diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el
index 2431c9d9e9..e2e4f29dd9 100644
--- a/lisp/language/misc-lang.el
+++ b/lisp/language/misc-lang.el
@@ -40,8 +40,9 @@
IPA is International Phonetic Alphabet for English, French, German
and Italian.")))
-;; This is for Arabic. But, as we still don't have Arabic language
-;; support, we at least define a coding system here.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Arabic
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-coding-system 'iso-8859-6
"ISO-8859-6 based encoding (MIME:ISO-8859-6)."
@@ -58,6 +59,19 @@ and Italian.")))
:mime-charset 'windows-1256)
(define-coding-system-alias 'cp1256 'windows-1256)
+(set-language-info-alist
+ "Arabic" '((charset unicode)
+ (coding-system utf-8 iso-8859-6 windows-1256)
+ (coding-priority utf-8 iso-8859-6 windows-1256)
+ (input-method . "arabic")
+ (sample-text . "Arabic السّلام عليكم")
+ (documentation . "Bidirectional editing is supported.")))
+
+(set-char-table-range
+ composition-function-table
+ '(#x600 . #x6FF)
+ (list ["[\u0600-\u06FF]+" 0 font-shape-gstring]))
+
(provide 'misc-lang)
;; arch-tag: 6953585c-1a1a-4c09-be82-a2518afb6074
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index ec2a7c3b52..f7493109d7 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -10464,7 +10464,6 @@ Turn flymake mode off.
;;;### (autoloads (flyspell-buffer flyspell-region flyspell-mode-off
;;;;;; turn-off-flyspell turn-on-flyspell flyspell-mode flyspell-prog-mode)
-;;;;;; "flyspell" "textmodes/flyspell.el" (19370 36541))
;;; Generated autoloads from textmodes/flyspell.el
(autoload 'flyspell-prog-mode "flyspell" "\
diff --git a/lisp/linum.el b/lisp/linum.el
index 3d70c25477..4ab4b10a7c 100644
--- a/lisp/linum.el
+++ b/lisp/linum.el
@@ -5,6 +5,7 @@
;; Author: Markus Triska <[email protected]>
;; Maintainer: FSF
;; Keywords: convenience
+;; Version: 0.9x
;; This file is part of GNU Emacs.
diff --git a/lisp/loadup.el b/lisp/loadup.el
index d4af1d4617..7757a0e5b4 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -5,6 +5,7 @@
;; Maintainer: FSF
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
index f91c7a808e..4dba41e065 100644
--- a/lisp/ls-lisp.el
+++ b/lisp/ls-lisp.el
@@ -7,6 +7,7 @@
;; Modified by: Francis J. Wright <[email protected]>
;; Maintainer: FSF
;; Keywords: unix, dired
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/macros.el b/lisp/macros.el
index fa45d8c610..cbceb96fad 100644
--- a/lisp/macros.el
+++ b/lisp/macros.el
@@ -5,6 +5,7 @@
;; Maintainer: FSF
;; Keywords: abbrev
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/mail/binhex.el b/lisp/mail/binhex.el
index 4d80d02139..42d2f35bae 100644
--- a/lisp/mail/binhex.el
+++ b/lisp/mail/binhex.el
@@ -328,5 +328,4 @@ If HEADER-ONLY is non-nil only decode header and return filename."
(provide 'binhex)
-;; arch-tag: 8476badd-1e76-4f1d-a640-f9a38c72eed8
;;; binhex.el ends here
diff --git a/lisp/mail/blessmail.el b/lisp/mail/blessmail.el
index 4520ea61d0..545350170e 100644
--- a/lisp/mail/blessmail.el
+++ b/lisp/mail/blessmail.el
@@ -5,6 +5,7 @@
;; Maintainer: FSF
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index 478d7aa075..b3ec3fb485 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -7,6 +7,7 @@
;; Author: K. Shane Hartman
;; Maintainer: FSF
;; Keywords: maint mail
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -74,6 +75,52 @@
(declare-function message-sort-headers "message" ())
(defvar message-strip-special-text-properties)
+(defun report-emacs-bug-can-use-xdg-email ()
+ "Check if xdg-email can be used, i.e. we are on Gnome, KDE or xfce4."
+ (and (getenv "DISPLAY")
+ (executable-find "xdg-email")
+ (or (getenv "GNOME_DESKTOP_SESSION_ID")
+ ;; GNOME_DESKTOP_SESSION_ID is deprecated, check on Dbus also.
+ (condition-case nil
+ (eq 0 (call-process
+ "dbus-send" nil nil nil
+ "--dest=org.gnome.SessionManager"
+ "--print-reply"
+ "/org/gnome/SessionManager"
+ "org.gnome.SessionManager.CanShutdown"))
+ (error nil))
+ (equal (getenv "KDE_FULL_SESSION") "true")
+ (condition-case nil
+ (eq 0 (call-process
+ "/bin/sh" nil nil nil
+ "-c"
+ "xprop -root _DT_SAVE_MODE|grep xfce4"))
+ (error nil)))))
+
+(defun report-emacs-bug-insert-to-mailer ()
+ (interactive)
+ (save-excursion
+ (let* ((to (progn
+ (goto-char (point-min))
+ (forward-line)
+ (and (looking-at "^To: \\(.*\\)")
+ (match-string-no-properties 1))))
+ (subject (progn
+ (forward-line)
+ (and (looking-at "^Subject: \\(.*\\)")
+ (match-string-no-properties 1))))
+ (body (progn
+ (forward-line 2)
+ (if (> (point-max) (point))
+ (buffer-substring-no-properties (point) (point-max))))))
+ (if (and to subject body)
+ (start-process "xdg-email" nil "xdg-email"
+ "--subject" subject
+ "--body" body
+ (concat "mailto:" to))
+ (error "Subject, To or body not found")))))
+
+
;;;###autoload
(defun report-emacs-bug (topic &optional recent-keys)
"Report a bug in GNU Emacs.
@@ -93,6 +140,7 @@ Prompts for bug subject. Leaves you in a mail buffer."
(prompt-properties '(field emacsbug-prompt
intangible but-helpful
rear-nonsticky t))
+ (can-xdg-email (report-emacs-bug-can-use-xdg-email))
user-point message-end-point)
(setq message-end-point
(with-current-buffer (get-buffer-create "*Messages*")
@@ -226,6 +274,9 @@ usually do not have translators to read other languages for them.\n\n")
;; This is so the user has to type something in order to send easily.
(use-local-map (nconc (make-sparse-keymap) (current-local-map)))
(define-key (current-local-map) "\C-c\C-i" 'report-emacs-bug-info)
+ (if can-xdg-email
+ (define-key (current-local-map) "\C-cm"
+ 'report-emacs-bug-insert-to-mailer))
;; Could test major-mode instead.
(cond ((memq mail-user-agent '(message-user-agent gnus-user-agent))
(setq report-emacs-bug-send-command "message-send-and-exit"
@@ -245,6 +296,9 @@ usually do not have translators to read other languages for them.\n\n")
report-emacs-bug-send-command))))
(princ (substitute-command-keys
" Type \\[kill-buffer] RET to cancel (don't send it).\n"))
+ (if can-xdg-email
+ (princ (substitute-command-keys
+ " Type \\[report-emacs-bug-insert-to-mailer] to insert text to you preferred mail program.\n")))
(terpri)
(princ (substitute-command-keys
" Type \\[report-emacs-bug-info] to visit in Info the Emacs Manual section
diff --git a/lisp/mail/hashcash.el b/lisp/mail/hashcash.el
index c7b48cf78e..cc3af11a47 100644
--- a/lisp/mail/hashcash.el
+++ b/lisp/mail/hashcash.el
@@ -276,7 +276,7 @@ BUFFER defaults to the current buffer."
(unless buffer (setq buffer (current-buffer)))
(let (entry)
(while (setq entry (rassq buffer hashcash-process-alist))
- (accept-process-output (car entry)))))
+ (accept-process-output (car entry) 1))))
(defun hashcash-processes-running-p (buffer)
"Return non-nil if hashcash processes in BUFFER are still running."
@@ -375,4 +375,4 @@ Prefix arg sets default accept amount temporarily."
(provide 'hashcash)
-;; arch-tag: 0e7fe983-a124-4392-9788-0dbcbd2c4d62
+;;; hashcash.el ends here
diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el
index 51c490da7a..342d735c93 100644
--- a/lisp/mail/mail-extr.el
+++ b/lisp/mail/mail-extr.el
@@ -6,6 +6,7 @@
;; Author: Joe Wells <[email protected]>
;; Maintainer: FSF
;; Keywords: mail
+;; Package: mail-utils
;; This file is part of GNU Emacs.
diff --git a/lisp/mail/mail-hist.el b/lisp/mail/mail-hist.el
index 6700d6d273..f129f29ea3 100644
--- a/lisp/mail/mail-hist.el
+++ b/lisp/mail/mail-hist.el
@@ -6,6 +6,7 @@
;; Author: Karl Fogel <[email protected]>
;; Created: March, 1994
;; Keywords: mail, history
+;; Package: mail-utils
;; This file is part of GNU Emacs.
diff --git a/lisp/mail/mailheader.el b/lisp/mail/mailheader.el
index 44967b05bc..960d3c6548 100644
--- a/lisp/mail/mailheader.el
+++ b/lisp/mail/mailheader.el
@@ -5,6 +5,7 @@
;; Author: Erik Naggum <[email protected]>
;; Keywords: tools, mail, news
+;; Package: mail-utils
;; This file is part of GNU Emacs.
diff --git a/lisp/mail/rmail-spam-filter.el b/lisp/mail/rmail-spam-filter.el
index a3eee899a6..33f3be30cc 100644
--- a/lisp/mail/rmail-spam-filter.el
+++ b/lisp/mail/rmail-spam-filter.el
@@ -4,6 +4,7 @@
;; Free Software Foundation, Inc.
;; Keywords: email, spam, filter, rmail
;; Author: Eli Tziperman <eli AT deas.harvard.edu>
+;; Package: rmail
;; This file is part of GNU Emacs.
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index fbf5c534a2..07ea7cc0d2 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -191,8 +191,6 @@ please report it with \\[report-emacs-bug].")
:group 'rmail-retrieve
:type '(repeat (directory)))
-(declare-function mail-position-on-field "sendmail" (field &optional soft))
-(declare-function mail-text-start "sendmail" ())
(declare-function rmail-dont-reply-to "mail-utils" (destinations))
(declare-function rmail-update-summary "rmailsum" (&rest ignore))
@@ -1643,8 +1641,6 @@ The duplicate copy goes into the Rmail file just after the original."
(declare-function rmail-summary-mark-deleted "rmailsum" (&optional n undel))
(declare-function rfc822-addresses "rfc822" (header-text))
(declare-function mail-abbrev-make-syntax-table "mailabbrev.el" ())
-(declare-function mail-sendmail-delimit-header "sendmail" ())
-(declare-function mail-header-end "sendmail" ())
;; RLK feature not added in this version:
;; argument specifies inbox file or files in various ways.
@@ -3686,7 +3682,8 @@ see the documentation of `rmail-resend'."
;; The mail buffer is now current.
(save-excursion
;; Insert after header separator--before signature if any.
- (goto-char (mail-text-start))
+ (rfc822-goto-eoh)
+ (forward-line 1)
(if (or rmail-enable-mime rmail-enable-mime-composing)
(funcall rmail-insert-mime-forwarded-message-function
forward-buffer)
@@ -3841,6 +3838,10 @@ The message should be narrowed to just the headers."
(1- (point))
(point-max)))))))
+(declare-function mail-sendmail-delimit-header "sendmail" ())
+(declare-function mail-header-end "sendmail" ())
+(declare-function mail-position-on-field "sendmail" (field &optional soft))
+
(defun rmail-retry-failure ()
"Edit a mail message which is based on the contents of the current message.
For a message rejected by the mail system, extract the interesting headers and
@@ -3932,6 +3933,8 @@ specifying headers which should not be copied into the new message."
(goto-char (point-min))
(if bounce-indent
(indent-rigidly (point-min) (point-max) bounce-indent))
+ ;; FIXME better to replace sendmail functions.
+ (require 'sendmail)
(mail-sendmail-delimit-header)
(save-restriction
(narrow-to-region (point-min) (mail-header-end))
@@ -4236,7 +4239,7 @@ encoded string (and the same mask) will decode the string."
;;; Start of automatically extracted autoloads.
;;;### (autoloads (rmail-edit-current-message) "rmailedit" "rmailedit.el"
-;;;;;; "60db8013bf16d7999914a16cda435287")
+;;;;;; "4bf8a5cdfc921b9e30680ee71b7f9ca6")
;;; Generated autoloads from rmailedit.el
(autoload 'rmail-edit-current-message "rmailedit" "\
@@ -4248,7 +4251,7 @@ Edit the contents of this message.
;;;### (autoloads (rmail-next-labeled-message rmail-previous-labeled-message
;;;;;; rmail-read-label rmail-kill-label rmail-add-label) "rmailkwd"
-;;;;;; "rmailkwd.el" "7027ce1ac922c0dd51262b641e4d42c1")
+;;;;;; "rmailkwd.el" "112240cbb53c402294013cc49987771a")
;;; Generated autoloads from rmailkwd.el
(autoload 'rmail-add-label "rmailkwd" "\
@@ -4291,7 +4294,7 @@ With prefix argument N moves forward N messages with these labels.
;;;***
-;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "4a7502b4aeb3bd5f2111b48cc6512924")
+;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "9f67f3b67de9b700b128b73c52abfefa")
;;; Generated autoloads from rmailmm.el
(autoload 'rmail-mime "rmailmm" "\
@@ -4307,7 +4310,7 @@ attachments as specfied by `rmail-mime-attachment-dirs-alist'.
;;;***
;;;### (autoloads (set-rmail-inbox-list) "rmailmsc" "rmailmsc.el"
-;;;;;; "b2a72d4e370f2d2b31b6f8f0794820e4")
+;;;;;; "c3575020691d5769bcf08ecc932304c3")
;;; Generated autoloads from rmailmsc.el
(autoload 'set-rmail-inbox-list "rmailmsc" "\
@@ -4323,7 +4326,7 @@ This applies only to the current session.
;;;### (autoloads (rmail-sort-by-labels rmail-sort-by-lines rmail-sort-by-correspondent
;;;;;; rmail-sort-by-recipient rmail-sort-by-author rmail-sort-by-subject
-;;;;;; rmail-sort-by-date) "rmailsort" "rmailsort.el" "5a3b5ee477d2fbf79d0c566d776a7fd4")
+;;;;;; rmail-sort-by-date) "rmailsort" "rmailsort.el" "b96e85edd736f23f1e9d54a299268d1e")
;;; Generated autoloads from rmailsort.el
(autoload 'rmail-sort-by-date "rmailsort" "\
@@ -4382,7 +4385,7 @@ If prefix argument REVERSE is non-nil, sorts in reverse order.
;;;### (autoloads (rmail-summary-by-senders rmail-summary-by-topic
;;;;;; rmail-summary-by-regexp rmail-summary-by-recipients rmail-summary-by-labels
-;;;;;; rmail-summary) "rmailsum" "rmailsum.el" "26b95919c7e1f8c5609ce7323aee77ae")
+;;;;;; rmail-summary) "rmailsum" "rmailsum.el" "4715fb58fb191bf6b192458ea75524b2")
;;; Generated autoloads from rmailsum.el
(autoload 'rmail-summary "rmailsum" "\
diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el
index d01773fe6c..02f36fd47e 100644
--- a/lisp/mail/rmailedit.el
+++ b/lisp/mail/rmailedit.el
@@ -5,6 +5,7 @@
;; Maintainer: FSF
;; Keywords: mail
+;; Package: rmail
;; This file is part of GNU Emacs.
diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el
index 5b9b95e5bb..5c44b5cafa 100644
--- a/lisp/mail/rmailkwd.el
+++ b/lisp/mail/rmailkwd.el
@@ -5,6 +5,7 @@
;; Maintainer: FSF
;; Keywords: mail
+;; Package: rmail
;; This file is part of GNU Emacs.
diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el
index e8ca11ee34..3882c9e47c 100644
--- a/lisp/mail/rmailmm.el
+++ b/lisp/mail/rmailmm.el
@@ -6,6 +6,7 @@
;; Alex Schroeder
;; Maintainer: FSF
;; Keywords: mail
+;; Package: rmail
;; This file is part of GNU Emacs.
diff --git a/lisp/mail/rmailmsc.el b/lisp/mail/rmailmsc.el
index fe8a627fe6..bbb8233d89 100644
--- a/lisp/mail/rmailmsc.el
+++ b/lisp/mail/rmailmsc.el
@@ -5,6 +5,7 @@
;; Maintainer: FSF
;; Keywords: mail
+;; Package: rmail
;; This file is part of GNU Emacs.
diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el
index a6ff75e4ef..93d512336d 100644
--- a/lisp/mail/rmailout.el
+++ b/lisp/mail/rmailout.el
@@ -5,6 +5,7 @@
;; Maintainer: FSF
;; Keywords: mail
+;; Package: rmail
;; This file is part of GNU Emacs.
diff --git a/lisp/mail/rmailsort.el b/lisp/mail/rmailsort.el
index f44f36bd5e..f4fd52c10c 100644
--- a/lisp/mail/rmailsort.el
+++ b/lisp/mail/rmailsort.el
@@ -6,6 +6,7 @@
;; Author: Masanobu UMEDA <[email protected]>
;; Maintainer: FSF
;; Keywords: mail
+;; Package: rmail
;; This file is part of GNU Emacs.
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index 80c65cdfb5..0b8abbca6a 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -5,6 +5,7 @@
;; Maintainer: FSF
;; Keywords: mail
+;; Package: rmail
;; This file is part of GNU Emacs.
diff --git a/lisp/mail/uudecode.el b/lisp/mail/uudecode.el
index b1c2a7be41..7ab2fcd1c6 100644
--- a/lisp/mail/uudecode.el
+++ b/lisp/mail/uudecode.el
@@ -236,5 +236,4 @@ If FILE-NAME is non-nil, save the result to FILE-NAME."
(provide 'uudecode)
-;; arch-tag: e1f09ed5-62b4-4677-9f13-4e81c4fe8ce3
;;; uudecode.el ends here
diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in
index 871b690f00..df997b7658 100644
--- a/lisp/makefile.w32-in
+++ b/lisp/makefile.w32-in
@@ -32,10 +32,9 @@ srcdir = $(CURDIR)/..
EMACS = $(THISDIR)/../bin/emacs.exe
-# Command line flags for Emacs. This must include --multibyte,
-# otherwise some files will not compile.
+# Command line flags for Emacs.
-EMACSOPT = -batch --no-init-file --no-site-file --multibyte
+EMACSOPT = -batch --no-init-file --no-site-file
# Extra flags to pass to the byte compiler
BYTE_COMPILE_EXTRA_FLAGS =
diff --git a/lisp/md4.el b/lisp/md4.el
index 32e3f376b1..6b28f757db 100644
--- a/lisp/md4.el
+++ b/lisp/md4.el
@@ -225,5 +225,4 @@ integers (cons high low)."
(provide 'md4)
-;; arch-tag: 99d706fe-089b-42ea-9507-67ae41091e6e
;;; md4.el ends here
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 626472605f..6149fea476 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -6,6 +6,7 @@
;; Author: RMS
;; Maintainer: FSF
;; Keywords: internal, mouse
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -462,7 +463,7 @@
;; Emacs compiled --without-x doesn't have
;; x-selection-exists-p.
(and (fboundp 'x-selection-exists-p)
- (x-selection-exists-p))
+ (x-selection-exists-p 'CLIPBOARD))
kill-ring)
(not buffer-read-only))
:help ,(purecopy "Paste (yank) text most recently cut/copied")))
@@ -968,6 +969,15 @@ mail status in mode line"))
:help ,(purecopy "Turn menu-bar on/off")
:button (:toggle . (> (frame-parameter nil 'menu-bar-lines) 0))))
+(defun menu-bar-set-tool-bar-position (position)
+ (customize-set-variable 'tool-bar-mode t)
+ (dolist (frame (frame-list))
+ (set-frame-parameter frame 'tool-bar-position position))
+ (customize-set-variable 'default-frame-alist
+ (cons (cons 'tool-bar-position position)
+ (assq-delete-all 'tool-bar-position
+ default-frame-alist))))
+
(defun menu-bar-showhide-tool-bar-menu-customize-disable ()
"Do not display tool bars."
(interactive)
@@ -975,24 +985,20 @@ mail status in mode line"))
(defun menu-bar-showhide-tool-bar-menu-customize-enable-left ()
"Display tool bars on the left side."
(interactive)
- (customize-set-variable 'tool-bar-mode t)
- (set-frame-parameter nil 'tool-bar-position 'left))
+ (menu-bar-set-tool-bar-position 'left))
(defun menu-bar-showhide-tool-bar-menu-customize-enable-right ()
"Display tool bars on the right side."
(interactive)
- (customize-set-variable 'tool-bar-mode t)
- (set-frame-parameter nil 'tool-bar-position 'right))
+ (menu-bar-set-tool-bar-position 'right))
(defun menu-bar-showhide-tool-bar-menu-customize-enable-top ()
"Display tool bars on the top side."
(interactive)
- (customize-set-variable 'tool-bar-mode t)
- (set-frame-parameter nil 'tool-bar-position 'top))
+ (menu-bar-set-tool-bar-position 'top))
(defun menu-bar-showhide-tool-bar-menu-customize-enable-bottom ()
"Display tool bars on the bottom side."
(interactive)
- (customize-set-variable 'tool-bar-mode t)
- (set-frame-parameter nil 'tool-bar-position 'bottom))
+ (menu-bar-set-tool-bar-position 'bottom))
(if (featurep 'move-toolbar)
(progn
@@ -1268,6 +1274,9 @@ mail status in mode line"))
(define-key menu-bar-games-menu [life]
`(menu-item ,(purecopy "Life") life
:help ,(purecopy "Watch how John Conway's cellular automaton evolves")))
+(define-key menu-bar-games-menu [land]
+ `(menu-item ,(purecopy "Landmark") landmark
+ :help ,(purecopy "Watch a neural-network robot learn landmarks")))
(define-key menu-bar-games-menu [hanoi]
`(menu-item ,(purecopy "Towers of Hanoi") hanoi
:help ,(purecopy "Watch Towers-of-Hanoi puzzle solved by Emacs")))
@@ -1477,6 +1486,9 @@ mail status in mode line"))
(define-key menu-bar-describe-menu [describe-current-display-table]
`(menu-item ,(purecopy "Describe Display Table") describe-current-display-table
:help ,(purecopy "Describe the current display table")))
+(define-key menu-bar-describe-menu [describe-package]
+ `(menu-item ,(purecopy "Describe Package...") describe-package
+ :help ,(purecopy "Display documentation of a Lisp package")))
(define-key menu-bar-describe-menu [describe-face]
`(menu-item ,(purecopy "Describe Face...") describe-face
:help ,(purecopy "Display the properties of a face")))
@@ -1608,11 +1620,11 @@ key, a click, or a menu-item")))
(define-key menu-bar-help-menu [sep2]
menu-bar-separator)
(define-key menu-bar-help-menu [external-packages]
- `(menu-item ,(purecopy "External Packages") menu-bar-help-extra-packages
+ `(menu-item ,(purecopy "Finding Extra Packages") menu-bar-help-extra-packages
:help ,(purecopy "Lisp packages distributed separately for use in Emacs")))
(define-key menu-bar-help-menu [find-emacs-packages]
- `(menu-item ,(purecopy "Find Emacs Packages") finder-by-keyword
- :help ,(purecopy "Find packages and features by keyword")))
+ `(menu-item ,(purecopy "Search Built-in Packages") finder-by-keyword
+ :help ,(purecopy "Find built-in packages and features by keyword")))
(define-key menu-bar-help-menu [more-manuals]
`(menu-item ,(purecopy "More Manuals") ,menu-bar-manuals-menu))
(define-key menu-bar-help-menu [emacs-manual]
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 3f22099bfd..f7dc035a88 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Stefan Monnier <[email protected]>
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/misc.el b/lisp/misc.el
index 4b2e78a313..6f32a3eb90 100644
--- a/lisp/misc.el
+++ b/lisp/misc.el
@@ -5,6 +5,7 @@
;; Maintainer: FSF
;; Keywords: convenience
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/mouse-sel.el b/lisp/mouse-sel.el
index bd3054a5b9..f3875e24f0 100644
--- a/lisp/mouse-sel.el
+++ b/lisp/mouse-sel.el
@@ -98,7 +98,7 @@
;;
;; Selection/kill-ring interaction is retained
;; interprogram-cut-function = x-select-text
-;; interprogram-paste-function = x-cut-buffer-or-selection-value
+;; interprogram-paste-function = x-selection-value
;;
;; What you lose is the ability to select some text in
;; delete-selection-mode and yank over the top of it.
@@ -299,7 +299,7 @@ where SELECTION-NAME = name of selection
SELECTION-THING-SYMBOL = name of variable where the current selection
type for this selection should be stored.")
-(declare-function x-select-text "term/x-win" (text &optional push))
+(declare-function x-select-text "term/x-win" (text))
(defvar mouse-sel-set-selection-function
(if (eq mouse-sel-default-bindings 'interprogram-cut-paste)
@@ -314,15 +314,15 @@ Called with two arguments:
SELECTION, the name of the selection concerned, and
VALUE, the text to store.
-This sets the selection as well as the cut buffer for the older applications,
-unless `mouse-sel-default-bindings' is `interprogram-cut-paste'.")
+This sets the selection, unless `mouse-sel-default-bindings'
+is `interprogram-cut-paste'.")
-(declare-function x-cut-buffer-or-selection-value "term/x-win" ())
+(declare-function x-selection-value "term/x-win" ())
(defvar mouse-sel-get-selection-function
(lambda (selection)
(if (eq selection 'PRIMARY)
- (or (x-cut-buffer-or-selection-value)
+ (or (x-selection-value)
(bound-and-true-p x-last-selected-text)
(bound-and-true-p x-last-selected-text-primary))
(x-get-selection selection)))
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 3bc3fcefa8..02ce48787e 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -5,6 +5,7 @@
;; Maintainer: FSF
;; Keywords: hardware, mouse
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -42,7 +43,10 @@
:group 'mouse)
(defcustom mouse-drag-copy-region nil
- "If non-nil, mouse drag copies region to kill-ring."
+ "If non-nil, copy to kill-ring upon mouse adjustments of the region.
+
+This affects `mouse-save-then-kill' (\\[mouse-save-then-kill]) in
+addition to mouse drags."
:type 'boolean
:version "24.1"
:group 'mouse)
@@ -954,8 +958,7 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by
'(only)
(cons 'only transient-mark-mode)))
(let ((range (mouse-start-end start-point start-point click-count)))
- (goto-char (nth 0 range))
- (push-mark nil t t)
+ (push-mark (nth 0 range) t t)
(goto-char (nth 1 range)))
;; Track the mouse until we get a non-movement event.
@@ -974,14 +977,8 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by
end-point (posn-point end))
(if (and (eq (posn-window end) start-window)
(integer-or-marker-p end-point))
- ;; If moving in the original window, move point by going
- ;; to start first, so that if end is in intangible text,
- ;; point jumps away from start. Don't do it if
- ;; start=end, or a single click would select a region if
- ;; it's on intangible text.
- (unless (= start-point end-point)
- (goto-char start-point)
- (goto-char end-point))
+ (mouse--drag-set-mark-and-point start-point
+ end-point click-count)
(let ((mouse-row (cdr (cdr (mouse-position)))))
(cond
((null mouse-row))
@@ -999,8 +996,9 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by
(eq (posn-window end) start-window)
(integer-or-marker-p end-point)
(/= start-point end-point))
- (goto-char start-point)
- (goto-char end-point))
+ (mouse--drag-set-mark-and-point start-point
+ end-point click-count))
+
;; Find its binding.
(let* ((fun (key-binding (vector (car event))))
(do-multi-click (and (> (event-click-count event) 0)
@@ -1051,6 +1049,21 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by
(put 'mouse-2 'event-kind 'mouse-click)))
(push event unread-command-events)))))))
+(defun mouse--drag-set-mark-and-point (start click click-count)
+ (let* ((range (mouse-start-end start click click-count))
+ (beg (nth 0 range))
+ (end (nth 1 range)))
+ (cond ((eq (mark) beg)
+ (goto-char end))
+ ((eq (mark) end)
+ (goto-char beg))
+ ((< click (mark))
+ (set-mark end)
+ (goto-char beg))
+ (t
+ (set-mark beg)
+ (goto-char end)))))
+
(defun mouse--remap-link-click-p (start-event end-event)
(or (and (eq mouse-1-click-follows-link 'double)
(= (event-click-count start-event) 2))
@@ -1166,8 +1179,7 @@ If MODE is 2 then do the same for lines."
((= mode 2)
(list (save-excursion
(goto-char start)
- (beginning-of-line 1)
- (point))
+ (line-beginning-position 1))
(save-excursion
(goto-char end)
(forward-line 1)
@@ -1260,15 +1272,23 @@ regardless of where you click."
(interactive "e")
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
+ ;; Without this, confusing things happen upon e.g. inserting into
+ ;; the middle of an active region.
(when select-active-regions
- ;; Without this, confusing things happen upon e.g. inserting into
- ;; the middle of an active region.
- (deactivate-mark))
+ (let (select-active-regions)
+ (deactivate-mark)))
(or mouse-yank-at-point (mouse-set-point click))
- (let ((primary (x-get-selection 'PRIMARY)))
+ (let ((primary
+ (cond
+ ((fboundp 'x-get-selection-value) ; MS-DOS and MS-Windows
+ (or (x-get-selection-value)
+ (x-get-selection 'PRIMARY)))
+ ;; FIXME: What about xterm-mouse-mode etc.?
+ (t
+ (x-get-selection 'PRIMARY)))))
(if primary
(insert primary)
- (error "No primary selection"))))
+ (error "No selection is available"))))
(defun mouse-kill-ring-save (click)
"Copy the region between point and the mouse click in the kill ring.
@@ -1282,8 +1302,7 @@ This does not delete the region; it acts like \\[kill-ring-save]."
;; whenever it was equal to the front of the kill ring, but some
;; people found that confusing.
-;; A list (TEXT START END), describing the text and position of the last
-;; invocation of mouse-save-then-kill.
+;; The position of the last invocation of `mouse-save-then-kill'.
(defvar mouse-save-then-kill-posn nil)
(defun mouse-save-then-kill-delete-region (beg end)
@@ -1321,111 +1340,90 @@ This does not delete the region; it acts like \\[kill-ring-save]."
(undo-boundary))
(defun mouse-save-then-kill (click)
- "Set the region according to CLICK; the second time, kill the region.
-Assuming this command is bound to a mouse button, CLICK is the
-corresponding input event.
-
-If the region is already active, adjust it. Normally, this
-happens by moving either point or mark, whichever is closer, to
-the position of CLICK. But if you have selected words or lines,
-the region is adjusted by moving point or mark to the word or
-line boundary closest to CLICK.
-
-If the region is inactive, activate it temporarily; set mark at
-the original point, and move click to the position of CLICK.
-
-However, if this command is being called a second time (i.e. the
-value of `last-command' is `mouse-save-then-kill'), kill the
-region instead. If the text in the region is the same as the
-text in the front of the kill ring, just delete it."
+ "Set the region according to CLICK; the second time, kill it.
+CLICK should be a mouse click event.
+
+If the region is inactive, activate it temporarily. Set mark at
+the original point, and move point to the position of CLICK.
+
+If the region is already active, adjust it. Normally, do this by
+moving point or mark, whichever is closer, to CLICK. But if you
+have selected whole words or lines, move point or mark to the
+word or line boundary closest to CLICK instead.
+
+If `mouse-drag-copy-region' is non-nil, this command also saves the
+new region to the kill ring (replacing the previous kill if the
+previous region was just saved to the kill ring).
+
+If this command is called a second consecutive time with the same
+CLICK position, kill the region (or delete it
+if `mouse-drag-copy-region' is non-nil)"
(interactive "e")
- (let ((before-scroll
- (with-current-buffer (window-buffer (posn-window (event-start click)))
- point-before-scroll)))
- (mouse-minibuffer-check click)
- (let ((click-posn (posn-point (event-start click)))
- ;; Don't let a subsequent kill command append to this one:
- ;; prevent setting this-command to kill-region.
- (this-command this-command))
- (if (and (with-current-buffer
- (window-buffer (posn-window (event-start click)))
- (and (mark t)
- (> (mod mouse-selection-click-count 3) 0)
- ;; Don't be fooled by a recent click in some other buffer.
- (eq mouse-selection-click-count-buffer
- (current-buffer)))))
- (if (and (eq last-command 'mouse-save-then-kill)
- (equal click-posn (nth 2 mouse-save-then-kill-posn)))
- ;; If we click this button again without moving it, kill.
- (progn
- ;; Call `deactivate-mark' to save the primary selection.
- (deactivate-mark)
- (mouse-save-then-kill-delete-region (mark) (point))
- (setq mouse-selection-click-count 0)
- (setq mouse-save-then-kill-posn nil))
- ;; Find both ends of the object selected by this click.
- (let* ((range
- (mouse-start-end click-posn click-posn
- mouse-selection-click-count)))
- ;; Move whichever end is closer to the click.
- ;; That's what xterm does, and it seems reasonable.
- (if (< (abs (- click-posn (mark t)))
- (abs (- click-posn (point))))
- (set-mark (car range))
- (goto-char (nth 1 range)))
- ;; We have already put the old region in the kill ring.
- ;; Replace it with the extended region.
- ;; (It would be annoying to make a separate entry.)
- (kill-new (buffer-substring (point) (mark t)) t)
- (mouse-set-region-1)
- ;; Arrange for a repeated mouse-3 to kill this region.
- (setq mouse-save-then-kill-posn
- (list (car kill-ring) (point) click-posn))))
-
- (if (and (eq last-command 'mouse-save-then-kill)
- mouse-save-then-kill-posn
- (eq (car mouse-save-then-kill-posn) (car kill-ring))
- (equal (cdr mouse-save-then-kill-posn)
- (list (point) click-posn)))
- ;; If this is the second time we've called
- ;; mouse-save-then-kill, delete the text from the buffer.
- (progn
- ;; Call `deactivate-mark' to save the primary selection.
- (deactivate-mark)
- (mouse-save-then-kill-delete-region (point) (mark t))
- ;; After we kill, another click counts as "the first time".
- (setq mouse-save-then-kill-posn nil))
- ;; This is not a repetition.
- ;; We are adjusting an old selection or creating a new one.
- (if (or (and (eq last-command 'mouse-save-then-kill)
- mouse-save-then-kill-posn)
- (and mark-active transient-mark-mode)
- (and (memq last-command
- '(mouse-drag-region mouse-set-region))
- (or mark-even-if-inactive
- (not transient-mark-mode))))
- ;; We have a selection or suitable region, so adjust it.
- (let* ((posn (event-start click))
- (new (posn-point posn)))
- (select-window (posn-window posn))
- (if (numberp new)
- (progn
- ;; Move whichever end of the region is closer to the click.
- ;; That is what xterm does, and it seems reasonable.
- (if (<= (abs (- new (point))) (abs (- new (mark t))))
- (goto-char new)
- (set-mark new))
- (setq deactivate-mark nil)))
- (kill-new (buffer-substring (point) (mark t)) t))
- ;; Set the mark where point is, then move where clicked.
- (mouse-set-mark-fast click)
- (if before-scroll
- (goto-char before-scroll))
- (exchange-point-and-mark) ;Why??? --Stef
- (kill-new (buffer-substring (point) (mark t))))
- (mouse-set-region-1)
- (setq mouse-save-then-kill-posn
- (list (car kill-ring) (point) click-posn)))))))
+ (mouse-minibuffer-check click)
+ (let* ((posn (event-start click))
+ (click-pt (posn-point posn))
+ (window (posn-window posn))
+ (buf (window-buffer window))
+ ;; Don't let a subsequent kill command append to this one.
+ (this-command this-command)
+ ;; Check if the user has multi-clicked to select words/lines.
+ (click-count
+ (if (and (eq mouse-selection-click-count-buffer buf)
+ (with-current-buffer buf (mark t)))
+ mouse-selection-click-count
+ 0)))
+ (cond
+ ((not (numberp click-pt)) nil)
+ ;; If the user clicked without moving point, kill the region.
+ ;; This also resets `mouse-selection-click-count'.
+ ((and (eq last-command 'mouse-save-then-kill)
+ (eq click-pt mouse-save-then-kill-posn)
+ (eq window (selected-window)))
+ (if mouse-drag-copy-region
+ ;; Region already saved in the previous click;
+ ;; don't make a duplicate entry, just delete.
+ (delete-region (mark t) (point))
+ (kill-region (mark t) (point)))
+ (setq mouse-selection-click-count 0)
+ (setq mouse-save-then-kill-posn nil))
+
+ ;; Otherwise, if there is a suitable region, adjust it by moving
+ ;; one end (whichever is closer) to CLICK-PT.
+ ((or (with-current-buffer buf (region-active-p))
+ (and (eq window (selected-window))
+ (mark t)
+ (or (and (eq last-command 'mouse-save-then-kill)
+ mouse-save-then-kill-posn)
+ (and (memq last-command '(mouse-drag-region
+ mouse-set-region))
+ (or mark-even-if-inactive
+ (not transient-mark-mode))))))
+ (select-window window)
+ (let* ((range (mouse-start-end click-pt click-pt click-count)))
+ (if (< (abs (- click-pt (mark t)))
+ (abs (- click-pt (point))))
+ (set-mark (car range))
+ (goto-char (nth 1 range)))
+ (setq deactivate-mark nil)
+ (mouse-set-region-1)
+ (when mouse-drag-copy-region
+ ;; Region already copied to kill-ring once, so replace.
+ (kill-new (filter-buffer-substring (mark t) (point)) t))
+ ;; Arrange for a repeated mouse-3 to kill the region.
+ (setq mouse-save-then-kill-posn click-pt)))
+
+ ;; Otherwise, set the mark where point is and move to CLICK-PT.
+ (t
+ (select-window window)
+ (mouse-set-mark-fast click)
+ (let ((before-scroll (with-current-buffer buf point-before-scroll)))
+ (if before-scroll (goto-char before-scroll)))
+ (exchange-point-and-mark)
+ (mouse-set-region-1)
+ (when mouse-drag-copy-region
+ (kill-new (filter-buffer-substring (mark t) (point))))
+ (setq mouse-save-then-kill-posn click-pt)))))
+
(global-set-key [M-mouse-1] 'mouse-start-secondary)
(global-set-key [M-drag-mouse-1] 'mouse-set-secondary)
@@ -1505,9 +1503,6 @@ The function returns a non-nil value if it creates a secondary selection."
;; of one word or line.
(let ((range (mouse-start-end start-point start-point click-count)))
(set-marker mouse-secondary-start nil)
- ;; Why the double move? --Stef
- ;; (move-overlay mouse-secondary-overlay 1 1
- ;; (window-buffer start-window))
(move-overlay mouse-secondary-overlay (car range) (nth 1 range)
(window-buffer start-window)))
;; Single-press: cancel any preexisting secondary selection.
@@ -1601,117 +1596,99 @@ is to prevent accidents."
(delete-overlay mouse-secondary-overlay))
(defun mouse-secondary-save-then-kill (click)
- "Save text to point in kill ring; the second time, kill the text.
-You must use this in a buffer where you have recently done \\[mouse-start-secondary].
-If the text between where you did \\[mouse-start-secondary] and where
-you use this command matches the text at the front of the kill ring,
-this command deletes the text.
-Otherwise, it adds the text to the kill ring, like \\[kill-ring-save],
-which prepares for a second click with this command to delete the text.
-
-If you have already made a secondary selection in that buffer,
-this command extends or retracts the selection to where you click.
-If you do this again in a different position, it extends or retracts
-again. If you do this twice in the same position, it kills the selection."
+ "Set the secondary selection and save it to the kill ring.
+The second time, kill it. CLICK should be a mouse click event.
+
+If you have not called `mouse-start-secondary' in the clicked
+buffer, activate the secondary selection and set it between point
+and the click position CLICK.
+
+Otherwise, adjust the bounds of the secondary selection.
+Normally, do this by moving its beginning or end, whichever is
+closer, to CLICK. But if you have selected whole words or lines,
+adjust to the word or line boundary closest to CLICK instead.
+
+If this command is called a second consecutive time with the same
+CLICK position, kill the secondary selection."
(interactive "e")
(mouse-minibuffer-check click)
- (let ((posn (event-start click))
- (click-posn (posn-point (event-start click)))
- ;; Don't let a subsequent kill command append to this one:
- ;; prevent setting this-command to kill-region.
- (this-command this-command))
- (or (eq (window-buffer (posn-window posn))
- (or (overlay-buffer mouse-secondary-overlay)
- (if mouse-secondary-start
- (marker-buffer mouse-secondary-start))))
- (error "Wrong buffer"))
- (with-current-buffer (window-buffer (posn-window posn))
- (if (> (mod mouse-secondary-click-count 3) 0)
- (if (not (and (eq last-command 'mouse-secondary-save-then-kill)
- (equal click-posn
- (car (cdr-safe (cdr-safe mouse-save-then-kill-posn))))))
- ;; Find both ends of the object selected by this click.
- (let* ((range
- (mouse-start-end click-posn click-posn
- mouse-secondary-click-count)))
- ;; Move whichever end is closer to the click.
- ;; That's what xterm does, and it seems reasonable.
- (if (< (abs (- click-posn (overlay-start mouse-secondary-overlay)))
- (abs (- click-posn (overlay-end mouse-secondary-overlay))))
- (move-overlay mouse-secondary-overlay (car range)
- (overlay-end mouse-secondary-overlay))
- (move-overlay mouse-secondary-overlay
- (overlay-start mouse-secondary-overlay)
- (nth 1 range)))
- ;; We have already put the old region in the kill ring.
- ;; Replace it with the extended region.
- ;; (It would be annoying to make a separate entry.)
- (kill-new (buffer-substring
- (overlay-start mouse-secondary-overlay)
- (overlay-end mouse-secondary-overlay)) t)
- ;; Arrange for a repeated mouse-3 to kill this region.
- (setq mouse-save-then-kill-posn
- (list (car kill-ring) (point) click-posn)))
- ;; If we click this button again without moving it,
- ;; that time kill.
- (progn
- (mouse-save-then-kill-delete-region
- (overlay-start mouse-secondary-overlay)
- (overlay-end mouse-secondary-overlay))
- (setq mouse-save-then-kill-posn nil)
- (setq mouse-secondary-click-count 0)
- (delete-overlay mouse-secondary-overlay)))
- (if (and (eq last-command 'mouse-secondary-save-then-kill)
- mouse-save-then-kill-posn
- (eq (car mouse-save-then-kill-posn) (car kill-ring))
- (equal (cdr mouse-save-then-kill-posn) (list (point) click-posn)))
- ;; If this is the second time we've called
- ;; mouse-secondary-save-then-kill, delete the text from the buffer.
- (progn
- (mouse-save-then-kill-delete-region
- (overlay-start mouse-secondary-overlay)
- (overlay-end mouse-secondary-overlay))
- (setq mouse-save-then-kill-posn nil)
- (delete-overlay mouse-secondary-overlay))
- (if (overlay-start mouse-secondary-overlay)
- ;; We have a selection, so adjust it.
- (progn
- (if (numberp click-posn)
- (progn
- ;; Move whichever end of the region is closer to the click.
- ;; That is what xterm does, and it seems reasonable.
- (if (< (abs (- click-posn (overlay-start mouse-secondary-overlay)))
- (abs (- click-posn (overlay-end mouse-secondary-overlay))))
- (move-overlay mouse-secondary-overlay click-posn
- (overlay-end mouse-secondary-overlay))
- (move-overlay mouse-secondary-overlay
- (overlay-start mouse-secondary-overlay)
- click-posn))
- (setq deactivate-mark nil)))
- (if (eq last-command 'mouse-secondary-save-then-kill)
- ;; If the front of the kill ring comes from
- ;; an immediately previous use of this command,
- ;; replace it with the extended region.
- ;; (It would be annoying to make a separate entry.)
- (kill-new (buffer-substring
- (overlay-start mouse-secondary-overlay)
- (overlay-end mouse-secondary-overlay)) t)
- (let (deactivate-mark)
- (copy-region-as-kill (overlay-start mouse-secondary-overlay)
- (overlay-end mouse-secondary-overlay)))))
- (if mouse-secondary-start
- ;; All we have is one end of a selection,
- ;; so put the other end here.
- (let ((start (+ 0 mouse-secondary-start)))
- (kill-ring-save start click-posn)
- (move-overlay mouse-secondary-overlay start click-posn))))
- (setq mouse-save-then-kill-posn
- (list (car kill-ring) (point) click-posn))))
- (if (overlay-buffer mouse-secondary-overlay)
- (x-set-selection 'SECONDARY
- (buffer-substring
- (overlay-start mouse-secondary-overlay)
- (overlay-end mouse-secondary-overlay)))))))
+ (let* ((posn (event-start click))
+ (click-pt (posn-point posn))
+ (window (posn-window posn))
+ (buf (window-buffer window))
+ ;; Don't let a subsequent kill command append to this one.
+ (this-command this-command)
+ ;; Check if the user has multi-clicked to select words/lines.
+ (click-count
+ (if (eq (overlay-buffer mouse-secondary-overlay) buf)
+ mouse-secondary-click-count
+ 0))
+ (beg (overlay-start mouse-secondary-overlay))
+ (end (overlay-end mouse-secondary-overlay)))
+
+ (cond
+ ((not (numberp click-pt)) nil)
+
+ ;; If the secondary selection is not active in BUF, activate it.
+ ((not (eq buf (or (overlay-buffer mouse-secondary-overlay)
+ (if mouse-secondary-start
+ (marker-buffer mouse-secondary-start)))))
+ (select-window window)
+ (setq mouse-secondary-start (make-marker))
+ (move-marker mouse-secondary-start (point))
+ (move-overlay mouse-secondary-overlay (point) click-pt buf)
+ (kill-ring-save (point) click-pt))
+
+ ;; If the user clicked without moving point, delete the secondary
+ ;; selection. This also resets `mouse-secondary-click-count'.
+ ((and (eq last-command 'mouse-secondary-save-then-kill)
+ (eq click-pt mouse-save-then-kill-posn)
+ (eq window (selected-window)))
+ (mouse-save-then-kill-delete-region beg end)
+ (delete-overlay mouse-secondary-overlay)
+ (setq mouse-secondary-click-count 0)
+ (setq mouse-save-then-kill-posn nil))
+
+ ;; Otherwise, if there is a suitable secondary selection overlay,
+ ;; adjust it by moving one end (whichever is closer) to CLICK-PT.
+ ((and beg (eq buf (overlay-buffer mouse-secondary-overlay)))
+ (let* ((range (mouse-start-end click-pt click-pt click-count)))
+ (if (< (abs (- click-pt beg))
+ (abs (- click-pt end)))
+ (move-overlay mouse-secondary-overlay (car range) end)
+ (move-overlay mouse-secondary-overlay beg (nth 1 range))))
+ (setq deactivate-mark nil)
+ (if (eq last-command 'mouse-secondary-save-then-kill)
+ ;; If the front of the kill ring comes from an immediately
+ ;; previous use of this command, replace the entry.
+ (kill-new
+ (buffer-substring (overlay-start mouse-secondary-overlay)
+ (overlay-end mouse-secondary-overlay))
+ t)
+ (let (deactivate-mark)
+ (copy-region-as-kill (overlay-start mouse-secondary-overlay)
+ (overlay-end mouse-secondary-overlay))))
+ (setq mouse-save-then-kill-posn click-pt))
+
+ ;; Otherwise, set the secondary selection overlay.
+ (t
+ (select-window window)
+ (if mouse-secondary-start
+ ;; All we have is one end of a selection, so put the other
+ ;; end here.
+ (let ((start (+ 0 mouse-secondary-start)))
+ (kill-ring-save start click-pt)
+ (move-overlay mouse-secondary-overlay start click-pt)))
+ (setq mouse-save-then-kill-posn click-pt))))
+
+ ;; Finally, set the window system's secondary selection.
+ (let (str)
+ (and (overlay-buffer mouse-secondary-overlay)
+ (setq str (buffer-substring (overlay-start mouse-secondary-overlay)
+ (overlay-end mouse-secondary-overlay)))
+ (> (length str) 0)
+ (x-set-selection 'SECONDARY str))))
+
(defcustom mouse-buffer-menu-maxlen 20
"Number of buffers in one pane (submenu) of the buffer menu.
@@ -1892,332 +1869,6 @@ and selects that window."
;; Few buffers--put them all in one pane.
(list (cons title alist))))
-;; These need to be rewritten for the new scroll bar implementation.
-
-;;!! ;; Commands for the scroll bar.
-;;!!
-;;!! (defun mouse-scroll-down (click)
-;;!! (interactive "@e")
-;;!! (scroll-down (1+ (cdr (mouse-coords click)))))
-;;!!
-;;!! (defun mouse-scroll-up (click)
-;;!! (interactive "@e")
-;;!! (scroll-up (1+ (cdr (mouse-coords click)))))
-;;!!
-;;!! (defun mouse-scroll-down-full ()
-;;!! (interactive "@")
-;;!! (scroll-down nil))
-;;!!
-;;!! (defun mouse-scroll-up-full ()
-;;!! (interactive "@")
-;;!! (scroll-up nil))
-;;!!
-;;!! (defun mouse-scroll-move-cursor (click)
-;;!! (interactive "@e")
-;;!! (move-to-window-line (1+ (cdr (mouse-coords click)))))
-;;!!
-;;!! (defun mouse-scroll-absolute (event)
-;;!! (interactive "@e")
-;;!! (let* ((pos (car event))
-;;!! (position (car pos))
-;;!! (length (car (cdr pos))))
-;;!! (if (<= length 0) (setq length 1))
-;;!! (let* ((scale-factor (max 1 (/ length (/ 8000000 (buffer-size)))))
-;;!! (newpos (* (/ (* (/ (buffer-size) scale-factor)
-;;!! position)
-;;!! length)
-;;!! scale-factor)))
-;;!! (goto-char newpos)
-;;!! (recenter '(4)))))
-;;!!
-;;!! (defun mouse-scroll-left (click)
-;;!! (interactive "@e")
-;;!! (scroll-left (1+ (car (mouse-coords click)))))
-;;!!
-;;!! (defun mouse-scroll-right (click)
-;;!! (interactive "@e")
-;;!! (scroll-right (1+ (car (mouse-coords click)))))
-;;!!
-;;!! (defun mouse-scroll-left-full ()
-;;!! (interactive "@")
-;;!! (scroll-left nil))
-;;!!
-;;!! (defun mouse-scroll-right-full ()
-;;!! (interactive "@")
-;;!! (scroll-right nil))
-;;!!
-;;!! (defun mouse-scroll-move-cursor-horizontally (click)
-;;!! (interactive "@e")
-;;!! (move-to-column (1+ (car (mouse-coords click)))))
-;;!!
-;;!! (defun mouse-scroll-absolute-horizontally (event)
-;;!! (interactive "@e")
-;;!! (let* ((pos (car event))
-;;!! (position (car pos))
-;;!! (length (car (cdr pos))))
-;;!! (set-window-hscroll (selected-window) 33)))
-;;!!
-;;!! (global-set-key [scroll-bar mouse-1] 'mouse-scroll-up)
-;;!! (global-set-key [scroll-bar mouse-2] 'mouse-scroll-absolute)
-;;!! (global-set-key [scroll-bar mouse-3] 'mouse-scroll-down)
-;;!!
-;;!! (global-set-key [vertical-slider mouse-1] 'mouse-scroll-move-cursor)
-;;!! (global-set-key [vertical-slider mouse-2] 'mouse-scroll-move-cursor)
-;;!! (global-set-key [vertical-slider mouse-3] 'mouse-scroll-move-cursor)
-;;!!
-;;!! (global-set-key [thumbup mouse-1] 'mouse-scroll-up-full)
-;;!! (global-set-key [thumbup mouse-2] 'mouse-scroll-up-full)
-;;!! (global-set-key [thumbup mouse-3] 'mouse-scroll-up-full)
-;;!!
-;;!! (global-set-key [thumbdown mouse-1] 'mouse-scroll-down-full)
-;;!! (global-set-key [thumbdown mouse-2] 'mouse-scroll-down-full)
-;;!! (global-set-key [thumbdown mouse-3] 'mouse-scroll-down-full)
-;;!!
-;;!! (global-set-key [horizontal-scroll-bar mouse-1] 'mouse-scroll-left)
-;;!! (global-set-key [horizontal-scroll-bar mouse-2]
-;;!! 'mouse-scroll-absolute-horizontally)
-;;!! (global-set-key [horizontal-scroll-bar mouse-3] 'mouse-scroll-right)
-;;!!
-;;!! (global-set-key [horizontal-slider mouse-1]
-;;!! 'mouse-scroll-move-cursor-horizontally)
-;;!! (global-set-key [horizontal-slider mouse-2]
-;;!! 'mouse-scroll-move-cursor-horizontally)
-;;!! (global-set-key [horizontal-slider mouse-3]
-;;!! 'mouse-scroll-move-cursor-horizontally)
-;;!!
-;;!! (global-set-key [thumbleft mouse-1] 'mouse-scroll-left-full)
-;;!! (global-set-key [thumbleft mouse-2] 'mouse-scroll-left-full)
-;;!! (global-set-key [thumbleft mouse-3] 'mouse-scroll-left-full)
-;;!!
-;;!! (global-set-key [thumbright mouse-1] 'mouse-scroll-right-full)
-;;!! (global-set-key [thumbright mouse-2] 'mouse-scroll-right-full)
-;;!! (global-set-key [thumbright mouse-3] 'mouse-scroll-right-full)
-;;!!
-;;!! (global-set-key [horizontal-scroll-bar S-mouse-2]
-;;!! 'mouse-split-window-horizontally)
-;;!! (global-set-key [mode-line S-mouse-2]
-;;!! 'mouse-split-window-horizontally)
-;;!! (global-set-key [vertical-scroll-bar S-mouse-2]
-;;!! 'mouse-split-window)
-
-;;!! ;;;;
-;;!! ;;;; Here are experimental things being tested. Mouse events
-;;!! ;;;; are of the form:
-;;!! ;;;; ((x y) window screen-part key-sequence timestamp)
-;;!! ;;
-;;!! ;;;;
-;;!! ;;;; Dynamically track mouse coordinates
-;;!! ;;;;
-;;!! ;;
-;;!! ;;(defun track-mouse (event)
-;;!! ;; "Track the coordinates, absolute and relative, of the mouse."
-;;!! ;; (interactive "@e")
-;;!! ;; (while mouse-grabbed
-;;!! ;; (let* ((pos (read-mouse-position (selected-screen)))
-;;!! ;; (abs-x (car pos))
-;;!! ;; (abs-y (cdr pos))
-;;!! ;; (relative-coordinate (coordinates-in-window-p
-;;!! ;; (list (car pos) (cdr pos))
-;;!! ;; (selected-window))))
-;;!! ;; (if (consp relative-coordinate)
-;;!! ;; (message "mouse: [%d %d], (%d %d)" abs-x abs-y
-;;!! ;; (car relative-coordinate)
-;;!! ;; (car (cdr relative-coordinate)))
-;;!! ;; (message "mouse: [%d %d]" abs-x abs-y)))))
-;;!!
-;;!! ;;
-;;!! ;; Dynamically put a box around the line indicated by point
-;;!! ;;
-;;!! ;;
-;;!! ;;(require 'backquote)
-;;!! ;;
-;;!! ;;(defun mouse-select-buffer-line (event)
-;;!! ;; (interactive "@e")
-;;!! ;; (let ((relative-coordinate
-;;!! ;; (coordinates-in-window-p (car event) (selected-window)))
-;;!! ;; (abs-y (car (cdr (car event)))))
-;;!! ;; (if (consp relative-coordinate)
-;;!! ;; (progn
-;;!! ;; (save-excursion
-;;!! ;; (move-to-window-line (car (cdr relative-coordinate)))
-;;!! ;; (x-draw-rectangle
-;;!! ;; (selected-screen)
-;;!! ;; abs-y 0
-;;!! ;; (save-excursion
-;;!! ;; (move-to-window-line (car (cdr relative-coordinate)))
-;;!! ;; (end-of-line)
-;;!! ;; (push-mark nil t)
-;;!! ;; (beginning-of-line)
-;;!! ;; (- (region-end) (region-beginning))) 1))
-;;!! ;; (sit-for 1)
-;;!! ;; (x-erase-rectangle (selected-screen))))))
-;;!! ;;
-;;!! ;;(defvar last-line-drawn nil)
-;;!! ;;(defvar begin-delim "[^ \t]")
-;;!! ;;(defvar end-delim "[^ \t]")
-;;!! ;;
-;;!! ;;(defun mouse-boxing (event)
-;;!! ;; (interactive "@e")
-;;!! ;; (save-excursion
-;;!! ;; (let ((screen (selected-screen)))
-;;!! ;; (while (= (x-mouse-events) 0)
-;;!! ;; (let* ((pos (read-mouse-position screen))
-;;!! ;; (abs-x (car pos))
-;;!! ;; (abs-y (cdr pos))
-;;!! ;; (relative-coordinate
-;;!! ;; (coordinates-in-window-p `(,abs-x ,abs-y)
-;;!! ;; (selected-window)))
-;;!! ;; (begin-reg nil)
-;;!! ;; (end-reg nil)
-;;!! ;; (end-column nil)
-;;!! ;; (begin-column nil))
-;;!! ;; (if (and (consp relative-coordinate)
-;;!! ;; (or (not last-line-drawn)
-;;!! ;; (not (= last-line-drawn abs-y))))
-;;!! ;; (progn
-;;!! ;; (move-to-window-line (car (cdr relative-coordinate)))
-;;!! ;; (if (= (following-char) 10)
-;;!! ;; ()
-;;!! ;; (progn
-;;!! ;; (setq begin-reg (1- (re-search-forward end-delim)))
-;;!! ;; (setq begin-column (1- (current-column)))
-;;!! ;; (end-of-line)
-;;!! ;; (setq end-reg (1+ (re-search-backward begin-delim)))
-;;!! ;; (setq end-column (1+ (current-column)))
-;;!! ;; (message "%s" (buffer-substring begin-reg end-reg))
-;;!! ;; (x-draw-rectangle screen
-;;!! ;; (setq last-line-drawn abs-y)
-;;!! ;; begin-column
-;;!! ;; (- end-column begin-column) 1))))))))))
-;;!! ;;
-;;!! ;;(defun mouse-erase-box ()
-;;!! ;; (interactive)
-;;!! ;; (if last-line-drawn
-;;!! ;; (progn
-;;!! ;; (x-erase-rectangle (selected-screen))
-;;!! ;; (setq last-line-drawn nil))))
-;;!!
-;;!! ;;; (defun test-x-rectangle ()
-;;!! ;;; (use-local-mouse-map (setq rectangle-test-map (make-sparse-keymap)))
-;;!! ;;; (define-key rectangle-test-map mouse-motion-button-left 'mouse-boxing)
-;;!! ;;; (define-key rectangle-test-map mouse-button-left-up 'mouse-erase-box))
-;;!!
-;;!! ;;
-;;!! ;; Here is how to do double clicking in lisp. About to change.
-;;!! ;;
-;;!!
-;;!! (defvar double-start nil)
-;;!! (defconst double-click-interval 300
-;;!! "Max ticks between clicks")
-;;!!
-;;!! (defun double-down (event)
-;;!! (interactive "@e")
-;;!! (if double-start
-;;!! (let ((interval (- (nth 4 event) double-start)))
-;;!! (if (< interval double-click-interval)
-;;!! (progn
-;;!! (backward-up-list 1)
-;;!! ;; (message "Interval %d" interval)
-;;!! (sleep-for 1)))
-;;!! (setq double-start nil))
-;;!! (setq double-start (nth 4 event))))
-;;!!
-;;!! (defun double-up (event)
-;;!! (interactive "@e")
-;;!! (and double-start
-;;!! (> (- (nth 4 event ) double-start) double-click-interval)
-;;!! (setq double-start nil)))
-;;!!
-;;!! ;;; (defun x-test-doubleclick ()
-;;!! ;;; (use-local-mouse-map (setq doubleclick-test-map (make-sparse-keymap)))
-;;!! ;;; (define-key doubleclick-test-map mouse-button-left 'double-down)
-;;!! ;;; (define-key doubleclick-test-map mouse-button-left-up 'double-up))
-;;!!
-;;!! ;;
-;;!! ;; This scrolls while button is depressed. Use preferable in scroll bar.
-;;!! ;;
-;;!!
-;;!! (defvar scrolled-lines 0)
-;;!! (defconst scroll-speed 1)
-;;!!
-;;!! (defun incr-scroll-down (event)
-;;!! (interactive "@e")
-;;!! (setq scrolled-lines 0)
-;;!! (incremental-scroll scroll-speed))
-;;!!
-;;!! (defun incr-scroll-up (event)
-;;!! (interactive "@e")
-;;!! (setq scrolled-lines 0)
-;;!! (incremental-scroll (- scroll-speed)))
-;;!!
-;;!! (defun incremental-scroll (n)
-;;!! (while (= (x-mouse-events) 0)
-;;!! (setq scrolled-lines (1+ (* scroll-speed scrolled-lines)))
-;;!! (scroll-down n)
-;;!! (sit-for 300 t)))
-;;!!
-;;!! (defun incr-scroll-stop (event)
-;;!! (interactive "@e")
-;;!! (message "Scrolled %d lines" scrolled-lines)
-;;!! (setq scrolled-lines 0)
-;;!! (sleep-for 1))
-;;!!
-;;!! ;;; (defun x-testing-scroll ()
-;;!! ;;; (let ((scrolling-map (function mouse-vertical-scroll-bar-prefix)))
-;;!! ;;; (define-key scrolling-map mouse-button-left 'incr-scroll-down)
-;;!! ;;; (define-key scrolling-map mouse-button-right 'incr-scroll-up)
-;;!! ;;; (define-key scrolling-map mouse-button-left-up 'incr-scroll-stop)
-;;!! ;;; (define-key scrolling-map mouse-button-right-up 'incr-scroll-stop)))
-;;!!
-;;!! ;;
-;;!! ;; Some playthings suitable for picture mode? They need work.
-;;!! ;;
-;;!!
-;;!! (defun mouse-kill-rectangle (event)
-;;!! "Kill the rectangle between point and the mouse cursor."
-;;!! (interactive "@e")
-;;!! (let ((point-save (point)))
-;;!! (save-excursion
-;;!! (mouse-set-point event)
-;;!! (push-mark nil t)
-;;!! (if (> point-save (point))
-;;!! (kill-rectangle (point) point-save)
-;;!! (kill-rectangle point-save (point))))))
-;;!!
-;;!! (defun mouse-open-rectangle (event)
-;;!! "Kill the rectangle between point and the mouse cursor."
-;;!! (interactive "@e")
-;;!! (let ((point-save (point)))
-;;!! (save-excursion
-;;!! (mouse-set-point event)
-;;!! (push-mark nil t)
-;;!! (if (> point-save (point))
-;;!! (open-rectangle (point) point-save)
-;;!! (open-rectangle point-save (point))))))
-;;!!
-;;!! ;; Must be a better way to do this.
-;;!!
-;;!! (defun mouse-multiple-insert (n char)
-;;!! (while (> n 0)
-;;!! (insert char)
-;;!! (setq n (1- n))))
-;;!!
-;;!! ;; What this could do is not finalize until button was released.
-;;!!
-;;!! (defun mouse-move-text (event)
-;;!! "Move text from point to cursor position, inserting spaces."
-;;!! (interactive "@e")
-;;!! (let* ((relative-coordinate
-;;!! (coordinates-in-window-p (car event) (selected-window))))
-;;!! (if (consp relative-coordinate)
-;;!! (cond ((> (current-column) (car relative-coordinate))
-;;!! (delete-char
-;;!! (- (car relative-coordinate) (current-column))))
-;;!! ((< (current-column) (car relative-coordinate))
-;;!! (mouse-multiple-insert
-;;!! (- (car relative-coordinate) (current-column)) " "))
-;;!! ((= (current-column) (car relative-coordinate)) (ding))))))
-
(define-obsolete-function-alias
'mouse-choose-completion 'choose-completion "23.2")
@@ -2460,10 +2111,6 @@ choose a font."
(mouse-menu-bar-map)
(mouse-menu-major-mode-map)))))
-
-;; Replaced with dragging mouse-1
-;; (global-set-key [S-mouse-1] 'mouse-set-mark)
-
;; Binding mouse-1 to mouse-select-window when on mode-, header-, or
;; vertical-line prevents Emacs from signaling an error when the mouse
;; button is released after dragging these lines, on non-toolkit
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index 743204cbe4..2fc84c0624 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -4,6 +4,7 @@
;; 2008, 2009, 2010 Free Software Foundation, Inc.
;; Maintainer: William M. Perry <[email protected]>
;; Keywords: mouse
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 420381cf43..fb9b57b724 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -892,6 +892,7 @@ The order attempted is gnome-moz-remote, Mozilla, Firefox,
Galeon, Konqueror, Netscape, Mosaic, Lynx in an xterm, and then W3."
(apply
(cond
+ ((browse-url-can-use-xdg-open) 'browse-url-xdg-open)
((executable-find browse-url-gnome-moz-program) 'browse-url-gnome-moz)
((executable-find browse-url-mozilla-program) 'browse-url-mozilla)
((executable-find browse-url-firefox-program) 'browse-url-firefox)
@@ -905,6 +906,41 @@ Galeon, Konqueror, Netscape, Mosaic, Lynx in an xterm, and then W3."
(lambda (&rest ignore) (error "No usable browser found"))))
url args))
+(defun browse-url-can-use-xdg-open ()
+ "Check if xdg-open can be used, i.e. we are on Gnome, KDE or xfce4."
+ (and (getenv "DISPLAY")
+ (executable-find "xdg-open")
+ ;; xdg-open may call gnome-open and that does not wait for its child
+ ;; to finish. This child may then be killed when the parent dies.
+ ;; Use nohup to work around.
+ (executable-find "nohup")
+ (or (getenv "GNOME_DESKTOP_SESSION_ID")
+ ;; GNOME_DESKTOP_SESSION_ID is deprecated, check on Dbus also.
+ (condition-case nil
+ (eq 0 (call-process
+ "dbus-send" nil nil nil
+ "--dest=org.gnome.SessionManager"
+ "--print-reply"
+ "/org/gnome/SessionManager"
+ "org.gnome.SessionManager.CanShutdown"))
+ (error nil))
+ (equal (getenv "KDE_FULL_SESSION") "true")
+ (condition-case nil
+ (eq 0 (call-process
+ "/bin/sh" nil nil nil
+ "-c"
+ "xprop -root _DT_SAVE_MODE|grep xfce4"))
+ (error nil)))))
+
+
+;;;###autoload
+(defun browse-url-xdg-open (url &optional new-window)
+ (interactive (browse-url-interactive-arg "URL: "))
+ (call-process "/bin/sh" nil nil nil
+ "-c"
+ (concat "nohup xdg-open " url
+ ">/dev/null 2>&1 </dev/null")))
+
;;;###autoload
(defun browse-url-netscape (url &optional new-window)
"Ask the Netscape WWW browser to load URL.
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 870bd2e313..8d9512d6f9 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -92,12 +92,10 @@
(defmacro dbus-ignore-errors (&rest body)
"Execute BODY; signal D-Bus error when `dbus-debug' is non-nil.
Otherwise, return result of last form in BODY, or all other errors."
+ (declare (indent 0) (debug t))
`(condition-case err
(progn ,@body)
(dbus-error (when dbus-debug (signal (car err) (cdr err))))))
-
-(put 'dbus-ignore-errors 'lisp-indent-function 0)
-(put 'dbus-ignore-errors 'edebug-form-spec '(form body))
(font-lock-add-keywords 'emacs-lisp-mode '("\\<dbus-ignore-errors\\>"))
(defvar dbus-event-error-hooks nil
@@ -108,15 +106,12 @@ catched in `condition-case' by `dbus-error'.")
;;; Hash table of registered functions.
-;; We create it here. So we have a simple test in dbusbind.c, whether
-;; the Lisp code has been loaded.
-(setq dbus-registered-objects-table (make-hash-table :test 'equal))
-
(defvar dbus-return-values-table (make-hash-table :test 'equal)
"Hash table for temporary storing arguments of reply messages.
-A key in this hash table is a list (BUS SERIAL). BUS is either the
-symbol `:system' or the symbol `:session'. SERIAL is the serial number
-of the reply message. See `dbus-call-method-non-blocking-handler' and
+A key in this hash table is a list (BUS SERIAL). BUS is either a
+Lisp symbol, `:system' or `:session', or a string denoting the
+bus address. SERIAL is the serial number of the reply message.
+See `dbus-call-method-non-blocking-handler' and
`dbus-call-method-non-blocking'.")
(defun dbus-list-hash-table ()
@@ -187,8 +182,8 @@ association to the service from D-Bus."
(defun dbus-unregister-service (bus service)
"Unregister all objects related to SERVICE from D-Bus BUS.
-BUS must be either the symbol `:system' or the symbol `:session'.
-SERVICE must be a known service name."
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address. SERVICE must be a known service name."
(maphash
(lambda (key value)
(dolist (elt value)
@@ -353,15 +348,15 @@ EVENT is a list which starts with symbol `dbus-event':
(dbus-event BUS TYPE SERIAL SERVICE PATH INTERFACE MEMBER HANDLER &rest ARGS)
BUS identifies the D-Bus the message is coming from. It is
-either the symbol `:system' or the symbol `:session'. TYPE is
-the D-Bus message type which has caused the event, SERIAL is the
-serial number of the received D-Bus message. SERVICE and PATH
-are the unique name and the object path of the D-Bus object
-emitting the message. INTERFACE and MEMBER denote the message
-which has been sent. HANDLER is the function which has been
-registered for this message. ARGS are the arguments passed to
-HANDLER, when it is called during event handling in
-`dbus-handle-event'.
+either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address. TYPE is the D-Bus message type which
+has caused the event, SERIAL is the serial number of the received
+D-Bus message. SERVICE and PATH are the unique name and the
+object path of the D-Bus object emitting the message. INTERFACE
+and MEMBER denote the message which has been sent. HANDLER is
+the function which has been registered for this message. ARGS
+are the arguments passed to HANDLER, when it is called during
+event handling in `dbus-handle-event'.
This function raises a `dbus-error' signal in case the event is
not well formed."
@@ -369,7 +364,8 @@ not well formed."
(unless (and (listp event)
(eq (car event) 'dbus-event)
;; Bus symbol.
- (symbolp (nth 1 event))
+ (or (symbolp (nth 1 event))
+ (stringp (nth 1 event)))
;; Type.
(and (natnump (nth 2 event))
(< dbus-message-type-invalid (nth 2 event)))
@@ -434,9 +430,10 @@ If the HANDLER returns a `dbus-error', it is propagated as return message."
(defun dbus-event-bus-name (event)
"Return the bus name the event is coming from.
-The result is either the symbol `:system' or the symbol `:session'.
-EVENT is a D-Bus event, see `dbus-check-event'. This function
-raises a `dbus-error' signal in case the event is not well formed."
+The result is either a Lisp symbol, `:system' or `:session', or a
+string denoting the bus address. EVENT is a D-Bus event, see
+`dbus-check-event'. This function raises a `dbus-error' signal
+in case the event is not well formed."
(dbus-check-event event)
(nth 1 event))
@@ -566,10 +563,11 @@ apply
"Return all interfaces and sub-nodes of SERVICE,
registered at object path PATH at bus BUS.
-BUS must be either the symbol `:system' or the symbol `:session'.
-SERVICE must be a known service name, and PATH must be a valid
-object path. The last two parameters are strings. The result,
-the introspection data, is a string in XML format."
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address. SERVICE must be a known service name,
+and PATH must be a valid object path. The last two parameters
+are strings. The result, the introspection data, is a string in
+XML format."
;; We don't want to raise errors. `dbus-call-method-non-blocking'
;; is used, because the handler can be registered in our Emacs
;; instance; caller an callee would block each other.
@@ -873,7 +871,8 @@ name of the property, and its value. If there are no properties,
(bus service path interface property access value &optional emits-signal)
"Register property PROPERTY on the D-Bus BUS.
-BUS is either the symbol `:system' or the symbol `:session'.
+BUS is either a Lisp symbol, `:system' or `:session', or a string
+denoting the bus address.
SERVICE is the D-Bus service name of the D-Bus. It must be a
known name.
diff --git a/lisp/net/dig.el b/lisp/net/dig.el
index add3c2f7a0..9392c73855 100644
--- a/lisp/net/dig.el
+++ b/lisp/net/dig.el
@@ -184,5 +184,4 @@ Returns nil for domain/class/type queries that result in no data."
(provide 'dig)
-;; arch-tag: 1d61726e-9400-4013-9ae7-4035e0c7f7d6
;;; dig.el ends here
diff --git a/lisp/net/dns.el b/lisp/net/dns.el
index d371737192..2d4c2d8cd8 100644
--- a/lisp/net/dns.el
+++ b/lisp/net/dns.el
@@ -151,7 +151,7 @@ If TCP-P, the first two bytes of the package with be the length field."
(lsh (if (dns-get 'truncated-p spec) 1 0) -1)
(lsh (if (dns-get 'recursion-desired-p spec) 1 0) 0)))
(dns-write-bytes
- (cond
+ (cond
((eq (dns-get 'response-code spec) 'no-error) 0)
((eq (dns-get 'response-code spec) 'format-error) 1)
((eq (dns-get 'response-code spec) 'server-failure) 2)
@@ -438,5 +438,4 @@ If REVERSEP, look up an IP address."
(provide 'dns)
-;; arch-tag: d0edd0c4-4cce-4538-ae92-06c3356ee80a
;;; dns.el ends here
diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el
index fe41d70a09..962020f2b3 100644
--- a/lisp/net/eudc-bob.el
+++ b/lisp/net/eudc-bob.el
@@ -6,6 +6,7 @@
;; Author: Oscar Figueiredo <[email protected]>
;; Maintainer: Pavel Jan�k <[email protected]>
;; Keywords: comm
+;; Package: eudc
;; This file is part of GNU Emacs.
diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el
index 7aa30cfcb6..91abac571b 100644
--- a/lisp/net/eudc-export.el
+++ b/lisp/net/eudc-export.el
@@ -6,6 +6,7 @@
;; Author: Oscar Figueiredo <[email protected]>
;; Maintainer: Pavel Jan�k <[email protected]>
;; Keywords: comm
+;; Package: eudc
;; This file is part of GNU Emacs.
diff --git a/lisp/net/eudc-hotlist.el b/lisp/net/eudc-hotlist.el
index 5f165ad2e2..7798fa43d9 100644
--- a/lisp/net/eudc-hotlist.el
+++ b/lisp/net/eudc-hotlist.el
@@ -6,6 +6,7 @@
;; Author: Oscar Figueiredo <[email protected]>
;; Maintainer: Pavel Jan�k <[email protected]>
;; Keywords: comm
+;; Package: eudc
;; This file is part of GNU Emacs.
diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el
index 5f8de5ec75..3f82816fab 100644
--- a/lisp/net/eudc-vars.el
+++ b/lisp/net/eudc-vars.el
@@ -6,6 +6,7 @@
;; Author: Oscar Figueiredo <[email protected]>
;; Maintainer: Pavel Jan�k <[email protected]>
;; Keywords: comm
+;; Package: eudc
;; This file is part of GNU Emacs.
diff --git a/lisp/net/eudcb-bbdb.el b/lisp/net/eudcb-bbdb.el
index 0ddfa81a50..aa4315077e 100644
--- a/lisp/net/eudcb-bbdb.el
+++ b/lisp/net/eudcb-bbdb.el
@@ -6,6 +6,7 @@
;; Author: Oscar Figueiredo <[email protected]>
;; Maintainer: Pavel Jan�k <[email protected]>
;; Keywords: comm
+;; Package: eudc
;; This file is part of GNU Emacs.
diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el
index fc90be96b5..e2ca2acadd 100644
--- a/lisp/net/eudcb-ldap.el
+++ b/lisp/net/eudcb-ldap.el
@@ -6,6 +6,7 @@
;; Author: Oscar Figueiredo <[email protected]>
;; Maintainer: Pavel Jan�k <[email protected]>
;; Keywords: comm
+;; Package: eudc
;; This file is part of GNU Emacs.
diff --git a/lisp/net/eudcb-mab.el b/lisp/net/eudcb-mab.el
index 8705be81b0..d848b9953a 100644
--- a/lisp/net/eudcb-mab.el
+++ b/lisp/net/eudcb-mab.el
@@ -6,6 +6,7 @@
;; Author: John Wiegley <[email protected]>
;; Maintainer: FSF
;; Keywords: comm
+;; Package: eudc
;; This file is part of GNU Emacs.
diff --git a/lisp/net/eudcb-ph.el b/lisp/net/eudcb-ph.el
index bd2e75ced0..c0e4f81d31 100644
--- a/lisp/net/eudcb-ph.el
+++ b/lisp/net/eudcb-ph.el
@@ -6,6 +6,7 @@
;; Author: Oscar Figueiredo <[email protected]>
;; Maintainer: Pavel Jan�k <[email protected]>
;; Keywords: comm
+;; Package: eudc
;; This file is part of GNU Emacs.
diff --git a/lisp/net/hmac-def.el b/lisp/net/hmac-def.el
index 5f57ea617b..c16fffc8de 100644
--- a/lisp/net/hmac-def.el
+++ b/lisp/net/hmac-def.el
@@ -80,5 +80,4 @@ If BIT is non-nil, truncate output to specified bits."
(provide 'hmac-def)
-;; arch-tag: 645adcef-b835-4900-a10a-11f636c982b9
;;; hmac-def.el ends here
diff --git a/lisp/net/hmac-md5.el b/lisp/net/hmac-md5.el
index 045a12520a..a0bfd36ea6 100644
--- a/lisp/net/hmac-md5.el
+++ b/lisp/net/hmac-md5.el
@@ -79,5 +79,4 @@
(provide 'hmac-md5)
-;; arch-tag: 0ab3f4f6-3d4b-4167-a9fa-635b7fed7f27
;;; hmac-md5.el ends here
diff --git a/lisp/net/imap.el b/lisp/net/imap.el
index f9c89cd816..e286a14a0e 100644
--- a/lisp/net/imap.el
+++ b/lisp/net/imap.el
@@ -267,7 +267,7 @@ See also `imap-log'."
:type 'string)
(defcustom imap-read-timeout (if (string-match
- "windows-nt\\|os/2\\|emx\\|cygwin"
+ "windows-nt\\|os/2\\|cygwin"
(symbol-name system-type))
1.0
0.1)
@@ -448,18 +448,6 @@ The actual value is really the text on the continuation line.")
The function should take two arguments, the first the IMAP tag and the
second the status (OK, NO, BAD etc) of the command.")
-(defvar imap-enable-exchange-bug-workaround nil
- "Send FETCH UID commands as *:* instead of *.
-
-When non-nil, use an alternative UIDS form. Enabling appears to
-be required for some servers (e.g., Microsoft Exchange 2007)
-which otherwise would trigger a response 'BAD The specified
-message set is invalid.'. We don't unconditionally use this
-form, since this is said to be significantly inefficient.
-
-This variable is set to t automatically per server if the
-canonical form fails.")
-
;; Utility functions:
@@ -515,6 +503,16 @@ sure of changing the value of `foo'."
;; Server functions; stream stuff:
+(defun imap-log (string-or-buffer)
+ (when imap-log
+ (with-current-buffer (get-buffer-create imap-log-buffer)
+ (imap-disable-multibyte)
+ (buffer-disable-undo)
+ (goto-char (point-max))
+ (if (bufferp string-or-buffer)
+ (insert-buffer-substring string-or-buffer)
+ (insert string-or-buffer)))))
+
(defun imap-kerberos4-stream-p (buffer)
(imap-capability 'AUTH=KERBEROS_V4 buffer))
@@ -569,12 +567,6 @@ sure of changing the value of `foo'."
(setq response (match-string 1)))))
(accept-process-output process 1)
(sit-for 1))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log-buffer)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring buffer)))
(erase-buffer)
(message "Opening Kerberos 4 IMAP connection with `%s'...%s" cmd
(if response (concat "done, " response) "failed"))
@@ -645,12 +637,7 @@ sure of changing the value of `foo'."
(setq response (match-string 1)))))
(accept-process-output process 1)
(sit-for 1))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log-buffer)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring buffer)))
+ (imap-log buffer)
(erase-buffer)
(message "GSSAPI IMAP connection: %s" (or response "failed"))
(if (and response (let ((case-fold-search nil))
@@ -701,12 +688,7 @@ sure of changing the value of `foo'."
(not (imap-parse-greeting)))
(accept-process-output process 1)
(sit-for 1))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log-buffer)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring buffer)))
+ (imap-log buffer)
(erase-buffer)
(when (memq (process-status process) '(open run))
(setq done process))))))
@@ -740,12 +722,7 @@ sure of changing the value of `foo'."
(not (imap-parse-greeting)))
(accept-process-output process 1)
(sit-for 1))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log-buffer)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring buffer)))
+ (imap-log buffer)
(when (memq (process-status process) '(open run))
process))))
@@ -764,12 +741,7 @@ sure of changing the value of `foo'."
(not (imap-parse-greeting)))
(accept-process-output process 1)
(sit-for 1))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log-buffer)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring buffer)))
+ (imap-log buffer)
(when (memq (process-status process) '(open run))
process))))
@@ -803,12 +775,7 @@ sure of changing the value of `foo'."
(not (imap-parse-greeting)))
(accept-process-output process 1)
(sit-for 1))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log-buffer)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring buffer)))
+ (imap-log buffer)
(erase-buffer)
(when (memq (process-status process) '(open run))
(setq done process)))))
@@ -845,11 +812,7 @@ sure of changing the value of `foo'."
(not (re-search-forward "[0-9]+ OK.*\r?\n" nil t)))
(accept-process-output process 1)
(sit-for 1))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log-buffer)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring buffer)))
+ (imap-log buffer)
(when (and (setq tls-info (starttls-negotiate process))
(memq (process-status process) '(open run)))
(setq done process)))
@@ -1227,7 +1190,7 @@ password is remembered in the buffer."
(when user (setq imap-username user))
(when passwd (setq imap-password passwd))
(if imap-auth
- (and (setq imap-last-authenticator
+ (and (setq imap-last-authenticator
(assq imap-auth imap-authenticator-alist))
(funcall (nth 2 imap-last-authenticator) (current-buffer))
(setq imap-state 'auth))
@@ -1340,40 +1303,38 @@ If BUFFER is nil, the current buffer is assumed."
;; Mailbox functions:
-(defun imap-mailbox-put (propname value &optional mailbox buffer)
- (with-current-buffer (or buffer (current-buffer))
- (if imap-mailbox-data
- (put (intern (or mailbox imap-current-mailbox) imap-mailbox-data)
- propname value)
- (error "Imap-mailbox-data is nil, prop %s value %s mailbox %s buffer %s"
- propname value mailbox (current-buffer)))
- t))
+(defun imap-mailbox-put (propname value &optional mailbox)
+ (if imap-mailbox-data
+ (put (intern (or mailbox imap-current-mailbox) imap-mailbox-data)
+ propname value)
+ (error "Imap-mailbox-data is nil, prop %s value %s mailbox %s buffer %s"
+ propname value mailbox (current-buffer)))
+ t)
(defsubst imap-mailbox-get-1 (propname &optional mailbox)
(get (intern-soft (or mailbox imap-current-mailbox) imap-mailbox-data)
propname))
(defun imap-mailbox-get (propname &optional mailbox buffer)
- (let ((mailbox (imap-utf7-encode mailbox)))
- (with-current-buffer (or buffer (current-buffer))
- (imap-mailbox-get-1 propname (or mailbox imap-current-mailbox)))))
-
-(defun imap-mailbox-map-1 (func &optional mailbox-decoder buffer)
(with-current-buffer (or buffer (current-buffer))
- (let (result)
- (mapatoms
- (lambda (s)
- (push (funcall func (if mailbox-decoder
- (funcall mailbox-decoder (symbol-name s))
- (symbol-name s))) result))
- imap-mailbox-data)
- result)))
-
-(defun imap-mailbox-map (func &optional buffer)
+ (imap-mailbox-get-1 propname (or (imap-utf7-encode mailbox)
+ imap-current-mailbox))))
+
+(defun imap-mailbox-map-1 (func &optional mailbox-decoder)
+ (let (result)
+ (mapatoms
+ (lambda (s)
+ (push (funcall func (if mailbox-decoder
+ (funcall mailbox-decoder (symbol-name s))
+ (symbol-name s))) result))
+ imap-mailbox-data)
+ result))
+
+(defun imap-mailbox-map (func)
"Map a function across each mailbox in `imap-mailbox-data', returning a list.
Function should take a mailbox name (a string) as
the only argument."
- (imap-mailbox-map-1 func 'imap-utf7-decode buffer))
+ (imap-mailbox-map-1 func 'imap-utf7-decode))
(defun imap-current-mailbox (&optional buffer)
(with-current-buffer (or buffer (current-buffer))
@@ -1687,29 +1648,26 @@ is non-nil return these properties."
uids)
(imap-message-get uids receive))))))
-(defun imap-message-put (uid propname value &optional buffer)
- (with-current-buffer (or buffer (current-buffer))
- (if imap-message-data
- (put (intern (number-to-string uid) imap-message-data)
- propname value)
- (error "Imap-message-data is nil, uid %s prop %s value %s buffer %s"
- uid propname value (current-buffer)))
- t))
+(defun imap-message-put (uid propname value)
+ (if imap-message-data
+ (put (intern (number-to-string uid) imap-message-data)
+ propname value)
+ (error "Imap-message-data is nil, uid %s prop %s value %s buffer %s"
+ uid propname value (current-buffer)))
+ t)
-(defun imap-message-get (uid propname &optional buffer)
- (with-current-buffer (or buffer (current-buffer))
- (get (intern-soft (number-to-string uid) imap-message-data)
- propname)))
+(defun imap-message-get (uid propname)
+ (get (intern-soft (number-to-string uid) imap-message-data)
+ propname))
-(defun imap-message-map (func propname &optional buffer)
+(defun imap-message-map (func propname)
"Map a function across each message in `imap-message-data', returning a list."
- (with-current-buffer (or buffer (current-buffer))
- (let (result)
- (mapatoms
- (lambda (s)
- (push (funcall func (get s 'UID) (get s propname)) result))
- imap-message-data)
- result)))
+ (let (result)
+ (mapatoms
+ (lambda (s)
+ (push (funcall func (get s 'UID) (get s propname)) result))
+ imap-message-data)
+ result))
(defmacro imap-message-envelope-date (uid &optional buffer)
`(with-current-buffer (or ,buffer (current-buffer))
@@ -1805,48 +1763,6 @@ is non-nil return these properties."
(format "String %s cannot be converted to a Lisp integer" number))
number)))
-(defun imap-fetch-safe (uids props &optional receive nouidfetch buffer)
- "Like `imap-fetch', but DTRT with Exchange 2007 bug.
-However, UIDS here is a cons, where the car is the canonical form
-of the UIDS specification, and the cdr is the one which works with
-Exchange 2007 or, potentially, other buggy servers.
-See `imap-enable-exchange-bug-workaround'."
- ;; The first time we get here for a given, we'll try the canonical
- ;; form. If we get the known error from the buggy server, set the
- ;; flag buffer-locally (to account for connections to multiple
- ;; servers), then re-try with the alternative UIDS spec. We don't
- ;; unconditionally use the alternative form, since the
- ;; currently-used alternatives are seriously inefficient with some
- ;; servers (although they are valid).
- ;;
- ;; FIXME: Maybe it would be cleaner to have a flag to not signal
- ;; the error (which otherwise gives a message), and test
- ;; `imap-failed-tags'. Also, Other IMAP clients use other forms of
- ;; request which work with Exchange, e.g. Claws does "UID FETCH 1:*
- ;; (UID)" rather than "FETCH UID 1,*". Is there a good reason not
- ;; to do the same?
- (condition-case data
- ;; Binding `debug-on-error' allows us to get the error from
- ;; `imap-parse-response' -- it's normally caught by Emacs around
- ;; execution of a process filter.
- (let ((debug-on-error t))
- (imap-fetch (if imap-enable-exchange-bug-workaround
- (cdr uids)
- (car uids))
- props receive nouidfetch buffer))
- (error
- (if (and (not imap-enable-exchange-bug-workaround)
- ;; This is the Exchange 2007 response. It may be more
- ;; robust just to check for a BAD response to the
- ;; attempted fetch.
- (string-match "The specified message set is invalid"
- (cadr data)))
- (with-current-buffer (or buffer (current-buffer))
- (set (make-local-variable 'imap-enable-exchange-bug-workaround)
- t)
- (imap-fetch (cdr uids) props receive nouidfetch))
- (signal (car data) (cdr data))))))
-
(defun imap-message-copyuid-1 (mailbox)
(if (imap-capability 'UIDPLUS)
(list (nth 0 (imap-mailbox-get-1 'copyuid mailbox))
@@ -1856,7 +1772,7 @@ See `imap-enable-exchange-bug-workaround'."
(imap-message-data (make-vector 2 0)))
(when (imap-mailbox-examine-1 mailbox)
(prog1
- (and (imap-fetch-safe '("*" . "*:*") "UID")
+ (and (imap-fetch "*:*" "UID")
(list (imap-mailbox-get-1 'uidvalidity mailbox)
(apply 'max (imap-message-map
(lambda (uid prop) uid) 'UID))))
@@ -1902,7 +1818,7 @@ first element. The rest of list contains the saved articles' UIDs."
(imap-message-data (make-vector 2 0)))
(when (imap-mailbox-examine-1 mailbox)
(prog1
- (and (imap-fetch-safe '("*" . "*:*") "UID")
+ (and (imap-fetch "*:*" "UID")
(list (imap-mailbox-get-1 'uidvalidity mailbox)
(apply 'max (imap-message-map
(lambda (uid prop) uid) 'UID))))
@@ -1959,12 +1875,7 @@ on failure."
(defun imap-send-command-1 (cmdstr)
(setq cmdstr (concat cmdstr imap-client-eol))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log-buffer)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert cmdstr)))
+ (imap-log cmdstr)
(process-send-string imap-process cmdstr))
(defun imap-send-command (command &optional buffer)
@@ -2002,13 +1913,7 @@ on failure."
(stream imap-stream)
(eol imap-client-eol))
(with-current-buffer cmd
- (and imap-log
- (with-current-buffer (get-buffer-create
- imap-log-buffer)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring cmd)))
+ (imap-log cmd)
(process-send-region process (point-min)
(point-max)))
(process-send-string process imap-client-eol))))
@@ -2084,12 +1989,7 @@ Return nil if no complete line has arrived."
(with-current-buffer (process-buffer proc)
(goto-char (point-max))
(insert string)
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log-buffer)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert string)))
+ (imap-log string)
(let (end)
(goto-char (point-min))
(while (setq end (imap-find-next-line))
@@ -2992,106 +2892,6 @@ Return nil if no complete line has arrived."
(imap-forward)
(nreverse body)))))
-(when imap-debug ; (untrace-all)
- (require 'trace)
- (buffer-disable-undo (get-buffer-create imap-debug-buffer))
- (mapc (lambda (f) (trace-function-background f imap-debug-buffer))
- '(
- imap-utf7-encode
- imap-utf7-decode
- imap-error-text
- imap-kerberos4s-p
- imap-kerberos4-open
- imap-ssl-p
- imap-ssl-open
- imap-network-p
- imap-network-open
- imap-interactive-login
- imap-kerberos4a-p
- imap-kerberos4-auth
- imap-cram-md5-p
- imap-cram-md5-auth
- imap-login-p
- imap-login-auth
- imap-anonymous-p
- imap-anonymous-auth
- imap-open-1
- imap-open
- imap-opened
- imap-ping-server
- imap-authenticate
- imap-close
- imap-capability
- imap-namespace
- imap-send-command-wait
- imap-mailbox-put
- imap-mailbox-get
- imap-mailbox-map-1
- imap-mailbox-map
- imap-current-mailbox
- imap-current-mailbox-p-1
- imap-current-mailbox-p
- imap-mailbox-select-1
- imap-mailbox-select
- imap-mailbox-examine-1
- imap-mailbox-examine
- imap-mailbox-unselect
- imap-mailbox-expunge
- imap-mailbox-close
- imap-mailbox-create-1
- imap-mailbox-create
- imap-mailbox-delete
- imap-mailbox-rename
- imap-mailbox-lsub
- imap-mailbox-list
- imap-mailbox-subscribe
- imap-mailbox-unsubscribe
- imap-mailbox-status
- imap-mailbox-acl-get
- imap-mailbox-acl-set
- imap-mailbox-acl-delete
- imap-current-message
- imap-list-to-message-set
- imap-fetch-asynch
- imap-fetch
- imap-fetch-safe
- imap-message-put
- imap-message-get
- imap-message-map
- imap-search
- imap-message-flag-permanent-p
- imap-message-flags-set
- imap-message-flags-del
- imap-message-flags-add
- imap-message-copyuid-1
- imap-message-copyuid
- imap-message-copy
- imap-message-appenduid-1
- imap-message-appenduid
- imap-message-append
- imap-body-lines
- imap-envelope-from
- imap-send-command-1
- imap-send-command
- imap-wait-for-tag
- imap-sentinel
- imap-find-next-line
- imap-arrival-filter
- imap-parse-greeting
- imap-parse-response
- imap-parse-resp-text
- imap-parse-resp-text-code
- imap-parse-data-list
- imap-parse-fetch
- imap-parse-status
- imap-parse-acl
- imap-parse-flag-list
- imap-parse-envelope
- imap-parse-body-extension
- imap-parse-body
- )))
-
(provide 'imap)
-;; arch-tag: 27369ed6-33e4-482f-96f1-8bb906ba70f7
;;; imap.el ends here
diff --git a/lisp/net/netrc.el b/lisp/net/netrc.el
index 99278d9ee2..408eca9bac 100644
--- a/lisp/net/netrc.el
+++ b/lisp/net/netrc.el
@@ -54,12 +54,19 @@
"Netrc configuration."
:group 'comm)
+(defcustom netrc-file "~/.authinfo"
+ "File where user credentials are stored."
+ :type 'file
+ :group 'netrc)
+
(defvar netrc-services-file "/etc/services"
"The name of the services file.")
-(defun netrc-parse (file)
+(defun netrc-parse (&optional file)
(interactive "fFile to Parse: ")
"Parse FILE and return a list of all entries in the file."
+ (unless file
+ (setq file netrc-file))
(if (listp file)
file
(when (file-exists-p file)
@@ -160,9 +167,9 @@ MODE can be \"login\" or \"password\", suitable for passing to
(defaults (or defaults '(nil)))
info)
(if (listp mode)
- (setq info
- (mapcar
- (lambda (mode-element)
+ (setq info
+ (mapcar
+ (lambda (mode-element)
(netrc-machine-user-or-password
mode-element
authinfo-list
@@ -221,7 +228,19 @@ MODE can be \"login\" or \"password\", suitable for passing to
(eq type (car (cddr service)))))))
(cadr service)))
+(defun netrc-credentials (machine &rest ports)
+ "Return a user name/password pair.
+Port specifications will be prioritised in the order they are
+listed in the PORTS list."
+ (let ((list (netrc-parse))
+ found)
+ (while (and ports
+ (not found))
+ (setq found (netrc-machine list machine (pop ports))))
+ (when found
+ (list (cdr (assoc "login" found))
+ (cdr (assoc "password" found))))))
+
(provide 'netrc)
-;; arch-tag: af9929cc-2d12-482f-936e-eb4366f9fa55
;;; netrc.el ends here
diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el
index 5a8f1dff5c..590363a1f6 100644
--- a/lisp/net/newst-backend.el
+++ b/lisp/net/newst-backend.el
@@ -8,6 +8,7 @@
;; URL: http://www.nongnu.org/newsticker
;; Keywords: News, RSS, Atom
;; Time-stamp: "6. Dezember 2009, 19:15:32 (ulf)"
+;; Package: newsticker
;; ======================================================================
diff --git a/lisp/net/newst-plainview.el b/lisp/net/newst-plainview.el
index e1bdc2cade..a6629a4072 100644
--- a/lisp/net/newst-plainview.el
+++ b/lisp/net/newst-plainview.el
@@ -7,6 +7,7 @@
;; Filename: newst-plainview.el
;; URL: http://www.nongnu.org/newsticker
;; Time-stamp: "6. Dezember 2009, 19:17:02 (ulf)"
+;; Package: newsticker
;; ======================================================================
diff --git a/lisp/net/newst-reader.el b/lisp/net/newst-reader.el
index ce468235b4..25ed65d04a 100644
--- a/lisp/net/newst-reader.el
+++ b/lisp/net/newst-reader.el
@@ -7,6 +7,7 @@
;; Filename: newst-reader.el
;; URL: http://www.nongnu.org/newsticker
;; Time-stamp: "6. Dezember 2009, 19:16:38 (ulf)"
+;; Package: newsticker
;; ======================================================================
diff --git a/lisp/net/newst-ticker.el b/lisp/net/newst-ticker.el
index 694d2cbc20..80df1a14f2 100644
--- a/lisp/net/newst-ticker.el
+++ b/lisp/net/newst-ticker.el
@@ -8,6 +8,7 @@
;; URL: http://www.nongnu.org/newsticker
;; Keywords: News, RSS, Atom
;; Time-stamp: "6. Dezember 2009, 19:16:00 (ulf)"
+;; Package: newsticker
;; ======================================================================
diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el
index 80bc2c70a1..6bf0b593de 100644
--- a/lisp/net/newst-treeview.el
+++ b/lisp/net/newst-treeview.el
@@ -8,6 +8,7 @@
;; Created: 2007
;; Keywords: News, RSS, Atom
;; Time-stamp: "6. Dezember 2009, 19:17:28 (ulf)"
+;; Package: newsticker
;; ======================================================================
diff --git a/lisp/net/newsticker.el b/lisp/net/newsticker.el
index 1d4b35bb61..2566529d42 100644
--- a/lisp/net/newsticker.el
+++ b/lisp/net/newsticker.el
@@ -9,6 +9,7 @@
;; Created: 17. June 2003
;; Keywords: News, RSS, Atom
;; Time-stamp: "6. Dezember 2009, 19:15:18 (ulf)"
+;; Version: 1.99
;; ======================================================================
diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el
index 91e40e3d01..517e97efe6 100644
--- a/lisp/net/ntlm.el
+++ b/lisp/net/ntlm.el
@@ -27,9 +27,9 @@
;; This library is a direct translation of the Samba release 2.2.0
;; implementation of Windows NT and LanManager compatible password
;; encryption.
-;;
+;;
;; Interface functions:
-;;
+;;
;; ntlm-build-auth-request
;; This will return a binary string, which should be used in the
;; base64 encoded form and it is the caller's responsibility to encode
@@ -40,7 +40,7 @@
;; (which will be a binary string) as the first argument and to
;; encode the returned string with base64. The second argument user
;; should be given in user@domain format.
-;;
+;;
;; ntlm-get-password-hashes
;;
;;
@@ -534,5 +534,4 @@ into a Unicode string. PASSWD is truncated to 128 bytes if longer."
(provide 'ntlm)
-;; arch-tag: 348ace18-f8e2-4176-8fe9-d9ab4e96f296
;;; ntlm.el ends here
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 76fc1cd72d..093892a110 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -774,42 +774,64 @@ If SILENT is non-nil, do not print the message in any irc buffer."
(setq rcirc-input-ring-index (1- rcirc-input-ring-index))
(insert (rcirc-prev-input-string -1))))
-(defvar rcirc-nick-completions nil)
-(defvar rcirc-nick-completion-start-offset nil)
-
-(defun rcirc-complete-nick ()
- "Cycle through nick completions from list of nicks in channel."
+(defvar rcirc-server-commands
+ '("/admin" "/away" "/connect" "/die" "/error" "/info"
+ "/invite" "/ison" "/join" "/kick" "/kill" "/links"
+ "/list" "/lusers" "/mode" "/motd" "/names" "/nick"
+ "/notice" "/oper" "/part" "/pass" "/ping" "/pong"
+ "/privmsg" "/quit" "/rehash" "/restart" "/service" "/servlist"
+ "/server" "/squery" "/squit" "/stats" "/summon" "/time"
+ "/topic" "/trace" "/user" "/userhost" "/users" "/version"
+ "/wallops" "/who" "/whois" "/whowas")
+ "A list of user commands by IRC server.
+The value defaults to RFCs 1459 and 2812.")
+
+;; /me and /ctcp are not defined by `defun-rcirc-command'.
+(defvar rcirc-client-commands '("/me" "/ctcp")
+ "A list of user commands defined by IRC client rcirc.
+The list is updated automatically by `defun-rcirc-command'.")
+
+(defun rcirc-completion-at-point ()
+ "Function used for `completion-at-point-functions' in `rcirc-mode'."
+ (let* ((beg (save-excursion
+ (if (re-search-backward " " rcirc-prompt-end-marker t)
+ (1+ (point))
+ rcirc-prompt-end-marker)))
+ (table (if (and (= beg rcirc-prompt-end-marker)
+ (eq (char-after beg) ?/))
+ (delete-dups
+ (nconc
+ (sort (copy-sequence rcirc-client-commands) 'string-lessp)
+ (sort (copy-sequence rcirc-server-commands) 'string-lessp)))
+ (rcirc-channel-nicks (rcirc-buffer-process) rcirc-target))))
+ (list beg (point) table)))
+
+(defvar rcirc-completions nil)
+(defvar rcirc-completion-start nil)
+
+(defun rcirc-complete ()
+ "Cycle through completions from list of nicks in channel or IRC commands.
+IRC command completion is performed only if '/' is the first input char."
(interactive)
(if (eq last-command this-command)
- (setq rcirc-nick-completions
- (append (cdr rcirc-nick-completions)
- (list (car rcirc-nick-completions))))
- (setq rcirc-nick-completion-start-offset
- (- (save-excursion
- (if (re-search-backward " " rcirc-prompt-end-marker t)
- (1+ (point))
- rcirc-prompt-end-marker))
- rcirc-prompt-end-marker))
- (setq rcirc-nick-completions
- (let ((completion-ignore-case t))
- (all-completions
- (buffer-substring
- (+ rcirc-prompt-end-marker
- rcirc-nick-completion-start-offset)
- (point))
- (mapcar (lambda (x) (cons x nil))
- (rcirc-channel-nicks (rcirc-buffer-process)
- rcirc-target))))))
- (let ((completion (car rcirc-nick-completions)))
+ (setq rcirc-completions
+ (append (cdr rcirc-completions) (list (car rcirc-completions))))
+ (let ((completion-ignore-case t)
+ (table (rcirc-completion-at-point)))
+ (setq rcirc-completion-start (car table))
+ (setq rcirc-completions
+ (all-completions (buffer-substring rcirc-completion-start
+ (cadr table))
+ (nth 2 table)))))
+ (let ((completion (car rcirc-completions)))
(when completion
- (delete-region (+ rcirc-prompt-end-marker
- rcirc-nick-completion-start-offset)
- (point))
- (insert (concat completion
- (if (= (+ rcirc-prompt-end-marker
- rcirc-nick-completion-start-offset)
- rcirc-prompt-end-marker)
- ": "))))))
+ (delete-region rcirc-completion-start (point))
+ (insert
+ (concat completion
+ (cond
+ ((= (aref completion 0) ?/) " ")
+ ((= rcirc-completion-start rcirc-prompt-end-marker) ": ")
+ (t "")))))))
(defun set-rcirc-decode-coding-system (coding-system)
"Set the decode coding system used in this channel."
@@ -827,7 +849,7 @@ If SILENT is non-nil, do not print the message in any irc buffer."
(define-key rcirc-mode-map (kbd "RET") 'rcirc-send-input)
(define-key rcirc-mode-map (kbd "M-p") 'rcirc-insert-prev-input)
(define-key rcirc-mode-map (kbd "M-n") 'rcirc-insert-next-input)
-(define-key rcirc-mode-map (kbd "TAB") 'rcirc-complete-nick)
+(define-key rcirc-mode-map (kbd "TAB") 'rcirc-complete)
(define-key rcirc-mode-map (kbd "C-c C-b") 'rcirc-browse-url)
(define-key rcirc-mode-map (kbd "C-c C-c") 'rcirc-edit-multiline)
(define-key rcirc-mode-map (kbd "C-c C-j") 'rcirc-cmd-join)
@@ -948,6 +970,9 @@ This number is independent of the number of lines in the buffer.")
rcirc-buffer-alist))))
(rcirc-update-short-buffer-names))
+ (add-hook 'completion-at-point-functions
+ 'rcirc-completion-at-point nil 'local)
+
(run-hooks 'rcirc-mode-hook))
(defun rcirc-update-prompt (&optional all)
@@ -1085,7 +1110,7 @@ Create the buffer if it doesn't exist."
(goto-char (point-max))
(when (not (equal 0 (- (point) rcirc-prompt-end-marker)))
;; delete a trailing newline
- (when (bolp)
+ (when (eq (point) (point-at-bol))
(delete-char -1))
(let ((input (buffer-substring-no-properties
rcirc-prompt-end-marker (point))))
@@ -1342,6 +1367,12 @@ Logfiles are kept in `rcirc-log-directory'."
:type 'integer
:group 'rcirc)
+(defcustom rcirc-log-process-buffers nil
+ "Non-nil if rcirc process buffers should be logged to disk."
+ :group 'rcirc
+ :type 'boolean
+ :version "24.1")
+
(defun rcirc-last-quit-line (process nick target)
"Return the line number where NICK left TARGET.
Returns nil if the information is not recorded."
@@ -1507,14 +1538,21 @@ record activity."
(when (not (rcirc-channel-p rcirc-target))
'nick)))
- (when rcirc-log-flag
+ (when (and rcirc-log-flag
+ (or target
+ rcirc-log-process-buffers))
(rcirc-log process sender response target text))
(sit-for 0) ; displayed text before hook
(run-hook-with-args 'rcirc-print-hooks
process sender response target text)))))
-(defcustom rcirc-log-filename-function 'rcirc-generate-new-buffer-name
+(defun rcirc-generate-log-filename (process target)
+ (if target
+ (rcirc-generate-new-buffer-name process target)
+ (process-name process)))
+
+(defcustom rcirc-log-filename-function 'rcirc-generate-log-filename
"A function to generate the filename used by rcirc's logging facility.
It is called with two arguments, PROCESS and TARGET (see
@@ -1991,16 +2029,18 @@ activity. Only run if the buffer is not visible and
;; containing the text following the /cmd.
(defmacro defun-rcirc-command (command argument docstring interactive-form
- &rest body)
+ &rest body)
"Define a command."
- `(defun ,(intern (concat "rcirc-cmd-" (symbol-name command)))
- (,@argument &optional process target)
- ,(concat docstring "\n\nNote: If PROCESS or TARGET are nil, the values given"
- "\nby `rcirc-buffer-process' and `rcirc-target' will be used.")
- ,interactive-form
- (let ((process (or process (rcirc-buffer-process)))
- (target (or target rcirc-target)))
- ,@body)))
+ `(progn
+ (add-to-list 'rcirc-client-commands ,(concat "/" (symbol-name command)))
+ (defun ,(intern (concat "rcirc-cmd-" (symbol-name command)))
+ (,@argument &optional process target)
+ ,(concat docstring "\n\nNote: If PROCESS or TARGET are nil, the values given"
+ "\nby `rcirc-buffer-process' and `rcirc-target' will be used.")
+ ,interactive-form
+ (let ((process (or process (rcirc-buffer-process)))
+ (target (or target rcirc-target)))
+ ,@body))))
(defun-rcirc-command msg (message)
"Send private MESSAGE to TARGET."
@@ -2138,12 +2178,13 @@ With a prefix arg, prompt for new topic."
(rcirc-send-string process (format "PRIVMSG %s :\C-aACTION %s\C-a"
target args)))
-(defun rcirc-add-or-remove (set &optional elt)
- (if (and elt (not (string= "" elt)))
- (if (member-ignore-case elt set)
- (delete elt set)
- (cons elt set))
- set))
+(defun rcirc-add-or-remove (set &rest elements)
+ (dolist (elt elements)
+ (if (and elt (not (string= "" elt)))
+ (setq set (if (member-ignore-case elt set)
+ (delete elt set)
+ (cons elt set)))))
+ set)
(defun-rcirc-command ignore (nick)
"Manage the ignore list.
@@ -2151,7 +2192,9 @@ Ignore NICK, unignore NICK if already ignored, or list ignored
nicks when no NICK is given. When listing ignored nicks, the
ones added to the list automatically are marked with an asterisk."
(interactive "sToggle ignoring of nick: ")
- (setq rcirc-ignore-list (rcirc-add-or-remove rcirc-ignore-list nick))
+ (setq rcirc-ignore-list
+ (apply #'rcirc-add-or-remove rcirc-ignore-list
+ (split-string nick nil t)))
(rcirc-print process nil "IGNORE" target
(mapconcat
(lambda (nick)
@@ -2163,14 +2206,18 @@ ones added to the list automatically are marked with an asterisk."
(defun-rcirc-command bright (nick)
"Manage the bright nick list."
(interactive "sToggle emphasis of nick: ")
- (setq rcirc-bright-nicks (rcirc-add-or-remove rcirc-bright-nicks nick))
+ (setq rcirc-bright-nicks
+ (apply #'rcirc-add-or-remove rcirc-bright-nicks
+ (split-string nick nil t)))
(rcirc-print process nil "BRIGHT" target
(mapconcat 'identity rcirc-bright-nicks " ")))
(defun-rcirc-command dim (nick)
"Manage the dim nick list."
(interactive "sToggle deemphasis of nick: ")
- (setq rcirc-dim-nicks (rcirc-add-or-remove rcirc-dim-nicks nick))
+ (setq rcirc-dim-nicks
+ (apply #'rcirc-add-or-remove rcirc-dim-nicks
+ (split-string nick nil t)))
(rcirc-print process nil "DIM" target
(mapconcat 'identity rcirc-dim-nicks " ")))
@@ -2179,7 +2226,9 @@ ones added to the list automatically are marked with an asterisk."
Mark KEYWORD, unmark KEYWORD if already marked, or list marked
keywords when no KEYWORD is given."
(interactive "sToggle highlighting of keyword: ")
- (setq rcirc-keywords (rcirc-add-or-remove rcirc-keywords keyword))
+ (setq rcirc-keywords
+ (apply #'rcirc-add-or-remove rcirc-keywords
+ (split-string keyword nil t)))
(rcirc-print process nil "KEYWORD" target
(mapconcat 'identity rcirc-keywords " ")))
diff --git a/lisp/net/sasl-cram.el b/lisp/net/sasl-cram.el
index 9faeded5c3..38d7ff4e11 100644
--- a/lisp/net/sasl-cram.el
+++ b/lisp/net/sasl-cram.el
@@ -5,6 +5,7 @@
;; Author: Daiki Ueno <[email protected]>
;; Kenichi OKADA <[email protected]>
;; Keywords: SASL, CRAM-MD5
+;; Package: sasl
;; This file is part of GNU Emacs.
@@ -46,5 +47,4 @@
(provide 'sasl-cram)
-;; arch-tag: 46cb281b-975a-4fe0-a39f-3018691b1b05
;;; sasl-cram.el ends here
diff --git a/lisp/net/sasl-digest.el b/lisp/net/sasl-digest.el
index 4d839296c9..8559c8f3fa 100644
--- a/lisp/net/sasl-digest.el
+++ b/lisp/net/sasl-digest.el
@@ -5,6 +5,7 @@
;; Author: Daiki Ueno <[email protected]>
;; Kenichi OKADA <[email protected]>
;; Keywords: SASL, DIGEST-MD5
+;; Package: sasl
;; This file is part of GNU Emacs.
@@ -94,10 +95,10 @@ charset algorithm cipher-opts auth-param)."
(md5-binary
(concat
(encode-hex-string
- (md5-binary (concat (md5-binary
+ (md5-binary (concat (md5-binary
(concat username ":" realm ":" passphrase))
":" nonce ":" cnonce
- (if authzid
+ (if authzid
(concat ":" authzid)))))
":" nonce
":" (format "%08x" nonce-count) ":" cnonce ":" qop ":"
@@ -153,5 +154,4 @@ charset algorithm cipher-opts auth-param)."
(provide 'sasl-digest)
-;; arch-tag: 786e02ed-1bc4-4b3c-bf34-96c27e31084d
;;; sasl-digest.el ends here
diff --git a/lisp/net/sasl-ntlm.el b/lisp/net/sasl-ntlm.el
index 94366f1a52..ace50528ac 100644
--- a/lisp/net/sasl-ntlm.el
+++ b/lisp/net/sasl-ntlm.el
@@ -6,6 +6,7 @@
;; Keywords: SASL, NTLM
;; Version: 1.00
;; Created: February 2001
+;; Package: sasl
;; This file is part of GNU Emacs.
@@ -62,5 +63,4 @@ challenge stored in the 2nd element of STEP. Called from `sasl-next-step'."
(provide 'sasl-ntlm)
-;; arch-tag: 1d9164c1-1df0-418f-b7ab-360157fd05dc
;;; sasl-ntlm.el ends here
diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el
index c2a3f10e3d..7f864390a5 100644
--- a/lisp/net/sasl.el
+++ b/lisp/net/sasl.el
@@ -267,5 +267,4 @@ It contain at least 64 bits of entropy."
(provide 'sasl)
-;; arch-tag: 8b3326fa-4978-4fda-93e2-cb2c6255f887
;;; sasl.el ends here
diff --git a/lisp/net/tls.el b/lisp/net/tls.el
index 9a1b0bb661..821daba6f6 100644
--- a/lisp/net/tls.el
+++ b/lisp/net/tls.el
@@ -298,5 +298,4 @@ match `%s'. Connect anyway? " host))))))
(provide 'tls)
-;; arch-tag: 5596d1c4-facc-4bc4-94a9-9863b928d7ac
;;; tls.el ends here
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index ac86fabe3a..8241c04882 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -1,3 +1,5 @@
+(setq tramp-version 24)
+
;;; tramp-cache.el --- file information caching for Tramp
;; Copyright (C) 2000, 2005, 2006, 2007, 2008, 2009,
@@ -6,6 +8,7 @@
;; Author: Daniel Pittman <[email protected]>
;; Michael Albinus <[email protected]>
;; Keywords: comm, processes
+;; Package: tramp
;; This file is part of GNU Emacs.
@@ -49,24 +52,14 @@
;;; Code:
-;; Pacify byte-compiler.
-(eval-when-compile
- (require 'cl)
- (autoload 'tramp-message "tramp")
- (autoload 'tramp-tramp-file-p "tramp")
- ;; We cannot autoload macro `with-parsed-tramp-file-name', it
- ;; results in problems of byte-compiled code.
- (autoload 'tramp-dissect-file-name "tramp")
- (autoload 'tramp-file-name-method "tramp")
- (autoload 'tramp-file-name-user "tramp")
- (autoload 'tramp-file-name-host "tramp")
- (autoload 'tramp-file-name-localname "tramp")
- (autoload 'tramp-run-real-handler "tramp")
- (autoload 'tramp-time-less-p "tramp")
- (autoload 'time-stamp-string "time-stamp"))
+(require 'tramp)
+; bob, 2010 Sep 11
+; (require 'trampver.el)
+(autoload 'time-stamp-string "time-stamp")
;;; -- Cache --
+;;;###tramp-autoload
(defvar tramp-cache-data (make-hash-table :test 'equal)
"Hash table for remote files properties.")
@@ -102,6 +95,7 @@ time.")
(defvar tramp-cache-data-changed nil
"Whether persistent cache data have been changed.")
+;;;###tramp-autoload
(defun tramp-get-file-property (vec file property default)
"Get the PROPERTY of FILE from the cache context of VEC.
Returns DEFAULT if not set."
@@ -129,6 +123,7 @@ Returns DEFAULT if not set."
(tramp-message vec 8 "%s %s %s" file property value)
value))
+;;;###tramp-autoload
(defun tramp-set-file-property (vec file property value)
"Set the PROPERTY of FILE to VALUE, in the cache context of VEC.
Returns VALUE."
@@ -143,6 +138,26 @@ Returns VALUE."
(tramp-message vec 8 "%s %s %s" file property value)
value))
+;;;###tramp-autoload
+(defmacro with-file-property (vec file property &rest body)
+ "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache.
+FILE must be a local file name on a connection identified via VEC."
+ `(if (file-name-absolute-p ,file)
+ (let ((value (tramp-get-file-property ,vec ,file ,property 'undef)))
+ (when (eq value 'undef)
+ ;; We cannot pass @body as parameter to
+ ;; `tramp-set-file-property' because it mangles our
+ ;; debug messages.
+ (setq value (progn ,@body))
+ (tramp-set-file-property ,vec ,file ,property value))
+ value)
+ ,@body))
+
+(put 'with-file-property 'lisp-indent-function 3)
+(put 'with-file-property 'edebug-form-spec t)
+(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-file-property\\>"))
+
+;;;###tramp-autoload
(defun tramp-flush-file-property (vec file)
"Remove all properties of FILE in the cache context of VEC."
;; Unify localname.
@@ -151,6 +166,7 @@ Returns VALUE."
(tramp-message vec 8 "%s" file)
(remhash vec tramp-cache-data))
+;;;###tramp-autoload
(defun tramp-flush-directory-property (vec directory)
"Remove all properties of DIRECTORY in the cache context of VEC.
Remove also properties of all files in subdirectories."
@@ -174,8 +190,7 @@ Remove also properties of all files in subdirectories."
(buffer-file-name)
default-directory)))
(when (tramp-tramp-file-p bfn)
- (let* ((v (tramp-dissect-file-name bfn))
- (localname (tramp-file-name-localname v)))
+ (with-parsed-tramp-file-name bfn nil
(tramp-flush-file-property v localname)))))
(add-hook 'before-revert-hook 'tramp-flush-file-function)
@@ -192,6 +207,7 @@ Remove also properties of all files in subdirectories."
;;; -- Properties --
+;;;###tramp-autoload
(defun tramp-get-connection-property (key property default)
"Get the named PROPERTY for the connection.
KEY identifies the connection, it is either a process or a vector.
@@ -208,6 +224,7 @@ If the value is not set for the connection, returns DEFAULT."
(tramp-message key 7 "%s %s" property value)
value))
+;;;###tramp-autoload
(defun tramp-set-connection-property (key property value)
"Set the named PROPERTY of a connection to VALUE.
KEY identifies the connection, it is either a process or a vector.
@@ -230,6 +247,23 @@ PROPERTY is set persistent when KEY is a vector."
(error nil))
value))
+;;;###tramp-autoload
+(defmacro with-connection-property (key property &rest body)
+ "Check in Tramp for property PROPERTY, otherwise executes BODY and set."
+ `(let ((value (tramp-get-connection-property ,key ,property 'undef)))
+ (when (eq value 'undef)
+ ;; We cannot pass ,@body as parameter to
+ ;; `tramp-set-connection-property' because it mangles our debug
+ ;; messages.
+ (setq value (progn ,@body))
+ (tramp-set-connection-property ,key ,property value))
+ value))
+
+(put 'with-connection-property 'lisp-indent-function 2)
+(put 'with-connection-property 'edebug-form-spec t)
+(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-connection-property\\>"))
+
+;;;###tramp-autoload
(defun tramp-flush-connection-property (key)
"Remove all properties identified by KEY.
KEY identifies the connection, it is either a process or a vector."
@@ -250,6 +284,7 @@ KEY identifies the connection, it is either a process or a vector."
(setq tramp-cache-data-changed t)
(remhash key tramp-cache-data))
+;;;###tramp-autoload
(defun tramp-cache-print (table)
"Print hash table TABLE."
(when (hash-table-p table)
@@ -270,6 +305,7 @@ KEY identifies the connection, it is either a process or a vector."
table)
result)))
+;;;###tramp-autoload
(defun tramp-list-connections ()
"Return a list of all known connection vectors according to `tramp-cache'."
(let (result)
@@ -325,6 +361,7 @@ KEY identifies the connection, it is either a process or a vector."
(remove-hook 'kill-emacs-hook
'tramp-dump-connection-properties)))
+;;;###tramp-autoload
(defun tramp-parse-connection-properties (method)
"Return a list of (user host) tuples allowed to access for METHOD.
This function is added always in `tramp-get-completion-function'
@@ -363,6 +400,10 @@ for all methods. Resulting data are derived from connection history."
tramp-persistency-file-name (error-message-string err))
(clrhash tramp-cache-data))))
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-cache 'force)))
+
(provide 'tramp-cache)
;; arch-tag: ee1739b7-7628-408c-9b96-d11a74b05d26
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 0e31360a41..32cbb16b9e 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -4,6 +4,7 @@
;; Author: Michael Albinus <[email protected]>
;; Keywords: comm, processes
+;; Package: tramp
;; This file is part of GNU Emacs.
@@ -128,6 +129,7 @@ This includes password cache, file cache, connection cache, buffers."
;; Tramp version is useful in a number of situations.
+;;;###tramp-autoload
(defun tramp-version (arg)
"Print version number of tramp.el in minibuffer or current buffer."
(interactive "P")
@@ -386,6 +388,9 @@ please ensure that the buffers are attached to your email.\n\n")
(defalias 'tramp-submit-bug 'tramp-bug)
+(add-hook 'tramp-unload-hook
+ (lambda () (unload-feature 'tramp-cmds 'force)))
+
(provide 'tramp-cmds)
;;; TODO:
@@ -394,7 +399,7 @@ please ensure that the buffers are attached to your email.\n\n")
;; * WIBNI there was an interactive command prompting for Tramp
;; method, hostname, username and filename and translates the user
;; input into the correct filename syntax (depending on the Emacs
-;; flavor) (Reiner Steib)
+;; flavor) (Reiner Steib)
;; * Let the user edit the connection properties interactively.
;; Something like `gnus-server-edit-server' in Gnus' *Server* buffer.
;; * It's just that when I come to Customize `tramp-default-user-alist'
@@ -403,7 +408,7 @@ please ensure that the buffers are attached to your email.\n\n")
;; Option and should not be modified by the code. add-to-list is
;; called in several places. One way to handle that is to have a new
;; ordinary variable that gets its initial value from
-;; tramp-default-user-alist and then is added to. (Pete Forman)
+;; tramp-default-user-alist and then is added to. (Pete Forman)
;; arch-tag: 190d4c33-76bb-4e99-8b6f-71741f23d98c
;;; tramp-cmds.el ends here
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 484d2be7ab..d5884574cb 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -4,6 +4,7 @@
;; Author: Michael Albinus <[email protected]>
;; Keywords: comm, processes
+;; Package: tramp
;; This file is part of GNU Emacs.
@@ -30,6 +31,10 @@
(eval-when-compile
+ (require 'tramp-loaddefs))
+
+(eval-when-compile
+
;; Pacify byte-compiler.
(require 'cl))
@@ -42,33 +47,20 @@
(require 'timer-funcs)
(require 'timer))
- (autoload 'tramp-tramp-file-p "tramp")
- (autoload 'tramp-file-name-handler "tramp")
-
;; We check whether `start-file-process' is bound.
(unless (fboundp 'start-file-process)
;; tramp-util offers integration into other (X)Emacs packages like
;; compile.el, gud.el etc. Not necessary in Emacs 23.
(eval-after-load "tramp"
- '(progn
- (require 'tramp-util)
- (add-hook 'tramp-unload-hook
- '(lambda ()
- (when (featurep 'tramp-util)
- (unload-feature 'tramp-util 'force))))))
+ '(require 'tramp-util))
;; Make sure that we get integration with the VC package. When it
;; is loaded, we need to pull in the integration module. Not
;; necessary in Emacs 23.
(eval-after-load "vc"
(eval-after-load "tramp"
- '(progn
- (require 'tramp-vc)
- (add-hook 'tramp-unload-hook
- '(lambda ()
- (when (featurep 'tramp-vc)
- (unload-feature 'tramp-vc 'force))))))))
+ '(require 'tramp-vc))))
;; Avoid byte-compiler warnings if the byte-compiler supports this.
;; Currently, XEmacs supports this.
@@ -262,6 +254,24 @@ Add the extension of FILENAME, if existing."
;; Default value in XEmacs.
(t 134217727)))
+(defun tramp-compat-decimal-to-octal (i)
+ "Return a string consisting of the octal digits of I.
+Not actually used. Use `(format \"%o\" i)' instead?"
+ (cond ((< i 0) (error "Cannot convert negative number to octal"))
+ ((not (integerp i)) (error "Cannot convert non-integer to octal"))
+ ((zerop i) "0")
+ (t (concat (tramp-compat-decimal-to-octal (/ i 8))
+ (number-to-string (% i 8))))))
+
+;; Kudos to Gerd Moellmann for this suggestion.
+(defun tramp-compat-octal-to-decimal (ostr)
+ "Given a string of octal digits, return a decimal number."
+ (let ((x (or ostr "")))
+ ;; `save-match' is in `tramp-mode-string-to-int' which calls this.
+ (unless (string-match "\\`[0-7]*\\'" x)
+ (error "Non-octal junk in string `%s'" x))
+ (string-to-number ostr 8)))
+
;; ID-FORMAT does not exists in XEmacs.
(defun tramp-compat-file-attributes (filename &optional id-format)
"Like `file-attributes' for Tramp files (compat function)."
@@ -396,6 +406,20 @@ This is, the first, empty, element is omitted. In XEmacs, the first
element is not omitted."
(delete "" (split-string string pattern)))
+(defun tramp-compat-call-process
+ (program &optional infile destination display &rest args)
+ "Calls `call-process' on the local host.
+This is needed because for some Emacs flavors Tramp has
+defadviced `call-process' to behave like `process-file'. The
+Lisp error raised when PROGRAM is nil is trapped also, returning 1."
+ (let ((default-directory
+ (if (file-remote-p default-directory)
+ (tramp-compat-temporary-file-directory)
+ default-directory)))
+ (if (executable-find program)
+ (apply 'call-process program infile destination display args)
+ 1)))
+
(defun tramp-compat-process-running-p (process-name)
"Returns `t' if system process PROCESS-NAME is running for `user-login-name'."
(when (stringp process-name)
@@ -438,6 +462,10 @@ element is not omitted."
(setenv "UNIX95" unix95)
result)))))
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-compat 'force)))
+
(provide 'tramp-compat)
;;; TODO:
diff --git a/lisp/net/tramp-fish.el b/lisp/net/tramp-fish.el
index 632b400e2b..e5d0ffd336 100644
--- a/lisp/net/tramp-fish.el
+++ b/lisp/net/tramp-fish.el
@@ -4,6 +4,7 @@
;; Author: Michael Albinus <[email protected]>
;; Keywords: comm, processes
+;; Package: tramp
;; This file is part of GNU Emacs.
@@ -156,16 +157,14 @@
(require 'cl))
(require 'tramp)
-(require 'tramp-cache)
-(require 'tramp-compat)
;; Define FISH method ...
-(defcustom tramp-fish-method "fish"
- "*Method to connect via FISH protocol."
- :group 'tramp
- :type 'string)
+;;;###tramp-autoload
+(defconst tramp-fish-method "fish"
+ "*Method to connect via FISH protocol.")
;; ... and add it to the method list.
+;;;###tramp-autoload
(add-to-list 'tramp-methods (cons tramp-fish-method nil))
;; Add a default for `tramp-default-user-alist'. Default is the local user.
@@ -263,11 +262,13 @@ Used instead of analyzing error codes of commands.")
"Alist of handler functions for Tramp FISH method.
Operations not mentioned here will be handled by the default Emacs primitives.")
-(defun tramp-fish-file-name-p (filename)
+;;;###tramp-autoload
+(defsubst tramp-fish-file-name-p (filename)
"Check if it's a filename for FISH protocol."
(let ((v (tramp-dissect-file-name filename)))
(string= (tramp-file-name-method v) tramp-fish-method)))
+;;;###tramp-autoload
(defun tramp-fish-file-name-handler (operation &rest args)
"Invoke the FISH related OPERATION.
First arg specifies the OPERATION, second arg is a list of arguments to
@@ -277,6 +278,7 @@ pass to the OPERATION."
(save-match-data (apply (cdr fn) args))
(tramp-run-real-handler operation args))))
+;;;###tramp-autoload
(add-to-list 'tramp-foreign-file-name-handler-alist
(cons 'tramp-fish-file-name-p 'tramp-fish-file-name-handler))
@@ -687,7 +689,7 @@ target of the symlink differ."
(tramp-flush-file-property v localname)
(unless (tramp-fish-send-command-and-check
v (format "#CHMOD %s %s"
- (tramp-decimal-to-octal mode)
+ (tramp-compat-decimal-to-octal mode)
(tramp-shell-quote-argument localname)))
(tramp-error
v 'file-error "Error while changing file's mode %s" filename))))
@@ -1169,6 +1171,10 @@ Returns nil if there has been an error message."
(goto-char (point-min))
(looking-at tramp-fish-ok-prompt-regexp)))
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-fish 'force)))
+
(provide 'tramp-fish)
;
;;;; TODO:
diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el
index 4c373cbcd8..799b974bd0 100644
--- a/lisp/net/tramp-ftp.el
+++ b/lisp/net/tramp-ftp.el
@@ -5,6 +5,7 @@
;; Author: Michael Albinus <[email protected]>
;; Keywords: comm, processes
+;; Package: tramp
;; This file is part of GNU Emacs.
@@ -29,7 +30,6 @@
;;; Code:
(require 'tramp)
-(autoload 'tramp-set-connection-property "tramp-cache")
(eval-when-compile
@@ -98,13 +98,14 @@ present for backward compatibility."
(add-hook 'tramp-ftp-unload-hook 'tramp-ftp-enable-ange-ftp)
;; Define FTP method ...
-(defcustom tramp-ftp-method "ftp"
- "*When this method name is used, forward all calls to Ange-FTP."
- :group 'tramp
- :type 'string)
+;;;###tramp-autoload
+(defconst tramp-ftp-method "ftp"
+ "*When this method name is used, forward all calls to Ange-FTP.")
;; ... and add it to the method list.
-(add-to-list 'tramp-methods (cons tramp-ftp-method nil))
+;;;###tramp-autoload
+(unless (featurep 'xemacs)
+ (add-to-list 'tramp-methods (cons tramp-ftp-method nil)))
;; Add some defaults for `tramp-default-method-alist'
(add-to-list 'tramp-default-method-alist
@@ -128,6 +129,7 @@ present for backward compatibility."
(symbol-plist
'substitute-in-file-name))))))
+;;;###tramp-autoload
(defun tramp-ftp-file-name-handler (operation &rest args)
"Invoke the Ange-FTP handler for OPERATION.
First arg specifies the OPERATION, second arg is a list of arguments to
@@ -198,13 +200,20 @@ pass to the OPERATION."
(inhibit-file-name-operation operation))
(apply 'ange-ftp-hook-function operation args)))))))
-(defun tramp-ftp-file-name-p (filename)
+;;;###tramp-autoload
+(defsubst tramp-ftp-file-name-p (filename)
"Check if it's a filename that should be forwarded to Ange-FTP."
(let ((v (tramp-dissect-file-name filename)))
(string= (tramp-file-name-method v) tramp-ftp-method)))
-(add-to-list 'tramp-foreign-file-name-handler-alist
- (cons 'tramp-ftp-file-name-p 'tramp-ftp-file-name-handler))
+;;;###tramp-autoload
+(unless (featurep 'xemacs)
+ (add-to-list 'tramp-foreign-file-name-handler-alist
+ (cons 'tramp-ftp-file-name-p 'tramp-ftp-file-name-handler)))
+
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-ftp 'force)))
(provide 'tramp-ftp)
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 202eaf5983..6e07ec1902 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -4,6 +4,7 @@
;; Author: Michael Albinus <[email protected]>
;; Keywords: comm, processes
+;; Package: tramp
;; This file is part of GNU Emacs.
@@ -107,6 +108,7 @@
(require 'url-util)
(require 'zeroconf)
+;;;###tramp-autoload
(defcustom tramp-gvfs-methods '("dav" "davs" "obex" "synce")
"*List of methods for remote files, accessed with GVFS."
:group 'tramp
@@ -132,11 +134,11 @@
;; Add the methods to `tramp-methods', in order to allow minibuffer
;; completion.
-(eval-after-load "tramp-gvfs"
- '(when (featurep 'tramp-gvfs)
- (dolist (elt tramp-gvfs-methods)
- (unless (assoc elt tramp-methods)
- (add-to-list 'tramp-methods (cons elt nil))))))
+;;;###tramp-autoload
+(when (featurep 'dbusbind)
+ (dolist (elt tramp-gvfs-methods)
+ (unless (assoc elt tramp-methods)
+ (add-to-list 'tramp-methods (cons elt nil)))))
(defconst tramp-gvfs-path-tramp (concat dbus-path-emacs "/Tramp")
"The preceeding object path for own objects.")
@@ -144,9 +146,12 @@
(defconst tramp-gvfs-service-daemon "org.gtk.vfs.Daemon"
"The well known name of the GVFS daemon.")
-;; Check that GVFS is available.
-(unless (dbus-ping :session tramp-gvfs-service-daemon 100)
- (throw 'tramp-loading nil))
+;; Check that GVFS is available. D-Bus integration is available since
+;; Emacs 23 on some system types. We don't call `dbus-ping', because
+;; this would load dbus.el.
+(unless (and (tramp-compat-funcall 'dbus-get-unique-name :session)
+ (tramp-compat-process-running-p "gvfs-fuse-daemon"))
+ (error "Package `tramp-gvfs' not supported"))
(defconst tramp-gvfs-path-mounttracker "/org/gtk/vfs/mounttracker"
"The object path of the GVFS daemon.")
@@ -384,7 +389,7 @@ Every entry is a list (NAME ADDRESS).")
(expand-file-name . tramp-gvfs-handle-expand-file-name)
;; `file-accessible-directory-p' performed by default handler.
(file-attributes . tramp-gvfs-handle-file-attributes)
- (file-directory-p . tramp-smb-handle-file-directory-p)
+ (file-directory-p . tramp-gvfs-handle-file-directory-p)
(file-executable-p . tramp-gvfs-handle-file-executable-p)
(file-exists-p . tramp-gvfs-handle-file-exists-p)
(file-local-copy . tramp-gvfs-handle-file-local-copy)
@@ -430,13 +435,15 @@ Every entry is a list (NAME ADDRESS).")
"Alist of handler functions for Tramp GVFS method.
Operations not mentioned here will be handled by the default Emacs primitives.")
-(defun tramp-gvfs-file-name-p (filename)
+;;;###tramp-autoload
+(defsubst tramp-gvfs-file-name-p (filename)
"Check if it's a filename handled by the GVFS daemon."
(and (tramp-tramp-file-p filename)
(let ((method
(tramp-file-name-method (tramp-dissect-file-name filename))))
(and (stringp method) (member method tramp-gvfs-methods)))))
+;;;###tramp-autoload
(defun tramp-gvfs-file-name-handler (operation &rest args)
"Invoke the GVFS related OPERATION.
First arg specifies the OPERATION, second arg is a list of arguments to
@@ -448,8 +455,10 @@ pass to the OPERATION."
;; This might be moved to tramp.el. It shall be the first file name
;; handler.
-(add-to-list 'tramp-foreign-file-name-handler-alist
- (cons 'tramp-gvfs-file-name-p 'tramp-gvfs-file-name-handler))
+;;;###tramp-autoload
+(when (featurep 'dbusbind)
+ (add-to-list 'tramp-foreign-file-name-handler-alist
+ (cons 'tramp-gvfs-file-name-p 'tramp-gvfs-file-name-handler)))
(defun tramp-gvfs-stringify-dbus-message (message)
"Convert a D-Bus message into readable UTF8 strings, used for traces."
@@ -493,7 +502,7 @@ In case of an error, modify the error message by replacing
`(let ((fuse-file-name (regexp-quote (tramp-gvfs-fuse-file-name ,filename)))
elt)
(condition-case err
- (funcall ,handler ,@args)
+ (tramp-compat-funcall ,handler ,@args)
(error
(setq elt (cdr err))
(while elt
@@ -646,6 +655,10 @@ is no information where to trace the message.")
"Like `file-attributes' for Tramp files."
(file-attributes (tramp-gvfs-fuse-file-name filename) id-format))
+(defun tramp-gvfs-handle-file-directory-p (filename)
+ "Like `file-directory-p' for Tramp files."
+ (file-directory-p (tramp-gvfs-fuse-file-name filename)))
+
(defun tramp-gvfs-handle-file-executable-p (filename)
"Like `file-executable-p' for Tramp files."
(file-executable-p (tramp-gvfs-fuse-file-name filename)))
@@ -1402,6 +1415,10 @@ They are retrieved from the hal daemon."
(tramp-set-completion-function
"synce" '((tramp-synce-parse-device-names "")))
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-gvfs 'force)))
+
(provide 'tramp-gvfs)
;;; TODO:
diff --git a/lisp/net/tramp-gw.el b/lisp/net/tramp-gw.el
index d76cd3b3bc..63dfd105f1 100644
--- a/lisp/net/tramp-gw.el
+++ b/lisp/net/tramp-gw.el
@@ -4,6 +4,7 @@
;; Author: Michael Albinus <[email protected]>
;; Keywords: comm, processes
+;; Package: tramp
;; This file is part of GNU Emacs.
@@ -37,11 +38,6 @@
(require 'cl)
(require 'custom))
-;; Autoload the socks library. It is used only when we access a SOCKS server.
-(autoload 'socks-open-network-stream "socks")
-(defvar socks-username (user-login-name))
-(defvar socks-server (list "Default server" "socks" 1080 5))
-
;; Avoid byte-compiler warnings if the byte-compiler supports this.
;; Currently, XEmacs supports this.
(eval-when-compile
@@ -49,21 +45,29 @@
(byte-compiler-options (warnings (- unused-vars)))))
;; Define HTTP tunnel method ...
-(defvar tramp-gw-tunnel-method "tunnel"
+;;;###tramp-autoload
+(defconst tramp-gw-tunnel-method "tunnel"
"*Method to connect HTTP gateways.")
;; ... and port.
-(defvar tramp-gw-default-tunnel-port 8080
+(defconst tramp-gw-default-tunnel-port 8080
"*Default port for HTTP gateways.")
;; Define SOCKS method ...
-(defvar tramp-gw-socks-method "socks"
+;;;###tramp-autoload
+(defconst tramp-gw-socks-method "socks"
"*Method to connect SOCKS servers.")
;; ... and port.
-(defvar tramp-gw-default-socks-port 1080
+(defconst tramp-gw-default-socks-port 1080
"*Default port for SOCKS servers.")
+;; Autoload the socks library. It is used only when we access a SOCKS server.
+(autoload 'socks-open-network-stream "socks")
+(defvar socks-username (user-login-name))
+(defvar socks-server
+ (list "Default server" "socks" tramp-gw-default-socks-port 5))
+
;; Add a default for `tramp-default-user-alist'. Default is the local user.
(add-to-list 'tramp-default-user-alist
`(,tramp-gw-tunnel-method nil ,(user-login-name)))
@@ -124,6 +128,7 @@
(process-send-string
(tramp-get-connection-property proc "process" nil) string)))
+;;;###tramp-autoload
(defun tramp-gw-open-connection (vec gw-vec target-vec)
"Open a remote connection to VEC (see `tramp-file-name' structure).
Take GW-VEC as SOCKS or HTTP gateway, i.e. its method must be a
@@ -309,6 +314,9 @@ password in password cache. This is done for the first try only."
(format
"Password for %s@[%s]: " socks-username (read (current-buffer)))))))))
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-gw 'force)))
(provide 'tramp-gw)
diff --git a/lisp/net/tramp-imap.el b/lisp/net/tramp-imap.el
index 3e8883d2e0..4a5e2418cf 100644
--- a/lisp/net/tramp-imap.el
+++ b/lisp/net/tramp-imap.el
@@ -4,6 +4,7 @@
;; Author: Teodor Zlatanov <[email protected]>
;; Keywords: mail, comm
+;; Package: tramp
;; This file is part of GNU Emacs.
@@ -54,7 +55,6 @@
(require 'assoc)
(require 'tramp)
-(require 'tramp-compat)
(autoload 'auth-source-user-or-password "auth-source")
(autoload 'epg-context-operation "epg")
@@ -75,21 +75,29 @@
'(add-to-list 'imap-hash-headers 'X-Size 'append))
;; Define Tramp IMAP method ...
+;;;###tramp-autoload
(defconst tramp-imap-method "imap"
"*Method to connect via IMAP protocol.")
-(add-to-list 'tramp-methods (list tramp-imap-method '(tramp-default-port 143)))
+;;;###tramp-autoload
+(when (and (locate-library "epa") (locate-library "imap-hash"))
+ (add-to-list 'tramp-methods
+ (list tramp-imap-method '(tramp-default-port 143))))
;; Add a default for `tramp-default-user-alist'. Default is the local user.
(add-to-list 'tramp-default-user-alist
`(,tramp-imap-method nil ,(user-login-name)))
;; Define Tramp IMAPS method ...
+;;;###tramp-autoload
(defconst tramp-imaps-method "imaps"
"*Method to connect via secure IMAP protocol.")
;; ... and add it to the method list.
-(add-to-list 'tramp-methods (list tramp-imaps-method '(tramp-default-port 993)))
+;;;###tramp-autoload
+(when (and (locate-library "epa") (locate-library "imap-hash"))
+ (add-to-list 'tramp-methods
+ (list tramp-imaps-method '(tramp-default-port 993))))
;; Add a default for `tramp-default-user-alist'. Default is the local user.
(add-to-list 'tramp-default-user-alist
@@ -183,13 +191,15 @@ Operations not mentioned here will be handled by the default Emacs primitives.")
(defvar tramp-imap-passphrase-cache nil) ;; can be t or 'never
(defvar tramp-imap-passphrase nil)
-(defun tramp-imap-file-name-p (filename)
+;;;###tramp-autoload
+(defsubst tramp-imap-file-name-p (filename)
"Check if it's a filename for IMAP protocol."
(let ((v (tramp-dissect-file-name filename)))
(or
(string= (tramp-file-name-method v) tramp-imap-method)
(string= (tramp-file-name-method v) tramp-imaps-method))))
+;;;###tramp-autoload
(defun tramp-imap-file-name-handler (operation &rest args)
"Invoke the IMAP related OPERATION.
First arg specifies the OPERATION, second arg is a list of arguments to
@@ -199,8 +209,10 @@ pass to the OPERATION."
(save-match-data (apply (cdr fn) args))
(tramp-run-real-handler operation args))))
-(add-to-list 'tramp-foreign-file-name-handler-alist
- (cons 'tramp-imap-file-name-p 'tramp-imap-file-name-handler))
+;;;###tramp-autoload
+(when (and (locate-library "epa") (locate-library "imap-hash"))
+ (add-to-list 'tramp-foreign-file-name-handler-alist
+ (cons 'tramp-imap-file-name-p 'tramp-imap-file-name-handler)))
(defun tramp-imap-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
@@ -775,6 +787,10 @@ With NEEDED-SUBJECT, alters the imap-hash test accordingly."
tramp-imap-subject-marker
(if needed-subject needed-subject "")))))
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-imap 'force)))
+
;;; TODO:
;; * Implement `tramp-imap-handle-delete-directory',
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index f1ec7a9b81..84d1197211 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -5,6 +5,7 @@
;; Author: Michael Albinus <[email protected]>
;; Keywords: comm, processes
+;; Package: tramp
;; This file is part of GNU Emacs.
@@ -29,17 +30,16 @@
(eval-when-compile (require 'cl)) ; block, return
(require 'tramp)
-(require 'tramp-cache)
-(require 'tramp-compat)
;; Define SMB method ...
-(defcustom tramp-smb-method "smb"
- "*Method to connect SAMBA and M$ SMB servers."
- :group 'tramp
- :type 'string)
+;;;###tramp-autoload
+(defconst tramp-smb-method "smb"
+ "*Method to connect SAMBA and M$ SMB servers.")
;; ... and add it to the method list.
-(add-to-list 'tramp-methods (cons tramp-smb-method nil))
+;;;###tramp-autoload
+(unless (memq system-type '(cygwin windows-nt))
+ (add-to-list 'tramp-methods (cons tramp-smb-method nil)))
;; Add a default for `tramp-default-method-alist'. Rule: If there is
;; a domain in USER, it must be the SMB method.
@@ -204,11 +204,13 @@ See `tramp-actions-before-shell' for more info.")
"Alist of handler functions for Tramp SMB method.
Operations not mentioned here will be handled by the default Emacs primitives.")
-(defun tramp-smb-file-name-p (filename)
+;;;###tramp-autoload
+(defsubst tramp-smb-file-name-p (filename)
"Check if it's a filename for SMB servers."
(let ((v (tramp-dissect-file-name filename)))
(string= (tramp-file-name-method v) tramp-smb-method)))
+;;;###tramp-autoload
(defun tramp-smb-file-name-handler (operation &rest args)
"Invoke the SMB related OPERATION.
First arg specifies the OPERATION, second arg is a list of arguments to
@@ -218,8 +220,10 @@ pass to the OPERATION."
(save-match-data (apply (cdr fn) args))
(tramp-run-real-handler operation args))))
-(add-to-list 'tramp-foreign-file-name-handler-alist
- (cons 'tramp-smb-file-name-p 'tramp-smb-file-name-handler))
+;;;###tramp-autoload
+(unless (memq system-type '(cygwin windows-nt))
+ (add-to-list 'tramp-foreign-file-name-handler-alist
+ (cons 'tramp-smb-file-name-p 'tramp-smb-file-name-handler)))
;; File name primitives.
@@ -783,7 +787,7 @@ PRESERVE-UID-GID is completely ignored."
(if (tramp-smb-get-cifs-capabilities v)
(format
"posix_mkdir \"%s\" %s"
- file (tramp-decimal-to-octal (default-file-modes)))
+ file (tramp-compat-decimal-to-octal (default-file-modes)))
(format "mkdir \"%s\"" file)))
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
@@ -892,7 +896,7 @@ target of the symlink differ."
(unless (tramp-smb-send-command
v (format "chmod \"%s\" %s"
(tramp-smb-get-localname v)
- (tramp-decimal-to-octal mode)))
+ (tramp-compat-decimal-to-octal mode)))
(tramp-error
v 'file-error "Error while changing file's mode %s" filename)))))
@@ -1396,6 +1400,9 @@ Returns nil if an error message has appeared."
(tramp-message vec 6 "\n%s" (buffer-string))
(not err))))
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-smb 'force)))
(provide 'tramp-smb)
diff --git a/lisp/net/tramp-uu.el b/lisp/net/tramp-uu.el
index 4b64387a8b..fe6862c924 100644
--- a/lisp/net/tramp-uu.el
+++ b/lisp/net/tramp-uu.el
@@ -1,10 +1,11 @@
;;; tramp-uu.el --- uuencode in Lisp
-;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007,
-;; 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008,
+;; 2009, 2010 Free Software Foundation, Inc.
;; Author: Kai Großjohann <[email protected]>
;; Keywords: comm, terminals
+;; Package: tramp
;; This file is part of GNU Emacs.
@@ -49,6 +50,7 @@
"Return the byte that is encoded as CHAR."
(cdr (assq char tramp-uu-b64-char-to-byte)))
+;;;###tramp-autoload
(defun tramp-uuencode-region (beg end)
"UU-encode the region between BEG and END."
;; First we base64 encode the region, then we transmogrify that into
@@ -86,6 +88,10 @@
(goto-char beg)
(insert "begin 600 xxx\n"))))
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-uu 'force)))
+
(provide 'tramp-uu)
;; arch-tag: 7153f2c6-8be5-4cd2-8c06-0fbcf5190ef6
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index e715ef596d..86ece233fa 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -1,3 +1,4 @@
+(setq tramp-version 24)
;;; tramp.el --- Transparent Remote Access, Multiple Protocol
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
@@ -8,6 +9,7 @@
;; Author: Kai Großjohann <[email protected]>
;; Michael Albinus <[email protected]>
;; Keywords: comm, processes
+;; Package: tramp
;; This file is part of GNU Emacs.
@@ -66,18 +68,7 @@
(when (and load-in-progress (null (current-message)))
(message "Loading tramp..."))
-;; The Tramp version number and bug report address, as prepared by configure.
-(require 'trampver)
-(add-hook 'tramp-unload-hook
- (lambda ()
- (when (featurep 'trampver)
- (unload-feature 'trampver 'force))))
-
(require 'tramp-compat)
-(add-hook 'tramp-unload-hook
- (lambda ()
- (when (featurep 'tramp-compat)
- (unload-feature 'tramp-compat 'force))))
(require 'format-spec)
;; As long as password.el is not part of (X)Emacs, it shouldn't
@@ -95,82 +86,8 @@
(load "auth-source" 'noerror)
(require 'auth-source nil 'noerror)))
-;; Requiring 'tramp-cache results in an endless loop.
-(autoload 'tramp-get-file-property "tramp-cache")
-(autoload 'tramp-set-file-property "tramp-cache")
-(autoload 'tramp-flush-file-property "tramp-cache")
-(autoload 'tramp-flush-directory-property "tramp-cache")
-(autoload 'tramp-get-connection-property "tramp-cache")
-(autoload 'tramp-set-connection-property "tramp-cache")
-(autoload 'tramp-flush-connection-property "tramp-cache")
-(autoload 'tramp-parse-connection-properties "tramp-cache")
-(add-hook 'tramp-unload-hook
- (lambda ()
- (when (featurep 'tramp-cache)
- (unload-feature 'tramp-cache 'force))))
-
-(autoload 'tramp-uuencode-region "tramp-uu"
- "Implementation of `uuencode' in Lisp.")
-(add-hook 'tramp-unload-hook
- (lambda ()
- (when (featurep 'tramp-uu)
- (unload-feature 'tramp-uu 'force))))
-
(autoload 'uudecode-decode-region "uudecode")
-;; The following Tramp packages must be loaded after tramp.el, because
-;; they require it as well.
-(eval-after-load "tramp"
- '(dolist
- (feature
- (list
-
- ;; Tramp interactive commands.
- 'tramp-cmds
-
- ;; Load foreign FTP method.
- (if (featurep 'xemacs) 'tramp-efs 'tramp-ftp)
-
- ;; tramp-smb uses "smbclient" from Samba. Not available
- ;; under Cygwin and Windows, because they don't offer
- ;; "smbclient". And even not necessary there, because Emacs
- ;; supports UNC file names like "//host/share/localname".
- (unless (memq system-type '(cygwin windows-nt)) 'tramp-smb)
-
- ;; Load foreign FISH method.
- 'tramp-fish
-
- ;; tramp-gvfs needs D-Bus messages. Available since Emacs 23
- ;; on some system types. We don't call `dbus-ping', because
- ;; this would load dbus.el.
- (when (and (featurep 'dbusbind)
- (condition-case nil
- (tramp-compat-funcall 'dbus-get-unique-name :session)
- (error nil))
- (tramp-compat-process-running-p "gvfs-fuse-daemon"))
- 'tramp-gvfs)
-
- ;; Load gateways. It needs `make-network-process' from Emacs 22.
- (when (functionp 'make-network-process) 'tramp-gw)
-
- ;; tramp-imap needs both epa (from Emacs 23.1) and imap-hash
- ;; (from Emacs 23.2).
- (when (and (locate-library "epa") (locate-library "imap-hash"))
- 'tramp-imap)))
-
- (when feature
- ;; We have used just some basic tests, whether a package shall
- ;; be added. There might still be other errors during loading,
- ;; which we will catch here.
- (catch 'tramp-loading
- (require feature)
- (add-hook 'tramp-unload-hook
- `(lambda ()
- (when (featurep (quote ,feature))
- (unload-feature (quote ,feature) 'force)))))
- (unless (featurep feature)
- (message "Loading %s failed, ignoring this package" feature)))))
-
;;; User Customizable Internal Variables:
(defgroup tramp nil
@@ -300,6 +217,7 @@ If it is nil, inline out-of-the-band copy will be used without a check."
:group 'tramp
:type '(choice (const nil) integer))
+;;;###tramp-autoload
(defcustom tramp-terminal-type "dumb"
"*Value of TERM environment variable for logging in to remote host.
Because Tramp wants to parse the output of the remote shell, it is easily
@@ -320,9 +238,11 @@ files conditionalize this setup based on the TERM environment variable."
The '$' character at the end is quoted; the string cannot be
detected as prompt when being sent on echoing hosts, therefore.")
+;;;###tramp-autoload
(defconst tramp-initial-end-of-output "#$ "
"Prompt when establishing a connection.")
+;;;###tramp-autoload
(defvar tramp-methods
`(("rcp" (tramp-login-program "rsh")
(tramp-login-args (("%h") ("-l" "%u")))
@@ -2097,6 +2017,7 @@ mentioned here will be handled by `tramp-file-name-handler-alist' or the
normal Emacs functions.")
;; Handlers for foreign methods, like FTP or SMB, shall be plugged here.
+;;;###tramp-autoload
(defvar tramp-foreign-file-name-handler-alist
;; (identity . tramp-sh-file-name-handler) should always be the last
;; entry, because `identity' always matches.
@@ -2107,6 +2028,257 @@ calling HANDLER.")
;;; Internal functions which must come first:
+
+;; ------------------------------------------------------------
+;; -- Tramp file names --
+;; ------------------------------------------------------------
+;; Conversion functions between external representation and
+;; internal data structure. Convenience functions for internal
+;; data structure.
+
+(defun tramp-file-name-p (vec)
+ "Check, whether VEC is a Tramp object."
+ (and (vectorp vec) (= 4 (length vec))))
+
+(defun tramp-file-name-method (vec)
+ "Return method component of VEC."
+ (and (tramp-file-name-p vec) (aref vec 0)))
+
+(defun tramp-file-name-user (vec)
+ "Return user component of VEC."
+ (and (tramp-file-name-p vec) (aref vec 1)))
+
+(defun tramp-file-name-host (vec)
+ "Return host component of VEC."
+ (and (tramp-file-name-p vec) (aref vec 2)))
+
+(defun tramp-file-name-localname (vec)
+ "Return localname component of VEC."
+ (and (tramp-file-name-p vec) (aref vec 3)))
+
+;; The user part of a Tramp file name vector can be of kind
+;; "user%domain". Sometimes, we must extract these parts.
+(defun tramp-file-name-real-user (vec)
+ "Return the user name of VEC without domain."
+ (save-match-data
+ (let ((user (tramp-file-name-user vec)))
+ (if (and (stringp user)
+ (string-match tramp-user-with-domain-regexp user))
+ (match-string 1 user)
+ user))))
+
+(defun tramp-file-name-domain (vec)
+ "Return the domain name of VEC."
+ (save-match-data
+ (let ((user (tramp-file-name-user vec)))
+ (and (stringp user)
+ (string-match tramp-user-with-domain-regexp user)
+ (match-string 2 user)))))
+
+;; The host part of a Tramp file name vector can be of kind
+;; "host#port". Sometimes, we must extract these parts.
+(defun tramp-file-name-real-host (vec)
+ "Return the host name of VEC without port."
+ (save-match-data
+ (let ((host (tramp-file-name-host vec)))
+ (if (and (stringp host)
+ (string-match tramp-host-with-port-regexp host))
+ (match-string 1 host)
+ host))))
+
+(defun tramp-file-name-port (vec)
+ "Return the port number of VEC."
+ (save-match-data
+ (let ((host (tramp-file-name-host vec)))
+ (and (stringp host)
+ (string-match tramp-host-with-port-regexp host)
+ (string-to-number (match-string 2 host))))))
+
+;;;###tramp-autoload
+(defun tramp-tramp-file-p (name)
+ "Return t if NAME is a string with Tramp file name syntax."
+ (save-match-data
+ (and (stringp name) (string-match tramp-file-name-regexp name))))
+
+(defun tramp-find-method (method user host)
+ "Return the right method string to use.
+This is METHOD, if non-nil. Otherwise, do a lookup in
+`tramp-default-method-alist'."
+ (or method
+ (let ((choices tramp-default-method-alist)
+ lmethod item)
+ (while choices
+ (setq item (pop choices))
+ (when (and (string-match (or (nth 0 item) "") (or host ""))
+ (string-match (or (nth 1 item) "") (or user "")))
+ (setq lmethod (nth 2 item))
+ (setq choices nil)))
+ lmethod)
+ tramp-default-method))
+
+(defun tramp-find-user (method user host)
+ "Return the right user string to use.
+This is USER, if non-nil. Otherwise, do a lookup in
+`tramp-default-user-alist'."
+ (or user
+ (let ((choices tramp-default-user-alist)
+ luser item)
+ (while choices
+ (setq item (pop choices))
+ (when (and (string-match (or (nth 0 item) "") (or method ""))
+ (string-match (or (nth 1 item) "") (or host "")))
+ (setq luser (nth 2 item))
+ (setq choices nil)))
+ luser)
+ tramp-default-user))
+
+(defun tramp-find-host (method user host)
+ "Return the right host string to use.
+This is HOST, if non-nil. Otherwise, it is `tramp-default-host'."
+ (or (and (> (length host) 0) host)
+ tramp-default-host))
+
+(defun tramp-dissect-file-name (name &optional nodefault)
+ "Return a `tramp-file-name' structure.
+The structure consists of remote method, remote user, remote host
+and localname (file name on remote host). If NODEFAULT is
+non-nil, the file name parts are not expanded to their default
+values."
+ (save-match-data
+ (let ((match (string-match (nth 0 tramp-file-name-structure) name)))
+ (unless match (error "Not a Tramp file name: %s" name))
+ (let ((method (match-string (nth 1 tramp-file-name-structure) name))
+ (user (match-string (nth 2 tramp-file-name-structure) name))
+ (host (match-string (nth 3 tramp-file-name-structure) name))
+ (localname (match-string (nth 4 tramp-file-name-structure) name)))
+ (when (member method '("multi" "multiu"))
+ (error
+ "`%s' method is no longer supported, see (info \"(tramp)Multi-hops\")"
+ method))
+ (when host
+ (when (string-match tramp-prefix-ipv6-regexp host)
+ (setq host (replace-match "" nil t host)))
+ (when (string-match tramp-postfix-ipv6-regexp host)
+ (setq host (replace-match "" nil t host))))
+ (if nodefault
+ (vector method user host localname)
+ (vector
+ (tramp-find-method method user host)
+ (tramp-find-user method user host)
+ (tramp-find-host method user host)
+ localname))))))
+
+(defun tramp-buffer-name (vec)
+ "A name for the connection buffer VEC."
+ ;; We must use `tramp-file-name-real-host', because for gateway
+ ;; methods the default port will be expanded later on, which would
+ ;; tamper the name.
+ (let ((method (tramp-file-name-method vec))
+ (user (tramp-file-name-user vec))
+ (host (tramp-file-name-real-host vec)))
+ (if (not (zerop (length user)))
+ (format "*tramp/%s %s@%s*" method user host)
+ (format "*tramp/%s %s*" method host))))
+
+(defun tramp-make-tramp-file-name (method user host localname)
+ "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME."
+ (concat tramp-prefix-format
+ (when (not (zerop (length method)))
+ (concat method tramp-postfix-method-format))
+ (when (not (zerop (length user)))
+ (concat user tramp-postfix-user-format))
+ (when host
+ (if (string-match tramp-ipv6-regexp host)
+ (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
+ host))
+ tramp-postfix-host-format
+ (when localname localname)))
+
+(defun tramp-completion-make-tramp-file-name (method user host localname)
+ "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME.
+It must not be a complete Tramp file name, but as long as there are
+necessary only. This function will be used in file name completion."
+ (concat tramp-prefix-format
+ (when (not (zerop (length method)))
+ (concat method tramp-postfix-method-format))
+ (when (not (zerop (length user)))
+ (concat user tramp-postfix-user-format))
+ (when (not (zerop (length host)))
+ (concat
+ (if (string-match tramp-ipv6-regexp host)
+ (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
+ host)
+ tramp-postfix-host-format))
+ (when localname localname)))
+
+(defun tramp-get-buffer (vec)
+ "Get the connection buffer to be used for VEC."
+ (or (get-buffer (tramp-buffer-name vec))
+ (with-current-buffer (get-buffer-create (tramp-buffer-name vec))
+ (setq buffer-undo-list t)
+ (setq default-directory
+ (tramp-make-tramp-file-name
+ (tramp-file-name-method vec)
+ (tramp-file-name-user vec)
+ (tramp-file-name-host vec)
+ "/"))
+ (current-buffer))))
+
+(defun tramp-get-connection-buffer (vec)
+ "Get the connection buffer to be used for VEC.
+In case a second asynchronous communication has been started, it is different
+from `tramp-get-buffer'."
+ (or (tramp-get-connection-property vec "process-buffer" nil)
+ (tramp-get-buffer vec)))
+
+(defun tramp-get-connection-process (vec)
+ "Get the connection process to be used for VEC.
+In case a second asynchronous communication has been started, it is different
+from the default one."
+ (get-process
+ (or (tramp-get-connection-property vec "process-name" nil)
+ (tramp-buffer-name vec))))
+
+(defun tramp-debug-buffer-name (vec)
+ "A name for the debug buffer for VEC."
+ ;; We must use `tramp-file-name-real-host', because for gateway
+ ;; methods the default port will be expanded later on, which would
+ ;; tamper the name.
+ (let ((method (tramp-file-name-method vec))
+ (user (tramp-file-name-user vec))
+ (host (tramp-file-name-real-host vec)))
+ (if (not (zerop (length user)))
+ (format "*debug tramp/%s %s@%s*" method user host)
+ (format "*debug tramp/%s %s*" method host))))
+
+(defconst tramp-debug-outline-regexp
+ "[0-9]+:[0-9]+:[0-9]+\\.[0-9]+ [a-z0-9-]+ (\\([0-9]+\\)) #")
+
+(defun tramp-get-debug-buffer (vec)
+ "Get the debug buffer for VEC."
+ (with-current-buffer
+ (get-buffer-create (tramp-debug-buffer-name vec))
+ (when (bobp)
+ (setq buffer-undo-list t)
+ ;; Activate `outline-mode'. This runs `text-mode-hook' and
+ ;; `outline-mode-hook'. We must prevent that local processes
+ ;; die. Yes: I've seen `flyspell-mode', which starts "ispell".
+ ;; Furthermore, `outline-regexp' must have the correct value
+ ;; already, because it is used by `font-lock-compile-keywords'.
+ (let ((default-directory (tramp-compat-temporary-file-directory))
+ (outline-regexp tramp-debug-outline-regexp))
+ (outline-mode))
+ (set (make-local-variable 'outline-regexp) tramp-debug-outline-regexp)
+ (set (make-local-variable 'outline-level) 'tramp-outline-level))
+ (current-buffer)))
+
+(defun tramp-outline-level ()
+ "Return the depth to which a statement is nested in the outline.
+Point must be at the beginning of a header line.
+
+The outline level is equal to the verbosity of the Tramp message."
+ (1+ (string-to-number (match-string 1))))
+
(defsubst tramp-debug-message (vec fmt-string &rest args)
"Append message to debug buffer.
Message is formatted with FMT-STRING as control string and the remaining
@@ -2266,39 +2438,6 @@ If VAR is nil, then we bind `v' to the structure and `method', `user',
(put 'with-parsed-tramp-file-name 'edebug-form-spec '(form symbolp body))
(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>"))
-(defmacro with-file-property (vec file property &rest body)
- "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache.
-FILE must be a local file name on a connection identified via VEC."
- `(if (file-name-absolute-p ,file)
- (let ((value (tramp-get-file-property ,vec ,file ,property 'undef)))
- (when (eq value 'undef)
- ;; We cannot pass @body as parameter to
- ;; `tramp-set-file-property' because it mangles our
- ;; debug messages.
- (setq value (progn ,@body))
- (tramp-set-file-property ,vec ,file ,property value))
- value)
- ,@body))
-
-(put 'with-file-property 'lisp-indent-function 3)
-(put 'with-file-property 'edebug-form-spec t)
-(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-file-property\\>"))
-
-(defmacro with-connection-property (key property &rest body)
- "Check in Tramp for property PROPERTY, otherwise executes BODY and set."
- `(let ((value (tramp-get-connection-property ,key ,property 'undef)))
- (when (eq value 'undef)
- ;; We cannot pass ,@body as parameter to
- ;; `tramp-set-connection-property' because it mangles our debug
- ;; messages.
- (setq value (progn ,@body))
- (tramp-set-connection-property ,key ,property value))
- value))
-
-(put 'with-connection-property 'lisp-indent-function 2)
-(put 'with-connection-property 'edebug-form-spec t)
-(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-connection-property\\>"))
-
(defun tramp-progress-reporter-update (reporter &optional value)
(let* ((parameters (cdr reporter))
(message (aref parameters 3)))
@@ -2374,7 +2513,7 @@ Return the local name of the temporary file."
(setq result nil)
;; This creates the file by side effect.
(set-file-times result)
- (set-file-modes result (tramp-octal-to-decimal "0700"))))
+ (set-file-modes result (tramp-compat-octal-to-decimal "0700"))))
;; Return the local part.
(with-parsed-tramp-file-name result nil localname)))
@@ -2414,7 +2553,7 @@ Example:
;; Windows registry.
(and (memq system-type '(cygwin windows-nt))
(zerop
- (tramp-local-call-process
+ (tramp-compat-call-process
"reg" nil nil nil "query" (nth 1 (car v)))))
;; Configuration file.
(file-exists-p (nth 1 (car v)))))
@@ -2552,7 +2691,7 @@ target of the symlink differ."
(unless ln
(tramp-error
l 'file-error
- "Making a symbolic link. ln(1) does not exist on the remote host."))
+ "Making a symbolic link. ln(1) does not exist on the remote host."))
;; Do the 'confirm if exists' thing.
(when (file-exists-p linkname)
@@ -2573,6 +2712,9 @@ target of the symlink differ."
(tramp-file-name-localname
(tramp-dissect-file-name (expand-file-name filename)))))
+ (tramp-flush-file-property l (file-name-directory l-localname))
+ (tramp-flush-file-property l l-localname)
+
;; Right, they are on the same host, regardless of user, method, etc.
;; We now make the link on the remote machine. This will occur as the user
;; that FILENAME belongs to.
@@ -3023,7 +3165,7 @@ of."
(unless (zerop (tramp-send-command-and-check
v
(format "chmod %s %s"
- (tramp-decimal-to-octal mode)
+ (tramp-compat-decimal-to-octal mode)
(tramp-shell-quote-argument localname))))
;; FIXME: extract the proper text from chmod's stderr.
(tramp-error
@@ -3054,7 +3196,7 @@ of."
;; We handle also the local part, because in older Emacsen,
;; without `set-file-times', this function is an alias for this.
;; We are local, so we don't need the UTC settings.
- (tramp-local-call-process
+ (tramp-compat-call-process
"touch" nil nil nil "-t"
(format-time-string "%Y%m%d%H%M.%S" time)
(tramp-shell-quote-argument filename)))))
@@ -3087,7 +3229,7 @@ and gid of the corresponding user is taken. Both parameters must be integers."
;; `set-file-uid-gid'. On W32 "chown" might not work.
(let ((uid (or (and (integerp uid) uid) (tramp-get-local-uid 'integer)))
(gid (or (and (integerp gid) gid) (tramp-get-local-gid 'integer))))
- (tramp-local-call-process
+ (tramp-compat-call-process
"chown" nil nil nil
(format "%d:%d" uid gid) (tramp-shell-quote-argument filename))))))
@@ -3215,7 +3357,7 @@ and gid of the corresponding user is taken. Both parameters must be integers."
If the file modes of FILENAME cannot be determined, return the
value of `default-file-modes', without execute permissions."
(or (file-modes filename)
- (logand (default-file-modes) (tramp-octal-to-decimal "0666"))))
+ (logand (default-file-modes) (tramp-compat-octal-to-decimal "0666"))))
(defun tramp-handle-file-directory-p (filename)
"Like `file-directory-p' for Tramp files."
@@ -3902,7 +4044,8 @@ the uid and gid from FILENAME."
;; Since this does not work reliable, we also
;; give read permissions.
(set-file-modes
- (concat prefix tmpfile) (tramp-octal-to-decimal "0777"))
+ (concat prefix tmpfile)
+ (tramp-compat-octal-to-decimal "0777"))
(tramp-set-file-uid-gid
(concat prefix tmpfile)
(tramp-get-local-uid 'integer)
@@ -3918,7 +4061,8 @@ the uid and gid from FILENAME."
;; We must change the ownership as local user.
;; Since this does not work reliable, we also
;; give read permissions.
- (set-file-modes tmpfile (tramp-octal-to-decimal "0777"))
+ (set-file-modes
+ tmpfile (tramp-compat-octal-to-decimal "0777"))
(tramp-set-file-uid-gid
tmpfile
(tramp-get-remote-uid v 'integer)
@@ -4638,7 +4782,9 @@ beginning of local filename are not substituted."
(setq outbuf (current-buffer))))
(when stderr (setq command (format "%s 2>%s" command stderr)))
- ;; Send the command. It might not return in time, so we protect it.
+ ;; Send the command. It might not return in time, so we protect
+ ;; it. Call it in a subshell, in order to preserve working
+ ;; directory.
(condition-case nil
(unwind-protect
(setq ret
@@ -4646,7 +4792,7 @@ beginning of local filename are not substituted."
v (format "\\cd %s; %s"
(tramp-shell-quote-argument localname)
command)
- nil t))
+ t t))
;; We should show the output anyway.
(when outbuf
(with-current-buffer outbuf
@@ -4684,20 +4830,6 @@ beginning of local filename are not substituted."
(keyboard-quit)
ret))))
-(defun tramp-local-call-process
- (program &optional infile destination display &rest args)
- "Calls `call-process' on the local host.
-This is needed because for some Emacs flavors Tramp has
-defadviced `call-process' to behave like `process-file'. The
-Lisp error raised when PROGRAM is nil is trapped also, returning 1."
- (let ((default-directory
- (if (file-remote-p default-directory)
- (tramp-compat-temporary-file-directory)
- default-directory)))
- (if (executable-find program)
- (apply 'call-process program infile destination display args)
- 1)))
-
(defun tramp-handle-call-process-region
(start end program &optional delete buffer display &rest args)
"Like `call-process-region' for Tramp files."
@@ -4767,7 +4899,7 @@ Lisp error raised when PROGRAM is nil is trapped also, returning 1."
;; Display output.
(pop-to-buffer output-buffer)
(setq mode-line-process '(":%s"))
- (require 'shell) (shell-mode))
+ (shell-mode))
(prog1
;; Run the process.
@@ -4976,7 +5108,7 @@ coding system might not be determined. This function repairs it."
;; When the file is not readable for the owner, it
;; cannot be inserted, even it is redable for the group
;; or for everybody.
- (set-file-modes local-copy (tramp-octal-to-decimal "0600"))
+ (set-file-modes local-copy (tramp-compat-octal-to-decimal "0600"))
(when (and (null remote-copy)
(tramp-get-method-parameter
@@ -5214,7 +5346,8 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
;; Ensure, that it is still readable.
(when modes
(set-file-modes
- tmpfile (logior (or modes 0) (tramp-octal-to-decimal "0400"))))
+ tmpfile
+ (logior (or modes 0) (tramp-compat-octal-to-decimal "0400"))))
;; This is a bit lengthy due to the different methods
;; possible for file transfer. First, we check whether the
@@ -5313,7 +5446,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file."
(erase-buffer)
(and
;; cksum runs locally, if possible.
- (zerop (tramp-local-call-process "cksum" tmpfile t))
+ (zerop (tramp-compat-call-process "cksum" tmpfile t))
;; cksum runs remotely.
(zerop
(tramp-send-command-and-check
@@ -5790,6 +5923,7 @@ should never be set globally, the intention is to let-bind it.")
;; Tramp file name syntax. Maybe another variable should be introduced
;; overwriting this check in such cases. Or we change Tramp file name
;; syntax in order to avoid ambiguities, like in XEmacs ...
+;;;###tramp-autoload
(defun tramp-completion-mode-p ()
"Check, whether method / user name / host name completion is active."
(or
@@ -6339,7 +6473,7 @@ User is always nil."
(let ((default-directory (tramp-compat-temporary-file-directory))
res)
(with-temp-buffer
- (when (zerop (tramp-local-call-process "reg" nil t nil "query" registry))
+ (when (zerop (tramp-compat-call-process "reg" nil t nil "query" registry))
(goto-char (point-min))
(while (not (eobp))
(push (tramp-parse-putty-group registry) res))))
@@ -6414,18 +6548,6 @@ hosts, or files, disagree."
(tramp-shell-quote-argument v1-localname)
(tramp-shell-quote-argument v2-localname))))))
-(defun tramp-buffer-name (vec)
- "A name for the connection buffer VEC."
- ;; We must use `tramp-file-name-real-host', because for gateway
- ;; methods the default port will be expanded later on, which would
- ;; tamper the name.
- (let ((method (tramp-file-name-method vec))
- (user (tramp-file-name-user vec))
- (host (tramp-file-name-real-host vec)))
- (if (not (zerop (length user)))
- (format "*tramp/%s %s@%s*" method user host)
- (format "*tramp/%s %s*" method host))))
-
(defun tramp-delete-temp-file-function ()
"Remove temporary files related to current buffer."
(when (stringp tramp-temp-buffer-file-name)
@@ -6439,74 +6561,6 @@ hosts, or files, disagree."
(remove-hook 'kill-buffer-hook
'tramp-delete-temp-file-function)))
-(defun tramp-get-buffer (vec)
- "Get the connection buffer to be used for VEC."
- (or (get-buffer (tramp-buffer-name vec))
- (with-current-buffer (get-buffer-create (tramp-buffer-name vec))
- (setq buffer-undo-list t)
- (setq default-directory
- (tramp-make-tramp-file-name
- (tramp-file-name-method vec)
- (tramp-file-name-user vec)
- (tramp-file-name-host vec)
- "/"))
- (current-buffer))))
-
-(defun tramp-get-connection-buffer (vec)
- "Get the connection buffer to be used for VEC.
-In case a second asynchronous communication has been started, it is different
-from `tramp-get-buffer'."
- (or (tramp-get-connection-property vec "process-buffer" nil)
- (tramp-get-buffer vec)))
-
-(defun tramp-get-connection-process (vec)
- "Get the connection process to be used for VEC.
-In case a second asynchronous communication has been started, it is different
-from the default one."
- (get-process
- (or (tramp-get-connection-property vec "process-name" nil)
- (tramp-buffer-name vec))))
-
-(defun tramp-debug-buffer-name (vec)
- "A name for the debug buffer for VEC."
- ;; We must use `tramp-file-name-real-host', because for gateway
- ;; methods the default port will be expanded later on, which would
- ;; tamper the name.
- (let ((method (tramp-file-name-method vec))
- (user (tramp-file-name-user vec))
- (host (tramp-file-name-real-host vec)))
- (if (not (zerop (length user)))
- (format "*debug tramp/%s %s@%s*" method user host)
- (format "*debug tramp/%s %s*" method host))))
-
-(defconst tramp-debug-outline-regexp
- "[0-9]+:[0-9]+:[0-9]+\\.[0-9]+ [a-z0-9-]+ (\\([0-9]+\\)) #")
-
-(defun tramp-get-debug-buffer (vec)
- "Get the debug buffer for VEC."
- (with-current-buffer
- (get-buffer-create (tramp-debug-buffer-name vec))
- (when (bobp)
- (setq buffer-undo-list t)
- ;; Activate `outline-mode'. This runs `text-mode-hook' and
- ;; `outline-mode-hook'. We must prevent that local processes
- ;; die. Yes: I've seen `flyspell-mode', which starts "ispell".
- ;; Furthermore, `outline-regexp' must have the correct value
- ;; already, because it is used by `font-lock-compile-keywords'.
- (let ((default-directory (tramp-compat-temporary-file-directory))
- (outline-regexp tramp-debug-outline-regexp))
- (outline-mode))
- (set (make-local-variable 'outline-regexp) tramp-debug-outline-regexp)
- (set (make-local-variable 'outline-level) 'tramp-outline-level))
- (current-buffer)))
-
-(defun tramp-outline-level ()
- "Return the depth to which a statement is nested in the outline.
-Point must be at the beginning of a header line.
-
-The outline level is equal to the verbosity of the Tramp message."
- (1+ (string-to-number (match-string 1))))
-
(defun tramp-find-executable
(vec progname dirlist &optional ignore-tilde ignore-path)
"Searches for PROGNAME in $PATH and all directories mentioned in DIRLIST.
@@ -6698,8 +6752,10 @@ file exists and nonzero exit status otherwise."
"Query the user for a password."
(with-current-buffer (process-buffer proc)
(tramp-check-for-regexp proc tramp-password-prompt-regexp)
- (tramp-message vec 3 "Sending %s" (match-string 1)))
- (tramp-enter-password proc))
+ (tramp-message vec 3 "Sending %s" (match-string 1))
+ (tramp-enter-password proc)
+ ;; Hide password prompt.
+ (narrow-to-region (point-max) (point-max))))
(defun tramp-action-succeed (proc vec)
"Signal success in finding shell prompt."
@@ -6810,6 +6866,7 @@ The terminal type can be configured with `tramp-terminal-type'."
(tramp-process-one-action proc vec actions))
(tramp-process-one-action proc vec actions)))))
(with-current-buffer (tramp-get-connection-buffer vec)
+ (widen)
(tramp-message vec 6 "\n%s" (buffer-string)))
(unless (eq exit 'ok)
(tramp-clear-passwd vec)
@@ -7286,7 +7343,7 @@ INPUT can also be nil which means `/dev/null'.
OUTPUT can be a string (which specifies a filename), or t (which
means standard output and thus the current buffer), or nil (which
means discard it)."
- (tramp-local-call-process
+ (tramp-compat-call-process
tramp-encoding-shell
(when (and input (not (string-match "%s" cmd))) input)
(if (eq output t) t nil)
@@ -7389,12 +7446,10 @@ Gateway hops are already opened."
(setq choices tramp-default-proxies-alist)))))
;; Handle gateways.
- (when (and (boundp 'tramp-gw-tunnel-method)
- (string-match (format
- "^\\(%s\\|%s\\)$"
- (symbol-value 'tramp-gw-tunnel-method)
- (symbol-value 'tramp-gw-socks-method))
- (tramp-file-name-method (car target-alist))))
+ (when (string-match
+ (format
+ "^\\(%s\\|%s\\)$" tramp-gw-tunnel-method tramp-gw-socks-method)
+ (tramp-file-name-method (car target-alist)))
(let ((gw (pop target-alist))
(hop (pop target-alist)))
;; Is the method prepared for gateways?
@@ -7691,6 +7746,7 @@ function waits for output unless NOOUTPUT is set."
;; Return value is whether end-of-output sentinel was found.
found)))
+;;;###tramp-autoload
(defun tramp-send-command-and-check
(vec command &optional subshell dont-suppress-err)
"Run COMMAND and check its exit status.
@@ -7799,57 +7855,57 @@ the remote host use line-endings as defined in the variable
(save-match-data
(logior
(cond
- ((char-equal owner-read ?r) (tramp-octal-to-decimal "00400"))
+ ((char-equal owner-read ?r) (tramp-compat-octal-to-decimal "00400"))
((char-equal owner-read ?-) 0)
(t (error "Second char `%c' must be one of `r-'" owner-read)))
(cond
- ((char-equal owner-write ?w) (tramp-octal-to-decimal "00200"))
+ ((char-equal owner-write ?w) (tramp-compat-octal-to-decimal "00200"))
((char-equal owner-write ?-) 0)
(t (error "Third char `%c' must be one of `w-'" owner-write)))
(cond
((char-equal owner-execute-or-setid ?x)
- (tramp-octal-to-decimal "00100"))
+ (tramp-compat-octal-to-decimal "00100"))
((char-equal owner-execute-or-setid ?S)
- (tramp-octal-to-decimal "04000"))
+ (tramp-compat-octal-to-decimal "04000"))
((char-equal owner-execute-or-setid ?s)
- (tramp-octal-to-decimal "04100"))
+ (tramp-compat-octal-to-decimal "04100"))
((char-equal owner-execute-or-setid ?-) 0)
(t (error "Fourth char `%c' must be one of `xsS-'"
owner-execute-or-setid)))
(cond
- ((char-equal group-read ?r) (tramp-octal-to-decimal "00040"))
+ ((char-equal group-read ?r) (tramp-compat-octal-to-decimal "00040"))
((char-equal group-read ?-) 0)
(t (error "Fifth char `%c' must be one of `r-'" group-read)))
(cond
- ((char-equal group-write ?w) (tramp-octal-to-decimal "00020"))
+ ((char-equal group-write ?w) (tramp-compat-octal-to-decimal "00020"))
((char-equal group-write ?-) 0)
(t (error "Sixth char `%c' must be one of `w-'" group-write)))
(cond
((char-equal group-execute-or-setid ?x)
- (tramp-octal-to-decimal "00010"))
+ (tramp-compat-octal-to-decimal "00010"))
((char-equal group-execute-or-setid ?S)
- (tramp-octal-to-decimal "02000"))
+ (tramp-compat-octal-to-decimal "02000"))
((char-equal group-execute-or-setid ?s)
- (tramp-octal-to-decimal "02010"))
+ (tramp-compat-octal-to-decimal "02010"))
((char-equal group-execute-or-setid ?-) 0)
(t (error "Seventh char `%c' must be one of `xsS-'"
group-execute-or-setid)))
(cond
((char-equal other-read ?r)
- (tramp-octal-to-decimal "00004"))
+ (tramp-compat-octal-to-decimal "00004"))
((char-equal other-read ?-) 0)
(t (error "Eighth char `%c' must be one of `r-'" other-read)))
(cond
- ((char-equal other-write ?w) (tramp-octal-to-decimal "00002"))
+ ((char-equal other-write ?w) (tramp-compat-octal-to-decimal "00002"))
((char-equal other-write ?-) 0)
(t (error "Nineth char `%c' must be one of `w-'" other-write)))
(cond
((char-equal other-execute-or-sticky ?x)
- (tramp-octal-to-decimal "00001"))
+ (tramp-compat-octal-to-decimal "00001"))
((char-equal other-execute-or-sticky ?T)
- (tramp-octal-to-decimal "01000"))
+ (tramp-compat-octal-to-decimal "01000"))
((char-equal other-execute-or-sticky ?t)
- (tramp-octal-to-decimal "01001"))
+ (tramp-compat-octal-to-decimal "01001"))
((char-equal other-execute-or-sticky ?-) 0)
(t (error "Tenth char `%c' must be one of `xtT-'"
other-execute-or-sticky)))))))
@@ -8010,24 +8066,6 @@ This is used internally by `tramp-file-mode-from-int'."
(and suid (upcase suid-text)) ; suid, !execute
(and x "x") "-")))) ; !suid
-(defun tramp-decimal-to-octal (i)
- "Return a string consisting of the octal digits of I.
-Not actually used. Use `(format \"%o\" i)' instead?"
- (cond ((< i 0) (error "Cannot convert negative number to octal"))
- ((not (integerp i)) (error "Cannot convert non-integer to octal"))
- ((zerop i) "0")
- (t (concat (tramp-decimal-to-octal (/ i 8))
- (number-to-string (% i 8))))))
-
-;; Kudos to Gerd Moellmann for this suggestion.
-(defun tramp-octal-to-decimal (ostr)
- "Given a string of octal digits, return a decimal number."
- (let ((x (or ostr "")))
- ;; `save-match' is in `tramp-mode-string-to-int' which calls this.
- (unless (string-match "\\`[0-7]*\\'" x)
- (error "Non-octal junk in string `%s'" x))
- (string-to-number ostr 8)))
-
(defun tramp-shell-case-fold (string)
"Converts STRING to shell glob pattern which ignores case."
(mapconcat
@@ -8038,145 +8076,6 @@ Not actually used. Use `(format \"%o\" i)' instead?"
string
""))
-
-;; ------------------------------------------------------------
-;; -- Tramp file names --
-;; ------------------------------------------------------------
-;; Conversion functions between external representation and
-;; internal data structure. Convenience functions for internal
-;; data structure.
-
-(defun tramp-file-name-p (vec)
- "Check, whether VEC is a Tramp object."
- (and (vectorp vec) (= 4 (length vec))))
-
-(defun tramp-file-name-method (vec)
- "Return method component of VEC."
- (and (tramp-file-name-p vec) (aref vec 0)))
-
-(defun tramp-file-name-user (vec)
- "Return user component of VEC."
- (and (tramp-file-name-p vec) (aref vec 1)))
-
-(defun tramp-file-name-host (vec)
- "Return host component of VEC."
- (and (tramp-file-name-p vec) (aref vec 2)))
-
-(defun tramp-file-name-localname (vec)
- "Return localname component of VEC."
- (and (tramp-file-name-p vec) (aref vec 3)))
-
-;; The user part of a Tramp file name vector can be of kind
-;; "user%domain". Sometimes, we must extract these parts.
-(defun tramp-file-name-real-user (vec)
- "Return the user name of VEC without domain."
- (save-match-data
- (let ((user (tramp-file-name-user vec)))
- (if (and (stringp user)
- (string-match tramp-user-with-domain-regexp user))
- (match-string 1 user)
- user))))
-
-(defun tramp-file-name-domain (vec)
- "Return the domain name of VEC."
- (save-match-data
- (let ((user (tramp-file-name-user vec)))
- (and (stringp user)
- (string-match tramp-user-with-domain-regexp user)
- (match-string 2 user)))))
-
-;; The host part of a Tramp file name vector can be of kind
-;; "host#port". Sometimes, we must extract these parts.
-(defun tramp-file-name-real-host (vec)
- "Return the host name of VEC without port."
- (save-match-data
- (let ((host (tramp-file-name-host vec)))
- (if (and (stringp host)
- (string-match tramp-host-with-port-regexp host))
- (match-string 1 host)
- host))))
-
-(defun tramp-file-name-port (vec)
- "Return the port number of VEC."
- (save-match-data
- (let ((host (tramp-file-name-host vec)))
- (and (stringp host)
- (string-match tramp-host-with-port-regexp host)
- (string-to-number (match-string 2 host))))))
-
-(defun tramp-tramp-file-p (name)
- "Return t if NAME is a string with Tramp file name syntax."
- (save-match-data
- (and (stringp name) (string-match tramp-file-name-regexp name))))
-
-(defun tramp-find-method (method user host)
- "Return the right method string to use.
-This is METHOD, if non-nil. Otherwise, do a lookup in
-`tramp-default-method-alist'."
- (or method
- (let ((choices tramp-default-method-alist)
- lmethod item)
- (while choices
- (setq item (pop choices))
- (when (and (string-match (or (nth 0 item) "") (or host ""))
- (string-match (or (nth 1 item) "") (or user "")))
- (setq lmethod (nth 2 item))
- (setq choices nil)))
- lmethod)
- tramp-default-method))
-
-(defun tramp-find-user (method user host)
- "Return the right user string to use.
-This is USER, if non-nil. Otherwise, do a lookup in
-`tramp-default-user-alist'."
- (or user
- (let ((choices tramp-default-user-alist)
- luser item)
- (while choices
- (setq item (pop choices))
- (when (and (string-match (or (nth 0 item) "") (or method ""))
- (string-match (or (nth 1 item) "") (or host "")))
- (setq luser (nth 2 item))
- (setq choices nil)))
- luser)
- tramp-default-user))
-
-(defun tramp-find-host (method user host)
- "Return the right host string to use.
-This is HOST, if non-nil. Otherwise, it is `tramp-default-host'."
- (or (and (> (length host) 0) host)
- tramp-default-host))
-
-(defun tramp-dissect-file-name (name &optional nodefault)
- "Return a `tramp-file-name' structure.
-The structure consists of remote method, remote user, remote host
-and localname (file name on remote host). If NODEFAULT is
-non-nil, the file name parts are not expanded to their default
-values."
- (save-match-data
- (let ((match (string-match (nth 0 tramp-file-name-structure) name)))
- (unless match (error "Not a Tramp file name: %s" name))
- (let ((method (match-string (nth 1 tramp-file-name-structure) name))
- (user (match-string (nth 2 tramp-file-name-structure) name))
- (host (match-string (nth 3 tramp-file-name-structure) name))
- (localname (match-string (nth 4 tramp-file-name-structure) name)))
- (when (member method '("multi" "multiu"))
- (error
- "`%s' method is no longer supported, see (info \"(tramp)Multi-hops\")"
- method))
- (when host
- (when (string-match tramp-prefix-ipv6-regexp host)
- (setq host (replace-match "" nil t host)))
- (when (string-match tramp-postfix-ipv6-regexp host)
- (setq host (replace-match "" nil t host))))
- (if nodefault
- (vector method user host localname)
- (vector
- (tramp-find-method method user host)
- (tramp-find-user method user host)
- (tramp-find-host method user host)
- localname))))))
-
(defun tramp-equal-remote (file1 file2)
"Check, whether the remote parts of FILE1 and FILE2 are identical.
The check depends on method, user and host name of the files. If
@@ -8195,37 +8094,6 @@ would yield `t'. On the other hand, the following check results in nil:
(stringp (file-remote-p file2))
(string-equal (file-remote-p file1) (file-remote-p file2))))
-(defun tramp-make-tramp-file-name (method user host localname)
- "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME."
- (concat tramp-prefix-format
- (when (not (zerop (length method)))
- (concat method tramp-postfix-method-format))
- (when (not (zerop (length user)))
- (concat user tramp-postfix-user-format))
- (when host
- (if (string-match tramp-ipv6-regexp host)
- (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
- host))
- tramp-postfix-host-format
- (when localname localname)))
-
-(defun tramp-completion-make-tramp-file-name (method user host localname)
- "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME.
-It must not be a complete Tramp file name, but as long as there are
-necessary only. This function will be used in file name completion."
- (concat tramp-prefix-format
- (when (not (zerop (length method)))
- (concat method tramp-postfix-method-format))
- (when (not (zerop (length user)))
- (concat user tramp-postfix-user-format))
- (when (not (zerop (length host)))
- (concat
- (if (string-match tramp-ipv6-regexp host)
- (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
- host)
- tramp-postfix-host-format))
- (when localname localname)))
-
(defun tramp-make-copy-program-file-name (vec)
"Create a file name suitable to be passed to `rcp' and workalikes."
(let ((user (tramp-file-name-user vec))
@@ -8273,6 +8141,7 @@ necessary only. This function will be used in file name completion."
;; Variables local to connection.
+;;;###tramp-autoload
(defun tramp-get-remote-path (vec)
(with-connection-property
;; When `tramp-own-remote-path' is in `tramp-remote-path', we
@@ -8346,6 +8215,7 @@ necessary only. This function will be used in file name completion."
x))
remote-path)))))
+;;;###tramp-autoload
(defun tramp-get-remote-tmpdir (vec)
(with-connection-property vec "tmp-directory"
(let ((dir (tramp-shell-quote-argument "/tmp")))
@@ -8427,6 +8297,7 @@ necessary only. This function will be used in file name completion."
(tramp-message vec 5 "Finding command to check if file exists")
(tramp-find-file-exists-command vec)))
+;;;###tramp-autoload
(defun tramp-get-remote-ln (vec)
(with-connection-property vec "ln"
(tramp-message vec 5 "Finding a suitable `ln' command")
@@ -8674,8 +8545,9 @@ If the `tramp-methods' entry does not exist, return nil."
;; Permissions should be set always, because there might be an old
;; auto-saved file belonging to another original file. This could
;; be a security threat.
- (set-file-modes buffer-auto-save-file-name
- (or (file-modes bfn) (tramp-octal-to-decimal "0600"))))))
+ (set-file-modes
+ buffer-auto-save-file-name
+ (or (file-modes bfn) (tramp-compat-octal-to-decimal "0600"))))))
(unless (and (featurep 'xemacs)
(= emacs-major-version 21)
@@ -8779,7 +8651,6 @@ Return the difference in the format of a time value."
(defun tramp-time-diff (t1 t2)
"Return the difference between the two times, in seconds.
T1 and T2 are time values (as returned by `current-time' for example)."
- ;; Pacify byte-compiler with `symbol-function'.
(cond ((and (fboundp 'subtract-time)
(fboundp 'float-time))
(tramp-compat-funcall
@@ -8855,6 +8726,7 @@ exiting if process is running."
;; CCC: This function should be rewritten so that
;; `shell-quote-argument' is not used. This way, we are safe from
;; changes in `shell-quote-argument'.
+;;;###tramp-autoload
(defun tramp-shell-quote-argument (s)
"Similar to `shell-quote-argument', but groks newlines.
Only works for Bourne-like shells."
@@ -8880,11 +8752,9 @@ Only works for Bourne-like shells."
(defun tramp-unload-tramp ()
"Discard Tramp from loading remote files."
(interactive)
- ;; When Tramp is not loaded yet, its autoloads are still active.
- (tramp-unload-file-name-handlers)
;; ange-ftp settings must be enabled.
(tramp-compat-funcall 'tramp-ftp-enable-ange-ftp)
- ;; Maybe its not loaded yet.
+ ;; Maybe it's not loaded yet.
(condition-case nil
(unload-feature 'tramp 'force)
(error nil)))
@@ -8983,10 +8853,16 @@ Only works for Bourne-like shells."
;; expects English? Or just to set LC_MESSAGES to "C" if Tramp
;; expects only English messages? (Juri Linkov)
;; * Make shadowfile.el grok Tramp filenames. (Bug#4526, Bug#4846)
-;; * Load Tramp subpackages only when needed. (Bug#1529, Bug#5448, Bug#5705)
;; * Try telnet+curl as new method. It might be useful for busybox,
;; without built-in uuencode/uudecode.
;; * Load ~/.emacs_SHELLNAME on the remote host for `shell'.
+;; * I was wondering it it would be possible to use tramp even if I'm
+;; actually using sshfs. But when I launch a command I would like
+;; to get it executed on the remote machine where the files really
+;; are. (Andrea Crotti)
+;; * Run emerge on two remote files. Bug is described here:
+;; <http://www.mail-archive.com/[email protected]/msg01041.html>.
+;; (Bug#6850)
;; Functions for file-name-handler-alist:
;; diff-latest-backup-file -- in diff.el
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 471a344b86..7690e85931 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -6,6 +6,7 @@
;; Author: Kai Großjohann <[email protected]>
;; Keywords: comm, processes
+;; Package: tramp
;; This file is part of GNU Emacs.
@@ -30,16 +31,29 @@
;; version check is defined in macro AC_EMACS_INFO of aclocal.m4;
;; should be changed only there.
-(defconst tramp-version "2.1.19-pre"
+;;;###tramp-autoload
+(defconst tramp-version "2.2.0-pre"
"This version of Tramp.")
+;;;###tramp-autoload
(defconst tramp-bug-report-address "[email protected]"
"Email address to send bug reports to.")
;; Check for (X)Emacs version.
-(let ((x (if (or (>= emacs-major-version 22) (and (featurep 'xemacs) (= emacs-major-version 21) (>= emacs-minor-version 4))) "ok" (format "Tramp 2.1.19-pre is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version)))))))
+(let ((x (if (or (>= emacs-major-version 22)
+ (and (featurep 'xemacs)
+ (= emacs-major-version 21)
+ (>= emacs-minor-version 4)))
+ "ok"
+ (format "Tramp 2.2.0-pre is not fit for %s"
+ (when (string-match "^.*$" (emacs-version))
+ (match-string 0 (emacs-version)))))))
(unless (string-match "\\`ok\\'" x) (error "%s" x)))
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'trampver 'force)))
+
(provide 'trampver)
;; arch-tag: 443576ca-f8f1-4bb1-addc-5c70861e93b1
diff --git a/lisp/newcomment.el b/lisp/newcomment.el
index 5d2da46734..957bab0d27 100644
--- a/lisp/newcomment.el
+++ b/lisp/newcomment.el
@@ -6,6 +6,7 @@
;; Author: code extracted from Emacs-20's simple.el
;; Maintainer: Stefan Monnier <[email protected]>
;; Keywords: comment uncomment
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -945,12 +946,12 @@ indentation to be kept as it was before narrowing."
(delete-char n)
(setq ,bindent (- ,bindent n)))))))))))
-;; Compute the number of extra comment starter characters
-;; (extra semicolons in Lisp mode, extra stars in C mode, etc.)
-;; If ARG is non-nil, just follow ARG.
-;; If the comment-starter is multi-char, just follow ARG.
-;; Otherwise obey comment-add, and double it if EXTRA is non-nil.
(defun comment-add (arg)
+ "Compute the number of extra comment starter characters
+\(extra semicolons in Lisp mode, extra stars in C mode, etc.)
+If ARG is non-nil, just follow ARG.
+If the comment starter is multi-char, just follow ARG.
+Otherwise obey `comment-add'."
(if (and (null arg) (= (string-match "[ \t]*\\'" comment-start) 1))
(* comment-add 1)
(1- (prefix-numeric-value arg))))
diff --git a/lisp/notifications.el b/lisp/notifications.el
index beb63a6311..68db58e54f 100644
--- a/lisp/notifications.el
+++ b/lisp/notifications.el
@@ -42,6 +42,9 @@
(require 'dbus)
+(defconst notifications-specification-version "1.1"
+ "The version of the Desktop Notifications Specification implemented.")
+
(defconst notifications-application-name "Emacs"
"Default application name.")
@@ -151,7 +154,14 @@ Various PARAMS can be set:
:image-data This is a raw data image format which describes the width,
height, rowstride, has alpha, bits per sample, channels and
image data respectively.
+ :image-path This is represented either as a URI (file:// is the
+ only URI schema supported right now) or a name
+ in a freedesktop.org-compliant icon theme.
:sound-file The path to a sound file to play when the notification pops up.
+ :sound-name A themeable named sound from the freedesktop.org sound naming
+ specification to play when the notification pops up.
+ Similar to icon-name,only for sounds. An example would
+ be \"message-new-instant\".
:suppress-sound Causes the server to suppress playing any sounds, if it has
that ability.
:x Specifies the X location on the screen that the notification
@@ -186,7 +196,9 @@ used to manipulate the notification item with
(category (plist-get params :category))
(desktop-entry (plist-get params :desktop-entry))
(image-data (plist-get params :image-data))
+ (image-path (plist-get params :image-path))
(sound-file (plist-get params :sound-file))
+ (sound-name (plist-get params :sound-name))
(suppress-sound (plist-get params :suppress-sound))
(x (plist-get params :x))
(y (plist-get params :y))
@@ -211,10 +223,18 @@ used to manipulate the notification item with
(add-to-list 'hints `(:dict-entry
"image_data"
(:variant :struct ,image-data)) t))
+ (when image-path
+ (add-to-list 'hints `(:dict-entry
+ "image_path"
+ (:variant :string ,image-path)) t))
(when sound-file
(add-to-list 'hints `(:dict-entry
"sound-file"
(:variant :string ,sound-file)) t))
+ (when sound-name
+ (add-to-list 'hints `(:dict-entry
+ "sound-name"
+ (:variant :string ,sound-name)) t))
(when suppress-sound
(add-to-list 'hints `(:dict-entry
"suppress-sound"
diff --git a/lisp/nxml/TODO b/lisp/nxml/TODO
deleted file mode 100644
index a5ac542f94..0000000000
--- a/lisp/nxml/TODO
+++ /dev/null
@@ -1,468 +0,0 @@
-* High priority
-
-** Command to insert an element template, including all required
-attributes and child elements. When there's a choice of elements
-possible, we could insert a comment, and put an overlay on that
-comment that makes it behave like a button with a pop-up menu to
-select the appropriate choice.
-
-** Command to tag a region. With a schema should complete using legal
-tags, but should work without a schema as well.
-
-** Provide a way to conveniently rename an element. With a schema should
-complete using legal tags, but should work without a schema as well.
-
-* Outlining
-
-** Implement C-c C-o C-q.
-
-** Install pre/post command hook for moving out of invisible section.
-
-** Put a modify hook on invisible sections that expands them.
-
-** Integrate dumb folding somehow.
-
-** An element should be able to be its own heading.
-
-** Optimize to avoid complete buffer scan on each command.
-
-** Make it work with HTML-style headings (i.e. level indicated by
-name of heading element rather than depth of section nesting).
-
-** Recognize root element as a section provided it has a title, even
-if it doesn't match section-element-name-regex.
-
-** Support for incremental search automatically making hidden text
-visible.
-
-** Allow title to be an attribute.
-
-** Command that says to recognize the tag at point as a section/heading.
-
-** Explore better ways to determine when an element is a section
-or a heading.
-
-** rng-next-error needs to either ignore invisible portion or reveal it
-(maybe use isearch oriented text properties).
-
-** Errors within hidden section should be highlighted by underlining the
-ellipsis.
-
-** Make indirect buffers work.
-
-** How should nxml-refresh outline recover from non well-formed tags?
-
-** Hide tags in title elements?
-
-** Use overlays instead of text properties for holding outline state?
-Necessary for indirect buffers to work?
-
-** Allow an outline to go in the speedbar.
-
-** Split up outlining manual section into subsections.
-
-** More detail in the manual about each outlining command.
-
-** More menu entries for hiding/showing?
-
-** Indication of many lines have been hidden?
-
-* Locating schemas
-
-** Should rng-validate-mode give the user an opportunity to specify a
-schema if there is currently none? Or should it at least give a hint
-to the user how to specify a non-vacuous schema?
-
-** Support for adding new schemas to schema-locating files. Add
-documentElement and namespace elements.
-
-** C-c C-w should be able to report current type id.
-
-** Implement doctypePublicId.
-
-** Implement typeIdBase.
-
-** Implement typeIdProcessingInstruction.
-
-** Support xml:base.
-
-** Implement group.
-
-** Find preferred prefix from schema-locating files. Get rid of
-rng-preferred-prefix-alist.
-
-** Inserting document element with vacuous schema should complete using
-document elements declared in schema locating files, and set schema
-appropriately.
-
-** Add a ruleType attribute to the <include> element?
-
-** Allow processing instruction in prolog to contain the compact syntax
-schema directly.
-
-** Use RDDL to locate a schema based on the namespace URI.
-
-** Should not prompt to add redundant association to schema locating
-file.
-
-** Command to reload current schema.
-
-* Schema-sensitive features
-
-** Should filter dynamic markup possibilities using schema validity, by
-adding hook to nxml-mode.
-
-** Dynamic markup word should (at least optionally) be able to look in
-other buffers that are using nxml-mode.
-
-** Should clicking on Invalid move to next error if already on an error?
-
-** Take advantage of a:documentation. Needs change to schema format.
-
-** Provide feasible validation (as in Jing) toggle.
-
-** Save the validation state as a property on the error overlay to enable
-more detailed diagnosis.
-
-** Provide an Error Summary buffer showing all the validation errors.
-
-** Pop-up menu. What is useful? Tag a region (should be greyed out if
-the region is not balanced). Suggestions based on error messages.
-
-** Have configurable list of namespace URIs so that we can provide
-namespace URI completion on extension elements or with schema-less
-documents.
-
-** Allow validation to handle XInclude.
-
-** ID/IDREF support.
-
-* Completion
-
-** Make it work with icomplete. Only use a function to complete when
-some of the possible names have undeclared namespaces.
-
-** How should C-return in mixed text work?
-
-** When there's a vacuous schema, C-return after < will insert the
-end-tag. Is this a bug or a feature?
-
-** After completing start-tag, ensure we don't get unhelpful message
-from validation
-
-** Syntax table for completion.
-
-** Should complete start-tag name with a space if namespace attributes
-are required.
-
-** When completing start-tag name with no prefix and it doesn't match
-should try to infer namespace from local name.
-
-** Should completion pay attention to characters after point? If so,
-how?
-
-** When completing start-tag name, add required atts if only one required
-attribute.
-
-** When completing attribute name, add attribute value if only one value
-is possible.
-
-** After attribute-value completion, insert space after close delimiter
-if more attributes are required.
-
-** Complete on enumerated data values in elements.
-
-** When in context that allows only elements, should get tag
-completion without having to type < first.
-
-** When immediately after start-tag name, and name is valid and not
-prefix of any other name, should C-return complete on attribute names?
-
-** When completing attributes, more consistent to ignore all attributes
-after point.
-
-** Inserting attribute value completions needs to be sensitive to what
-delimiter is used so that it quotes the correct character.
-
-** Complete on encoding-names in XML decl.
-
-** Complete namespace declarations by searching for all namespaces
-mentioned in the schema.
-
-* Well-formed XML support
-
-** Deal better with Mule-UCS
-
-** Deal with UTF-8 BOM when reading.
-
-** Complete entity names.
-
-** Provide some support for entity names for MathML.
-
-** Command to repeat the last tag.
-
-** Support for changing between character references and characters.
-Need to check that context is one in which character references are
-allowed. xmltok prolog parsing will need to distinguish parameter
-literals from other kinds of literal.
-
-** Provide a comment command to bind to M-; that works better than the
-normal one.
-
-** Make indenting in a multi-line comment work.
-
-** Structure view. Separate buffer displaying element tree. Be able to
-navigate from structure view to document and vice-versa.
-
-** Flash matching >.
-
-** Smart selection command that selects increasingly large syntactically
-coherent chunks of XML. If point is in an attribute value, first
-select complete value; then if command is repeated, select value plus
-delimiters, then select attribute name as well, then complete
-start-tag, then complete element, then enclosing element, etc.
-
-** ispell integration.
-
-** Block-level items in mixed content should be indented, e.g:
- <para>This is list:
- <ul>
- <li>item</li>
-
-** Provide option to indent like this:
-
-** <para>This is a paragraph
- occupying multiple lines.</para>
-
-** Option to add make a / that closes a start-tag electrically insert a
-space for the XHTML guys.
-
-** C-M-q should work.
-
-* Datatypes
-
-** Figure out workaround for CJK characters with regexps.
-
-** Does category C contain Cn?
-
-** Do ENTITY datatype properly.
-
-* XML Parsing Library
-
-** Parameter entity parsing option, nil (never), t (always),
-unless-standalone (unless standalone="yes" in XML declaration).
-
-** When a file is currently being edited, there should be an option to
-use its buffer instead of the on-disk copy.
-
-* Handling all XML features
-
-** Provide better support for editing external general parsed entities.
-Perhaps provide a way to force ignoring undefined entities; maybe turn
-this on automatically with <?xml encoding=""?> (with no version
-pseudo-att).
-
-** Handle internal general entity declarations containing elements.
-
-** Handle external general entity declarations.
-
-** Handle default attribute declarations in internal subset.
-
-** Handle parameter entities (including DTD).
-
-* RELAX NG
-
-** Do complete schema checking, at least optionally.
-
-** Detect include/external loops during schema parse.
-
-** Coding system detection for schemas. Should use utf-8/utf-16 per the
-spec. But also need to allow encodings other than UTF-8/16 to support
-CJK charsets that Emacs cannot represent in Unicode.
-
-* Catching XML errors
-
-** Check public identifiers.
-
-** Check default attribute values.
-
-* Performance
-
-** Explore whether overlay-recenter can cure overlays performance
-problems.
-
-** Cache schemas. Need to have list of files and mtimes.
-
-** Make it possible to reduce rng-validate-chunk-size significantly,
-perhaps to 500 bytes, without bad performance impact: don't do
-redisplay on every chunk; pass continue functions on other uses of
-rng-do-some-validation.
-
-** Cache after first tag.
-
-** Introduce a new name class that is a choice between names (so that
-we can use member)
-
-** intern-choice should simplify after patterns with same 1st/2nd args
-
-** Large numbers of overlays slow things down dramatically. Represent
-errors using text properties. This implies we cannot incrementally
-keep track of the number of errors, in order to determine validity.
-Instead, when validation completes, scan for any characters with an
-error text property; this seems to be fast enough even with large
-buffers. Problem with error at end of buffer, where there's no
-character; need special variable for this. Need to merge face from
-font-lock with the error face: use :inherit attribute with list of two
-faces. How do we avoid making rng-valid depend on nxml-mode?
-
-* Error recovery
-
-** Don't stop at newline in looking for close of start-tag.
-
-** Use indentation to guide recovery from mismatched end-tags
-
-** Don't keep parsing when currently not well-formed but previously
-well-formed
-
-** Try to recover from a bad start-tag by popping an open element if
-there was a mismatched end-tag unaccounted for.
-
-** Try to recover from a bad start-tag open on the hypothesis that there
-was an error in the namespace URI.
-
-** Better recovery from ill-formed XML declarations.
-
-* Useability improvements
-
-** Should print a "Parsing..." message during long movements.
-
-** Provide better position for reference to undefined pattern error.
-
-** Put Well-formed in the mode-line when validating against any-content.
-
-** Trim marking of illegal data for leading and trailing whitespace.
-
-** Show Invalid status as soon as we are sure it's invalid, rather than
-waiting for everything to be completely up to date.
-
-** When narrowed, Valid or Invalid status should probably consider only
-validity of narrowed region.
-
-* Bug fixes
-
-** Need to give an error for a document like: <foo/><![CDATA[ ]]>
-
-** Make nxml-forward-balanced-item work better for the prolog.
-
-** Make filling and indenting comments work in the prolog.
-
-** Should delete RNC Input buffers.
-
-** Figure out what regex use for NCName and use it consistently,
-
-** Should have not-well-formed tokens in ref.
-
-** Require version in XML declaration? Probably not because prevents
-use for external parsed entities. At least forbid standalone
-without version.
-
-** Reject schema that compiles to rng-not-allowed-ipattern.
-
-** Move point backwards on schema parse error so that it's on the right token.
-
-* Internal
-
-** Use rng-quote-string consistently.
-
-** Use parsing library for XML to texinfo conversion.
-
-** Rename xmltok.el to nxml-token.el. Use nxml-t- prefix instead of
-xmltok-. Change nxml-t-type to nxml-t-token-type, nxml-t-start to
-nxml-t-token-start.
-
-** Can we set fill-prefix to nil and rely on indenting?
-
-** xmltok should make available replacement text of entities containing
-elements
-
-** In rng-valid, instead of using modification-hooks and
-insert-behind-hooks on dependent overlays, use same technique as
-nxml-mode.
-
-** Port to XEmacs. Issues include: Unicode (XEmacs seems to be based on
-Mule-UCS); overlays/text properties vs extents; absence of
-fontification-functions hook.
-
-* Fontification
-
-** Allow face to depend on element qname, attribute qname, attribute
-value. Use list with pairs of (R . F), where R specifies regexps and
-F specifies faces. How can this list be made to depend on the
-document type?
-
-* Other
-
-** Support RELAX NG XML syntax (use XML parsing library).
-
-** Support W3C XML Schema (use XML parsing library).
-
-** Command to infer schema from current document (like trang).
-
-* Schemas
-
-** XSLT schema should take advantage of RELAX NG to express cooccurrence
-constraints on attributes (e.g. xsl:template).
-
-* Documentation
-
-** Move material from README to manual.
-
-** Document encodings.
-
-* Notes
-
-** How can we allow an error to be displayed on a different token from
-where it is detected? In particular, for a missing closing ">" we
-will need to display it at the beginning of the following token. At
-the moment, when we parse the following token the error overlay will
-get cleared.
-
-** How should rng-goto-next-error deal with narrowing?
-
-** Perhaps should merge errors having same start position even if they
-have different ends.
-
-** How to handle surrogates? One possibility is to be compatible with
-utf8.e: represent as sequence of 4 chars. But utf-16 is incompatible
-with this.
-
-** Should we distinguish well-formedness errors from invalidity errors?
-(I think not: we may want to recover from a bad start-tag by implying
-an end-tag.)
-
-** Seems to be a bug with Emacs, where a mouse movement that causes
-help-echo text to appear counts as pending input but does not cause
-idle timer to be restarted.
-
-** Use XML to represent this file.
-
-** I had a TODO which said simply "split-string". What did I mean?
-
-** Investigate performance on large files all on one line.
-
-* Issues for Emacs versions >= 22
-
-** Take advantage of UTF-8 CJK support.
-
-** Supply a next-error-function.
-
-** Investigate this NEWS item "Emacs now tries to set up buffer coding
-systems for HTML/XML files automatically."
-
-** Take advantage of the pointer text property.
-
-** Leverage char-displayable-p.
-
-Local variables:
-mode: outline
-end:
diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog
index 9fb48e00ed..c0b3fa567c 100644
--- a/lisp/org/ChangeLog
+++ b/lisp/org/ChangeLog
@@ -1,3 +1,33 @@
+2010-08-19 Glenn Morris <[email protected]>
+
+ * org.el (org-outline-overlay-data, org-set-outline-overlay-data)
+ (org-save-outline-visibility): Move to org-macs.
+ * org-macs.el (org-outline-overlay-data, org-set-outline-overlay-data)
+ (org-save-outline-visibility): Move here from org.el.
+ (show-all): Autoload it.
+ * ob.el: Don't require org when compiling.
+
+2010-08-18 Glenn Morris <[email protected]>
+
+ * ob.el: Require org when compiling.
+ (org-save-outline-visibility): Remove macro declaration.
+ * ob-emacs-lisp.el: Require ob-comint when compiling, for macros.
+ Remove unnecessary/macro declarations.
+ * org-docview.el: Require doc-view when compiling.
+ (doc-view-goto-page): Autoload rather than declaring.
+ (doc-view-current-page): Remove macro declaration.
+
+2010-08-17 Glenn Morris <[email protected]>
+
+ * ob.el (tramp-compat-make-temp-file, org-edit-src-code)
+ (org-entry-get, org-table-import): Fix declarations.
+ (org-match-string-no-properties): Remove unnecessary declaration.
+ * ob-sh.el (org-babel-comint-in-buffer)
+ (org-babel-comint-wait-for-output, org-babel-comint-buffer-livep)
+ (org-babel-comint-with-output): Remove unnecessary declarations.
+ * ob-R.el (orgtbl-to-tsv): Fix declaration.
+ * org-list.el (org-entry-get): Fix declaration.
+
2010-07-19 Eric Schulte <[email protected]>
* ob-C.el: New file.
diff --git a/lisp/org/ob-R.el b/lisp/org/ob-R.el
index 105862c157..d990d69b35 100644
--- a/lisp/org/ob-R.el
+++ b/lisp/org/ob-R.el
@@ -33,7 +33,7 @@
(require 'ob-eval)
(eval-when-compile (require 'cl))
-(declare-function orgtbl-to-tsv "ob-table" (table params))
+(declare-function orgtbl-to-tsv "org-table" (table params))
(declare-function R "ext:essd-r" (&optional start-args))
(declare-function inferior-ess-send-input "ext:ess-inf" ())
diff --git a/lisp/org/ob-emacs-lisp.el b/lisp/org/ob-emacs-lisp.el
index 92c3f36e2e..2ec729f7dc 100644
--- a/lisp/org/ob-emacs-lisp.el
+++ b/lisp/org/ob-emacs-lisp.el
@@ -28,15 +28,12 @@
;;; Code:
(require 'ob)
+(eval-when-compile (require 'ob-comint))
(defvar org-babel-default-header-args:emacs-lisp
'((:hlines . "yes") (:colnames . "no"))
"Default arguments for evaluating an emacs-lisp source block.")
-(declare-function org-babel-comint-with-output "ob-comint" (&rest body))
-(declare-function org-babel-comint-buffer-livep "ob-comint" (buffer))
-(declare-function org-babel-comint-wait-for-output "ob-comint" (buffer))
-(declare-function org-babel-comint-in-buffer "ob-comint" (buffer &rest body))
(declare-function orgtbl-to-generic "org-table" (table params))
(defun org-babel-expand-body:emacs-lisp (body params &optional processed-params)
diff --git a/lisp/org/ob-sh.el b/lisp/org/ob-sh.el
index 69fbefc82c..072bc91af1 100644
--- a/lisp/org/ob-sh.el
+++ b/lisp/org/ob-sh.el
@@ -34,10 +34,6 @@
(eval-when-compile (require 'cl))
(declare-function org-babel-ref-variables "ob-ref" (params))
-(declare-function org-babel-comint-in-buffer "ob-comint" (buffer &rest body))
-(declare-function org-babel-comint-wait-for-output "ob-comint" (buffer))
-(declare-function org-babel-comint-buffer-livep "ob-comint" (buffer))
-(declare-function org-babel-comint-with-output "ob-comint" (meta &rest body))
(declare-function orgtbl-to-generic "org-table" (table params))
(defvar org-babel-default-header-args:sh '())
diff --git a/lisp/org/ob.el b/lisp/org/ob.el
index eeb60836b3..a58fb4eca8 100644
--- a/lisp/org/ob.el
+++ b/lisp/org/ob.el
@@ -25,33 +25,34 @@
;;; Commentary:
;; See the online documentation for more information
-;;
+;;
;; http://orgmode.org/worg/org-contrib/babel/
;;; Code:
-(eval-when-compile (require 'cl))
+(eval-when-compile
+ (require 'cl))
(require 'org-macs)
(defvar org-babel-call-process-region-original)
(declare-function show-all "outline" ())
-(declare-function tramp-compat-make-temp-file "tramp" (filename &optional dir-flag))
+(declare-function tramp-compat-make-temp-file "tramp-compat"
+ (filename &optional dir-flag))
(declare-function tramp-dissect-file-name "tramp" (name &optional nodefault))
(declare-function tramp-file-name-user "tramp" (vec))
(declare-function tramp-file-name-host "tramp" (vec))
(declare-function org-icompleting-read "org" (&rest args))
-(declare-function org-edit-src-code "org" (context code edit-buffer-name))
+(declare-function org-edit-src-code "org-src"
+ (&optional context code edit-buffer-name))
(declare-function org-open-at-point "org" (&optional in-emacs reference-buffer))
-(declare-function org-save-outline-visibility "org" (use-markers &rest body))
(declare-function org-narrow-to-subtree "org" ())
-(declare-function org-entry-get "org" (pom property &optional inherit))
+(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
(declare-function org-make-options-regexp "org" (kwds &optional extra))
-(declare-function org-match-string-no-properties "org" (num &optional string))
(declare-function org-do-remove-indentation "org" (&optional n))
(declare-function org-show-context "org" (&optional key))
(declare-function org-at-table-p "org" (&optional table-type))
(declare-function org-cycle "org" (&optional arg))
(declare-function org-uniquify "org" (list))
-(declare-function org-table-import "org" (file arg))
+(declare-function org-table-import "org-table" (file arg))
(declare-function org-add-hook "org-compat" (hook function &optional append local))
(declare-function org-table-align "org-table" ())
(declare-function org-table-end "org-table" (&optional table-type))
diff --git a/lisp/org/org-docview.el b/lisp/org/org-docview.el
index cac13e6ddf..0ef5df0fda 100644
--- a/lisp/org/org-docview.el
+++ b/lisp/org/org-docview.el
@@ -45,9 +45,9 @@
(require 'org)
+(eval-when-compile (require 'doc-view)) ; doc-view-current-page macro
-(declare-function doc-view-goto-page "doc-view" (page))
-(declare-function doc-view-current-page "doc-view" (&optional win))
+(autoload 'doc-view-goto-page "doc-view")
(org-add-link-type "docview" 'org-docview-open)
(add-hook 'org-store-link-functions 'org-docview-store-link)
diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el
index f1d6520fe5..19ba1a9639 100644
--- a/lisp/org/org-list.el
+++ b/lisp/org/org-list.el
@@ -51,7 +51,8 @@
(declare-function org-get-indentation "org" (&optional line))
(declare-function org-timer-item "org-timer" (&optional arg))
(declare-function org-combine-plists "org" (&rest plists))
-(declare-function org-entry-get "org" (pom property &optional inherit))
+(declare-function org-entry-get "org"
+ (pom property &optional inherit literal-nil))
(declare-function org-narrow-to-subtree "org" ())
(declare-function org-show-subtree "org" ())
diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el
index abcdcdc94e..212fae4fcc 100644
--- a/lisp/org/org-macs.el
+++ b/lisp/org/org-macs.el
@@ -300,6 +300,66 @@ The number of levels is controlled by `org-inlinetask-min-level'"
(nstars (if org-odd-levels-only (1- (* limit-level 2)) limit-level)))
(format "\\*\\{1,%d\\} " nstars))))
+
+;;; Saving and restoring visibility
+
+(defun org-outline-overlay-data (&optional use-markers)
+ "Return a list of the locations of all outline overlays.
+The are overlays with the `invisible' property value `outline'.
+The return values is a list of cons cells, with start and stop
+positions for each overlay.
+If USE-MARKERS is set, return the positions as markers."
+ (let (beg end)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (delq nil
+ (mapcar (lambda (o)
+ (when (eq (overlay-get o 'invisible) 'outline)
+ (setq beg (overlay-start o)
+ end (overlay-end o))
+ (and beg end (> end beg)
+ (if use-markers
+ (cons (move-marker (make-marker) beg)
+ (move-marker (make-marker) end))
+ (cons beg end)))))
+ (overlays-in (point-min) (point-max))))))))
+
+(autoload 'show-all "outline" nil t)
+
+(defun org-set-outline-overlay-data (data)
+ "Create visibility overlays for all positions in DATA.
+DATA should have been made by `org-outline-overlay-data'."
+ (let (o)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (show-all)
+ (mapc (lambda (c)
+ (setq o (make-overlay (car c) (cdr c)))
+ (overlay-put o 'invisible 'outline))
+ data)))))
+
+(defmacro org-save-outline-visibility (use-markers &rest body)
+ "Save and restore outline visibility around BODY.
+If USE-MARKERS is non-nil, use markers for the positions.
+This means that the buffer may change while running BODY,
+but it also means that the buffer should stay alive
+during the operation, because otherwise all these markers will
+point nowhere."
+ (declare (indent 1))
+ `(let ((data (org-outline-overlay-data ,use-markers)))
+ (unwind-protect
+ (progn
+ ,@body
+ (org-set-outline-overlay-data data))
+ (when ,use-markers
+ (mapc (lambda (c)
+ (and (markerp (car c)) (move-marker (car c) nil))
+ (and (markerp (cdr c)) (move-marker (cdr c) nil)))
+ data)))))
+
+
(provide 'org-macs)
;; arch-tag: 7e6a73ce-aac9-4fc0-9b30-ce6f89dc6668
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 5b37e0aa26..a2965e87d2 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -6190,62 +6190,6 @@ Optional argument N means put the headline into the Nth line of the window."
(beginning-of-line)
(recenter (prefix-numeric-value N))))
-;;; Saving and restoring visibility
-
-(defun org-outline-overlay-data (&optional use-markers)
- "Return a list of the locations of all outline overlays.
-The are overlays with the `invisible' property value `outline'.
-The return values is a list of cons cells, with start and stop
-positions for each overlay.
-If USE-MARKERS is set, return the positions as markers."
- (let (beg end)
- (save-excursion
- (save-restriction
- (widen)
- (delq nil
- (mapcar (lambda (o)
- (when (eq (overlay-get o 'invisible) 'outline)
- (setq beg (overlay-start o)
- end (overlay-end o))
- (and beg end (> end beg)
- (if use-markers
- (cons (move-marker (make-marker) beg)
- (move-marker (make-marker) end))
- (cons beg end)))))
- (overlays-in (point-min) (point-max))))))))
-
-(defun org-set-outline-overlay-data (data)
- "Create visibility overlays for all positions in DATA.
-DATA should have been made by `org-outline-overlay-data'."
- (let (o)
- (save-excursion
- (save-restriction
- (widen)
- (show-all)
- (mapc (lambda (c)
- (setq o (make-overlay (car c) (cdr c)))
- (overlay-put o 'invisible 'outline))
- data)))))
-
-(defmacro org-save-outline-visibility (use-markers &rest body)
- "Save and restore outline visibility around BODY.
-If USE-MARKERS is non-nil, use markers for the positions.
-This means that the buffer may change while running BODY,
-but it also means that the buffer should stay alive
-during the operation, because otherwise all these markers will
-point nowhere."
- (declare (indent 1))
- `(let ((data (org-outline-overlay-data ,use-markers)))
- (unwind-protect
- (progn
- ,@body
- (org-set-outline-overlay-data data))
- (when ,use-markers
- (mapc (lambda (c)
- (and (markerp (car c)) (move-marker (car c) nil))
- (and (markerp (cdr c)) (move-marker (cdr c) nil)))
- data)))))
-
;;; Folding of blocks
diff --git a/lisp/password-cache.el b/lisp/password-cache.el
index 7c07642a1f..7c67ab1770 100644
--- a/lisp/password-cache.el
+++ b/lisp/password-cache.el
@@ -134,5 +134,4 @@ The password is removed by a timer after `password-cache-expiry' seconds."
(provide 'password-cache)
-;; arch-tag: ab160494-16c8-4c68-a4a1-73eebf6686e5
;;; password-cache.el ends here
diff --git a/lisp/paths.el b/lisp/paths.el
index 510caa3a87..095326e9c8 100644
--- a/lisp/paths.el
+++ b/lisp/paths.el
@@ -5,6 +5,7 @@
;; Maintainer: FSF
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/pcmpl-cvs.el b/lisp/pcmpl-cvs.el
index 8b394826e6..98d1e47666 100644
--- a/lisp/pcmpl-cvs.el
+++ b/lisp/pcmpl-cvs.el
@@ -4,6 +4,7 @@
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: John Wiegley <[email protected]>
+;; Package: pcomplete
;; This file is part of GNU Emacs.
diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el
index accab1dea9..df1f055506 100644
--- a/lisp/pcmpl-gnu.el
+++ b/lisp/pcmpl-gnu.el
@@ -3,6 +3,8 @@
;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Package: pcomplete
+
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
diff --git a/lisp/pcmpl-linux.el b/lisp/pcmpl-linux.el
index 67ef8e76aa..59c084fffa 100644
--- a/lisp/pcmpl-linux.el
+++ b/lisp/pcmpl-linux.el
@@ -3,6 +3,8 @@
;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Package: pcomplete
+
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
diff --git a/lisp/pcmpl-rpm.el b/lisp/pcmpl-rpm.el
index 754d7ce743..7960141f03 100644
--- a/lisp/pcmpl-rpm.el
+++ b/lisp/pcmpl-rpm.el
@@ -3,6 +3,8 @@
;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
;; 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Package: pcomplete
+
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
diff --git a/lisp/pcmpl-unix.el b/lisp/pcmpl-unix.el
index 9282fe87b5..f2c19ca71c 100644
--- a/lisp/pcmpl-unix.el
+++ b/lisp/pcmpl-unix.el
@@ -3,6 +3,8 @@
;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Package: pcomplete
+
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
diff --git a/lisp/pgg-def.el b/lisp/pgg-def.el
index c506d57928..d1b78ccb30 100644
--- a/lisp/pgg-def.el
+++ b/lisp/pgg-def.el
@@ -6,6 +6,7 @@
;; Author: Daiki Ueno <[email protected]>
;; Created: 1999/11/02
;; Keywords: PGP, OpenPGP, GnuPG
+;; Package: pgg
;; This file is part of GNU Emacs.
@@ -94,5 +95,4 @@ Whether the passphrase is cached at all is controlled by
(provide 'pgg-def)
-;; arch-tag: c425f3ab-ed75-4055-bb46-431a418c94b7
;;; pgg-def.el ends here
diff --git a/lisp/pgg-gpg.el b/lisp/pgg-gpg.el
index e8375fe58f..97b3b3e3d4 100644
--- a/lisp/pgg-gpg.el
+++ b/lisp/pgg-gpg.el
@@ -4,10 +4,11 @@
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Daiki Ueno <[email protected]>
-;; Symmetric encryption and gpg-agent support added by:
+;; Symmetric encryption and gpg-agent support added by:
;; Sascha Wilde <[email protected]>
;; Created: 1999/10/28
;; Keywords: PGP, OpenPGP, GnuPG
+;; Package: pgg
;; This file is part of GNU Emacs.
@@ -406,5 +407,4 @@ passphrase cache or user."
(provide 'pgg-gpg)
-;; arch-tag: 2aa5d5d8-93a0-4865-9312-33e29830e000
;;; pgg-gpg.el ends here
diff --git a/lisp/pgg-parse.el b/lisp/pgg-parse.el
index 40df20bde3..2325171b68 100644
--- a/lisp/pgg-parse.el
+++ b/lisp/pgg-parse.el
@@ -6,6 +6,7 @@
;; Author: Daiki Ueno <[email protected]>
;; Created: 1999/10/28
;; Keywords: PGP, OpenPGP, GnuPG
+;; Package: pgg
;; This file is part of GNU Emacs.
@@ -518,5 +519,4 @@
(provide 'pgg-parse)
-;; arch-tag: 16c2eb82-1313-4a7c-a70f-420709b5b43e
;;; pgg-parse.el ends here
diff --git a/lisp/pgg-pgp.el b/lisp/pgg-pgp.el
index c1c9249a73..dfa02d7835 100644
--- a/lisp/pgg-pgp.el
+++ b/lisp/pgg-pgp.el
@@ -6,6 +6,7 @@
;; Author: Daiki Ueno <[email protected]>
;; Created: 1999/11/02
;; Keywords: PGP, OpenPGP
+;; Package: pgg
;; This file is part of GNU Emacs.
@@ -253,5 +254,4 @@ passphrase cache or user."
(provide 'pgg-pgp)
-;; arch-tag: 076b7801-37b2-49a6-97c3-218fdecde33c
;;; pgg-pgp.el ends here
diff --git a/lisp/pgg-pgp5.el b/lisp/pgg-pgp5.el
index cb2cfd915f..4973119094 100644
--- a/lisp/pgg-pgp5.el
+++ b/lisp/pgg-pgp5.el
@@ -6,6 +6,7 @@
;; Author: Daiki Ueno <[email protected]>
;; Created: 1999/11/02
;; Keywords: PGP, OpenPGP
+;; Package: pgg
;; This file is part of GNU Emacs.
@@ -254,5 +255,4 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
(provide 'pgg-pgp5)
-;; arch-tag: 3dbd1073-6b3a-466c-9f55-5c587ffa6d7b
;;; pgg-pgp5.el ends here
diff --git a/lisp/pgg.el b/lisp/pgg.el
index 8209dc1608..8827424ce3 100644
--- a/lisp/pgg.el
+++ b/lisp/pgg.el
@@ -602,5 +602,4 @@ within the region."
(provide 'pgg)
-;; arch-tag: 9cc705dd-1e6a-4c90-8dce-c3561f9a2cf4
;;; pgg.el ends here
diff --git a/lisp/play/cookie1.el b/lisp/play/cookie1.el
index 75c0d9b2b0..e786c6cc5c 100644
--- a/lisp/play/cookie1.el
+++ b/lisp/play/cookie1.el
@@ -138,7 +138,7 @@ Optional fifth arg REQUIRE-MATCH non-nil forces a matching cookie."
(vec (cookie-snarf phrase-file
startmsg endmsg))
(i (length vec)))
- (while (> (setq i (1- i)) 0)
+ (while (>= (setq i (1- i)) 0)
(setq alist (cons (list (aref vec i)) alist)))
(put sym 'completion-alist alist))))
nil require-match nil nil))
diff --git a/lisp/proced.el b/lisp/proced.el
index 06056ed268..ee4e7b26ca 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -2,7 +2,7 @@
;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc.
-;; Author: Roland Winkler <[email protected]>
+;; Author: Roland Winkler <[email protected]>
;; Keywords: Processes, Unix
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el
index 227f202fef..4bbe1e43f8 100644
--- a/lisp/progmodes/ada-mode.el
+++ b/lisp/progmodes/ada-mode.el
@@ -834,10 +834,7 @@ the 4 file locations can be clicked on and jumped to."
;;
;; On Emacs, this is done through the `syntax-table' text property. The
;; corresponding action is applied automatically each time the buffer
-;; changes. If `font-lock-mode' is enabled (the default) the action is
-;; set up by `font-lock-syntactic-keywords'. Otherwise, we do it
-;; manually in `ada-after-change-function'. The proper method is
-;; installed by `ada-handle-syntax-table-properties'.
+;; changes via syntax-propertize-function.
;;
;; on XEmacs, the `syntax-table' property does not exist and we have to use a
;; slow advice to `parse-partial-sexp' to do the same thing.
@@ -937,6 +934,12 @@ declares it as a word constituent."
(insert (caddar change))
(setq change (cdr change)))))))
+(unless (eval-when-compile (fboundp 'syntax-propertize-via-font-lock))
+ ;; Before `syntax-propertize', we had to use font-lock to apply syntax-table
+ ;; properties, and in some cases we even had to do it manually (in
+ ;; `ada-after-change-function'). `ada-handle-syntax-table-properties'
+ ;; decides which method to use.
+
(defun ada-set-syntax-table-properties ()
"Assign `syntax-table' properties in accessible part of buffer.
In particular, character constants are said to be strings, #...#
@@ -991,6 +994,8 @@ OLD-LEN indicates what the length of the replaced text was."
;; Take care of `syntax-table' properties manually.
(ada-initialize-syntax-table-properties)))
+) ;;(not (fboundp 'syntax-propertize))
+
;;------------------------------------------------------------------
;; Testing the grammatical context
;;------------------------------------------------------------------
@@ -1118,7 +1123,8 @@ the file name."
;;;###autoload
(defun ada-mode ()
- "Ada mode is the major mode for editing Ada code."
+ "Ada mode is the major mode for editing Ada code.
+\\{ada-mode-map}"
(interactive)
(kill-all-local-variables)
@@ -1161,9 +1167,9 @@ the file name."
(set (make-local-variable 'comment-padding) 0)
(set (make-local-variable 'parse-sexp-lookup-properties) t))
- (set 'case-fold-search t)
+ (setq case-fold-search t)
(if (boundp 'imenu-case-fold-search)
- (set 'imenu-case-fold-search t))
+ (setq imenu-case-fold-search t))
(set (make-local-variable 'fill-paragraph-function)
'ada-fill-comment-paragraph)
@@ -1186,8 +1192,13 @@ the file name."
'(ada-font-lock-keywords
nil t
((?\_ . "w") (?# . "."))
- beginning-of-line
- (font-lock-syntactic-keywords . ada-font-lock-syntactic-keywords)))
+ beginning-of-line))
+
+ (if (eval-when-compile (fboundp 'syntax-propertize-via-font-lock))
+ (set (make-local-variable 'syntax-propertize-function)
+ (syntax-propertize-via-font-lock ada-font-lock-syntactic-keywords))
+ (set (make-local-variable 'font-lock-syntactic-keywords)
+ ada-font-lock-syntactic-keywords))
;; Set up support for find-file.el.
(set (make-local-variable 'ff-other-file-alist)
@@ -1322,22 +1333,24 @@ the file name."
;; To be run after the hook, in case the user modified
;; ada-fill-comment-prefix
- (make-local-variable 'comment-start)
- (if ada-fill-comment-prefix
- (set 'comment-start ada-fill-comment-prefix)
- (set 'comment-start "-- "))
+ ;; FIXME: if the user modified ada-fill-comment-prefix in his .emacs
+ ;; then it was already available before running the hook, and if he
+ ;; modifies it in the hook, he might as well modify comment-start instead.
+ (set (make-local-variable 'comment-start) (or ada-fill-comment-prefix "-- "))
;; Run this after the hook to give the users a chance to activate
;; font-lock-mode
- (unless (featurep 'xemacs)
+ (unless (or (eval-when-compile (fboundp 'syntax-propertize-via-font-lock))
+ (featurep 'xemacs))
(ada-initialize-syntax-table-properties)
(add-hook 'font-lock-mode-hook 'ada-handle-syntax-table-properties nil t))
;; the following has to be done after running the ada-mode-hook
;; because users might want to set the values of these variable
;; inside the hook
-
+ ;; FIXME: it might even be set later on via file-local vars, no?
+ ;; so maybe ada-keywords should be set lazily.
(cond ((eq ada-language-version 'ada83)
(setq ada-keywords ada-83-keywords))
((eq ada-language-version 'ada95)
@@ -1397,25 +1410,21 @@ If WORD is not given, then the current word in the buffer is used instead.
The new word is added to the first file in `ada-case-exception-file'.
The standard casing rules will no longer apply to this word."
(interactive)
- (let ((previous-syntax-table (syntax-table))
- file-name
- )
-
- (cond ((stringp ada-case-exception-file)
- (setq file-name ada-case-exception-file))
- ((listp ada-case-exception-file)
- (setq file-name (car ada-case-exception-file)))
- (t
- (error (concat "No exception file specified. "
- "See variable ada-case-exception-file"))))
+ (let ((file-name
+ (cond ((stringp ada-case-exception-file)
+ ada-case-exception-file)
+ ((listp ada-case-exception-file)
+ (car ada-case-exception-file))
+ (t
+ (error (concat "No exception file specified. "
+ "See variable ada-case-exception-file"))))))
- (set-syntax-table ada-mode-symbol-syntax-table)
(unless word
- (save-excursion
- (skip-syntax-backward "w")
- (setq word (buffer-substring-no-properties
- (point) (save-excursion (forward-word 1) (point))))))
- (set-syntax-table previous-syntax-table)
+ (with-syntax-table ada-mode-symbol-syntax-table
+ (save-excursion
+ (skip-syntax-backward "w")
+ (setq word (buffer-substring-no-properties
+ (point) (save-excursion (forward-word 1) (point)))))))
;; Reread the exceptions file, in case it was modified by some other,
(ada-case-read-exceptions-from-file file-name)
@@ -1425,11 +1434,9 @@ The standard casing rules will no longer apply to this word."
(if (and (not (equal ada-case-exception '()))
(assoc-string word ada-case-exception t))
(setcar (assoc-string word ada-case-exception t) word)
- (add-to-list 'ada-case-exception (cons word t))
- )
+ (add-to-list 'ada-case-exception (cons word t)))
- (ada-save-exceptions-to-file file-name)
- ))
+ (ada-save-exceptions-to-file file-name)))
(defun ada-create-case-exception-substring (&optional word)
"Define the substring WORD as an exception for the casing system.
@@ -1464,7 +1471,7 @@ word itself has a special casing."
(modify-syntax-entry ?_ "." (syntax-table))
(save-excursion
(skip-syntax-backward "w")
- (set 'word (buffer-substring-no-properties
+ (setq word (buffer-substring-no-properties
(point)
(save-excursion (forward-word 1) (point))))))
(modify-syntax-entry ?_ (make-string 1 underscore-syntax)
@@ -1633,37 +1640,30 @@ ARG is the prefix the user entered with \\[universal-argument]."
(interactive "P")
(if ada-auto-case
- (let ((lastk last-command-event)
- (previous-syntax-table (syntax-table)))
-
- (unwind-protect
- (progn
- (set-syntax-table ada-mode-symbol-syntax-table)
- (cond ((or (eq lastk ?\n)
- (eq lastk ?\r))
- ;; horrible kludge
- (insert " ")
- (ada-adjust-case)
- ;; horrible dekludge
- (delete-char -1)
- ;; some special keys and their bindings
- (cond
- ((eq lastk ?\n)
- (funcall ada-lfd-binding))
- ((eq lastk ?\r)
- (funcall ada-ret-binding))))
- ((eq lastk ?\C-i) (ada-tab))
- ;; Else just insert the character
- ((self-insert-command (prefix-numeric-value arg))))
- ;; if there is a keyword in front of the underscore
- ;; then it should be part of an identifier (MH)
- (if (eq lastk ?_)
- (ada-adjust-case t)
- (ada-adjust-case))
- )
- ;; Restore the syntax table
- (set-syntax-table previous-syntax-table))
- )
+ (let ((lastk last-command-event))
+
+ (with-syntax-table ada-mode-symbol-syntax-table
+ (cond ((or (eq lastk ?\n)
+ (eq lastk ?\r))
+ ;; horrible kludge
+ (insert " ")
+ (ada-adjust-case)
+ ;; horrible dekludge
+ (delete-char -1)
+ ;; some special keys and their bindings
+ (cond
+ ((eq lastk ?\n)
+ (funcall ada-lfd-binding))
+ ((eq lastk ?\r)
+ (funcall ada-ret-binding))))
+ ((eq lastk ?\C-i) (ada-tab))
+ ;; Else just insert the character
+ ((self-insert-command (prefix-numeric-value arg))))
+ ;; if there is a keyword in front of the underscore
+ ;; then it should be part of an identifier (MH)
+ (if (eq lastk ?_)
+ (ada-adjust-case t)
+ (ada-adjust-case))))
;; Else, no auto-casing
(cond
@@ -1672,10 +1672,10 @@ ARG is the prefix the user entered with \\[universal-argument]."
((eq last-command-event ?\r)
(funcall ada-ret-binding))
(t
- (self-insert-command (prefix-numeric-value arg))))
- ))
+ (self-insert-command (prefix-numeric-value arg))))))
(defun ada-activate-keys-for-case ()
+ ;; FIXME: Use post-self-insert-hook instead of changing key bindings.
"Modify the key bindings for all the keys that should readjust the casing."
(interactive)
;; Save original key-bindings to allow swapping ret/lfd
@@ -1735,44 +1735,41 @@ Attention: This function might take very long for big regions!"
(let ((begin nil)
(end nil)
(keywordp nil)
- (attribp nil)
- (previous-syntax-table (syntax-table)))
+ (attribp nil))
(message "Adjusting case ...")
- (unwind-protect
- (save-excursion
- (set-syntax-table ada-mode-symbol-syntax-table)
- (goto-char to)
- ;;
- ;; loop: look for all identifiers, keywords, and attributes
- ;;
- (while (re-search-backward "\\<\\(\\sw+\\)\\>" from t)
- (setq end (match-end 1))
- (setq attribp
- (and (> (point) from)
- (save-excursion
- (forward-char -1)
- (setq attribp (looking-at "'.[^']")))))
- (or
- ;; do nothing if it is a string or comment
- (ada-in-string-or-comment-p)
- (progn
- ;;
- ;; get the identifier or keyword or attribute
- ;;
- (setq begin (point))
- (setq keywordp (looking-at ada-keywords))
- (goto-char end)
- ;;
- ;; casing according to user-option
- ;;
- (if attribp
- (funcall ada-case-attribute -1)
- (if keywordp
- (funcall ada-case-keyword -1)
- (ada-adjust-case-identifier)))
- (goto-char begin))))
- (message "Adjusting case ... Done"))
- (set-syntax-table previous-syntax-table))))
+ (with-syntax-table ada-mode-symbol-syntax-table
+ (save-excursion
+ (goto-char to)
+ ;;
+ ;; loop: look for all identifiers, keywords, and attributes
+ ;;
+ (while (re-search-backward "\\<\\(\\sw+\\)\\>" from t)
+ (setq end (match-end 1))
+ (setq attribp
+ (and (> (point) from)
+ (save-excursion
+ (forward-char -1)
+ (setq attribp (looking-at "'.[^']")))))
+ (or
+ ;; do nothing if it is a string or comment
+ (ada-in-string-or-comment-p)
+ (progn
+ ;;
+ ;; get the identifier or keyword or attribute
+ ;;
+ (setq begin (point))
+ (setq keywordp (looking-at ada-keywords))
+ (goto-char end)
+ ;;
+ ;; casing according to user-option
+ ;;
+ (if attribp
+ (funcall ada-case-attribute -1)
+ (if keywordp
+ (funcall ada-case-keyword -1)
+ (ada-adjust-case-identifier)))
+ (goto-char begin))))
+ (message "Adjusting case ... Done")))))
(defun ada-adjust-case-buffer ()
"Adjust the case of all words in the whole buffer.
@@ -1803,46 +1800,39 @@ ATTENTION: This function might take very long for big buffers!"
(let ((begin nil)
(end nil)
(delend nil)
- (paramlist nil)
- (previous-syntax-table (syntax-table)))
- (unwind-protect
- (progn
- (set-syntax-table ada-mode-symbol-syntax-table)
+ (paramlist nil))
+ (with-syntax-table ada-mode-symbol-syntax-table
- ;; check if really inside parameter list
- (or (ada-in-paramlist-p)
- (error "Not in parameter list"))
+ ;; check if really inside parameter list
+ (or (ada-in-paramlist-p)
+ (error "Not in parameter list"))
- ;; find start of current parameter-list
- (ada-search-ignore-string-comment
- (concat ada-subprog-start-re "\\|\\<body\\>" ) t nil)
- (down-list 1)
- (backward-char 1)
- (setq begin (point))
+ ;; find start of current parameter-list
+ (ada-search-ignore-string-comment
+ (concat ada-subprog-start-re "\\|\\<body\\>" ) t nil)
+ (down-list 1)
+ (backward-char 1)
+ (setq begin (point))
- ;; find end of parameter-list
- (forward-sexp 1)
- (setq delend (point))
- (delete-char -1)
- (insert "\n")
-
- ;; find end of last parameter-declaration
- (forward-comment -1000)
- (setq end (point))
+ ;; find end of parameter-list
+ (forward-sexp 1)
+ (setq delend (point))
+ (delete-char -1)
+ (insert "\n")
- ;; build a list of all elements of the parameter-list
- (setq paramlist (ada-scan-paramlist (1+ begin) end))
+ ;; find end of last parameter-declaration
+ (forward-comment -1000)
+ (setq end (point))
- ;; delete the original parameter-list
- (delete-region begin delend)
+ ;; build a list of all elements of the parameter-list
+ (setq paramlist (ada-scan-paramlist (1+ begin) end))
- ;; insert the new parameter-list
- (goto-char begin)
- (ada-insert-paramlist paramlist))
+ ;; delete the original parameter-list
+ (delete-region begin delend)
- ;; restore syntax-table
- (set-syntax-table previous-syntax-table)
- )))
+ ;; insert the new parameter-list
+ (goto-char begin)
+ (ada-insert-paramlist paramlist))))
(defun ada-scan-paramlist (begin end)
"Scan the parameter list found in between BEGIN and END.
@@ -2186,14 +2176,12 @@ Return the new position of point or nil if not found."
Return the calculation that was done, including the reference point
and the offset."
(interactive)
- (let ((previous-syntax-table (syntax-table))
- (orgpoint (point-marker))
+ (let ((orgpoint (point-marker))
cur-indent tmp-indent
prev-indent)
(unwind-protect
- (progn
- (set-syntax-table ada-mode-symbol-syntax-table)
+ (with-syntax-table ada-mode-symbol-syntax-table
;; This need to be done here so that the advice is not always
;; activated (this might interact badly with other modes)
@@ -2203,14 +2191,14 @@ and the offset."
(save-excursion
(setq cur-indent
- ;; Not First line in the buffer ?
- (if (save-excursion (zerop (forward-line -1)))
- (progn
- (back-to-indentation)
- (ada-get-current-indent))
+ ;; Not First line in the buffer ?
+ (if (save-excursion (zerop (forward-line -1)))
+ (progn
+ (back-to-indentation)
+ (ada-get-current-indent))
- ;; first line in the buffer
- (list (point-min) 0))))
+ ;; first line in the buffer
+ (list (point-min) 0))))
;; Evaluate the list to get the column to indent to
;; prev-indent contains the column to indent to
@@ -2242,14 +2230,10 @@ and the offset."
(if (< (current-column) (current-indentation))
(back-to-indentation)))
- ;; restore syntax-table
- (set-syntax-table previous-syntax-table)
(if (featurep 'xemacs)
- (ad-deactivate 'parse-partial-sexp))
- )
+ (ad-deactivate 'parse-partial-sexp)))
- cur-indent
- ))
+ cur-indent))
(defun ada-get-current-indent ()
"Return the indentation to use for the current line."
@@ -2512,11 +2496,11 @@ and the offset."
(if (looking-at "renames")
(let (pos)
(save-excursion
- (set 'pos (ada-search-ignore-string-comment ";\\|return\\>" t)))
+ (setq pos (ada-search-ignore-string-comment ";\\|return\\>" t)))
(if (and pos
(= (downcase (char-after (car pos))) ?r))
(goto-char (car pos)))
- (set 'var 'ada-indent-renames)))
+ (setq var 'ada-indent-renames)))
(forward-comment -1000)
(if (= (char-before) ?\))
@@ -2533,7 +2517,7 @@ and the offset."
(looking-at "\\(function\\|procedure\\)\\>"))
(progn
(backward-word 1)
- (set 'num-back 2)
+ (setq num-back 2)
(looking-at "\\(function\\|procedure\\)\\>")))))
;; The indentation depends of the value of ada-indent-return
@@ -4046,8 +4030,7 @@ Point is moved at the beginning of the SEARCH-RE."
(let (found
begin
end
- parse-result
- (previous-syntax-table (syntax-table)))
+ parse-result)
;; FIXME: need to pass BACKWARD to search-func!
(unless search-func
@@ -4057,67 +4040,65 @@ Point is moved at the beginning of the SEARCH-RE."
;; search until found or end-of-buffer
;; We have to test that we do not look further than limit
;;
- (set-syntax-table ada-mode-symbol-syntax-table)
- (while (and (not found)
- (or (not limit)
- (or (and backward (<= limit (point)))
- (>= limit (point))))
- (funcall search-func search-re limit 1))
- (setq begin (match-beginning 0))
- (setq end (match-end 0))
-
- (setq parse-result (parse-partial-sexp
- (save-excursion (beginning-of-line) (point))
- (point)))
-
- (cond
- ;;
- ;; If inside a string, skip it (and the following comments)
- ;;
- ((ada-in-string-p parse-result)
- (if (featurep 'xemacs)
- (search-backward "\"" nil t)
- (goto-char (nth 8 parse-result)))
- (unless backward (forward-sexp 1)))
- ;;
- ;; If inside a comment, skip it (and the following comments)
- ;; There is a special code for comments at the end of the file
- ;;
- ((ada-in-comment-p parse-result)
- (if (featurep 'xemacs)
- (progn
- (forward-line 1)
- (beginning-of-line)
- (forward-comment -1))
- (goto-char (nth 8 parse-result)))
- (unless backward
- ;; at the end of the file, it is not possible to skip a comment
- ;; so we just go at the end of the line
- (if (forward-comment 1)
- (progn
- (forward-comment 1000)
- (beginning-of-line))
- (end-of-line))))
- ;;
- ;; directly in front of a comment => skip it, if searching forward
- ;;
- ((and (= (char-after begin) ?-) (= (char-after (1+ begin)) ?-))
- (unless backward (progn (forward-char -1) (forward-comment 1000))))
-
- ;;
- ;; found a parameter-list but should ignore it => skip it
- ;;
- ((and (not paramlists) (ada-in-paramlist-p))
- (if backward
- (search-backward "(" nil t)
- (search-forward ")" nil t)))
- ;;
- ;; found what we were looking for
- ;;
- (t
- (setq found t)))) ; end of loop
-
- (set-syntax-table previous-syntax-table)
+ (with-syntax-table ada-mode-symbol-syntax-table
+ (while (and (not found)
+ (or (not limit)
+ (or (and backward (<= limit (point)))
+ (>= limit (point))))
+ (funcall search-func search-re limit 1))
+ (setq begin (match-beginning 0))
+ (setq end (match-end 0))
+
+ (setq parse-result (parse-partial-sexp
+ (save-excursion (beginning-of-line) (point))
+ (point)))
+
+ (cond
+ ;;
+ ;; If inside a string, skip it (and the following comments)
+ ;;
+ ((ada-in-string-p parse-result)
+ (if (featurep 'xemacs)
+ (search-backward "\"" nil t)
+ (goto-char (nth 8 parse-result)))
+ (unless backward (forward-sexp 1)))
+ ;;
+ ;; If inside a comment, skip it (and the following comments)
+ ;; There is a special code for comments at the end of the file
+ ;;
+ ((ada-in-comment-p parse-result)
+ (if (featurep 'xemacs)
+ (progn
+ (forward-line 1)
+ (beginning-of-line)
+ (forward-comment -1))
+ (goto-char (nth 8 parse-result)))
+ (unless backward
+ ;; at the end of the file, it is not possible to skip a comment
+ ;; so we just go at the end of the line
+ (if (forward-comment 1)
+ (progn
+ (forward-comment 1000)
+ (beginning-of-line))
+ (end-of-line))))
+ ;;
+ ;; directly in front of a comment => skip it, if searching forward
+ ;;
+ ((and (= (char-after begin) ?-) (= (char-after (1+ begin)) ?-))
+ (unless backward (progn (forward-char -1) (forward-comment 1000))))
+
+ ;;
+ ;; found a parameter-list but should ignore it => skip it
+ ;;
+ ((and (not paramlists) (ada-in-paramlist-p))
+ (if backward
+ (search-backward "(" nil t)
+ (search-forward ")" nil t)))
+ ;;
+ ;; found what we were looking for
+ ;;
+ (t
+ (setq found t))))) ; end of loop
(if found
(cons begin end)
@@ -4398,122 +4379,109 @@ of the region. Otherwise, operate only on the current line."
(defun ada-move-to-start ()
"Move point to the matching start of the current Ada structure."
(interactive)
- (let ((pos (point))
- (previous-syntax-table (syntax-table)))
- (unwind-protect
- (progn
- (set-syntax-table ada-mode-symbol-syntax-table)
+ (let ((pos (point)))
+ (with-syntax-table ada-mode-symbol-syntax-table
- (save-excursion
- ;;
- ;; do nothing if in string or comment or not on 'end ...;'
- ;; or if an error occurs during processing
- ;;
- (or
- (ada-in-string-or-comment-p)
- (and (progn
- (or (looking-at "[ \t]*\\<end\\>")
- (backward-word 1))
- (or (looking-at "[ \t]*\\<end\\>")
- (backward-word 1))
- (or (looking-at "[ \t]*\\<end\\>")
- (error "Not on end ...;")))
- (ada-goto-matching-start 1)
- (setq pos (point))
-
- ;;
- ;; on 'begin' => go on, according to user option
- ;;
- ada-move-to-declaration
- (looking-at "\\<begin\\>")
- (ada-goto-decl-start)
- (setq pos (point))))
-
- ) ; end of save-excursion
-
- ;; now really move to the found position
- (goto-char pos))
-
- ;; restore syntax-table
- (set-syntax-table previous-syntax-table))))
+ (save-excursion
+ ;;
+ ;; do nothing if in string or comment or not on 'end ...;'
+ ;; or if an error occurs during processing
+ ;;
+ (or
+ (ada-in-string-or-comment-p)
+ (and (progn
+ (or (looking-at "[ \t]*\\<end\\>")
+ (backward-word 1))
+ (or (looking-at "[ \t]*\\<end\\>")
+ (backward-word 1))
+ (or (looking-at "[ \t]*\\<end\\>")
+ (error "Not on end ...;")))
+ (ada-goto-matching-start 1)
+ (setq pos (point))
+
+ ;;
+ ;; on 'begin' => go on, according to user option
+ ;;
+ ada-move-to-declaration
+ (looking-at "\\<begin\\>")
+ (ada-goto-decl-start)
+ (setq pos (point))))
+
+ ) ; end of save-excursion
+
+ ;; now really move to the found position
+ (goto-char pos))))
(defun ada-move-to-end ()
"Move point to the end of the block around point.
Moves to 'begin' if in a declarative part."
(interactive)
(let ((pos (point))
- decl-start
- (previous-syntax-table (syntax-table)))
- (unwind-protect
- (progn
- (set-syntax-table ada-mode-symbol-syntax-table)
-
- (save-excursion
-
- (cond
- ;; Go to the beginning of the current word, and check if we are
- ;; directly on 'begin'
- ((save-excursion
- (skip-syntax-backward "w")
- (looking-at "\\<begin\\>"))
- (ada-goto-matching-end 1)
- )
-
- ;; on first line of subprogram body
- ;; Do nothing for specs or generic instantion, since these are
- ;; handled as the general case (find the enclosing block)
- ;; We also need to make sure that we ignore nested subprograms
- ((save-excursion
- (and (skip-syntax-backward "w")
- (looking-at "\\<function\\>\\|\\<procedure\\>" )
- (ada-search-ignore-string-comment "is\\|;")
- (not (= (char-before) ?\;))
- ))
- (skip-syntax-backward "w")
- (ada-goto-matching-end 0 t))
-
- ;; on first line of task declaration
- ((save-excursion
- (and (ada-goto-stmt-start)
- (looking-at "\\<task\\>" )
- (forward-word 1)
- (ada-goto-next-non-ws)
- (looking-at "\\<body\\>")))
- (ada-search-ignore-string-comment "begin" nil nil nil
- 'word-search-forward))
- ;; accept block start
- ((save-excursion
- (and (ada-goto-stmt-start)
- (looking-at "\\<accept\\>" )))
- (ada-goto-matching-end 0))
- ;; package start
- ((save-excursion
- (setq decl-start (and (ada-goto-decl-start t) (point)))
- (and decl-start (looking-at "\\<package\\>")))
- (ada-goto-matching-end 1))
-
- ;; On a "declare" keyword
- ((save-excursion
- (skip-syntax-backward "w")
- (looking-at "\\<declare\\>"))
- (ada-goto-matching-end 0 t))
-
- ;; inside a 'begin' ... 'end' block
- (decl-start
- (goto-char decl-start)
- (ada-goto-matching-end 0 t))
-
- ;; (hopefully ;-) everything else
- (t
- (ada-goto-matching-end 1)))
- (setq pos (point))
- )
+ decl-start)
+ (with-syntax-table ada-mode-symbol-syntax-table
- ;; now really move to the position found
- (goto-char pos))
+ (save-excursion
- ;; restore syntax-table
- (set-syntax-table previous-syntax-table))))
+ (cond
+ ;; Go to the beginning of the current word, and check if we are
+ ;; directly on 'begin'
+ ((save-excursion
+ (skip-syntax-backward "w")
+ (looking-at "\\<begin\\>"))
+ (ada-goto-matching-end 1))
+
+ ;; on first line of subprogram body
+ ;; Do nothing for specs or generic instantion, since these are
+ ;; handled as the general case (find the enclosing block)
+ ;; We also need to make sure that we ignore nested subprograms
+ ((save-excursion
+ (and (skip-syntax-backward "w")
+ (looking-at "\\<function\\>\\|\\<procedure\\>" )
+ (ada-search-ignore-string-comment "is\\|;")
+ (not (= (char-before) ?\;))
+ ))
+ (skip-syntax-backward "w")
+ (ada-goto-matching-end 0 t))
+
+ ;; on first line of task declaration
+ ((save-excursion
+ (and (ada-goto-stmt-start)
+ (looking-at "\\<task\\>" )
+ (forward-word 1)
+ (ada-goto-next-non-ws)
+ (looking-at "\\<body\\>")))
+ (ada-search-ignore-string-comment "begin" nil nil nil
+ 'word-search-forward))
+ ;; accept block start
+ ((save-excursion
+ (and (ada-goto-stmt-start)
+ (looking-at "\\<accept\\>" )))
+ (ada-goto-matching-end 0))
+ ;; package start
+ ((save-excursion
+ (setq decl-start (and (ada-goto-decl-start t) (point)))
+ (and decl-start (looking-at "\\<package\\>")))
+ (ada-goto-matching-end 1))
+
+ ;; On a "declare" keyword
+ ((save-excursion
+ (skip-syntax-backward "w")
+ (looking-at "\\<declare\\>"))
+ (ada-goto-matching-end 0 t))
+
+ ;; inside a 'begin' ... 'end' block
+ (decl-start
+ (goto-char decl-start)
+ (ada-goto-matching-end 0 t))
+
+ ;; (hopefully ;-) everything else
+ (t
+ (ada-goto-matching-end 1)))
+ (setq pos (point))
+ )
+
+ ;; now really move to the position found
+ (goto-char pos))))
(defun ada-next-procedure ()
"Move point to next procedure."
@@ -4818,7 +4786,7 @@ Moves to 'begin' if in a declarative part."
(if (featurep 'xemacs)
(progn
(define-key ada-mode-map [menu-bar] ada-mode-menu)
- (set 'mode-popup-menu (cons "Ada mode" ada-mode-menu))))))
+ (setq mode-popup-menu (cons "Ada mode" ada-mode-menu))))))
;; -------------------------------------------------------
@@ -5040,7 +5008,7 @@ or the spec otherwise."
(ada-find-src-file-in-dir
(file-name-nondirectory (concat name (car suffixes))))))
(if other
- (set 'is-spec other)))
+ (setq is-spec other)))
;; Else search in the current directory
(if (file-exists-p (concat name (car suffixes)))
diff --git a/lisp/progmodes/ada-prj.el b/lisp/progmodes/ada-prj.el
index 0ae93c392a..630f83e58a 100644
--- a/lisp/progmodes/ada-prj.el
+++ b/lisp/progmodes/ada-prj.el
@@ -6,6 +6,7 @@
;; Author: Emmanuel Briot <[email protected]>
;; Maintainer: Stephen Leake <[email protected]>
;; Keywords: languages, ada, project file
+;; Package: ada-mode
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/ada-stmt.el b/lisp/progmodes/ada-stmt.el
index 103bc093bd..b618b26c73 100644
--- a/lisp/progmodes/ada-stmt.el
+++ b/lisp/progmodes/ada-stmt.el
@@ -9,6 +9,7 @@
;; Rolf Ebert <[email protected]>
;; Maintainer: Stephen Leake <[email protected]>
;; Keywords: languages, ada
+;; Package: ada-mode
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el
index 9b43a0629b..73c31f08cd 100644
--- a/lisp/progmodes/ada-xref.el
+++ b/lisp/progmodes/ada-xref.el
@@ -8,6 +8,7 @@
;; Emmanuel Briot <[email protected]>
;; Maintainer: Stephen Leake <[email protected]>
;; Keywords: languages ada xref
+;; Package: ada-mode
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el
index 4e93c54788..9b24ac7a1f 100644
--- a/lisp/progmodes/antlr-mode.el
+++ b/lisp/progmodes/antlr-mode.el
@@ -5,7 +5,7 @@
;; Author: [email protected]
;; Keywords: languages, ANTLR, code generator
-;; Version: (see `antlr-version' below)
+;; Version: 2.2c
;; X-URL: http://antlr-mode.sourceforge.net/
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/autoconf.el b/lisp/progmodes/autoconf.el
index a56623f22d..004bb3de78 100644
--- a/lisp/progmodes/autoconf.el
+++ b/lisp/progmodes/autoconf.el
@@ -43,9 +43,6 @@
(defvar autoconf-mode-hook nil
"Hook run by `autoconf-mode'.")
-(defconst autoconf-font-lock-syntactic-keywords
- '(("\\<dnl\\>" 0 '(11))))
-
(defconst autoconf-definition-regexp
"AC_\\(SUBST\\|DEFINE\\(_UNQUOTED\\)?\\)(\\[*\\(\\sw+\\)\\]*")
@@ -94,8 +91,8 @@ searching backwards at another AC_... command."
"^[ \t]*A[CM]_\\(\\sw\\|\\s_\\)+")
(set (make-local-variable 'comment-start) "dnl ")
(set (make-local-variable 'comment-start-skip) "\\(?:\\<dnl\\|#\\) +")
- (set (make-local-variable 'font-lock-syntactic-keywords)
- autoconf-font-lock-syntactic-keywords)
+ (set (make-local-variable 'syntax-propertize-function)
+ (syntax-propertize-rules ("\\<dnl\\>" (0 "<"))))
(set (make-local-variable 'font-lock-defaults)
`(autoconf-font-lock-keywords nil nil (("_" . "w"))))
(set (make-local-variable 'imenu-generic-expression)
diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el
index e52a0d70e4..8224db79ac 100644
--- a/lisp/progmodes/cc-align.el
+++ b/lisp/progmodes/cc-align.el
@@ -12,8 +12,8 @@
;; 1985 Richard M. Stallman
;; Maintainer: [email protected]
;; Created: 22-Apr-1997 (split from cc-mode.el)
-;; Version: See cc-mode.el
-;; Keywords: c languages oop
+;; Keywords: c languages
+;; Package: cc-mode
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el
index be7d2a0fd3..6c7db25612 100644
--- a/lisp/progmodes/cc-awk.el
+++ b/lisp/progmodes/cc-awk.el
@@ -6,6 +6,7 @@
;; Author: Alan Mackenzie <[email protected]> (originally based on awk-mode.el)
;; Maintainer: FSF
;; Keywords: AWK, cc-mode, unix, languages
+;; Package: cc-mode
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/cc-bytecomp.el b/lisp/progmodes/cc-bytecomp.el
index cde38d872b..597267d4e5 100644
--- a/lisp/progmodes/cc-bytecomp.el
+++ b/lisp/progmodes/cc-bytecomp.el
@@ -6,8 +6,8 @@
;; Author: Martin Stjernholm
;; Maintainer: [email protected]
;; Created: 15-Jul-2000
-;; Version: See cc-mode.el
-;; Keywords: c languages oop
+;; Keywords: c languages
+;; Package: cc-mode
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el
index 02fc3950a3..b17703b030 100644
--- a/lisp/progmodes/cc-cmds.el
+++ b/lisp/progmodes/cc-cmds.el
@@ -12,8 +12,8 @@
;; 1985 Richard M. Stallman
;; Maintainer: [email protected]
;; Created: 22-Apr-1997 (split from cc-mode.el)
-;; Version: See cc-mode.el
-;; Keywords: c languages oop
+;; Keywords: c languages
+;; Package: cc-mode
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/cc-compat.el b/lisp/progmodes/cc-compat.el
index 59a336f3c6..adfac2f5f9 100644
--- a/lisp/progmodes/cc-compat.el
+++ b/lisp/progmodes/cc-compat.el
@@ -8,8 +8,8 @@
;; 1994-1999 Barry A. Warsaw
;; Maintainer: [email protected]
;; Created: August 1994, split from cc-mode.el
-;; Version: See cc-mode.el
-;; Keywords: c languages oop
+;; Keywords: c languages
+;; Package: cc-mode
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index e5e108106f..147a0e2dc2 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -12,8 +12,8 @@
;; 1985 Richard M. Stallman
;; Maintainer: [email protected]
;; Created: 22-Apr-1997 (split from cc-mode.el)
-;; Version: See cc-mode.el
-;; Keywords: c languages oop
+;; Keywords: c languages
+;; Package: cc-mode
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index d87db0fe8b..e389007065 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -1,8 +1,8 @@
;;; cc-engine.el --- core syntax guessing engine for CC mode
;; Copyright (C) 1985, 1987, 1992, 1993, 1994, 1995, 1996, 1997, 1998,
-;; 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
-;; Free Software Foundation, Inc.
+;; 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
+;; 2010 Free Software Foundation, Inc.
;; Authors: 2001- Alan Mackenzie
;; 1998- Martin Stjernholm
@@ -12,8 +12,8 @@
;; 1985 Richard M. Stallman
;; Maintainer: [email protected]
;; Created: 22-Apr-1997 (split from cc-mode.el)
-;; Version: See cc-mode.el
-;; Keywords: c languages oop
+;; Keywords: c languages
+;; Package: cc-mode
;; This file is part of GNU Emacs.
@@ -5023,6 +5023,10 @@ comment at the start of cc-engine.el for more info."
(c-unmark-<->-as-paren pos))
t)))
+;; Set by c-common-init in cc-mode.el.
+(defvar c-new-BEG)
+(defvar c-new-END)
+
(defun c-before-change-check-<>-operators (beg end)
;; Unmark certain pairs of "< .... >" which are currently marked as
;; template/generic delimiters. (This marking is via syntax-table
@@ -5366,6 +5370,9 @@ comment at the start of cc-engine.el for more info."
(goto-char safe-pos)
t)))
+;; cc-mode requires cc-fonts.
+(declare-function c-fontify-recorded-types-and-refs "cc-fonts" ())
+
(defun c-forward-<>-arglist (all-types)
;; The point is assumed to be at a "<". Try to treat it as the open
;; paren of an angle bracket arglist and move forward to the
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index 219eb25368..72703b9a5e 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -6,8 +6,8 @@
;; 2002- Martin Stjernholm
;; Maintainer: [email protected]
;; Created: 07-Jan-2002
-;; Version: See cc-mode.el
-;; Keywords: c languages oop
+;; Keywords: c languages
+;; Package: cc-mode
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index ae0ed1b928..5cd5c0b95c 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -12,8 +12,8 @@
;; 1985 Richard M. Stallman
;; Maintainer: [email protected]
;; Created: 22-Apr-1997 (split from cc-mode.el)
-;; Version: See cc-mode.el
-;; Keywords: c languages oop
+;; Keywords: c languages
+;; Package: cc-mode
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/cc-menus.el b/lisp/progmodes/cc-menus.el
index ae346afa54..e27335e1f5 100644
--- a/lisp/progmodes/cc-menus.el
+++ b/lisp/progmodes/cc-menus.el
@@ -11,8 +11,8 @@
;; 1985 Richard M. Stallman
;; Maintainer: [email protected]
;; Created: 22-Apr-1997 (split from cc-mode.el)
-;; Version: See cc-mode.el
-;; Keywords: c languages oop
+;; Keywords: c languages
+;; Package: cc-mode
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index f9917ce406..6a76a65782 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -1,8 +1,8 @@
;;; cc-mode.el --- major mode for editing C and similar languages
;; Copyright (C) 1985, 1987, 1992, 1993, 1994, 1995, 1996, 1997, 1998,
-;; 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
-;; Free Software Foundation, Inc.
+;; 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
+;; 2010 Free Software Foundation, Inc.
;; Authors: 2003- Alan Mackenzie
;; 1998- Martin Stjernholm
@@ -12,7 +12,7 @@
;; 1985 Richard M. Stallman
;; Maintainer: [email protected]
;; Created: a long, long, time ago. adapted from the original c-mode.el
-;; Keywords: c languages oop
+;; Keywords: c languages
;; This file is part of GNU Emacs.
@@ -616,6 +616,15 @@ that requires a literal mode spec at compile time."
(font-lock-mode 0)
(font-lock-mode 1)))
+;; Buffer local variables defining the region to be fontified by a font lock
+;; after-change function. They are set in c-after-change to
+;; after-change-function's BEG and END, and may be modified by a
+;; `c-before-font-lock-function'.
+(defvar c-new-BEG 0)
+(make-variable-buffer-local 'c-new-BEG)
+(defvar c-new-END 0)
+(make-variable-buffer-local 'c-new-END)
+
(defun c-common-init (&optional mode)
"Common initialization for all CC Mode modes.
In addition to the work done by `c-basic-common-init' and
@@ -811,15 +820,6 @@ Note that the style variables are always made local to the buffer."
;;; Change hooks, linking with Font Lock.
-;; Buffer local variables defining the region to be fontified by a font lock
-;; after-change function. They are set in c-after-change to
-;; after-change-function's BEG and END, and may be modified by a
-;; `c-before-font-lock-function'.
-(defvar c-new-BEG 0)
-(make-variable-buffer-local 'c-new-BEG)
-(defvar c-new-END 0)
-(make-variable-buffer-local 'c-new-END)
-
;; Buffer local variables recording Beginning/End-of-Macro position before a
;; change, when a macro straddles, respectively, the BEG or END (or both) of
;; the change region. Otherwise these have the values BEG/END.
diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el
index ec9ffe3462..48120563b2 100644
--- a/lisp/progmodes/cc-styles.el
+++ b/lisp/progmodes/cc-styles.el
@@ -12,8 +12,8 @@
;; 1985 Richard M. Stallman
;; Maintainer: [email protected]
;; Created: 22-Apr-1997 (split from cc-mode.el)
-;; Version: See cc-mode.el
-;; Keywords: c languages oop
+;; Keywords: c languages
+;; Package: cc-mode
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el
index f61c2a9fd0..e965cc2192 100644
--- a/lisp/progmodes/cc-vars.el
+++ b/lisp/progmodes/cc-vars.el
@@ -12,8 +12,8 @@
;; 1985 Richard M. Stallman
;; Maintainer: [email protected]
;; Created: 22-Apr-1997 (split from cc-mode.el)
-;; Version: See cc-mode.el
-;; Keywords: c languages oop
+;; Keywords: c languages
+;; Package: cc-mode
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el
index 86a6be40cc..e074e92fbe 100644
--- a/lisp/progmodes/cfengine.el
+++ b/lisp/progmodes/cfengine.el
@@ -83,12 +83,6 @@ This includes those for cfservd as well as cfagent."))
;; File, acl &c in group: { token ... }
("{[ \t]*\\([^ \t\n]+\\)" 1 font-lock-constant-face)))
-(defconst cfengine-font-lock-syntactic-keywords
- ;; In the main syntax-table, backslash is marked as a punctuation, because
- ;; of its use in DOS-style directory separators. Here we try to recognize
- ;; the cases where backslash is used as an escape inside strings.
- '(("\\(\\(?:\\\\\\)+\\)\"" 1 "\\")))
-
(defvar cfengine-imenu-expression
`((nil ,(concat "^[ \t]*" (eval-when-compile
(regexp-opt cfengine-actions t))
@@ -237,13 +231,15 @@ to the action header."
(set (make-local-variable 'fill-paragraph-function)
#'cfengine-fill-paragraph)
(define-abbrev-table 'cfengine-mode-abbrev-table cfengine-mode-abbrevs)
- ;; Fixme: Use `font-lock-syntactic-keywords' to set the args of
- ;; functions in evaluated classes to string syntax, and then obey
- ;; syntax properties.
(setq font-lock-defaults
- '(cfengine-font-lock-keywords nil nil nil beginning-of-line
- (font-lock-syntactic-keywords
- . cfengine-font-lock-syntactic-keywords)))
+ '(cfengine-font-lock-keywords nil nil nil beginning-of-line))
+ ;; Fixme: set the args of functions in evaluated classes to string
+ ;; syntax, and then obey syntax properties.
+ (set (make-local-variable 'syntax-propertize-function)
+ ;; In the main syntax-table, \ is marked as a punctuation, because
+ ;; of its use in DOS-style directory separators. Here we try to
+ ;; recognize the cases where \ is used as an escape inside strings.
+ (syntax-propertize-rules ("\\(\\(?:\\\\\\)+\\)\"" (1 "\\"))))
(setq imenu-generic-expression cfengine-imenu-expression)
(set (make-local-variable 'beginning-of-defun-function)
#'cfengine-beginning-of-defun)
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index c92d6a9f05..7f0732ecff 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -164,7 +164,7 @@ and a string describing how the process finished.")
(defvar compilation-num-errors-found)
-(defconst compilation-error-regexp-alist-alist
+(defvar compilation-error-regexp-alist-alist
'((absoft
"^\\(?:[Ee]rror on \\|[Ww]arning on\\( \\)\\)?[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\
of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
@@ -237,6 +237,10 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
nil 1 nil 2 0
(2 (compilation-face '(3))))
+ (gcc-include
+ "^\\(?:In file included \\| \\|\t\\)from \
+\\(.+\\):\\([0-9]+\\)\\(?:\\(:\\)\\|\\(,\\|$\\)\\)?" 1 2 nil (3 . 4))
+
(gnu
;; The first line matches the program name for
@@ -259,9 +263,11 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
;; The core of the regexp is the one with *?. It says that a file name
;; can be composed of any non-newline char, but it also rules out some
;; valid but unlikely cases, such as a trailing space or a space
- ;; followed by a -.
- "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\)?\
-\\([0-9]*[^0-9\n]\\(?:[^\n ]\\| [^-/\n]\\)*?\\): ?\
+ ;; followed by a -, or a colon followed by a space.
+
+ ;; The "in \\|from " exception was added to handle messages from Ruby.
+ "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\|[ \t]+\\(?:in \\|from \\)\\)?\
+\\([0-9]*[^0-9\n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\): ?\
\\([0-9]+\\)\\(?:\\([.:]\\)\\([0-9]+\\)\\)?\
\\(?:-\\([0-9]+\\)?\\(?:\\.\\([0-9]+\\)\\)?\\)?:\
\\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\
@@ -269,12 +275,6 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
\[0-9]?\\(?:[^0-9\n]\\|$\\)\\|[0-9][0-9][0-9]\\)"
1 (2 . 5) (4 . 6) (7 . 8))
- ;; The `gnu' style above can incorrectly match gcc's "In file
- ;; included from" message, so we process that first. -- cyd
- (gcc-include
- "^\\(?:In file included\\| \\) from \
-\\(.+\\):\\([0-9]+\\)\\(?:\\(:\\)\\|\\(,\\)\\)?" 1 2 nil (3 . 4))
-
(lcc
"^\\(?:E\\|\\(W\\)\\), \\([^(\n]+\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)"
2 3 4 (1))
@@ -329,10 +329,6 @@ during global destruction\\.$\\)" 1 2)
"\\(?:Parse\\|Fatal\\) error: \\(.*\\) in \\(.*\\) on line \\([0-9]+\\)"
2 3 nil nil)
- (ruby
- "^[\t ]*\\(?:from \\)?\
-\\([^\(\n][^[:space:]\n]*\\):\\([1-9][0-9]*\\)\\(:in `.*'\\)?.*$" 1 2)
-
(ruby-Test::Unit
"[\t ]*\\[\\([^\(].*\\):\\([1-9][0-9]*\\)\\(\\]\\)?:$" 1 2)
@@ -772,12 +768,27 @@ The value can be either 2 -- skip anything less than error, 1 --
skip anything less than warning or 0 -- don't skip any messages.
Note that all messages not positively identified as warning or
info, are considered errors."
- :type '(choice (const :tag "Warnings and info" 2)
- (const :tag "Info" 1)
- (const :tag "None" 0))
+ :type '(choice (const :tag "Skip warnings and info" 2)
+ (const :tag "Skip info" 1)
+ (const :tag "No skip" 0))
:group 'compilation
:version "22.1")
+(defun compilation-set-skip-threshold (level)
+ "Switch the `compilation-skip-threshold' level."
+ (interactive
+ (list
+ (mod (if current-prefix-arg
+ (prefix-numeric-value current-prefix-arg)
+ (1+ compilation-skip-threshold))
+ 3)))
+ (setq compilation-skip-threshold level)
+ (message "Skipping %s"
+ (case compilation-skip-threshold
+ (0 "Nothing")
+ (1 "Info messages")
+ (2 "Warnings and info"))))
+
(defcustom compilation-skip-visited nil
"Compilation motion commands skip visited messages if this is t.
Visited messages are ones for which the file, line and column have been jumped
@@ -1218,7 +1229,7 @@ Returns the compilation buffer created."
(let* ((name-of-mode
(if (eq mode t)
"compilation"
- (replace-regexp-in-string "-mode$" "" (symbol-name mode))))
+ (replace-regexp-in-string "-mode\\'" "" (symbol-name mode))))
(thisdir default-directory)
outwin outbuf)
(with-current-buffer
@@ -2383,7 +2394,7 @@ The file-structure looks like this:
(defun compilation-forget-errors ()
;; In case we hit the same file/line specs, we want to recompute a new
;; marker for them, so flush our cache.
- (setq compilation-locs (make-hash-table :test 'equal :weakness 'value))
+ (clrhash compilation-locs)
(setq compilation-gcpro nil)
;; FIXME: the old code reset the directory-stack, so maybe we should
;; put a `directory change' marker of some sort, but where? -stef
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index d69cce76fa..d89e41b38f 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -1840,7 +1840,13 @@ or as help on variables `cperl-tips', `cperl-problems',
(make-local-variable 'cperl-syntax-state)
(setq cperl-syntax-state nil) ; reset syntaxification cache
(if cperl-use-syntax-table-text-property
- (progn
+ (if (boundp 'syntax-propertize-function)
+ (progn
+ ;; Reset syntaxification cache.
+ (set (make-local-variable 'cperl-syntax-done-to) nil)
+ (set (make-local-variable 'syntax-propertize-function)
+ (lambda (start end)
+ (goto-char start) (cperl-fontify-syntaxically end))))
(make-local-variable 'parse-sexp-lookup-properties)
;; Do not introduce variable if not needed, we check it!
(set 'parse-sexp-lookup-properties t)
diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el
index e4b380995d..00c11086ce 100644
--- a/lisp/progmodes/cwarn.el
+++ b/lisp/progmodes/cwarn.el
@@ -6,7 +6,7 @@
;; Author: Anders Lindgren <[email protected]>
;; Keywords: c, languages, faces
;; X-Url: http://www.andersl.com/emacs
-;; Version: 1.3.1 1999-12-13
+;; Version: 1.3.1
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/ebnf-abn.el b/lisp/progmodes/ebnf-abn.el
index 17173bd045..a8741a30cf 100644
--- a/lisp/progmodes/ebnf-abn.el
+++ b/lisp/progmodes/ebnf-abn.el
@@ -7,6 +7,7 @@
;; Maintainer: Vinicius Jose Latorre <[email protected]>
;; Keywords: wp, ebnf, PostScript
;; Version: 1.2
+;; Package: ebnf2ps
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/ebnf-bnf.el b/lisp/progmodes/ebnf-bnf.el
index 3c71f29b23..45f2fe727e 100644
--- a/lisp/progmodes/ebnf-bnf.el
+++ b/lisp/progmodes/ebnf-bnf.el
@@ -7,6 +7,7 @@
;; Maintainer: Vinicius Jose Latorre <[email protected]>
;; Keywords: wp, ebnf, PostScript
;; Version: 1.10
+;; Package: ebnf2ps
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/ebnf-dtd.el b/lisp/progmodes/ebnf-dtd.el
index 2bd527a022..2ca38406d4 100644
--- a/lisp/progmodes/ebnf-dtd.el
+++ b/lisp/progmodes/ebnf-dtd.el
@@ -7,6 +7,7 @@
;; Maintainer: Vinicius Jose Latorre <[email protected]>
;; Keywords: wp, ebnf, PostScript
;; Version: 1.1
+;; Package: ebnf2ps
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/ebnf-ebx.el b/lisp/progmodes/ebnf-ebx.el
index 901c80a722..dd94f9e638 100644
--- a/lisp/progmodes/ebnf-ebx.el
+++ b/lisp/progmodes/ebnf-ebx.el
@@ -7,6 +7,7 @@
;; Maintainer: Vinicius Jose Latorre <[email protected]>
;; Keywords: wp, ebnf, PostScript
;; Version: 1.2
+;; Package: ebnf2ps
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/ebnf-iso.el b/lisp/progmodes/ebnf-iso.el
index ad5683cb7f..fa1592bb17 100644
--- a/lisp/progmodes/ebnf-iso.el
+++ b/lisp/progmodes/ebnf-iso.el
@@ -7,6 +7,7 @@
;; Maintainer: Vinicius Jose Latorre <[email protected]>
;; Keywords: wp, ebnf, PostScript
;; Version: 1.9
+;; Package: ebnf2ps
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/ebnf-otz.el b/lisp/progmodes/ebnf-otz.el
index a9c4838d9e..b005d95a80 100644
--- a/lisp/progmodes/ebnf-otz.el
+++ b/lisp/progmodes/ebnf-otz.el
@@ -7,6 +7,7 @@
;; Maintainer: Vinicius Jose Latorre <[email protected]>
;; Keywords: wp, ebnf, PostScript
;; Version: 1.0
+;; Package: ebnf2ps
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/ebnf-yac.el b/lisp/progmodes/ebnf-yac.el
index e2a35dbc94..a7f1851cff 100644
--- a/lisp/progmodes/ebnf-yac.el
+++ b/lisp/progmodes/ebnf-yac.el
@@ -7,6 +7,7 @@
;; Maintainer: Vinicius Jose Latorre <[email protected]>
;; Keywords: wp, ebnf, PostScript
;; Version: 1.4
+;; Package: ebnf2ps
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 4f0fcd77ab..2018a71574 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -40,6 +40,7 @@ If you set this variable, do not also set `tags-table-list'.
Use the `etags' program to make a tags table file.")
;; Make M-x set-variable tags-file-name like M-x visit-tags-table.
;;;###autoload (put 'tags-file-name 'variable-interactive (purecopy "fVisit tags table: "))
+;;;###autoload (put 'tags-file-name 'safe-local-variable 'stringp)
(defgroup etags nil "Tags tables."
:group 'tools)
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 2a19821553..712af6fd28 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -1152,7 +1152,8 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'."
(when dir
(let ((default-directory dir))
(flymake-log 3 "starting process on dir %s" default-directory)))
- (setq process (apply 'start-process "flymake-proc" (current-buffer) cmd args))
+ (setq process (apply 'start-file-process
+ "flymake-proc" (current-buffer) cmd args))
(set-process-sentinel process 'flymake-process-sentinel)
(set-process-filter process 'flymake-process-filter)
(push process flymake-processes)
diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el
index c37744bfe4..daa0fd0736 100644
--- a/lisp/progmodes/fortran.el
+++ b/lisp/progmodes/fortran.el
@@ -483,6 +483,7 @@ The only difference is, it returns t in a case when the default returns nil."
"Maximum highlighting for Fortran mode.
Consists of level 3 plus all other intrinsics not already highlighted.")
+(defvar fortran--font-lock-syntactic-keywords)
;; Comments are real pain in Fortran because there is no way to
;; represent the standard comment syntax in an Emacs syntax table.
;; (We can do so for F90-style). Therefore an unmatched quote in a
@@ -887,9 +888,11 @@ with no args, if that value is non-nil."
fortran-font-lock-keywords-3
fortran-font-lock-keywords-4)
nil t ((?/ . "$/") ("_$" . "w"))
- fortran-beginning-of-subprogram
- (font-lock-syntactic-keywords
- . fortran-font-lock-syntactic-keywords)))
+ fortran-beginning-of-subprogram))
+ (set (make-local-variable 'fortran--font-lock-syntactic-keywords)
+ (fortran-make-syntax-propertize-function))
+ (set (make-local-variable 'syntax-propertize-function)
+ (syntax-propertize-via-font-lock fortran--font-lock-syntactic-keywords))
(set (make-local-variable 'imenu-case-fold-search) t)
(set (make-local-variable 'imenu-generic-expression)
fortran-imenu-generic-expression)
@@ -917,11 +920,13 @@ affects all Fortran buffers, and also the default."
(when (eq major-mode 'fortran-mode)
(setq fortran-line-length nchars
fill-column fortran-line-length
- new (fortran-font-lock-syntactic-keywords))
+ new (fortran-make-syntax-propertize-function))
;; Refontify only if necessary.
- (unless (equal new font-lock-syntactic-keywords)
- (setq font-lock-syntactic-keywords
- (fortran-font-lock-syntactic-keywords))
+ (unless (equal new fortran--font-lock-syntactic-keywords)
+ (setq fortran--font-lock-syntactic-keywords new)
+ (setq syntax-propertize-function
+ (syntax-propertize-via-font-lock new))
+ (syntax-ppss-flush-cache (point-min))
(if font-lock-mode (font-lock-mode 1))))))
(if global
(buffer-list)
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index d20a14682c..4c1471e39e 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -3123,10 +3123,12 @@ class of the file (using s to separate nested class ids)."
("\\$\\(\\w+\\)" (1 font-lock-variable-name-face))
("^\\s-*\\(\\w\\(\\w\\|\\s_\\)*\\)" (1 font-lock-keyword-face))))
-(defvar gdb-script-font-lock-syntactic-keywords
- '(("^document\\s-.*\\(\n\\)" (1 "< b"))
- ("^end\\>"
- (0 (unless (eq (match-beginning 0) (point-min))
+(defconst gdb-script-syntax-propertize-function
+ (syntax-propertize-rules
+ ("^document\\s-.*\\(\n\\)" (1 "< b"))
+ ("^end\\(\\>\\)"
+ (1 (ignore
+ (unless (eq (match-beginning 0) (point-min))
;; We change the \n in front, which is more difficult, but results
;; in better highlighting. If the doc is empty, the single \n is
;; both the beginning and the end of the docstring, which can't be
@@ -3138,10 +3140,9 @@ class of the file (using s to separate nested class ids)."
'syntax-table (eval-when-compile
(string-to-syntax "> b")))
;; Make sure that rehighlighting the previous line won't erase our
- ;; syntax-table property.
+ ;; syntax-table property and that modifying `end' will.
(put-text-property (1- (match-beginning 0)) (match-end 0)
- 'font-lock-multiline t)
- nil)))))
+ 'syntax-multiline t)))))))
(defun gdb-script-font-lock-syntactic-face (state)
(cond
@@ -3239,10 +3240,13 @@ Treats actions as defuns."
#'gdb-script-end-of-defun)
(set (make-local-variable 'font-lock-defaults)
'(gdb-script-font-lock-keywords nil nil ((?_ . "w")) nil
- (font-lock-syntactic-keywords
- . gdb-script-font-lock-syntactic-keywords)
(font-lock-syntactic-face-function
- . gdb-script-font-lock-syntactic-face))))
+ . gdb-script-font-lock-syntactic-face)))
+ ;; Recognize docstrings.
+ (set (make-local-variable 'syntax-propertize-function)
+ gdb-script-syntax-propertize-function)
+ (add-hook 'syntax-propertize-extend-region-functions
+ #'syntax-propertize-multiline 'append 'local))
;;; tooltips for GUD
diff --git a/lisp/progmodes/idlw-complete-structtag.el b/lisp/progmodes/idlw-complete-structtag.el
index 696853e092..95acc42773 100644
--- a/lisp/progmodes/idlw-complete-structtag.el
+++ b/lisp/progmodes/idlw-complete-structtag.el
@@ -7,6 +7,7 @@
;; Maintainer: J.D. Smith <[email protected]>
;; Version: 1.2
;; Keywords: languages
+;; Package: idlwave
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el
index f6eff9c3cf..850d68e918 100644
--- a/lisp/progmodes/idlw-help.el
+++ b/lisp/progmodes/idlw-help.el
@@ -6,7 +6,8 @@
;; Authors: J.D. Smith <[email protected]>
;; Carsten Dominik <[email protected]>
;; Maintainer: J.D. Smith <[email protected]>
-;; Version: 6.1_em22
+;; Version: 6.1.22
+;; Package: idlwave
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el
index dbe6f179e5..3acd396e9c 100644
--- a/lisp/progmodes/idlw-shell.el
+++ b/lisp/progmodes/idlw-shell.el
@@ -7,8 +7,9 @@
;; Carsten Dominik <[email protected]>
;; Chris Chase <[email protected]>
;; Maintainer: J.D. Smith <[email protected]>
-;; Version: 6.1_em22
+;; Version: 6.1.22
;; Keywords: processes
+;; Package: idlwave
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/idlw-toolbar.el b/lisp/progmodes/idlw-toolbar.el
index 395cfd5404..474065451d 100644
--- a/lisp/progmodes/idlw-toolbar.el
+++ b/lisp/progmodes/idlw-toolbar.el
@@ -5,8 +5,9 @@
;; Author: Carsten Dominik <[email protected]>
;; Maintainer: J.D. Smith <[email protected]>
-;; Version: 6.1_em22
+;; Version: 6.1.22
;; Keywords: processes
+;; Package: idlwave
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index 1d042c9945..dc85d09481 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -7,7 +7,7 @@
;; Carsten Dominik <[email protected]>
;; Chris Chase <[email protected]>
;; Maintainer: J.D. Smith <[email protected]>
-;; Version: 6.1_em22
+;; Version: 6.1.22
;; Keywords: languages
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index d6feca4d8a..ba70bb8ecc 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -7,7 +7,7 @@
;; Maintainer: Daniel Colascione <[email protected]>
;; Version: 9
;; Date: 2009-07-25
-;; Keywords: languages, oop, javascript
+;; Keywords: languages, javascript
;; This file is part of GNU Emacs.
@@ -45,16 +45,16 @@
;;; Code:
-(eval-and-compile
- (require 'cc-mode)
- (require 'font-lock)
- (require 'newcomment)
- (require 'imenu)
- (require 'etags)
- (require 'thingatpt)
- (require 'easymenu)
- (require 'moz nil t)
- (require 'json nil t))
+
+(require 'cc-mode)
+(require 'font-lock)
+(require 'newcomment)
+(require 'imenu)
+(require 'etags)
+(require 'thingatpt)
+(require 'easymenu)
+(require 'moz nil t)
+(require 'json nil t)
(eval-when-compile
(require 'cl)
@@ -431,11 +431,32 @@ Match group 1 is the name of the macro.")
:group 'js)
(defcustom js-expr-indent-offset 0
- "Number of additional spaces used for indentation of continued expressions.
+ "Number of additional spaces for indenting continued expressions.
The value must be no less than minus `js-indent-level'."
:type 'integer
:group 'js)
+(defcustom js-paren-indent-offset 0
+ "Number of additional spaces for indenting expressions in parentheses.
+The value must be no less than minus `js-indent-level'."
+ :type 'integer
+ :group 'js
+ :version "24.1")
+
+(defcustom js-square-indent-offset 0
+ "Number of additional spaces for indenting expressions in square braces.
+The value must be no less than minus `js-indent-level'."
+ :type 'integer
+ :group 'js
+ :version "24.1")
+
+(defcustom js-curly-indent-offset 0
+ "Number of additional spaces for indenting expressions in curly braces.
+The value must be no less than minus `js-indent-level'."
+ :type 'integer
+ :group 'js
+ :version "24.1")
+
(defcustom js-auto-indent-flag t
"Whether to automatically indent when typing punctuation characters.
If non-nil, the characters {}();,: also indent the current line
@@ -704,20 +725,19 @@ as if strings, cpp macros, and comments have been removed.
If invoked while inside a macro, it treats the contents of the
macro as normal text."
+ (unless count (setq count 1))
(let ((saved-point (point))
- (search-expr
- (cond ((null count)
- '(js--re-search-forward-inner regexp bound 1))
- ((< count 0)
- '(js--re-search-backward-inner regexp bound (- count)))
- ((> count 0)
- '(js--re-search-forward-inner regexp bound count)))))
+ (search-fun
+ (cond ((< count 0) (setq count (- count))
+ #'js--re-search-backward-inner)
+ ((> count 0) #'js--re-search-forward-inner)
+ (t #'ignore))))
(condition-case err
- (eval search-expr)
+ (funcall search-fun regexp bound count)
(search-failed
(goto-char saved-point)
(unless noerror
- (error (error-message-string err)))))))
+ (signal (car err) (cdr err)))))))
(defun js--re-search-backward-inner (regexp &optional bound count)
@@ -761,20 +781,7 @@ as if strings, preprocessor macros, and comments have been
removed.
If invoked while inside a macro, treat the macro as normal text."
- (let ((saved-point (point))
- (search-expr
- (cond ((null count)
- '(js--re-search-backward-inner regexp bound 1))
- ((< count 0)
- '(js--re-search-forward-inner regexp bound (- count)))
- ((> count 0)
- '(js--re-search-backward-inner regexp bound count)))))
- (condition-case err
- (eval search-expr)
- (search-failed
- (goto-char saved-point)
- (unless noerror
- (error (error-message-string err)))))))
+ (js--re-search-forward regexp bound noerror (if count (- count) -1)))
(defun js--forward-expression ()
"Move forward over a whole JavaScript expression.
@@ -1653,18 +1660,19 @@ This performs fontification according to `js--class-styles'."
;; XXX: Javascript can continue a regexp literal across lines so long
;; as the newline is escaped with \. Account for that in the regexp
;; below.
-(defconst js--regexp-literal
+(eval-and-compile
+ (defconst js--regexp-literal
"[=(,:]\\(?:\\s-\\|\n\\)*\\(/\\)\\(?:\\\\/\\|[^/*]\\)\\(?:\\\\/\\|[^/]\\)*\\(/\\)"
"Regexp matching a JavaScript regular expression literal.
Match groups 1 and 2 are the characters forming the beginning and
-end of the literal.")
+end of the literal."))
-;; we want to match regular expressions only at the beginning of
-;; expressions
-(defconst js-font-lock-syntactic-keywords
- `((,js--regexp-literal (1 "|") (2 "|")))
- "Syntactic font lock keywords matching regexps in JavaScript.
-See `font-lock-keywords'.")
+
+(defconst js-syntax-propertize-function
+ (syntax-propertize-rules
+ ;; We want to match regular expressions only at the beginning of
+ ;; expressions.
+ (js--regexp-literal (1 "\"") (2 "\""))))
;;; Indentation
@@ -1769,14 +1777,17 @@ nil."
((eq (char-after) ?#) 0)
((save-excursion (js--beginning-of-macro)) 4)
((nth 1 parse-status)
+ ;; A single closing paren/bracket should be indented at the
+ ;; same level as the opening statement. Same goes for
+ ;; "case" and "default".
(let ((same-indent-p (looking-at
"[]})]\\|\\_<case\\_>\\|\\_<default\\_>"))
(continued-expr-p (js--continued-expression-p)))
- (goto-char (nth 1 parse-status))
+ (goto-char (nth 1 parse-status)) ; go to the opening char
(if (looking-at "[({[]\\s-*\\(/[/*]\\|$\\)")
- (progn
+ (progn ; nothing following the opening paren/bracket
(skip-syntax-backward " ")
- (when (eq (char-before) ?\)) (backward-list))
+ (when (eq (char-before) ?\)) (backward-list))
(back-to-indentation)
(cond (same-indent-p
(current-column))
@@ -1784,7 +1795,14 @@ nil."
(+ (current-column) (* 2 js-indent-level)
js-expr-indent-offset))
(t
- (+ (current-column) js-indent-level))))
+ (+ (current-column) js-indent-level
+ (case (char-after (nth 1 parse-status))
+ (?\( js-paren-indent-offset)
+ (?\[ js-square-indent-offset)
+ (?\{ js-curly-indent-offset))))))
+ ;; If there is something following the opening
+ ;; paren/bracket, everything else should be indented at
+ ;; the same level.
(unless same-indent-p
(forward-char)
(skip-chars-forward " \t"))
@@ -3286,10 +3304,9 @@ Key bindings:
(set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil)
(set (make-local-variable 'font-lock-defaults)
- (list js--font-lock-keywords
- nil nil nil nil
- '(font-lock-syntactic-keywords
- . js-font-lock-syntactic-keywords)))
+ '(js--font-lock-keywords))
+ (set (make-local-variable 'syntax-propertize-function)
+ js-syntax-propertize-function)
(set (make-local-variable 'parse-sexp-ignore-comments) t)
(set (make-local-variable 'parse-sexp-lookup-properties) t)
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index 15664c8e56..187c838382 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -505,15 +505,16 @@ not be enclosed in { } or ( )."
cpp-font-lock-keywords))
-(defconst makefile-font-lock-syntactic-keywords
- ;; From sh-script.el.
- ;; A `#' begins a comment in sh when it is unquoted and at the beginning
- ;; of a word. In the shell, words are separated by metacharacters.
- ;; The list of special chars is taken from the single-unix spec of the
- ;; shell command language (under `quoting') but with `$' removed.
- '(("[^|&;<>()`\\\"' \t\n]\\(#+\\)" 1 "_")
- ;; Change the syntax of a quoted newline so that it does not end a comment.
- ("\\\\\n" 0 ".")))
+(defconst makefile-syntax-propertize-function
+ (syntax-propertize-rules
+ ;; From sh-script.el.
+ ;; A `#' begins a comment in sh when it is unquoted and at the beginning
+ ;; of a word. In the shell, words are separated by metacharacters.
+ ;; The list of special chars is taken from the single-unix spec of the
+ ;; shell command language (under `quoting') but with `$' removed.
+ ("[^|&;<>()`\\\"' \t\n]\\(#+\\)" (1 "_"))
+ ;; Change the syntax of a quoted newline so that it does not end a comment.
+ ("\\\\\n" (0 "."))))
(defvar makefile-imenu-generic-expression
`(("Dependencies" makefile-previous-dependency 1)
@@ -872,9 +873,9 @@ Makefile mode can be configured by modifying the following variables:
'(makefile-font-lock-keywords
nil nil
((?$ . "."))
- backward-paragraph
- (font-lock-syntactic-keywords
- . makefile-font-lock-syntactic-keywords)))
+ backward-paragraph))
+ (set (make-local-variable 'syntax-propertize-function)
+ makefile-syntax-propertize-function)
;; Add-log.
(set (make-local-variable 'add-log-current-defun-function)
@@ -943,15 +944,9 @@ Makefile mode can be configured by modifying the following variables:
(define-derived-mode makefile-imake-mode makefile-mode "Imakefile"
"An adapted `makefile-mode' that knows about imake."
:syntax-table makefile-imake-mode-syntax-table
- (let ((base `(makefile-imake-font-lock-keywords ,@(cdr font-lock-defaults)))
- new)
- ;; Remove `font-lock-syntactic-keywords' entry from font-lock-defaults.
- (mapc (lambda (elt)
- (unless (and (consp elt)
- (eq (car elt) 'font-lock-syntactic-keywords))
- (setq new (cons elt new))))
- base)
- (setq font-lock-defaults (nreverse new))))
+ (set (make-local-variable 'syntax-propertize-function) nil)
+ (setq font-lock-defaults
+ `(makefile-imake-font-lock-keywords ,@(cdr font-lock-defaults))))
@@ -1300,7 +1295,9 @@ definition and conveniently use this command."
(save-restriction
(narrow-to-region beginning end)
(makefile-backslash-region (point-min) (point-max) t)
- (let ((fill-paragraph-function nil))
+ (let ((fill-paragraph-function nil)
+ ;; Adjust fill-column to allow space for the backslash.
+ (fill-column (- fill-column 1)))
(fill-paragraph nil))
(makefile-backslash-region (point-min) (point-max) nil)
(goto-char (point-max))
@@ -1314,7 +1311,9 @@ definition and conveniently use this command."
;; resulting region.
(save-restriction
(narrow-to-region (point) (line-beginning-position 2))
- (let ((fill-paragraph-function nil))
+ (let ((fill-paragraph-function nil)
+ ;; Adjust fill-column to allow space for the backslash.
+ (fill-column (- fill-column 1)))
(fill-paragraph nil))
(makefile-backslash-region (point-min) (point-max) nil))
;; Return non-nil to indicate it's been filled.
diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el
index ecb8461a9f..94af563d88 100644
--- a/lisp/progmodes/mixal-mode.el
+++ b/lisp/progmodes/mixal-mode.el
@@ -89,7 +89,7 @@
(defvar mixal-mode-syntax-table
(let ((st (make-syntax-table)))
;; We need to do a bit more to make fontlocking for comments work.
- ;; See mixal-font-lock-syntactic-keywords.
+ ;; See use of syntax-propertize-function.
;; (modify-syntax-entry ?* "<" st)
(modify-syntax-entry ?\n ">" st)
st)
@@ -1028,13 +1028,14 @@ EXECUTION-TIME holds info about the time it takes, number or string.")
;;; Font-locking:
-(defvar mixal-font-lock-syntactic-keywords
- ;; Normal comments start with a * in column 0 and end at end of line.
- '(("^\\*" (0 '(11))) ;(string-to-syntax "<") == '(11)
- ;; Every line can end with a comment which is placed after the operand.
- ;; I assume here that mnemonics without operands can not have a comment.
- ("^[[:alnum:]]*[ \t]+[[:alnum:]]+[ \t]+[^ \n\t]+[ \t]*\\([ \t]\\)[^\n \t]"
- (1 '(11)))))
+(defconst mixal-syntax-propertize-function
+ (syntax-propertize-rules
+ ;; Normal comments start with a * in column 0 and end at end of line.
+ ("^\\*" (0 "<"))
+ ;; Every line can end with a comment which is placed after the operand.
+ ;; I assume here that mnemonics without operands can not have a comment.
+ ("^[[:alnum:]]*[ \t]+[[:alnum:]]+[ \t]+[^ \n\t]+[ \t]*\\([ \t]\\)[^\n \t]"
+ (1 "<"))))
(defvar mixal-font-lock-keywords
`(("^\\([A-Z0-9a-z]+\\)"
@@ -1110,9 +1111,9 @@ Assumes that file has been compiled with debugging support."
(set (make-local-variable 'comment-start) "*")
(set (make-local-variable 'comment-start-skip) "^\\*[ \t]*")
(set (make-local-variable 'font-lock-defaults)
- `(mixal-font-lock-keywords nil nil nil nil
- (font-lock-syntactic-keywords . ,mixal-font-lock-syntactic-keywords)
- (parse-sexp-lookup-properties . t)))
+ `(mixal-font-lock-keywords))
+ (set (make-local-variable 'syntax-propertize-function)
+ mixal-syntax-propertize-function)
;; might add an indent function in the future
;; (set (make-local-variable 'indent-line-function) 'mixal-indent-line)
(set (make-local-variable 'compile-command) (concat "mixasm "
diff --git a/lisp/progmodes/octave-inf.el b/lisp/progmodes/octave-inf.el
index 8e64d5689d..c526a634d8 100644
--- a/lisp/progmodes/octave-inf.el
+++ b/lisp/progmodes/octave-inf.el
@@ -7,6 +7,7 @@
;; Author: John Eaton <[email protected]>
;; Maintainer: Kurt Hornik <[email protected]>
;; Keywords: languages
+;; Package: octave-mod
;; This file is part of GNU Emacs.
diff --git a/lisp/progmodes/octave-mod.el b/lisp/progmodes/octave-mod.el
index 12f561c681..bbefdaa2cc 100644
--- a/lisp/progmodes/octave-mod.el
+++ b/lisp/progmodes/octave-mod.el
@@ -4,7 +4,7 @@
;; Free Software Foundation, Inc.
;; Author: Kurt Hornik <[email protected]>
-;; Author: John Eaton <[email protected]>
+;; Author: John Eaton <[email protected]>
;; Maintainer: Kurt Hornik <[email protected]>
;; Keywords: languages
@@ -92,7 +92,7 @@ All Octave abbrevs start with a grave accent (`)."
(defvar octave-comment-char ?#
"Character to start an Octave comment.")
(defvar octave-comment-start
- (string octave-comment-char ?\ )
+ (string octave-comment-char ?\s)
"String to insert to start a new Octave in-line comment.")
(defvar octave-comment-start-skip "\\s<+\\s-*"
"Regexp to match the start of an Octave comment up to its body.")
@@ -161,8 +161,8 @@ parenthetical grouping.")
(list
;; Fontify all builtin keywords.
(cons (concat "\\<\\("
- (mapconcat 'identity octave-reserved-words "\\|")
- (mapconcat 'identity octave-text-functions "\\|")
+ (regexp-opt (append octave-reserved-words
+ octave-text-functions))
"\\)\\>")
'font-lock-keyword-face)
;; Fontify all builtin operators.
@@ -171,9 +171,7 @@ parenthetical grouping.")
'font-lock-builtin-face
'font-lock-preprocessor-face))
;; Fontify all builtin variables.
- (cons (concat "\\<\\("
- (mapconcat 'identity octave-variables "\\|")
- "\\)\\>")
+ (cons (concat "\\<" (regexp-opt octave-variables) "\\>")
'font-lock-variable-name-face)
;; Fontify all function declarations.
(list octave-function-header-regexp
@@ -181,6 +179,29 @@ parenthetical grouping.")
'(3 font-lock-function-name-face nil t)))
"Additional Octave expressions to highlight.")
+(defun octave-syntax-propertize-function (start end)
+ (goto-char start)
+ (octave-syntax-propertize-sqs end)
+ (funcall (syntax-propertize-rules
+ ;; Try to distinguish the string-quotes from the transpose-quotes.
+ ("[[({,; ]\\('\\)"
+ (1 (prog1 "\"'" (octave-syntax-propertize-sqs end)))))
+ (point) end))
+
+(defun octave-syntax-propertize-sqs (end)
+ "Propertize the content/end of single-quote strings."
+ (when (eq (nth 3 (syntax-ppss)) ?\')
+ ;; A '..' string.
+ (when (re-search-forward
+ "\\(?:\\=\\|[^']\\)\\(?:''\\)*\\('\\)\\($\\|[^']\\)" end 'move)
+ (goto-char (match-beginning 2))
+ (when (eq (char-before (match-beginning 1)) ?\\)
+ ;; Backslash cannot escape a single quote.
+ (put-text-property (1- (match-beginning 1)) (match-beginning 1)
+ 'syntax-table (string-to-syntax ".")))
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'syntax-table (string-to-syntax "\"'")))))
+
(defcustom inferior-octave-buffer "*Inferior Octave*"
"Name of buffer for running an inferior Octave process."
:type 'string
@@ -194,27 +215,17 @@ parenthetical grouping.")
(define-key map ";" 'octave-electric-semi)
(define-key map " " 'octave-electric-space)
(define-key map "\n" 'octave-reindent-then-newline-and-indent)
- (define-key map "\e;" 'octave-indent-for-comment)
(define-key map "\e\n" 'octave-indent-new-comment-line)
- (define-key map "\e\t" 'octave-complete-symbol)
- (define-key map "\M-\C-a" 'octave-beginning-of-defun)
- (define-key map "\M-\C-e" 'octave-end-of-defun)
- (define-key map "\M-\C-h" 'octave-mark-defun)
(define-key map "\M-\C-q" 'octave-indent-defun)
- (define-key map "\C-c;" 'octave-comment-region)
- (define-key map "\C-c:" 'octave-uncomment-region)
(define-key map "\C-c\C-b" 'octave-submit-bug-report)
(define-key map "\C-c\C-p" 'octave-previous-code-line)
(define-key map "\C-c\C-n" 'octave-next-code-line)
(define-key map "\C-c\C-a" 'octave-beginning-of-line)
(define-key map "\C-c\C-e" 'octave-end-of-line)
- (define-key map "\C-c\M-\C-n" 'octave-forward-block)
- (define-key map "\C-c\M-\C-p" 'octave-backward-block)
- (define-key map "\C-c\M-\C-u" 'octave-backward-up-block)
- (define-key map "\C-c\M-\C-d" 'octave-down-block)
+ (define-key map [remap down-list] 'smie-down-list)
(define-key map "\C-c\M-\C-h" 'octave-mark-block)
- (define-key map "\C-c]" 'octave-close-block)
- (define-key map "\C-c/" 'octave-close-block)
+ (define-key map "\C-c]" 'smie-close-block)
+ (define-key map "\C-c/" 'smie-close-block)
(define-key map "\C-c\C-f" 'octave-insert-defun)
(define-key map "\C-c\C-h" 'octave-help)
(define-key map "\C-c\C-il" 'octave-send-line)
@@ -235,7 +246,9 @@ parenthetical grouping.")
"Keymap used in Octave mode.")
-(defvar octave-mode-menu
+
+(easy-menu-define octave-mode-menu octave-mode-map
+ "Menu for Octave mode."
'("Octave"
("Lines"
["Previous Code Line" octave-previous-code-line t]
@@ -244,16 +257,9 @@ parenthetical grouping.")
["End of Continuation" octave-end-of-line t]
["Split Line at Point" octave-indent-new-comment-line t])
("Blocks"
- ["Next Block" octave-forward-block t]
- ["Previous Block" octave-backward-block t]
- ["Down Block" octave-down-block t]
- ["Up Block" octave-backward-up-block t]
["Mark Block" octave-mark-block t]
- ["Close Block" octave-close-block t])
+ ["Close Block" smie-close-block t])
("Functions"
- ["Begin of Function" octave-beginning-of-defun t]
- ["End of Function" octave-end-of-defun t]
- ["Mark Function" octave-mark-defun t]
["Indent Function" octave-indent-defun t]
["Insert Function" octave-insert-defun t])
"-"
@@ -267,16 +273,17 @@ parenthetical grouping.")
["Kill Process" octave-kill-process t])
"-"
["Indent Line" indent-according-to-mode t]
- ["Complete Symbol" octave-complete-symbol t]
+ ["Complete Symbol" completion-at-point t]
"-"
- ["Toggle Abbrev Mode" abbrev-mode t]
- ["Toggle Auto-Fill Mode" auto-fill-mode t]
+ ["Toggle Abbrev Mode" abbrev-mode
+ :style toggle :selected abbrev-mode]
+ ["Toggle Auto-Fill Mode" auto-fill-mode
+ :style toggle :selected auto-fill-function]
"-"
["Submit Bug Report" octave-submit-bug-report t]
"-"
- ["Describe Octave Mode" octave-describe-major-mode t]
- ["Lookup Octave Index" octave-help t])
- "Menu for Octave mode.")
+ ["Describe Octave Mode" describe-mode t]
+ ["Lookup Octave Index" info-lookup-symbol t]))
(defvar octave-mode-syntax-table
(let ((table (make-syntax-table)))
@@ -298,8 +305,16 @@ parenthetical grouping.")
(modify-syntax-entry ?\" "\"" table)
(modify-syntax-entry ?. "w" table)
(modify-syntax-entry ?_ "w" table)
- (modify-syntax-entry ?\% "<" table)
- (modify-syntax-entry ?\# "<" table)
+ ;; The "b" flag only applies to the second letter of the comstart
+ ;; and the first letter of the comend, i.e. the "4b" below is ineffective.
+ ;; If we try to put `b' on the single-line comments, we get a similar
+ ;; problem where the % and # chars appear as first chars of the 2-char
+ ;; comend, so the multi-line ender is also turned into style-b.
+ ;; So we need the new "c" comment style.
+ (modify-syntax-entry ?\% "< 13" table)
+ (modify-syntax-entry ?\# "< 13" table)
+ (modify-syntax-entry ?\{ "(} 2c" table)
+ (modify-syntax-entry ?\} "){ 4c" table)
(modify-syntax-entry ?\n ">" table)
table)
"Syntax table in use in `octave-mode' buffers.")
@@ -320,40 +335,12 @@ Non-nil means show matching begin of block when inserting a space,
newline or semicolon after an else or end keyword."
:type 'boolean
:group 'octave)
+
(defcustom octave-block-offset 2
"Extra indentation applied to statements in Octave block structures."
:type 'integer
:group 'octave)
-(defvar octave-block-begin-regexp
- (concat "\\<\\("
- (mapconcat 'identity octave-begin-keywords "\\|")
- "\\)\\>"))
-(defvar octave-block-else-regexp
- (concat "\\<\\("
- (mapconcat 'identity octave-else-keywords "\\|")
- "\\)\\>"))
-(defvar octave-block-end-regexp
- (concat "\\<\\("
- (mapconcat 'identity octave-end-keywords "\\|")
- "\\)\\>"))
-(defvar octave-block-begin-or-end-regexp
- (concat octave-block-begin-regexp "\\|" octave-block-end-regexp))
-(defvar octave-block-else-or-end-regexp
- (concat octave-block-else-regexp "\\|" octave-block-end-regexp))
-(defvar octave-block-match-alist
- '(("do" . ("until"))
- ("for" . ("endfor" "end"))
- ("function" . ("endfunction"))
- ("if" . ("else" "elseif" "endif" "end"))
- ("switch" . ("case" "otherwise" "endswitch" "end"))
- ("try" . ("catch" "end_try_catch"))
- ("unwind_protect" . ("unwind_protect_cleanup" "end_unwind_protect"))
- ("while" . ("endwhile" "end")))
- "Alist with Octave's matching block keywords.
-Has Octave's begin keywords as keys and a list of the matching else or
-end keywords as associated values.")
-
(defvar octave-block-comment-start
(concat (make-string 2 octave-comment-char) " ")
"String to insert to start a new Octave comment on an empty line.")
@@ -362,8 +349,11 @@ end keywords as associated values.")
"Extra indentation applied to Octave continuation lines."
:type 'integer
:group 'octave)
+(eval-and-compile
+ (defconst octave-continuation-marker-regexp "\\\\\\|\\.\\.\\."))
(defvar octave-continuation-regexp
- "[^#%\n]*\\(\\\\\\|\\.\\.\\.\\)\\s-*\\(\\s<.*\\)?$")
+ (concat "[^#%\n]*\\(" octave-continuation-marker-regexp
+ "\\)\\s-*\\(\\s<.*\\)?$"))
(defcustom octave-continuation-string "\\"
"Character string used for Octave continuation lines. Normally \\."
:type 'string
@@ -401,8 +391,153 @@ Non-nil means always go to the next Octave code line after sending."
:group 'octave)
+;;; SMIE indentation
+
+(require 'smie)
+
+(defconst octave-operator-table
+ '((assoc ";" "\n") (assoc ",") ; The doc claims they have equal precedence!?
+ (right "=" "+=" "-=" "*=" "/=")
+ (assoc "&&") (assoc "||") ; The doc claims they have equal precedence!?
+ (assoc "&") (assoc "|") ; The doc claims they have equal precedence!?
+ (nonassoc "<" "<=" "==" ">=" ">" "!=" "~=")
+ (nonassoc ":") ;No idea what this is.
+ (assoc "+" "-")
+ (assoc "*" "/" "\\" ".\\" ".*" "./")
+ (nonassoc "'" ".'")
+ (nonassoc "++" "--" "!" "~") ;And unary "+" and "-".
+ (right "^" "**" ".^" ".**")
+ ;; It's not really an operator, but for indentation purposes it
+ ;; could be convenient to treat it as one.
+ (assoc "...")))
+
+(defconst octave-smie-bnf-table
+ '((atom)
+ ;; We can't distinguish the first element in a sequence with
+ ;; precedence grammars, so we can't distinguish the condition
+ ;; if the `if' from the subsequent body, for example.
+ ;; This has to be done later in the indentation rules.
+ (exp (exp "\n" exp)
+ ;; We need to mention at least one of the operators in this part
+ ;; of the grammar: if the BNF and the operator table have
+ ;; no overlap, SMIE can't know how they relate.
+ (exp ";" exp)
+ ("try" exp "catch" exp "end_try_catch")
+ ("try" exp "catch" exp "end")
+ ("unwind_protect" exp
+ "unwind_protect_cleanup" exp "end_unwind_protect")
+ ("unwind_protect" exp "unwind_protect_cleanup" exp "end")
+ ("for" exp "endfor")
+ ("for" exp "end")
+ ("do" exp "until" atom)
+ ("while" exp "endwhile")
+ ("while" exp "end")
+ ("if" exp "endif")
+ ("if" exp "else" exp "endif")
+ ("if" exp "elseif" exp "else" exp "endif")
+ ("if" exp "elseif" exp "elseif" exp "else" exp "endif")
+ ("if" exp "elseif" exp "elseif" exp "else" exp "end")
+ ("switch" exp "case" exp "endswitch")
+ ("switch" exp "case" exp "otherwise" exp "endswitch")
+ ("switch" exp "case" exp "case" exp "otherwise" exp "endswitch")
+ ("switch" exp "case" exp "case" exp "otherwise" exp "end")
+ ("function" exp "endfunction")
+ ("function" exp "end"))
+ ;; (fundesc (atom "=" atom))
+ ))
+
+(defconst octave-smie-closer-alist
+ (smie-bnf-closer-alist octave-smie-bnf-table))
+
+(defconst octave-smie-op-levels
+ (smie-prec2-levels
+ (smie-merge-prec2s
+ (smie-bnf-precedence-table
+ octave-smie-bnf-table
+ '((assoc "\n" ";")))
+
+ (smie-precs-precedence-table
+ (append octave-operator-table
+ '((nonassoc " -dummy- "))) ;Bogus anchor at the end.
+ ))))
+
+;; Tokenizing needs to be refined so that ";;" is treated as two
+;; tokens and also so as to recognize the \n separator (and
+;; corresponding continuation lines).
+
+(defconst octave-operator-regexp
+ (regexp-opt (apply 'append (mapcar 'cdr octave-operator-table))))
+
+(defun octave-smie-backward-token ()
+ (let ((pos (point)))
+ (forward-comment (- (point)))
+ (cond
+ ((and (not (eq (char-before) ?\;)) ;Coalesce ";" and "\n".
+ (> pos (line-end-position))
+ (if (looking-back octave-continuation-marker-regexp (- (point) 3))
+ (progn
+ (goto-char (match-beginning 0))
+ (forward-comment (- (point)))
+ nil)
+ t)
+ ;; Ignore it if it's within parentheses.
+ (let ((ppss (syntax-ppss)))
+ (not (and (nth 1 ppss)
+ (eq ?\( (char-after (nth 1 ppss)))))))
+ (skip-chars-forward " \t")
+ ;; Why bother distinguishing \n and ;?
+ ";") ;;"\n"
+ ((and (looking-back octave-operator-regexp (- (point) 3) 'greedy)
+ ;; Don't mistake a string quote for a transpose.
+ (not (looking-back "\\s\"" (1- (point)))))
+ (goto-char (match-beginning 0))
+ (match-string-no-properties 0))
+ (t
+ (smie-default-backward-token)))))
+
+(defun octave-smie-forward-token ()
+ (skip-chars-forward " \t")
+ (when (looking-at (eval-when-compile
+ (concat "\\(" octave-continuation-marker-regexp
+ "\\)[ \t]*\\($\\|[%#]\\)")))
+ (goto-char (match-end 1))
+ (forward-comment 1))
+ (cond
+ ((and (looking-at "$\\|[%#]")
+ ;; Ignore it if it's within parentheses.
+ (prog1 (let ((ppss (syntax-ppss)))
+ (not (and (nth 1 ppss)
+ (eq ?\( (char-after (nth 1 ppss))))))
+ (forward-comment (point-max))))
+ ;; Why bother distinguishing \n and ;?
+ ";") ;;"\n"
+ ((looking-at ";[ \t]*\\($\\|[%#]\\)")
+ ;; Combine the ; with the subsequent \n.
+ (goto-char (match-beginning 1))
+ (forward-comment 1)
+ ";")
+ ((and (looking-at octave-operator-regexp)
+ ;; Don't mistake a string quote for a transpose.
+ (not (looking-at "\\s\"")))
+ (goto-char (match-end 0))
+ (match-string-no-properties 0))
+ (t
+ (smie-default-forward-token))))
+
+(defconst octave-smie-indent-rules
+ '((";"
+ (:parent ("function" "if" "while" "else" "elseif" "for" "otherwise"
+ "case" "try" "catch" "unwind_protect" "unwind_protect_cleanup")
+ ;; FIXME: don't hardcode 2.
+ (+ parent octave-block-offset))
+ ;; (:parent "switch" 4) ;For (invalid) code between switch and case.
+ 0)
+ ((:before . "case") octave-block-offset)))
+
+(defvar electric-indent-chars)
+
;;;###autoload
-(defun octave-mode ()
+(define-derived-mode octave-mode prog-mode "Octave"
"Major mode for editing Octave code.
This mode makes it easier to write Octave code by helping with
@@ -485,57 +620,80 @@ an Octave mode buffer.
This automatically sets up a mail buffer with version information
already added. You just need to add a description of the problem,
including a reproducible test case and send the message."
- (interactive)
- (kill-all-local-variables)
-
- (use-local-map octave-mode-map)
- (setq major-mode 'octave-mode)
- (setq mode-name "Octave")
(setq local-abbrev-table octave-abbrev-table)
- (set-syntax-table octave-mode-syntax-table)
-
- (make-local-variable 'indent-line-function)
- (setq indent-line-function 'octave-indent-line)
-
- (make-local-variable 'comment-start)
- (setq comment-start octave-comment-start)
- (make-local-variable 'comment-end)
- (setq comment-end "")
- (make-local-variable 'comment-column)
- (setq comment-column 32)
- (make-local-variable 'comment-start-skip)
- (setq comment-start-skip "\\s<+\\s-*")
- (make-local-variable 'comment-indent-function)
- (setq comment-indent-function 'octave-comment-indent)
-
- (make-local-variable 'parse-sexp-ignore-comments)
- (setq parse-sexp-ignore-comments t)
- (make-local-variable 'paragraph-start)
- (setq paragraph-start (concat "\\s-*$\\|" page-delimiter))
- (make-local-variable 'paragraph-separate)
- (setq paragraph-separate paragraph-start)
- (make-local-variable 'paragraph-ignore-fill-prefix)
- (setq paragraph-ignore-fill-prefix t)
- (make-local-variable 'fill-paragraph-function)
- (setq fill-paragraph-function 'octave-fill-paragraph)
- (make-local-variable 'adaptive-fill-regexp)
- (setq adaptive-fill-regexp nil)
- (make-local-variable 'fill-column)
- (setq fill-column 72)
- (make-local-variable 'normal-auto-fill-function)
- (setq normal-auto-fill-function 'octave-auto-fill)
-
- (make-local-variable 'font-lock-defaults)
- (setq font-lock-defaults '(octave-font-lock-keywords nil nil))
-
- (make-local-variable 'imenu-generic-expression)
- (setq imenu-generic-expression octave-mode-imenu-generic-expression
- imenu-case-fold-search nil)
-
- (octave-add-octave-menu)
+
+ (smie-setup octave-smie-op-levels octave-smie-indent-rules)
+ (set (make-local-variable 'smie-indent-basic) 'octave-block-offset)
+ (set (make-local-variable 'smie-backward-token-function)
+ 'octave-smie-backward-token)
+ (set (make-local-variable 'smie-forward-token-function)
+ 'octave-smie-forward-token)
+ (set (make-local-variable 'forward-sexp-function)
+ 'smie-forward-sexp-command)
+ (set (make-local-variable 'smie-closer-alist) octave-smie-closer-alist)
+ ;; Only needed for interactive calls to blink-matching-open.
+ (set (make-local-variable 'blink-matching-check-function)
+ #'smie-blink-matching-check)
+
+ (when octave-blink-matching-block
+ (add-hook 'post-self-insert-hook #'smie-blink-matching-open 'append 'local)
+ (set (make-local-variable 'smie-blink-matching-triggers)
+ (append smie-blink-matching-triggers '(\;)
+ ;; Rather than wait for SPC or ; to blink, try to blink as
+ ;; soon as we type the last char of a block ender.
+ ;; But strip ?d from this list so that we don't blink twice
+ ;; when the user writes "endif" (once at "end" and another
+ ;; time at "endif").
+ (delq ?d (delete-dups
+ (mapcar (lambda (kw)
+ (aref (cdr kw) (1- (length (cdr kw)))))
+ smie-closer-alist))))))
+
+ ;; FIXME: maybe we should use (cons ?\; electric-indent-chars)
+ ;; since only ; is really octave-specific.
+ (set (make-local-variable 'electric-indent-chars) '(?\; ?\s ?\n))
+
+ (set (make-local-variable 'comment-start) octave-comment-start)
+ (set (make-local-variable 'comment-end) "")
+ ;; Don't set it here: it's not really a property of the language,
+ ;; just a personal preference of the author.
+ ;; (set (make-local-variable 'comment-column) 32)
+ (set (make-local-variable 'comment-start-skip) "\\s<+\\s-*")
+ (set (make-local-variable 'comment-add) 1)
+
+ (set (make-local-variable 'parse-sexp-ignore-comments) t)
+ (set (make-local-variable 'paragraph-start)
+ (concat "\\s-*$\\|" page-delimiter))
+ (set (make-local-variable 'paragraph-separate) paragraph-start)
+ (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
+ (set (make-local-variable 'fill-paragraph-function) 'octave-fill-paragraph)
+ ;; FIXME: Why disable it?
+ ;; (set (make-local-variable 'adaptive-fill-regexp) nil)
+ ;; Again, this is not a property of the language, don't set it here.
+ ;; (set (make-local-variable 'fill-column) 72)
+ (set (make-local-variable 'normal-auto-fill-function) 'octave-auto-fill)
+
+ (set (make-local-variable 'font-lock-defaults)
+ '(octave-font-lock-keywords))
+
+ (set (make-local-variable 'syntax-propertize-function)
+ #'octave-syntax-propertize-function)
+
+ (set (make-local-variable 'imenu-generic-expression)
+ octave-mode-imenu-generic-expression)
+ (set (make-local-variable 'imenu-case-fold-search) nil)
+
+ (add-hook 'completion-at-point-functions
+ 'octave-completion-at-point-function nil t)
+ (set (make-local-variable 'beginning-of-defun-function)
+ 'octave-beginning-of-defun)
+
+ (easy-menu-add octave-mode-menu)
(octave-initialize-completions)
(run-mode-hooks 'octave-mode-hook))
+(defvar info-lookup-mode)
+
(defun octave-help ()
"Get help on Octave symbols from the Octave info files.
Look up symbol in the function, operator and variable indices of the info files."
@@ -543,74 +701,31 @@ Look up symbol in the function, operator and variable indices of the info files.
(call-interactively 'info-lookup-symbol)))
;;; Miscellaneous useful functions
-(defun octave-describe-major-mode ()
- "Describe the current major mode."
- (interactive)
- (describe-function major-mode))
(defsubst octave-in-comment-p ()
"Return t if point is inside an Octave comment."
- (interactive)
(save-excursion
+ ;; FIXME: use syntax-ppss?
(nth 4 (parse-partial-sexp (line-beginning-position) (point)))))
(defsubst octave-in-string-p ()
"Return t if point is inside an Octave string."
- (interactive)
(save-excursion
+ ;; FIXME: use syntax-ppss?
(nth 3 (parse-partial-sexp (line-beginning-position) (point)))))
(defsubst octave-not-in-string-or-comment-p ()
"Return t if point is not inside an Octave string or comment."
+ ;; FIXME: Use syntax-ppss?
(let ((pps (parse-partial-sexp (line-beginning-position) (point))))
(not (or (nth 3 pps) (nth 4 pps)))))
-(defun octave-in-block-p ()
- "Return t if point is inside an Octave block.
-The block is taken to start at the first letter of the begin keyword and
-to end after the end keyword."
- (let ((pos (point)))
- (save-excursion
- (condition-case nil
- (progn
- (skip-syntax-forward "w")
- (octave-up-block -1)
- (octave-forward-block)
- t)
- (error nil))
- (< pos (point)))))
(defun octave-looking-at-kw (regexp)
"Like `looking-at', but sets `case-fold-search' nil."
(let ((case-fold-search nil))
(looking-at regexp)))
-(defun octave-re-search-forward-kw (regexp count)
- "Like `re-search-forward', but sets `case-fold-search' nil, and moves point."
- (let ((case-fold-search nil))
- (re-search-forward regexp nil 'move count)))
-
-(defun octave-re-search-backward-kw (regexp count)
- "Like `re-search-backward', but sets `case-fold-search' nil, and moves point."
- (let ((case-fold-search nil))
- (re-search-backward regexp nil 'move count)))
-
-(defun octave-in-defun-p ()
- "Return t if point is inside an Octave function declaration.
-The function is taken to start at the `f' of `function' and to end after
-the end keyword."
- (let ((pos (point)))
- (save-excursion
- (or (and (octave-looking-at-kw "\\<function\\>")
- (octave-not-in-string-or-comment-p))
- (and (octave-beginning-of-defun)
- (condition-case nil
- (progn
- (octave-forward-block)
- t)
- (error nil))
- (< pos (point)))))))
-
(defun octave-maybe-insert-continuation-string ()
(if (or (octave-in-comment-p)
(save-excursion
@@ -620,147 +735,8 @@ the end keyword."
(delete-horizontal-space)
(insert (concat " " octave-continuation-string))))
-;;; Comments
-(defun octave-comment-region (beg end &optional arg)
- "Comment or uncomment each line in the region as Octave code.
-See `comment-region'."
- (interactive "r\nP")
- (let ((comment-start (char-to-string octave-comment-char)))
- (comment-region beg end arg)))
-
-(defun octave-uncomment-region (beg end &optional arg)
- "Uncomment each line in the region as Octave code."
- (interactive "r\nP")
- (or arg (setq arg 1))
- (octave-comment-region beg end (- arg)))
-
;;; Indentation
-(defun calculate-octave-indent ()
- "Return appropriate indentation for current line as Octave code.
-Returns an integer (the column to indent to) unless the line is a
-comment line with fixed goal golumn. In that case, returns a list whose
-car is the column to indent to, and whose cdr is the current indentation
-level."
- (let ((is-continuation-line
- (save-excursion
- (if (zerop (octave-previous-code-line))
- (looking-at octave-continuation-regexp))))
- (icol 0))
- (save-excursion
- (beginning-of-line)
- ;; If we can move backward out one level of parentheses, take 1
- ;; plus the indentation of that parenthesis. Otherwise, go back
- ;; to the beginning of the previous code line, and compute the
- ;; offset this line gives.
- (if (condition-case nil
- (progn
- (up-list -1)
- t)
- (error nil))
- (setq icol (+ 1 (current-column)))
- (if (zerop (octave-previous-code-line))
- (progn
- (octave-beginning-of-line)
- (back-to-indentation)
- (setq icol (current-column))
- (let ((bot (point))
- (eol (line-end-position)))
- (while (< (point) eol)
- (if (octave-not-in-string-or-comment-p)
- (cond
- ((octave-looking-at-kw "\\<switch\\>")
- (setq icol (+ icol (* 2 octave-block-offset))))
- ((octave-looking-at-kw octave-block-begin-regexp)
- (setq icol (+ icol octave-block-offset)))
- ((octave-looking-at-kw octave-block-else-regexp)
- (if (= bot (point))
- (setq icol (+ icol octave-block-offset))))
- ((octave-looking-at-kw octave-block-end-regexp)
- (if (and (not (= bot (point)))
- ;; special case for `end' keyword,
- ;; applied to all keywords
- (not (octave-end-as-array-index-p)))
- (setq icol (- icol
- (octave-block-end-offset)))))))
- (forward-char)))
- (if is-continuation-line
- (setq icol (+ icol octave-continuation-offset)))))))
- (save-excursion
- (back-to-indentation)
- (cond
- ((and (octave-looking-at-kw octave-block-else-regexp)
- (octave-not-in-string-or-comment-p))
- (setq icol (- icol octave-block-offset)))
- ((and (octave-looking-at-kw octave-block-end-regexp)
- (octave-not-in-string-or-comment-p))
- (setq icol (- icol (octave-block-end-offset))))
- ((or (looking-at "\\s<\\s<\\s<\\S<")
- (octave-before-magic-comment-p))
- (setq icol (list 0 icol)))
- ((looking-at "\\s<\\S<")
- (setq icol (list comment-column icol)))))
- icol))
-
-;; FIXME: this should probably also make sure we are actually looking
-;; at the "end" keyword.
-(defun octave-end-as-array-index-p ()
- (save-excursion
- (condition-case nil
- ;; Check if point is between parens
- (progn (up-list 1) t)
- (error nil))))
-
-(defun octave-block-end-offset ()
- (save-excursion
- (octave-backward-up-block 1)
- (* octave-block-offset
- (if (string-match (match-string 0) "switch") 2 1))))
-
-(defun octave-before-magic-comment-p ()
- (save-excursion
- (beginning-of-line)
- (and (bobp) (looking-at "\\s-*#!"))))
-
-(defun octave-comment-indent ()
- (if (or (looking-at "\\s<\\s<\\s<")
- (octave-before-magic-comment-p))
- 0
- (if (looking-at "\\s<\\s<")
- (calculate-octave-indent)
- (skip-syntax-backward " ")
- (max (if (bolp) 0 (+ 1 (current-column)))
- comment-column))))
-
-(defun octave-indent-for-comment ()
- "Maybe insert and indent an Octave comment.
-If there is no comment already on this line, create a code-level comment
-\(started by two comment characters) if the line is empty, or an in-line
-comment (started by one comment character) otherwise.
-Point is left after the start of the comment which is properly aligned."
- (interactive)
- (beginning-of-line)
- (if (looking-at "^\\s-*$")
- (insert octave-block-comment-start)
- (indent-for-comment))
- (indent-according-to-mode))
-
-(defun octave-indent-line (&optional arg)
- "Indent current line as Octave code.
-With optional ARG, use this as offset unless this line is a comment with
-fixed goal column."
- (interactive)
- (or arg (setq arg 0))
- (let ((icol (calculate-octave-indent))
- (relpos (- (current-column) (current-indentation))))
- (if (listp icol)
- (setq icol (car icol))
- (setq icol (+ icol arg)))
- (if (< icol 0)
- (error "Unmatched end keyword")
- (indent-line-to icol)
- (if (> relpos 0)
- (move-to-column (+ icol relpos))))))
(defun octave-indent-new-comment-line ()
"Break Octave line at point, continuing comment if within one.
@@ -782,7 +758,7 @@ The new line is properly indented."
"Properly indent the Octave function which contains point."
(interactive)
(save-excursion
- (octave-mark-defun)
+ (mark-defun)
(message "Indenting function...")
(indent-region (point) (mark) nil))
(message "Indenting function...done."))
@@ -862,193 +838,33 @@ does not end in `...' or `\\' or is inside an open parenthesis list."
(zerop (forward-line 1)))))
(end-of-line)))
-(defun octave-scan-blocks (count depth)
- "Scan from point by COUNT Octave begin-end blocks.
-Returns the character number of the position thus found.
-
-If DEPTH is nonzero, block depth begins counting from that value.
-Only places where the depth in blocks becomes zero are candidates for
-stopping; COUNT such places are counted.
-
-If the beginning or end of the buffer is reached and the depth is wrong,
-an error is signaled."
- (let ((min-depth (if (> depth 0) 0 depth))
- (inc (if (> count 0) 1 -1)))
- (save-excursion
- (while (/= count 0)
- (catch 'foo
- (while (or (octave-re-search-forward-kw
- octave-block-begin-or-end-regexp inc)
- (if (/= depth 0)
- (error "Unbalanced block")))
- (if (octave-not-in-string-or-comment-p)
- (progn
- (cond
- ((match-end 1)
- (setq depth (+ depth inc)))
- ((match-end 2)
- (setq depth (- depth inc))))
- (if (< depth min-depth)
- (error "Containing expression ends prematurely"))
- (if (= depth 0)
- (throw 'foo nil))))))
- (setq count (- count inc)))
- (point))))
-
-(defun octave-forward-block (&optional arg)
- "Move forward across one balanced Octave begin-end block.
-With argument, do it that many times.
-Negative arg -N means move backward across N blocks."
- (interactive "p")
- (or arg (setq arg 1))
- (goto-char (or (octave-scan-blocks arg 0) (buffer-end arg))))
-
-(defun octave-backward-block (&optional arg)
- "Move backward across one balanced Octave begin-end block.
-With argument, do it that many times.
-Negative arg -N means move forward across N blocks."
- (interactive "p")
- (or arg (setq arg 1))
- (octave-forward-block (- arg)))
-
-(defun octave-down-block (arg)
- "Move forward down one begin-end block level of Octave code.
-With argument, do this that many times.
-A negative argument means move backward but still go down a level.
-In Lisp programs, an argument is required."
- (interactive "p")
- (let ((inc (if (> arg 0) 1 -1)))
- (while (/= arg 0)
- (goto-char (or (octave-scan-blocks inc -1)
- (buffer-end arg)))
- (setq arg (- arg inc)))))
-
-(defun octave-backward-up-block (arg)
- "Move backward out of one begin-end block level of Octave code.
-With argument, do this that many times.
-A negative argument means move forward but still to a less deep spot.
-In Lisp programs, an argument is required."
- (interactive "p")
- (octave-up-block (- arg)))
-
-(defun octave-up-block (arg)
- "Move forward out of one begin-end block level of Octave code.
-With argument, do this that many times.
-A negative argument means move backward but still to a less deep spot.
-In Lisp programs, an argument is required."
- (interactive "p")
- (let ((inc (if (> arg 0) 1 -1)))
- (while (/= arg 0)
- (goto-char (or (octave-scan-blocks inc 1)
- (buffer-end arg)))
- (setq arg (- arg inc)))))
-
(defun octave-mark-block ()
"Put point at the beginning of this Octave block, mark at the end.
The block marked is the one that contains point or follows point."
(interactive)
- (let ((pos (point)))
- (if (or (and (octave-in-block-p)
- (skip-syntax-forward "w"))
- (condition-case nil
- (progn
- (octave-down-block 1)
- (octave-in-block-p))
- (error nil)))
- (progn
- (octave-up-block -1)
- (push-mark (point))
- (octave-forward-block)
- (exchange-point-and-mark))
- (goto-char pos)
- (message "No block to mark found"))))
-
-(defun octave-close-block ()
- "Close the current Octave block on a separate line.
-An error is signaled if no block to close is found."
- (interactive)
- (let (bb-keyword)
- (condition-case nil
- (progn
- (save-excursion
- (octave-backward-up-block 1)
- (setq bb-keyword (buffer-substring-no-properties
- (match-beginning 1) (match-end 1))))
- (if (save-excursion
- (beginning-of-line)
- (looking-at "^\\s-*$"))
- (indent-according-to-mode)
- (octave-reindent-then-newline-and-indent))
- (insert (car (reverse
- (assoc bb-keyword
- octave-block-match-alist))))
- (octave-reindent-then-newline-and-indent)
- t)
- (error (message "No block to close found")))))
-
-(defun octave-blink-matching-block-open ()
- "Blink the matching Octave begin block keyword.
-If point is right after an Octave else or end type block keyword, move
-cursor momentarily to the corresponding begin keyword.
-Signal an error if the keywords are incompatible."
- (interactive)
- (let (bb-keyword bb-arg eb-keyword pos eol)
- (if (and (octave-not-in-string-or-comment-p)
- (looking-at "\\>")
- (save-excursion
- (skip-syntax-backward "w")
- (octave-looking-at-kw octave-block-else-or-end-regexp)))
- (save-excursion
- (cond
- ((match-end 1)
- (setq eb-keyword
- (buffer-substring-no-properties
- (match-beginning 1) (match-end 1)))
- (octave-backward-up-block 1))
- ((match-end 2)
- (setq eb-keyword
- (buffer-substring-no-properties
- (match-beginning 2) (match-end 2)))
- (octave-backward-block)))
- (setq pos (match-end 0)
- bb-keyword
- (buffer-substring-no-properties
- (match-beginning 0) pos)
- pos (+ pos 1)
- eol (line-end-position)
- bb-arg
- (save-excursion
- (save-restriction
- (goto-char pos)
- (while (and (skip-syntax-forward "^<" eol)
- (octave-in-string-p)
- (not (forward-char 1))))
- (skip-syntax-backward " ")
- (buffer-substring-no-properties pos (point)))))
- (if (member eb-keyword
- (cdr (assoc bb-keyword octave-block-match-alist)))
- (progn
- (message "Matches `%s %s'" bb-keyword bb-arg)
- (if (pos-visible-in-window-p)
- (sit-for blink-matching-delay)))
- (error "Block keywords `%s' and `%s' do not match"
- bb-keyword eb-keyword))))))
+ (unless (or (looking-at "\\s(")
+ (save-excursion
+ (let* ((token (funcall smie-forward-token-function))
+ (level (assoc token smie-op-levels)))
+ (and level (null (cadr level))))))
+ (backward-up-list 1))
+ (mark-sexp))
(defun octave-beginning-of-defun (&optional arg)
"Move backward to the beginning of an Octave function.
With positive ARG, do it that many times. Negative argument -N means
move forward to Nth following beginning of a function.
Returns t unless search stops at the beginning or end of the buffer."
- (interactive "p")
(let* ((arg (or arg 1))
(inc (if (> arg 0) 1 -1))
- (found))
+ (found nil)
+ (case-fold-search nil))
(and (not (eobp))
- (not (and (> arg 0) (octave-looking-at-kw "\\<function\\>")))
+ (not (and (> arg 0) (looking-at "\\<function\\>")))
(skip-syntax-forward "w"))
(while (and (/= arg 0)
(setq found
- (octave-re-search-backward-kw "\\<function\\>" inc)))
+ (re-search-backward "\\<function\\>" inc)))
(if (octave-not-in-string-or-comment-p)
(setq arg (- arg inc))))
(if found
@@ -1056,40 +872,6 @@ Returns t unless search stops at the beginning or end of the buffer."
(and (< inc 0) (goto-char (match-beginning 0)))
t))))
-(defun octave-end-of-defun (&optional arg)
- "Move forward to the end of an Octave function.
-With positive ARG, do it that many times. Negative argument -N means
-move back to Nth preceding end of a function.
-
-An end of a function occurs right after the end keyword matching the
-`function' keyword that starts the function."
- (interactive "p")
- (or arg (setq arg 1))
- (and (< arg 0) (skip-syntax-backward "w"))
- (and (> arg 0) (skip-syntax-forward "w"))
- (if (octave-in-defun-p)
- (setq arg (- arg 1)))
- (if (= arg 0) (setq arg -1))
- (if (octave-beginning-of-defun (- arg))
- (octave-forward-block)))
-
-(defun octave-mark-defun ()
- "Put point at the beginning of this Octave function, mark at its end.
-The function marked is the one containing point or following point."
- (interactive)
- (let ((pos (point)))
- (if (or (octave-in-defun-p)
- (and (octave-beginning-of-defun -1)
- (octave-in-defun-p)))
- (progn
- (skip-syntax-forward "w")
- (octave-beginning-of-defun)
- (push-mark (point))
- (octave-end-of-defun)
- (exchange-point-and-mark))
- (goto-char pos)
- (message "No function to mark found"))))
-
;;; Filling
(defun octave-auto-fill ()
@@ -1154,81 +936,73 @@ otherwise."
(not give-up))))
(defun octave-fill-paragraph (&optional arg)
- "Fill paragraph of Octave code, handling Octave comments."
- ;; FIXME: now that the default fill-paragraph takes care of similar issues,
- ;; this seems obsolete. --Stef
- (interactive "P")
- (save-excursion
- (let ((end (progn (forward-paragraph) (point)))
- (beg (progn
- (forward-paragraph -1)
- (skip-chars-forward " \t\n")
- (beginning-of-line)
- (point)))
- (cfc (current-fill-column))
- (ind (calculate-octave-indent))
- comment-prefix)
- (save-restriction
- (goto-char beg)
- (narrow-to-region beg end)
- (if (listp ind) (setq ind (nth 1 ind)))
- (while (not (eobp))
- (condition-case nil
- (octave-indent-line ind)
- (error nil))
- (if (and (> ind 0)
- (not
- (save-excursion
- (beginning-of-line)
- (looking-at "^\\s-*\\($\\|\\s<+\\)"))))
- (setq ind 0))
- (move-to-column cfc)
- ;; First check whether we need to combine non-empty comment lines
- (if (and (< (current-column) cfc)
- (octave-in-comment-p)
- (not (save-excursion
- (beginning-of-line)
- (looking-at "^\\s-*\\s<+\\s-*$"))))
- ;; This is a nonempty comment line which does not extend
- ;; past the fill column. If it is followed by a nonempty
- ;; comment line with the same comment prefix, try to
- ;; combine them, and repeat this until either we reach the
- ;; fill-column or there is nothing more to combine.
- (progn
- ;; Get the comment prefix
- (save-excursion
- (beginning-of-line)
- (while (and (re-search-forward "\\s<+")
- (not (octave-in-comment-p))))
- (setq comment-prefix (match-string 0)))
- ;; And keep combining ...
- (while (and (< (current-column) cfc)
- (save-excursion
- (forward-line 1)
- (and (looking-at
- (concat "^\\s-*"
- comment-prefix
- "\\S<"))
- (not (looking-at
- (concat "^\\s-*"
- comment-prefix
- "\\s-*$"))))))
- (delete-char 1)
- (re-search-forward comment-prefix)
- (delete-region (match-beginning 0) (match-end 0))
- (fixup-whitespace)
- (move-to-column cfc))))
- ;; We might also try to combine continued code lines> Perhaps
- ;; some other time ...
- (skip-chars-forward "^ \t\n")
- (delete-horizontal-space)
- (if (or (< (current-column) cfc)
- (and (= (current-column) cfc) (eolp)))
- (forward-line 1)
- (if (not (eolp)) (insert " "))
- (or (octave-auto-fill)
- (forward-line 1)))))
- t)))
+ "Fill paragraph of Octave code, handling Octave comments."
+ ;; FIXME: difference with generic fill-paragraph:
+ ;; - code lines are only split, never joined.
+ ;; - \n that end comments are never removed.
+ ;; - insert continuation marker when splitting code lines.
+ (interactive "P")
+ (save-excursion
+ (let ((end (progn (forward-paragraph) (copy-marker (point) t)))
+ (beg (progn
+ (forward-paragraph -1)
+ (skip-chars-forward " \t\n")
+ (beginning-of-line)
+ (point)))
+ (cfc (current-fill-column))
+ comment-prefix)
+ (goto-char beg)
+ (while (< (point) end)
+ (condition-case nil
+ (indent-according-to-mode)
+ (error nil))
+ (move-to-column cfc)
+ ;; First check whether we need to combine non-empty comment lines
+ (if (and (< (current-column) cfc)
+ (octave-in-comment-p)
+ (not (save-excursion
+ (beginning-of-line)
+ (looking-at "^\\s-*\\s<+\\s-*$"))))
+ ;; This is a nonempty comment line which does not extend
+ ;; past the fill column. If it is followed by a nonempty
+ ;; comment line with the same comment prefix, try to
+ ;; combine them, and repeat this until either we reach the
+ ;; fill-column or there is nothing more to combine.
+ (progn
+ ;; Get the comment prefix
+ (save-excursion
+ (beginning-of-line)
+ (while (and (re-search-forward "\\s<+")
+ (not (octave-in-comment-p))))
+ (setq comment-prefix (match-string 0)))
+ ;; And keep combining ...
+ (while (and (< (current-column) cfc)
+ (save-excursion
+ (forward-line 1)
+ (and (looking-at
+ (concat "^\\s-*"
+ comment-prefix
+ "\\S<"))
+ (not (looking-at
+ (concat "^\\s-*"
+ comment-prefix
+ "\\s-*$"))))))
+ (delete-char 1)
+ (re-search-forward comment-prefix)
+ (delete-region (match-beginning 0) (match-end 0))
+ (fixup-whitespace)
+ (move-to-column cfc))))
+ ;; We might also try to combine continued code lines> Perhaps
+ ;; some other time ...
+ (skip-chars-forward "^ \t\n")
+ (delete-horizontal-space)
+ (if (or (< (current-column) cfc)
+ (and (= (current-column) cfc) (eolp)))
+ (forward-line 1)
+ (if (not (eolp)) (insert " "))
+ (or (octave-auto-fill)
+ (forward-line 1))))
+ t)))
;;; Completions
@@ -1237,34 +1011,34 @@ otherwise."
(if octave-completion-alist
()
(setq octave-completion-alist
- (mapcar '(lambda (var) (cons var var))
- (append octave-reserved-words
- octave-text-functions
- octave-variables)))))
+ (append octave-reserved-words
+ octave-text-functions
+ octave-variables))))
+
+(defun octave-completion-at-point-function ()
+ "Find the text to complete and the corresponding table."
+ (let* ((beg (save-excursion (backward-sexp 1) (point)))
+ (end (point)))
+ (if (< beg (point))
+ ;; Extend region past point, if applicable.
+ (save-excursion (goto-char beg) (forward-sexp 1)
+ (setq end (max end (point)))))
+ (list beg end octave-completion-alist)))
(defun octave-complete-symbol ()
"Perform completion on Octave symbol preceding point.
Compare that symbol against Octave's reserved words and builtin
variables."
(interactive)
- (let* ((end (point))
- (beg (save-excursion (backward-sexp 1) (point))))
- (completion-in-region beg end octave-completion-alist)))
-
+ (apply 'completion-in-region (octave-completion-at-point-function)))
;;; Electric characters && friends
(defun octave-reindent-then-newline-and-indent ()
"Reindent current Octave line, insert newline, and indent the new line.
If Abbrev mode is on, expand abbrevs first."
+ ;; FIXME: None of this is Octave-specific.
(interactive)
- (if abbrev-mode (expand-abbrev))
- (if octave-blink-matching-block
- (octave-blink-matching-block-open))
- (save-excursion
- (delete-region (point) (progn (skip-chars-backward " \t") (point)))
- (indent-according-to-mode))
- (insert "\n")
- (indent-according-to-mode))
+ (reindent-then-newline-and-indent))
(defun octave-electric-semi ()
"Insert a semicolon in Octave mode.
@@ -1272,14 +1046,12 @@ Maybe expand abbrevs and blink matching block open keywords.
Reindent the line if `octave-auto-indent' is non-nil.
Insert a newline if `octave-auto-newline' is non-nil."
(interactive)
+ (setq last-command-event ?\;)
(if (not (octave-not-in-string-or-comment-p))
- (insert ";")
- (if abbrev-mode (expand-abbrev))
- (if octave-blink-matching-block
- (octave-blink-matching-block-open))
+ (self-insert-command 1)
(if octave-auto-indent
(indent-according-to-mode))
- (insert ";")
+ (self-insert-command 1)
(if octave-auto-newline
(newline-and-indent))))
@@ -1294,9 +1066,6 @@ Reindent the line if `octave-auto-indent' is non-nil."
(progn
(indent-according-to-mode)
(self-insert-command 1))
- (if abbrev-mode (expand-abbrev))
- (if octave-blink-matching-block
- (octave-blink-matching-block-open))
(if (and octave-auto-indent
(save-excursion
(skip-syntax-backward " ")
@@ -1324,51 +1093,27 @@ Note that all Octave mode abbrevs start with a grave accent."
(list-abbrevs))
(setq unread-command-events (list c))))))
-(defun octave-insert-defun (name args vals)
+(define-skeleton octave-insert-defun
"Insert an Octave function skeleton.
Prompt for the function's name, arguments and return values (to be
entered without parens)."
- (interactive
- (list
- (read-from-minibuffer "Function name: "
- (substring (buffer-name) 0 -2))
- (read-from-minibuffer "Arguments: ")
- (read-from-minibuffer "Return values: ")))
- (let ((string (format "%s %s (%s)"
- (cond
- ((string-equal vals "")
- vals)
- ((string-match "[ ,]" vals)
- (concat " [" vals "] ="))
- (t
- (concat " " vals " =")))
- name
- args))
- (prefix octave-block-comment-start))
- (if (not (bobp)) (newline))
- (insert "function" string)
- (indent-according-to-mode)
- (newline 2)
- (insert prefix "usage: " string)
- (reindent-then-newline-and-indent)
- (insert prefix)
- (reindent-then-newline-and-indent)
- (insert prefix)
- (indent-according-to-mode)
- (save-excursion
- (newline 2)
- (insert "endfunction")
- (indent-according-to-mode))))
-
-
-;;; Menu
-(defun octave-add-octave-menu ()
- "Add the `Octave' menu to the menu bar in Octave mode."
- (require 'easymenu)
- (easy-menu-define octave-mode-menu-map octave-mode-map
- "Menu keymap for Octave mode." octave-mode-menu)
- (easy-menu-add octave-mode-menu-map octave-mode-map))
-
+ (let* ((defname (substring (buffer-name) 0 -2))
+ (name (read-string (format "Function name (default %s): " defname)
+ nil nil defname))
+ (args (read-string "Arguments: "))
+ (vals (read-string "Return values: ")))
+ (format "%s%s (%s)"
+ (cond
+ ((string-equal vals "") vals)
+ ((string-match "[ ,]" vals) (concat "[" vals "] = "))
+ (t (concat vals " = ")))
+ name
+ args))
+ \n "function " > str \n \n
+ octave-block-comment-start "usage: " str \n
+ octave-block-comment-start \n octave-block-comment-start
+ \n _ \n
+ "endfunction" > \n)
;;; Communication with the inferior Octave process
(defun octave-kill-process ()
@@ -1435,7 +1180,7 @@ entered without parens)."
"Send current Octave function to the inferior Octave process."
(interactive)
(save-excursion
- (octave-mark-defun)
+ (mark-defun)
(octave-send-region (point) (mark))))
(defun octave-send-line (&optional arg)
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index f8eba5accd..ae3acc3cda 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -250,59 +250,76 @@ The expansion is entirely correct because it uses the C preprocessor."
;; y /.../.../
;;
;; <file*glob>
-(defvar perl-font-lock-syntactic-keywords
- ;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)")
- `(;; Turn POD into b-style comments
- ("^\\(=\\)\\sw" (1 "< b"))
- ("^=cut[ \t]*\\(\n\\)" (1 "> b"))
- ;; Catch ${ so that ${var} doesn't screw up indentation.
- ;; This also catches $' to handle 'foo$', although it should really
- ;; check that it occurs inside a '..' string.
- ("\\(\\$\\)[{']" (1 ". p"))
- ;; Handle funny names like $DB'stop.
- ("\\$ ?{?^?[_a-zA-Z][_a-zA-Z0-9]*\\('\\)[_a-zA-Z]" (1 "_"))
- ;; format statements
- ("^[ \t]*format.*=[ \t]*\\(\n\\)" (1 '(7)))
- ;; Funny things in `sub' arg-specs like `sub myfun ($)' or `sub ($)'.
- ;; Be careful not to match "sub { (...) ... }".
- ("\\<sub\\(?:[[:space:]]+[^{}[:punct:][:space:]]+\\)?[[:space:]]*(\\([^)]+\\))"
- 1 '(1))
- ;; Regexp and funny quotes. Distinguishing a / that starts a regexp
- ;; match from the division operator is ...interesting.
- ;; Basically, / is a regexp match if it's preceded by an infix operator
- ;; (or some similar separator), or by one of the special keywords
- ;; corresponding to builtin functions that can take their first arg
- ;; without parentheses. Of course, that presume we're looking at the
- ;; *opening* slash. We can afford to mis-match the closing ones
- ;; here, because they will be re-treated separately later in
- ;; perl-font-lock-special-syntactic-constructs.
- (,(concat "\\(?:\\(?:\\(?:^\\|[^$@&%[:word:]]\\)"
- (regexp-opt '("split" "if" "unless" "until" "while" "split"
- "grep" "map" "not" "or" "and"))
- "\\)\\|[?:.,;=!~({[]\\|\\(^\\)\\)[ \t\n]*\\(/\\)")
- (2 (if (and (match-end 1)
- (save-excursion
- (goto-char (match-end 1))
- ;; Not 100% correct since we haven't finished setting up
- ;; the syntax-table before point, but better than nothing.
- (forward-comment (- (point-max)))
- (put-text-property (point) (match-end 2)
- 'jit-lock-defer-multiline t)
- (not (memq (char-before)
- '(?? ?: ?. ?, ?\; ?= ?! ?~ ?\( ?\[)))))
- nil ;; A division sign instead of a regexp-match.
- '(7))))
- ("\\(^\\|[?:.,;=!~({[ \t]\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\([^])}> \n\t]\\)"
- ;; Nasty cases:
- ;; /foo/m $a->m $#m $m @m %m
- ;; \s (appears often in regexps).
- ;; -s file
- (3 (if (assoc (char-after (match-beginning 3))
- perl-quote-like-pairs)
- '(15) '(7))))
- ;; Find and mark the end of funny quotes and format statements.
- (perl-font-lock-special-syntactic-constructs)
- ))
+(defun perl-syntax-propertize-function (start end)
+ (let ((case-fold-search nil))
+ (goto-char start)
+ (perl-syntax-propertize-special-constructs end)
+ ;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)")
+ (funcall
+ (syntax-propertize-rules
+ ;; Turn POD into b-style comments. Place the cut rule first since it's
+ ;; more specific.
+ ("^=cut\\>.*\\(\n\\)" (1 "> b"))
+ ("^\\(=\\)\\sw" (1 "< b"))
+ ;; Catch ${ so that ${var} doesn't screw up indentation.
+ ;; This also catches $' to handle 'foo$', although it should really
+ ;; check that it occurs inside a '..' string.
+ ("\\(\\$\\)[{']" (1 ". p"))
+ ;; Handle funny names like $DB'stop.
+ ("\\$ ?{?^?[_a-zA-Z][_a-zA-Z0-9]*\\('\\)[_a-zA-Z]" (1 "_"))
+ ;; format statements
+ ("^[ \t]*format.*=[ \t]*\\(\n\\)"
+ (1 (prog1 "\"" (perl-syntax-propertize-special-constructs end))))
+ ;; Funny things in `sub' arg-specs like `sub myfun ($)' or `sub ($)'.
+ ;; Be careful not to match "sub { (...) ... }".
+ ("\\<sub\\(?:[[:space:]]+[^{}[:punct:][:space:]]+\\)?[[:space:]]*(\\([^)]+\\))"
+ (1 "."))
+ ;; Regexp and funny quotes. Distinguishing a / that starts a regexp
+ ;; match from the division operator is ...interesting.
+ ;; Basically, / is a regexp match if it's preceded by an infix operator
+ ;; (or some similar separator), or by one of the special keywords
+ ;; corresponding to builtin functions that can take their first arg
+ ;; without parentheses. Of course, that presume we're looking at the
+ ;; *opening* slash. We can afford to mis-match the closing ones
+ ;; here, because they will be re-treated separately later in
+ ;; perl-font-lock-special-syntactic-constructs.
+ ((concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)"
+ (regexp-opt '("split" "if" "unless" "until" "while" "split"
+ "grep" "map" "not" "or" "and"))
+ "\\|[?:.,;=!~({[]\\|\\(^\\)\\)[ \t\n]*\\(/\\)")
+ (2 (ignore
+ (if (and (match-end 1) ; / at BOL.
+ (save-excursion
+ (goto-char (match-end 1))
+ (forward-comment (- (point-max)))
+ (put-text-property (point) (match-end 2)
+ 'syntax-multiline t)
+ (not (memq (char-before)
+ '(?? ?: ?. ?, ?\; ?= ?! ?~ ?\( ?\[)))))
+ nil ;; A division sign instead of a regexp-match.
+ (put-text-property (match-beginning 2) (match-end 2)
+ 'syntax-table (string-to-syntax "\""))
+ (perl-syntax-propertize-special-constructs end)))))
+ ("\\(^\\|[?:.,;=!~({[ \t]\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\([^])}> \n\t]\\)"
+ ;; Nasty cases:
+ ;; /foo/m $a->m $#m $m @m %m
+ ;; \s (appears often in regexps).
+ ;; -s file
+ ;; sub tr {...}
+ (3 (ignore
+ (if (save-excursion (goto-char (match-beginning 0))
+ (forward-word -1)
+ (looking-at-p "sub[ \t\n]"))
+ ;; This is defining a function.
+ nil
+ (put-text-property (match-beginning 3) (match-end 3)
+ 'syntax-table
+ (if (assoc (char-after (match-beginning 3))
+ perl-quote-like-pairs)
+ (string-to-syntax "|")
+ (string-to-syntax "\"")))
+ (perl-syntax-propertize-special-constructs end))))))
+ (point) end)))
(defvar perl-empty-syntax-table
(let ((st (copy-syntax-table)))
@@ -321,95 +338,123 @@ The expansion is entirely correct because it uses the C preprocessor."
(modify-syntax-entry close ")" st))
st))
-(defun perl-font-lock-special-syntactic-constructs (limit)
- ;; We used to do all this in a font-lock-syntactic-face-function, which
- ;; did not work correctly because sometimes some parts of the buffer are
- ;; treated with font-lock-syntactic-keywords but not with
- ;; font-lock-syntactic-face-function (mostly because of
- ;; font-lock-syntactically-fontified). That meant that some syntax-table
- ;; properties were missing. So now we do the parse-partial-sexp loop
- ;; ourselves directly from font-lock-syntactic-keywords, so we're sure
- ;; it's done when necessary.
+(defun perl-syntax-propertize-special-constructs (limit)
+ "Propertize special constructs like regexps and formats."
(let ((state (syntax-ppss))
char)
- (while (< (point) limit)
- (cond
- ((or (null (setq char (nth 3 state)))
- (and (characterp char) (eq (char-syntax (nth 3 state)) ?\")))
- ;; Normal text, or comment, or docstring, or normal string.
- nil)
- ((eq (nth 3 state) ?\n)
- ;; A `format' command.
- (save-excursion
- (when (and (re-search-forward "^\\s *\\.\\s *$" nil t)
- (not (eobp)))
- (put-text-property (point) (1+ (point)) 'syntax-table '(7)))))
- (t
- ;; This is regexp like quote thingy.
- (setq char (char-after (nth 8 state)))
- (save-excursion
- (let ((twoargs (save-excursion
- (goto-char (nth 8 state))
- (skip-syntax-backward " ")
- (skip-syntax-backward "w")
- (member (buffer-substring
- (point) (progn (forward-word 1) (point)))
- '("tr" "s" "y"))))
- (close (cdr (assq char perl-quote-like-pairs)))
- (pos (point))
- (st (perl-quote-syntax-table char)))
- (if (not close)
- ;; The closing char is the same as the opening char.
- (with-syntax-table st
- (parse-partial-sexp (point) (point-max)
- nil nil state 'syntax-table)
- (when twoargs
- (parse-partial-sexp (point) (point-max)
- nil nil state 'syntax-table)))
- ;; The open/close chars are matched like () [] {} and <>.
- (let ((parse-sexp-lookup-properties nil))
- (condition-case err
- (progn
- (with-syntax-table st
- (goto-char (nth 8 state)) (forward-sexp 1))
- (when twoargs
- (save-excursion
- ;; Skip whitespace and make sure that font-lock will
- ;; refontify the second part in the proper context.
- (put-text-property
- (point) (progn (forward-comment (point-max)) (point))
- 'font-lock-multiline t)
- ;;
- (unless
- (or (eobp)
- (save-excursion
- (with-syntax-table
- (perl-quote-syntax-table (char-after))
- (forward-sexp 1))
- (put-text-property pos (line-end-position)
- 'jit-lock-defer-multiline t)
- (looking-at "\\s-*\\sw*e")))
- (put-text-property (point) (1+ (point))
- 'syntax-table
- (if (assoc (char-after)
- perl-quote-like-pairs)
- '(15) '(7)))))))
- ;; The arg(s) is not terminated, so it extends until EOB.
- (scan-error (goto-char (point-max))))))
- ;; Point is now right after the arg(s).
- ;; Erase any syntactic marks within the quoted text.
- (put-text-property pos (1- (point)) 'syntax-table nil)
- (when (eq (char-before (1- (point))) ?$)
- (put-text-property (- (point) 2) (1- (point))
- 'syntax-table '(1)))
- (put-text-property (1- (point)) (point)
- 'syntax-table (if close '(15) '(7)))))))
-
- (setq state (parse-partial-sexp (point) limit nil nil state
- 'syntax-table))))
- ;; Tell font-lock that this needs not further processing.
- nil)
-
+ (cond
+ ((or (null (setq char (nth 3 state)))
+ (and (characterp char) (eq (char-syntax (nth 3 state)) ?\")))
+ ;; Normal text, or comment, or docstring, or normal string.
+ nil)
+ ((eq (nth 3 state) ?\n)
+ ;; A `format' command.
+ (when (re-search-forward "^\\s *\\.\\s *\n" limit 'move)
+ (put-text-property (1- (point)) (point)
+ 'syntax-table (string-to-syntax "\""))))
+ (t
+ ;; This is regexp like quote thingy.
+ (setq char (char-after (nth 8 state)))
+ (let ((twoargs (save-excursion
+ (goto-char (nth 8 state))
+ (skip-syntax-backward " ")
+ (skip-syntax-backward "w")
+ (member (buffer-substring
+ (point) (progn (forward-word 1) (point)))
+ '("tr" "s" "y"))))
+ (close (cdr (assq char perl-quote-like-pairs)))
+ (st (perl-quote-syntax-table char)))
+ (when (with-syntax-table st
+ (if close
+ ;; For paired delimiters, Perl allows nesting them, but
+ ;; since we treat them as strings, Emacs does not count
+ ;; those delimiters in `state', so we don't know how deep
+ ;; we are: we have to go back to the beginning of this
+ ;; "string" and count from there.
+ (condition-case nil
+ (progn
+ ;; Start after the first char since it doesn't have
+ ;; paren-syntax (an alternative would be to let-bind
+ ;; parse-sexp-lookup-properties).
+ (goto-char (1+ (nth 8 state)))
+ (up-list 1)
+ t)
+ (scan-error nil))
+ (not (or (nth 8 (parse-partial-sexp
+ (point) limit nil nil state 'syntax-table))
+ ;; If we have a self-paired opener and a twoargs
+ ;; command, the form is s/../../ so we have to skip
+ ;; a second time.
+ ;; In the case of s{...}{...}, we only handle the
+ ;; first part here and the next below.
+ (when (and twoargs (not close))
+ (nth 8 (parse-partial-sexp
+ (point) limit
+ nil nil state 'syntax-table)))))))
+ ;; Point is now right after the arg(s).
+ (when (eq (char-before (1- (point))) ?$)
+ (put-text-property (- (point) 2) (1- (point))
+ 'syntax-table '(1)))
+ (put-text-property (1- (point)) (point)
+ 'syntax-table
+ (if close
+ (string-to-syntax "|")
+ (string-to-syntax "\"")))
+ ;; If we have two args with a non-self-paired starter (e.g.
+ ;; s{...}{...}) we're right after the first arg, so we still have to
+ ;; handle the second part.
+ (when (and twoargs close)
+ ;; Skip whitespace and make sure that font-lock will
+ ;; refontify the second part in the proper context.
+ (put-text-property
+ (point) (progn (forward-comment (point-max)) (point))
+ 'syntax-multiline t)
+ ;;
+ (when (< (point) limit)
+ (put-text-property (point) (1+ (point))
+ 'syntax-table
+ (if (assoc (char-after)
+ perl-quote-like-pairs)
+ ;; Put an `e' in the cdr to mark this
+ ;; char as "second arg starter".
+ (string-to-syntax "|e")
+ (string-to-syntax "\"e")))
+ (forward-char 1)
+ ;; Re-use perl-syntax-propertize-special-constructs to handle the
+ ;; second part (the first delimiter of second part can't be
+ ;; preceded by "s" or "tr" or "y", so it will not be considered
+ ;; as twoarg).
+ (perl-syntax-propertize-special-constructs limit)))))))))
+
+(defun perl-font-lock-syntactic-face-function (state)
+ (cond
+ ((and (nth 3 state)
+ (eq ?e (cdr-safe (get-text-property (nth 8 state) 'syntax-table)))
+ ;; This is a second-arg of s{..}{...} form; let's check if this second
+ ;; arg is executable code rather than a string. For that, we need to
+ ;; look for an "e" after this second arg, so we have to hunt for the
+ ;; end of the arg. Depending on whether the whole arg has already
+ ;; been syntax-propertized or not, the end-char will have different
+ ;; syntaxes, so let's ignore syntax-properties temporarily so we can
+ ;; pretend it has not been syntax-propertized yet.
+ (let* ((parse-sexp-lookup-properties nil)
+ (char (char-after (nth 8 state)))
+ (paired (assq char perl-quote-like-pairs)))
+ (with-syntax-table (perl-quote-syntax-table char)
+ (save-excursion
+ (if (not paired)
+ (parse-partial-sexp (point) (point-max)
+ nil nil state 'syntax-table)
+ (condition-case nil
+ (progn
+ (goto-char (1+ (nth 8 state)))
+ (up-list 1))
+ (scan-error (goto-char (point-max)))))
+ (put-text-property (nth 8 state) (point)
+ 'jit-lock-defer-multiline t)
+ (looking-at "[ \t]*\\sw*e")))))
+ nil)
+ (t (funcall (default-value 'font-lock-syntactic-face-function) state))))
(defcustom perl-indent-level 4
"*Indentation of Perl statements with respect to containing block."
@@ -574,9 +619,12 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'."
perl-font-lock-keywords-1
perl-font-lock-keywords-2)
nil nil ((?\_ . "w")) nil
- (font-lock-syntactic-keywords
- . perl-font-lock-syntactic-keywords)
- (parse-sexp-lookup-properties . t)))
+ (font-lock-syntactic-face-function
+ . perl-font-lock-syntactic-face-function)))
+ (set (make-local-variable 'syntax-propertize-function)
+ #'perl-syntax-propertize-function)
+ (add-hook 'syntax-propertize-extend-region-functions
+ #'syntax-propertize-multiline 'append 'local)
;; Tell imenu how to handle Perl.
(set (make-local-variable 'imenu-generic-expression)
perl-imenu-generic-expression)
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index 64277dc4f8..77e334ca8d 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -31,7 +31,7 @@
(defvar comint-prompt-regexp)
(defvar comint-process-echoes)
-(defvar smie-indent-basic)
+(require 'smie)
(defgroup prolog nil
"Major mode for editing and running Prolog under Emacs."
diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el
index 387a0cb6e0..9b83f77d3b 100644
--- a/lisp/progmodes/ps-mode.el
+++ b/lisp/progmodes/ps-mode.el
@@ -6,7 +6,7 @@
;; Author: Peter Kleiweg <[email protected]>
;; Maintainer: Peter Kleiweg <[email protected]>
;; Created: 20 Aug 1997
-;; Version: 1.1h, 16 Jun 2005
+;; Version: 1.1h
;; Keywords: PostScript, languages
;; Yoni Rabkin <[email protected]> contacted the maintainer of this
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 2b09e34633..10e852223c 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -166,29 +166,32 @@
symbol-end)
. font-lock-builtin-face)))
-(defconst python-font-lock-syntactic-keywords
+(defconst python-syntax-propertize-function
;; Make outer chars of matching triple-quote sequences into generic
;; string delimiters. Fixme: Is there a better way?
;; First avoid a sequence preceded by an odd number of backslashes.
- `((,(rx (not (any ?\\))
- ?\\ (* (and ?\\ ?\\))
- (group (syntax string-quote))
- (backref 1)
- (group (backref 1)))
- (2 ,(string-to-syntax "\""))) ; dummy
- (,(rx (group (optional (any "uUrR"))) ; prefix gets syntax property
- (optional (any "rR")) ; possible second prefix
- (group (syntax string-quote)) ; maybe gets property
- (backref 2) ; per first quote
- (group (backref 2))) ; maybe gets property
- (1 (python-quote-syntax 1))
- (2 (python-quote-syntax 2))
- (3 (python-quote-syntax 3)))
- ;; This doesn't really help.
-;;; (,(rx (and ?\\ (group ?\n))) (1 " "))
- ))
-
-(defun python-quote-syntax (n)
+ (syntax-propertize-rules
+ (;; (rx (not (any ?\\))
+ ;; ?\\ (* (and ?\\ ?\\))
+ ;; (group (syntax string-quote))
+ ;; (backref 1)
+ ;; (group (backref 1)))
+ ;; �Backrefs don't work in syntax-propertize-rules!
+ "[^\\]\\\\\\(\\\\\\\\\\)*\\(?:''\\('\\)\\|\"\"\\(?2:\"\\)\\)"
+ (2 "\"")) ; dummy
+ (;; (rx (optional (group (any "uUrR"))) ; prefix gets syntax property
+ ;; (optional (any "rR")) ; possible second prefix
+ ;; (group (syntax string-quote)) ; maybe gets property
+ ;; (backref 2) ; per first quote
+ ;; (group (backref 2))) ; maybe gets property
+ ;; �Backrefs don't work in syntax-propertize-rules!
+ "\\([RUru]\\)?[Rr]?\\(?:\\('\\)'\\('\\)\\|\\(?2:\"\\)\"\\(?3:\"\\)\\)"
+ (3 (ignore (python-quote-syntax))))
+ ;; This doesn't really help.
+ ;;((rx (and ?\\ (group ?\n))) (1 " "))
+ ))
+
+(defun python-quote-syntax ()
"Put `syntax-table' property correctly on triple quote.
Used for syntactic keywords. N is the match number (1, 2 or 3)."
;; Given a triple quote, we have to check the context to know
@@ -206,28 +209,25 @@ Used for syntactic keywords. N is the match number (1, 2 or 3)."
;; x '"""' x """ \"""" x
(save-excursion
(goto-char (match-beginning 0))
- (cond
- ;; Consider property for the last char if in a fenced string.
- ((= n 3)
- (let* ((font-lock-syntactic-keywords nil)
- (syntax (syntax-ppss)))
- (when (eq t (nth 3 syntax)) ; after unclosed fence
- (goto-char (nth 8 syntax)) ; fence position
- (skip-chars-forward "uUrR") ; skip any prefix
- ;; Is it a matching sequence?
- (if (eq (char-after) (char-after (match-beginning 2)))
- (eval-when-compile (string-to-syntax "|"))))))
- ;; Consider property for initial char, accounting for prefixes.
- ((or (and (= n 2) ; leading quote (not prefix)
- (= (match-beginning 1) (match-end 1))) ; prefix is null
- (and (= n 1) ; prefix
- (/= (match-beginning 1) (match-end 1)))) ; non-empty
- (let ((font-lock-syntactic-keywords nil))
- (unless (eq 'string (syntax-ppss-context (syntax-ppss)))
- (eval-when-compile (string-to-syntax "|")))))
- ;; Otherwise (we're in a non-matching string) the property is
- ;; nil, which is OK.
- )))
+ (let ((syntax (save-match-data (syntax-ppss))))
+ (cond
+ ((eq t (nth 3 syntax)) ; after unclosed fence
+ ;; Consider property for the last char if in a fenced string.
+ (goto-char (nth 8 syntax)) ; fence position
+ (skip-chars-forward "uUrR") ; skip any prefix
+ ;; Is it a matching sequence?
+ (if (eq (char-after) (char-after (match-beginning 2)))
+ (put-text-property (match-beginning 3) (match-end 3)
+ 'syntax-table (string-to-syntax "|"))))
+ ((match-end 1)
+ ;; Consider property for initial char, accounting for prefixes.
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'syntax-table (string-to-syntax "|")))
+ (t
+ ;; Consider property for initial char, accounting for prefixes.
+ (put-text-property (match-beginning 2) (match-end 2)
+ 'syntax-table (string-to-syntax "|"))))
+ )))
;; This isn't currently in `font-lock-defaults' as probably not worth
;; it -- we basically only mess with a few normally-symbol characters.
@@ -579,6 +579,33 @@ having to restart the program."
"Queue of Python temp files awaiting execution.
Currently-active file is at the head of the list.")
+(defcustom python-shell-prompt-alist
+ '(("ipython" . "^In \\[[0-9]+\\]: *")
+ (t . "^>>> "))
+ "Alist of Python input prompts.
+Each element has the form (PROGRAM . REGEXP), where PROGRAM is
+the value of `python-python-command' for the python process and
+REGEXP is a regular expression matching the Python prompt.
+PROGRAM can also be t, which specifies the default when no other
+element matches `python-python-command'."
+ :type 'string
+ :group 'python
+ :version "24.1")
+
+(defcustom python-shell-continuation-prompt-alist
+ '(("ipython" . "^ [.][.][.]+: *")
+ (t . "^[.][.][.] "))
+ "Alist of Python continued-line prompts.
+Each element has the form (PROGRAM . REGEXP), where PROGRAM is
+the value of `python-python-command' for the python process and
+REGEXP is a regular expression matching the Python prompt for
+continued lines.
+PROGRAM can also be t, which specifies the default when no other
+element matches `python-python-command'."
+ :type 'string
+ :group 'python
+ :version "24.1")
+
(defvar python-pdbtrack-is-tracking-p nil)
(defconst python-pdbtrack-stack-entry-regexp
@@ -755,7 +782,7 @@ Set `python-indent' locally to the value guessed."
'(("else" "if" "elif" "while" "for" "try" "except")
("elif" "if" "elif")
("except" "try" "except")
- ("finally" "try" "except"))
+ ("finally" "else" "try" "except"))
"Alist of keyword matches.
The car of an element is a keyword introducing a statement which
can close a block opened by a keyword in the cdr.")
@@ -1311,13 +1338,9 @@ See `python-check-command' for the default."
;;;; Inferior mode stuff (following cmuscheme).
-;; Fixme: Make sure we can work with IPython.
-
(defcustom python-python-command "python"
"Shell command to run Python interpreter.
-Any arguments can't contain whitespace.
-Note that IPython may not work properly; it must at least be used
-with the `-cl' flag, i.e. use `ipython -cl'."
+Any arguments can't contain whitespace."
:group 'python
:type 'string)
@@ -1395,6 +1418,23 @@ local value.")
;; Autoloaded.
(declare-function compilation-shell-minor-mode "compile" (&optional arg))
+(defvar python--prompt-regexp nil)
+
+(defun python--set-prompt-regexp ()
+ (let ((prompt (cdr-safe (or (assoc python-python-command
+ python-shell-prompt-alist)
+ (assq t python-shell-prompt-alist))))
+ (cprompt (cdr-safe (or (assoc python-python-command
+ python-shell-continuation-prompt-alist)
+ (assq t python-shell-continuation-prompt-alist)))))
+ (set (make-local-variable 'comint-prompt-regexp)
+ (concat "\\("
+ (mapconcat 'identity
+ (delq nil (list prompt cprompt "^([Pp]db) "))
+ "\\|")
+ "\\)"))
+ (set (make-local-variable 'python--prompt-regexp) prompt)))
+
;; Fixme: This should inherit some stuff from `python-mode', but I'm
;; not sure how much: at least some keybindings, like C-c C-f;
;; syntax?; font-locking, e.g. for triple-quoted strings?
@@ -1417,14 +1457,12 @@ For running multiple processes in multiple buffers, see `run-python' and
\\{inferior-python-mode-map}"
:group 'python
+ (require 'ansi-color) ; for ipython
(setq mode-line-process '(":%s"))
(set (make-local-variable 'comint-input-filter) 'python-input-filter)
(add-hook 'comint-preoutput-filter-functions #'python-preoutput-filter
nil t)
- ;; Still required by `comint-redirect-send-command', for instance
- ;; (and we need to match things like `>>> ... >>> '):
- (set (make-local-variable 'comint-prompt-regexp)
- (rx line-start (1+ (and (or (repeat 3 (any ">.")) "(Pdb)") " "))))
+ (python--set-prompt-regexp)
(set (make-local-variable 'compilation-error-regexp-alist)
python-compilation-regexp-alist)
(compilation-shell-minor-mode 1))
@@ -1521,12 +1559,12 @@ Don't save anything for STR matching `inferior-python-filter-regexp'."
cmd)))
(unless (shell-command-to-string cmd)
(error "Can't run Python command `%s'" cmd))
- (let* ((res (shell-command-to-string (concat cmd " --version"))))
- (string-match "Python \\([0-9]\\)\\.\\([0-9]\\)" res)
- (unless (and (equal "2" (match-string 1 res))
- (match-beginning 2)
- (>= (string-to-number (match-string 2 res)) 2))
- (error "Only Python versions >= 2.2 and < 3.0 supported")))
+ (let* ((res (shell-command-to-string
+ (concat cmd
+ " -c \"from sys import version_info;\
+print version_info >= (2, 2) and version_info < (3, 0)\""))))
+ (unless (string-match "True" res)
+ (error "Only Python versions >= 2.2 and < 3.0 are supported")))
(setq python-version-checked t)))
;;;###autoload
@@ -1549,6 +1587,7 @@ buffer for a list of commands.)"
(interactive (if current-prefix-arg
(list (read-string "Run Python: " python-command) nil t)
(list python-command)))
+ (require 'ansi-color) ; for ipython
(unless cmd (setq cmd python-command))
(python-check-version cmd)
(setq python-command cmd)
@@ -1566,8 +1605,10 @@ buffer for a list of commands.)"
(if path (concat path path-separator))
data-directory)
process-environment))
- ;; Suppress use of pager for help output:
- (process-connection-type nil))
+ ;; If we use a pipe, unicode characters are not printed
+ ;; correctly (Bug#5794) and IPython does not work at
+ ;; all (Bug#5390).
+ (process-connection-type t))
(apply 'make-comint-in-buffer "Python"
(generate-new-buffer "*Python*")
(car cmdlist) nil (cdr cmdlist)))
@@ -1623,7 +1664,12 @@ buffer for a list of commands.)"
;; non-ASCII.
(interactive "r")
(let* ((f (make-temp-file "py"))
- (command (format "emacs.eexecfile(%S)" f))
+ (command
+ ;; IPython puts the FakeModule module into __main__ so
+ ;; emacs.eexecfile becomes useless.
+ (if (string-match "^ipython" python-command)
+ (format "execfile %S" f)
+ (format "emacs.eexecfile(%S)" f)))
(orig-start (copy-marker start)))
(when (save-excursion
(goto-char start)
@@ -1823,7 +1869,9 @@ If there isn't, it's probably not appropriate to send input to return Eldoc
information etc. If PROC is non-nil, check the buffer for that process."
(with-current-buffer (process-buffer (or proc (python-proc)))
(save-excursion
- (save-match-data (re-search-backward ">>> \\=" nil t)))))
+ (save-match-data
+ (re-search-backward (concat python--prompt-regexp " *\\=")
+ nil t)))))
;; Fixme: Is there anything reasonable we can do with random methods?
;; (Currently only works with functions.)
@@ -2237,6 +2285,7 @@ the if condition."
(eval-when-compile
;; Define a user-level skeleton and add it to the abbrev table.
(defmacro def-python-skeleton (name &rest elements)
+ (declare (indent 2))
(let* ((name (symbol-name name))
(function (intern (concat "python-insert-" name))))
`(progn
@@ -2249,7 +2298,6 @@ the if condition."
(define-skeleton ,function
,(format "Insert Python \"%s\" template." name)
,@elements)))))
-(put 'def-python-skeleton 'lisp-indent-function 2)
;; From `skeleton-further-elements' set below:
;; `<': outdent a level;
@@ -2447,12 +2495,12 @@ with skeleton expansions for compound statement templates.
:group 'python
(set (make-local-variable 'font-lock-defaults)
'(python-font-lock-keywords nil nil nil nil
- (font-lock-syntactic-keywords
- . python-font-lock-syntactic-keywords)
- ;; This probably isn't worth it.
- ;; (font-lock-syntactic-face-function
- ;; . python-font-lock-syntactic-face-function)
- ))
+ ;; This probably isn't worth it.
+ ;; (font-lock-syntactic-face-function
+ ;; . python-font-lock-syntactic-face-function)
+ ))
+ (set (make-local-variable 'syntax-propertize-function)
+ python-syntax-propertize-function)
(set (make-local-variable 'parse-sexp-lookup-properties) t)
(set (make-local-variable 'parse-sexp-ignore-comments) t)
(set (make-local-variable 'comment-start) "# ")
@@ -2539,9 +2587,7 @@ Runs `jython-mode-hook' after `python-mode-hook'."
"Watch output for Python prompt and exec next file waiting in queue.
This function is appropriate for `comint-output-filter-functions'."
;; TBD: this should probably use split-string
- (when (and (or (string-equal string ">>> ")
- (and (>= (length string) 5)
- (string-equal (substring string -5) "\n>>> ")))
+ (when (and (string-match python--prompt-regexp string)
python-file-queue)
(condition-case nil
(delete-file (car python-file-queue))
@@ -2753,6 +2799,7 @@ comint believe the user typed this string so that
(funcall (process-filter proc) proc msg))
(set-buffer curbuf))
(process-send-string proc cmd)))
+
;;;###autoload
(defun python-shell (&optional argprompt)
"Start an interactive Python interpreter in another window.
@@ -2792,6 +2839,7 @@ interaction between undo and process filters; the same problem exists in
non-Python process buffers using the default (Emacs-supplied) process
filter."
(interactive "P")
+ (require 'ansi-color) ; For ipython
;; Set the default shell if not already set
(when (null python-which-shell)
(python-toggle-shells python-default-interpreter))
@@ -2808,10 +2856,9 @@ filter."
))))
(switch-to-buffer-other-window
(apply 'make-comint python-which-bufname python-which-shell nil args))
- (make-local-variable 'comint-prompt-regexp)
(set-process-sentinel (get-buffer-process (current-buffer))
'python-sentinel)
- (setq comint-prompt-regexp "^>>> \\|^[.][.][.] \\|^(pdb) ")
+ (python--set-prompt-regexp)
(add-hook 'comint-output-filter-functions
'python-comint-output-filter-function nil t)
;; pdbtrack
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index a75c5b01bb..4d015de519 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -43,6 +43,11 @@
(eval-when-compile (require 'cl))
+(defgroup ruby nil
+ "Major mode for editing Ruby code."
+ :prefix "ruby-"
+ :group 'languages)
+
(defconst ruby-keyword-end-re
(if (string-match "\\_>" "ruby")
"\\_>"
@@ -95,17 +100,10 @@
(defconst ruby-block-end-re "\\<end\\>")
-(defconst ruby-here-doc-beg-re
+(eval-and-compile
+ (defconst ruby-here-doc-beg-re
"\\(<\\)<\\(-\\)?\\(\\([a-zA-Z0-9_]+\\)\\|[\"]\\([^\"]+\\)[\"]\\|[']\\([^']+\\)[']\\)"
- "Regexp to match the beginning of a heredoc.")
-
-(defconst ruby-here-doc-end-re
- "^\\([ \t]+\\)?\\(.*\\)\\(.\\)$"
- "Regexp to match the end of heredocs.
-
-This will actually match any line with one or more characters.
-It's useful in that it divides up the match string so that
-`ruby-here-doc-beg-match' can search for the beginning of the heredoc.")
+ "Regexp to match the beginning of a heredoc."))
(defun ruby-here-doc-end-match ()
"Return a regexp to find the end of a heredoc.
@@ -118,18 +116,6 @@ This should only be called after matching against `ruby-here-doc-beg-re'."
(match-string 5)
(match-string 6)))))
-(defun ruby-here-doc-beg-match ()
- "Return a regexp to find the beginning of a heredoc.
-
-This should only be called after matching against `ruby-here-doc-end-re'."
- (let ((contents (regexp-quote (concat (match-string 2) (match-string 3)))))
- (concat "<<"
- (let ((match (match-string 1)))
- (if (and match (> (length match) 0))
- (concat "\\(?:-\\([\"']?\\)\\|\\([\"']\\)" (match-string 1) "\\)"
- contents "\\b\\(\\1\\|\\2\\)")
- (concat "-?\\([\"']\\|\\)" contents "\\b\\1"))))))
-
(defconst ruby-delimiter
(concat "[?$/%(){}#\"'`.:]\\|<<\\|\\[\\|\\]\\|\\<\\("
ruby-block-beg-re
@@ -357,7 +343,7 @@ Also ignores spaces after parenthesis when 'space."
(back-to-indentation)
(current-column)))
-(defun ruby-indent-line (&optional flag)
+(defun ruby-indent-line (&optional ignored)
"Correct the indentation of the current Ruby line."
(interactive)
(ruby-indent-to (ruby-calculate-indent)))
@@ -400,8 +386,7 @@ and `\\' when preceded by `?'."
"TODO: document."
(save-excursion
(store-match-data nil)
- (let ((space (skip-chars-backward " \t"))
- (start (point)))
+ (let ((space (skip-chars-backward " \t")))
(cond
((bolp) t)
((progn
@@ -695,7 +680,7 @@ and `\\' when preceded by `?'."
(beginning-of-line)
(let ((ruby-indent-point (point))
(case-fold-search nil)
- state bol eol begin op-end
+ state eol begin op-end
(paren (progn (skip-syntax-forward " ")
(and (char-after) (matching-paren (char-after)))))
(indent 0))
@@ -775,7 +760,6 @@ and `\\' when preceded by `?'."
(if (re-search-forward "^\\s *#" end t)
(beginning-of-line)
(setq done t))))
- (setq bol (point))
(end-of-line)
;; skip the comment at the end
(skip-chars-backward " \t")
@@ -1032,10 +1016,8 @@ With ARG, do it many times. Negative ARG means move forward."
(ruby-beginning-of-defun)
(re-search-backward "^\n" (- (point) 1) t))
-(defun ruby-indent-exp (&optional shutup-p)
- "Indent each line in the balanced expression following the point.
-If a prefix arg is given or SHUTUP-P is non-nil, no errors
-are signalled if a balanced expression isn't found."
+(defun ruby-indent-exp (&optional ignored)
+ "Indent each line in the balanced expression following the point."
(interactive "*P")
(let ((here (point-marker)) start top column (nest t))
(set-marker-insertion-type here t)
@@ -1128,58 +1110,208 @@ See `add-log-current-defun-function'."
(if mlist (concat mlist mname) mname)
mlist)))))
-(defconst ruby-font-lock-syntactic-keywords
- `(;; #{ }, #$hoge, #@foo are not comments
- ("\\(#\\)[{$@]" 1 (1 . nil))
- ;; the last $', $", $` in the respective string is not variable
- ;; the last ?', ?", ?` in the respective string is not ascii code
- ("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)"
- (2 (7 . nil))
- (4 (7 . nil)))
- ;; $' $" $` .... are variables
- ;; ?' ?" ?` are ascii codes
- ("\\(^\\|[^\\\\]\\)\\(\\\\\\\\\\)*[?$]\\([#\"'`]\\)" 3 (1 . nil))
- ;; regexps
- ("\\(^\\|[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)"
- (4 (7 . ?/))
- (6 (7 . ?/)))
- ("^=en\\(d\\)\\_>" 1 "!")
- ("^\\(=\\)begin\\_>" 1 (ruby-comment-beg-syntax))
- ;; Currently, the following case is highlighted incorrectly:
- ;;
- ;; <<FOO
- ;; FOO
- ;; <<BAR
- ;; <<BAZ
- ;; BAZ
- ;; BAR
- ;;
- ;; This is because all here-doc beginnings are highlighted before any endings,
- ;; so although <<BAR is properly marked as a beginning, when we get to <<BAZ
- ;; it thinks <<BAR is part of a string so it's marked as well.
- ;;
- ;; This may be fixable by modifying ruby-in-here-doc-p to use
- ;; ruby-in-non-here-doc-string-p rather than syntax-ppss-context,
- ;; but I don't want to try that until we've got unit tests set up
- ;; to make sure I don't break anything else.
- (,(concat ruby-here-doc-beg-re ".*\\(\n\\)")
- ,(+ 1 (regexp-opt-depth ruby-here-doc-beg-re))
- (ruby-here-doc-beg-syntax))
- (,ruby-here-doc-end-re 3 (ruby-here-doc-end-syntax)))
- "Syntactic keywords for Ruby mode. See `font-lock-syntactic-keywords'.")
-
-(defun ruby-comment-beg-syntax ()
- "Return the syntax cell for a the first character of a =begin.
+(if (eval-when-compile (fboundp #'syntax-propertize-rules))
+ ;; New code that works independently from font-lock.
+ (progn
+ (defun ruby-syntax-propertize-function (start end)
+ "Syntactic keywords for Ruby mode. See `syntax-propertize-function'."
+ (goto-char start)
+ (ruby-syntax-propertize-heredoc end)
+ (funcall
+ (syntax-propertize-rules
+ ;; #{ }, #$hoge, #@foo are not comments
+ ("\\(#\\)[{$@]" (1 "."))
+ ;; the last $', $", $` in the respective string is not variable
+ ;; the last ?', ?", ?` in the respective string is not ascii code
+ ("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)"
+ (2 "\"")
+ (4 "\""))
+ ;; $' $" $` .... are variables
+ ;; ?' ?" ?` are ascii codes
+ ("\\(^\\|[^\\\\]\\)\\(\\\\\\\\\\)*[?$]\\([#\"'`]\\)" (3 "."))
+ ;; regexps
+ ("\\(^\\|[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)"
+ (4 "\"/")
+ (6 "\"/"))
+ ("^=en\\(d\\)\\_>" (1 "!"))
+ ("^\\(=\\)begin\\_>" (1 "!"))
+ ;; Handle here documents.
+ ((concat ruby-here-doc-beg-re ".*\\(\n\\)")
+ (7 (prog1 "\"" (ruby-syntax-propertize-heredoc end)))))
+ (point) end))
+
+ (defun ruby-syntax-propertize-heredoc (limit)
+ (let ((ppss (syntax-ppss))
+ (res '()))
+ (when (eq ?\n (nth 3 ppss))
+ (save-excursion
+ (goto-char (nth 8 ppss))
+ (beginning-of-line)
+ (while (re-search-forward ruby-here-doc-beg-re
+ (line-end-position) t)
+ (push (concat (ruby-here-doc-end-match) "\n") res)))
+ (let ((start (point)))
+ ;; With multiple openers on the same line, we don't know in which
+ ;; part `start' is, so we have to go back to the beginning.
+ (when (cdr res)
+ (goto-char (nth 8 ppss))
+ (setq res (nreverse res)))
+ (while (and res (re-search-forward (pop res) limit 'move))
+ (if (null res)
+ (put-text-property (1- (point)) (point)
+ 'syntax-table (string-to-syntax "\""))))
+ ;; Make extra sure we don't move back, lest we could fall into an
+ ;; inf-loop.
+ (if (< (point) start) (goto-char start))))))
+ )
+
+ ;; For Emacsen where syntax-propertize-rules is not (yet) available,
+ ;; fallback on the old font-lock-syntactic-keywords stuff.
+
+ (defconst ruby-here-doc-end-re
+ "^\\([ \t]+\\)?\\(.*\\)\\(\n\\)"
+ "Regexp to match the end of heredocs.
+
+This will actually match any line with one or more characters.
+It's useful in that it divides up the match string so that
+`ruby-here-doc-beg-match' can search for the beginning of the heredoc.")
+
+ (defun ruby-here-doc-beg-match ()
+ "Return a regexp to find the beginning of a heredoc.
+
+This should only be called after matching against `ruby-here-doc-end-re'."
+ (let ((contents (regexp-quote (match-string 2))))
+ (concat "<<"
+ (let ((match (match-string 1)))
+ (if (and match (> (length match) 0))
+ (concat "\\(?:-\\([\"']?\\)\\|\\([\"']\\)" match "\\)"
+ contents "\\b\\(\\1\\|\\2\\)")
+ (concat "-?\\([\"']\\|\\)" contents "\\b\\1"))))))
+
+ (defconst ruby-font-lock-syntactic-keywords
+ `( ;; #{ }, #$hoge, #@foo are not comments
+ ("\\(#\\)[{$@]" 1 (1 . nil))
+ ;; the last $', $", $` in the respective string is not variable
+ ;; the last ?', ?", ?` in the respective string is not ascii code
+ ("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)"
+ (2 (7 . nil))
+ (4 (7 . nil)))
+ ;; $' $" $` .... are variables
+ ;; ?' ?" ?` are ascii codes
+ ("\\(^\\|[^\\\\]\\)\\(\\\\\\\\\\)*[?$]\\([#\"'`]\\)" 3 (1 . nil))
+ ;; regexps
+ ("\\(^\\|[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)"
+ (4 (7 . ?/))
+ (6 (7 . ?/)))
+ ("^=en\\(d\\)\\_>" 1 "!")
+ ("^\\(=\\)begin\\_>" 1 (ruby-comment-beg-syntax))
+ ;; Currently, the following case is highlighted incorrectly:
+ ;;
+ ;; <<FOO
+ ;; FOO
+ ;; <<BAR
+ ;; <<BAZ
+ ;; BAZ
+ ;; BAR
+ ;;
+ ;; This is because all here-doc beginnings are highlighted before any endings,
+ ;; so although <<BAR is properly marked as a beginning, when we get to <<BAZ
+ ;; it thinks <<BAR is part of a string so it's marked as well.
+ ;;
+ ;; This may be fixable by modifying ruby-in-here-doc-p to use
+ ;; ruby-in-non-here-doc-string-p rather than syntax-ppss-context,
+ ;; but I don't want to try that until we've got unit tests set up
+ ;; to make sure I don't break anything else.
+ (,(concat ruby-here-doc-beg-re ".*\\(\n\\)")
+ ,(+ 1 (regexp-opt-depth ruby-here-doc-beg-re))
+ (ruby-here-doc-beg-syntax))
+ (,ruby-here-doc-end-re 3 (ruby-here-doc-end-syntax)))
+ "Syntactic keywords for Ruby mode. See `font-lock-syntactic-keywords'.")
+
+ (defun ruby-comment-beg-syntax ()
+ "Return the syntax cell for a the first character of a =begin.
See the definition of `ruby-font-lock-syntactic-keywords'.
This returns a comment-delimiter cell as long as the =begin
isn't in a string or another comment."
- (when (not (nth 3 (syntax-ppss)))
- (string-to-syntax "!")))
+ (when (not (nth 3 (syntax-ppss)))
+ (string-to-syntax "!")))
-(unless (functionp 'syntax-ppss)
- (defun syntax-ppss (&optional pos)
- (parse-partial-sexp (point-min) (or pos (point)))))
+ (defun ruby-in-here-doc-p ()
+ "Return whether or not the point is in a heredoc."
+ (save-excursion
+ (let ((old-point (point)) (case-fold-search nil))
+ (beginning-of-line)
+ (catch 'found-beg
+ (while (re-search-backward ruby-here-doc-beg-re nil t)
+ (if (not (or (ruby-in-ppss-context-p 'anything)
+ (ruby-here-doc-find-end old-point)))
+ (throw 'found-beg t)))))))
+
+ (defun ruby-here-doc-find-end (&optional limit)
+ "Expects the point to be on a line with one or more heredoc openers.
+Returns the buffer position at which all heredocs on the line
+are terminated, or nil if they aren't terminated before the
+buffer position `limit' or the end of the buffer."
+ (save-excursion
+ (beginning-of-line)
+ (catch 'done
+ (let ((eol (save-excursion (end-of-line) (point)))
+ (case-fold-search nil)
+ ;; Fake match data such that (match-end 0) is at eol
+ (end-match-data (progn (looking-at ".*$") (match-data)))
+ beg-match-data end-re)
+ (while (re-search-forward ruby-here-doc-beg-re eol t)
+ (setq beg-match-data (match-data))
+ (setq end-re (ruby-here-doc-end-match))
+
+ (set-match-data end-match-data)
+ (goto-char (match-end 0))
+ (unless (re-search-forward end-re limit t) (throw 'done nil))
+ (setq end-match-data (match-data))
+
+ (set-match-data beg-match-data)
+ (goto-char (match-end 0)))
+ (set-match-data end-match-data)
+ (goto-char (match-end 0))
+ (point)))))
+
+ (defun ruby-here-doc-beg-syntax ()
+ "Return the syntax cell for a line that may begin a heredoc.
+See the definition of `ruby-font-lock-syntactic-keywords'.
+
+This sets the syntax cell for the newline ending the line
+containing the heredoc beginning so that cases where multiple
+heredocs are started on one line are handled correctly."
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (unless (or (ruby-in-ppss-context-p 'non-heredoc)
+ (ruby-in-here-doc-p))
+ (string-to-syntax "\""))))
+
+ (defun ruby-here-doc-end-syntax ()
+ "Return the syntax cell for a line that may end a heredoc.
+See the definition of `ruby-font-lock-syntactic-keywords'."
+ (let ((pss (syntax-ppss)) (case-fold-search nil))
+ ;; If we aren't in a string, we definitely aren't ending a heredoc,
+ ;; so we can just give up.
+ ;; This means we aren't doing a full-document search
+ ;; every time we enter a character.
+ (when (ruby-in-ppss-context-p 'heredoc pss)
+ (save-excursion
+ (goto-char (nth 8 pss)) ; Go to the beginning of heredoc.
+ (let ((eol (point)))
+ (beginning-of-line)
+ (if (and (re-search-forward (ruby-here-doc-beg-match) eol t) ; If there is a heredoc that matches this line...
+ (not (ruby-in-ppss-context-p 'anything)) ; And that's not inside a heredoc/string/comment...
+ (progn (goto-char (match-end 0)) ; And it's the last heredoc on its line...
+ (not (re-search-forward ruby-here-doc-beg-re eol t))))
+ (string-to-syntax "\"")))))))
+
+ (unless (functionp 'syntax-ppss)
+ (defun syntax-ppss (&optional pos)
+ (parse-partial-sexp (point-min) (or pos (point)))))
+ )
(defun ruby-in-ppss-context-p (context &optional ppss)
(let ((ppss (or ppss (syntax-ppss (point)))))
@@ -1190,10 +1322,7 @@ isn't in a string or another comment."
((eq context 'string)
(nth 3 ppss))
((eq context 'heredoc)
- (and (nth 3 ppss)
- ;; If it's generic string, it's a heredoc and we don't care
- ;; See `parse-partial-sexp'
- (not (numberp (nth 3 ppss)))))
+ (eq ?\n (nth 3 ppss)))
((eq context 'non-heredoc)
(and (ruby-in-ppss-context-p 'anything)
(not (ruby-in-ppss-context-p 'heredoc))))
@@ -1205,77 +1334,6 @@ isn't in a string or another comment."
"context name `" (symbol-name context) "' is unknown"))))
t)))
-(defun ruby-in-here-doc-p ()
- "Return whether or not the point is in a heredoc."
- (save-excursion
- (let ((old-point (point)) (case-fold-search nil))
- (beginning-of-line)
- (catch 'found-beg
- (while (re-search-backward ruby-here-doc-beg-re nil t)
- (if (not (or (ruby-in-ppss-context-p 'anything)
- (ruby-here-doc-find-end old-point)))
- (throw 'found-beg t)))))))
-
-(defun ruby-here-doc-find-end (&optional limit)
- "Expects the point to be on a line with one or more heredoc openers.
-Returns the buffer position at which all heredocs on the line
-are terminated, or nil if they aren't terminated before the
-buffer position `limit' or the end of the buffer."
- (save-excursion
- (beginning-of-line)
- (catch 'done
- (let ((eol (save-excursion (end-of-line) (point)))
- (case-fold-search nil)
- ;; Fake match data such that (match-end 0) is at eol
- (end-match-data (progn (looking-at ".*$") (match-data)))
- beg-match-data end-re)
- (while (re-search-forward ruby-here-doc-beg-re eol t)
- (setq beg-match-data (match-data))
- (setq end-re (ruby-here-doc-end-match))
-
- (set-match-data end-match-data)
- (goto-char (match-end 0))
- (unless (re-search-forward end-re limit t) (throw 'done nil))
- (setq end-match-data (match-data))
-
- (set-match-data beg-match-data)
- (goto-char (match-end 0)))
- (set-match-data end-match-data)
- (goto-char (match-end 0))
- (point)))))
-
-(defun ruby-here-doc-beg-syntax ()
- "Return the syntax cell for a line that may begin a heredoc.
-See the definition of `ruby-font-lock-syntactic-keywords'.
-
-This sets the syntax cell for the newline ending the line
-containing the heredoc beginning so that cases where multiple
-heredocs are started on one line are handled correctly."
- (save-excursion
- (goto-char (match-beginning 0))
- (unless (or (ruby-in-ppss-context-p 'non-heredoc)
- (ruby-in-here-doc-p))
- (string-to-syntax "|"))))
-
-(defun ruby-here-doc-end-syntax ()
- "Return the syntax cell for a line that may end a heredoc.
-See the definition of `ruby-font-lock-syntactic-keywords'."
- (let ((pss (syntax-ppss)) (case-fold-search nil))
- ;; If we aren't in a string, we definitely aren't ending a heredoc,
- ;; so we can just give up.
- ;; This means we aren't doing a full-document search
- ;; every time we enter a character.
- (when (ruby-in-ppss-context-p 'heredoc pss)
- (save-excursion
- (goto-char (nth 8 pss)) ; Go to the beginning of heredoc.
- (let ((eol (point)))
- (beginning-of-line)
- (if (and (re-search-forward (ruby-here-doc-beg-match) eol t) ; If there is a heredoc that matches this line...
- (not (ruby-in-ppss-context-p 'anything)) ; And that's not inside a heredoc/string/comment...
- (progn (goto-char (match-end 0)) ; And it's the last heredoc on its line...
- (not (re-search-forward ruby-here-doc-beg-re eol t))))
- (string-to-syntax "|")))))))
-
(if (featurep 'xemacs)
(put 'ruby-mode 'font-lock-defaults
'((ruby-font-lock-keywords)
@@ -1372,8 +1430,10 @@ See `font-lock-syntax-table'.")
)
"Additional expressions to highlight in Ruby mode.")
+(defvar electric-indent-chars)
+
;;;###autoload
-(defun ruby-mode ()
+(define-derived-mode ruby-mode prog-mode "Ruby"
"Major mode for editing Ruby scripts.
\\[ruby-indent-line] properly indents subexpressions of multi-line
class, module, def, if, while, for, do, and case statements, taking
@@ -1382,27 +1442,22 @@ nesting into account.
The variable `ruby-indent-level' controls the amount of indentation.
\\{ruby-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (use-local-map ruby-mode-map)
- (setq mode-name "Ruby")
- (setq major-mode 'ruby-mode)
(ruby-mode-variables)
- (set (make-local-variable 'indent-line-function)
- 'ruby-indent-line)
(set (make-local-variable 'imenu-create-index-function)
'ruby-imenu-create-index)
(set (make-local-variable 'add-log-current-defun-function)
'ruby-add-log-current-method)
(add-hook
- (cond ((boundp 'before-save-hook)
- (make-local-variable 'before-save-hook)
- 'before-save-hook)
+ (cond ((boundp 'before-save-hook) 'before-save-hook)
((boundp 'write-contents-functions) 'write-contents-functions)
((boundp 'write-contents-hooks) 'write-contents-hooks))
- 'ruby-mode-set-encoding)
+ 'ruby-mode-set-encoding nil 'local)
+
+ (set (make-local-variable 'electric-indent-chars)
+ (append '(?\{ ?\}) (if (boundp 'electric-indent-chars)
+ (default-value 'electric-indent-chars))))
(set (make-local-variable 'font-lock-defaults)
'((ruby-font-lock-keywords) nil nil))
@@ -1410,12 +1465,12 @@ The variable `ruby-indent-level' controls the amount of indentation.
ruby-font-lock-keywords)
(set (make-local-variable 'font-lock-syntax-table)
ruby-font-lock-syntax-table)
- (set (make-local-variable 'font-lock-syntactic-keywords)
- ruby-font-lock-syntactic-keywords)
- (if (fboundp 'run-mode-hooks)
- (run-mode-hooks 'ruby-mode-hook)
- (run-hooks 'ruby-mode-hook)))
+ (if (eval-when-compile (fboundp 'syntax-propertize-rules))
+ (set (make-local-variable 'syntax-propertize-function)
+ #'ruby-syntax-propertize-function)
+ (set (make-local-variable 'font-lock-syntactic-keywords)
+ ruby-font-lock-syntactic-keywords)))
;;; Invoke ruby-mode when appropriate
diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el
index ce8a34220e..da143db5ff 100644
--- a/lisp/progmodes/scheme.el
+++ b/lisp/progmodes/scheme.el
@@ -107,7 +107,7 @@
;; Special characters
(modify-syntax-entry ?, "' " st)
(modify-syntax-entry ?@ "' " st)
- (modify-syntax-entry ?# "' 14b" st)
+ (modify-syntax-entry ?# "' 14" st)
(modify-syntax-entry ?\\ "\\ " st)
st))
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index 5f4028af89..d41a81e38a 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -939,7 +939,6 @@ See `sh-feature'.")
;; These are used for the syntax table stuff (derived from cperl-mode).
;; Note: parse-sexp-lookup-properties must be set to t for it to work.
(defconst sh-st-punc (string-to-syntax "."))
-(defconst sh-st-symbol (string-to-syntax "_"))
(defconst sh-here-doc-syntax (string-to-syntax "|")) ;; generic string
(defconst sh-escaped-line-re
@@ -957,7 +956,7 @@ See `sh-feature'.")
(defvar sh-here-doc-re sh-here-doc-open-re)
(make-variable-buffer-local 'sh-here-doc-re)
-(defun sh-font-lock-close-heredoc (bol eof indented)
+(defun sh-font-lock-close-heredoc (bol eof indented eol)
"Determine the syntax of the \\n after an EOF.
If non-nil INDENTED indicates that the EOF was indented."
(let* ((eof-re (if eof (regexp-quote eof) ""))
@@ -971,6 +970,8 @@ If non-nil INDENTED indicates that the EOF was indented."
(ere (concat "^" (if indented "[ \t]*") eof-re "\n"))
(start (save-excursion
(goto-char bol)
+ ;; FIXME: will incorrectly find a <<EOF embedded inside
+ ;; the heredoc.
(re-search-backward (concat sre "\\|" ere) nil t))))
;; If subgroup 1 matched, we found an open-heredoc, otherwise we first
;; found a close-heredoc which makes the current close-heredoc inoperant.
@@ -990,7 +991,7 @@ If non-nil INDENTED indicates that the EOF was indented."
(sh-in-comment-or-string (point)))))
;; No <<EOF2 found after our <<.
(= (point) start)))
- sh-here-doc-syntax)
+ (put-text-property eol (1+ eol) 'syntax-table sh-here-doc-syntax))
((not (or start (save-excursion (re-search-forward sre nil t))))
;; There's no <<EOF either before or after us,
;; so we should remove ourselves from font-lock's keywords.
@@ -1000,7 +1001,7 @@ If non-nil INDENTED indicates that the EOF was indented."
(regexp-opt sh-here-doc-markers t) "\\(\n\\)"))
nil))))
-(defun sh-font-lock-open-heredoc (start string)
+(defun sh-font-lock-open-heredoc (start string eol)
"Determine the syntax of the \\n after a <<EOF.
START is the position of <<.
STRING is the actual word used as delimiter (e.g. \"EOF\").
@@ -1030,13 +1031,8 @@ Point is at the beginning of the next line."
;; Don't bother fixing it now, but place a multiline property so
;; that when jit-lock-context-* refontifies the rest of the
;; buffer, it also refontifies the current line with it.
- (put-text-property start (point) 'font-lock-multiline t)))
- sh-here-doc-syntax))
-
-(defun sh-font-lock-here-doc (limit)
- "Search for a heredoc marker."
- ;; This looks silly, but it's because `sh-here-doc-re' keeps changing.
- (re-search-forward sh-here-doc-re limit t))
+ (put-text-property start (point) 'syntax-multiline t)))
+ (put-text-property eol (1+ eol) 'syntax-table sh-here-doc-syntax)))
(defun sh-font-lock-quoted-subshell (limit)
"Search for a subshell embedded in a string.
@@ -1045,9 +1041,7 @@ subshells can nest."
;; FIXME: This can (and often does) match multiple lines, yet it makes no
;; effort to handle multiline cases correctly, so it ends up being
;; rather flakey.
- (when (and (re-search-forward "\"\\(?:\\(?:.\\|\n\\)*?[^\\]\\(?:\\\\\\\\\\)*\\)??\\(\\$(\\|`\\)" limit t)
- ;; Make sure the " we matched is an opening quote.
- (eq ?\" (nth 3 (syntax-ppss))))
+ (when (eq ?\" (nth 3 (syntax-ppss))) ; Check we matched an opening quote.
;; bingo we have a $( or a ` inside a ""
(let ((char (char-after (point)))
;; `state' can be: double-quote, backquote, code.
@@ -1082,8 +1076,7 @@ subshells can nest."
(double-quote nil)
(t (setq state (pop states)))))
(t (error "Internal error in sh-font-lock-quoted-subshell")))
- (forward-char 1)))
- t))
+ (forward-char 1)))))
(defun sh-is-quoted-p (pos)
@@ -1122,7 +1115,7 @@ subshells can nest."
(when (progn (backward-char 2)
(if (> start (line-end-position))
(put-text-property (point) (1+ start)
- 'font-lock-multiline t))
+ 'syntax-multiline t))
;; FIXME: The `in' may just be a random argument to
;; a normal command rather than the real `in' keyword.
;; I.e. we should look back to try and find the
@@ -1136,40 +1129,44 @@ subshells can nest."
sh-st-punc
nil))
-(defun sh-font-lock-flush-syntax-ppss-cache (limit)
- ;; This should probably be a standard function provided by font-lock.el
- ;; (or syntax.el).
- (syntax-ppss-flush-cache (point))
- (goto-char limit)
- nil)
-
-(defconst sh-font-lock-syntactic-keywords
- ;; A `#' begins a comment when it is unquoted and at the beginning of a
- ;; word. In the shell, words are separated by metacharacters.
- ;; The list of special chars is taken from the single-unix spec
- ;; of the shell command language (under `quoting') but with `$' removed.
- `(("[^|&;<>()`\\\"' \t\n]\\(#+\\)" 1 ,sh-st-symbol)
- ;; In a '...' the backslash is not escaping.
- ("\\(\\\\\\)'" (1 (sh-font-lock-backslash-quote)))
- ;; The previous rule uses syntax-ppss, but the subsequent rules may
- ;; change the syntax, so we have to tell syntax-ppss that the states it
- ;; has just computed will need to be recomputed.
- (sh-font-lock-flush-syntax-ppss-cache)
- ;; Make sure $@ and $? are correctly recognized as sexps.
- ("\\$\\([?@]\\)" 1 ,sh-st-symbol)
- ;; Find HEREDOC starters and add a corresponding rule for the ender.
- (sh-font-lock-here-doc
- (2 (sh-font-lock-open-heredoc
- (match-beginning 0) (match-string 1)) nil t)
- (5 (sh-font-lock-close-heredoc
- (match-beginning 0) (match-string 4)
- (and (match-beginning 3) (/= (match-beginning 3) (match-end 3))))
- nil t))
- ;; Distinguish the special close-paren in `case'.
- (")" 0 (sh-font-lock-paren (match-beginning 0)))
- ;; highlight (possibly nested) subshells inside "" quoted regions correctly.
- ;; This should be at the very end because it uses syntax-ppss.
- (sh-font-lock-quoted-subshell)))
+(defun sh-syntax-propertize-function (start end)
+ (goto-char start)
+ (while (prog1
+ (re-search-forward sh-here-doc-re end 'move)
+ (save-excursion
+ (save-match-data
+ (funcall
+ (syntax-propertize-rules
+ ;; A `#' begins a comment when it is unquoted and at the
+ ;; beginning of a word. In the shell, words are separated by
+ ;; metacharacters. The list of special chars is taken from
+ ;; the single-unix spec of the shell command language (under
+ ;; `quoting') but with `$' removed.
+ ("[^|&;<>()`\\\"' \t\n]\\(#+\\)" (1 "_"))
+ ;; In a '...' the backslash is not escaping.
+ ("\\(\\\\\\)'" (1 (sh-font-lock-backslash-quote)))
+ ;; Make sure $@ and $? are correctly recognized as sexps.
+ ("\\$\\([?@]\\)" (1 "_"))
+ ;; Distinguish the special close-paren in `case'.
+ (")" (0 (sh-font-lock-paren (match-beginning 0))))
+ ;; Highlight (possibly nested) subshells inside "" quoted
+ ;; regions correctly.
+ ("\"\\(?:\\(?:.\\|\n\\)*?[^\\]\\(?:\\\\\\\\\\)*\\)??\\(\\$(\\|`\\)"
+ (1 (ignore
+ ;; Save excursion because we want to also apply other
+ ;; syntax-propertize rules within the affected region.
+ (save-excursion
+ (sh-font-lock-quoted-subshell end))))))
+ (prog1 start (setq start (point))) (point)))))
+ (if (match-beginning 2)
+ ;; FIXME: actually, once we see an heredoc opener, we should just
+ ;; search for its ender without propertizing anything in it.
+ (sh-font-lock-open-heredoc
+ (match-beginning 0) (match-string 1) (match-beginning 2))
+ (sh-font-lock-close-heredoc
+ (match-beginning 0) (match-string 4)
+ (and (match-beginning 3) (/= (match-beginning 3) (match-end 3)))
+ (match-beginning 5)))))
(defun sh-font-lock-syntactic-face-function (state)
(let ((q (nth 3 state)))
@@ -1553,9 +1550,12 @@ with your script for an edit-interpret-debug cycle."
sh-font-lock-keywords-1 sh-font-lock-keywords-2)
nil nil
((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w")) nil
- (font-lock-syntactic-keywords . sh-font-lock-syntactic-keywords)
(font-lock-syntactic-face-function
. sh-font-lock-syntactic-face-function)))
+ (set (make-local-variable 'syntax-propertize-function)
+ #'sh-syntax-propertize-function)
+ (add-hook 'syntax-propertize-extend-region-functions
+ #'syntax-propertize-multiline 'append 'local)
(set (make-local-variable 'skeleton-pair-alist) '((?` _ ?`)))
(set (make-local-variable 'skeleton-pair-filter-function) 'sh-quoted-p)
(set (make-local-variable 'skeleton-further-elements)
@@ -2207,10 +2207,9 @@ STRING This is ignored for the purposes of calculating
;; Note: setting result to t means we are done and will return nil.
;;(This function never returns just t.)
(cond
- ((or (and (boundp 'font-lock-string-face) (not (bobp))
- (eq (get-text-property (1- (point)) 'face)
- font-lock-string-face))
+ ((or (nth 3 (syntax-ppss (point)))
(eq (get-text-property (point) 'face) sh-heredoc-face))
+ ;; String continuation -- don't indent
(setq result t)
(setq have-result t))
((looking-at "\\s-*#") ; was (equal this-kw "#")
diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el
index f8d1a6aca9..34c50b6cfe 100644
--- a/lisp/progmodes/simula.el
+++ b/lisp/progmodes/simula.el
@@ -163,17 +163,18 @@ for SIMULA mode to function correctly."
(defvar simula-mode-syntax-table nil
"Syntax table in SIMULA mode buffers.")
-(defconst simula-font-lock-syntactic-keywords
- `(;; `comment' directive.
- ("\\<\\(c\\)omment\\>" 1 "<")
- ;; end comments
- (,(concat "\\<end\\>\\([^;\n]\\).*?\\(\n\\|\\(.\\)\\(;\\|"
- (regexp-opt '("end" "else" "when" "otherwise"))
- "\\)\\)")
- (1 "< b")
- (3 "> b" nil t))
- ;; non-quoted single-quote char.
- ("'\\('\\)'" 1 ".")))
+(defconst simula-syntax-propertize-function
+ (syntax-propertize-rules
+ ;; `comment' directive.
+ ("\\<\\(c\\)omment\\>" (1 "<"))
+ ;; end comments
+ ((concat "\\<end\\>\\([^;\n]\\).*?\\(\n\\|\\(.\\)\\(;\\|"
+ (regexp-opt '("end" "else" "when" "otherwise"))
+ "\\)\\)")
+ (1 "< b")
+ (3 "> b"))
+ ;; non-quoted single-quote char.
+ ("'\\('\\)'" (1 "."))))
;; Regexps written with help from Alf-Ivar Holm <[email protected]>.
(defconst simula-font-lock-keywords-1
@@ -396,8 +397,9 @@ with no arguments, if that value is non-nil."
(setq font-lock-defaults
'((simula-font-lock-keywords simula-font-lock-keywords-1
simula-font-lock-keywords-2 simula-font-lock-keywords-3)
- nil t ((?_ . "w")) nil
- (font-lock-syntactic-keywords . simula-font-lock-syntactic-keywords)))
+ nil t ((?_ . "w"))))
+ (set (make-local-variable 'syntax-propertize-function)
+ simula-syntax-propertize-function)
(abbrev-mode 1))
(defun simula-indent-exp ()
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index ff75d46ff1..a80a555c13 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -5,7 +5,7 @@
;; Author: Alex Schroeder <[email protected]>
;; Maintainer: Michael Mauger <[email protected]>
-;; Version: 2.4
+;; Version: 2.6
;; Keywords: comm languages processes
;; URL: http://savannah.gnu.org/cgi-bin/viewcvs/emacs/emacs/lisp/progmodes/sql.el
;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SqlMode
@@ -187,10 +187,10 @@
;; 6) Define a convienence function to invoke the SQL interpreter.
-;; (defun my-sql-xyz ()
+;; (defun my-sql-xyz (&optional buffer)
;; "Run ixyz by XyzDB as an inferior process."
-;; (interactive)
-;; (sql-product-interactive 'xyz))
+;; (interactive "P")
+;; (sql-product-interactive 'xyz buffer))
;;; To Do:
@@ -275,8 +275,8 @@ Customizing your password will store it in your ~/.emacs file."
:group 'SQL
:safe 'stringp)
-(defcustom sql-port nil
- "Default server or host."
+(defcustom sql-port 0
+ "Default port."
:version "24.1"
:type 'number
:group 'SQL
@@ -336,6 +336,7 @@ Customizing your password will store it in your ~/.emacs file."
:sqli-comint-func sql-comint-db2
:prompt-regexp "^db2 => "
:prompt-length 7
+ :prompt-cont-regexp "^db2 (cont\.) => "
:input-filter sql-escape-newlines-filter)
(informix
@@ -357,7 +358,8 @@ Customizing your password will store it in your ~/.emacs file."
:sqli-login sql-ingres-login-params
:sqli-comint-func sql-comint-ingres
:prompt-regexp "^\* "
- :prompt-length 2)
+ :prompt-length 2
+ :prompt-cont-regexp "^\* ")
(interbase
:name "Interbase"
@@ -401,6 +403,7 @@ Customizing your password will store it in your ~/.emacs file."
:sqli-comint-func sql-comint-mysql
:prompt-regexp "^mysql> "
:prompt-length 6
+ :prompt-cont-regexp "^ -> "
:input-filter sql-remove-tabs-filter)
(oracle
@@ -412,6 +415,7 @@ Customizing your password will store it in your ~/.emacs file."
:sqli-comint-func sql-comint-oracle
:prompt-regexp "^SQL> "
:prompt-length 5
+ :prompt-cont-regexp "^\\s-*\\d+> "
:syntax-alist ((?$ . "w") (?# . "w"))
:terminator ("\\(^/\\|;\\)" . "/")
:input-filter sql-placeholders-filter)
@@ -424,10 +428,11 @@ Customizing your password will store it in your ~/.emacs file."
:sqli-options sql-postgres-options
:sqli-login sql-postgres-login-params
:sqli-comint-func sql-comint-postgres
- :prompt-regexp "^.*[#>] *"
+ :prompt-regexp "^.*=[#>] "
:prompt-length 5
+ :prompt-cont-regexp "^.*[-(][#>] "
:input-filter sql-remove-tabs-filter
- :terminator ("\\(^[\\]g\\|;\\)" . ";"))
+ :terminator ("\\(^\\s-*\\\\g\\|;\\)" . ";"))
(solid
:name "Solid"
@@ -448,7 +453,9 @@ Customizing your password will store it in your ~/.emacs file."
:sqli-login sql-sqlite-login-params
:sqli-comint-func sql-comint-sqlite
:prompt-regexp "^sqlite> "
- :prompt-length 8)
+ :prompt-length 8
+ :prompt-cont-regexp "^ ...> "
+ :terminator ";")
(sybase
:name "Sybase"
@@ -509,6 +516,10 @@ may be any one of the following:
:prompt-length length of the prompt on the line.
+ :prompt-cont-regexp regular expression string that matches
+ the continuation prompt issued by the
+ product interpreter.
+
:input-filter function which can filter strings sent to
the command interpreter. It is also used
by the `sql-send-string',
@@ -516,7 +527,8 @@ may be any one of the following:
and `sql-send-buffer' functions. The
function is passed the string sent to the
command interpreter and must return the
- filtered string.
+ filtered string. May also be a list of
+ such functions.
:terminator the terminator to be sent after a
`sql-send-string', `sql-send-region',
@@ -539,7 +551,6 @@ settings.")
(defvar sql-indirect-features
'(:font-lock :sqli-program :sqli-options :sqli-login))
-;;;###autoload
(defcustom sql-connection-alist nil
"An alist of connection parameters for interacting with a SQL
product.
@@ -588,7 +599,6 @@ prompted for during login."
:version "24.1"
:group 'SQL)
-;;;###autoload
(defcustom sql-product 'ansi
"Select the SQL database product used so that buffers can be
highlighted properly when you open them."
@@ -601,6 +611,7 @@ highlighted properly when you open them."
sql-product-alist))
:group 'SQL
:safe 'symbolp)
+(defvaralias 'sql-dialect 'sql-product)
;; misc customization of sql.el behaviour
@@ -776,7 +787,9 @@ to be safe:
;; Customization for SQLite
-(defcustom sql-sqlite-program "sqlite3"
+(defcustom sql-sqlite-program (or (executable-find "sqlite3")
+ (executable-find "sqlite")
+ "sqlite")
"Command to start SQLite.
Starts `sql-interactive-mode' after doing some setup."
@@ -789,7 +802,7 @@ Starts `sql-interactive-mode' after doing some setup."
:version "20.8"
:group 'SQL)
-(defcustom sql-sqlite-login-params '((database :file ".*\\.db"))
+(defcustom sql-sqlite-login-params '((database :file ".*\\.\\(db\\|sqlite[23]?\\)"))
"List of login parameters needed to connect to SQLite."
:type 'sql-login-params
:version "24.1"
@@ -1010,9 +1023,6 @@ Starts `sql-interactive-mode' after doing some setup."
(defvar sql-server-history nil
"History of servers used.")
-(defvar sql-port-history nil
- "History of ports used.")
-
;; Passwords are not kept in a history.
(defvar sql-buffer nil
@@ -1034,11 +1044,20 @@ You can change `sql-prompt-regexp' on `sql-interactive-mode-hook'.")
You can change `sql-prompt-length' on `sql-interactive-mode-hook'.")
+(defvar sql-prompt-cont-regexp nil
+ "Prompt pattern of statement continuation prompts.")
+
(defvar sql-alternate-buffer-name nil
"Buffer-local string used to possibly rename the SQLi buffer.
Used by `sql-rename-buffer'.")
+(defun sql-buffer-live-p (buffer)
+ "Returns non-nil if the process associated with buffer is live."
+ (and buffer
+ (buffer-live-p (get-buffer buffer))
+ (get-buffer-process buffer)))
+
;; Keymap for sql-interactive-mode.
(defvar sql-interactive-mode-map
@@ -1076,15 +1095,11 @@ Based on `comint-mode-map'.")
sql-mode-menu sql-mode-map
"Menu for `sql-mode'."
`("SQL"
- ["Send Paragraph" sql-send-paragraph (and (buffer-live-p sql-buffer)
- (get-buffer-process sql-buffer))]
+ ["Send Paragraph" sql-send-paragraph (sql-buffer-live-p sql-buffer)]
["Send Region" sql-send-region (and mark-active
- (buffer-live-p sql-buffer)
- (get-buffer-process sql-buffer))]
- ["Send Buffer" sql-send-buffer (and (buffer-live-p sql-buffer)
- (get-buffer-process sql-buffer))]
- ["Send String" sql-send-string (and (buffer-live-p sql-buffer)
- (get-buffer-process sql-buffer))]
+ (sql-buffer-live-p sql-buffer))]
+ ["Send Buffer" sql-send-buffer (sql-buffer-live-p sql-buffer)]
+ ["Send String" sql-send-string (sql-buffer-live-p sql-buffer)]
"--"
["Start SQLi session" sql-product-interactive
:visible (not sql-connection-alist)
@@ -1349,7 +1364,7 @@ to add functions and PL/SQL keywords.")
;; Oracle SQL*Plus Commands
(cons
(concat
- "^\\(?:\\(?:" (regexp-opt '(
+ "^\\s-*\\(?:\\(?:" (regexp-opt '(
"@" "@@" "accept" "append" "archive" "attribute" "break"
"btitle" "change" "clear" "column" "connect" "copy" "define"
"del" "describe" "disconnect" "edit" "execute" "exit" "get" "help"
@@ -1388,7 +1403,7 @@ to add functions and PL/SQL keywords.")
"\\)\\b.*"
)
'font-lock-doc-face)
- '("^[ \t]*rem\\(?:ark\\)?.*" . font-lock-comment-face)
+ '("^\\s-*rem\\(?:ark\\)?\\>.*" . font-lock-comment-face)
;; Oracle Functions
(sql-font-lock-keywords-builder 'font-lock-builtin-face nil
@@ -1570,81 +1585,153 @@ to add functions and PL/SQL keywords.")
(defvar sql-mode-postgres-font-lock-keywords
(eval-when-compile
(list
- ;; Postgres Functions
+ ;; Postgres psql commands
+ '("^\\s-*\\\\.*$" . font-lock-doc-face)
+
+ ;; Postgres unreserved words but may have meaning
+ (sql-font-lock-keywords-builder 'font-lock-builtin-face nil "a"
+"abs" "absent" "according" "ada" "alias" "allocate" "are" "array_agg"
+"asensitive" "atomic" "attribute" "attributes" "avg" "base64"
+"bernoulli" "bit_length" "bitvar" "blob" "blocked" "bom" "breadth" "c"
+"call" "cardinality" "catalog_name" "ceil" "ceiling" "char_length"
+"character_length" "character_set_catalog" "character_set_name"
+"character_set_schema" "characters" "checked" "class_origin" "clob"
+"cobol" "collation" "collation_catalog" "collation_name"
+"collation_schema" "collect" "column_name" "columns"
+"command_function" "command_function_code" "completion" "condition"
+"condition_number" "connect" "connection_name" "constraint_catalog"
+"constraint_name" "constraint_schema" "constructor" "contains"
+"control" "convert" "corr" "corresponding" "count" "covar_pop"
+"covar_samp" "cube" "cume_dist" "current_default_transform_group"
+"current_path" "current_transform_group_for_type" "cursor_name"
+"datalink" "datetime_interval_code" "datetime_interval_precision" "db"
+"defined" "degree" "dense_rank" "depth" "deref" "derived" "describe"
+"descriptor" "destroy" "destructor" "deterministic" "diagnostics"
+"disconnect" "dispatch" "dlnewcopy" "dlpreviouscopy" "dlurlcomplete"
+"dlurlcompleteonly" "dlurlcompletewrite" "dlurlpath" "dlurlpathonly"
+"dlurlpathwrite" "dlurlscheme" "dlurlserver" "dlvalue" "dynamic"
+"dynamic_function" "dynamic_function_code" "element" "empty"
+"end-exec" "equals" "every" "exception" "exec" "existing" "exp" "file"
+"filter" "final" "first_value" "flag" "floor" "fortran" "found" "free"
+"fs" "fusion" "g" "general" "generated" "get" "go" "goto" "grouping"
+"hex" "hierarchy" "host" "id" "ignore" "implementation" "import"
+"indent" "indicator" "infix" "initialize" "instance" "instantiable"
+"integrity" "intersection" "iterate" "k" "key_member" "key_type" "lag"
+"last_value" "lateral" "lead" "length" "less" "library" "like_regex"
+"link" "ln" "locator" "lower" "m" "map" "matched" "max"
+"max_cardinality" "member" "merge" "message_length"
+"message_octet_length" "message_text" "method" "min" "mod" "modifies"
+"modify" "module" "more" "multiset" "mumps" "namespace" "nclob"
+"nesting" "new" "nfc" "nfd" "nfkc" "nfkd" "nil" "normalize"
+"normalized" "nth_value" "ntile" "nullable" "number"
+"occurrences_regex" "octet_length" "octets" "old" "open" "operation"
+"ordering" "ordinality" "others" "output" "overriding" "p" "pad"
+"parameter" "parameter_mode" "parameter_name"
+"parameter_ordinal_position" "parameter_specific_catalog"
+"parameter_specific_name" "parameter_specific_schema" "parameters"
+"pascal" "passing" "passthrough" "percent_rank" "percentile_cont"
+"percentile_disc" "permission" "pli" "position_regex" "postfix"
+"power" "prefix" "preorder" "public" "rank" "reads" "recovery" "ref"
+"referencing" "regr_avgx" "regr_avgy" "regr_count" "regr_intercept"
+"regr_r2" "regr_slope" "regr_sxx" "regr_sxy" "regr_syy" "requiring"
+"respect" "restore" "result" "return" "returned_cardinality"
+"returned_length" "returned_octet_length" "returned_sqlstate" "rollup"
+"routine" "routine_catalog" "routine_name" "routine_schema"
+"row_count" "row_number" "scale" "schema_name" "scope" "scope_catalog"
+"scope_name" "scope_schema" "section" "selective" "self" "sensitive"
+"server_name" "sets" "size" "source" "space" "specific"
+"specific_name" "specifictype" "sql" "sqlcode" "sqlerror"
+"sqlexception" "sqlstate" "sqlwarning" "sqrt" "state" "static"
+"stddev_pop" "stddev_samp" "structure" "style" "subclass_origin"
+"sublist" "submultiset" "substring_regex" "sum" "system_user" "t"
+"table_name" "tablesample" "terminate" "than" "ties" "timezone_hour"
+"timezone_minute" "token" "top_level_count" "transaction_active"
+"transactions_committed" "transactions_rolled_back" "transform"
+"transforms" "translate" "translate_regex" "translation"
+"trigger_catalog" "trigger_name" "trigger_schema" "trim_array"
+"uescape" "under" "unlink" "unnamed" "unnest" "untyped" "upper" "uri"
+"usage" "user_defined_type_catalog" "user_defined_type_code"
+"user_defined_type_name" "user_defined_type_schema" "var_pop"
+"var_samp" "varbinary" "variable" "whenever" "width_bucket" "within"
+"xmlagg" "xmlbinary" "xmlcast" "xmlcomment" "xmldeclaration"
+"xmldocument" "xmlexists" "xmliterate" "xmlnamespaces" "xmlquery"
+"xmlschema" "xmltable" "xmltext" "xmlvalidate"
+)
+
+ ;; Postgres non-reserved words
(sql-font-lock-keywords-builder 'font-lock-builtin-face nil
-"abbrev" "abs" "acos" "age" "area" "ascii" "asin" "atab2" "atan"
-"atan2" "avg" "bit_length" "both" "broadcast" "btrim" "cbrt" "ceil"
-"center" "char_length" "chr" "coalesce" "col_description" "convert"
-"cos" "cot" "count" "current_database" "current_date" "current_schema"
-"current_schemas" "current_setting" "current_time" "current_timestamp"
-"current_user" "currval" "date_part" "date_trunc" "decode" "degrees"
-"diameter" "encode" "exp" "extract" "floor" "get_bit" "get_byte"
-"has_database_privilege" "has_function_privilege"
-"has_language_privilege" "has_schema_privilege" "has_table_privilege"
-"height" "host" "initcap" "isclosed" "isfinite" "isopen" "leading"
-"length" "ln" "localtime" "localtimestamp" "log" "lower" "lpad"
-"ltrim" "masklen" "max" "min" "mod" "netmask" "network" "nextval"
-"now" "npoints" "nullif" "obj_description" "octet_length" "overlay"
-"pclose" "pg_client_encoding" "pg_function_is_visible"
-"pg_get_constraintdef" "pg_get_indexdef" "pg_get_ruledef"
-"pg_get_userbyid" "pg_get_viewdef" "pg_opclass_is_visible"
-"pg_operator_is_visible" "pg_table_is_visible" "pg_type_is_visible"
-"pi" "popen" "position" "pow" "quote_ident" "quote_literal" "radians"
-"radius" "random" "repeat" "replace" "round" "rpad" "rtrim"
-"session_user" "set_bit" "set_byte" "set_config" "set_masklen"
-"setval" "sign" "sin" "split_part" "sqrt" "stddev" "strpos" "substr"
-"substring" "sum" "tan" "timeofday" "to_ascii" "to_char" "to_date"
-"to_hex" "to_number" "to_timestamp" "trailing" "translate" "trim"
-"trunc" "upper" "variance" "version" "width"
+"abort" "absolute" "access" "action" "add" "admin" "after" "aggregate"
+"also" "alter" "always" "assertion" "assignment" "at" "backward"
+"before" "begin" "between" "by" "cache" "called" "cascade" "cascaded"
+"catalog" "chain" "characteristics" "checkpoint" "class" "close"
+"cluster" "coalesce" "comment" "comments" "commit" "committed"
+"configuration" "connection" "constraints" "content" "continue"
+"conversion" "copy" "cost" "createdb" "createrole" "createuser" "csv"
+"current" "cursor" "cycle" "data" "database" "day" "deallocate" "dec"
+"declare" "defaults" "deferred" "definer" "delete" "delimiter"
+"delimiters" "dictionary" "disable" "discard" "document" "domain"
+"drop" "each" "enable" "encoding" "encrypted" "enum" "escape"
+"exclude" "excluding" "exclusive" "execute" "exists" "explain"
+"external" "extract" "family" "first" "float" "following" "force"
+"forward" "function" "functions" "global" "granted" "greatest"
+"handler" "header" "hold" "hour" "identity" "if" "immediate"
+"immutable" "implicit" "including" "increment" "index" "indexes"
+"inherit" "inherits" "inline" "inout" "input" "insensitive" "insert"
+"instead" "invoker" "isolation" "key" "language" "large" "last"
+"lc_collate" "lc_ctype" "least" "level" "listen" "load" "local"
+"location" "lock" "login" "mapping" "match" "maxvalue" "minute"
+"minvalue" "mode" "month" "move" "name" "names" "national" "nchar"
+"next" "no" "nocreatedb" "nocreaterole" "nocreateuser" "noinherit"
+"nologin" "none" "nosuperuser" "nothing" "notify" "nowait" "nullif"
+"nulls" "object" "of" "oids" "operator" "option" "options" "out"
+"overlay" "owned" "owner" "parser" "partial" "partition" "password"
+"plans" "position" "preceding" "prepare" "prepared" "preserve" "prior"
+"privileges" "procedural" "procedure" "quote" "range" "read"
+"reassign" "recheck" "recursive" "reindex" "relative" "release"
+"rename" "repeatable" "replace" "replica" "reset" "restart" "restrict"
+"returns" "revoke" "role" "rollback" "row" "rows" "rule" "savepoint"
+"schema" "scroll" "search" "second" "security" "sequence" "sequences"
+"serializable" "server" "session" "set" "setof" "share" "show"
+"simple" "stable" "standalone" "start" "statement" "statistics"
+"stdin" "stdout" "storage" "strict" "strip" "substring" "superuser"
+"sysid" "system" "tables" "tablespace" "temp" "template" "temporary"
+"transaction" "treat" "trigger" "trim" "truncate" "trusted" "type"
+"unbounded" "uncommitted" "unencrypted" "unknown" "unlisten" "until"
+"update" "vacuum" "valid" "validator" "value" "values" "version"
+"view" "volatile" "whitespace" "work" "wrapper" "write"
+"xmlattributes" "xmlconcat" "xmlelement" "xmlforest" "xmlparse"
+"xmlpi" "xmlroot" "xmlserialize" "year" "yes"
)
+
;; Postgres Reserved
(sql-font-lock-keywords-builder 'font-lock-keyword-face nil
-"abort" "access" "add" "after" "aggregate" "alignment" "all" "alter"
-"analyze" "and" "any" "as" "asc" "assignment" "authorization"
-"backward" "basetype" "before" "begin" "between" "binary" "by" "cache"
-"called" "cascade" "case" "cast" "characteristics" "check"
-"checkpoint" "class" "close" "cluster" "column" "comment" "commit"
-"committed" "commutator" "constraint" "constraints" "conversion"
-"copy" "create" "createdb" "createuser" "cursor" "cycle" "database"
-"deallocate" "declare" "default" "deferrable" "deferred" "definer"
-"delete" "delimiter" "desc" "distinct" "do" "domain" "drop" "each"
-"element" "else" "encoding" "encrypted" "end" "escape" "except"
-"exclusive" "execute" "exists" "explain" "extended" "external" "false"
-"fetch" "finalfunc" "for" "force" "foreign" "forward" "freeze" "from"
-"full" "function" "grant" "group" "gtcmp" "handler" "hashes" "having"
-"immediate" "immutable" "implicit" "in" "increment" "index" "inherits"
-"initcond" "initially" "input" "insensitive" "insert" "instead"
-"internallength" "intersect" "into" "invoker" "is" "isnull"
-"isolation" "join" "key" "language" "leftarg" "level" "like" "limit"
-"listen" "load" "local" "location" "lock" "ltcmp" "main" "match"
-"maxvalue" "merges" "minvalue" "mode" "move" "natural" "negator"
-"next" "nocreatedb" "nocreateuser" "none" "not" "nothing" "notify"
-"notnull" "null" "of" "offset" "oids" "on" "only" "operator" "or"
-"order" "output" "owner" "partial" "passedbyvalue" "password" "plain"
-"prepare" "primary" "prior" "privileges" "procedural" "procedure"
-"public" "read" "recheck" "references" "reindex" "relative" "rename"
-"reset" "restrict" "returns" "revoke" "rightarg" "rollback" "row"
-"rule" "schema" "scroll" "security" "select" "sequence" "serializable"
-"session" "set" "sfunc" "share" "show" "similar" "some" "sort1"
-"sort2" "stable" "start" "statement" "statistics" "storage" "strict"
-"stype" "sysid" "table" "temp" "template" "temporary" "then" "to"
-"transaction" "trigger" "true" "truncate" "trusted" "type"
-"unencrypted" "union" "unique" "unknown" "unlisten" "until" "update"
-"usage" "user" "using" "vacuum" "valid" "validator" "values"
-"variable" "verbose" "view" "volatile" "when" "where" "with" "without"
-"work"
+"all" "analyse" "analyze" "and" "any" "array" "asc" "as" "asymmetric"
+"authorization" "binary" "both" "case" "cast" "check" "collate"
+"column" "concurrently" "constraint" "create" "cross"
+"current_catalog" "current_date" "current_role" "current_schema"
+"current_time" "current_timestamp" "current_user" "default"
+"deferrable" "desc" "distinct" "do" "else" "end" "except" "false"
+"fetch" "foreign" "for" "freeze" "from" "full" "grant" "group"
+"having" "ilike" "initially" "inner" "in" "intersect" "into" "isnull"
+"is" "join" "leading" "left" "like" "limit" "localtime"
+"localtimestamp" "natural" "notnull" "not" "null" "off" "offset"
+"only" "on" "order" "or" "outer" "overlaps" "over" "placing" "primary"
+"references" "returning" "right" "select" "session_user" "similar"
+"some" "symmetric" "table" "then" "to" "trailing" "true" "union"
+"unique" "user" "using" "variadic" "verbose" "when" "where" "window"
+"with"
)
;; Postgres Data Types
(sql-font-lock-keywords-builder 'font-lock-type-face nil
-"anyarray" "bigint" "bigserial" "bit" "boolean" "box" "bytea" "char"
-"character" "cidr" "circle" "cstring" "date" "decimal" "double"
-"float4" "float8" "inet" "int2" "int4" "int8" "integer" "internal"
-"interval" "language_handler" "line" "lseg" "macaddr" "money"
-"numeric" "oid" "opaque" "path" "point" "polygon" "precision" "real"
-"record" "regclass" "regoper" "regoperator" "regproc" "regprocedure"
-"regtype" "serial" "serial4" "serial8" "smallint" "text" "time"
-"timestamp" "varchar" "varying" "void" "zone"
+"bigint" "bigserial" "bit" "bool" "boolean" "box" "bytea" "char"
+"character" "cidr" "circle" "date" "decimal" "double" "float4"
+"float8" "inet" "int" "int2" "int4" "int8" "integer" "interval" "line"
+"lseg" "macaddr" "money" "numeric" "path" "point" "polygon"
+"precision" "real" "serial" "serial4" "serial8" "smallint" "text"
+"time" "timestamp" "timestamptz" "timetz" "tsquery" "tsvector"
+"txid_snapshot" "uuid" "varbit" "varchar" "varying" "without"
+"xml" "zone"
)))
"Postgres SQL keywords used by font-lock.
@@ -1964,15 +2051,17 @@ you define your own `sql-mode-mysql-font-lock-keywords'.")
(defvar sql-mode-sqlite-font-lock-keywords
(eval-when-compile
(list
+ ;; SQLite commands
+ '("^[.].*$" . font-lock-doc-face)
+
;; SQLite Keyword
(sql-font-lock-keywords-builder 'font-lock-keyword-face nil
"abort" "action" "add" "after" "all" "alter" "analyze" "and" "as"
"asc" "attach" "autoincrement" "before" "begin" "between" "by"
"cascade" "case" "cast" "check" "collate" "column" "commit" "conflict"
-"constraint" "create" "cross" "current_date" "current_time"
-"current_timestamp" "database" "default" "deferrable" "deferred"
-"delete" "desc" "detach" "distinct" "drop" "each" "else" "end"
-"escape" "except" "exclusive" "exists" "explain" "fail" "for"
+"constraint" "create" "cross" "database" "default" "deferrable"
+"deferred" "delete" "desc" "detach" "distinct" "drop" "each" "else"
+"end" "escape" "except" "exclusive" "exists" "explain" "fail" "for"
"foreign" "from" "full" "glob" "group" "having" "if" "ignore"
"immediate" "in" "index" "indexed" "initially" "inner" "insert"
"instead" "intersect" "into" "is" "isnull" "join" "key" "left" "like"
@@ -1987,9 +2076,9 @@ you define your own `sql-mode-mysql-font-lock-keywords'.")
;; SQLite Data types
(sql-font-lock-keywords-builder 'font-lock-type-face nil
"int" "integer" "tinyint" "smallint" "mediumint" "bigint" "unsigned"
-"big" "int2" "int8" "character" "varchar" "varying" "nchar" "native "
+"big" "int2" "int8" "character" "varchar" "varying" "nchar" "native"
"nvarchar" "text" "clob" "blob" "real" "double" "precision" "float"
-"numeric" "decimal" "boolean" "date" "datetime"
+"numeric" "number" "decimal" "boolean" "date" "datetime"
)
;; SQLite Functions
(sql-font-lock-keywords-builder 'font-lock-builtin-face nil
@@ -2002,6 +2091,7 @@ you define your own `sql-mode-mysql-font-lock-keywords'.")
"typeof" "upper" "zeroblob"
;; Date/time functions
"time" "julianday" "strftime"
+"current_date" "current_time" "current_timestamp"
;; Aggregate functions
"avg" "count" "group_concat" "max" "min" "sum" "total"
)))
@@ -2478,16 +2568,18 @@ function like this: (sql-get-login 'user 'password 'database)."
((eq token 'port) ; port
(setq sql-port
- (read-number "Port: " sql-port))))))
- what))
+ (read-number "Port: " (if (numberp sql-port)
+ sql-port
+ 0)))))))
+ what))
(defun sql-find-sqli-buffer ()
- "Returns the current default SQLi buffer or nil.
-In order to qualify, the SQLi buffer must be alive,
-be in `sql-interactive-mode' and have a process."
- (let ((default-buffer (default-value 'sql-buffer)))
- (if (and (buffer-live-p default-buffer)
- (get-buffer-process default-buffer))
+ "Returns the name of the current default SQLi buffer or nil.
+In order to qualify, the SQLi buffer must be alive, be in
+`sql-interactive-mode' and have a process."
+ (let ((default-buffer (default-value 'sql-buffer))
+ (current-product sql-product))
+ (if (sql-buffer-live-p default-buffer)
default-buffer
(save-current-buffer
(let ((buflist (buffer-list))
@@ -2496,9 +2588,10 @@ be in `sql-interactive-mode' and have a process."
found))
(let ((candidate (car buflist)))
(set-buffer candidate)
- (if (and (derived-mode-p 'sql-interactive-mode)
- (get-buffer-process candidate))
- (setq found candidate))
+ (if (and (sql-buffer-live-p candidate)
+ (derived-mode-p 'sql-interactive-mode)
+ (eq sql-product current-product))
+ (setq found (buffer-name candidate)))
(setq buflist (cdr buflist))))
found)))))
@@ -2512,15 +2605,15 @@ using `sql-find-sqli-buffer'. If `sql-buffer' is set,
(interactive)
(save-excursion
(let ((buflist (buffer-list))
- (default-sqli-buffer (sql-find-sqli-buffer)))
- (setq-default sql-buffer default-sqli-buffer)
+ (default-buffer (sql-find-sqli-buffer)))
+ (setq-default sql-buffer default-buffer)
(while (not (null buflist))
(let ((candidate (car buflist)))
(set-buffer candidate)
(if (and (derived-mode-p 'sql-mode)
(not (buffer-live-p sql-buffer)))
(progn
- (setq sql-buffer default-sqli-buffer)
+ (setq sql-buffer default-buffer)
(run-hooks 'sql-set-sqli-hook))))
(setq buflist (cdr buflist))))))
@@ -2546,11 +2639,11 @@ If you call it from anywhere else, it sets the global copy of
(if (null (get-buffer-process new-buffer))
(error "Buffer %s has no process" (buffer-name new-buffer)))
(if (null (with-current-buffer new-buffer
- (equal major-mode 'sql-interactive-mode)))
+ (derived-mode-p 'sql-interactive-mode)))
(error "Buffer %s is no SQLi buffer" (buffer-name new-buffer)))
(if new-buffer
(progn
- (setq sql-buffer new-buffer)
+ (setq sql-buffer (buffer-name new-buffer))
(run-hooks 'sql-set-sqli-hook))))))
(defun sql-show-sqli-buffer ()
@@ -2559,11 +2652,11 @@ If you call it from anywhere else, it sets the global copy of
This is the buffer SQL strings are sent to. It is stored in the
variable `sql-buffer'. See `sql-help' on how to create such a buffer."
(interactive)
- (if (null (buffer-live-p sql-buffer))
+ (if (null (buffer-live-p (get-buffer sql-buffer)))
(message "%s has no SQLi buffer set." (buffer-name (current-buffer)))
(if (null (get-buffer-process sql-buffer))
- (message "Buffer %s has no process." (buffer-name sql-buffer))
- (message "Current SQLi buffer is %s." (buffer-name sql-buffer)))))
+ (message "Buffer %s has no process." sql-buffer)
+ (message "Current SQLi buffer is %s." sql-buffer))))
(defun sql-make-alternate-buffer-name ()
"Return a string that can be used to rename a SQLi buffer.
@@ -2585,25 +2678,34 @@ server/database name."
;; Build a name using the :sqli-login setting
(setq name
(apply 'concat
- (apply 'append nil
- (sql-for-each-login
- (sql-get-product-feature sql-product :sqli-login)
- (lambda (token type arg)
- (cond
- ((eq token 'user) (list "/" sql-user))
- ((eq token 'port) (list ":" sql-port))
- ((eq token 'server)
- (list "." (if (eq type :file)
- (file-name-nondirectory sql-server)
- sql-server)))
- ((eq token 'database)
- (list "@" (if (eq type :file)
- (file-name-nondirectory sql-database)
- sql-database)))
-
- ((eq token 'password) nil)
- (t nil)))))))
-
+ (cdr
+ (apply 'append nil
+ (sql-for-each-login
+ (sql-get-product-feature sql-product :sqli-login)
+ (lambda (token type arg)
+ (cond
+ ((eq token 'user)
+ (unless (string= "" sql-user)
+ (list "/" sql-user)))
+ ((eq token 'port)
+ (unless (or (not (numberp sql-port))
+ (= 0 sql-port))
+ (list ":" (number-to-string sql-port))))
+ ((eq token 'server)
+ (unless (string= "" sql-server)
+ (list "."
+ (if (eq type :file)
+ (file-name-nondirectory sql-server)
+ sql-server))))
+ ((eq token 'database)
+ (unless (string= "" sql-database)
+ (list "@"
+ (if (eq type :file)
+ (file-name-nondirectory sql-database)
+ sql-database))))
+
+ ((eq token 'password) nil)
+ (t nil))))))))
;; If there's a connection, use it and the name thus far
(if sql-connection
@@ -2623,13 +2725,35 @@ server/database name."
sql-server)
sql-database))
- ;; We've got a name, go with it (without the first punctuation char)
- (substring name 1)))))
+ ;; Use the name we've got
+ name))))
-(defun sql-rename-buffer ()
- "Rename a SQLi buffer."
- (interactive)
- (rename-buffer (format "*SQL: %s*" sql-alternate-buffer-name) t))
+(defun sql-rename-buffer (&optional new-name)
+ "Rename a SQL interactive buffer.
+
+Prompts for the new name if command is preceeded by
+\\[universal-argument]. If no buffer name is provided, then the
+`sql-alternate-buffer-name' is used.
+
+The actual buffer name set will be \"*SQL: NEW-NAME*\". If
+NEW-NAME is empty, then the buffer name will be \"*SQL*\"."
+ (interactive "P")
+
+ (if (not (derived-mode-p 'sql-interactive-mode))
+ (message "Current buffer is not a SQL interactive buffer")
+
+ (cond
+ ((stringp new-name)
+ (setq sql-alternate-buffer-name new-name))
+ ((listp new-name)
+ (setq sql-alternate-buffer-name
+ (read-string "Buffer name (\"*SQL: XXX*\"; enter `XXX'): "
+ sql-alternate-buffer-name))))
+
+ (rename-buffer (if (string= "" sql-alternate-buffer-name)
+ "*SQL*"
+ (format "*SQL: %s*" sql-alternate-buffer-name))
+ t)))
(defun sql-copy-column ()
"Copy current column to the end of buffer.
@@ -2702,14 +2826,73 @@ Every newline in STRING will be preceded with a space and a backslash."
;;; Input sender for SQLi buffers
+(defvar sql-output-newline-count 0
+ "Number of newlines in the input string.
+
+Allows the suppression of continuation prompts.")
+
+(defvar sql-output-by-send nil
+ "Non-nil if the command in the input was generated by `sql-send-string'.")
+
(defun sql-input-sender (proc string)
"Send STRING to PROC after applying filters."
(let* ((product (with-current-buffer (process-buffer proc) sql-product))
(filter (sql-get-product-feature product :input-filter)))
+ ;; Apply filter(s)
+ (cond
+ ((not filter)
+ nil)
+ ((functionp filter)
+ (setq string (funcall filter string)))
+ ((listp filter)
+ (mapc (lambda (f) (setq string (funcall f string))) filter))
+ (t nil))
+
+ ;; Count how many newlines in the string
+ (setq sql-output-newline-count 0)
+ (mapc (lambda (ch)
+ (when (eq ch ?\n)
+ (setq sql-output-newline-count (1+ sql-output-newline-count))))
+ string)
+
;; Send the string
- (comint-simple-send proc (if filter (funcall filter string) string))))
+ (comint-simple-send proc string)))
+
+;;; Strip out continuation prompts
+
+(defun sql-interactive-remove-continuation-prompt (oline)
+ "Strip out continuation prompts out of the OLINE.
+
+Added to the `comint-preoutput-filter-functions' hook in a SQL
+interactive buffer. If `sql-outut-newline-count' is greater than
+zero, then an output line matching the continuation prompt is filtered
+out. If the count is one, then the prompt is replaced with a newline
+to force the output from the query to appear on a new line."
+ (if (and sql-prompt-cont-regexp
+ sql-output-newline-count
+ (numberp sql-output-newline-count)
+ (>= sql-output-newline-count 1))
+ (progn
+ (while (and oline
+ sql-output-newline-count
+ (> sql-output-newline-count 0)
+ (string-match sql-prompt-cont-regexp oline))
+
+ (setq oline
+ (replace-match (if (and
+ (= 1 sql-output-newline-count)
+ sql-output-by-send)
+ "\n" "")
+ nil nil oline)
+ sql-output-newline-count
+ (1- sql-output-newline-count)))
+ (if (= sql-output-newline-count 0)
+ (setq sql-output-newline-count nil))
+ (setq sql-output-by-send nil))
+ (setq sql-output-newline-count nil))
+ oline)
;;; Sending the region to the SQLi buffer.
@@ -2717,28 +2900,22 @@ Every newline in STRING will be preceded with a space and a backslash."
"Send the string STR to the SQL process."
(interactive "sSQL Text: ")
- (let (comint-input-sender-no-newline proc)
- (if (buffer-live-p sql-buffer)
+ (let ((comint-input-sender-no-newline nil)
+ (s (replace-regexp-in-string "[[:space:]\n\r]+\\'" "" str)))
+ (if (sql-buffer-live-p sql-buffer)
(progn
;; Ignore the hoping around...
(save-excursion
- ;; Get the process
- (setq proc (get-buffer-process sql-buffer))
-
;; Set product context
(with-current-buffer sql-buffer
- ;; Send the string
- (sql-input-sender proc str)
-
- ;; Send a newline if there wasn't one on the end of the string
- (unless (string-equal "\n" (substring str (1- (length str))))
- (comint-send-string proc "\n"))
+ ;; Send the string (trim the trailing whitespace)
+ (sql-input-sender (get-buffer-process sql-buffer) s)
;; Send a command terminator if we must
(if sql-send-terminator
- (sql-send-magic-terminator sql-buffer str sql-send-terminator))
+ (sql-send-magic-terminator sql-buffer s sql-send-terminator))
- (message "Sent string to buffer %s." (buffer-name sql-buffer))))
+ (message "Sent string to buffer %s." sql-buffer)))
;; Display the sql buffer
(if sql-pop-to-buffer-after-send-region
@@ -2771,7 +2948,7 @@ Every newline in STRING will be preceded with a space and a backslash."
(defun sql-send-magic-terminator (buf str terminator)
"Send TERMINATOR to buffer BUF if its not present in STR."
- (let (pat term)
+ (let (comint-input-sender-no-newline pat term)
;; If flag is merely on(t), get product-specific terminator
(if (eq terminator t)
(setq terminator (sql-get-product-feature sql-product :terminator)))
@@ -2792,8 +2969,13 @@ Every newline in STRING will be preceded with a space and a backslash."
;; Check to see if the pattern is present in the str already sent
(unless (and pat term
- (string-match (concat pat "\n?\\'") str))
- (comint-send-string buf (concat term "\n")))))
+ (string-match (concat pat "\\'") str))
+ (comint-simple-send (get-buffer-process buf) term)
+ (setq sql-output-newline-count
+ (if sql-output-newline-count
+ (1+ sql-output-newline-count)
+ 1)))
+ (setq sql-output-by-send t)))
(defun sql-remove-tabs-filter (str)
"Replace tab characters with spaces."
@@ -2982,7 +3164,7 @@ you entered, right above the output it created.
(setq local-abbrev-table sql-mode-abbrev-table)
(setq abbrev-all-caps 1)
;; Exiting the process will call sql-stop.
- (set-process-sentinel (get-buffer-process sql-buffer) 'sql-stop)
+ (set-process-sentinel (get-buffer-process (current-buffer)) 'sql-stop)
;; Save the connection name
(make-local-variable 'sql-connection)
;; Create a usefull name for renaming this buffer later.
@@ -2993,12 +3175,22 @@ you entered, right above the output it created.
(sql-get-product-feature sql-product :prompt-regexp))
(set (make-local-variable 'sql-prompt-length)
(sql-get-product-feature sql-product :prompt-length))
+ (set (make-local-variable 'sql-prompt-cont-regexp)
+ (sql-get-product-feature sql-product :prompt-cont-regexp))
+ (make-local-variable 'sql-output-newline-count)
+ (make-local-variable 'sql-output-by-send)
+ (add-hook 'comint-preoutput-filter-functions
+ 'sql-interactive-remove-continuation-prompt nil t)
(make-local-variable 'sql-input-ring-separator)
(make-local-variable 'sql-input-ring-file-name)
;; Run the mode hook (along with comint's hooks).
(run-mode-hooks 'sql-interactive-mode-hook)
;; Set comint based on user overrides.
- (setq comint-prompt-regexp sql-prompt-regexp)
+ (setq comint-prompt-regexp
+ (if sql-prompt-cont-regexp
+ (concat "\\(" sql-prompt-regexp
+ "\\|" sql-prompt-cont-regexp "\\)")
+ sql-prompt-regexp))
(setq left-margin sql-prompt-length)
;; Install input sender
(set (make-local-variable 'comint-input-sender) 'sql-input-sender)
@@ -3157,49 +3349,60 @@ optionally is saved to the user's init file."
;;; Entry functions for different SQL interpreters.
;;;###autoload
-(defun sql-product-interactive (&optional product)
+(defun sql-product-interactive (&optional product new-name)
"Run PRODUCT interpreter as an inferior process.
If buffer `*SQL*' exists but no process is running, make a new process.
If buffer exists and a process is running, just switch to buffer `*SQL*'.
+To specify the SQL product, prefix the call with
+\\[universal-argument]. To set the buffer name as well, prefix
+the call to \\[sql-product-interactive] with
+\\[universal-argument] \\[universal-argument].
+
\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
(interactive "P")
+ ;; Handle universal arguments if specified
+ (when (not (or executing-kbd-macro noninteractive))
+ (when (and (listp product)
+ (not (cdr product))
+ (numberp (car product)))
+ (when (>= (car product) 16)
+ (when (not new-name)
+ (setq new-name '(4)))
+ (setq product '(4)))))
+
+ ;; Get the value of product that we need
(setq product
(cond
- ((equal product '(4)) ; Universal arg, prompt for product
+ ((equal product '(4)) ; C-u, prompt for product
(intern (completing-read "SQL product: "
(mapcar (lambda (info) (symbol-name (car info)))
sql-product-alist)
nil 'require-match
- (or (and sql-product (symbol-name sql-product)) "ansi"))))
+ (or (and sql-product
+ (symbol-name sql-product))
+ "ansi"))))
((and product ; Product specified
(symbolp product)) product)
(t sql-product))) ; Default to sql-product
+ ;; If we have a product and it has a interactive mode
(if product
(when (sql-get-product-feature product :sqli-comint-func)
- (if (and sql-buffer
- (buffer-live-p sql-buffer)
- (comint-check-proc sql-buffer))
+ ;; If no new name specified, fall back on sql-buffer if its for
+ ;; the same product
+ (if (and (not new-name)
+ sql-buffer
+ (sql-buffer-live-p sql-buffer)
+ (comint-check-proc sql-buffer)
+ (eq product (with-current-buffer sql-buffer sql-product)))
(pop-to-buffer sql-buffer)
- ;; Is the current buffer in sql-mode and
- ;; there is a buffer local setting of sql-buffer
- (let* ((start-buffer
- (and (derived-mode-p 'sql-mode)
- (current-buffer)))
- (start-sql-buffer
- (and start-buffer
- (let (found)
- (dolist (var (buffer-local-variables))
- (and (consp var)
- (eq (car var) 'sql-buffer)
- (buffer-live-p (cdr var))
- (get-buffer-process (cdr var))
- (setq found (cdr var))))
- found)))
+ ;; We have a new name or sql-buffer doesn't exist or match
+ ;; Start by remembering where we start
+ (let* ((start-buffer (current-buffer))
new-sqli-buffer)
;; Get credentials.
@@ -3212,15 +3415,18 @@ If buffer exists and a process is running, just switch to buffer `*SQL*'.
(sql-get-product-feature product :sqli-options))
;; Set SQLi mode.
- (setq sql-interactive-product product
- new-sqli-buffer (current-buffer)
- sql-buffer new-sqli-buffer)
- (sql-interactive-mode)
+ (setq new-sqli-buffer (current-buffer))
+ (let ((sql-interactive-product product))
+ (sql-interactive-mode))
+
+ ;; Set the new buffer name
+ (when new-name
+ (sql-rename-buffer new-name))
;; Set `sql-buffer' in the start buffer
- (when (and start-buffer (not start-sql-buffer))
- (with-current-buffer start-buffer
- (setq sql-buffer new-sqli-buffer)))
+ (setq sql-buffer (buffer-name new-sqli-buffer))
+ (with-current-buffer start-buffer
+ (setq sql-buffer (buffer-name new-sqli-buffer)))
;; All done.
(message "Login...done")
@@ -3232,12 +3438,22 @@ If buffer exists and a process is running, just switch to buffer `*SQL*'.
PRODUCT is the SQL product. PARAMS is a list of strings which are
passed as command line arguments."
- (let ((program (sql-get-product-feature product :sqli-program)))
+ (let ((program (sql-get-product-feature product :sqli-program))
+ (buf-name "SQL"))
+ ;; Make sure buffer name is unique
+ (when (get-buffer (format "*%s*" buf-name))
+ (setq buf-name (format "SQL-%s" product))
+ (when (get-buffer (format "*%s*" buf-name))
+ (let ((i 1))
+ (while (get-buffer (format "*%s*"
+ (setq buf-name
+ (format "SQL-%s%d" product i))))
+ (setq i (1+ i))))))
(set-buffer
- (apply 'make-comint "SQL" program nil params))))
+ (apply 'make-comint buf-name program nil params))))
;;;###autoload
-(defun sql-oracle ()
+(defun sql-oracle (&optional buffer)
"Run sqlplus by Oracle as an inferior process.
If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3252,6 +3468,11 @@ the list `sql-oracle-options'.
The buffer is put in SQL interactive mode, giving commands for sending
input. See `sql-interactive-mode'.
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-oracle]. Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
To specify a coding system for converting non-ASCII characters
in the input and output to the process, use \\[universal-coding-system-argument]
before \\[sql-oracle]. You can also specify this with \\[set-buffer-process-coding-system]
@@ -3260,8 +3481,8 @@ The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
- (interactive)
- (sql-product-interactive 'oracle))
+ (interactive "P")
+ (sql-product-interactive 'oracle buffer))
(defun sql-comint-oracle (product options)
"Create comint buffer and connect to Oracle."
@@ -3284,7 +3505,7 @@ The default comes from `process-coding-system-alist' and
;;;###autoload
-(defun sql-sybase ()
+(defun sql-sybase (&optional buffer)
"Run isql by Sybase as an inferior process.
If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3299,6 +3520,11 @@ can be stored in the list `sql-sybase-options'.
The buffer is put in SQL interactive mode, giving commands for sending
input. See `sql-interactive-mode'.
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-sybase]. Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
To specify a coding system for converting non-ASCII characters
in the input and output to the process, use \\[universal-coding-system-argument]
before \\[sql-sybase]. You can also specify this with \\[set-buffer-process-coding-system]
@@ -3307,8 +3533,8 @@ The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
- (interactive)
- (sql-product-interactive 'sybase))
+ (interactive "P")
+ (sql-product-interactive 'sybase buffer))
(defun sql-comint-sybase (product options)
"Create comint buffer and connect to Sybase."
@@ -3328,7 +3554,7 @@ The default comes from `process-coding-system-alist' and
;;;###autoload
-(defun sql-informix ()
+(defun sql-informix (&optional buffer)
"Run dbaccess by Informix as an inferior process.
If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3341,6 +3567,11 @@ the variable `sql-database' as default, if set.
The buffer is put in SQL interactive mode, giving commands for sending
input. See `sql-interactive-mode'.
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-informix]. Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
To specify a coding system for converting non-ASCII characters
in the input and output to the process, use \\[universal-coding-system-argument]
before \\[sql-informix]. You can also specify this with \\[set-buffer-process-coding-system]
@@ -3349,8 +3580,8 @@ The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
- (interactive)
- (sql-product-interactive 'informix))
+ (interactive "P")
+ (sql-product-interactive 'informix buffer))
(defun sql-comint-informix (product options)
"Create comint buffer and connect to Informix."
@@ -3365,7 +3596,7 @@ The default comes from `process-coding-system-alist' and
;;;###autoload
-(defun sql-sqlite ()
+(defun sql-sqlite (&optional buffer)
"Run sqlite as an inferior process.
SQLite is free software.
@@ -3382,6 +3613,11 @@ can be stored in the list `sql-sqlite-options'.
The buffer is put in SQL interactive mode, giving commands for sending
input. See `sql-interactive-mode'.
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-sqlite]. Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
To specify a coding system for converting non-ASCII characters
in the input and output to the process, use \\[universal-coding-system-argument]
before \\[sql-sqlite]. You can also specify this with \\[set-buffer-process-coding-system]
@@ -3390,8 +3626,8 @@ The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
- (interactive)
- (sql-product-interactive 'sqlite))
+ (interactive "P")
+ (sql-product-interactive 'sqlite buffer))
(defun sql-comint-sqlite (product options)
"Create comint buffer and connect to SQLite."
@@ -3407,7 +3643,7 @@ The default comes from `process-coding-system-alist' and
;;;###autoload
-(defun sql-mysql ()
+(defun sql-mysql (&optional buffer)
"Run mysql by TcX as an inferior process.
Mysql versions 3.23 and up are free software.
@@ -3424,6 +3660,11 @@ can be stored in the list `sql-mysql-options'.
The buffer is put in SQL interactive mode, giving commands for sending
input. See `sql-interactive-mode'.
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-mysql]. Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
To specify a coding system for converting non-ASCII characters
in the input and output to the process, use \\[universal-coding-system-argument]
before \\[sql-mysql]. You can also specify this with \\[set-buffer-process-coding-system]
@@ -3432,8 +3673,8 @@ The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
- (interactive)
- (sql-product-interactive 'mysql))
+ (interactive "P")
+ (sql-product-interactive 'mysql buffer))
(defun sql-comint-mysql (product options)
"Create comint buffer and connect to MySQL."
@@ -3444,7 +3685,7 @@ The default comes from `process-coding-system-alist' and
(setq params (append (list sql-database) params)))
(if (not (string= "" sql-server))
(setq params (append (list (concat "--host=" sql-server)) params)))
- (if (and sql-port (numberp sql-port))
+ (if (not (= 0 sql-port))
(setq params (append (list (concat "--port=" (number-to-string sql-port))) params)))
(if (not (string= "" sql-password))
(setq params (append (list (concat "--password=" sql-password)) params)))
@@ -3456,7 +3697,7 @@ The default comes from `process-coding-system-alist' and
;;;###autoload
-(defun sql-solid ()
+(defun sql-solid (&optional buffer)
"Run solsql by Solid as an inferior process.
If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3470,6 +3711,11 @@ defaults, if set.
The buffer is put in SQL interactive mode, giving commands for sending
input. See `sql-interactive-mode'.
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-solid]. Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
To specify a coding system for converting non-ASCII characters
in the input and output to the process, use \\[universal-coding-system-argument]
before \\[sql-solid]. You can also specify this with \\[set-buffer-process-coding-system]
@@ -3478,8 +3724,8 @@ The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
- (interactive)
- (sql-product-interactive 'solid))
+ (interactive "P")
+ (sql-product-interactive 'solid buffer))
(defun sql-comint-solid (product options)
"Create comint buffer and connect to Solid."
@@ -3497,7 +3743,7 @@ The default comes from `process-coding-system-alist' and
;;;###autoload
-(defun sql-ingres ()
+(defun sql-ingres (&optional buffer)
"Run sql by Ingres as an inferior process.
If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3510,6 +3756,11 @@ the variable `sql-database' as default, if set.
The buffer is put in SQL interactive mode, giving commands for sending
input. See `sql-interactive-mode'.
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-ingres]. Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
To specify a coding system for converting non-ASCII characters
in the input and output to the process, use \\[universal-coding-system-argument]
before \\[sql-ingres]. You can also specify this with \\[set-buffer-process-coding-system]
@@ -3518,8 +3769,8 @@ The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
- (interactive)
- (sql-product-interactive 'ingres))
+ (interactive "P")
+ (sql-product-interactive 'ingres buffer))
(defun sql-comint-ingres (product options)
"Create comint buffer and connect to Ingres."
@@ -3533,7 +3784,7 @@ The default comes from `process-coding-system-alist' and
;;;###autoload
-(defun sql-ms ()
+(defun sql-ms (&optional buffer)
"Run osql by Microsoft as an inferior process.
If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3548,6 +3799,11 @@ in the list `sql-ms-options'.
The buffer is put in SQL interactive mode, giving commands for sending
input. See `sql-interactive-mode'.
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-ms]. Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
To specify a coding system for converting non-ASCII characters
in the input and output to the process, use \\[universal-coding-system-argument]
before \\[sql-ms]. You can also specify this with \\[set-buffer-process-coding-system]
@@ -3556,8 +3812,8 @@ The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
- (interactive)
- (sql-product-interactive 'ms))
+ (interactive "P")
+ (sql-product-interactive 'ms buffer))
(defun sql-comint-ms (product options)
"Create comint buffer and connect to Microsoft SQL Server."
@@ -3584,7 +3840,7 @@ The default comes from `process-coding-system-alist' and
;;;###autoload
-(defun sql-postgres ()
+(defun sql-postgres (&optional buffer)
"Run psql by Postgres as an inferior process.
If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3599,6 +3855,11 @@ Additional command line parameters can be stored in the list
The buffer is put in SQL interactive mode, giving commands for sending
input. See `sql-interactive-mode'.
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-postgres]. Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
To specify a coding system for converting non-ASCII characters
in the input and output to the process, use \\[universal-coding-system-argument]
before \\[sql-postgres]. You can also specify this with \\[set-buffer-process-coding-system]
@@ -3612,8 +3873,8 @@ Try to set `comint-output-filter-functions' like this:
'(comint-strip-ctrl-m)))
\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
- (interactive)
- (sql-product-interactive 'postgres))
+ (interactive "P")
+ (sql-product-interactive 'postgres buffer))
(defun sql-comint-postgres (product options)
"Create comint buffer and connect to Postgres."
@@ -3634,7 +3895,7 @@ Try to set `comint-output-filter-functions' like this:
;;;###autoload
-(defun sql-interbase ()
+(defun sql-interbase (&optional buffer)
"Run isql by Interbase as an inferior process.
If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3648,6 +3909,11 @@ defaults, if set.
The buffer is put in SQL interactive mode, giving commands for sending
input. See `sql-interactive-mode'.
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-interbase]. Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
To specify a coding system for converting non-ASCII characters
in the input and output to the process, use \\[universal-coding-system-argument]
before \\[sql-interbase]. You can also specify this with \\[set-buffer-process-coding-system]
@@ -3656,8 +3922,8 @@ The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
- (interactive)
- (sql-product-interactive 'interbase))
+ (interactive "P")
+ (sql-product-interactive 'interbase buffer))
(defun sql-comint-interbase (product options)
"Create comint buffer and connect to Interbase."
@@ -3675,7 +3941,7 @@ The default comes from `process-coding-system-alist' and
;;;###autoload
-(defun sql-db2 ()
+(defun sql-db2 (&optional buffer)
"Run db2 by IBM as an inferior process.
If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3693,6 +3959,11 @@ db2, newlines will be escaped if necessary. If you don't want that, set
`comint-input-sender' back to `comint-simple-send' by writing an after
advice. See the elisp manual for more information.
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-db2]. Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
To specify a coding system for converting non-ASCII characters
in the input and output to the process, use \\[universal-coding-system-argument]
before \\[sql-db2]. You can also specify this with \\[set-buffer-process-coding-system]
@@ -3701,8 +3972,8 @@ The default comes from `process-coding-system-alist' and
`default-process-coding-system'.
\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
- (interactive)
- (sql-product-interactive 'db2))
+ (interactive "P")
+ (sql-product-interactive 'db2 buffer))
(defun sql-comint-db2 (product options)
"Create comint buffer and connect to DB2."
@@ -3710,11 +3981,9 @@ The default comes from `process-coding-system-alist' and
;; make-comint.
(sql-comint product options)
)
-;; ;; Properly escape newlines when DB2 is interactive.
-;; (setq comint-input-sender 'sql-escape-newlines-and-send))
;;;###autoload
-(defun sql-linter ()
+(defun sql-linter (&optional buffer)
"Run inl by RELEX as an inferior process.
If buffer `*SQL*' exists but no process is running, make a new process.
@@ -3736,9 +4005,14 @@ an empty password.
The buffer is put in SQL interactive mode, giving commands for sending
input. See `sql-interactive-mode'.
+To set the buffer name directly, use \\[universal-argument]
+before \\[sql-linter]. Once session has started,
+\\[sql-rename-buffer] can be called separately to rename the
+buffer.
+
\(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
- (interactive)
- (sql-product-interactive 'linter))
+ (interactive "P")
+ (sql-product-interactive 'linter buffer))
(defun sql-comint-linter (product options)
"Create comint buffer and connect to Linter."
diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el
index 29096a2304..8f80d13bab 100644
--- a/lisp/progmodes/tcl.el
+++ b/lisp/progmodes/tcl.el
@@ -411,9 +411,10 @@ This variable is generally set from `tcl-proc-regexp',
`tcl-typeword-list', and `tcl-keyword-list' by the function
`tcl-set-font-lock-keywords'.")
-(defvar tcl-font-lock-syntactic-keywords
- ;; Mark the few `#' that are not comment-markers.
- '(("[^;[{ \t\n][ \t]*\\(#\\)" (1 ".")))
+(defconst tcl-syntax-propertize-function
+ (syntax-propertize-rules
+ ;; Mark the few `#' that are not comment-markers.
+ ("[^;[{ \t\n][ \t]*\\(#\\)" (1 ".")))
"Syntactic keywords for `tcl-mode'.")
;; FIXME need some way to recognize variables because array refs look
@@ -593,9 +594,9 @@ Commands:
(set (make-local-variable 'outline-level) 'tcl-outline-level)
(set (make-local-variable 'font-lock-defaults)
- '(tcl-font-lock-keywords nil nil nil beginning-of-defun
- (font-lock-syntactic-keywords . tcl-font-lock-syntactic-keywords)
- (parse-sexp-lookup-properties . t)))
+ '(tcl-font-lock-keywords nil nil nil beginning-of-defun))
+ (set (make-local-variable 'syntax-propertize-function)
+ tcl-syntax-propertize-function)
(set (make-local-variable 'imenu-generic-expression)
tcl-imenu-generic-expression)
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index 4ff9cf92b8..24768d93e6 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -4693,8 +4693,15 @@ Key bindings:
(set (make-local-variable 'font-lock-defaults)
(list
'(nil vhdl-font-lock-keywords) nil
- (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line
- '(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords)))
+ (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line))
+ (if (eval-when-compile (fboundp 'syntax-propertize-rules))
+ (set (make-local-variable 'syntax-propertize-function)
+ (syntax-propertize-rules
+ ;; Mark single quotes as having string quote syntax in
+ ;; 'c' instances.
+ ("\\(\'\\).\\(\'\\)" (1 "\"'") (2 "\"'"))))
+ (set (make-local-variable 'font-lock-syntactic-keywords)
+ vhdl-font-lock-syntactic-keywords))
(unless vhdl-emacs-21
(set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode)
(set (make-local-variable 'lazy-lock-defer-contextually) nil)
@@ -12914,10 +12921,9 @@ This does background highlighting of translate-off regions.")
"Re-initialize fontification and fontify buffer."
(interactive)
(setq font-lock-defaults
- (list
- 'vhdl-font-lock-keywords nil
- (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line
- '(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords)))
+ `(vhdl-font-lock-keywords
+ nil ,(not vhdl-highlight-case-sensitive) ((?\_ . "w"))
+ beginning-of-line))
(when (fboundp 'font-lock-unset-defaults)
(font-lock-unset-defaults)) ; not implemented in XEmacs
(font-lock-set-defaults)
diff --git a/lisp/ps-bdf.el b/lisp/ps-bdf.el
index 65ec4bf101..585b5f9eb6 100644
--- a/lisp/ps-bdf.el
+++ b/lisp/ps-bdf.el
@@ -15,6 +15,7 @@
;; Author: Kenichi Handa <[email protected]>
;; (according to ack.texi)
;; Keywords: wp, BDF, font, PostScript
+;; Package: ps-print
;; This file is part of GNU Emacs.
diff --git a/lisp/ps-def.el b/lisp/ps-def.el
index 5e045bccf9..c27ee251e0 100644
--- a/lisp/ps-def.el
+++ b/lisp/ps-def.el
@@ -8,6 +8,7 @@
;; Vinicius Jose Latorre <[email protected]>
;; Keywords: wp, print, PostScript
;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
+;; Package: ps-print
;; This file is part of GNU Emacs.
diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el
index 51c4cc20be..df779fde39 100644
--- a/lisp/ps-mule.el
+++ b/lisp/ps-mule.el
@@ -8,6 +8,7 @@
;; Maintainer: Kenichi Handa <[email protected]> (multi-byte characters)
;; Vinicius Jose Latorre <[email protected]>
;; Keywords: wp, print, PostScript, multibyte, mule
+;; Package: ps-print
;; This file is part of GNU Emacs.
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index 7c7397a52b..02e43ef3f0 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -6656,7 +6656,7 @@ If FACE is not a valid face name, use default face."
;; But autoload them here to make the separation invisible.
;;;### (autoloads (ps-mule-end-job ps-mule-begin-job ps-mule-initialize
-;;;;;; ps-multibyte-buffer) "ps-mule" "ps-mule.el" "9187df3473401876e0df4937c311fbaf")
+;;;;;; ps-multibyte-buffer) "ps-mule" "ps-mule.el" "d2fcad95db7404989362657faf744796")
;;; Generated autoloads from ps-mule.el
(defvar ps-multibyte-buffer nil "\
diff --git a/lisp/ps-samp.el b/lisp/ps-samp.el
index 5ad1c6855d..9fab290fc5 100644
--- a/lisp/ps-samp.el
+++ b/lisp/ps-samp.el
@@ -10,6 +10,7 @@
;; Vinicius Jose Latorre <[email protected]>
;; Keywords: wp, print, PostScript
;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
+;; Package: ps-print
;; This file is part of GNU Emacs.
diff --git a/lisp/rect.el b/lisp/rect.el
index facc6d5185..6658408991 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -5,6 +5,7 @@
;; Maintainer: Didier Verna <[email protected]>
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/register.el b/lisp/register.el
index 1a6d84d2c1..97b6eb0dfc 100644
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -5,6 +5,7 @@
;; Maintainer: FSF
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/repeat.el b/lisp/repeat.el
index edebbe24a8..eddaf4f020 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -5,7 +5,7 @@
;; Author: Will Mengarini <[email protected]>
;; Created: Mo 02 Mar 98
-;; Version: 0.51, We 13 May 98
+;; Version: 0.51
;; Keywords: convenience, vi, repeat
;; This file is part of GNU Emacs.
diff --git a/lisp/replace.el b/lisp/replace.el
index 01d971f76e..baea282043 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -5,6 +5,7 @@
;; Free Software Foundation, Inc.
;; Maintainer: FSF
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/rfn-eshadow.el b/lisp/rfn-eshadow.el
index 7c2cf0f96f..fa7a933615 100644
--- a/lisp/rfn-eshadow.el
+++ b/lisp/rfn-eshadow.el
@@ -5,6 +5,7 @@
;;
;; Author: Miles Bader <[email protected]>
;; Keywords: convenience minibuffer
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el
index ebc0085913..8b8edab000 100644
--- a/lisp/scroll-bar.el
+++ b/lisp/scroll-bar.el
@@ -5,6 +5,7 @@
;; Maintainer: FSF
;; Keywords: hardware
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/select.el b/lisp/select.el
index 842c250df6..3e9cd2d5d5 100644
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -174,36 +174,6 @@ are not available to other programs."
(symbolp data)
(integerp data)))
-;;; Cut Buffer support
-
-(declare-function x-get-cut-buffer-internal "xselect.c")
-
-(defun x-get-cut-buffer (&optional which-one)
- "Return the value of one of the 8 X server cut-buffers.
-Optional arg WHICH-ONE should be a number from 0 to 7, defaulting to 0.
-Cut buffers are considered obsolete; you should use selections instead."
- (x-get-cut-buffer-internal
- (if which-one
- (aref [CUT_BUFFER0 CUT_BUFFER1 CUT_BUFFER2 CUT_BUFFER3
- CUT_BUFFER4 CUT_BUFFER5 CUT_BUFFER6 CUT_BUFFER7]
- which-one)
- 'CUT_BUFFER0)))
-
-(declare-function x-rotate-cut-buffers-internal "xselect.c")
-(declare-function x-store-cut-buffer-internal "xselect.c")
-
-(defun x-set-cut-buffer (string &optional push)
- "Store STRING into the X server's primary cut buffer.
-If PUSH is non-nil, also rotate the cut buffers:
-this means the previous value of the primary cut buffer moves to the second
-cut buffer, and the second to the third, and so on (there are 8 buffers.)
-Cut buffers are considered obsolete; you should use selections instead."
- (or (stringp string) (signal 'wrong-type-argument (list 'stringp string)))
- (if push
- (x-rotate-cut-buffers-internal 1))
- (x-store-cut-buffer-internal 'CUT_BUFFER0 string))
-
-
;; Functions to convert the selection into various other selection types.
;; Every selection type that Emacs handles is implemented this way, except
;; for TIMESTAMP, which is a special case.
diff --git a/lisp/server.el b/lisp/server.el
index b2cb829adf..f0e88d0361 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -1093,9 +1093,7 @@ The following commands are accepted by the client:
(condition-case err
(let* ((buffers
(when files
- (run-hooks 'pre-command-hook)
- (prog1 (server-visit-files files proc nowait)
- (run-hooks 'post-command-hook)))))
+ (server-visit-files files proc nowait))))
(mapc 'funcall (nreverse commands))
@@ -1166,8 +1164,13 @@ so don't mark these buffers specially, just visit them normally."
(obuf (get-file-buffer filen)))
(add-to-history 'file-name-history filen)
(if (null obuf)
- (set-buffer (find-file-noselect filen))
+ (progn
+ (run-hooks 'pre-command-hook)
+ (set-buffer (find-file-noselect filen)))
(set-buffer obuf)
+ ;; separately for each file, in sync with post-command hooks,
+ ;; with the new buffer current:
+ (run-hooks 'pre-command-hook)
(cond ((file-exists-p filen)
(when (not (verify-visited-file-modtime obuf))
(revert-buffer t nil)))
@@ -1179,7 +1182,9 @@ so don't mark these buffers specially, just visit them normally."
(unless server-buffer-clients
(setq server-existing-buffer t)))
(server-goto-line-column (cdr file))
- (run-hooks 'server-visit-hook))
+ (run-hooks 'server-visit-hook)
+ ;; hooks may be specific to current buffer:
+ (run-hooks 'post-command-hook))
(unless nowait
;; When the buffer is killed, inform the clients.
(add-hook 'kill-buffer-hook 'server-kill-buffer nil t)
diff --git a/lisp/sha1.el b/lisp/sha1.el
index 351af62783..0d97ac6ce4 100644
--- a/lisp/sha1.el
+++ b/lisp/sha1.el
@@ -439,5 +439,4 @@ If BINARY is non-nil, return a string in binary form."
(provide 'sha1)
-;; arch-tag: c0f9abd0-ffc1-4557-aac6-ece7f2d4c901
;;; sha1.el ends here
diff --git a/lisp/simple.el b/lisp/simple.el
index 0ac199ea2f..36931c7777 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -6,6 +6,7 @@
;; Maintainer: FSF
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -424,6 +425,19 @@ Other major modes are defined by comparison with this one."
;; Major mode meant to be the parent of programming modes.
+(defvar prog-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [?\C-\M-q] 'prog-indent-sexp)
+ map)
+ "Keymap used for programming modes.")
+
+(defun prog-indent-sexp ()
+ "Indent the expression after point."
+ (interactive)
+ (let ((start (point))
+ (end (save-excursion (forward-sexp 1) (point))))
+ (indent-region start end nil)))
+
(define-derived-mode prog-mode fundamental-mode "Prog"
"Major mode for editing programming language source code."
(set (make-local-variable 'require-final-newline) mode-require-final-newline)
@@ -443,72 +457,43 @@ Call `auto-fill-function' if the current column number is greater
than the value of `fill-column' and ARG is nil."
(interactive "*P")
(barf-if-buffer-read-only)
- ;; Inserting a newline at the end of a line produces better redisplay in
- ;; try_window_id than inserting at the beginning of a line, and the textual
- ;; result is the same. So, if we're at beginning of line, pretend to be at
- ;; the end of the previous line.
- (let ((flag (and (not (bobp))
- (bolp)
- ;; Make sure no functions want to be told about
- ;; the range of the changes.
- (not after-change-functions)
- (not before-change-functions)
- ;; Make sure there are no markers here.
- (not (buffer-has-markers-at (1- (point))))
- (not (buffer-has-markers-at (point)))
- ;; Make sure no text properties want to know
- ;; where the change was.
- (not (get-char-property (1- (point)) 'modification-hooks))
- (not (get-char-property (1- (point)) 'insert-behind-hooks))
- (or (eobp)
- (not (get-char-property (point) 'insert-in-front-hooks)))
- ;; Make sure the newline before point isn't intangible.
- (not (get-char-property (1- (point)) 'intangible))
- ;; Make sure the newline before point isn't read-only.
- (not (get-char-property (1- (point)) 'read-only))
- ;; Make sure the newline before point isn't invisible.
- (not (get-char-property (1- (point)) 'invisible))
- ;; Make sure the newline before point has the same
- ;; properties as the char before it (if any).
- (< (or (previous-property-change (point)) -2)
- (- (point) 2))))
- (was-page-start (and (bolp)
- (looking-at page-delimiter)))
- (beforepos (point)))
- (if flag (backward-char 1))
- ;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
- ;; Set last-command-event to tell self-insert what to insert.
- (let ((last-command-event ?\n)
- ;; Don't auto-fill if we have a numeric argument.
- ;; Also not if flag is true (it would fill wrong line);
- ;; there is no need to since we're at BOL.
- (auto-fill-function (if (or arg flag) nil auto-fill-function)))
- (unwind-protect
- (self-insert-command (prefix-numeric-value arg))
- ;; If we get an error in self-insert-command, put point at right place.
- (if flag (forward-char 1))))
- ;; Even if we did *not* get an error, keep that forward-char;
- ;; all further processing should apply to the newline that the user
- ;; thinks he inserted.
-
- ;; Mark the newline(s) `hard'.
- (if use-hard-newlines
- (set-hard-newline-properties
- (- (point) (prefix-numeric-value arg)) (point)))
- ;; If the newline leaves the previous line blank,
- ;; and we have a left margin, delete that from the blank line.
- (or flag
- (save-excursion
- (goto-char beforepos)
- (beginning-of-line)
- (and (looking-at "[ \t]$")
- (> (current-left-margin) 0)
- (delete-region (point) (progn (end-of-line) (point))))))
- ;; Indent the line after the newline, except in one case:
- ;; when we added the newline at the beginning of a line
- ;; which starts a page.
- (or was-page-start
- (move-to-left-margin nil t)))
+ ;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
+ ;; Set last-command-event to tell self-insert what to insert.
+ (let* ((was-page-start (and (bolp) (looking-at page-delimiter)))
+ (beforepos (point))
+ (last-command-event ?\n)
+ ;; Don't auto-fill if we have a numeric argument.
+ (auto-fill-function (if arg nil auto-fill-function))
+ (postproc
+ ;; Do the rest in post-self-insert-hook, because we want to do it
+ ;; *before* other functions on that hook.
+ (lambda ()
+ ;; Mark the newline(s) `hard'.
+ (if use-hard-newlines
+ (set-hard-newline-properties
+ (- (point) (prefix-numeric-value arg)) (point)))
+ ;; If the newline leaves the previous line blank, and we
+ ;; have a left margin, delete that from the blank line.
+ (save-excursion
+ (goto-char beforepos)
+ (beginning-of-line)
+ (and (looking-at "[ \t]$")
+ (> (current-left-margin) 0)
+ (delete-region (point)
+ (line-end-position))))
+ ;; Indent the line after the newline, except in one case:
+ ;; when we added the newline at the beginning of a line which
+ ;; starts a page.
+ (or was-page-start
+ (move-to-left-margin nil t)))))
+ (unwind-protect
+ (progn
+ (add-hook 'post-self-insert-hook postproc)
+ (self-insert-command (prefix-numeric-value arg)))
+ ;; We first used let-binding to protect the hook, but that was naive
+ ;; since add-hook affects the symbol-default value of the variable,
+ ;; whereas the let-binding might only protect the buffer-local value.
+ (remove-hook 'post-self-insert-hook postproc)))
nil)
(defun set-hard-newline-properties (from to)
@@ -790,15 +775,16 @@ If BACKWARD-ONLY is non-nil, only delete them before point."
(constrain-to-field nil orig-pos t)))))
(defun beginning-of-buffer (&optional arg)
- "Move point to the beginning of the buffer; leave mark at previous position.
-With \\[universal-argument] prefix, do not set mark at previous position.
+ "Move point to the beginning of the buffer.
With numeric arg N, put point N/10 of the way from the beginning.
+If the buffer is narrowed, this command uses the beginning of the
+accessible part of the buffer.
-If the buffer is narrowed, this command uses the beginning and size
-of the accessible part of the buffer.
+If Transient Mark mode is disabled, leave mark at previous
+position, unless a \\[universal-argument] prefix is supplied.
Don't use this command in Lisp programs!
-\(goto-char (point-min)) is faster and avoids clobbering the mark."
+\(goto-char (point-min)) is faster."
(interactive "^P")
(or (consp arg)
(region-active-p)
@@ -815,15 +801,16 @@ Don't use this command in Lisp programs!
(if (and arg (not (consp arg))) (forward-line 1)))
(defun end-of-buffer (&optional arg)
- "Move point to the end of the buffer; leave mark at previous position.
-With \\[universal-argument] prefix, do not set mark at previous position.
+ "Move point to the end of the buffer.
With numeric arg N, put point N/10 of the way from the end.
+If the buffer is narrowed, this command uses the end of the
+accessible part of the buffer.
-If the buffer is narrowed, this command uses the beginning and size
-of the accessible part of the buffer.
+If Transient Mark mode is disabled, leave mark at previous
+position, unless a \\[universal-argument] prefix is supplied.
Don't use this command in Lisp programs!
-\(goto-char (point-max)) is faster and avoids clobbering the mark."
+\(goto-char (point-max)) is faster."
(interactive "^P")
(or (consp arg) (region-active-p) (push-mark))
(let ((size (- (point-max) (point-min))))
@@ -1288,6 +1275,40 @@ to get different commands to edit and resubmit."
(if command-history
(error "Argument %d is beyond length of command history" arg)
(error "There are no previous complex commands to repeat")))))
+
+(defun read-extended-command ()
+ "Read command name to invoke in `execute-extended-command'."
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (set (make-local-variable 'minibuffer-default-add-function)
+ (lambda ()
+ ;; Get a command name at point in the original buffer
+ ;; to propose it after M-n.
+ (with-current-buffer (window-buffer (minibuffer-selected-window))
+ (and (commandp (function-called-at-point))
+ (format "%S" (function-called-at-point)))))))
+ ;; Read a string, completing from and restricting to the set of
+ ;; all defined commands. Don't provide any initial input.
+ ;; Save the command read on the extended-command history list.
+ (completing-read
+ (concat (cond
+ ((eq current-prefix-arg '-) "- ")
+ ((and (consp current-prefix-arg)
+ (eq (car current-prefix-arg) 4)) "C-u ")
+ ((and (consp current-prefix-arg)
+ (integerp (car current-prefix-arg)))
+ (format "%d " (car current-prefix-arg)))
+ ((integerp current-prefix-arg)
+ (format "%d " current-prefix-arg)))
+ ;; This isn't strictly correct if `execute-extended-command'
+ ;; is bound to anything else (e.g. [menu]).
+ ;; It could use (key-description (this-single-command-keys)),
+ ;; but actually a prompt other than "M-x" would be confusing,
+ ;; because "M-x" is a well-known prompt to read a command
+ ;; and it serves as a shorthand for "Extended command: ".
+ "M-x ")
+ obarray 'commandp t nil 'extended-command-history)))
+
(defvar minibuffer-history nil
"Default minibuffer history list.
@@ -2879,11 +2900,8 @@ This variable holds a function that Emacs calls whenever text
is put in the kill ring, to make the new kill available to other
programs.
-The function takes one or two arguments.
-The first argument, TEXT, is a string containing
-the text which should be made available.
-The second, optional, argument PUSH, has the same meaning as the
-similar argument to `x-set-cut-buffer', which see.")
+The function takes one argument, TEXT, which is a string containing
+the text which should be made available.")
(defvar interprogram-paste-function nil
"Function to call to get text cut from other programs.
@@ -3000,7 +3018,7 @@ argument should still be a \"useful\" string for such uses."
(setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))))
(setq kill-ring-yank-pointer kill-ring)
(if interprogram-cut-function
- (funcall interprogram-cut-function string (not replace))))
+ (funcall interprogram-cut-function string)))
(defun kill-append (string before-p &optional yank-handler)
"Append STRING to the end of the latest kill in the kill ring.
@@ -3090,7 +3108,8 @@ If the buffer is read-only, Emacs will beep and refrain from deleting
the text, but put the text in the kill ring anyway. This means that
you can use the killing commands to copy text from a read-only buffer.
-This is the primitive for programs to kill text (as opposed to deleting it).
+Lisp programs should use this function for killing text.
+ (To delete text, use `delete-region'.)
Supply two arguments, character positions indicating the stretch of text
to be killed.
Any command that calls this function is a \"kill command\".
@@ -3674,7 +3693,9 @@ Unless FORCE is non-nil, this function does nothing if Transient
Mark mode is disabled.
This function also runs `deactivate-mark-hook'."
(when (or transient-mark-mode force)
- (when (and select-active-regions
+ (when (and (if (eq select-active-regions 'only)
+ (eq (car-safe transient-mark-mode) 'only)
+ select-active-regions)
(region-active-p)
(display-selections-p))
;; The var `saved-region-selection', if non-nil, is the text in
@@ -5453,21 +5474,40 @@ it skips the contents of comments that end before point."
:type 'boolean
:group 'paren-blinking)
+(defun blink-matching-check-mismatch (start end)
+ "Return whether or not START...END are matching parens.
+END is the current point and START is the blink position.
+START might be nil if no matching starter was found.
+Returns non-nil if we find there is a mismatch."
+ (let* ((end-syntax (syntax-after (1- end)))
+ (matching-paren (and (consp end-syntax)
+ (eq (syntax-class end-syntax) 5)
+ (cdr end-syntax))))
+ ;; For self-matched chars like " and $, we can't know when they're
+ ;; mismatched or unmatched, so we can only do it for parens.
+ (when matching-paren
+ (not (and start
+ (or
+ (eq (char-after start) matching-paren)
+ ;; The cdr might hold a new paren-class info rather than
+ ;; a matching-char info, in which case the two CDRs
+ ;; should match.
+ (eq matching-paren (cdr-safe (syntax-after start)))))))))
+
+(defvar blink-matching-check-function #'blink-matching-check-mismatch
+ "Function to check parentheses mismatches.
+The function takes two arguments (START and END) where START is the
+position just before the opening token and END is the position right after.
+START can be nil, if it was not found.
+The function should return non-nil if the two tokens do not match.")
+
(defun blink-matching-open ()
"Move cursor momentarily to the beginning of the sexp before point."
(interactive)
- (when (and (> (point) (point-min))
- blink-matching-paren
- ;; Verify an even number of quoting characters precede the close.
- (= 1 (logand 1 (- (point)
- (save-excursion
- (forward-char -1)
- (skip-syntax-backward "/\\")
- (point))))))
+ (when (and (not (bobp))
+ blink-matching-paren)
(let* ((oldpos (point))
- (message-log-max nil) ; Don't log messages about paren matching.
- (atdollar (eq (syntax-class (syntax-after (1- oldpos))) 8))
- (isdollar)
+ (message-log-max nil) ; Don't log messages about paren matching.
(blinkpos
(save-excursion
(save-restriction
@@ -5480,38 +5520,28 @@ it skips the contents of comments that end before point."
(and parse-sexp-ignore-comments
(not blink-matching-paren-dont-ignore-comments))))
(condition-case ()
- (scan-sexps oldpos -1)
+ (progn
+ (forward-sexp -1)
+ ;; backward-sexp skips backward over prefix chars,
+ ;; so move back to the matching paren.
+ (while (and (< (point) (1- oldpos))
+ (let ((code (car (syntax-after (point)))))
+ (or (eq (logand 65536 code) 6)
+ (eq (logand 1048576 code) 1048576))))
+ (forward-char 1))
+ (point))
(error nil))))))
- (matching-paren
- (and blinkpos
- ;; Not syntax '$'.
- (not (setq isdollar
- (eq (syntax-class (syntax-after blinkpos)) 8)))
- (let ((syntax (syntax-after blinkpos)))
- (and (consp syntax)
- (eq (syntax-class syntax) 4)
- (cdr syntax))))))
+ (mismatch (funcall blink-matching-check-function blinkpos oldpos)))
(cond
- ;; isdollar is for:
- ;; http://lists.gnu.org/archive/html/emacs-devel/2007-10/msg00871.html
- ((not (or (and isdollar blinkpos)
- (and atdollar (not blinkpos)) ; see below
- (eq matching-paren (char-before oldpos))
- ;; The cdr might hold a new paren-class info rather than
- ;; a matching-char info, in which case the two CDRs
- ;; should match.
- (eq matching-paren (cdr (syntax-after (1- oldpos))))))
- (if (minibufferp)
- (minibuffer-message " [Mismatched parentheses]")
- (message "Mismatched parentheses")))
- ((not blinkpos)
- (or blink-matching-paren-distance
- ;; Don't complain when `$' with no blinkpos, because it
- ;; could just be the first one typed in the buffer.
- atdollar
+ (mismatch
+ (if blinkpos
(if (minibufferp)
- (minibuffer-message " [Unmatched parenthesis]")
- (message "Unmatched parenthesis"))))
+ (minibuffer-message " [Mismatched parentheses]")
+ (message "Mismatched parentheses"))
+ (if (minibufferp)
+ (minibuffer-message " [Unmatched parenthesis]")
+ (message "Unmatched parenthesis"))))
+ ((not blinkpos) nil)
((pos-visible-in-window-p blinkpos)
;; Matching open within window, temporarily move to blinkpos but only
;; if `blink-matching-paren-on-screen' is non-nil.
@@ -5554,7 +5584,29 @@ it skips the contents of comments that end before point."
(message "Matches %s"
(substring-no-properties open-paren-line-string)))))))))
-(setq blink-paren-function 'blink-matching-open)
+(defvar blink-paren-function 'blink-matching-open
+ "Function called, if non-nil, whenever a close parenthesis is inserted.
+More precisely, a char with closeparen syntax is self-inserted.")
+
+(defun blink-paren-post-self-insert-function ()
+ (when (and (eq (char-before) last-command-event) ; Sanity check.
+ (memq (char-syntax last-command-event) '(?\) ?\$))
+ blink-paren-function
+ (not executing-kbd-macro)
+ (not noninteractive)
+ ;; Verify an even number of quoting characters precede the close.
+ (= 1 (logand 1 (- (point)
+ (save-excursion
+ (forward-char -1)
+ (skip-syntax-backward "/\\")
+ (point))))))
+ (funcall blink-paren-function)))
+
+(add-hook 'post-self-insert-hook #'blink-paren-post-self-insert-function
+ ;; Most likely, this hook is nil, so this arg doesn't matter,
+ ;; but I use it as a reminder that this function usually
+ ;; likes to be run after others since it does `sit-for'.
+ 'append)
;; This executes C-g typed while Emacs is waiting for a command.
;; Quitting out of a program does not go through here;
diff --git a/lisp/startup.el b/lisp/startup.el
index 76e11491c0..c029eff54c 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -6,6 +6,7 @@
;; Maintainer: FSF
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -785,15 +786,16 @@ opening the first frame (e.g. open a connection to an X server).")
argi (match-string 1 argi)))
(when (string-match "\\`--." orig-argi)
(let ((completion (try-completion argi longopts)))
- (if (eq completion t)
- (setq argi (substring argi 1))
- (if (stringp completion)
- (let ((elt (assoc completion longopts)))
- (or elt
- (error "Option `%s' is ambiguous" argi))
- (setq argi (substring (car elt) 1)))
- (setq argval nil
- argi orig-argi)))))
+ (cond ((eq completion t)
+ (setq argi (substring argi 1)))
+ ((stringp completion)
+ (let ((elt (assoc completion longopts)))
+ (unless elt
+ (error "Option `%s' is ambiguous" argi))
+ (setq argi (substring (car elt) 1))))
+ (t
+ (setq argval nil
+ argi orig-argi)))))
(cond
;; The --display arg is handled partly in C, partly in Lisp.
;; When it shows up here, we just put it back to be handled
@@ -2231,6 +2233,11 @@ A fancy display is used on graphic displays, normal otherwise."
(move-to-column (1- cl1-column)))
(setq cl1-column 0))
+ ;; These command lines now have no effect.
+ ((string-match "\\`--?\\(no-\\)?\\(uni\\|multi\\)byte$" argi)
+ (display-warning 'initialization
+ (format "Ignoring obsolete arg %s" argi)))
+
((equal argi "--")
(setq just-files t))
(t
diff --git a/lisp/subr.el b/lisp/subr.el
index c490bb89d0..c30b42aba8 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -5,6 +5,7 @@
;; Maintainer: FSF
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -219,6 +220,7 @@ Treated as a declaration when used at the right place in a
(defmacro ignore-errors (&rest body)
"Execute BODY; if an error occurs, return nil.
Otherwise, return result of last form in BODY."
+ (declare (debug t) (indent 0))
`(condition-case nil (progn ,@body) (error nil)))
;;;; Basic Lisp functions.
@@ -1634,6 +1636,7 @@ Return nil if there isn't one."
load-elt (and loads (car loads)))))
load-elt))
+(put 'eval-after-load 'lisp-indent-function 1)
(defun eval-after-load (file form)
"Arrange that, if FILE is ever loaded, FORM will be run at that time.
If FILE is already loaded, evaluate FORM right now.
@@ -1824,6 +1827,7 @@ When there's an ambiguity because the key looks like the prefix of
some sort of escape sequence, the ambiguity is resolved via `read-key-delay'."
(let ((overriding-terminal-local-map read-key-empty-map)
(overriding-local-map nil)
+ (echo-keystrokes 0)
(old-global-map (current-global-map))
(timer (run-with-idle-timer
;; Wait long enough that Emacs has the time to receive and
@@ -1848,7 +1852,12 @@ some sort of escape sequence, the ambiguity is resolved via `read-key-delay'."
(throw 'read-key keys)))))))
(unwind-protect
(progn
- (use-global-map read-key-empty-map)
+ (use-global-map
+ (let ((map (make-sparse-keymap)))
+ ;; Don't hide the menu-bar and tool-bar entries.
+ (define-key map [menu-bar] (lookup-key global-map [menu-bar]))
+ (define-key map [tool-bar] (lookup-key global-map [tool-bar]))
+ map))
(aref (catch 'read-key (read-key-sequence-vector prompt nil t)) 0))
(cancel-timer timer)
(use-global-map old-global-map))))
@@ -2711,7 +2720,7 @@ nor the buffer list."
"Create a new buffer, evaluate BODY there, and write the buffer to FILE.
The value returned is the value of the last form in BODY.
See also `with-temp-buffer'."
- (declare (debug t))
+ (declare (indent 1) (debug t))
(let ((temp-file (make-symbol "temp-file"))
(temp-buffer (make-symbol "temp-buffer")))
`(let ((,temp-file ,file)
@@ -2733,7 +2742,7 @@ The value returned is the value of the last form in BODY.
MESSAGE is written to the message log buffer if `message-log-max' is non-nil.
If MESSAGE is nil, the echo area and message log buffer are unchanged.
Use a MESSAGE of \"\" to temporarily clear the echo area."
- (declare (debug t))
+ (declare (debug t) (indent 1))
(let ((current-message (make-symbol "current-message"))
(temp-message (make-symbol "with-temp-message")))
`(let ((,temp-message ,message)
@@ -2763,7 +2772,7 @@ See also `with-temp-file' and `with-output-to-string'."
(kill-buffer ,temp-buffer)))))))
(defmacro with-silent-modifications (&rest body)
- "Execute BODY, pretending it does not modifies the buffer.
+ "Execute BODY, pretending it does not modify the buffer.
If BODY performs real modifications to the buffer's text, other
than cosmetic ones, undo data may become corrupted.
Typically used around modifications of text-properties which do not really
@@ -3225,7 +3234,7 @@ that can be added."
The syntax table of the current buffer is saved, BODY is evaluated, and the
saved table is restored, even in case of an abnormal exit.
Value is what BODY returns."
- (declare (debug t))
+ (declare (debug t) (indent 1))
(let ((old-table (make-symbol "table"))
(old-buffer (make-symbol "buffer")))
`(let ((,old-table (syntax-table))
@@ -3355,6 +3364,52 @@ clone should be incorporated in the clone."
(overlay-put ol2 'evaporate t)
(overlay-put ol2 'text-clones dups)))
+;;;; Misc functions moved over from the C side.
+
+(defun y-or-n-p (prompt)
+ "Ask user a \"y or n\" question. Return t if answer is \"y\".
+The argument PROMPT is the string to display to ask the question.
+It should end in a space; `y-or-n-p' adds `(y or n) ' to it.
+No confirmation of the answer is requested; a single character is enough.
+Also accepts Space to mean yes, or Delete to mean no. \(Actually, it uses
+the bindings in `query-replace-map'; see the documentation of that variable
+for more information. In this case, the useful bindings are `act', `skip',
+`recenter', and `quit'.\)
+
+Under a windowing system a dialog box will be used if `last-nonmenu-event'
+is nil and `use-dialog-box' is non-nil."
+ ;; ¡Beware! when I tried to edebug this code, Emacs got into a weird state
+ ;; where all the keys were unbound (i.e. it somehow got triggered
+ ;; within read-key, apparently). I had to kill it.
+ (let ((answer 'none)
+ (xprompt prompt))
+ (if (and (display-popup-menus-p)
+ (listp last-nonmenu-event)
+ use-dialog-box)
+ (setq answer
+ (x-popup-dialog t `(,prompt ("yes" . act) ("No" . skip))))
+ (while
+ (let* ((key
+ (let ((cursor-in-echo-area t))
+ (when minibuffer-auto-raise
+ (raise-frame (window-frame (minibuffer-window))))
+ (read-key (propertize xprompt 'face 'minibuffer-prompt)))))
+ (setq answer (lookup-key query-replace-map (vector key) t))
+ (cond
+ ((memq answer '(skip act)) nil)
+ ((eq answer 'recenter) (recenter) t)
+ ((memq answer '(exit-prefix quit)) (signal 'quit nil) t)
+ (t t)))
+ (ding)
+ (discard-input)
+ (setq xprompt
+ (if (eq answer 'recenter) prompt
+ (concat "Please answer y or n. " prompt)))))
+ (let ((ret (eq answer 'act)))
+ (unless noninteractive
+ (message "%s %s" prompt (if ret "y" "n")))
+ ret)))
+
;;;; Mail user agents.
;; Here we include just enough for other packages to be able
@@ -3583,11 +3638,11 @@ Usually the separator is \".\", but it can be any other string.")
(defconst version-regexp-alist
- '(("^[-_+ ]?a\\(lpha\\)?$" . -3)
+ '(("^[-_+ ]?alpha$" . -3)
("^[-_+]$" . -3) ; treat "1.2.3-20050920" and "1.2-3" as alpha releases
("^[-_+ ]cvs$" . -3) ; treat "1.2.3-CVS" as alpha release
- ("^[-_+ ]?b\\(eta\\)?$" . -2)
- ("^[-_+ ]?\\(pre\\|rc\\)$" . -1))
+ ("^[-_+ ]?beta$" . -2)
+ ("^[-_+ ]?\\(pre\\|rcc\\)$" . -1))
"*Specify association between non-numeric version and its priority.
This association is used to handle version string like \"1.0pre2\",
@@ -3680,8 +3735,13 @@ See documentation for `version-separator' and `version-regexp-alist'."
(setq al version-regexp-alist)
(while (and al (not (string-match (caar al) s)))
(setq al (cdr al)))
- (or al (error "Invalid version syntax: '%s'" ver))
- (setq lst (cons (cdar al) lst)))))
+ (cond (al
+ (push (cdar al) lst))
+ ;; Convert 22.3a to 22.3.1.
+ ((string-match "^[-_+ ]?\\([a-zA-Z]\\)$" s)
+ (push (- (aref (downcase (match-string 1 s)) 0) ?a -1)
+ lst))
+ (t (error "Invalid version syntax: '%s'" ver))))))
(if (null lst)
(error "Invalid version syntax: '%s'" ver)
(nreverse lst)))))
diff --git a/lisp/tabify.el b/lisp/tabify.el
index c8cf877cb9..591a9432fe 100644
--- a/lisp/tabify.el
+++ b/lisp/tabify.el
@@ -4,6 +4,7 @@
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Maintainer: FSF
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/term.el b/lisp/term.el
index d5e0d149ae..80f5dcdc01 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -1231,8 +1231,7 @@ without any interpretation."
(if (featurep 'xemacs)
(term-send-raw-string
(or (condition-case () (x-get-selection) (error ()))
- (x-get-cutbuffer)
- (error "No selection or cut buffer available")))
+ (error "No selection available")))
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
(setq this-command 'yank)
diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el
index f73b3d7e67..dd386fe133 100644
--- a/lisp/term/ns-win.el
+++ b/lisp/term/ns-win.el
@@ -293,7 +293,7 @@ The properties returned may include `top', `left', `height', and `width'."
(unless (terminal-parameter frame 'x-setup-function-keys)
(with-selected-frame frame
(setq interprogram-cut-function 'x-select-text
- interprogram-paste-function 'x-cut-buffer-or-selection-value)
+ interprogram-paste-function 'x-selection-value)
(let ((map (copy-keymap ns-alternatives-map)))
(set-keymap-parent map (keymap-parent local-function-key-map))
(set-keymap-parent local-function-key-map map))
@@ -1003,7 +1003,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(defun ns-get-pasteboard ()
"Returns the value of the pasteboard."
- (ns-get-cut-buffer-internal 'PRIMARY))
+ (ns-get-cut-buffer-internal 'CLIPBOARD))
(declare-function ns-store-cut-buffer-internal "nsselect.m" (buffer string))
@@ -1011,27 +1011,25 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
"Store STRING into the pasteboard of the Nextstep display server."
;; Check the data type of STRING.
(if (not (stringp string)) (error "Nonstring given to pasteboard"))
- (ns-store-cut-buffer-internal 'PRIMARY string))
+ (ns-store-cut-buffer-internal 'CLIPBOARD string))
;; We keep track of the last text selected here, so we can check the
;; current selection against it, and avoid passing back our own text
-;; from x-cut-buffer-or-selection-value.
+;; from x-selection-value.
(defvar ns-last-selected-text nil)
-(defun x-select-text (text &optional push)
+(defun x-select-text (text)
"Select TEXT, a string, according to the window system.
-On X, put TEXT in the primary X selection. For backward
-compatibility with older X applications, set the value of X cut
-buffer 0 as well, and if the optional argument PUSH is non-nil,
-rotate the cut buffers. If `x-select-enable-clipboard' is
-non-nil, copy the text to the X clipboard as well.
+On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the
+clipboard. If `x-select-enable-primary' is non-nil, put TEXT in
+the primary selection.
On Windows, make TEXT the current selection. If
`x-select-enable-clipboard' is non-nil, copy the text to the
-clipboard as well. The argument PUSH is ignored.
+clipboard as well.
-On Nextstep, put TEXT in the pasteboard; PUSH is ignored."
+On Nextstep, put TEXT in the pasteboard."
;; Don't send the pasteboard too much text.
;; It becomes slow, and if really big it causes errors.
(ns-set-pasteboard text)
@@ -1040,11 +1038,10 @@ On Nextstep, put TEXT in the pasteboard; PUSH is ignored."
;; Return the value of the current Nextstep selection. For
;; compatibility with older Nextstep applications, this checks cut
;; buffer 0 before retrieving the value of the primary selection.
-(defun x-cut-buffer-or-selection-value ()
+(defun x-selection-value ()
(let (text)
- ;; Consult the selection, then the cut buffer. Treat empty strings
- ;; as if they were unset.
+ ;; Consult the selection. Treat empty strings as if they were unset.
(or text (setq text (ns-get-pasteboard)))
(if (string= text "") (setq text nil))
diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el
index d9d4e3851f..b52e408b19 100644
--- a/lisp/term/pc-win.el
+++ b/lisp/term/pc-win.el
@@ -192,11 +192,11 @@ the operating system.")
;; From lisp/term/w32-win.el
;
-;;;; Selections and cut buffers
+;;;; Selections
;
;;; We keep track of the last text selected here, so we can check the
;;; current selection against it, and avoid passing back our own text
-;;; from x-cut-buffer-or-selection-value.
+;;; from x-selection-value.
(defvar x-last-selected-text nil)
(defcustom x-select-enable-clipboard t
@@ -209,27 +209,24 @@ set by Emacs is not accessible to other programs on Windows.\)"
:type 'boolean
:group 'killing)
-(defun x-select-text (text &optional push)
+(defun x-select-text (text)
"Select TEXT, a string, according to the window system.
-On X, put TEXT in the primary X selection. For backward
-compatibility with older X applications, set the value of X cut
-buffer 0 as well, and if the optional argument PUSH is non-nil,
-rotate the cut buffers. If `x-select-enable-clipboard' is
-non-nil, copy the text to the X clipboard as well.
+On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the
+clipboard. If `x-select-enable-primary' is non-nil, put TEXT in
+the primary selection.
On Windows, make TEXT the current selection. If
`x-select-enable-clipboard' is non-nil, copy the text to the
-clipboard as well. The argument PUSH is ignored.
+clipboard as well.
-On Nextstep, put TEXT in the pasteboard; PUSH is ignored."
+On Nextstep, put TEXT in the pasteboard."
(if x-select-enable-clipboard
(w16-set-clipboard-data text))
(setq x-last-selected-text text))
;;; Return the value of the current selection.
-;;; Consult the selection, then the cut buffer. Treat empty strings
-;;; as if they were unset.
+;;; Consult the selection. Treat empty strings as if they were unset.
(defun x-get-selection-value ()
(if x-select-enable-clipboard
(let (text)
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index 65ba534de4..b19e0f854d 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -1192,32 +1192,19 @@ as returned by `x-server-vendor'."
;; #x0dde THAI MAIHANAKAT Thai
-;;;; Selections and cut buffers
+;;;; Selections
;; We keep track of the last text selected here, so we can check the
;; current selection against it, and avoid passing back our own text
-;; from x-cut-buffer-or-selection-value. We track all three
+;; from x-selection-value. We track both
;; separately in case another X application only sets one of them
-;; (say the cut buffer) we aren't fooled by the PRIMARY or
-;; CLIPBOARD selection staying the same.
+;; we aren't fooled by the PRIMARY or CLIPBOARD selection staying the same.
(defvar x-last-selected-text-clipboard nil
"The value of the CLIPBOARD X selection last time we selected or
pasted text.")
(defvar x-last-selected-text-primary nil
"The value of the PRIMARY X selection last time we selected or
pasted text.")
-(defvar x-last-selected-text-cut nil
- "The value of the X cut buffer last time we selected or pasted text.
-The actual text stored in the X cut buffer is what encoded from this value.")
-(defvar x-last-selected-text-cut-encoded nil
- "The value of the X cut buffer last time we selected or pasted text.
-This is the actual text stored in the X cut buffer.")
-(defvar x-last-cut-buffer-coding 'iso-latin-1
- "The coding we last used to encode/decode the text from the X cut buffer")
-
-(defvar x-cut-buffer-max 20000 ; Note this value is overridden below.
- "Max number of characters to put in the cut buffer.
-It is said that overlarge strings are slow to put into the cut buffer.")
(defcustom x-select-enable-clipboard t
"Non-nil means cutting and pasting uses the clipboard.
@@ -1232,29 +1219,20 @@ This is in addition to, but in preference to, the primary selection."
:group 'killing
:version "24.1")
-(defun x-select-text (text &optional push)
+(defun x-select-text (text)
"Select TEXT, a string, according to the window system.
-If `x-select-enable-clipboard' is non-nil, copy TEXT to the
+
+On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the
clipboard. If `x-select-enable-primary' is non-nil, put TEXT in
-the primary selection. For backward compatibility with older X
-applications, this function also sets the value of X cut buffer
-0, and, if the optional argument PUSH is non-nil, rotates the cut
-buffers."
+the primary selection.
+
+On Windows, make TEXT the current selection. If
+`x-select-enable-clipboard' is non-nil, copy the text to the
+clipboard as well.
+
+On Nextstep, put TEXT in the pasteboard."
;; With multi-tty, this function may be called from a tty frame.
(when (eq (framep (selected-frame)) 'x)
- ;; Don't send the cut buffer too much text.
- ;; It becomes slow, and if really big it causes errors.
- (cond ((>= (length text) x-cut-buffer-max)
- (x-set-cut-buffer "" push)
- (setq x-last-selected-text-cut ""
- x-last-selected-text-cut-encoded ""))
- (t
- (setq x-last-selected-text-cut text
- x-last-cut-buffer-coding 'iso-latin-1
- x-last-selected-text-cut-encoded
- ;; ICCCM says cut buffer always contain ISO-Latin-1
- (encode-coding-string text 'iso-latin-1))
- (x-set-cut-buffer x-last-selected-text-cut-encoded push)))
(when x-select-enable-primary
(x-set-selection 'PRIMARY text)
(setq x-last-selected-text-primary text))
@@ -1282,7 +1260,7 @@ The value nil is the same as this list:
;; The return value is already decoded. If x-get-selection causes an
;; error, this function return nil.
-(defun x-selection-value (type)
+(defun x-selection-value-internal (type)
(let ((request-type (or x-select-request-type
'(UTF8_STRING COMPOUND_TEXT STRING)))
text)
@@ -1300,17 +1278,16 @@ The value nil is the same as this list:
text))
;; Return the value of the current X selection.
-;; Consult the selection, and the cut buffer. Treat empty strings
-;; as if they were unset.
+;; Consult the selection. Treat empty strings as if they were unset.
;; If this function is called twice and finds the same text,
;; it returns nil the second time. This is so that a single
;; selection won't be added to the kill ring over and over.
-(defun x-cut-buffer-or-selection-value ()
+(defun x-selection-value ()
;; With multi-tty, this function may be called from a tty frame.
(when (eq (framep (selected-frame)) 'x)
- (let (clip-text primary-text cut-text)
+ (let (clip-text primary-text)
(when x-select-enable-clipboard
- (setq clip-text (x-selection-value 'CLIPBOARD))
+ (setq clip-text (x-selection-value-internal 'CLIPBOARD))
(if (string= clip-text "") (setq clip-text nil))
;; Check the CLIPBOARD selection for 'newness', is it different
@@ -1329,7 +1306,7 @@ The value nil is the same as this list:
(t (setq x-last-selected-text-clipboard clip-text)))))
(when x-select-enable-primary
- (setq primary-text (x-selection-value 'PRIMARY))
+ (setq primary-text (x-selection-value-internal 'PRIMARY))
;; Check the PRIMARY selection for 'newness', is it different
;; from what we remebered them to be last time we did a
;; cut/paste operation.
@@ -1346,69 +1323,35 @@ The value nil is the same as this list:
(t
(setq x-last-selected-text-primary primary-text)))))
- (setq cut-text (x-get-cut-buffer 0))
-
- ;; Check the x cut buffer for 'newness', is it different
- ;; from what we remebered them to be last time we did a
- ;; cut/paste operation.
- (setq cut-text
- (let ((next-coding (or next-selection-coding-system 'iso-latin-1)))
- (cond ;; check cut buffer
- ((or (not cut-text) (string= cut-text ""))
- (setq x-last-selected-text-cut nil))
- ;; This short cut doesn't work because x-get-cut-buffer
- ;; always returns a newly created string.
- ;; ((eq cut-text x-last-selected-text-cut) nil)
- ((and (string= cut-text x-last-selected-text-cut-encoded)
- (eq x-last-cut-buffer-coding next-coding))
- ;; See the comment above. No need of this recording.
- ;; Record the newer string,
- ;; so subsequent calls can use the `eq' test.
- ;; (setq x-last-selected-text-cut cut-text)
- nil)
- (t
- (setq x-last-selected-text-cut-encoded cut-text
- x-last-cut-buffer-coding next-coding
- x-last-selected-text-cut
- ;; ICCCM says cut buffer always contain ISO-Latin-1, but
- ;; use next-selection-coding-system if not nil.
- (decode-coding-string
- cut-text next-coding))))))
-
;; As we have done one selection, clear this now.
(setq next-selection-coding-system nil)
;; At this point we have recorded the current values for the
- ;; selection from clipboard (if we are supposed to) primary,
- ;; and cut buffer. So return the first one that has changed
+ ;; selection from clipboard (if we are supposed to) and primary.
+ ;; So return the first one that has changed
;; (which is the first non-null one).
;;
;; NOTE: There will be cases where more than one of these has
;; changed and the new values differ. This indicates that
;; something like the following has happened since the last time
;; we looked at the selections: Application X set all the
- ;; selections, then Application Y set only one or two of them (say
- ;; just the cut-buffer). In this case since we don't have
+ ;; selections, then Application Y set only one of them.
+ ;; In this case since we don't have
;; timestamps there is no way to know what the 'correct' value to
;; return is. The nice thing to do would be to tell the user we
;; saw multiple possible selections and ask the user which was the
;; one they wanted.
- ;; This code is still a big improvement because now the user can
- ;; futz with the current selection and get emacs to pay attention
- ;; to the cut buffer again (previously as soon as clipboard or
- ;; primary had been set the cut buffer would essentially never be
- ;; checked again).
- (or clip-text primary-text cut-text)
+ (or clip-text primary-text)
)))
;; Arrange for the kill and yank functions to set and check the clipboard.
(setq interprogram-cut-function 'x-select-text)
-(setq interprogram-paste-function 'x-cut-buffer-or-selection-value)
+(setq interprogram-paste-function 'x-selection-value)
(defun x-clipboard-yank ()
"Insert the clipboard contents, or the last stretch of killed text."
(interactive "*")
- (let ((clipboard-text (x-selection-value 'CLIPBOARD))
+ (let ((clipboard-text (x-selection-value-internal 'CLIPBOARD))
(x-select-enable-clipboard t))
(if (and clipboard-text (> (length clipboard-text) 0))
(kill-new clipboard-text))
@@ -1465,9 +1408,6 @@ The value nil is the same as this list:
;; are the initial display.
(eq initial-window-system 'x))
- (setq x-cut-buffer-max (min (- (/ (x-server-max-request-size) 2) 100)
- x-cut-buffer-max))
-
;; Create the default fontset.
(create-default-fontset)
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index e17cd9e5b2..0662acf2c5 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -9,7 +9,7 @@
;; Mike Newton <[email protected]>
;; Aaron Larson <[email protected]>
;; Dirk Herrmann <[email protected]>
-;; Maintainer: Roland Winkler <[email protected]>
+;; Maintainer: Roland Winkler <[email protected]>
;; Keywords: BibTeX, LaTeX, TeX
;; This file is part of GNU Emacs.
@@ -3027,12 +3027,14 @@ if that value is non-nil.
;; brace-delimited ones
)
nil
- (font-lock-syntactic-keywords . bibtex-font-lock-syntactic-keywords)
(font-lock-extra-managed-props . (category))
(font-lock-mark-block-function
. (lambda ()
(set-mark (bibtex-end-of-entry))
(bibtex-beginning-of-entry)))))
+ (set (make-local-variable 'syntax-propertize-function)
+ (syntax-propertize-via-font-lock
+ bibtex-font-lock-syntactic-keywords))
(setq imenu-generic-expression
(list (list nil bibtex-entry-head bibtex-key-in-head))
imenu-case-fold-search t)
diff --git a/lisp/textmodes/dns-mode.el b/lisp/textmodes/dns-mode.el
index fa011687c1..45ebc07d8b 100644
--- a/lisp/textmodes/dns-mode.el
+++ b/lisp/textmodes/dns-mode.el
@@ -227,5 +227,4 @@ This function is run from `before-save-hook'."
(provide 'dns-mode)
-;; arch-tag: 6a179f0a-072f-49db-8b01-37b8f23998c0
;;; dns-mode.el ends here
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
index a9eb45939b..be3fd5a178 100644
--- a/lisp/textmodes/fill.el
+++ b/lisp/textmodes/fill.el
@@ -5,6 +5,7 @@
;; Maintainer: FSF
;; Keywords: wp
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index e8a92b101e..8a73a0f818 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -199,9 +199,9 @@ Ispell's ultimate default dictionary."
(defcustom flyspell-check-tex-math-command nil
"Non-nil means check even inside TeX math environment.
-TeX math environments are discovered by the TEXMATHP that implemented
-inside the texmathp.el Emacs package. That package may be found at:
-http://strw.leidenuniv.nl/~dominik/Tools"
+TeX math environments are discovered by `texmathp', implemented
+inside AUCTeX package. That package may be found at
+URL `http://www.gnu.org/software/auctex/'"
:group 'flyspell
:type 'boolean)
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index ad591eb0e7..ad2838adaa 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -221,10 +221,10 @@ compatibility function in case `version<=' is not available."
(let (ver mver)
(if (string-match "[0-9]+" version start-ver)
(setq start-ver (match-end 0)
- ver (string-to-number (substring version (match-beginning 0) (match-end 0)))))
+ ver (string-to-number (match-string 0 version))))
(if (string-match "[0-9]+" minver start-mver)
(setq start-mver (match-end 0)
- mver (string-to-number (substring minver (match-beginning 0) (match-end 0)))))
+ mver (string-to-number (match-string 0 minver))))
(if (or ver mver)
(progn
@@ -310,7 +310,9 @@ Warning! Not checking comments, when a comment start is embedded in strings,
may produce undesired results."
:type '(choice (const exclusive) (const :tag "off" nil) (const :tag "on" t))
:group 'ispell)
-;;;###autoload(put 'ispell-check-comments 'safe-local-variable (lambda (a) (memq a '(nil t exclusive))))
+;;;###autoload
+(put 'ispell-check-comments 'safe-local-variable
+ (lambda (a) (memq a '(nil t exclusive))))
(defcustom ispell-query-replace-choices nil
"*Corrections made throughout region when non-nil.
@@ -514,7 +516,8 @@ is automatically set when defined in the file with either
:type '(choice string
(const :tag "default" nil))
:group 'ispell)
-;;;###autoload(put 'ispell-local-dictionary 'safe-local-variable 'string-or-null-p)
+;;;###autoload
+(put 'ispell-local-dictionary 'safe-local-variable 'string-or-null-p)
(make-variable-buffer-local 'ispell-local-dictionary)
@@ -738,8 +741,8 @@ Note that the CASECHARS and OTHERCHARS slots of the alist should
contain the same character set as casechars and otherchars in the
LANGUAGE.aff file \(e.g., english.aff\).")
-(defvar ispell-really-aspell nil) ; Non-nil if aspell extensions should be used
-(defvar ispell-really-hunspell nil) ; Non-nil if hunspell extensions should be used
+(defvar ispell-really-aspell nil) ; Non-nil if we can use aspell extensions.
+(defvar ispell-really-hunspell nil) ; Non-nil if we can use hunspell extensions.
(defvar ispell-encoding8-command nil
"Command line option prefix to select UTF-8 if supported, nil otherwise.
If UTF-8 if supported by spellchecker and is selectable from the command line
@@ -962,7 +965,8 @@ Internal use.")
(setq found (nconc found (list dict)))))
(setq ispell-aspell-dictionary-alist found)
;; Add a default entry
- (let ((default-dict '(nil "[[:alpha:]]" "[^[:alpha:]]" "[']" nil ("-B") nil utf-8)))
+ (let ((default-dict
+ '(nil "[[:alpha:]]" "[^[:alpha:]]" "[']" nil ("-B") nil utf-8)))
(push default-dict ispell-aspell-dictionary-alist))))
(defvar ispell-aspell-data-dir nil
@@ -1026,7 +1030,8 @@ Assumes that value contains no whitespace."
(defun ispell-aspell-add-aliases (alist)
"Find aspell's dictionary aliases and add them to dictionary ALIST.
Return the new dictionary alist."
- (let ((aliases (file-expand-wildcards
+ (let ((aliases
+ (file-expand-wildcards
(concat (or ispell-aspell-dict-dir
(setq ispell-aspell-dict-dir
(ispell-get-aspell-config-value "dict-dir")))
@@ -1111,26 +1116,24 @@ The variable `ispell-library-directory' defines the library location."
(let ((dicts (append ispell-local-dictionary-alist ispell-dictionary-alist))
(dict-list (cons "default" nil))
- name load-dict)
+ name dict-bname)
(dolist (dict dicts)
(setq name (car dict)
- load-dict (car (cdr (member "-d" (nth 5 dict)))))
+ dict-bname (or (car (cdr (member "-d" (nth 5 dict))))
+ name))
;; Include if the dictionary is in the library, or dir not defined.
(if (and
name
- ;; include all dictionaries if lib directory not known.
;; For Aspell, we already know which dictionaries exist.
(or ispell-really-aspell
+ ;; Include all dictionaries if lib directory not known.
+ ;; Same for Hunspell, where ispell-library-directory is nil.
(not ispell-library-directory)
(file-exists-p (concat ispell-library-directory
- "/" name ".hash"))
- (file-exists-p (concat ispell-library-directory "/" name ".has"))
- (and load-dict
- (or (file-exists-p (concat ispell-library-directory
- "/" load-dict ".hash"))
- (file-exists-p (concat ispell-library-directory
- "/" load-dict ".has"))))))
- (setq dict-list (cons name dict-list))))
+ "/" dict-bname ".hash"))
+ (file-exists-p (concat ispell-library-directory
+ "/" dict-bname ".has"))))
+ (push name dict-list)))
dict-list))
;;; define commands in menu in opposite order you want them to appear.
@@ -1168,7 +1171,8 @@ The variable `ispell-library-directory' defines the library location."
`(menu-item ,(purecopy "Complete Word") ispell-complete-word
:help ,(purecopy "Complete word at cursor using dictionary")))
(define-key ispell-menu-map [ispell-complete-word-interior-frag]
- `(menu-item ,(purecopy "Complete Word Fragment") ispell-complete-word-interior-frag
+ `(menu-item ,(purecopy "Complete Word Fragment")
+ ispell-complete-word-interior-frag
:help ,(purecopy "Complete word fragment at cursor")))))
;;;###autoload
@@ -1185,7 +1189,8 @@ The variable `ispell-library-directory' defines the library location."
`(menu-item ,(purecopy "Spell-Check Word") ispell-word
:help ,(purecopy "Spell-check word at cursor")))
(define-key ispell-menu-map [ispell-comments-and-strings]
- `(menu-item ,(purecopy "Spell-Check Comments") ispell-comments-and-strings
+ `(menu-item ,(purecopy "Spell-Check Comments")
+ ispell-comments-and-strings
:help ,(purecopy "Spell-check only comments and strings")))))
;;;###autoload
@@ -1334,9 +1339,6 @@ Protects against bogus binding of `enable-multibyte-characters' in XEmacs."
(defvar ispell-process-directory nil
"The directory where `ispell-process' was started.")
-(defvar ispell-process-buffer-name nil
- "The buffer where `ispell-process' was started.")
-
(defvar ispell-filter nil
"Output filter from piped calls to Ispell.")
@@ -1400,7 +1402,8 @@ The last occurring definition in the buffer will be used.")
(ispell-dictionary-keyword forward-line)
(ispell-pdict-keyword forward-line)
(ispell-parsing-keyword forward-line)
- (,(purecopy "^---*BEGIN PGP [A-Z ]*--*") . ,(purecopy "^---*END PGP [A-Z ]*--*"))
+ (,(purecopy "^---*BEGIN PGP [A-Z ]*--*")
+ . ,(purecopy "^---*END PGP [A-Z ]*--*"))
;; assume multiline uuencoded file? "\nM.*$"?
(,(purecopy "^begin [0-9][0-9][0-9] [^ \t]+$") . ,(purecopy "\nend\n"))
(,(purecopy "^%!PS-Adobe-[123].0") . ,(purecopy "\n%%EOF\n"))
@@ -1880,9 +1883,10 @@ Global `ispell-quit' set to start location to continue spell session."
;; setup the *Choices* buffer with valid data.
(with-current-buffer (get-buffer-create ispell-choices-buffer)
(setq mode-line-format
- (concat "-- %b -- word: " word
- " -- dict: " (or ispell-current-dictionary "default")
- " -- prog: " (file-name-nondirectory ispell-program-name)))
+ (concat
+ "-- %b -- word: " word
+ " -- dict: " (or ispell-current-dictionary "default")
+ " -- prog: " (file-name-nondirectory ispell-program-name)))
;; XEmacs: no need for horizontal scrollbar in choices window
(with-no-warnings
(and (fboundp 'set-specifier)
@@ -2280,8 +2284,9 @@ if defined."
(unless (file-readable-p lookup-dict)
(error "lookup-words error: Unreadable or missing plain word-list %s."
lookup-dict))
- (error (concat "lookup-words error: No plain word-list found at system default "
- "locations. Customize `ispell-alternate-dictionary' to set yours.")))
+ (error (concat "lookup-words error: No plain word-list found at system"
+ "default locations. "
+ "Customize `ispell-alternate-dictionary' to set yours.")))
(let* ((process-connection-type ispell-use-ptys-p)
(wild-p (string-match "\\*" word))
@@ -2332,16 +2337,16 @@ if defined."
results))
-;;; "ispell-filter" is a list of output lines from the generating function.
-;;; Each full line (ending with \n) is a separate item on the list.
-;;; "output" can contain multiple lines, part of a line, or both.
-;;; "start" and "end" are used to keep bounds on lines when "output" contains
-;;; multiple lines.
-;;; "ispell-filter-continue" is true when we have received only part of a
-;;; line as output from a generating function ("output" did not end with \n)
-;;; THIS FUNCTION WILL FAIL IF THE PROCESS OUTPUT DOESN'T END WITH \n!
-;;; This is the case when a process dies or fails. The default behavior
-;;; in this case treats the next input received as fresh input.
+;; "ispell-filter" is a list of output lines from the generating function.
+;; Each full line (ending with \n) is a separate item on the list.
+;; "output" can contain multiple lines, part of a line, or both.
+;; "start" and "end" are used to keep bounds on lines when "output" contains
+;; multiple lines.
+;; "ispell-filter-continue" is true when we have received only part of a
+;; line as output from a generating function ("output" did not end with \n)
+;; THIS FUNCTION WILL FAIL IF THE PROCESS OUTPUT DOESN'T END WITH \n!
+;; This is the case when a process dies or fails. The default behavior
+;; in this case treats the next input received as fresh input.
(defun ispell-filter (process output)
"Output filter function for ispell, grep, and look."
@@ -2573,37 +2578,35 @@ When asynchronous processes are not supported, `run' is always returned."
(defun ispell-start-process ()
"Start the ispell process, with support for no asynchronous processes.
Keeps argument list for future ispell invocations for no async support."
- (let ((default-directory default-directory)
- args)
- (unless (and (file-directory-p default-directory)
- (file-readable-p default-directory))
- ;; Defend against bad `default-directory'.
- (setq default-directory (expand-file-name "~/")))
- ;; Local dictionary becomes the global dictionary in use.
- (setq ispell-current-dictionary
- (or ispell-local-dictionary ispell-dictionary))
- (setq ispell-current-personal-dictionary
- (or ispell-local-pdict ispell-personal-dictionary))
- (setq args (ispell-get-ispell-args))
- (if (and ispell-current-dictionary ; use specified dictionary
- (not (member "-d" args))) ; only define if not overridden
- (setq args
- (append (list "-d" ispell-current-dictionary) args)))
- (if ispell-current-personal-dictionary ; use specified pers dict
- (setq args
- (append args
- (list "-p"
- (expand-file-name ispell-current-personal-dictionary)))))
-
- ;; If we are using recent aspell or hunspell, make sure we use the right encoding
- ;; for communication. ispell or older aspell/hunspell does not support this
- (if ispell-encoding8-command
- (setq args
- (append args
- (list
- (concat ispell-encoding8-command
- (symbol-name (ispell-get-coding-system)))))))
- (setq args (append args ispell-extra-args))
+ ;; Local dictionary becomes the global dictionary in use.
+ (setq ispell-current-dictionary
+ (or ispell-local-dictionary ispell-dictionary))
+ (setq ispell-current-personal-dictionary
+ (or ispell-local-pdict ispell-personal-dictionary))
+ (let* ((default-directory
+ (if (and (file-directory-p default-directory)
+ (file-readable-p default-directory))
+ default-directory
+ ;; Defend against bad `default-directory'.
+ (expand-file-name "~/")))
+ (orig-args (ispell-get-ispell-args))
+ (args
+ (append
+ (if (and ispell-current-dictionary ; Not for default dict (nil)
+ (not (member "-d" orig-args))) ; Only define if not overridden.
+ (list "-d" ispell-current-dictionary))
+ orig-args
+ (if ispell-current-personal-dictionary ; Use specified pers dict.
+ (list "-p"
+ (expand-file-name ispell-current-personal-dictionary)))
+ ;; If we are using recent aspell or hunspell, make sure we use the
+ ;; right encoding for communication. ispell or older aspell/hunspell
+ ;; does not support this.
+ (if ispell-encoding8-command
+ (list
+ (concat ispell-encoding8-command
+ (symbol-name (ispell-get-coding-system)))))
+ ispell-extra-args)))
;; Initially we don't know any buffer's local words.
(setq ispell-buffer-local-name nil)
@@ -2612,9 +2615,11 @@ Keeps argument list for future ispell invocations for no async support."
(let ((process-connection-type ispell-use-ptys-p))
(apply 'start-process
"ispell" nil ispell-program-name
- "-a" ; accept single input lines
- (if ispell-really-hunspell "" "-m") ; make root/affix combos not in dict
- args)) ; hunspell -m option means different
+ "-a" ; Accept single input lines.
+ ;; Make root/affix combos not in dict.
+ ;; hunspell -m option means different.
+ (if ispell-really-hunspell "" "-m")
+ args))
(setq ispell-cmd-args args
ispell-output-buffer (generate-new-buffer " *ispell-output*")
ispell-session-buffer (generate-new-buffer " *ispell-session*"))
@@ -2622,79 +2627,112 @@ Keeps argument list for future ispell invocations for no async support."
t)))
-
(defun ispell-init-process ()
"Check status of Ispell process and start if necessary."
- (if (and ispell-process
- (eq (ispell-process-status) 'run)
- ;; Unless we are using an explicit personal dictionary,
- ;; ensure we're in the same default directory!
- ;; Restart check for personal dictionary is done in
- ;; `ispell-internal-change-dictionary', called from `ispell-buffer-local-dict'
- (or (or ispell-local-pdict ispell-personal-dictionary)
- (equal ispell-process-directory (expand-file-name default-directory))))
- (setq ispell-filter nil ispell-filter-continue nil)
- ;; may need to restart to select new personal dictionary.
- (ispell-kill-ispell t)
- (message "Starting new Ispell process [%s] ..."
- (or ispell-local-dictionary ispell-dictionary "default"))
- (sit-for 0)
- (setq ispell-library-directory (ispell-check-version)
- ispell-process (ispell-start-process)
- ispell-filter nil
- ispell-filter-continue nil)
- ;; When spellchecking minibuffer contents, make sure ispell process
- ;; is not restarted every time the minibuffer is killed.
- (if (window-minibuffer-p)
- (if (fboundp 'minibuffer-selected-window)
- ;; Assign ispell process to parent buffer
- (setq ispell-process-directory (expand-file-name default-directory)
- ispell-process-buffer-name (window-buffer (minibuffer-selected-window)))
- ;; Force `ispell-process-directory' to $HOME and use a dummy name
- (setq ispell-process-directory (expand-file-name "~/")
- ispell-process-buffer-name " * Minibuffer-has-spellcheck-enabled"))
- ;; Not in a minibuffer
- (setq ispell-process-directory (expand-file-name default-directory)
- ispell-process-buffer-name (buffer-name)))
- (if ispell-async-processp
- (set-process-filter ispell-process 'ispell-filter))
- ;; protect against bogus binding of `enable-multibyte-characters' in XEmacs
- (if (and (or (featurep 'xemacs)
- (and (boundp 'enable-multibyte-characters)
- enable-multibyte-characters))
- (fboundp 'set-process-coding-system))
- (set-process-coding-system ispell-process (ispell-get-coding-system)
- (ispell-get-coding-system)))
- ;; Get version ID line
- (ispell-accept-output 3)
- ;; get more output if filter empty?
- (if (null ispell-filter) (ispell-accept-output 3))
- (cond ((null ispell-filter)
- (error "%s did not output version line" ispell-program-name))
- ((and
- (stringp (car ispell-filter))
- (if (string-match "warning: " (car ispell-filter))
- (progn
- (ispell-accept-output 3) ; was warn msg.
- (stringp (car ispell-filter)))
- (null (cdr ispell-filter)))
- (string-match "^@(#) " (car ispell-filter)))
- ;; got the version line as expected (we already know it's the right
- ;; version, so don't bother checking again.)
- nil)
- (t
- ;; Otherwise, it must be an error message. Show the user.
- ;; But first wait to see if some more output is going to arrive.
- ;; Otherwise we get cool errors like "Can't open ".
- (sleep-for 1)
- (ispell-accept-output 3)
- (error "%s" (mapconcat 'identity ispell-filter "\n"))))
- (setq ispell-filter nil) ; Discard version ID line
- (let ((extended-char-mode (ispell-get-extended-character-mode)))
- (if extended-char-mode ; ~ extended character mode
- (ispell-send-string (concat extended-char-mode "\n"))))
- (if ispell-async-processp
- (set-process-query-on-exit-flag ispell-process nil))))
+ (let* (;; Basename of dictionary used by the spell-checker
+ (dict-bname (or (car (cdr (member "-d" (ispell-get-ispell-args))))
+ ispell-current-dictionary))
+ ;; Use "~/" as default-directory unless using Ispell with per-dir
+ ;; personal dictionaries and not in a minibuffer under XEmacs
+ (default-directory
+ (if (or ispell-really-aspell
+ ispell-really-hunspell
+ ;; Protect against bad default-directory
+ (not (and (file-directory-p default-directory)
+ (file-readable-p default-directory)))
+ ;; Ispell and per-dir personal dicts available
+ (not (or (file-readable-p (concat default-directory
+ ".ispell_words"))
+ (file-readable-p (concat default-directory
+ ".ispell_"
+ (or dict-bname
+ "default")))))
+ ;; Ispell, in a minibuffer, and XEmacs
+ (and (window-minibuffer-p)
+ (not (fboundp 'minibuffer-selected-window))))
+ (expand-file-name "~/")
+ (expand-file-name default-directory))))
+ ;; Check if process needs restart
+ (if (and ispell-process
+ (eq (ispell-process-status) 'run)
+ ;; Unless we are using an explicit personal dictionary, ensure
+ ;; we're in the same default directory! Restart check for
+ ;; personal dictionary is done in
+ ;; `ispell-internal-change-dictionary', called from
+ ;; `ispell-buffer-local-dict'
+ (or (or ispell-local-pdict ispell-personal-dictionary)
+ (equal ispell-process-directory default-directory)))
+ (setq ispell-filter nil ispell-filter-continue nil)
+ ;; may need to restart to select new personal dictionary.
+ (ispell-kill-ispell t)
+ (message "Starting new Ispell process [%s] ..."
+ (or ispell-local-dictionary ispell-dictionary "default"))
+ (sit-for 0)
+ (setq ispell-library-directory (ispell-check-version)
+ ispell-process (ispell-start-process)
+ ispell-filter nil
+ ispell-filter-continue nil
+ ispell-process-directory default-directory)
+
+ (unless (equal ispell-process-directory (expand-file-name "~/"))
+ ;; At this point, `ispell-process-directory' will be "~/" unless using
+ ;; Ispell with directory-specific dicts and not in XEmacs minibuffer.
+ ;; If not, kill ispell process when killing buffer. It may be in a
+ ;; removable device that would otherwise become un-mountable.
+ (with-current-buffer
+ (if (and (window-minibuffer-p) ;; In minibuffer
+ (fboundp 'minibuffer-selected-window)) ;; Not XEmacs.
+ ;; In this case kill ispell only when parent buffer is killed
+ ;; to avoid over and over ispell kill.
+ (window-buffer (minibuffer-selected-window))
+ (current-buffer))
+ ;; 'local does not automatically make hook buffer-local in XEmacs.
+ (if (featurep 'xemacs)
+ (make-local-hook 'kill-buffer-hook))
+ (add-hook 'kill-buffer-hook
+ (lambda () (ispell-kill-ispell t)) nil 'local)))
+
+ (if ispell-async-processp
+ (set-process-filter ispell-process 'ispell-filter))
+ ;; Protect against XEmacs bogus binding of `enable-multibyte-characters'.
+ (if (and (or (featurep 'xemacs)
+ (and (boundp 'enable-multibyte-characters)
+ enable-multibyte-characters))
+ (fboundp 'set-process-coding-system))
+ (set-process-coding-system ispell-process (ispell-get-coding-system)
+ (ispell-get-coding-system)))
+ ;; Get version ID line
+ (ispell-accept-output 3)
+ ;; get more output if filter empty?
+ (if (null ispell-filter) (ispell-accept-output 3))
+ (cond ((null ispell-filter)
+ (error "%s did not output version line" ispell-program-name))
+ ((and
+ (stringp (car ispell-filter))
+ (if (string-match "warning: " (car ispell-filter))
+ (progn
+ (ispell-accept-output 3) ; was warn msg.
+ (stringp (car ispell-filter)))
+ (null (cdr ispell-filter)))
+ (string-match "^@(#) " (car ispell-filter)))
+ ;; got the version line as expected (we already know it's the right
+ ;; version, so don't bother checking again.)
+ nil)
+ (t
+ ;; Otherwise, it must be an error message. Show the user.
+ ;; But first wait to see if some more output is going to arrive.
+ ;; Otherwise we get cool errors like "Can't open ".
+ (sleep-for 1)
+ (ispell-accept-output 3)
+ (error "%s" (mapconcat 'identity ispell-filter "\n"))))
+ (setq ispell-filter nil) ; Discard version ID line
+ (let ((extended-char-mode (ispell-get-extended-character-mode)))
+ (if extended-char-mode ; ~ extended character mode
+ (ispell-send-string (concat extended-char-mode "\n"))))
+ (if ispell-async-processp
+ (if (fboundp 'set-process-query-on-exit-flag) ;; not XEmacs
+ (set-process-query-on-exit-flag ispell-process nil)
+ (process-kill-without-query ispell-process))))))
;;;###autoload
(defun ispell-kill-ispell (&optional no-error)
@@ -2716,17 +2754,10 @@ With NO-ERROR, just return non-nil if there was no Ispell running."
(kill-buffer ispell-session-buffer)
(setq ispell-output-buffer nil
ispell-session-buffer nil))
- (setq ispell-process-buffer-name nil)
(setq ispell-process nil)
(message "Ispell process killed")
nil))
-;; Kill ispell process when killing its associated buffer
-(add-hook 'kill-buffer-hook
- '(lambda ()
- (if (equal ispell-process-buffer-name (buffer-name))
- (ispell-kill-ispell t))))
-
;;; ispell-change-dictionary is set in some people's hooks. Maybe this should
;;; call ispell-init-process rather than wait for a spell checking command?
@@ -2823,9 +2854,10 @@ Return nil if spell session is quit,
(set-marker skip-region-start (- (point) (length key)))
(goto-char reg-start)))
(let (message-log-max)
- (message "Continuing spelling check using %s with %s dictionary..."
- (file-name-nondirectory ispell-program-name)
- (or ispell-current-dictionary "default")))
+ (message
+ "Continuing spelling check using %s with %s dictionary..."
+ (file-name-nondirectory ispell-program-name)
+ (or ispell-current-dictionary "default")))
(set-marker rstart reg-start)
(set-marker ispell-region-end reg-end)
(while (and (not ispell-quit)
@@ -3090,9 +3122,9 @@ Point is placed at end of skipped region."
(sit-for 2)))))
-;;; Grab the next line of data.
-;;; Returns a string with the line data
(defun ispell-get-line (start end in-comment)
+ "Grab the next line of data.
+Returns a string with the line data."
(let ((ispell-casechars (ispell-get-casechars))
string)
(cond ; LOOK AT THIS LINE AND SKIP OR PROCESS
@@ -3119,7 +3151,8 @@ Point is placed at end of skipped region."
(point) (+ (point) len))
coding)))))
-;;; Avoid error messages when compiling for these dynamic variables.
+;; Avoid error messages when compiling for these dynamic variables.
+;; FIXME: dynamically scoped vars should have an "ispell-" prefix.
(defvar start)
(defvar end)
@@ -3254,10 +3287,12 @@ Returns the sum SHIFT due to changes in word replacements."
;; (length (car poss)))))
))
(if (not ispell-quit)
+ ;; FIXME: remove redundancy with identical code above.
(let (message-log-max)
- (message "Continuing spelling check using %s with %s dictionary..."
- (file-name-nondirectory ispell-program-name)
- (or ispell-current-dictionary "default"))))
+ (message
+ "Continuing spelling check using %s with %s dictionary..."
+ (file-name-nondirectory ispell-program-name)
+ (or ispell-current-dictionary "default"))))
(sit-for 0)
(setq start (marker-position line-start)
end (marker-position line-end))
@@ -3330,7 +3365,7 @@ Returns the sum SHIFT due to changes in word replacements."
;;; Interactive word completion.
-;;; Forces "previous-word" processing. Do we want to make this selectable?
+;; Forces "previous-word" processing. Do we want to make this selectable?
;;;###autoload
(defun ispell-complete-word (&optional interior-frag)
diff --git a/lisp/textmodes/nroff-mode.el b/lisp/textmodes/nroff-mode.el
index 61ea89582b..14b0b106bb 100644
--- a/lisp/textmodes/nroff-mode.el
+++ b/lisp/textmodes/nroff-mode.el
@@ -55,6 +55,7 @@
(define-key map "\n" 'nroff-electric-newline)
(define-key map "\en" 'nroff-forward-text-line)
(define-key map "\ep" 'nroff-backward-text-line)
+ (define-key map "\C-c\C-c" 'nroff-view)
(define-key map [menu-bar nroff-mode] (cons "Nroff" menu-map))
(define-key menu-map [nn]
'(menu-item "Newline" nroff-electric-newline
@@ -73,6 +74,9 @@
nroff-electric-mode
:help "Auto insert closing requests if necessary"
:button (:toggle . nroff-electric-mode)))
+ (define-key menu-map [npm]
+ '(menu-item "Preview as man page" nroff-view
+ :help "Run man on this file."))
map)
"Major mode keymap for `nroff-mode'.")
@@ -301,6 +305,17 @@ turns it on if arg is positive, otherwise off."
:lighter " Electric"
(or (derived-mode-p 'nroff-mode) (error "Must be in nroff mode")))
+(declare-function Man-getpage-in-background "man" (topic))
+
+(defun nroff-view ()
+ "Run man on this file."
+ (interactive)
+ (require 'man)
+ (let* ((file (buffer-file-name)))
+ (if file
+ (Man-getpage-in-background file)
+ (error "No associated file for the current buffer"))))
+
;; Old names that were not namespace clean.
(define-obsolete-function-alias 'count-text-lines 'nroff-count-text-lines "22.1")
(define-obsolete-function-alias 'forward-text-line 'nroff-forward-text-line "22.1")
diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el
index a672dc9215..e85c083538 100644
--- a/lisp/textmodes/page.el
+++ b/lisp/textmodes/page.el
@@ -1,3 +1,10 @@
+;; (push-mark (point) t) needed at the end of forward-page
+;; The documentation in simple.el for set-mark says
+;; To remember a location for internal use in the Lisp program,
+;; store it in a Lisp variable. Example:
+;; (let ((beg (point))) (forward-line 1) (delete-region beg (point)))."
+
+
;;; page.el --- page motion commands for Emacs
;; Copyright (C) 1985, 2001, 2002, 2003, 2004, 2005,
@@ -5,6 +12,7 @@
;; Maintainer: FSF
;; Keywords: wp convenience
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el
index 2c698a836f..4f1bcefa90 100644
--- a/lisp/textmodes/paragraphs.el
+++ b/lisp/textmodes/paragraphs.el
@@ -6,6 +6,7 @@
;; Maintainer: FSF
;; Keywords: wp
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/textmodes/reftex-auc.el b/lisp/textmodes/reftex-auc.el
index 374ac990cc..89e8d26bc6 100644
--- a/lisp/textmodes/reftex-auc.el
+++ b/lisp/textmodes/reftex-auc.el
@@ -6,6 +6,7 @@
;; Author: Carsten Dominik <[email protected]>
;; Maintainer: [email protected]
;; Version: 4.31
+;; Package: reftex
;; This file is part of GNU Emacs.
diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el
index 3972a1df31..79797b4791 100644
--- a/lisp/textmodes/reftex-cite.el
+++ b/lisp/textmodes/reftex-cite.el
@@ -6,6 +6,7 @@
;; Author: Carsten Dominik <[email protected]>
;; Maintainer: [email protected]
;; Version: 4.31
+;; Package: reftex
;; This file is part of GNU Emacs.
diff --git a/lisp/textmodes/reftex-dcr.el b/lisp/textmodes/reftex-dcr.el
index d15cf3f993..39fc0f4a81 100644
--- a/lisp/textmodes/reftex-dcr.el
+++ b/lisp/textmodes/reftex-dcr.el
@@ -6,6 +6,7 @@
;; Author: Carsten Dominik <[email protected]>
;; Maintainer: [email protected]
;; Version: 4.31
+;; Package: reftex
;; This file is part of GNU Emacs.
diff --git a/lisp/textmodes/reftex-global.el b/lisp/textmodes/reftex-global.el
index 22e8a577d9..dc533185b2 100644
--- a/lisp/textmodes/reftex-global.el
+++ b/lisp/textmodes/reftex-global.el
@@ -6,6 +6,7 @@
;; Author: Carsten Dominik <[email protected]>
;; Maintainer: [email protected]
;; Version: 4.31
+;; Package: reftex
;; This file is part of GNU Emacs.
diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el
index 35cae5ae87..dee7a31926 100644
--- a/lisp/textmodes/reftex-index.el
+++ b/lisp/textmodes/reftex-index.el
@@ -6,6 +6,7 @@
;; Author: Carsten Dominik <[email protected]>
;; Maintainer: [email protected]
;; Version: 4.31
+;; Package: reftex
;; This file is part of GNU Emacs.
diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el
index dc03a38708..58aaaa47a3 100644
--- a/lisp/textmodes/reftex-parse.el
+++ b/lisp/textmodes/reftex-parse.el
@@ -6,6 +6,7 @@
;; Author: Carsten Dominik <[email protected]>
;; Maintainer: [email protected]
;; Version: 4.31
+;; Package: reftex
;; This file is part of GNU Emacs.
diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el
index b186a1ea71..23723489d1 100644
--- a/lisp/textmodes/reftex-ref.el
+++ b/lisp/textmodes/reftex-ref.el
@@ -6,6 +6,7 @@
;; Author: Carsten Dominik <[email protected]>
;; Maintainer: [email protected]
;; Version: 4.31
+;; Package: reftex
;; This file is part of GNU Emacs.
diff --git a/lisp/textmodes/reftex-sel.el b/lisp/textmodes/reftex-sel.el
index 90dc01a6bb..bebeb1cd51 100644
--- a/lisp/textmodes/reftex-sel.el
+++ b/lisp/textmodes/reftex-sel.el
@@ -6,6 +6,7 @@
;; Author: Carsten Dominik <[email protected]>
;; Maintainer: [email protected]
;; Version: 4.31
+;; Package: reftex
;; This file is part of GNU Emacs.
diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el
index ae1690416b..41ea83b077 100644
--- a/lisp/textmodes/reftex-toc.el
+++ b/lisp/textmodes/reftex-toc.el
@@ -6,6 +6,7 @@
;; Author: Carsten Dominik <[email protected]>
;; Maintainer: [email protected]
;; Version: 4.31
+;; Package: reftex
;; This file is part of GNU Emacs.
diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el
index ce0ac32492..5b83e7a43a 100644
--- a/lisp/textmodes/reftex-vars.el
+++ b/lisp/textmodes/reftex-vars.el
@@ -6,6 +6,7 @@
;; Author: Carsten Dominik <[email protected]>
;; Maintainer: [email protected]
;; Version: 4.31
+;; Package: reftex
;; This file is part of GNU Emacs.
diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el
index b4b0a281ca..2a2e725e92 100644
--- a/lisp/textmodes/reftex.el
+++ b/lisp/textmodes/reftex.el
@@ -599,7 +599,6 @@ on the menu bar.
(defvar font-lock-mode)
(defvar font-lock-keywords)
(defvar font-lock-fontify-region-function)
-(defvar font-lock-syntactic-keywords)
;;; =========================================================================
;;;
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 87ffecd5d5..bc1af67d58 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -293,11 +293,12 @@ Any terminating `>' or `/' is not matched.")
(defvar sgml-font-lock-keywords sgml-font-lock-keywords-1
"*Rules for highlighting SGML code. See also `sgml-tag-face-alist'.")
-(defvar sgml-font-lock-syntactic-keywords
+(defconst sgml-syntax-propertize-function
+ (syntax-propertize-rules
;; Use the `b' style of comments to avoid interference with the -- ... --
;; comments recognized when `sgml-specials' includes ?-.
;; FIXME: beware of <!--> blabla <!--> !!
- '(("\\(<\\)!--" (1 "< b"))
+ ("\\(<\\)!--" (1 "< b"))
("--[ \t\n]*\\(>\\)" (1 "> b"))
;; Double quotes outside of tags should not introduce strings.
;; Be careful to call `syntax-ppss' on a position before the one we're
@@ -477,9 +478,9 @@ Do \\[describe-key] on the following bindings to discover what they do.
'((sgml-font-lock-keywords
sgml-font-lock-keywords-1
sgml-font-lock-keywords-2)
- nil t nil nil
- (font-lock-syntactic-keywords
- . sgml-font-lock-syntactic-keywords)))
+ nil t))
+ (set (make-local-variable 'syntax-propertize-function)
+ sgml-syntax-propertize-function)
(set (make-local-variable 'facemenu-add-face-function)
'sgml-mode-facemenu-add-face-function)
(set (make-local-variable 'sgml-xml-mode) (sgml-xml-guess))
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index da0c5396f2..81a3816c1e 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -488,7 +488,7 @@ An alternative value is \" . \", if you use a font with a narrow period."
;; (arg "\\(?:{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)\\|\\\\[a-z*]+\\)"))
(arg "{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)"))
(list
- ;; font-lock-syntactic-keywords causes the \ of \end{verbatim} to be
+ ;; tex-font-lock-syntactic-keywords causes the \ of \end{verbatim} to be
;; highlighted as tex-verbatim face. Let's undo that.
;; This is ugly and brittle :-( --Stef
'("^\\(\\\\\\)end" (1 (get-text-property (match-end 1) 'face) t))
@@ -655,6 +655,7 @@ An alternative value is \" . \", if you use a font with a narrow period."
;; line is re-font-locked on its own.
;; There's a hack in tex-font-lock-keywords-1 to remove the verbatim
;; face from the \ but C-M-f still jumps to the wrong spot :-( --Stef
+ ;; FIXME: See gud.el for an example of a solution to a similar problem.
(eval . `(,(concat "^\\(\\\\\\)end *{"
(regexp-opt tex-verbatim-environments t)
"}\\(.?\\)") (1 "|") (3 "<")))
@@ -1163,10 +1164,9 @@ Entering SliTeX mode runs the hook `text-mode-hook', then the hook
(font-lock-syntactic-face-function
. tex-font-lock-syntactic-face-function)
(font-lock-unfontify-region-function
- . tex-font-lock-unfontify-region)
- (font-lock-syntactic-keywords
- . tex-font-lock-syntactic-keywords)
- (parse-sexp-lookup-properties . t)))
+ . tex-font-lock-unfontify-region)))
+ (set (make-local-variable 'syntax-propertize-function)
+ (syntax-propertize-via-font-lock tex-font-lock-syntactic-keywords))
;; TABs in verbatim environments don't do what you think.
(set (make-local-variable 'indent-tabs-mode) nil)
;; Other vars that should be buffer-local.
@@ -2850,12 +2850,12 @@ There might be text before point."
(mapcar
(lambda (x)
(case (car-safe x)
- (font-lock-syntactic-keywords
- (cons (car x) 'doctex-font-lock-syntactic-keywords))
(font-lock-syntactic-face-function
(cons (car x) 'doctex-font-lock-syntactic-face-function))
(t x)))
- (cdr font-lock-defaults)))))
+ (cdr font-lock-defaults))))
+ (set (make-local-variable 'syntax-propertize-function)
+ (syntax-propertize-via-font-lock doctex-font-lock-syntactic-keywords)))
(run-hooks 'tex-mode-load-hook)
diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el
index 7c71acd044..be23a439bf 100644
--- a/lisp/textmodes/texinfo.el
+++ b/lisp/textmodes/texinfo.el
@@ -310,10 +310,11 @@ chapter."
("Chapters" "^@chapter[ \t]+\\(.*\\)$" 1))
"Imenu generic expression for Texinfo mode. See `imenu-generic-expression'.")
-(defvar texinfo-font-lock-syntactic-keywords
- '(("\\(@\\)c\\(omment\\)?\\>" (1 "<"))
- ("^\\(@\\)ignore\\>" (1 "< b"))
- ("^@end ignore\\(\n\\)" (1 "> b")))
+(defconst texinfo-syntax-propertize-function
+ (syntax-propertize-rules
+ ("\\(@\\)c\\(omment\\)?\\>" (1 "<"))
+ ("^\\(@\\)ignore\\>" (1 "< b"))
+ ("^@end ignore\\(\n\\)" (1 "> b")))
"Syntactic keywords to catch comment delimiters in `texinfo-mode'.")
(defconst texinfo-environments
@@ -600,9 +601,9 @@ value of `texinfo-mode-hook'."
(setq imenu-case-fold-search nil)
(make-local-variable 'font-lock-defaults)
(setq font-lock-defaults
- '(texinfo-font-lock-keywords nil nil nil backward-paragraph
- (font-lock-syntactic-keywords
- . texinfo-font-lock-syntactic-keywords)))
+ '(texinfo-font-lock-keywords nil nil nil backward-paragraph))
+ (set (make-local-variable 'syntax-propertize-function)
+ texinfo-syntax-propertize-function)
(set (make-local-variable 'parse-sexp-lookup-properties) t)
;; Outline settings.
diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el
index 51040824b2..b6868d3a8e 100644
--- a/lisp/textmodes/text-mode.el
+++ b/lisp/textmodes/text-mode.el
@@ -5,6 +5,7 @@
;; Maintainer: FSF
;; Keywords: wp
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el
index 4b83b07754..98aaa8fe50 100644
--- a/lisp/tool-bar.el
+++ b/lisp/tool-bar.el
@@ -5,6 +5,7 @@
;;
;; Author: Dave Love <[email protected]>
;; Keywords: mouse frames
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/tooltip.el b/lisp/tooltip.el
index 344f01fa4c..5987b00f92 100644
--- a/lisp/tooltip.el
+++ b/lisp/tooltip.el
@@ -5,6 +5,7 @@
;; Author: Gerd Moellmann <[email protected]>
;; Keywords: help c mouse tools
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/tutorial.el b/lisp/tutorial.el
index 15dfe86a8d..6961fafb3a 100644
--- a/lisp/tutorial.el
+++ b/lisp/tutorial.el
@@ -4,6 +4,7 @@
;; Maintainer: FSF
;; Keywords: help, internal
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/uniquify.el b/lisp/uniquify.el
index 27093042ef..a654b2dcfc 100644
--- a/lisp/uniquify.el
+++ b/lisp/uniquify.el
@@ -7,6 +7,7 @@
;; Maintainer: FSF
;; Keywords: files
;; Created: 15 May 86
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index e3f76e72e3..170bedd3b2 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,8 @@
+2010-09-11 Glenn Morris <[email protected]>
+
+ * url-cache.el, url-gw.el, url-history.el, url-irc.el, url-util.el:
+ * url-vars.el: Remove leading `*' from defcustom docs.
+
2010-07-27 Michael Albinus <[email protected]>
* url-http (url-http-parse-headers): Disable file name handlers at
diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el
index 71841c9a0c..7cff9aa923 100644
--- a/lisp/url/url-cache.el
+++ b/lisp/url/url-cache.el
@@ -1,7 +1,7 @@
;;; url-cache.el --- Uniform Resource Locator retrieval tool
-;; Copyright (C) 1996, 1997, 1998, 1999, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007, 2008,
+;; 2009, 2010 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
@@ -28,7 +28,7 @@
(defcustom url-cache-directory
(expand-file-name "cache" url-configuration-directory)
- "*The directory where cache files should be stored."
+ "The directory where cache files should be stored."
:type 'directory
:group 'url-file)
@@ -165,7 +165,7 @@ Very fast if you have an `md5' primitive function, suitably fast otherwise."
url-cache-directory))))))
(defcustom url-cache-creation-function 'url-cache-create-filename-using-md5
- "*What function to use to create a cached filename."
+ "What function to use to create a cached filename."
:type '(choice (const :tag "MD5 of filename (low collision rate)"
:value url-cache-create-filename-using-md5)
(const :tag "Human readable filenames (higher collision rate)"
diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el
index 9915ccc678..714d12f3f1 100644
--- a/lisp/url/url-gw.el
+++ b/lisp/url/url-gw.el
@@ -37,50 +37,50 @@
:group 'url)
(defcustom url-gateway-local-host-regexp nil
- "*A regular expression specifying local hostnames/machines."
+ "A regular expression specifying local hostnames/machines."
:type '(choice (const nil) regexp)
:group 'url-gateway)
(defcustom url-gateway-prompt-pattern
"^[^#$%>;]*[#$%>;] *" ;; "bash\\|\$ *\r?$\\|> *\r?"
- "*A regular expression matching a shell prompt."
+ "A regular expression matching a shell prompt."
:type 'regexp
:group 'url-gateway)
(defcustom url-gateway-rlogin-host nil
- "*What hostname to actually rlog into before doing a telnet."
+ "What hostname to actually rlog into before doing a telnet."
:type '(choice (const nil) string)
:group 'url-gateway)
(defcustom url-gateway-rlogin-user-name nil
- "*Username to log into the remote machine with when using rlogin."
+ "Username to log into the remote machine with when using rlogin."
:type '(choice (const nil) string)
:group 'url-gateway)
(defcustom url-gateway-rlogin-parameters '("telnet" "-8")
- "*Parameters to `url-open-rlogin'.
+ "Parameters to `url-open-rlogin'.
This list will be used as the parameter list given to rsh."
:type '(repeat string)
:group 'url-gateway)
(defcustom url-gateway-telnet-host nil
- "*What hostname to actually login to before doing a telnet."
+ "What hostname to actually login to before doing a telnet."
:type '(choice (const nil) string)
:group 'url-gateway)
(defcustom url-gateway-telnet-parameters '("exec" "telnet" "-8")
- "*Parameters to `url-open-telnet'.
+ "Parameters to `url-open-telnet'.
This list will be executed as a command after logging in via telnet."
:type '(repeat string)
:group 'url-gateway)
(defcustom url-gateway-telnet-login-prompt "^\r*.?login:"
- "*Prompt that tells us we should send our username when loggin in w/telnet."
+ "Prompt that tells us we should send our username when loggin in w/telnet."
:type 'regexp
:group 'url-gateway)
(defcustom url-gateway-telnet-password-prompt "^\r*.?password:"
- "*Prompt that tells us we should send our password when loggin in w/telnet."
+ "Prompt that tells us we should send our password when loggin in w/telnet."
:type 'regexp
:group 'url-gateway)
@@ -95,7 +95,7 @@ This list will be executed as a command after logging in via telnet."
:group 'url-gateway)
(defcustom url-gateway-broken-resolution nil
- "*Whether to use nslookup to resolve hostnames.
+ "Whether to use nslookup to resolve hostnames.
This should be used when your version of Emacs cannot correctly use DNS,
but your machine can. This usually happens if you are running a statically
linked Emacs under SunOS 4.x."
@@ -103,7 +103,7 @@ linked Emacs under SunOS 4.x."
:group 'url-gateway)
(defcustom url-gateway-nslookup-program "nslookup"
- "*If non-nil then a string naming nslookup program."
+ "If non-nil then a string naming nslookup program."
:type '(choice (const :tag "None" :value nil) string)
:group 'url-gateway)
diff --git a/lisp/url/url-history.el b/lisp/url/url-history.el
index 5b4f330ed2..0cc891b32b 100644
--- a/lisp/url/url-history.el
+++ b/lisp/url/url-history.el
@@ -1,7 +1,7 @@
;;; url-history.el --- Global history tracking for URL package
-;; Copyright (C) 1996, 1997, 1998, 1999, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007, 2008,
+;; 2009, 2010 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
@@ -35,7 +35,7 @@
:group 'url)
(defcustom url-history-track nil
- "*Controls whether to keep a list of all the URLs being visited.
+ "Controls whether to keep a list of all the URLs being visited.
If non-nil, the URL package will keep track of all the URLs visited.
If set to t, then the list is saved to disk at the end of each Emacs
session."
@@ -49,14 +49,14 @@ session."
:group 'url-history)
(defcustom url-history-file nil
- "*The global history file for the URL package.
+ "The global history file for the URL package.
This file contains a list of all the URLs you have visited. This file
is parsed at startup and used to provide URL completion."
:type '(choice (const :tag "Default" :value nil) file)
:group 'url-history)
(defcustom url-history-save-interval 3600
- "*The number of seconds between automatic saves of the history list.
+ "The number of seconds between automatic saves of the history list.
Default is 1 hour. Note that if you change this variable outside of
the `customize' interface after `url-do-setup' has been run, you need
to run the `url-history-setup-save-timer' function manually."
diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el
index 1469cb9eb8..715eecd211 100644
--- a/lisp/url/url-irc.el
+++ b/lisp/url/url-irc.el
@@ -1,7 +1,7 @@
;;; url-irc.el --- IRC URL interface
-;; Copyright (C) 1996, 1997, 1998, 1999, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007, 2008,
+;; 2009, 2010 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
@@ -22,7 +22,8 @@
;;; Commentary:
-;; IRC URLs are defined in http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt
+;; IRC URLs are defined in
+;; http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt
;;; Code:
@@ -32,7 +33,7 @@
(defconst url-irc-default-port 6667 "Default port for IRC connections.")
(defcustom url-irc-function 'url-irc-rcirc
- "*Function to actually open an IRC connection.
+ "Function to actually open an IRC connection.
The function should take the following arguments:
HOST - the hostname of the IRC server to contact
PORT - the port number of the IRC server to contact
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index e92ccc7628..8beffe60a7 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -43,7 +43,7 @@
;;;###autoload
(defcustom url-debug nil
- "*What types of debug messages from the URL library to show.
+ "What types of debug messages from the URL library to show.
Debug messages are logged to the *URL-DEBUG* buffer.
If t, all messages will be logged.
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el
index 65622a06e0..7419247822 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -1,7 +1,7 @@
;;; url-vars.el --- Variables for Uniform Resource Locator tool
-;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2004, 2005, 2006, 2007,
+;; 2008, 2009, 2010 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
@@ -68,7 +68,7 @@
))
(defcustom url-honor-refresh-requests t
- "*Whether to do automatic page reloads.
+ "Whether to do automatic page reloads.
These are done at the request of the document author or the server via
the `Refresh' header in an HTTP response. If nil, no refresh
requests will be honored. If t, all refresh requests will be honored.
@@ -79,14 +79,14 @@ If non-nil and not t, the user will be asked for each refresh request."
:group 'url-hairy)
(defcustom url-automatic-caching nil
- "*If non-nil, all documents will be automatically cached to the local disk."
+ "If non-nil, all documents will be automatically cached to the local disk."
:type 'boolean
:group 'url-cache)
;; Fixme: sanitize this.
(defcustom url-cache-expired
(lambda (t1 t2) (>= (- (car t2) (car t1)) 5))
- "*A function determining if a cached item has expired.
+ "A function determining if a cached item has expired.
It takes two times (numbers) as its arguments, and returns non-nil if
the second time is 'too old' when compared to the first time."
:type 'function
@@ -96,14 +96,14 @@ the second time is 'too old' when compared to the first time."
"Where to send bug reports.")
(defcustom url-personal-mail-address nil
- "*Your full email address.
+ "Your full email address.
This is what is sent to HTTP servers as the FROM field in an HTTP
request."
:type '(choice (const :tag "Unspecified" nil) string)
:group 'url)
(defcustom url-directory-index-file "index.html"
- "*The filename to look for when indexing a directory.
+ "The filename to look for when indexing a directory.
If this file exists, and is readable, then it will be viewed instead of
using `dired' to view the directory."
:type 'string
@@ -166,14 +166,14 @@ variable."
(".hqx" . "x-hqx")
(".Z" . "x-compress")
(".bz2" . "x-bzip2"))
- "*An alist of file extensions and appropriate content-transfer-encodings."
+ "An alist of file extensions and appropriate content-transfer-encodings."
:type '(repeat (cons :format "%v"
(string :tag "Extension")
(string :tag "Encoding")))
:group 'url-mime)
(defcustom url-mail-command 'compose-mail
- "*This function will be called whenever URL needs to send mail.
+ "This function will be called whenever URL needs to send mail.
It should enter a mail-mode-like buffer in the current window.
The commands `mail-to' and `mail-subject' should still work in this
buffer, and it should use `mail-header-separator' if possible."
@@ -181,7 +181,7 @@ buffer, and it should use `mail-header-separator' if possible."
:group 'url)
(defcustom url-proxy-services nil
- "*An alist of schemes and proxy servers that gateway them.
+ "An alist of schemes and proxy servers that gateway them.
Looks like ((\"http\" . \"hostname:portnumber\") ...). This is set up
from the ACCESS_proxy environment variables."
:type '(repeat (cons :format "%v"
@@ -190,7 +190,7 @@ from the ACCESS_proxy environment variables."
:group 'url)
(defcustom url-standalone-mode nil
- "*Rely solely on the cache?"
+ "Rely solely on the cache?"
:type 'boolean
:group 'url-cache)
@@ -202,7 +202,7 @@ from the ACCESS_proxy environment variables."
(defcustom url-bad-port-list
'("25" "119" "19")
- "*List of ports to warn the user about connecting to.
+ "List of ports to warn the user about connecting to.
Defaults to just the mail, chargen, and NNTP ports so you cannot be
tricked into sending fake mail or forging messages by a malicious HTML
document."
@@ -255,7 +255,7 @@ given priority 1 and the rest are given priority 0.5.")
;; Fixme: set from the locale.
(defcustom url-mime-language-string nil
- "*String to send in the Accept-language: field in HTTP requests.
+ "String to send in the Accept-language: field in HTTP requests.
Specifies the preferred language when servers can serve documents in
several languages. Use RFC 1766 abbreviations, e.g.: `en' for
@@ -284,20 +284,20 @@ get the first available language (as opposed to the default)."
"What OS we are on.")
(defcustom url-max-password-attempts 5
- "*Maximum number of times a password will be prompted for.
+ "Maximum number of times a password will be prompted for.
Applies when a protected document is denied by the server."
:type 'integer
:group 'url)
(defcustom url-temporary-directory (or (getenv "TMPDIR") "/tmp")
- "*Where temporary files go."
+ "Where temporary files go."
:type 'directory
:group 'url-file)
(make-obsolete-variable 'url-temporary-directory
'temporary-file-directory "23.1")
(defcustom url-show-status t
- "*Whether to show a running total of bytes transferred.
+ "Whether to show a running total of bytes transferred.
Can cause a large hit if using a remote X display over a slow link, or
a terminal with a slow modem."
:type 'boolean
@@ -308,7 +308,7 @@ a terminal with a slow modem."
http://www.example.com/")
(defcustom url-news-server nil
- "*The default news server from which to get newsgroups/articles.
+ "The default news server from which to get newsgroups/articles.
Applies if no server is specified in the URL. Defaults to the
environment variable NNTPSERVER or \"news\" if NNTPSERVER is
undefined."
@@ -320,13 +320,13 @@ undefined."
"A regular expression that will match an absolute URL.")
(defcustom url-max-redirections 30
- "*The maximum number of redirection requests to honor in a HTTP connection.
+ "The maximum number of redirection requests to honor in a HTTP connection.
A negative number means to honor an unlimited number of redirection requests."
:type 'integer
:group 'url)
(defcustom url-confirmation-func 'y-or-n-p
- "*What function to use for asking yes or no functions.
+ "What function to use for asking yes or no functions.
Possible values are `yes-or-no-p' or `y-or-n-p', or any function that
takes a single argument (the prompt), and returns t only if a positive
answer is given."
@@ -336,7 +336,7 @@ answer is given."
:group 'url-hairy)
(defcustom url-gateway-method 'native
- "*The type of gateway support to use.
+ "The type of gateway support to use.
Should be a symbol specifying how to get a connection from the local machine.
Currently supported methods:
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el
index cf391b2f9a..23f1e33f18 100644
--- a/lisp/vc/add-log.el
+++ b/lisp/vc/add-log.el
@@ -755,7 +755,17 @@ Optional arg BUFFER-FILE overrides `buffer-file-name'."
(if add-log-file-name-function
(funcall add-log-file-name-function buffer-file)
(setq buffer-file
- (file-relative-name buffer-file (file-name-directory log-file)))
+ (let* ((dir (file-name-directory log-file))
+ (rel (file-relative-name buffer-file dir)))
+ ;; Sometimes with symlinks, the two buffers may have names that
+ ;; appear to belong to different directory trees. So check the
+ ;; file-truenames, to see if we get a better result.
+ (if (not (string-match "\\`\\.\\./" rel))
+ rel
+ (let ((new (file-relative-name (file-truename buffer-file)
+ (file-truename dir))))
+ (if (< (length new) (length rel))
+ new rel)))))
;; If we have a backup file, it's presumably because we're
;; comparing old and new versions (e.g. for deleted
;; functions) and we'll want to use the original name.
diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el
index 5695b058d2..4316b6e4d9 100644
--- a/lisp/vc/ediff-diff.el
+++ b/lisp/vc/ediff-diff.el
@@ -4,6 +4,7 @@
;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Michael Kifer <[email protected]>
+;; Package: ediff
;; This file is part of GNU Emacs.
diff --git a/lisp/vc/ediff-help.el b/lisp/vc/ediff-help.el
index d9ca687e6b..06a600f0af 100644
--- a/lisp/vc/ediff-help.el
+++ b/lisp/vc/ediff-help.el
@@ -4,6 +4,7 @@
;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Michael Kifer <[email protected]>
+;; Package: ediff
;; This file is part of GNU Emacs.
diff --git a/lisp/vc/ediff-hook.el b/lisp/vc/ediff-hook.el
index 390538ed00..e917d29a7b 100644
--- a/lisp/vc/ediff-hook.el
+++ b/lisp/vc/ediff-hook.el
@@ -4,6 +4,7 @@
;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Michael Kifer <[email protected]>
+;; Package: ediff
;; This file is part of GNU Emacs.
diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el
index 0ea1e8c02f..d1b40f7ee5 100644
--- a/lisp/vc/ediff-init.el
+++ b/lisp/vc/ediff-init.el
@@ -4,6 +4,7 @@
;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Michael Kifer <[email protected]>
+;; Package: ediff
;; This file is part of GNU Emacs.
diff --git a/lisp/vc/ediff-merg.el b/lisp/vc/ediff-merg.el
index c4b94a02e0..4c6aee15d1 100644
--- a/lisp/vc/ediff-merg.el
+++ b/lisp/vc/ediff-merg.el
@@ -4,6 +4,7 @@
;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Michael Kifer <[email protected]>
+;; Package: ediff
;; This file is part of GNU Emacs.
diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el
index a2c1043049..39bd06fbd9 100644
--- a/lisp/vc/ediff-mult.el
+++ b/lisp/vc/ediff-mult.el
@@ -4,6 +4,7 @@
;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Michael Kifer <[email protected]>
+;; Package: ediff
;; This file is part of GNU Emacs.
diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el
index 1203747fdb..b6c7f6ab7b 100644
--- a/lisp/vc/ediff-ptch.el
+++ b/lisp/vc/ediff-ptch.el
@@ -4,6 +4,7 @@
;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Michael Kifer <[email protected]>
+;; Package: ediff
;; This file is part of GNU Emacs.
diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el
index 77284a19f5..e1589e3deb 100644
--- a/lisp/vc/ediff-util.el
+++ b/lisp/vc/ediff-util.el
@@ -4,6 +4,7 @@
;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Michael Kifer <[email protected]>
+;; Package: ediff
;; This file is part of GNU Emacs.
diff --git a/lisp/vc/ediff-vers.el b/lisp/vc/ediff-vers.el
index e314afc24b..581aad3e4d 100644
--- a/lisp/vc/ediff-vers.el
+++ b/lisp/vc/ediff-vers.el
@@ -4,6 +4,7 @@
;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Michael Kifer <[email protected]>
+;; Package: ediff
;; This file is part of GNU Emacs.
diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el
index 61213c039c..8b16c5a4a1 100644
--- a/lisp/vc/ediff-wind.el
+++ b/lisp/vc/ediff-wind.el
@@ -4,6 +4,7 @@
;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Michael Kifer <[email protected]>
+;; Package: ediff
;; This file is part of GNU Emacs.
diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el
index cb0d6444b7..c41a6e4a1a 100644
--- a/lisp/vc/ediff.el
+++ b/lisp/vc/ediff.el
@@ -6,6 +6,7 @@
;; Author: Michael Kifer <[email protected]>
;; Created: February 2, 1994
;; Keywords: comparing, merging, patching, vc, tools, unix
+;; Version: 2.81.4
;; Yoni Rabkin <[email protected]> contacted the maintainer of this
;; file on 20/3/2008, and the maintainer agreed that when a bug is
diff --git a/lisp/vc/pcvs-defs.el b/lisp/vc/pcvs-defs.el
index a49cd2f1ab..7dda4533f6 100644
--- a/lisp/vc/pcvs-defs.el
+++ b/lisp/vc/pcvs-defs.el
@@ -6,6 +6,7 @@
;; Author: Stefan Monnier <[email protected]>
;; Keywords: pcl-cvs
+;; Package: pcvs
;; This file is part of GNU Emacs.
diff --git a/lisp/vc/pcvs-info.el b/lisp/vc/pcvs-info.el
index 198b3dd057..1ae924ff17 100644
--- a/lisp/vc/pcvs-info.el
+++ b/lisp/vc/pcvs-info.el
@@ -6,6 +6,7 @@
;; Author: Stefan Monnier <[email protected]>
;; Keywords: pcl-cvs
+;; Package: pcvs
;; This file is part of GNU Emacs.
diff --git a/lisp/vc/pcvs-parse.el b/lisp/vc/pcvs-parse.el
index deb11936c8..560a270a73 100644
--- a/lisp/vc/pcvs-parse.el
+++ b/lisp/vc/pcvs-parse.el
@@ -5,6 +5,7 @@
;; Author: Stefan Monnier <[email protected]>
;; Keywords: pcl-cvs
+;; Package: pcvs
;; This file is part of GNU Emacs.
diff --git a/lisp/vc/pcvs-util.el b/lisp/vc/pcvs-util.el
index 26f4a829a5..595b762b2f 100644
--- a/lisp/vc/pcvs-util.el
+++ b/lisp/vc/pcvs-util.el
@@ -5,6 +5,7 @@
;; Author: Stefan Monnier <[email protected]>
;; Keywords: pcl-cvs
+;; Package: pcvs
;; This file is part of GNU Emacs.
diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el
index c95fe54d04..10b88e6f14 100644
--- a/lisp/vc/vc-annotate.el
+++ b/lisp/vc/vc-annotate.el
@@ -6,6 +6,7 @@
;; Author: Martin Lorentzson <[email protected]>
;; Maintainer: FSF
;; Keywords: vc tools
+;; Package: vc
;; This file is part of GNU Emacs.
diff --git a/lisp/vc/vc-arch.el b/lisp/vc/vc-arch.el
index a723f98b8a..3ca9d59e3c 100644
--- a/lisp/vc/vc-arch.el
+++ b/lisp/vc/vc-arch.el
@@ -5,6 +5,7 @@
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Stefan Monnier <[email protected]>
+;; Package: vc
;; This file is part of GNU Emacs.
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index bea856b28e..78441772bd 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -6,8 +6,9 @@
;; Riccardo Murri <[email protected]>
;; Keywords: vc tools
;; Created: Sept 2006
-;; Version: 2008-01-04 (Bzr revno 25)
+;; Version: 2008-01-04
;; URL: http://launchpad.net/vc-bzr
+;; Package: vc
;; This file is part of GNU Emacs.
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index 8f9d07723d..ad307d3a20 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -5,6 +5,7 @@
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <[email protected]>
+;; Package: vc
;; This file is part of GNU Emacs.
diff --git a/lisp/vc/vc-dav.el b/lisp/vc/vc-dav.el
index 1036f34fe7..bd495eaf4b 100644
--- a/lisp/vc/vc-dav.el
+++ b/lisp/vc/vc-dav.el
@@ -5,6 +5,7 @@
;; Author: Bill Perry <[email protected]>
;; Maintainer: Bill Perry <[email protected]>
;; Keywords: url, vc
+;; Package: vc
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 9cacef2f71..4397251959 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -5,6 +5,7 @@
;; Author: Dan Nicolaescu <[email protected]>
;; Keywords: vc tools
+;; Package: vc
;; This file is part of GNU Emacs.
diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index 0b7851f0a8..b6ccae1af1 100644
--- a/lisp/vc/vc-dispatcher.el
+++ b/lisp/vc/vc-dispatcher.el
@@ -6,6 +6,7 @@
;; Author: FSF (see below for full credits)
;; Maintainer: Eric S. Raymond <[email protected]>
;; Keywords: vc tools
+;; Package: vc
;; This file is part of GNU Emacs.
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index cccccbdfd0..48a86454f7 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -4,6 +4,7 @@
;; Author: Alexandre Julliard <[email protected]>
;; Keywords: vc tools
+;; Package: vc
;; This file is part of GNU Emacs.
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index 8504309e33..c087a4d9e1 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -4,6 +4,7 @@
;; Author: Ivan Kanis
;; Keywords: vc tools
+;; Package: vc
;; This file is part of GNU Emacs.
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index cf444d204e..91e9b8e3cd 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -6,6 +6,7 @@
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <[email protected]>
+;; Package: vc
;; This file is part of GNU Emacs.
diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el
index 03b651d945..cb03853f86 100644
--- a/lisp/vc/vc-mtn.el
+++ b/lisp/vc/vc-mtn.el
@@ -4,6 +4,7 @@
;; Author: Stefan Monnier <[email protected]>
;; Keywords: vc
+;; Package: vc
;; This file is part of GNU Emacs.
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index 9756ec2196..1c3b4c00e3 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -6,6 +6,7 @@
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <[email protected]>
+;; Package: vc
;; This file is part of GNU Emacs.
diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el
index de476ded36..cf7d97e483 100644
--- a/lisp/vc/vc-sccs.el
+++ b/lisp/vc/vc-sccs.el
@@ -6,6 +6,7 @@
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Andre Spiegel <[email protected]>
+;; Package: vc
;; This file is part of GNU Emacs.
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index 889a60c278..3af6842ab4 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -5,6 +5,7 @@
;; Author: FSF (see vc.el for full credits)
;; Maintainer: Stefan Monnier <[email protected]>
+;; Package: vc
;; This file is part of GNU Emacs.
diff --git a/lisp/version.el b/lisp/version.el
index 770409b948..b4e2c61b57 100644
--- a/lisp/version.el
+++ b/lisp/version.el
@@ -6,6 +6,7 @@
;; Maintainer: FSF
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el
index 78fe793b17..1abb29febc 100644
--- a/lisp/w32-fns.el
+++ b/lisp/w32-fns.el
@@ -5,6 +5,7 @@
;; Author: Geoff Voelker <[email protected]>
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -424,40 +425,32 @@ bit output with no translation."
'w32-charset-info-alist "21.1")
-;;;; Selections and cut buffers
+;;;; Selections
;; We keep track of the last text selected here, so we can check the
;; current selection against it, and avoid passing back our own text
-;; from x-cut-buffer-or-selection-value.
+;; from x-selection-value.
(defvar x-last-selected-text nil)
-;; It is said that overlarge strings are slow to put into the cut buffer.
-;; Note this value is overridden below.
-(defvar x-cut-buffer-max 20000
- "Max number of characters to put in the cut buffer.")
-
-(defun x-select-text (text &optional push)
+(defun x-select-text (text)
"Select TEXT, a string, according to the window system.
-On X, put TEXT in the primary X selection. For backward
-compatibility with older X applications, set the value of X cut
-buffer 0 as well, and if the optional argument PUSH is non-nil,
-rotate the cut buffers. If `x-select-enable-clipboard' is
-non-nil, copy the text to the X clipboard as well.
+On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the
+clipboard. If `x-select-enable-primary' is non-nil, put TEXT in
+the primary selection.
On Windows, make TEXT the current selection. If
`x-select-enable-clipboard' is non-nil, copy the text to the
-clipboard as well. The argument PUSH is ignored.
+clipboard as well.
-On Nextstep, put TEXT in the pasteboard; PUSH is ignored."
+On Nextstep, put TEXT in the pasteboard."
(if x-select-enable-clipboard
(w32-set-clipboard-data text))
(setq x-last-selected-text text))
(defun x-get-selection-value ()
"Return the value of the current selection.
-Consult the selection, then the cut buffer. Treat empty strings as if
-they were unset."
+Consult the selection. Treat empty strings as if they were unset."
(if x-select-enable-clipboard
(let (text)
;; Don't die if x-get-selection signals an error.
@@ -475,7 +468,7 @@ they were unset."
(t
(setq x-last-selected-text text))))))
-(defalias 'x-cut-buffer-or-selection-value 'x-get-selection-value)
+(defalias 'x-selection-value 'x-get-selection-value)
;; Arrange for the kill and yank functions to set and check the clipboard.
(setq interprogram-cut-function 'x-select-text)
diff --git a/lisp/w32-vars.el b/lisp/w32-vars.el
index c1d593ea4e..91676dd12d 100644
--- a/lisp/w32-vars.el
+++ b/lisp/w32-vars.el
@@ -5,6 +5,7 @@
;; Author: Jason Rumney <[email protected]>
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index 79ce9a330d..4b8b9a6117 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -6,7 +6,7 @@
;; Author: Vinicius Jose Latorre <[email protected]>
;; Maintainer: Vinicius Jose Latorre <[email protected]>
;; Keywords: data, wp
-;; Version: 12.1
+;; Version: 13.1
;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
;; This file is part of GNU Emacs.
@@ -382,19 +382,28 @@
(defcustom whitespace-style
- '(tabs spaces trailing lines space-before-tab newline
- indentation empty space-after-tab
- space-mark tab-mark newline-mark)
+ '(face
+ tabs spaces trailing lines space-before-tab newline
+ indentation empty space-after-tab
+ space-mark tab-mark newline-mark)
"Specify which kind of blank is visualized.
It's a list containing some or all of the following values:
+ face enable all visualization via faces (see below).
+
trailing trailing blanks are visualized via faces.
+ It has effect only if `face' (see above)
+ is present in `whitespace-style'.
tabs TABs are visualized via faces.
+ It has effect only if `face' (see above)
+ is present in `whitespace-style'.
spaces SPACEs and HARD SPACEs are visualized via
faces.
+ It has effect only if `face' (see above)
+ is present in `whitespace-style'.
lines lines which have columns beyond
`whitespace-line-column' are highlighted via
@@ -402,6 +411,8 @@ It's a list containing some or all of the following values:
Whole line is highlighted.
It has precedence over `lines-tail' (see
below).
+ It has effect only if `face' (see above)
+ is present in `whitespace-style'.
lines-tail lines which have columns beyond
`whitespace-line-column' are highlighted via
@@ -409,45 +420,69 @@ It's a list containing some or all of the following values:
But only the part of line which goes
beyond `whitespace-line-column' column.
It has effect only if `lines' (see above)
- is not present in `whitespace-style'.
+ is not present in `whitespace-style'
+ and if `face' (see above) is present in
+ `whitespace-style'.
newline NEWLINEs are visualized via faces.
+ It has effect only if `face' (see above)
+ is present in `whitespace-style'.
empty empty lines at beginning and/or end of buffer
are visualized via faces.
+ It has effect only if `face' (see above)
+ is present in `whitespace-style'.
indentation::tab 8 or more SPACEs at beginning of line are
visualized via faces.
+ It has effect only if `face' (see above)
+ is present in `whitespace-style'.
indentation::space TABs at beginning of line are visualized via
faces.
+ It has effect only if `face' (see above)
+ is present in `whitespace-style'.
indentation 8 or more SPACEs at beginning of line are
visualized, if `indent-tabs-mode' (which see)
is non-nil; otherwise, TABs at beginning of
line are visualized via faces.
+ It has effect only if `face' (see above)
+ is present in `whitespace-style'.
space-after-tab::tab 8 or more SPACEs after a TAB are
visualized via faces.
+ It has effect only if `face' (see above)
+ is present in `whitespace-style'.
space-after-tab::space TABs are visualized when 8 or more
SPACEs occur after a TAB, via faces.
+ It has effect only if `face' (see above)
+ is present in `whitespace-style'.
space-after-tab 8 or more SPACEs after a TAB are
visualized, if `indent-tabs-mode'
(which see) is non-nil; otherwise,
the TABs are visualized via faces.
+ It has effect only if `face' (see above)
+ is present in `whitespace-style'.
space-before-tab::tab SPACEs before TAB are visualized via
faces.
+ It has effect only if `face' (see above)
+ is present in `whitespace-style'.
space-before-tab::space TABs are visualized when SPACEs occur
before TAB, via faces.
+ It has effect only if `face' (see above)
+ is present in `whitespace-style'.
space-before-tab SPACEs before TAB are visualized, if
`indent-tabs-mode' (which see) is
non-nil; otherwise, the TABs are
visualized via faces.
+ It has effect only if `face' (see above)
+ is present in `whitespace-style'.
space-mark SPACEs and HARD SPACEs are visualized via
display table.
@@ -486,9 +521,16 @@ So, for example, if indentation and indentation::space are
included in `whitespace-style' list, the indentation value is
evaluated instead of indentation::space value.
+One reason for not visualize spaces via faces (if `face' is not
+included in `whitespace-style') is to use exclusively for
+cleanning up a buffer. See `whitespace-cleanup' and
+`whitespace-cleanup-region' for documentation.
+
See also `whitespace-display-mappings' for documentation."
:type '(repeat :tag "Kind of Blank"
(choice :tag "Kind of Blank Face"
+ (const :tag "(Face) Face visualization"
+ face)
(const :tag "(Face) Trailing TABs, SPACEs and HARD SPACEs"
trailing)
(const :tag "(Face) SPACEs and HARD SPACEs"
@@ -521,9 +563,9 @@ Used when `whitespace-style' includes the value `spaces'."
(defface whitespace-space
'((((class color) (background dark))
- (:background "grey20" :foreground "aquamarine3"))
+ (:background "grey20" :foreground "darkgray"))
(((class color) (background light))
- (:background "LightYellow" :foreground "aquamarine3"))
+ (:background "LightYellow" :foreground "lightgray"))
(t (:inverse-video t)))
"Face used to visualize SPACE."
:group 'whitespace)
@@ -539,9 +581,9 @@ Used when `whitespace-style' includes the value `spaces'."
(defface whitespace-hspace ; 'nobreak-space
'((((class color) (background dark))
- (:background "grey24" :foreground "aquamarine3"))
+ (:background "grey24" :foreground "darkgray"))
(((class color) (background light))
- (:background "LemonChiffon3" :foreground "aquamarine3"))
+ (:background "LemonChiffon3" :foreground "lightgray"))
(t (:inverse-video t)))
"Face used to visualize HARD SPACE."
:group 'whitespace)
@@ -557,9 +599,9 @@ Used when `whitespace-style' includes the value `tabs'."
(defface whitespace-tab
'((((class color) (background dark))
- (:background "grey22" :foreground "aquamarine3"))
+ (:background "grey22" :foreground "darkgray"))
(((class color) (background light))
- (:background "beige" :foreground "aquamarine3"))
+ (:background "beige" :foreground "lightgray"))
(t (:inverse-video t)))
"Face used to visualize TAB."
:group 'whitespace)
@@ -812,7 +854,7 @@ Used when `whitespace-style' includes `indentation',
:group 'whitespace)
-(defcustom whitespace-empty-at-bob-regexp "\\`\\(\\([ \t]*\n\\)+\\)"
+(defcustom whitespace-empty-at-bob-regexp "^\\(\\([ \t]*\n\\)+\\)"
"Specify regexp for empty lines at beginning of buffer.
If you're using `mule' package, there may be other characters besides:
@@ -827,7 +869,7 @@ Used when `whitespace-style' includes `empty'."
:group 'whitespace)
-(defcustom whitespace-empty-at-eob-regexp "^\\([ \t\n]+\\)\\'"
+(defcustom whitespace-empty-at-eob-regexp "^\\([ \t\n]+\\)"
"Specify regexp for empty lines at end of buffer.
If you're using `mule' package, there may be other characters besides:
@@ -866,8 +908,13 @@ Used when `whitespace-style' includes `space-after-tab',
(defcustom whitespace-line-column 80
"Specify column beyond which the line is highlighted.
+It must be an integer or nil. If nil, the `fill-column' variable value is
+used.
+
Used when `whitespace-style' includes `lines' or `lines-tail'."
- :type '(integer :tag "Line Length")
+ :type '(choice :tag "Line Length Limit"
+ (integer :tag "Line Length")
+ (const :tag "Use fill-column" nil))
:group 'whitespace)
@@ -1151,7 +1198,8 @@ See also `whitespace-newline' and `whitespace-display-mappings'."
(defconst whitespace-style-value-list
- '(tabs
+ '(face
+ tabs
spaces
trailing
lines
@@ -1176,7 +1224,8 @@ See also `whitespace-newline' and `whitespace-display-mappings'."
(defconst whitespace-toggle-option-alist
- '((?t . tabs)
+ '((?f . face)
+ (?t . tabs)
(?s . spaces)
(?r . trailing)
(?l . lines)
@@ -1228,6 +1277,19 @@ Used by `whitespace-trailing-regexp' function (which see).")
"Used to save locally the font-lock refontify state.
Used by `whitespace-post-command-hook' function (which see).")
+(defvar whitespace-bob-marker nil
+ "Used to save locally the bob marker value.
+Used by `whitespace-post-command-hook' function (which see).")
+
+(defvar whitespace-eob-marker nil
+ "Used to save locally the eob marker value.
+Used by `whitespace-post-command-hook' function (which see).")
+
+(defvar whitespace-buffer-changed nil
+ "Used to indicate locally if buffer changed.
+Used by `whitespace-post-command-hook' and `whitespace-buffer-changed'
+functions (which see).")
+
;;;###autoload
(defun whitespace-toggle-options (arg)
@@ -1243,6 +1305,7 @@ Interactively, it reads one of the following chars:
CHAR MEANING
(VIA FACES)
+ f toggle face visualization
t toggle TAB visualization
s toggle SPACE and HARD SPACE visualization
r toggle trailing blanks visualization
@@ -1271,6 +1334,7 @@ Interactively, it reads one of the following chars:
Non-interactively, ARG should be a symbol or a list of symbols.
The valid symbols are:
+ face toggle face visualization
tabs toggle TAB visualization
spaces toggle SPACE and HARD SPACE visualization
trailing toggle trailing blanks visualization
@@ -1320,6 +1384,7 @@ Interactively, it accepts one of the following chars:
CHAR MEANING
(VIA FACES)
+ f toggle face visualization
t toggle TAB visualization
s toggle SPACE and HARD SPACE visualization
r toggle trailing blanks visualization
@@ -1348,6 +1413,7 @@ Interactively, it accepts one of the following chars:
Non-interactively, ARG should be a symbol or a list of symbols.
The valid symbols are:
+ face toggle face visualization
tabs toggle TAB visualization
spaces toggle SPACE and HARD SPACE visualization
trailing toggle trailing blanks visualization
@@ -1463,10 +1529,10 @@ documentation."
(let (overwrite-mode) ; enforce no overwrite
(goto-char (point-min))
(when (re-search-forward
- whitespace-empty-at-bob-regexp nil t)
+ (concat "\\`" whitespace-empty-at-bob-regexp) nil t)
(delete-region (match-beginning 1) (match-end 1)))
(when (re-search-forward
- whitespace-empty-at-eob-regexp nil t)
+ (concat whitespace-empty-at-eob-regexp "\\'") nil t)
(delete-region (match-beginning 1) (match-end 1)))))))
;; PROBLEM 3: 8 or more SPACEs at bol
;; PROBLEM 4: SPACEs before TAB
@@ -1877,9 +1943,10 @@ cleaning up these problems."
(defconst whitespace-help-text
"\
- Whitespace Toggle Options
-
- FACES
+ Whitespace Toggle Options | scroll up : SPC or > |
+ | scroll down: M-SPC or < |
+ FACES \\__________________________/
+ [] f - toggle face visualization
[] t - toggle TAB visualization
[] s - toggle SPACE and HARD SPACE visualization
[] r - toggle trailing blanks visualization
@@ -1953,15 +2020,13 @@ cleaning up these problems."
"Display BUFFER in a new window."
(goto-char (point-min))
(set-buffer-modified-p nil)
- (let ((size (- (window-height)
- (max window-min-height
- (1+ (count-lines (point-min)
- (point-max)))))))
- (when (<= size 0)
- (kill-buffer buffer)
- (error "Frame height is too small; \
+ (when (< (window-height) (* 2 window-min-height))
+ (kill-buffer buffer)
+ (error "Window height is too small; \
can't split window to display whitespace toggle options"))
- (set-window-buffer (split-window nil size) buffer)))
+ (let ((win (split-window)))
+ (set-window-buffer win buffer)
+ (shrink-window-if-larger-than-buffer win)))
(defun whitespace-kill-buffer (buffer-name)
@@ -1977,6 +2042,24 @@ can't split window to display whitespace toggle options"))
(whitespace-kill-buffer whitespace-help-buffer-name))
+(defun whitespace-help-scroll (&optional up)
+ "Scroll help window, if it exists.
+
+If UP is non-nil, scroll up; otherwise, scroll down."
+ (condition-case data-help
+ (let ((buffer (get-buffer whitespace-help-buffer-name)))
+ (if buffer
+ (with-selected-window (get-buffer-window buffer)
+ (if up
+ (scroll-up 3)
+ (scroll-down 3)))
+ (ding)))
+ ;; handler
+ ((error)
+ ;; just ignore error
+ )))
+
+
(defun whitespace-interactive-char (local-p)
"Interactive function to read a char and return a symbol.
@@ -1987,6 +2070,7 @@ It accepts one of the following chars:
CHAR MEANING
(VIA FACES)
+ f toggle face visualization
t toggle TAB visualization
s toggle SPACE and HARD SPACE visualization
r toggle trailing blanks visualization
@@ -2036,9 +2120,13 @@ See also `whitespace-toggle-option-alist'."
(cdr
(assq ch whitespace-toggle-option-alist)))))
;; while body
- (if (eq ch ?\?)
- (whitespace-help-on style)
- (ding)))
+ (cond
+ ((eq ch ?\?) (whitespace-help-on style))
+ ((eq ch ?\ ) (whitespace-help-scroll t))
+ ((eq ch ?\M- ) (whitespace-help-scroll))
+ ((eq ch ?>) (whitespace-help-scroll t))
+ ((eq ch ?<) (whitespace-help-scroll))
+ (t (ding))))
(whitespace-help-off)
(message " ")) ; clean echo area
;; handler
@@ -2117,22 +2205,23 @@ resultant list will be returned."
(defun whitespace-style-face-p ()
"Return t if there is some visualization via face."
- (or (memq 'tabs whitespace-active-style)
- (memq 'spaces whitespace-active-style)
- (memq 'trailing whitespace-active-style)
- (memq 'lines whitespace-active-style)
- (memq 'lines-tail whitespace-active-style)
- (memq 'newline whitespace-active-style)
- (memq 'empty whitespace-active-style)
- (memq 'indentation whitespace-active-style)
- (memq 'indentation::tab whitespace-active-style)
- (memq 'indentation::space whitespace-active-style)
- (memq 'space-after-tab whitespace-active-style)
- (memq 'space-after-tab::tab whitespace-active-style)
- (memq 'space-after-tab::space whitespace-active-style)
- (memq 'space-before-tab whitespace-active-style)
- (memq 'space-before-tab::tab whitespace-active-style)
- (memq 'space-before-tab::space whitespace-active-style)))
+ (and (memq 'face whitespace-active-style)
+ (or (memq 'tabs whitespace-active-style)
+ (memq 'spaces whitespace-active-style)
+ (memq 'trailing whitespace-active-style)
+ (memq 'lines whitespace-active-style)
+ (memq 'lines-tail whitespace-active-style)
+ (memq 'newline whitespace-active-style)
+ (memq 'empty whitespace-active-style)
+ (memq 'indentation whitespace-active-style)
+ (memq 'indentation::tab whitespace-active-style)
+ (memq 'indentation::space whitespace-active-style)
+ (memq 'space-after-tab whitespace-active-style)
+ (memq 'space-after-tab::tab whitespace-active-style)
+ (memq 'space-after-tab::space whitespace-active-style)
+ (memq 'space-before-tab whitespace-active-style)
+ (memq 'space-before-tab::tab whitespace-active-style)
+ (memq 'space-before-tab::space whitespace-active-style))))
(defun whitespace-color-on ()
@@ -2146,8 +2235,15 @@ resultant list will be returned."
(set (make-local-variable 'whitespace-point)
(point))
(set (make-local-variable 'whitespace-font-lock-refontify)
+ 0)
+ (set (make-local-variable 'whitespace-bob-marker)
+ (point-min-marker))
+ (set (make-local-variable 'whitespace-eob-marker)
+ (point-max-marker))
+ (set (make-local-variable 'whitespace-buffer-changed)
nil)
(add-hook 'post-command-hook #'whitespace-post-command-hook nil t)
+ (add-hook 'before-change-functions #'whitespace-buffer-changed nil t)
;; turn off font lock
(set (make-local-variable 'whitespace-font-lock-mode)
font-lock-mode)
@@ -2158,7 +2254,7 @@ resultant list will be returned."
nil
(list
;; Show SPACEs
- (list #'whitespace-space-regexp 1 whitespace-space t)
+ (list whitespace-space-regexp 1 whitespace-space t)
;; Show HARD SPACEs
(list whitespace-hspace-regexp 1 whitespace-hspace t))
t))
@@ -2167,7 +2263,7 @@ resultant list will be returned."
nil
(list
;; Show TABs
- (list #'whitespace-tab-regexp 1 whitespace-tab t))
+ (list whitespace-tab-regexp 1 whitespace-tab t))
t))
(when (memq 'trailing whitespace-active-style)
(font-lock-add-keywords
@@ -2183,14 +2279,16 @@ resultant list will be returned."
(list
;; Show "long" lines
(list
- (format
- "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$"
- whitespace-tab-width (1- whitespace-tab-width)
- (/ whitespace-line-column whitespace-tab-width)
- (let ((rem (% whitespace-line-column whitespace-tab-width)))
- (if (zerop rem)
- ""
- (format ".\\{%d\\}" rem))))
+ (let ((line-column (or whitespace-line-column fill-column)))
+ (format
+ "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$"
+ whitespace-tab-width
+ (1- whitespace-tab-width)
+ (/ line-column whitespace-tab-width)
+ (let ((rem (% line-column whitespace-tab-width)))
+ (if (zerop rem)
+ ""
+ (format ".\\{%d\\}" rem)))))
(if (memq 'lines whitespace-active-style)
0 ; whole line
2) ; line tail
@@ -2296,7 +2394,8 @@ resultant list will be returned."
;; turn off font lock
(when (whitespace-style-face-p)
(font-lock-mode 0)
- (remove-hook 'post-command-hook #'whitespace-post-command-hook)
+ (remove-hook 'post-command-hook #'whitespace-post-command-hook t)
+ (remove-hook 'before-change-functions #'whitespace-buffer-changed t)
(when whitespace-font-lock
(setq whitespace-font-lock nil
font-lock-keywords whitespace-font-lock-keywords))
@@ -2317,37 +2416,128 @@ resultant list will be returned."
(defun whitespace-empty-at-bob-regexp (limit)
"Match spaces at beginning of buffer which do not contain the point at \
beginning of buffer."
- (and (/= whitespace-point 1)
- (re-search-forward whitespace-empty-at-bob-regexp limit t)))
+ (let ((b (point))
+ r)
+ (cond
+ ;; at bob
+ ((= b 1)
+ (setq r (and (/= whitespace-point 1)
+ (looking-at whitespace-empty-at-bob-regexp)))
+ (if r
+ (set-marker whitespace-bob-marker (match-end 1))
+ (set-marker whitespace-bob-marker b)))
+ ;; inside bob empty region
+ ((<= limit whitespace-bob-marker)
+ (setq r (looking-at whitespace-empty-at-bob-regexp))
+ (if r
+ (when (< (match-end 1) limit)
+ (set-marker whitespace-bob-marker (match-end 1)))
+ (set-marker whitespace-bob-marker b)))
+ ;; intersection with end of bob empty region
+ ((<= b whitespace-bob-marker)
+ (setq r (looking-at whitespace-empty-at-bob-regexp))
+ (if r
+ (set-marker whitespace-bob-marker (match-end 1))
+ (set-marker whitespace-bob-marker b)))
+ ;; it is not inside bob empty region
+ (t
+ (setq r nil)))
+ ;; move to end of matching
+ (and r (goto-char (match-end 1)))
+ r))
+
+
+(defsubst whitespace-looking-back (regexp limit)
+ (save-excursion
+ (when (/= 0 (skip-chars-backward " \t\n" limit))
+ (unless (bolp)
+ (forward-line 1))
+ (looking-at regexp))))
(defun whitespace-empty-at-eob-regexp (limit)
"Match spaces at end of buffer which do not contain the point at end of \
buffer."
- (and (/= whitespace-point (1+ (buffer-size)))
- (re-search-forward whitespace-empty-at-eob-regexp limit t)))
-
-
-(defun whitespace-space-regexp (limit)
- "Match spaces."
- (setq whitespace-font-lock-refontify t)
- (re-search-forward whitespace-space-regexp limit t))
-
-
-(defun whitespace-tab-regexp (limit)
- "Match tabs."
- (setq whitespace-font-lock-refontify t)
- (re-search-forward whitespace-tab-regexp limit t))
+ (let ((b (point))
+ (e (1+ (buffer-size)))
+ r)
+ (cond
+ ;; at eob
+ ((= limit e)
+ (when (/= whitespace-point e)
+ (goto-char limit)
+ (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b)))
+ (if r
+ (set-marker whitespace-eob-marker (match-beginning 1))
+ (set-marker whitespace-eob-marker limit)
+ (goto-char b))) ; return back to initial position
+ ;; inside eob empty region
+ ((>= b whitespace-eob-marker)
+ (goto-char limit)
+ (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b))
+ (if r
+ (when (> (match-beginning 1) b)
+ (set-marker whitespace-eob-marker (match-beginning 1)))
+ (set-marker whitespace-eob-marker limit)
+ (goto-char b))) ; return back to initial position
+ ;; intersection with beginning of eob empty region
+ ((>= limit whitespace-eob-marker)
+ (goto-char limit)
+ (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b))
+ (if r
+ (set-marker whitespace-eob-marker (match-beginning 1))
+ (set-marker whitespace-eob-marker limit)
+ (goto-char b))) ; return back to initial position
+ ;; it is not inside eob empty region
+ (t
+ (setq r nil)))
+ r))
+
+
+(defun whitespace-buffer-changed (beg end)
+ "Set `whitespace-buffer-changed' variable to t."
+ (setq whitespace-buffer-changed t))
(defun whitespace-post-command-hook ()
"Save current point into `whitespace-point' variable.
Also refontify when necessary."
- (setq whitespace-point (point))
- (let ((refontify (or (eolp) ; end of line
- (= whitespace-point 1)))) ; beginning of buffer
- (when (or whitespace-font-lock-refontify refontify)
- (setq whitespace-font-lock-refontify refontify)
+ (setq whitespace-point (point)) ; current point position
+ (let ((refontify
+ (or
+ ;; it is at end of line ...
+ (and (eolp)
+ ;; ... with trailing SPACE or TAB
+ (or (= (preceding-char) ?\ )
+ (= (preceding-char) ?\t)))
+ ;; it is at beginning of buffer (bob)
+ (= whitespace-point 1)
+ ;; the buffer was modified and ...
+ (and whitespace-buffer-changed
+ (or
+ ;; ... or inside bob whitespace region
+ (<= whitespace-point whitespace-bob-marker)
+ ;; ... or at bob whitespace region border
+ (and (= whitespace-point (1+ whitespace-bob-marker))
+ (= (preceding-char) ?\n))))
+ ;; it is at end of buffer (eob)
+ (= whitespace-point (1+ (buffer-size)))
+ ;; the buffer was modified and ...
+ (and whitespace-buffer-changed
+ (or
+ ;; ... or inside eob whitespace region
+ (>= whitespace-point whitespace-eob-marker)
+ ;; ... or at eob whitespace region border
+ (and (= whitespace-point (1- whitespace-eob-marker))
+ (= (following-char) ?\n)))))))
+ (when (or refontify (> whitespace-font-lock-refontify 0))
+ (setq whitespace-buffer-changed nil)
+ ;; adjust refontify counter
+ (setq whitespace-font-lock-refontify
+ (if refontify
+ 1
+ (1- whitespace-font-lock-refontify)))
+ ;; refontify
(jit-lock-refontify))))
@@ -2386,11 +2576,11 @@ Also refontify when necessary."
(unless whitespace-display-table-was-local
(setq whitespace-display-table-was-local t
whitespace-display-table
+ (copy-sequence buffer-display-table))
+ ;; asure `buffer-display-table' is unique
+ ;; when two or more windows are visible.
+ (setq buffer-display-table
(copy-sequence buffer-display-table)))
- ;; asure `buffer-display-table' is unique
- ;; when two or more windows are visible.
- (set (make-local-variable 'buffer-display-table)
- (copy-sequence buffer-display-table))
(unless buffer-display-table
(setq buffer-display-table (make-display-table)))
(dolist (entry whitespace-display-mappings)
diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el
index 698e6e805a..96e6bd236c 100644
--- a/lisp/wid-browse.el
+++ b/lisp/wid-browse.el
@@ -5,6 +5,7 @@
;;
;; Author: Per Abrahamsen <[email protected]>
;; Keywords: extensions
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index dfeb6371f5..721414b32a 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -6,6 +6,7 @@
;; Author: Per Abrahamsen <[email protected]>
;; Maintainer: FSF
;; Keywords: extensions
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/widget.el b/lisp/widget.el
index 3e35f6c25a..962235a25d 100644
--- a/lisp/widget.el
+++ b/lisp/widget.el
@@ -7,6 +7,7 @@
;; Keywords: help, extensions, faces, hypermedia
;; Version: 1.9920
;; X-URL: http://www.dina.kvl.dk/~abraham/custom/
+;; Package: emacs
;; This file is part of GNU Emacs.
diff --git a/lisp/window.el b/lisp/window.el
index b674b48002..9a52667cea 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -6,6 +6,7 @@
;; Maintainer: FSF
;; Keywords: internal
+;; Package: emacs
;; This file is part of GNU Emacs.
@@ -54,6 +55,7 @@ This macro saves and restores the current buffer, since otherwise
its normal operation could make a different buffer current. The
order of recently selected windows and the buffer list ordering
are not altered by this macro (unless they are altered in BODY)."
+ (declare (indent 0) (debug t))
`(let ((save-selected-window-window (selected-window))
;; It is necessary to save all of these, because calling
;; select-window changes frame-selected-window for whatever
diff --git a/lisp/woman.el b/lisp/woman.el
index 291ebcee74..cc14091c2e 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -7,7 +7,7 @@
;; Maintainer: FSF
;; Keywords: help, unix
;; Adapted-By: Eli Zaretskii <[email protected]>
-;; Version: see `woman-version'
+;; Version: 0.551
;; URL: http://centaur.maths.qmul.ac.uk/Emacs/WoMan/
;; This file is part of GNU Emacs.
@@ -3388,7 +3388,10 @@ Format paragraphs upto TO. Supports special chars.
"Translate up to marker TO. Do this last of all transformations."
(if translations
(let ((matches (car translations))
- (alist (cdr translations)))
+ (alist (cdr translations))
+ ;; Translations are case-sensitive, eg ".tr ab" does not
+ ;; affect "A" (bug#6849).
+ (case-fold-search nil))
(while (re-search-forward matches to t)
;; Done like this to retain text properties and
;; support translation of special characters:
diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el
index 6d38fd043f..c589382e01 100644
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -6,6 +6,7 @@
;; Author: Jan Djärv <[email protected]>
;; Maintainer: FSF
;; Keywords: window, drag, drop
+;; Package: emacs
;; This file is part of GNU Emacs.