diff options
Diffstat (limited to 'lisp')
252 files changed, 13324 insertions, 9150 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 9af92aebf3a..95c3566dd5b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -20,7 +20,7 @@ * skeleton.el (skeleton-insert): Doc fix. -2014-06-20 Stefan Monnier <monnier@iro.umontreal.ca> +2014-06-21 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/smie.el (smie-config--guess): Fix typo. (smie-config-guess): Use smie-config-local so the rules are obeyed @@ -29,18 +29,18 @@ * mouse.el (mouse-drag-line): Don't re-add to unread-comment-events, since it's already done inside the loop (bug#17819). -2014-06-20 Martin Rudalics <rudalics@gmx.at> +2014-06-21 Martin Rudalics <rudalics@gmx.at> * mouse.el (mouse-drag-line): Re-remove code initially removed on 2013-03-09 and inadvertently reintroduced on 2013-11-30 (Bug#17819). -2014-06-20 Stefan Monnier <monnier@iro.umontreal.ca> +2014-06-21 Stefan Monnier <monnier@iro.umontreal.ca> * progmodes/sh-script.el (sh-smie-sh-rules): For { after &&, don't align with the surrounding parent (bug#17721). -2014-06-20 Eli Zaretskii <eliz@gnu.org> +2014-06-21 Eli Zaretskii <eliz@gnu.org> * textmodes/texinfo.el (texinfo-mode): Set skeleton-end-newline locally to nil. @@ -49,70 +49,257 @@ local setting of skeleton-end-newline by adding an explicit \n to the skeletons where appropriate. (Bug#17801) -2014-06-20 Stefan Monnier <monnier@iro.umontreal.ca> +2014-06-21 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/smie.el (smie--hanging-eolp-function): New var. (smie-indent--hanging-p): Use it. * progmodes/sh-script.el (sh-set-shell): Set it (bug#17621). -2014-06-20 Leo Liu <sdl.web@gmail.com> +2014-06-21 Leo Liu <sdl.web@gmail.com> * simple.el (read-quoted-char): Don't let help chars pop up help buffer. (Bug#16617) -2014-06-19 Stefan Monnier <monnier@iro.umontreal.ca> +2014-06-21 Stefan Monnier <monnier@iro.umontreal.ca> * progmodes/sh-script.el (sh-smie-sh-rules): Use same rule for && as for | (bug#17621). -2014-06-18 Stefan Monnier <monnier@iro.umontreal.ca> + * xt-mouse.el (xterm-mouse--read-event-sequence-1000): + Drop unknown events instead of burping. - * xt-mouse.el (xterm-mouse-translate-1): Fix last change (bug#17776). - (xterm-mouse--read-event-sequence-1000): Drop unknown events instead of - burping. - -2014-06-18 Eli Zaretskii <eliz@gnu.org> +2014-06-21 Eli Zaretskii <eliz@gnu.org> * term/w32-win.el (dynamic-library-alist): Support giflib 5.1.0 and later. (Bug#17790) -2014-06-18 Juri Linkov <juri@jurta.org> +2014-06-21 Juri Linkov <juri@jurta.org> * dired.el (dired-mark-pop-up): Let-bind display-buffer-mark-dedicated to `soft'. (Bug#17554) -2014-06-17 Stefan Monnier <monnier@iro.umontreal.ca> +2014-06-21 Stefan Monnier <monnier@iro.umontreal.ca> * delsel.el (electric-newline-and-maybe-indent): Mark it as well (bug#17737). -2014-06-16 Dmitry <dgutov@yandex.ru> +2014-06-21 Dmitry Gutov <dgutov@yandex.ru> * progmodes/ruby-mode.el (ruby-font-lock-keywords): Don't fontify `!' in `!~' with `font-lock-negation-char-face'. (Bug#17732) -2014-06-15 Michael Albinus <michael.albinus@gmx.de> +2014-06-21 Michael Albinus <michael.albinus@gmx.de> * net/dbus.el (dbus-call-method): Push only non D-Bus events into `unread-command-events'. -2014-06-14 Glenn Morris <rgm@gnu.org> +2014-06-19 William Xu <william.xwl@gmail.com> + + * progmodes/hideif.el (hif-string-to-number): Don't return float for + hex integer constants (bug#17807). + +2014-06-19 Stefan Monnier <monnier@iro.umontreal.ca> + + * international/mule-util.el (truncate-string-ellipsis): New var. + (truncate-string-to-width): Use it. + +2014-06-19 Robert Brown <robert.brown@gmail.com> (tiny change) + + * emacs-lisp/lisp-mode.el (lisp-string-after-doc-keyword-p): New fun. + (lisp-string-in-doc-position-p): New function, extracted from + lisp-font-lock-syntactic-face-function. + (lisp-font-lock-syntactic-face-function): Use them (bug#9130). + +2014-06-19 Grégoire Jadi <daimrod@gmail.com> + + * net/rcirc.el (rcirc-omit-mode): Fix recenter error. (Bug#17769) + +2014-06-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * play/bubbles.el (bubbles--initialize, bubbles--show-scores) + (bubbles--game-over): Don't add `intangible' properties since they + didn't work anyway. + +2014-06-18 Juri Linkov <juri@jurta.org> + + * vc/ediff-init.el (ediff-current-diff-Ancestor) + (ediff-fine-diff-Ancestor, ediff-even-diff-A, ediff-even-diff-B) + (ediff-even-diff-C, ediff-even-diff-Ancestor, ediff-odd-diff-A) + (ediff-odd-diff-B, ediff-odd-diff-C, ediff-odd-diff-Ancestor): + Add `min-colors 88' version with removed black/white foregrounds. + (Bug#10181) + +2014-06-18 Juri Linkov <juri@jurta.org> + + * vc/diff-mode.el (diff-changed): Empty face definition to use + `diff-removed' and `diff-added' on tty as well. (Bug#10181) + (diff-context): Use darker color on light background and + lighter color on dark background. + +2014-06-18 Juri Linkov <juri@jurta.org> + + * vc/diff-mode.el (diff-refine-changed): Rename from + `diff-refine-change' for consistency with `diff-changed'. + (diff-refine-change): Add obsolete face alias. (Bug#10181) + + * vc/smerge-mode.el (smerge-refined-changed): Rename from + `smerge-refined-change'. + (smerge-refined-change): Add obsolete face alias. + +2014-06-17 Stefan Monnier <monnier@iro.umontreal.ca> + + * rect.el (rectangle-preview): New custom. + (rectangle): New group. + (rectangle--pos-cols): Add `window' argument. + (rectangle--string-preview-state, rectangle--string-preview-window): + New vars. + (rectangle--string-flush-preview, rectangle--string-erase-preview) + (rectangle--space-to, rectangle--string-preview): New functions. + (string-rectangle): Use them. + (rectangle--inhibit-region-highlight): New var. + (rectangle--highlight-for-redisplay): Obey it. Make sure + `apply-on-region' uses the point-crutches of the right window. + Use :align-to rather than multiple spaces. + +2014-06-16 Andrea Rossetti <andrea.rossetti@gmail.com> (tiny change) + + * ruler-mode.el (ruler-mode-window-col) + (ruler-mode-mouse-set-left-margin) + (ruler-mode-mouse-set-right-margin): Fix calculation of column + from mouse position (Bug#17768). + +2014-06-16 Ron Schnell <ronnie@driver-aces.com> + + * play/dunnet.el (dun-doassign): Fix bug where UNIX variable assignment + without varname or rhs causes crash. + (dun-ftp): Fix bug where blank ftp password is allowed, making it + impossible to win endgame. + (dun-unix-verbs): Add ssh as alias to rlogin, because nobody knows what + rlogin is anymore. + (dun-help): Bump version number; update contact info. + +2014-06-15 Michael Albinus <michael.albinus@gmx.de> + + Sync with Tramp 2.2.10. + + * net/tramp.el (tramp-methods): Tweak docstring. + (tramp-handle-file-accessible-directory-p): Check for + `file-readable-p' instead of `file-executable-p'. + (tramp-check-cached-permissions): + Use `tramp-compat-file-attributes'. + (tramp-call-process): Add new argument VEC. Adapt callees in all + tramp*.el files. + + * net/tramp-adb.el (tramp-adb-handle-write-region): Improve messages. + (tramp-adb-maybe-open-connection): Don't set + `tramp-current-*' variables. + + * net/tramp-cache.el (tramp-flush-file-function): Do not flush + file properties of temporary buffers. + + * net/tramp-ftp.el (top): Remove special handling for URL syntax. + + * net/tramp-gvfs.el (tramp-gvfs-methods) <sftp>: Add. + (tramp-gvfs-handle-delete-file): Flush file + properties, not directory properties. + (tramp-gvfs-handle-file-attributes): Use `string-to-number' when + reading "unix::mode". + (tramp-gvfs-handle-file-name-all-completions): + Use "-h" option for "gvfs-ls". + (tramp-gvfs-url-file-name): `user' and `localname' could be nil. + (tramp-gvfs-send-command): Simplify traces. + + * net/tramp-sh.el (vc-handled-backends, vc-bzr-program) + (vc-git-program, vc-hg-program): Declare. + (tramp-methods) <sftp>: Remove. It has never worked satisfactorily. + (tramp-methods) <nc>: Add new method. + (tramp-methods) <telnet>: Redirect stderr to "/dev/null". + (tramp-methods) <plink, plinkx, pscp, psftp>: Improve + `tramp-login-args'. + (tramp-default-user-alist): Add "nc". + (top): Remove completion function for "sftp". Add completion + functions for "nc" and "psftp". + (tramp-do-copy-or-rename-file-out-of-band): Tweak docstring. + Implement support for "nc" method. + (tramp-sh-handle-expand-file-name, tramp-local-coding-commands) + (tramp-remote-coding-commands, tramp-call-local-coding-command): + Tweak docstring. + (tramp-sh-handle-write-region): Tweak error message. + (tramp-sh-handle-vc-registered): Remove backends when the remote + binary does not exist. + (tramp-find-inline-encoding): Do not raise an error. + (tramp-make-copy-program-file-name): Tweak docstring. Handle also + the "nc" case. Quote result also locally. + + * net/tramp-smb.el (tramp-smb-handle-copy-directory) + (tramp-smb-handle-set-file-acl): Use `start-process'. + (tramp-smb-handle-insert-directory): Use progress reporter. + (tramp-smb-handle-rename-file): Flush also file properties of + FILENAME. + + * net/trampver.el: Update release number. + +2014-06-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * ses.el: Miscellaneous cleanups; use lexical-binding; avoid + add-to-list. + (ses-localvars): Remove ses--local-printer-list, unused. + (ses--metaprogramming): New macro. Use it to defvar variables. + (ses-set-localvars): Simplify. + (ses--locprn, ses-cell): Use defstruct. Change ses-cell's + property-list into an alist. + (ses-locprn-get-compiled, ses-locprn-compiled-aset) + (ses-locprn-get-def, ses-locprn-def-aset, ses-locprn-get-number): + Remove; use defstruct accessors/setters instead. + (ses-cell-formula-aset, ses-cell-printer-aset) + (ses-cell-references-aset): Remove, use setf instead. + (ses--alist-get): New function. + (ses-cell-property): Rename from ses-cell-property-get and rewrite. + Use an alist instead of a plist and don't do move-to-front since the + list is always short. + (ses-cell-property-get-fun, ses-cell-property-delq-fun) + (ses-cell-property-set-fun, ses-cell-property-set) + (ses-cell-property-pop-fun, ses-cell-property-get-handle) + (ses-cell-property-handle-car, ses-cell-property-handle-setcar): Remove. + (ses--letref): New macro. + (ses-cell-property-pop): Rewrite. + (ses--cell): Rename from ses-cell and make it into a function. + Make `formula' fallback on `value' if nil. + (ses--local-printer): Rename from ses-local-printer and make it into + a function. + (ses-set-cell): Turn it into a macro so finding the accessor from the + field name is done at compile time. + (ses-repair-cell-reference-all): Test presence of `sym' rather than + `ref' before adding `sym' to :ses-repair-reference. + (ses-calculate-cell): Use ses--letref rather than + ses-cell-property-get-handle. + (ses-write-cells): Use a single prin1-to-string. + (ses-setter-with-undo): New function. + (ses-aset-with-undo, ses-set-with-undo): Rewrite using it. + (ses-unset-with-undo): Remove. + (ses-load): Prefer apply' over `eval'. + (ses-read-printer, ses-set-column-width): Use standard "(default + foo)" format. + +2014-06-15 Glenn Morris <rgm@gnu.org> + + * Makefile.in (leim, semantic): Use `make -C' rather than `cd && make'. * progmodes/cc-langs.el: Require cl-lib. (Bug#17463) Replace delete-duplicates and mapcan by cl- versions throughout. And cl-macroexpand-all by macroexpand-all. (delete-duplicates, mapcan, cl-macroexpand-all): No need to declare. -2014-06-14 Eli Zaretskii <eliz@gnu.org> +2014-06-15 Eli Zaretskii <eliz@gnu.org> * subr.el (posn-col-row): Doc fix. (Bug#17768) -2014-06-14 Juri Linkov <juri@jurta.org> +2014-06-15 Juri Linkov <juri@jurta.org> * bindings.el: Put `ascii-character' property on keypad keys mapped to characters. (Bug#17759) -2014-06-13 Stefan Monnier <monnier@iro.umontreal.ca> +2014-06-15 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/smie.el (smie-next-sexp): Fix up "other-end" info when bumping forward into a closing paren (bug#17761). @@ -120,6 +307,130 @@ * term/xterm.el (xterm--version-handler): Work around for OSX Terminal.app (bug#17607). +2014-06-14 Ron Schnell <ronnie@driver-aces.com> + + * play/dunnet.el (dun-describe-room, dun-mode): + If a lamp is in the room, you won't be eaten by a grue. + +2014-06-13 Glenn Morris <rgm@gnu.org> + + * Makefile.in ($(lisp)/cus-load.el, $(lisp)/finder-inf.el) + (autoloads, $(lisp)/subdirs.el, compile-main, leim, semantic, compile) + (compile-always): GNU make automatically passes + command-line arguments to sub-makes. + + * calendar/calendar.el (calendar-generate-window): + Remove pointless call to font-lock-fontify-buffer. + +2014-06-13 Matthias Meulien <orontee@gmail.com> + + * simple.el (completion-list-mode-map): Navigate with tab and backtab + (bug#17767). + +2014-06-13 Stefan Monnier <monnier@iro.umontreal.ca> + + * simple.el (set-mark-command): Simplify a bit. + +2014-06-12 Nicolas Richard <theonewiththeevillook@yahoo.fr> + + * help.el (help--key-binding-keymap): New function. + (help--binding-locus): New function. + (describe-key): Mention the keymap in which the binding was + found. (bug#13948) + +2014-06-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * hippie-exp.el (he--all-buffers): New function. + (try-expand-line-all-buffers, try-expand-list-all-buffers) + (try-expand-dabbrev-all-buffers): Use it. + +2014-06-12 Emilio C. Lopes <eclig@gmx.net> + + * hippie-exp.el (try-expand-line-all-buffers) + (try-expand-list-all-buffers, try-expand-dabbrev-all-buffers): + Read hippie-expand-only-buffers and hippie-expand-ignore-buffers in the + original buffer, in case they're buffer-local. + +2014-06-12 Vincent Belaïche <vincentb1@users.sourceforge.net> + + * ses.el (ses-initial-global-parameters-re): New defconst, a + specific regexp is needed now that ses.el can handle both + file-format 2 --- ie. no local printers --- and 3 --- i.e. may have + local printers. + (ses-localvars): Add local variables needed for local printer handling. + (ses-set-localvars): Handle hashmap initialisation. + (ses-paramlines-plist): Add param-line for number of local printers. + (ses-paramfmt-plist): New defconst, needed for code factorization + between functions `ses-set-parameter' and + `ses-file-format-extend-paramter-list' + (ses-make-local-printer-info): New defsubst. + (ses-locprn-get-compiled, ses-locprn-compiled-aset) + (ses-locprn-get-def, ses-locprn-def-aset, ses-locprn-get-number) + (ses-cell-printer-aset): New defmacro. + (ses-local-printer-compile): New defun. + (ses-local-printer): New defmacro. + (ses-printer-validate, ses-call-printer): Add support for local + printer functions. + (ses-file-format-extend-paramter-list): New defun. + (ses-set-parameter): Use const `ses-paramfmt-plist' for code + factorization. + (ses-load): Add support for local printer functions. + (ses-read-printer): Update docstring and add support for local printer + functions. + (ses-refresh-local-printer, ses-define-local-printer): New defun. + (ses-safe-printer): Add support for local printer functions. + +2014-06-12 Ivan Andrus <darthandrus@gmail.com> + + * ffap.el (ffap-lax-url): New var (bug#17723). + (ffap-url-at-point): Use it. + (ffap-file-at-point): Avoid returning just "/". + +2014-06-12 Matthias Meulien <orontee@gmail.com> + + * progmodes/python.el (import skeleton): New skeleton (bug#17672). + (python-mode-map): Bind it. + + * progmodes/python.el (class skeleton): Don't erase last char of class + name (bug#17683). + +2014-06-12 Cameron Desautels <camdez@gmail.com> (tiny change) + + * help.el (where-is): Use `default' arg of completing-read (bug#17705). + +2014-06-12 Kevin Ryde <user42_kevin@yahoo.com.au> + + * files.el (auto-mode-alist): Map .ad files to xdefaults-mode + (bug#17745). + +2014-06-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * international/mule-cmds.el: Use lexical-binding. + (ucs-names): Simplify. + +2014-05-18 Eric Hanchrow <eric.hanchrow@gmail.com> + + * progmodes/python.el (run-python): Use read-shell-command. + +2014-06-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * rect.el: Make it possible to move bounds past EOL or into TABs. + (operate-on-rectangle): Use apply-on-rectangle. + (rectangle--mark-crutches): New var. + (rectangle--pos-cols, rectangle--col-pos, rectangle--point-col) + (rectangle--crutches, rectangle--reset-crutches): New functions. + (apply-on-rectangle): Obey crutches. Avoid setq. + Fix missing final iteration if end is at EOB&BOL. + (rectangle-mark-mode-map): Add remap bindings for + exchange-point-and-mark and char/line movements. + (rectangle--*-char): New function. + (rectangle-exchange-point-and-mark, rectangle-right-char) + (rectangle-left-char, rectangle-forward-char) + (rectangle-backward-char, rectangle-next-line) + (rectangle-previous-line): New commands. + (rectangle--place-cursor): New function. + (rectangle--highlight-for-redisplay): Use it. Use apply-on-rectangle. + 2014-06-08 Glenn Morris <rgm@gnu.org> * startup.el (initial-buffer-choice): Doc fix. @@ -128,63 +439,231 @@ * bookmark.el (bookmark-load): * uniquify.el (uniquify-buffer-name-style): Doc fixes. -2014-06-06 Juri Linkov <juri@jurta.org> +2014-06-08 Juri Linkov <juri@jurta.org> * desktop.el: Activate auto-saving on window configuration changes. (desktop-save-mode, desktop-auto-save-timeout): Add/remove - `desktop-auto-save-set-timer' to/from `window-configuration-change-hook'. + `desktop-auto-save-set-timer' to/from + `window-configuration-change-hook'. (desktop-auto-save-set-timer): Change REPEAT arg of `run-with-idle-timer' from t to nil. http://lists.gnu.org/archive/html/emacs-devel/2014-06/msg00147.html -2014-06-06 Santiago Payà i Miralta <santiagopim@gmail.com> +2014-06-08 Santiago Payà i Miralta <santiagopim@gmail.com> * vc/vc-hg.el (vc-hg-working-revision): Use "hg parent" and vc-hg-command (bug#17570). -2014-06-06 Stefan Monnier <monnier@iro.umontreal.ca> +2014-06-08 Stefan Monnier <monnier@iro.umontreal.ca> * international/mule-cmds.el (ucs-names): Add special entry for BEL (bug#17702). -2014-06-06 Glenn Morris <rgm@gnu.org> +2014-06-08 Glenn Morris <rgm@gnu.org> * startup.el (window-setup-hook): Doc fix. -2014-06-05 Glenn Morris <rgm@gnu.org> - * emacs-lisp/package.el (package-check-signature) (package-unsigned-archives): Doc fixes. -2014-06-03 Martin Rudalics <rudalics@gmx.at> +2014-06-08 Martin Rudalics <rudalics@gmx.at> * window.el (display-buffer-use-some-window): Don't make window used smaller than it was before (Bug#17671). -2014-06-03 Eli Zaretskii <eliz@gnu.org> +2014-06-08 Eli Zaretskii <eliz@gnu.org> * menu-bar.el (menu-bar-open): Fix last change: use the PC 'redisplay' instead of '(sit-for 0)'. -2014-06-03 Michael Albinus <michael.albinus@gmx.de> +2014-06-08 Michael Albinus <michael.albinus@gmx.de> - * net/tramp.el (tramp-ssh-controlmaster-options): Improve search - regexp. (Bug#17653) + * net/tramp.el (tramp-ssh-controlmaster-options): + Improve search regexp. (Bug#17653) -2014-06-03 Glenn Morris <rgm@gnu.org> +2014-06-08 Glenn Morris <rgm@gnu.org> * emacs-lisp/package.el (package-pinned-packages): Doc fix. -2014-06-02 Eli Zaretskii <eliz@gnu.org> +2014-06-08 Eli Zaretskii <eliz@gnu.org> * menu-bar.el (menu-bar-open): Fix invocation via M-x. -2014-06-01 Eli Zaretskii <eliz@gnu.org> +2014-06-06 Santiago Payà i Miralta <santiagopim@gmail.com> + + * vc/vc-hg.el (vc-hg-create-tag, vc-hg-retrieve-tag): New functions + (bug#17586). + + * vc/vc-hg.el (vc-hg-log-graph): New var. + (vc-hg-print-log): Use it. + (vc-hg-root-log-format): Include branch name and bookmarks; ignore + graph output (bug#17515). + +2014-06-06 Stefan Monnier <monnier@iro.umontreal.ca> + + * mouse.el (mouse-posn-property): Ignore buffer position info when the + even happened elsewhere. + +2014-06-06 Mario Lang <mlang@delysid.org> + + * emacs-lisp/tabulated-list.el (tabulated-list-print): Only call + `recenter' if `current-buffer' is equal to `window-buffer'. + +2014-06-05 Leo Liu <sdl.web@gmail.com> + + * emacs-lisp/cl-macs.el (cl-macrolet): Avoid excessive progn's. + +2014-06-05 Michal Nazarewicz <mina86@mina86.com> + + * textmodes/tildify.el (tildify-foreach-region-outside-env): + New function which calls a callback on portions of the buffer that are + outside of ignored environments. + (tildify-build-regexp): Remove function since it is now + incorporated in `tildify-foreach-region-outside-env' where it is + optimised and simplified by the use of `mapconcat'. + (tildify-tildify): Return number of substitutions made so that… + (tildify-count): …can be removed. + (tildify-find-env): Accept a new PAIRS argument which was + previously looked up in `tildify-ignored-environments-alist' each + time the function was called. With this change, the lookup is + performed only once in `tildify-foreach-region-outside-env'. + (tildify-region): Greatly simplify the function since now most of + the work is done by `tildify-foreach-region-outside-env'. + (tildify-mode-alist): Simplify slightly by avoiding if and setq + and instead using or. + + * textmodes/tildify.el (tildify-ignored-environments-alist): + Optimise environments regexes + + Each time beginning of an environment to ignore is found, + `tildify-find-env' needs to identify regexp for the ending + of the environment. This is done by trying all the opening + regexes on matched text in a loop, so to speed that up, this + loop should have fewer things to match, which can be done by + using alternatives in the opening regexes. + + Coincidentally, this should make matching of the opening + regexp faster as well thanks to the use of `regexp-opt' and + having common prefix pulled from many regexes. + + * textmodes/tildify.el (tildify-string-alist) + (tildify-ignored-environments-alist): Add `nxml-mode' to the list + of supported modes since `xml-mode' is no longer a thing but just + an alias to the former. Also include comments and insides of tags + in `tildify-ignored-environments-alist' for XML modes. Finally, + since XML does not define “ ”[1], use a numeric reference for + a no-break space (namely “ ”) + + [1] XML specification defines only a handful of predefined entities. + The list is at <http://www.w3.org/TR/REC-xml/#sec-predefined-ent> + and includes only <, >, &, ' and " (meaning <, + >, &, ' and " respectively). This is in contrast to HTML and even + XHTML which defined a whole bunch of entities including “ ”. + + * textmodes/tildify.el (tildify-pattern-alist) + (tildify-string-alist, tildify-ignored-environments-alist): + Improve defcustom's types by adding more tags explaining what each + value means and replace “sexp” used in + `tildify-ignored-environments-alist' with a full type declaration. + + * textmodes/tildify.el (tildify-find-env): Fix matched group + indexes in end-regex building + + When looking for a start of an ignore-environment, the regex is built + by concatenating regexes of all the environments configured in + `tildify-ignored-environments-alist'. So for example, the following + list could be used to match TeX's \verb and \verb* commands: + + (("\\\\verb\\(.\\)" . (1)) + ("\\\\verb\\*\\(.\\)" . (1))) + + This would result in the following regex being used to find the start + of any of the variants of the \verb command: + + \\\\verb\\(.\\)\\|\\\\verb\\*\\(.\\) + + But now, if “\\\\verb\\*\\(.\\)” matches, the first capture group + won't match anything, and thus (match-string 1) will be nil, which + will cause building of the end-matching regex to fail. + + Fix this by using capture groups from the time when the opening + regexes are matched individually. + + * textmodes/tildify.el (tildify-find-env): Fix end-regex building + in `tildify-find-env' + + The `tildify-ignored-environments-alist' allows the end-regex to + be provided not as a static string but mix of strings and indexes + of groups matched the begin-regex. For example, the “\verb!…!” + TeX-command (where “!” is an arbitrary character) is handled + using: + + ("\\\\verb\\*?\\(.\\)" . (1)) + + In the same way, the following should be supported as well: + + ("open-\\(.\\)" . ("end-" 1)) + + However the tildify-find-env function fails at + + (concat result + (if (stringp (setq aux (car expression))) + expression ; BUG: expression is a list + (regexp-quote (match-string aux)))) + + where the string part is handled incorrectly. + + The most trivial fix would be to replace `expression' in the + true-part of the if-statement with `aux', but instead, this commit + optimises `tildify-find-env' by changing it to use `mapconcat' + rather than open-coded while-loop. + +2014-06-05 Mario Lang <mlang@delysid.org> + + * woman.el (woman-mapcan): Remove. + (woman-parse-colon-path): Use cl-mapcan instead. + +2014-06-03 Rüdiger Sonderfeld <ruediger@c-plusplus.de> + + * register.el: Add link to Emacs manual in Commentary. + +2014-06-02 Sam Steingold <sds@gnu.org> + + * menu-bar.el (lookup-key-ignore-too-long): Extract from... + (popup-menu): ...here. + (menu-bar-open): Use it to avoid an error when `lookup-key' + returns a number. + +2014-06-02 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-call-process): Add traces. + (tramp-handle-unhandled-file-name-directory): Return "/". + +2014-06-02 Wilson Snyder <wsnyder@wsnyder.org> + + Sync with upstream verilog-mode revision 3cd8144. + * progmodes/verilog-mode.el (verilog-mode-version): Bump. + (verilog-auto-arg-format): New option, to support newlines in AUTOARG. + (verilog-type-font-keywords): Add nor. + (verilog-batch-execute-func): Force reading of Local Variables. + Fix printing "no changes to be saved" with verilog-batch. + (verilog-auto-arg-ports): Doc fix. + Add verilog-auto-arg-format to support newlines in AUTOARG. + (verilog-auto-arg): Doc fix. + +2014-06-02 Glenn Morris <rgm@gnu.org> + + * emulation/crisp.el, emulation/tpu-edt.el, emulation/tpu-extras.el: + * emulation/tpu-mapper.el, emulation/vi.el, emulation/vip.el: + * emulation/ws-mode.el: Move to obsolete/. + * Makefile.in (AUTOGEN_VCS): Update for moved tpu-edu.el. + +2014-06-02 Eli Zaretskii <eliz@gnu.org> * simple.el (keyboard-quit): Force update of mode lines, to remove the "Def" indicator, if we were defining a macro. (Bug#17615) -2014-06-01 Stefan Monnier <monnier@iro.umontreal.ca> +2014-06-02 Stefan Monnier <monnier@iro.umontreal.ca> * minibuffer.el (minibuffer-force-complete-and-exit): Obey minibuffer-default (bug#17545). @@ -192,19 +671,17 @@ * progmodes/js.el (js-indent-line): Don't mix columns and chars (bug#17619). -2014-05-31 Stefan Monnier <monnier@iro.umontreal.ca> - * subr.el (set-transient-map): Don't wait for some "nested" transient-map to finish if we're only supposed to be active for the next command (bug#17642). -2014-05-31 Leo Liu <sdl.web@gmail.com> +2014-06-02 Leo Liu <sdl.web@gmail.com> * emacs-lisp/gv.el (window-buffer, window-display-table) (window-dedicated-p, window-hscroll, window-point, window-start): Fix gv-expander. (Bug#17630) -2014-05-31 Stefan Monnier <monnier@iro.umontreal.ca> +2014-06-02 Stefan Monnier <monnier@iro.umontreal.ca> * mouse.el (mouse-posn-property): Ignore posn-point for mode-line clicks (bug#17633). @@ -213,20 +690,20 @@ for the single comma, since ", " is *very* common in normal French text (bug#17643). -2014-05-30 Glenn Morris <rgm@gnu.org> +2014-06-02 Glenn Morris <rgm@gnu.org> * emacs-lisp/package.el (package-check-signature) (package-unsigned-archives): Fix :version. -2014-05-29 Stefan Monnier <monnier@iro.umontreal.ca> +2014-06-02 Stefan Monnier <monnier@iro.umontreal.ca> * subr.el (sit-for): Don't run input-methods (bug#15614). -2014-05-28 Glenn Morris <rgm@gnu.org> +2014-06-02 Glenn Morris <rgm@gnu.org> * cus-start.el: Fix some :version numbers. -2014-05-27 Stefan Monnier <monnier@iro.umontreal.ca> +2014-06-02 Stefan Monnier <monnier@iro.umontreal.ca> * simple.el (deactivate-mark): Set mark-active to nil even if deactivation is done via setting transient-mark-mode to nil, @@ -235,7 +712,7 @@ * emacs-lisp/byte-opt.el (byte-optimize-binary-predicate): Don't assume there can't be more than 2 arguments (bug#17584). -2014-05-27 Glenn Morris <rgm@gnu.org> +2014-06-02 Glenn Morris <rgm@gnu.org> * simple.el (filter-buffer-substring-functions) (filter-buffer-substring-function, buffer-substring-filters) @@ -247,27 +724,140 @@ * abbrev.el (abbrev-expand-functions, abbrev-expand-function) (expand-abbrev, abbrev--default-expand): Doc fixes. -2014-05-26 Paul Eggert <eggert@cs.ucla.edu> +2014-06-02 Paul Eggert <eggert@cs.ucla.edu> Include sources used to create macuvs.h. * international/README: Refer to the Unicode Terms of Use rather than copying it bodily here, as that simplifies maintenance. -2014-05-25 Andreas Schwab <schwab@linux-m68k.org> +2014-06-01 Glenn Morris <rgm@gnu.org> + + * loadup.el (load-prefer-newer): Set non-nil when dumping. (Bug#17629) + +2014-05-31 Glenn Morris <rgm@gnu.org> + + * files.el (locate-dominating-file): Expand file argument. (Bug#17641) + +2014-05-30 Glenn Morris <rgm@gnu.org> + + * loadup.el: Treat `command-line-args' more flexibly. + +2014-05-30 Alan Mackenzie <acm@muc.de> + + Guard (looking-at "\\s!") from XEmacs. + * progmodes/cc-engine.el (c-state-pp-to-literal): add guard form. + +2014-05-30 Ken Olum <kdo@cosmos.phy.tufts.edu> (tiny change) + + * mail/rmail.el (rmail-delete-forward, rmail-delete-backward): + The argument COUNT is now optional, to be more backward-compatible. + Doc fix. (Bug#17560) + +2014-05-29 Reuben Thomas <rrt@sc3d.org> + + * whitespace.el (whitespace-report-region): + Simplify documentation. + (whitespace-report-region): Allow report-if-bogus to take the + value `never', for non-interactive use. + (whitespace-report): Refer to whitespace-report-region's + documentation. + +2014-05-29 Stefan Monnier <monnier@iro.umontreal.ca> + + * whitespace.el: Use font-lock-flush. Minimize refontifications. + Side benefit: it works without jit-lock. + (whitespace-point--used): New buffer-local var. + (whitespace-color-on): Initialize it and flush it. Use font-lock-flush. + (whitespace-color-off): Use font-lock-flush. + (whitespace-point--used, whitespace-point--flush-used): New functions. + (whitespace-trailing-regexp, whitespace-empty-at-bob-regexp) + (whitespace-empty-at-eob-regexp): Use them. + (whitespace-post-command-hook): Rewrite. + + * font-lock.el (font-lock-flush, font-lock-ensure): New functions. + (font-lock-fontify-buffer): Mark interactive-only. + (font-lock-multiline, font-lock-fontified, font-lock-set-defaults): + Make buffer-local. + (font-lock-specified-p): Remove redundant boundp check. + (font-lock-flush-function, font-lock-ensure-function): New vars. + (font-lock-turn-on-thing-lock): Set them. + (font-lock-default-fontify-buffer): Obey font-lock-dont-widen. + (font-lock-after-change-function): Make `old-len' optional. + (font-lock-set-defaults): Remove redundant `set' of font-lock-defaults. + Call font-lock-flush, just in case. + * progmodes/verilog-mode.el (verilog-preprocess): Disable workaround in + recent Emacsen. + * progmodes/vera-mode.el (vera-fontify-buffer): Declare obsolete. + (vera-mode-map, vera-mode-menu): Remove bindings to it. + * progmodes/idlw-help.el (idlwave-help-fontify): Use font-lock-ensure + and with-syntax-table. + * textmodes/conf-mode.el (conf-quote-normal): + * progmodes/sh-script.el (sh-set-shell): + * progmodes/prog-mode.el (prettify-symbols-mode): + * progmodes/f90.el (f90-font-lock-n): + * progmodes/cwarn.el (cwarn-mode): + * nxml/nxml-mode.el (nxml-toggle-char-ref-extra-display): + * progmodes/compile.el (compilation-setup, compilation--unsetup): + * hi-lock.el (hi-lock-mode, hi-lock-unface-buffer) + (hi-lock-set-pattern, hi-lock-set-file-patterns): Use font-lock-flush. + * mail/rmail.el (rmail-variables): Set font-lock-dont-widen instead of + font-lock-fontify-buffer-function and + font-lock-unfontify-buffer-function. + (rmail-unfontify-buffer-function, rmail-fontify-message): + Use with-silent-modifications. + * htmlfontify.el (hfy-force-fontification): Use jit-lock-fontify-now + and font-lock-ensure. + * bs.el (bs-show-in-buffer): Use font-lock-ensure. + +2014-05-28 Thien-Thi Nguyen <ttn@gnu.org> + + * emacs-lisp/package.el (package-generate-autoloads): + Inhibit backup files. + +2014-05-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/hideshow.el (hs-hide-all): Call syntax-propertize + (bug#17608). + +2014-05-21 Michal Nazarewicz <mina86@mina86.com> + + * textmodes/tildify.el (tildify-buffer, tildify-region): + Add dont-ask option. + +2014-05-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * subr.el (zerop): Move from C. Add compiler-macro (bug#17475). + * emacs-lisp/byte-opt.el (byte-optimize-zerop): Remove. + + * subr.el (internal--funcall-interactively): New. + (internal--call-interactively): Remove. + (called-interactively-p): Detect funcall-interactively instead of + call-interactively. + * simple.el (repeat-complex-command): Use funcall-interactively. + (repeat-complex-command--called-interactively-skip): Remove. + +2014-05-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * register.el (register-read-with-preview): Don't burp on + frame switches (e.g. due to the frame we just popped). + + * mouse.el (mouse-set-region): Handle spurious drag events (bug#17562). + (mouse-drag-track): Annotate `mouse-drag-start' so we know we moved. + +2014-05-26 Andreas Schwab <schwab@linux-m68k.org> * cus-face.el (custom-face-attributes): Add :distant-foreground. -2014-05-25 Martin Rudalics <rudalics@gmx.at> +2014-05-26 Martin Rudalics <rudalics@gmx.at> - * window.el (window--dump-frame): Remove interactive - specification. + * window.el (window--dump-frame): Remove interactive specification. -2014-05-23 Glenn Morris <rgm@gnu.org> +2014-05-26 Glenn Morris <rgm@gnu.org> * hippie-exp.el (he-line-search-regexp): Handle comint-prompt-regexp containing subgroups. (Bug#17529) -2014-05-23 Stephen Berman <stephen.berman@gmx.net> +2014-05-26 Stephen Berman <stephen.berman@gmx.net> * calendar/todo-mode.el: Remove dependence on auto-mode-alist, to avoid errors when trying to create or visit a file foo.todo @@ -289,14 +879,14 @@ (auto-mode-alist): Remove add-to-list calls making Todo file extensions unrestrictedly tied to Todo modes. -2014-05-23 Stefan Monnier <monnier@iro.umontreal.ca> +2014-05-26 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/nadvice.el (advice--member-p): Change second arg. (advice-function-member-p): Tell it to check both names and functions (bug#17531). (advice--add-function): Adjust call accordingly. -2014-05-23 Stephen Berman <stephen.berman@gmx.net> +2014-05-26 Stephen Berman <stephen.berman@gmx.net> * calendar/todo-mode.el: Miscellaneous bug fixes. (todo-delete-file): When deleting an archive but not its todo @@ -328,21 +918,21 @@ (todo-reset-highlight-item): Also reset in filtered items files. Fix incorrect variable reference in document string. -2014-05-22 Glenn Morris <rgm@gnu.org> +2014-05-26 Glenn Morris <rgm@gnu.org> * window.el (window--dump-frame): Avoid error in --without-x builds. -2014-05-21 Glenn Morris <rgm@gnu.org> +2014-05-26 Glenn Morris <rgm@gnu.org> * nxml/nxml-mode.el (xml-mode): Only define this alias once. -2014-05-21 Eli Zaretskii <eliz@gnu.org> +2014-05-26 Eli Zaretskii <eliz@gnu.org> * frame.el (set-frame-font): Doc fix. * menu-bar.el (menu-set-font): Doc fix. (Bug#17532) -2014-05-21 Dmitry Gutov <dgutov@yandex.ru> +2014-05-26 Dmitry Gutov <dgutov@yandex.ru> * emacs-lisp/package.el (package--download-one-archive): Use `write-region' instead of `save-buffer' to avoid running various @@ -350,7 +940,7 @@ (describe-package-1): Same. Insert newline at the end of the buffer if appropriate. -2014-05-20 Juri Linkov <juri@jurta.org> +2014-05-26 Juri Linkov <juri@jurta.org> * avoid.el (mouse-avoidance-set-mouse-position): Don't raise frame. (mouse-avoidance-ignore-p): Remove `switch-frame', add `focus-out'. @@ -360,7 +950,7 @@ * avoid.el (mouse-avoidance-banish-position): Fix defcustom :options to allow changing its value with `set-variable'. -2014-05-20 Stefan Monnier <monnier@iro.umontreal.ca> +2014-05-26 Stefan Monnier <monnier@iro.umontreal.ca> * progmodes/scheme.el (scheme-mode-syntax-table): Remove hack for #; comments. @@ -372,32 +962,136 @@ * emacs-lisp/lisp.el (end-of-defun): Ensure we move (bug#17274). -2014-05-18 Stefan Monnier <monnier@iro.umontreal.ca> - * emacs-lisp/timer.el (timer-event-handler): Don't run if canceled (bug#17392). -2014-05-17 Michael Albinus <michael.albinus@gmx.de> +2014-05-26 Michael Albinus <michael.albinus@gmx.de> * net/tramp-sh.el (tramp-find-inline-encoding): Do not match "%%t" for a temporary file name. -2014-05-17 Eli Zaretskii <eliz@gnu.org> +2014-05-26 Eli Zaretskii <eliz@gnu.org> * simple.el (line-move-ignore-invisible): Doc fix. (Bug#17511) -2014-05-16 Michael Albinus <michael.albinus@gmx.de> +2014-05-26 Michael Albinus <michael.albinus@gmx.de> * net/dbus.el (dbus-init-bus, dbus-call-method) (dbus-call-method-asynchronously, dbus-send-signal) (dbus-method-return-internal, dbus-method-error-internal): Check, whether Emacs has been compiled with D-Bus support. (Bug#17508) -2014-05-14 Nicolas Richard <theonewiththeevillook@yahoo.fr> +2014-05-26 Nicolas Richard <theonewiththeevillook@yahoo.fr> * emacs-lisp/eieio-opt.el (eieio-help-class): Correctly deal with methods which do not have a doc string. (Bug#17490) +2014-05-25 Tassilo Horn <tsdh@gnu.org> + + * textmodes/reftex-ref.el (reftex-format-special): Make it work + also for AMS Math's \eqref macro. + +2014-05-25 Thien-Thi Nguyen <ttn@gnu.org> + + Arrange to never byte-compile the generated -pkg.el file. + + * emacs-lisp/package.el (package-generate-description-file): + Output first-line comment to set buffer-local var `no-byte-compile'. + Suggested by Dmitry Gutov: + <http://lists.gnu.org/archive/html/emacs-devel/2014-05/msg00401.html>. + +2014-05-25 Thien-Thi Nguyen <ttn@gnu.org> + + Fix bug: Properly quote args to generated -pkg.el `define-package'. + + * emacs-lisp/package.el (package-generate-description-file): + Inline `package--alist-to-plist'; rewrite to selectively + quote alist values that are not self-quoting. + (package--alist-to-plist): Delete func. + +2014-05-25 Andreas Schwab <schwab@linux-m68k.org> + + * term/xterm.el (xterm-function-map): Add mapping for shifted + keypad keys. + +2014-05-24 Daniel Colascione <dancol@dancol.org> + + * progmodes/subword.el (subword-find-word-boundary): Move point to + correct spot before search. (Bug#17580) + + * emacs-lisp/nadvice.el (defun): Write in eval-and-compile to avoid + breaking the build. + +2014-05-24 Leo Liu <sdl.web@gmail.com> + + * calc/calc.el (math-bignum): Handle most-negative-fixnum. (Bug#17556) + +2014-05-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * minibuffer.el (completion--sreverse): Remove. + (completion--common-suffix): Use `reverse' instead. + * emacs-lisp/regexp-opt.el (regexp-opt-group): Use `reverse' on strings. + +2014-05-22 Glenn Morris <rgm@gnu.org> + + * shell.el (shell-mode) <shell-dirstack-query>: Bypass bash aliases. + +2014-05-21 Daniel Colascione <dancol@dancol.org> + + * files.el (interpreter-mode-alist): Add mksh. + + * progmodes/sh-script.el (sh-ancestor-alist): Add mksh, a pdksh + derivative. + (sh-alias-alist): Alias /system/bin/sh (Android's system shell) to + mksh. Improve custom spec; allow regular expressions. + (sh-shell): Delegate name splitting to `sh-canonicalize-shell'. + (sh-after-hack-local-variables): New function. + (sh-mode): Use it; respect file-local `sh-shell' variable. (bug#17333) + (sh-set-shell): Use `sh-canonicalize-shell' instead of open-coding + the normalization. + (sh-canonicalize-shell): Rewrite to support regexes. + +2014-05-21 Leo Liu <sdl.web@gmail.com> + + * emacs-lisp/cl-lib.el (cl-endp): Fix last change. + +2014-05-19 Leo Liu <sdl.web@gmail.com> + + * emacs-lisp/cl-lib.el (cl-endp): Conform to CL's semantics. + +2014-05-18 Glenn Morris <rgm@gnu.org> + + * loadup.el: + * play/gametree.el: `track-mouse' is always defined since 2012-11-24. + +2014-05-14 Sam Steingold <sds@gnu.org> + + * progmodes/python.el (python-shell-get-or-create-process): + Do not bind `current-prefix-arg' so that C-c C-z does not talk + back unless requested. + +2014-05-14 Glenn Morris <rgm@gnu.org> + + * subr.el (with-file-modes): New macro. + * printing.el (pr-save-file-modes): Make obsolete. + * eshell/esh-util.el (eshell-with-file-modes): Make obsolete. + * emacs-lisp/lisp-mode.el (lisp-el-font-lock-keywords-2): + Add with-file-modes. + * doc-view.el (doc-view-make-safe-dir): + * epg.el (epg--start): + * files.el (locate-user-emacs-file, make-temp-file) + (backup-buffer-copy, move-file-to-trash): + * printing.el (pr-despool-print, pr-call-process, pr-text2ps): + * eshell/esh-util.el (eshell-with-private-file-modes) + (eshell-make-private-directory): + * net/browse-url.el (browse-url-mosaic): + * obsolete/mailpost.el (post-mail-send-it): + * obsolete/pgg-pgp.el (pgg-pgp-verify-region): + * obsolete/pgg-pgp5.el (pgg-pgp5-verify-region): + Use with-file-modes. + + * vc/emerge.el (emerge-make-temp-file): Simplify. + 2014-05-14 Stephen Berman <stephen.berman@gmx.net> Stefan Monnier <monnier@iro.umontreal.ca> @@ -410,34 +1104,49 @@ Make pointless option obsolete. (emerge-temp-file-mode): Make non-functional option obsolete. -2014-05-13 Michael Albinus <michael.albinus@gmx.de> +2014-05-14 Michael Albinus <michael.albinus@gmx.de> * net/browse-url.el (browse-url): Use `unhandled-file-name-directory' when setting `default-directory', in order to circumvent stalled remote connections. (Bug#17425) +2014-05-14 Glenn Morris <rgm@gnu.org> + + * printing.el (subst-char-in-string, make-temp-file, pr-get-symbol): + Optimize on Emacs, which has the relevant functions for ages. + +2014-05-13 Stefan Monnier <monnier@iro.umontreal.ca> + + * simple.el (undo-make-selective-list): Obey undo-no-redo. + +2014-05-12 Sam Steingold <sds@gnu.org> + + * calendar/time-date.el (seconds-to-string): New function to + pretty print time delay in seconds. + 2014-05-12 Stefan Monnier <monnier@iro.umontreal.ca> + * mpc.el (mpc-format): Trim Date to the year. + (mpc-songs-hashcons): Shorten the Date field. + * emacs-lisp/nadvice.el (advice--interactive-form): Don't get fooled into autoloading just because of a silly indirection. -2014-05-11 Santiago Payà i Miralta <santiagopim@gmail.com> (tiny change) +2014-05-12 Santiago Payà i Miralta <santiagopim@gmail.com> * vc/vc-hg.el (vc-hg-unregister): New function. (Bug#17454) -2014-05-11 Glenn Morris <rgm@gnu.org> +2014-05-12 Glenn Morris <rgm@gnu.org> * emacs-lisp/find-gc.el: Move to ../admin. -2014-05-10 Glenn Morris <rgm@gnu.org> - * printing.el (pr-version): * ps-print.el (ps-print-version): Also mention bug-gnu-emacs. * net/browse-url.el (browse-url-mosaic): Create /tmp/Mosaic.PID as a private file. -2014-05-10 Stefan Monnier <monnier@iro.umontreal.ca> +2014-05-12 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/nadvice.el: Support adding a given function multiple times. (advice--member-p): If name is given, only compare the name. @@ -447,21 +1156,17 @@ (advice--add-function): Pass the name, if any, to advice--remove-function. -2014-05-09 Philipp Rumpf <prumpf@gmail.com> (tiny change) +2014-05-12 Philipp Rumpf <prumpf@gmail.com> (tiny change) * electric.el (electric-indent-post-self-insert-function): Don't use `pos' after modifying the buffer (bug#17449). -2014-05-09 Stefan Monnier <monnier@iro.umontreal.ca> - - * subr.el (function-put): Add function. - -2014-05-09 Stephen Berman <stephen.berman@gmx.net> +2014-05-12 Stephen Berman <stephen.berman@gmx.net> * calendar/todo-mode.el (todo-insert-item-from-calendar): Correct argument list to conform to todo-insert-item--basic. -2014-05-09 Glenn Morris <rgm@gnu.org> +2014-05-12 Glenn Morris <rgm@gnu.org> * files.el (cd-absolute): Test if directory is accessible rather than executable. (Bug#17330) @@ -469,21 +1174,60 @@ * progmodes/compile.el (recompile): Handle C-u M-x recompile from a non-compilation buffer. (Bug#17444) -2014-05-08 Juri Linkov <juri@jurta.org> - - * dired.el (dired-check-switches, dired-switches-recursive-p): - New functions. (Bug#17218) - (dired-switches-escape-p, dired-move-to-end-of-filename): - Use `dired-check-switches'. - (dired-insert-old-subdirs, dired-build-subdir-alist) - (dired-sort-R-check): Use `dired-switches-recursive-p'. - -2014-05-08 Glenn Morris <rgm@gnu.org> - * net/browse-url.el (browse-url-mosaic): Be careful when writing /tmp/Mosaic.PID. (Bug#17428) This is CVE-2014-3423. +2014-05-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * mouse.el: Use the normal toplevel loop while dragging. + (mouse-set-point): Handle multi-clicks. + (mouse-set-region): Handle multi-clicks for drags. + (mouse-drag-region): Update call accordingly. + (mouse-drag-track): Remove `do-mouse-drag-region-post-process' hack. + Use the normal event loop instead of a local while/read-event loop. + (global-map): Remove redundant bindings for double/triple-mouse-1. + * xt-mouse.el (xterm-mouse-translate-1): Only process one event at a time. + Generate synthetic down events when the protocol only sends up events. + (xterm-mouse-last): Remove. + (xterm-mouse--read-event-sequence-1000): Use xterm-mouse-last-down + terminal parameter instead. + (xterm-mouse--set-click-count): New function. + (xterm-mouse-event): Detect/generate double/triple clicks. + * reveal.el (reveal-close-old-overlays): Don't close while dragging. + + * info.el (Info-quoted): New face. + (Info-mode-font-lock-keywords): New var. + (Info-mode): Use it. + + * emacs-lisp/lisp-mode.el (preceding-sexp): Exclude leading "," which + are a hindrance for C-x C-e. + +2014-05-11 Leo Liu <sdl.web@gmail.com> + + * net/rcirc.el (rcirc-sentinel): Fix last change. + +2014-05-08 Sam Steingold <sds@gnu.org> + + * net/rcirc.el (rcirc-reconnect-delay): New user option. + (rcirc-sentinel): Auto-reconnect to the server if + `rcirc-reconnect-delay' is non-0 (but not more often than its + value in case the host is off-line). + +2014-05-09 Eli Zaretskii <eliz@gnu.org> + + * progmodes/grep.el (lgrep): Fix a typo in last commit. + +2014-05-09 Glenn Morris <rgm@gnu.org> + + * files.el (file-expand-wildcards): + * man.el (Man-support-local-filenames): + * printing.el (pr-i-directory, pr-interface-directory): + * progmodes/grep.el (lgrep, rgrep): + * textmodes/ispell.el (ispell-call-process) + (ispell-call-process-region, ispell-start-process) + (ispell-init-process): Use file-accessible-directory-p. + 2014-05-08 Stefan Monnier <monnier@iro.umontreal.ca> * xt-mouse.el: Drop spurious/oddly shaped events (bug#17378). @@ -492,30 +1236,30 @@ (xterm-mouse-event): Propagate it. (xterm-mouse-translate-1): Handle it. -2014-05-07 Stephen Berman <stephen.berman@gmx.net> +2014-05-08 Stephen Berman <stephen.berman@gmx.net> * calendar/todo-mode.el (todo-insert-item--apply-args): When all four slots of the parameter list are filled, make sure to pass it to the argument list of todo-insert-item--basic. -2014-05-06 Stefan Monnier <monnier@iro.umontreal.ca> +2014-05-08 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/package.el (package-compute-transaction): Topological sort. Add optional `seen' argument to detect and break infinite loops. -2014-05-06 Eli Zaretskii <eliz@gnu.org> +2014-05-08 Eli Zaretskii <eliz@gnu.org> * emacs-lisp/find-gc.el (find-gc-unsafe, find-unsafe-funcs) (trace-unsafe, trace-use-tree): Make parentheses style be according to Emacs style. -2014-05-06 Michael Albinus <michael.albinus@gmx.de> +2014-05-08 Michael Albinus <michael.albinus@gmx.de> * net/tramp-sh.el (tramp-remote-process-environment): Remove HISTFILE and HISTSIZE; it's too late to set them here. Add :version entry. (tramp-open-shell): Do not let-bind `tramp-end-of-output'. - Add "HISTFILE=/dev/null" to the shell's env arguments. Do not send + Add "HISTSIZE=/dev/null" to the shell's env arguments. Do not send extra "PSx=..." commands. (tramp-maybe-open-connection): Setenv HISTFILE to /dev/null. (Bug#17295) @@ -527,7 +1271,7 @@ name. (Bug#17415) This is CVE-2014-3424. -2014-05-06 Glenn Morris <rgm@gnu.org> +2014-05-08 Glenn Morris <rgm@gnu.org> * emacs-lisp/find-gc.el (find-gc-source-directory): Give it a value. (find-gc-source-files): Update some names. @@ -535,7 +1279,7 @@ Avoid predictable temp-file names. (http://bugs.debian.org/747100) This is CVE-2014-3422. -2014-05-05 Stefan Monnier <monnier@iro.umontreal.ca> +2014-05-08 Stefan Monnier <monnier@iro.umontreal.ca> * minibuffer.el (completion--try-word-completion): Revert fix for Bug#15980 (bug#17375). @@ -545,30 +1289,47 @@ Don't burp is xterm-mouse-last is not set as expected. Never return negative indices. -2014-05-05 Dmitry Gutov <dgutov@yandex.ru> +2014-05-08 Dmitry Gutov <dgutov@yandex.ru> * progmodes/ruby-mode.el (ruby-syntax-propertize-function): Backtrack one char if the global/char-literal var matcher hits inside a string. The next char could be the beginning of an expression expansion. -2014-05-05 Glenn Morris <rgm@gnu.org> +2014-05-08 Glenn Morris <rgm@gnu.org> * help-fns.el (describe-function-1): Test for an autoload before a macro, since `macrop' works on autoloads. (Bug#17410) -2014-05-05 Stefan Monnier <monnier@iro.umontreal.ca> +2014-05-08 Stefan Monnier <monnier@iro.umontreal.ca> * electric.el (electric-indent-functions-without-reindent): Add yaml. * minibuffer.el (completion-table-with-quoting) <completion--unquote>: Make sure the new point we return is within the new string (bug#17239). -2014-05-03 Eli Zaretskii <eliz@gnu.org> +2014-05-05 Daniel Colascione <dancol@dancol.org> + + * progmodes/compile.el (compilation-error-regexp-alist-alist): + Port `gnu' pattern to rx. + +2014-05-05 Jarek Czekalski <jarekczek@poczta.onet.pl> + + Remove unneeded prompt when closing a buffer with active + emacsclient ("Buffer ... still has clients"), #16548. + * server.el (server-start): Remove the only call to: + (server-kill-buffer-query-function): Remove. + +2014-05-04 Leo Liu <sdl.web@gmail.com> + + * calendar/diary-lib.el (calendar-chinese-month-name-array): + Defvar to pacify compiler. + +2014-05-04 Eli Zaretskii <eliz@gnu.org> * mail/rmailsum.el (rmail-new-summary-1): Fix a typo in a comment. -2014-05-03 Stefan Monnier <monnier@iro.umontreal.ca> +2014-05-04 Stefan Monnier <monnier@iro.umontreal.ca> * vc/ediff-diff.el (ediff-set-fine-diff-properties-in-one-buffer): Use nil rather than `default' for the "default" appearance (bug#17388). @@ -578,12 +1339,12 @@ * vc/ediff-init.el (ediff-set-overlay-face): Don't set help-echo if the overlay is not visible. -2014-05-02 Stephen Berman <stephen.berman@gmx.net> +2014-05-04 Stephen Berman <stephen.berman@gmx.net> * calendar/todo-mode.el (todo-edit-file): Use display-warning. (todo-menu): Uncomment and update. -2014-05-02 Stephen Berman <stephen.berman@gmx.net> +2014-05-04 Stephen Berman <stephen.berman@gmx.net> * calendar/todo-mode.el: Reimplement item editing to have the same basic user interface as item insertion, and make small UI and @@ -636,11 +1397,11 @@ (todo-key-bindings-t): Bind "e" to todo-edit-item. Remove bindings of deleted commands. -2014-05-02 Leo Liu <sdl.web@gmail.com> +2014-05-04 Leo Liu <sdl.web@gmail.com> * emacs-lisp/cl-macs.el (cl-deftype): Fix indentation. -2014-05-01 Glenn Morris <rgm@gnu.org> +2014-05-04 Glenn Morris <rgm@gnu.org> * allout-widgets.el (allout-widgets-tally) (allout-decorate-item-guides): @@ -654,20 +1415,74 @@ * textmodes/reftex-parse.el (reftex-using-biblatex-p): Doc fixes (replace `iff'). -2014-05-01 Stefan Monnier <monnier@iro.umontreal.ca> +2014-05-04 Stefan Monnier <monnier@iro.umontreal.ca> * mpc.el (mpc-volume-mouse-set): Don't burp at the boundaries. +2014-05-04 Leo Liu <sdl.web@gmail.com> + + Support Chinese diary entries in calendar and diary. (Bug#17393) + * calendar/cal-china.el (calendar-chinese-month-name-array): New var. + (calendar-chinese-from-absolute-for-diary) + (calendar-chinese-to-absolute-for-diary) + (calendar-chinese-mark-date-pattern, diary-chinese-mark-entries) + (diary-chinese-list-entries): New functions to list and mark + Chinese diary entries in the calendar window. + (diary-chinese-anniversary) + (diary-chinese-insert-anniversary-entry) + (diary-chinese-insert-entry, diary-chinese-insert-monthly-entry) + (diary-chinese-insert-yearly-entry): New commands to insert + Chinese diary entries. + + * calendar/diary-lib.el (diary-font-lock-keywords): + Support font-locking Chinese dates. + + * calendar/cal-menu.el (cal-menu-diary-menu): Add entries for + inserting Chinese diary entries. + + * calendar/calendar.el (diary-chinese-entry-symbol): + New customizable variable. + (calendar-mode-map): Add bindings for inserting Chinese diary + entries. + +2014-05-03 Juri Linkov <juri@jurta.org> + + * dired.el (dired-check-switches, dired-switches-recursive-p): + New functions. (Bug#17218) + (dired-switches-escape-p, dired-move-to-end-of-filename): + Use `dired-check-switches'. + (dired-insert-old-subdirs, dired-build-subdir-alist) + (dired-sort-R-check): Use `dired-switches-recursive-p'. + +2014-05-01 Barry O'Reilly <gundaetiapo@gmail.com> + + * simple.el (undo-make-selective-list): New algorithm fixes + incorrectness of position adjustments when undoing in region. + (Bug#17235) + (undo-elt-crosses-region): Make obsolete. + (undo-adjust-elt, undo-adjust-beg-end, undo-adjust-pos): + New functions to adjust positions using undo-deltas. + +2014-05-01 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/lisp-mode.el (lisp--match-hidden-arg): Only highlight past + the last consecutive closing paren (bug#17345). + +2014-04-30 Reuben Thomas <rrt@sc3d.org> + + * dired.el (dired-mode): make terminology for eXpunge command + consistent. (Bug#17276) + 2014-04-30 Eli Zaretskii <eliz@gnu.org> * dired.el (dired-initial-position-hook, dired-initial-position): Doc string fixes. -2014-04-29 Glenn Morris <rgm@gnu.org> +2014-04-30 Glenn Morris <rgm@gnu.org> * mail/rmail.el (rmail-quit): Handle killed summaries. (Bug#17283) -2014-04-27 Matthias Dahl <matthias.dahl@binary-island.eu> +2014-04-30 Matthias Dahl <matthias.dahl@binary-island.eu> * faces.el (face-spec-recalc): Apply X resources only after the defface spec has been applied. Thus, X resources are no longer @@ -675,37 +1490,71 @@ the toolbar coloring was wrong because it is set through X resources and was (wrongfully) overriden. (Bug#16694) -2014-04-28 Stefan Monnier <monnier@iro.umontreal.ca> +2014-04-30 Stefan Monnier <monnier@iro.umontreal.ca> * textmodes/rst.el (electric-pair-pairs): Declare. (rst-mode): Set it (bug#17131). -2014-04-27 Juri Linkov <juri@jurta.org> +2014-04-30 Juri Linkov <juri@jurta.org> * desktop.el (desktop-value-to-string): Let-bind `print-length' and `print-level' to nil. (Bug#17351) -2014-04-25 Nicolas Richard <theonewiththeevillook@yahoo.fr> +2014-04-30 Nicolas Richard <theonewiththeevillook@yahoo.fr> * battery.el (battery-update): Handle the case where battery status is "N/A" (bug#17319). -2014-04-24 Eli Zaretskii <eliz@gnu.org> +2014-04-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/ps-mode.el: Use SMIE. Move string and comment recognition + to syntax-propertize. + (ps-mode-auto-indent): Mark as obsolete. + (ps-mode-font-lock-keywords-1): Remove string-or-comment handling. + (ps-mode-font-lock-keywords-3): Use symbol regexp operators instead of + word regexp operators. + (ps-mode-map): Move initialization into declaration. Remove binding + for TAB, RET, >, ], and }. + (ps-mode-syntax-table): Move initialization into declaration. + Don't give word syntax to non-word chars. + (ps-run-mode-map): Move initialization into declaration. + (ps-mode-menu-main): Remove auto-indent entry. + (ps-mode-smie-rules): New function. + (ps-mode): Setup smie, syntax-propertize, and electric-indent-mode. + (ps-mode-looking-at-nested, ps-mode-match-string-or-comment): Remove. + (ps-mode--string-syntax-table): New const. + (ps-mode--syntax-propertize-special, ps-mode-syntax-propertize): + New functions. + (ps-mode-newline, ps-mode-tabkey, ps-mode-r-brace, ps-mode-r-angle) + (ps-mode-r-gt, ps-mode-r-balance): Remove functions. + +2014-04-27 Daniel Colascione <dancol@dancol.org> + + * term/xterm.el (xterm-paste): Use large finite timeout when + reading event to avoid putting keys in this-command-keys. + +2014-04-25 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/perl-mode.el (perl--syntax-exp-intro-regexp): New var. + (perl-syntax-propertize-function): Use it. Extend handling of + here-docs to the unquoted case. + +2014-04-25 Eli Zaretskii <eliz@gnu.org> * tooltip.el (tooltip-show-help-non-mode, tooltip-show-help): Use equal-including-properties to compare help-echo strings (bug#17331). -2014-04-24 Leo Liu <sdl.web@gmail.com> +2014-04-25 Leo Liu <sdl.web@gmail.com> * emacs-lisp/lisp-mode.el (emacs-lisp-mode-syntax-table): Fix syntax for @. (Bug#17325) -2014-04-24 Daniel Colascione <dancol@dancol.org> +2014-04-25 Daniel Colascione <dancol@dancol.org> * emacs-lisp/cl.el (gv): Require gv early to break eager macro-expansion cycles. -2014-04-23 Stefan Monnier <monnier@iro.umontreal.ca> +2014-04-25 Stefan Monnier <monnier@iro.umontreal.ca> * simple.el (region-active-p): Check there's a mark (bug#17324). @@ -721,11 +1570,42 @@ * progmodes/perl-mode.el (perl-syntax-propertize-function): Slash after &, |, +, - and * can't be a division (bug#17317). -2014-04-22 Stefan Monnier <monnier@iro.umontreal.ca> - * term/xterm.el (xterm--version-handler): Don't use modern xterm features on gnome-terminal (bug#16988). +2014-04-25 Thien-Thi Nguyen <ttn@gnu.org> + + Improve Scheme font-locking for (define ((foo ...) ...) ...). + + * progmodes/scheme.el (scheme-font-lock-keywords-1): To find + the declared object, ignore zero or more parens, not zero or one. + +2014-04-24 Leo Liu <sdl.web@gmail.com> + + * progmodes/xscheme.el (xscheme-expressions-ring) + (xscheme-expressions-ring-yank-pointer, xscheme-running-p) + (xscheme-control-g-disabled-p, xscheme-process-filter-state) + (xscheme-allow-output-p, xscheme-prompt) + (xscheme-string-accumulator, xscheme-mode-string): Use defvar-local. + + * progmodes/scheme.el (would-be-symbol, next-sexp-as-string): + Comment out unused functions. + +2014-04-24 Stefan Monnier <monnier@iro.umontreal.ca> + + * info.el: Use lexical-binding and cl-lib. + Use defvar-local and setq-local instead of make-local-variable. + (Info-apropos-matches): Avoid add-to-list. + (Info-edit-mode-map): Fix obsolescence call to Info-edit-map. + +2014-04-24 Daniel Colascione <dancol@dancol.org> + + * progmodes/sh-script.el (sh-builtins): Add coproc to list of bash builtins. + +2014-04-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/cl-macs.el (cl--loop-let): Fix last merge. + 2014-04-22 Michael Heerdegen <michael_heerdegen@web.de> * dired.el (dired-insert-set-properties): Do not consider @@ -739,30 +1619,119 @@ (tramp-do-copy-or-rename-file-out-of-band): Do not quote `source' and `target' twice. -2014-04-21 Stefan Monnier <monnier@iro.umontreal.ca> +2014-04-22 Stefan Monnier <monnier@iro.umontreal.ca> * dframe.el (dframe-get-focus): Remove `hook' argument (bug#17311). * speedbar.el (speedbar-get-focus): Run the "hook" afterwards instead. * emacs-lisp/cl-macs.el (cl--loop-let): Avoid `nil' as var name. -2014-04-21 Michael Albinus <michael.albinus@gmx.de> +2014-04-22 Michael Albinus <michael.albinus@gmx.de> * net/tramp-sh.el (tramp-sh-handle-file-name-all-completions): Set "IFS=" when using read builtin, in order to preserve spaces in the file name. Add test messages for hunting a bug on hydra. (tramp-get-ls-command): Undo using "-b" argument. It doesn't help. -2014-04-21 Stefan Monnier <monnier@iro.umontreal.ca> +2014-04-22 Stefan Monnier <monnier@iro.umontreal.ca> * progmodes/prog-mode.el (prettify-symbols--compose-symbol): Don't prettify a word within a symbol. -2014-04-20 Michael Albinus <michael.albinus@gmx.de> +2014-04-22 Michael Albinus <michael.albinus@gmx.de> * net/tramp-sh.el (tramp-get-ls-command): Use "-b" argument if possible. +2014-04-22 Daniel Colascione <dancol@dancol.org> + + * emacs-lisp/byte-run.el (function-put): Unbreak build: don't + use defun to define `function-put'. + +2014-04-22 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/lisp-mode.el (lisp--match-hidden-arg): New function. + (lisp-el-font-lock-keywords-2, lisp-cl-font-lock-keywords-2): Use it. + (lisp-mode-variables): Set font-lock-extra-managed-props. + + * emacs-lisp/byte-run.el (function-put): New function. + (defun-declarations-alist): Use it. Add `pure' and `side-effect-free'. + * emacs-lisp/cl-macs.el (cl-defstruct, cl-struct-sequence-type) + (cl-struct-slot-info, cl-struct-slot-offset, cl-struct-slot-value): + Use them. + +2014-04-22 Daniel Colascione <dancol@dancol.org> + + * emacs-lisp/macroexp.el (internal-macroexpand-for-load): + Add `full-p' parameter; when nil, call `macroexpand' instead of + `macroexpand-all'. + + * emacs-lisp/byte-run.el (eval-when-compile, eval-and-compile): + Improve docstrings. + + * emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment): + Use lambda function values, not quoted lambdas. + (byte-compile-recurse-toplevel): Remove extraneous &optional. + + * emacs-lisp/cl-macs.el + (cl-struct-sequence-type, cl-struct-slot-info): Declare pure. + (cl-struct-slot-value): Conditionally use aref or nth so that the + compiler produces optimal code. + +2014-04-22 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/cl-macs.el (cl-struct-slot-offset): Mark as pure. + (inline): Don't inline cl--set-elt. + (cl-struct-slot-value): Remove explicit gv-setter and compiler-macro. + Define as inlinable instead. + (cl-struct-set-slot-value): Remove. + + * emacs-lisp/cl-lib.el (cl--set-elt): Remove. + * emacs-lisp/cl-seq.el (cl-replace, cl-substitute, cl-nsubstitute): + Use setf instead. + +2014-04-21 Daniel Colascione <dancol@dancol.org> + + * emacs-lisp/cl-macs.el (cl--const-expr-val): We didn't need the + last two parameters after all. + (cl--expr-contains,cl--compiler-macro-typep,cl--compiler-macro-member) + (cl--compiler-macro-assoc,cl-struct-slot-value) + (cl-struct-set-slot-value): Stop using them. + +(2014-04-21 Stefan Monnier <monnier@iro.umontreal.ca> + + * image-mode.el (image-mode-window-put): Don't assume there's a `t' + entry in image-mode-winprops-alist. + +2014-04-21 Daniel Colascione <dancol@dancol.org> + + * emacs-lisp/bytecomp.el (byte-compile-recurse-toplevel): New function. + (byte-compile-recurse-toplevel, byte-compile-initial-macro-environment) + (byte-compile-toplevel-file-form): Use it. + + * emacs-lisp/cl-macs.el: + (cl--loop-let): Properly destructure `while' clauses. + +2014-04-20 Daniel Colascione <dancol@dancol.org> + + * vc/vc.el (vc-root-dir): New public autoloaded function for + generically finding the current VC root. + * vc/vc-hooks.el (vc-not-supported): New error. + (vc-call-backend): Signal `vc-not-supported' instead of generic error. + +2014-04-20 Daniel Colascione <dancol@dancol.org> + + * emacs-lisp/cl-macs.el (cl-the): Make `cl-the' assert its type + argument. + (cl--const-expr-val): cl--const-expr-val should macroexpand its + argument in case we're inside a symbol-macrolet. + (cl--do-arglist, cl--compiler-macro-typep) + (cl--compiler-macro-member, cl--compiler-macro-assoc): Pass macro + environment to `cl--const-expr-val'. + (cl-struct-sequence-type,cl-struct-slot-info) + (cl-struct-slot-offset, cl-struct-slot-value) + (cl-struct-set-slot-value): New functions. + 2014-04-19 Stefan Monnier <monnier@iro.umontreal.ca> * progmodes/sh-script.el (sh-smie--sh-keyword-p): Handle variable @@ -785,12 +1754,46 @@ * net/tramp-compat.el (tramp-unload-hook): Unload `tramp-loaddefs'. -2014-04-16 Stefan Monnier <monnier@iro.umontreal.ca> +2014-04-17 Daniel Colascione <dancol@dancol.org> + + Add support for bracketed paste mode; add infrastructure for + managing terminal mode enabling and disabling automatically. + + * xt-mouse.el: + (xterm-mouse-mode): Simplify. + (xterm-mouse-tracking-enable-sequence) + (xterm-mouse-tracking-disable-sequence): New constants. + (turn-on-xterm-mouse-tracking-on-terminal) + (turn-off-xterm-mouse-tracking-on-terminal): + Use tty-mode-set-strings and tty-mode-reset-strings terminal + parameters instead of random hooks. + (turn-on-xterm-mouse-tracking) + (turn-off-xterm-mouse-tracking): Delete. + + * term/xterm.el (xterm-extra-capabilities): Fix bitrotted comment. + (xterm-paste-ending-sequence): New constant. + (xterm-paste): New command used for bracketed paste support. + + (xterm-modify-other-keys-terminal-list): Delete obsolete variable. + (terminal-init-xterm-bracketed-paste-mode): New function. + (terminal-init-xterm): Call it. + (terminal-init-xterm-modify-other-keys): Use tty-mode-set-strings + and tty-mode-reset-strings instead of random hooks. + (xterm-turn-on-modify-other-keys) + (xterm-turn-off-modify-other-keys) + (xterm-remove-modify-other-keys): Delete obsolete functions. + + * term/screen.el: Rewrite to just use the xterm code. + Add copyright notice. Mention tmux. + +2014-04-17 Ian D <dunni@gnu.org> (tiny change) + + * image-mode.el (image-mode-window-put): Also update the property of + the "default window". + * doc-view.el (doc-view-new-window-function): If no window + exists, move to the last known page. - * nxml/nxml-mode.el (nxml-fontify-matcher): Make sure propertization - was done (bug#17264). - * nxml/xmltok.el (xmltok-scan-after-comment-open): Extend unclosed - comment to EOB. +2014-04-16 Stefan Monnier <monnier@iro.umontreal.ca> * progmodes/perl-mode.el (perl-calculate-indent): Don't auto-indent in here-documents (bug#17262). @@ -800,7 +1803,7 @@ * term/pc-win.el (x-list-fonts, x-get-selection-value): Provide doc strings, as required by snarf-documentation. -2014-04-15 Stefan Monnier <monnier@iro.umontreal.ca> +2014-04-16 Stefan Monnier <monnier@iro.umontreal.ca> * ps-def.el (ps-generate-postscript-with-faces1): Use the new `sorted' arg of overlays-at. Use `invisible-p'. @@ -810,46 +1813,69 @@ overlays-at. (hfy-fontify-buffer): Remove unused var `orig-ovls'. -2014-04-14 João Távora <joaotavora@gmail.com> +2014-04-16 João Távora <joaotavora@gmail.com> * net/shr.el (shr-expand-url): Use `expand-file-name' for relative links. (Bug#17217). -2014-04-14 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> +2014-04-16 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> * vc/ediff-diff.el (ediff-set-fine-diff-properties-in-one-buffer): Use mapc to loop over a vector. (Bug#17257). -2014-04-13 Michael Albinus <michael.albinus@gmx.de> +2014-04-16 Michael Albinus <michael.albinus@gmx.de> * net/tramp-sh.el (tramp-sh-handle-file-truename): Revert previous patch, there are new problems with file names containing spaces. Get rid of backticks. (Bug#17238) -2014-04-13 João Távora <joaotavora@gmail.com> +2014-04-16 João Távora <joaotavora@gmail.com> * elec-pair.el (electric-pair--syntax-ppss): Simplify and fix possible bug. -2014-04-13 Eli Zaretskii <eliz@gnu.org> +2014-04-16 Eli Zaretskii <eliz@gnu.org> * frame.el (blink-cursor-blinks, blink-cursor-blinks-done): Doc fixes. (blink-cursor-mode): Mention customization variables and the effect of 'blink-cursor-blinks'. -2014-04-12 Barry O'Reilly <gundaetiapo@gmail.com> +2014-04-16 Barry O'Reilly <gundaetiapo@gmail.com> * simple.el (undo): Prevent insertion of identity mapping into undo-equiv-table so as undo-only does not inf loop in the presence of consecutive nils in undo list. -2014-04-12 Matthias Dahl <matthias.dahl@binary-island.eu> +2014-04-16 Matthias Dahl <matthias.dahl@binary-island.eu> * faces.el (make-face): Deprecate optional argument as it is no longer needed/used since the conditional X resources handling has been pushed down to make-face-x-resource-internal itself. (make-empty-face): Don't pass optional argument to make-face. +2014-04-16 Karl Fogel <kfogel@red-bean.com> + + * savehist.el (savehist-save): Remove workaround for a read-passwd + bug that was fixed before 24.3. Thanks to Juanma Barranquero for + noticing that the shim was still present. + +2014-04-14 Stefan Monnier <monnier@iro.umontreal.ca> + + * doc-view.el (doc-view-set-doc-type): Ignore file name case; add .pps. + +2014-04-14 Juanma Barranquero <lekktu@gmail.com> + + * faces.el (face-set-after-frame-default): Remove unused local variable. + +2014-04-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/grep.el: Use lexical-binding. + (grep-expand-template): Pass explicit lexical env to `eval'. + (zrgrep): Let-bind grep-find-template explicitly. + + * emacs-lisp/cl-lib.el (current-case-table): Remove setter. + * leim/quail/sisheng.el (sisheng-list): Use with-case-table. + 2014-04-12 Eli Zaretskii <eliz@gnu.org> * international/characters.el <standard-case-table>: Add entries @@ -858,24 +1884,34 @@ 2014-04-12 Leo Liu <sdl.web@gmail.com> - * progmodes/octave.el (completion-table-with-cache): Define if not - available. - (octave-goto-function-definition) - (octave-sync-function-file-names) - (octave-find-definition-default-filename): Backquote upattern for - compatibility. + * progmodes/octave.el (completion-table-with-cache): + Define if not available. + (octave-goto-function-definition, octave-sync-function-file-names) + (octave-find-definition-default-filename): + Backquote upattern for compatibility. -2014-04-11 Michael Albinus <michael.albinus@gmx.de> +2014-04-12 Michael Albinus <michael.albinus@gmx.de> * net/tramp-sh.el (tramp-sh-handle-file-truename): Quote the file name twice due to backticks. (Bug#17238) -2014-04-11 Glenn Morris <rgm@gnu.org> +2014-04-12 Glenn Morris <rgm@gnu.org> * term/w32-win.el (x-win-suspend-error): * term/x-win.el (x-win-suspend-error): Sync docs. -2014-04-10 Stefan Monnier <monnier@iro.umontreal.ca> +2014-04-12 Matthias Dahl <matthias.dahl@binary-island.eu> + + * faces.el (make-face): Remove deprecated optional argument. + The conditional application of X resources is handled directly by + make-face-x-resource-internal since Emacs 24.4. + (make-empty-face): Don't pass optional argument to make-face. + +2014-04-11 Glenn Morris <rgm@gnu.org> + + * Makefile.in (EMACSDATA, EMACSDOC, EMACSPATH): Unexport. (Bug#16429) + +2014-04-11 Stefan Monnier <monnier@iro.umontreal.ca> Ediff's overlay priorities cause more trouble than they solve. * vc/ediff-init.el (ediff-shadow-overlay-priority): Remove variable. @@ -885,12 +1921,12 @@ (ediff-set-fine-diff-properties-in-one-buffer): Don't mess with overlay priorities. -2014-04-10 Feng Li <fengli@gmail.com> (tiny change) +2014-04-11 Feng Li <fengli@gmail.com> (tiny change) * progmodes/pascal.el (pascal-font-lock-keywords): Fix incorrect format entry; use symbol boundaries to avoid mis-matches. -2014-04-10 Michael Albinus <michael.albinus@gmx.de> +2014-04-11 Michael Albinus <michael.albinus@gmx.de> * net/tramp.el (tramp-file-name-handler) (tramp-completion-file-name-handler): Avoid recursive loading. @@ -898,21 +1934,86 @@ * net/tramp-sh.el (tramp-make-copy-program-file-name): Quote result also locally. +2014-04-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * emulation/cua-base.el (<toplevel>, cua--pre-command-handler-1): + Remove left-over code. + + * newcomment.el (comment-indent-new-line): Sink code where it's used. + Reuse the previous comment's indentation unconditionally if it's on its + own line. + +2014-04-09 Daniel Colascione <dancol@dancol.org> + + * emacs-lisp/lisp.el (backward-up-list): Add `escape-strings', + `no-syntax-crossing' arguments. Forward to `up-list'. + (up-list): Add `escape-strings', `no-syntax-crossing' arguments. + Implement logic for escaping from strings. Use narrowing to deal + with corner cases. + +2014-04-09 Leo Liu <sdl.web@gmail.com> + + * net/rcirc.el (rcirc-connection-info): New variable. + (rcirc-connect): Use it to store connection info. + (rcirc-buffer-process): Avoid get-buffer-process which returns nil + for killed process. + (rcirc-cmd-reconnect): New command. (Bug#17045) + (rcirc-mode, set-rcirc-encode-coding-system) + (set-rcirc-decode-coding-system, rcirc-connect): Use setq-local. + +2014-04-09 Daniel Colascione <dancol@dancol.org> + + * emacs-lisp/cl-indent.el: Add comment claiming + facility is also good for elisp. + (lisp-indent-find-method): New function. + (common-lisp-indent-function): Recognize cl-loop. + (common-lisp-indent-function-1): Recognize cl constructs; use + `lisp-indent-find-method' instead of `get' directly. + (if): Use else-body style for elisp. + 2014-04-09 Dmitry Gutov <dgutov@yandex.ru> * progmodes/ruby-mode.el (ruby-font-lock-keywords): Highlight more Module methods. (Bug#17216) -2014-04-08 Stefan Monnier <monnier@iro.umontreal.ca> +2014-04-09 Stefan Monnier <monnier@iro.umontreal.ca> * help.el (describe-bindings): Fix buffer handling (bug#17210). (describe-bindings-internal): Mark obsolete. +2014-04-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * subr.el (with-silent-modifications): Don't bind deactivate-mark, + buffer-file-name, and buffer-file-truename any more. + +2014-04-08 Leo Liu <sdl.web@gmail.com> + + Use lexical-binding and require cl-lib. + * net/rcirc.el (rcirc, rcirc-handler-ctcp-KEEPALIVE) + (rcirc-handler-generic, rcirc-fill-paragraph) + (rcirc-format-response-string, rcirc-target-buffer) + (rcirc-last-line, rcirc-record-activity, rcirc-split-activity) + (rcirc-activity-string, rcirc-make-trees, rcirc-cmd-ctcp) + (rcirc-ctcp-sender-PING, rcirc-browse-url) + (rcirc-markup-timestamp, rcirc-markup-attributes) + (rcirc-markup-my-nick, rcirc-markup-urls) + (rcirc-markup-bright-nicks, rcirc-markup-fill) + (rcirc-check-auth-status, rcirc-handler-WALLOPS) + (rcirc-handler-JOIN, rcirc-handler-PART-or-KICK) + (rcirc-handler-PART, rcirc-handler-KICK, rcirc-handler-QUIT) + (rcirc-handler-NICK, rcirc-handler-PING, rcirc-handler-PONG) + (rcirc-handler-TOPIC, rcirc-handler-301, rcirc-handler-317) + (rcirc-handler-332, rcirc-handler-333, rcirc-handler-477) + (rcirc-handler-MODE, rcirc-handler-353, rcirc-handler-366) + (rcirc-authenticate, rcirc-handler-INVITE, rcirc-handler-ERROR) + (rcirc-handler-ctcp-VERSION, rcirc-handler-ctcp-TIME) + (rcirc-handler-CTCP-response): Fix unused arguments warnings and + use cl-lib. + 2014-04-07 João Távora <joaotavora@gmail.com> - * elec-pair.el: - (electric-pair--syntax-ppss): When inside comments parse from - comment beginning. + * elec-pair.el (electric-pair--syntax-ppss): + When inside comments parse from comment beginning. (electric-pair--balance-info): Fix typo in comment. (electric-pair--in-unterminated-string-p): Delete. (electric-pair--unbalanced-strings-p): New function. @@ -920,8 +2021,6 @@ (electric-pair-inhibit-if-helps-balance): Decide quote pairing according to `electric-pair--in-unterminated-string-p' -2014-04-07 João Távora <joaotavora@gmail.com> - * elec-pair.el (electric-pair-inhibit-if-helps-balance): Inhibit quote pairing if point-max is inside an unterminated string. (electric-pair--looking-at-unterminated-string-p): Delete. @@ -932,7 +2031,7 @@ * shell.el (shell-directory-tracker): Go back to just ignoring failures. (Bug#17159) -2014-04-06 João Távora <joaotavora@gmail.com> +2014-04-07 João Távora <joaotavora@gmail.com> Fix `electric-pair-delete-adjacent-pairs' in modes binding backspace. (bug#16981) @@ -942,33 +2041,29 @@ a new `electric-pair-delete-pair' command. (electric-pair-delete-pair): New command. -2014-04-06 João Távora <joaotavora@gmail.com> - * progmodes/python.el (python-electric-pair-string-delimiter): Fix triple-quoting electricity. (Bug#17192) -2014-04-06 João Távora <joaotavora@gmail.com> - * elec-pair.el (electric-pair-post-self-insert-function): Don't skip whitespace when `electric-pair-text-pairs' and `electric-pair-pairs' were used. syntax to electric-pair--skip-whitespace. (Bug#17183) -2014-04-06 Eli Zaretskii <eliz@gnu.org> +2014-04-07 Eli Zaretskii <eliz@gnu.org> * leim/quail/ipa.el (ipa-x-sampa): Fix the character produced for "<F>". (Bug#17199) -2014-04-06 Stefan Monnier <monnier@iro.umontreal.ca> +2014-04-07 Stefan Monnier <monnier@iro.umontreal.ca> * mpc.el (mpc--status-timer-run): Disable timer if not displayed. (mpc--status-idle-timer-run): Use mpc--status-timer-run. -2014-04-05 Glenn Morris <rgm@gnu.org> +2014-04-07 Glenn Morris <rgm@gnu.org> * help.el (view-lossage): Doc tweak. -2014-04-05 Matthias Dahl <matthias.dahl@binary-island.eu> +2014-04-07 Matthias Dahl <ml_emacs-lists@binary-island.eu> * faces.el (face-spec-recalc): Call make-face-x-resource-internal only when inhibit-x-resources is nil, and do that earlier in the @@ -983,30 +2078,30 @@ (face-set-after-frame-default): Don't call make-face-x-resource-internal here. (Bug#16434) -2014-04-04 Tassilo Horn <tsdh@gnu.org> +2014-04-07 Tassilo Horn <tsdh@gnu.org> * doc-view.el (doc-view-bookmark-jump): Use `bookmark-after-jump-hook' to jump to the right page after the buffer is shown in a window. (bug#16090) -2014-04-04 Eli Zaretskii <eliz@gnu.org> +2014-04-07 Eli Zaretskii <eliz@gnu.org> * international/characters.el (mirroring): Fix last change: instead of loading uni-mirrored.el explicitly, do that implicitly by creating the 'mirroring' uniprop table. This avoids announcing the loading of uni-mirrored.el. -2014-04-04 Glenn Morris <rgm@gnu.org> +2014-04-07 Glenn Morris <rgm@gnu.org> * files.el (buffer-stale--default-function) (buffer-stale-function, revert-buffer--default): * autorevert.el (auto-revert-buffers): Doc tweaks. -2014-04-03 Eli Zaretskii <eliz@gnu.org> +2014-04-07 Eli Zaretskii <eliz@gnu.org> * international/characters.el: Preload uni-mirrored.el. (Bug#17169) -2014-04-03 Glenn Morris <rgm@gnu.org> +2014-04-07 Glenn Morris <rgm@gnu.org> * files.el (make-backup-file-name-function) (make-backup-file-name, make-backup-file-name--default-function) @@ -1020,18 +2115,57 @@ (make-backup-file-name-function): Bump :version. Restore nil as a valid but deprecated custom type. -2014-04-03 Stefan Monnier <monnier@iro.umontreal.ca> - - * progmodes/perl-mode.el (perl-syntax-propertize-function): Handle $' - used as a variable (bug#17174). +2014-04-07 Stefan Monnier <monnier@iro.umontreal.ca> -2014-04-02 Stefan Monnier <monnier@iro.umontreal.ca> + * progmodes/perl-mode.el (perl-syntax-propertize-function): + Handle $' used as a variable (bug#17174). * progmodes/perl-mode.el (perl-indent-new-calculate): Handle forward-sexp failure (bug#16985). (perl-syntax-propertize-function): Add "foreach" and "for" statement modifiers introducing expressions (bug#17116). +2014-04-06 Stefan Monnier <monnier@iro.umontreal.ca> + + * dired-aux.el (dired-file-set-difference): Use lexical-scoping. + +2014-04-05 Leo Liu <sdl.web@gmail.com> + + * emacs-lisp/lisp-mode.el (lisp-imenu-generic-expression): + Add define-compilation-mode. + +2014-04-04 João Távora <joaotavora@gmail.com> + + * elec-pair.el (electric-pair--syntax-ppss): When inside comments + parse from comment beginning. + (electric-pair--balance-info): Fix typo in comment. + (electric-pair--in-unterminated-string-p): Delete. + (electric-pair--unbalanced-strings-p): New function. + (electric-pair-string-bound-function): New var. + (electric-pair-inhibit-if-helps-balance): Decide quote pairing + according to `electric-pair--in-unterminated-string-p'. + +2014-04-04 Stefan Monnier <monnier@iro.umontreal.ca> + + * textmodes/reftex-parse.el (reftex--index-tags): Rename `index-tags'. + Move declaration before first use. + (reftex-move-to-next-arg): Silence compiler warning. + +2014-04-04 Joost Kremers <joostkremers@fastmail.fm> (tiny change) + + * textmodes/reftex-toc.el (reftex-toc, reftex-re-enlarge): + Use `window-total-width' instead of `window-width'. + +2014-04-03 Daniel Colascione <dancol@dancol.org> + + * subr.el (set-transient-map): Remove rms's workaround entirely; + use new `suspicious-object' subr to mark our lambda for closer + scrutiny during gc. + +2014-04-02 Richard Stallman <rms@gnu.org> + + * subr.el (set-transient-map): Comment out previous change. + 2014-04-02 Glenn Morris <rgm@gnu.org> * menu-bar.el (menu-bar-file-menu): @@ -1040,21 +2174,132 @@ * simple.el (command-execute): Respect nil disabled-command-function. -2014-04-01 Nicolas Richard <theonewiththeevillook@yahoo.fr> +2014-04-02 Nicolas Richard <theonewiththeevillook@yahoo.fr> * simple.el (command-execute): Do not execute the command when it is disabled; fixes thinko in 2013-02-20 conversion from C. (Bug#17151) -2014-03-29 Juri Linkov <juri@jurta.org> +2014-04-02 Juri Linkov <juri@jurta.org> * dired-aux.el (dired-compress-file): Don't use string-match-p because its match data is used afterwards. -2014-03-28 Stefan Monnier <monnier@iro.umontreal.ca> +2014-04-02 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/package.el (package-built-in-p): Treat a min-version of 0 like nil. +2014-04-02 João Távora <joaotavora@gmail.com> + + * elec-pair.el (electric-pair-inhibit-if-helps-balance): + Inhibit quote pairing if point-max is inside an unterminated string. + (electric-pair--looking-at-unterminated-string-p): + Delete. + (electric-pair--in-unterminated-string-p): New function. + +2014-04-01 Daniel Colascione <dancol@dancol.org> + + * minibuffer.el (minibuffer-complete): Prevent assertion failure + when trying to complete the prompt. + +2014-03-31 Leo Liu <sdl.web@gmail.com> + + * emacs-lisp/eldoc.el (eldoc-print-current-symbol-info): + Refactor out eldoc-documentation-function-default. + (eldoc-documentation-function-default): New function. + (eldoc-documentation-function): Change value. + +2014-03-31 Glenn Morris <rgm@gnu.org> + + * simple.el (cycle-spacing--context, cycle-spacing): Doc tweaks. + + * progmodes/vhdl-mode.el (vhdl-speedbar-select-mra) + (vhdl-compose-components-package, vhdl-compose-configuration): + Abbreviate default-directory (missing from some previous upstream sync). + +2014-03-31 Reto Zimmermann <reto@gnu.org> + + Sync with upstream vhdl mode v3.35.2. + * progmodes/vhdl-mode.el (vhdl-version, vhdl-time-stamp): Update. + (top-level): No longer require assoc. + (vhdl-asort, vhdl-anot-head-p, vhdl-aput, vhdl-adelete, vhdl-aget): + New functions. Use throughout to replace aget etc. + (vhdl-aput-delete-if-nil): Rename from vhdl-aput. + (vhdl-update-file-contents): Update for vhdl-aput-delete-if-nil rename. + (vhdl-template-replace-header-keywords): Fix bug for "<title string>". + (vhdl-compile-init): Do not initialize regexps for Emacs 22+. + (vhdl-error-regexp-emacs-alist): Remove regexps from all compilers + except `vhdl-compiler'. + (vhdl-error-regexp-add-emacs): Remove all other compilers, + when appropriate. + +2014-03-31 Glenn Morris <rgm@gnu.org> + + * progmodes/vhdl-mode.el (vhdl-expand-abbrev, vhdl-expand-paren): + Revert 2014-03-26 merge goof; go back to using defalias. + +2014-03-30 Daniel Colascione <dancol@dancol.org> + + * comint.el (comint-send-input): + Deactivate completion-in-region-mode before we send comint input. + (Bug#17139). + + * simple.el (keyboard-quit): Deactivate completion-in-region-mode + on keyboard-quit. + +2014-03-29 Glenn Morris <rgm@gnu.org> + + * textmodes/reftex.el: Manage most autoloads automatically. + * textmodes/reftex-auc.el, textmodes/reftex-cite.el: + * textmodes/reftex-dcr.el, textmodes/reftex-global.el: + * textmodes/reftex-index.el, textmodes/reftex-parse.el: + * textmodes/reftex-ref.el, textmodes/reftex-sel.el: + * textmodes/reftex-toc.el: Set generated-autoload-file, + and add autoload cookies for reftex.el. + * Makefile.in (AUTOGEN_VCS): Add textmodes/reftex.el. + +2014-03-28 Glenn Morris <rgm@gnu.org> + + * cus-start.el (report-emacs-bug-address): Set custom properties. + * mail/emacsbug.el (report-emacs-bug-address): + Variable is now defined in emacs.c. + + * mail/emacsbug.el (report-emacs-bug): + Include system-configuration-features. + +2014-03-28 Michal Nazarewicz <mina86@mina86.com> + + * simple.el (cycle-spacing): Never delete spaces on first run by + default, but do so in a new 'fast mode and if there are already + N spaces (the previous behavior). + Compare N with its value in previous invocation so that changing + prefix argument restarts `cycle-spacing' sequence. + The idea is that with this change, binding M-SPC to + `cycle-spacing' should not introduce any changes in behavior of + the binding so long as users do not type M-SPC twice in a raw with + the same prefix argument or lack thereof. + +2014-03-28 Glenn Morris <rgm@gnu.org> + + * faces.el (term-file-aliases): New variable. + (tty-run-terminal-initialization): Respect term-file-aliases. + * term/apollo.el, term/vt102.el, term/vt125.el, term/vt201.el: + * term/vt220.el, term/vt240.el, term/vt300.el, term/vt320.el: + * term/vt400.el, term/vt420.el: Remove files, replaced by aliases. + +2014-03-27 Glenn Morris <rgm@gnu.org> + + * startup.el (inhibit-startup-hooks): Doc tweak. + (normal-top-level): Simplify running of hooks. + For window-setup-hook, respect inhibit-startup-hooks. + (command-line-1): Don't set window-setup-hook to nil. + + Allow selective autoloading from obsolete/ directory. + * Makefile.in (obsolete-autoloads): New rule. + (autoloads): Run obsolete-autoloads. + * obsolete/iswitchb.el (iswitchb-mode): Use obsolete-autoload. + * simple.el (iswitchb-mode): Remove hand-written autoloads. + 2014-03-27 Dmitry Gutov <dgutov@yandex.ru> * progmodes/ruby-mode.el (ruby-font-lock-keywords): @@ -1072,6 +2317,11 @@ * emacs-lisp/package-x.el (package--archive-contents-from-url): Use url-insert-file-contents; package-handle-response no longer exists. +2014-03-26 Daniel Colascione <dancol@dancol.org> + + * simple.el (process-menu-mode-map): New variable. + (process-menu-delete-process): New command. + 2014-03-26 Juanma Barranquero <lekktu@gmail.com> * emacs-lisp/package.el: Fix bug#16733 (again). @@ -1083,11 +2333,7 @@ dynamic binding of `buffer'. (describe-package-1): Do not decode readme-string. -2014-03-25 Barry O'Reilly <gundaetiapo@gmail.com> - - * simple.el (primitive-undo): Correction to 2014-03-24 change. - -2014-03-25 Michael Albinus <michael.albinus@gmx.de> +2014-03-26 Michael Albinus <michael.albinus@gmx.de> * net/tramp.el (tramp-methods, tramp-connection-timeout): Fix docstring. @@ -1099,7 +2345,7 @@ (tramp-do-copy-or-rename-file-directly): In the `rename' case, check whether source directory has set the sticky bit. -2014-03-24 Barry O'Reilly <gundaetiapo@gmail.com> +2014-03-26 Barry O'Reilly <gundaetiapo@gmail.com> * simple.el (primitive-undo): Only process marker adjustments validated against their corresponding (TEXT . POS). Issue warning @@ -1111,28 +2357,11 @@ (undo-elt-in-region): Return nil when passed a marker adjustment and explain in function doc. -2014-03-24 Dmitry Gutov <dgutov@yandex.ru> - - * emacs-lisp/package.el (package--add-to-archive-contents): - Include already installed and built-in packages in - `package-archive-contents'. - (package-install): Don't include already installed packages in the - options during interactive invocation. (Bug#16762) - -2014-03-24 Daniel Colascione <dancol@dancol.org> - - * emacs-lisp/cl-macs.el (cl--do-arglist): Use `plist-member' - instead of cl-loop search function. - -2014-03-24 Juanma Barranquero <lekktu@gmail.com> - - * frameset.el (frameset--initial-params): Fix typo in parameter name. - -2014-03-24 Nicolas Richard <theonewiththeevillook@yahoo.fr> +2014-03-26 Nicolas Richard <theonewiththeevillook@yahoo.fr> * align.el (align-region): Do not fail when end-mark is nil (bug#17088). -2014-03-24 Dmitry Gutov <dgutov@yandex.ru> +2014-03-26 Dmitry Gutov <dgutov@yandex.ru> * progmodes/ruby-mode.el (ruby-expression-expansion-re): Match special global variables without curlies, too. @@ -1140,32 +2369,120 @@ variables. Don't require a non-word character after the variable. (Bug#17057) -2014-03-23 Stefan Monnier <monnier@iro.umontreal.ca> +2014-03-26 Stefan Monnier <monnier@iro.umontreal.ca> * simple.el (redisplay-highlight-region-function): Increase priority of overlay to make sure boundaries are visible (bug#15899). -2014-03-23 Juanma Barranquero <lekktu@gmail.com> +2014-03-26 Juanma Barranquero <lekktu@gmail.com> - * frameset.el (frameset-restore): Compare display strings with equal. + * frameset.el (frameset--initial-params): Fix typo in parameter name. + (frameset-restore): Compare display strings with equal. * frame.el (make-frame): Don't quote display name in error message, it is already a string. -2014-03-23 Thierry Volpiatto <thierry.volpiatto@gmail.com> +2014-03-26 Thierry Volpiatto <thierry.volpiatto@gmail.com> * net/tramp.el (tramp-read-passwd): Suspend the timers while reading the password. -2014-03-23 Dmitry Gutov <dgutov@yandex.ru> +2014-03-26 Dmitry Gutov <dgutov@yandex.ru> - * emacs-lisp/package.el (package-show-package-list): If the buffer - is already displayed in another window, switch to that window. + * emacs-lisp/package.el (package--add-to-archive-contents): + Include already installed and built-in packages in + `package-archive-contents'. + (package-install): Don't include already installed packages in the + options during interactive invocation. (Bug#16762) + (package-show-package-list): If the buffer is already displayed in + another window, switch to that window. + +2014-03-26 Reto Zimmermann <reto@gnu.org> + + Sync with upstream vhdl mode v3.35.1. + * progmodes/vhdl-mode.el (vhdl-version, vhdl-time-stamp): Update. + (vhdl-compiler-alist): Doc fix. + (vhdl-goto-line): Remove. + (vhdl-mode-abbrev-table-init): Add XEmacs compat. + (vhdl-mode) <paragraph-start>: Fix value. + (vhdl-fix-statement-region): Not `for' in wait-statement. + (vhdl-beautify-region): Also (un)tabify. + (vhdl-get-visible-signals): + Scan declarative part of generate statements. + (vhdl-template-record): Fix indentation for record type declaration. + (vhdl-expand-abbrev, vhdl-expand-paren): + Revert to using fset again rather than defalias. + (vhdl-scan-directory-contents): Tweak. + (vhdl-speedbar-find-file, vhdl-speedbar-port-copy) + (vhdl-compose-components-package): + Replace vhdl-goto-line with forward-line. + (top-level): Tweak speedbar frame selection. + (vhdl-generate-makefile-1): Support for compilers with no + unit-to-file name mapping (create directory with dummy files). + +2014-03-26 Wilson Snyder <wsnyder@wsnyder.org> + + Sync with upstream verilog-mode revision 702457d. + * progmodes/verilog-mode.el (verilog-mode-version): Update. + (create-lockfiles): Declare. + (verilog-read-decls): Fix module header imports, bug709. + Reported by Victor Lau. + Fix parsing 'var' in AUTOs, msg1294. Reported by Dominique Chen. + (verilog-auto-inout-module): Fix AUTOINOUTMODULE not inserting + interface-only modules, bug721. Reported by Dean Hoyt. -2014-03-21 Daniel Colascione <dancol@dancol.org> +2014-03-26 Glenn Morris <rgm@gnu.org> - * mail/emacsbug.el (report-emacs-bug): Include memory usage - information in bug reports. + * obsolete/gulp.el: Move here from emacs-lisp/. + + * files.el (lock-buffer, unlock-buffer, file-locked-p): + Remove fallback aliases, since they are always defined now. + +2014-03-24 Daniel Colascione <dancol@dancol.org> + + * emacs-lisp/cl-macs.el (cl--do-arglist): Use `plist-member' + instead of cl-loop search function. + +2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> + + * calendar/parse-time.el (parse-time-iso8601-regexp) + (parse-iso8601-time-string): Copied from `url-dav' so that we can use + it more generally. + +2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> + + * net/dns.el (network-interface-list): Define for XEmacs. + +2014-03-23 Magnus Henoch <magnus.henoch@gmail.com> + + * net/dns.el (dns-servers-up-to-date-p): New function to see whether + the network interfaces changed. + (dns-query): Use it to flush the data. + +2014-03-23 Juanma Barranquero <lekktu@gmail.com> + + * vc/vc.el (vc-rollback): Use set-buffer-modified-p. + +2014-03-23 Daniel Colascione <dancol@dancol.org> + + Change subword-mode to use `find-word-boundary-function-table' and + replace `capitalized-words-mode'. Also, convert to lexical + binding. + + * progmodes/cap-words.el: Delete now-obsolete file. + * progmodes/subword.el: Reimplement using + `find-word-boundary-function-table'. + (subword-mode-map): Hollow out. + (capitalized-words-mode): Define as obsolete alias for + `subword-mode'. + (subword-mode, superword-mode): Tweak documentation to reflect new + implementation; call `subword-setup-buffer'. + (subword-forward, subword-capitalize): Add underscore to indicate + unused variable. + (subword-find-word-boundary-function-table): New constant. + (subword-empty-char-table): New constant. + (subword-setup-buffer): New function. + (subword-find-word-boundary): New function. 2014-03-23 Daniel Colascione <dancol@dancol.org> @@ -1174,10 +2491,41 @@ (Bug#3647) --- unfortunately, only for freshly-compiled code. Please make bootstrap. -2014-03-23 Richard Stallman <rms@gnu.org> - - * battery.el (battery-linux-sysfs): Search for each field - from the beginning of the buffer. +2014-03-22 Glenn Morris <rgm@gnu.org> + + * dired.el (dired-read-regexp): Make obsolete. + (dired-mark-files-regexp, dired-mark-files-containing-regexp) + (dired-flag-files-regexp): + * dired-aux.el (dired-mark-read-regexp): + * dired-x.el (dired-mark-unmarked-files): Use read-regexp directly. + + * startup.el (fancy-startup-text): + * help.el (describe-gnu-project): Visit online info about GNU project. + + * help-fns.el (help-fns--interactive-only): New function. + (help-fns-describe-function-functions): Add the above function. + * simple.el (beginning-of-buffer, end-of-buffer, insert-buffer) + (next-line, previous-line): Remove hand-written interactive-only + information from doc strings, it is auto-generated now. + * bookmark.el (bookmark-write): + * epa-mail.el (epa-mail-decrypt, epa-mail-verify, epa-mail-sign) + (epa-mail-import-keys): Mark interactive-only, + and remove hand-written interactive-only information from doc strings. + * epa.el (epa-decrypt-armor-in-region, epa-verify-region) + (epa-verify-cleartext-in-region, epa-sign-region, epa-encrypt-region): + * files.el (not-modified): + * simple.el (mark-whole-buffer): Mark interactive-only. + + * emacs-lisp/byte-run.el (defun-declarations-alist): + Add interactive-only. Doc tweak. + (macro-declarations-alist): Doc tweak. + * subr.el (declare): Doc tweak (add xref to manual). + * comint.el (comint-run): + * files.el (insert-file-literally, insert-file): + * replace.el (replace-string, replace-regexp): + * simple.el (beginning-of-buffer, end-of-buffer, delete-backward-char) + (delete-forward-char, goto-line, insert-buffer, next-line) + (previous-line): Set interactive-only via declare. 2014-03-22 Dmitry Gutov <dgutov@yandex.ru> @@ -1189,6 +2537,36 @@ * w32-common-fns.el (x-selection-owner-p): Add empty docstring for the benefit of doc.c; change parameter profile to match the X function. +2014-03-22 Leo Liu <sdl.web@gmail.com> + + * help.el (temp-buffer-setup-hook): Remove help-mode-setup. + (temp-buffer-show-hook): Remove help-mode-finish. (Bug#16038) + +2014-03-21 Richard Stallman <rms@gnu.org> + + * battery.el (battery-linux-sysfs): Search for each field + from the beginning of the buffer. + + * subr.el (set-transient-map): Clear out function and value + of the temporary symbol when we're done with it. + + * mail/rmailsum.el (rmail-summary-delete-forward): + Optimize case of reaching end and handling count. + (rmail-summary-mark-deleted): Optimize when N is current msg. + Don't create new summary line. + (rmail-summary-undelete): Pass arg to rmail-undelete-previous-message. + (rmail-summary-undelete-many): Rewrite for speed. + (rmail-summary-msg-number): New function. + + * mail/rmail.el (rmail-delete-message): Update summary. + (rmail-undelete-previous-message): Handle repeat count arg. + (rmail-delete-backward, rmail-delete-forward): Likewise. + +2014-03-21 Daniel Colascione <dancol@dancol.org> + + * mail/emacsbug.el (report-emacs-bug): Include memory usage + information in bug reports. + 2014-03-21 Michael Albinus <michael.albinus@gmx.de> * net/tramp.el (tramp-methods): Add docstring for `tramp-login-env' @@ -1237,6 +2615,34 @@ (tty-color-approximate, tty-color-by-index, tty-color-values) (tty-color-desc): Remove superfluous backslashes. +2014-03-21 Glenn Morris <rgm@gnu.org> + + * cus-start.el (history-length): Bump :version. + + * Makefile.in ($(MH_E_DIR)/mh-loaddefs.el) + ($(TRAMP_DIR)/tramp-loaddefs.el, $(CAL_DIR)/cal-loaddefs.el) + ($(CAL_DIR)/diary-loaddefs.el, $(CAL_DIR)/hol-loaddefs.el): + Don't set `make-backup-files'. + + * info.el (info--prettify-description): New function, + to give info-finder descriptions consistent case, punctuation. + (Info-finder-find-node): Use it. Sort packages. + Refer to "description" rather than "commentary". + +2014-03-21 Juanma Barranquero <lekktu@gmail.com> + + * frameset.el (frameset--print-register): New function. + (frameset-to-register): Use it. + +2014-03-20 Juanma Barranquero <lekktu@gmail.com> + + * progmodes/hideif.el (hif-string-to-number): New function. + (hif-tokenize): Use it to understand non-decimal floats. + + * emacs-lisp/cl-extra.el (cl--map-overlays): Remove obsolete code. + + * skeleton.el (skeleton-autowrap): Mark as obsolete. Doc fix. + 2014-03-20 Stefan Monnier <monnier@iro.umontreal.ca> * electric.el (electric-newline-and-maybe-indent): New command. @@ -6020,7 +7426,7 @@ * rect.el (rectangle-mark-mode): Rename from rectangle-mark. Make it into a proper minor mode. - (rectangle--region): (implicitly) rename to rectangle-mark-mode. + (rectangle--region): (Implicitly) rename to rectangle-mark-mode. (rectangle-mark-mode-map): New keymap. (rectangle--highlight-for-redisplay): Fix some corner cases (bug#15796). @@ -6263,8 +7669,7 @@ 2013-10-28 Daiki Ueno <ueno@gnu.org> - * epa-file.el - (epa-file-cache-passphrase-for-symmetric-encryption): + * epa-file.el (epa-file-cache-passphrase-for-symmetric-encryption): Document that this option has no effect with GnuPG 2.0 (bug#15552). 2013-10-27 Xue Fuqiao <xfq.free@gmail.com> @@ -13076,9 +14481,8 @@ * textmodes/reftex-vars.el (reftex-ref-style-alist): Add cleveref macros. - * textmodes/reftex-parse.el - (reftex-locate-bibliography-files): Accept options for - bibliography commands. + * textmodes/reftex-parse.el (reftex-locate-bibliography-files): + Accept options for bibliography commands. * textmodes/reftex-vars.el (reftex-bibliography-commands): Add addbibresource. Basic Biblatex support. @@ -14548,8 +15952,7 @@ 2013-04-19 Fabián Ezequiel Gallina <fgallina@gnu.org> New faster Imenu implementation (bug#14058). - * progmodes/python.el: - (python-imenu-prev-index-position): + * progmodes/python.el (python-imenu-prev-index-position) (python-imenu-format-item-label-function) (python-imenu-format-parent-item-label-function) (python-imenu-format-parent-item-jump-label-function): diff --git a/lisp/Makefile.in b/lisp/Makefile.in index a1cd6d19ce8..cbc1d2af3ae 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -74,12 +74,13 @@ AUTOGENEL = loaddefs.el \ # Note that update_loaddefs parses this. AUTOGEN_VCS = \ ps-print.el \ - emulation/tpu-edt.el \ + obsolete/tpu-edt.el \ mail/rmail.el \ dired.el \ ibuffer.el \ htmlfontify.el \ - emacs-lisp/eieio.el + emacs-lisp/eieio.el \ + textmodes/reftex.el # Value of max-lisp-eval-depth when compiling initially. # During bootstrapping the byte-compiler is run interpreted when compiling @@ -106,6 +107,9 @@ COMPILE_FIRST = \ $(lisp)/emacs-lisp/bytecomp.elc \ $(lisp)/emacs-lisp/autoload.elc +# Prevent any settings in the user environment causing problems. +unexport EMACSDATA EMACSDOC EMACSPATH + # The actual Emacs command run in the targets below. # Prevent any setting of EMACSLOADPATH in user environment causing problems. emacs = EMACSLOADPATH= '$(EMACS)' $(EMACSOPT) @@ -164,7 +168,7 @@ doit: # since they will never contain any useful information # (see finder-no-scan-regexp and custom-dependencies-no-scan-regexp). $(lisp)/cus-load.el: - $(MAKE) $(MFLAGS) custom-deps + $(MAKE) custom-deps custom-deps: doit $(setwins_almost); \ echo Directories: $$wins; \ @@ -173,7 +177,7 @@ custom-deps: doit -f custom-make-dependencies $$wins $(lisp)/finder-inf.el: - $(MAKE) $(MFLAGS) finder-data + $(MAKE) finder-data finder-data: doit $(setwins_finder); \ echo Directories: $$wins; \ @@ -196,11 +200,22 @@ autoloads: $(LOADDEFS) doit --eval '(setq autoload-builtin-package-versions t)' \ --eval '(setq generated-autoload-file (expand-file-name (unmsys--file-name "$(srcdir)/loaddefs.el")))' \ -f batch-update-autoloads $$wins + $(MAKE) obsolete-autoloads + +# The obsolete/ subdirectory is normally not scanned for autoloads. +# Sometimes we still want to autoload something from that directory, +# eg iswitchb. +.PHONY: obsolete-autoloads +obsolete-autoloads: ${lisp}/obsolete/*.el + $(emacs) -l autoload \ + --eval '(setq generate-autoload-cookie ";;;###obsolete-autoload")' \ + --eval '(setq generated-autoload-file (expand-file-name (unmsys--file-name "$(srcdir)/loaddefs.el")))' \ + -f batch-update-autoloads ${lisp}/obsolete # This is required by the bootstrap-emacs target in ../src/Makefile, so # we know that if we have an emacs executable, we also have a subdirs.el. $(lisp)/subdirs.el: - $(MAKE) $(MFLAGS) update-subdirs + $(MAKE) update-subdirs update-subdirs: doit $(setwins_for_subdirs); \ for file in $$wins; do \ @@ -292,7 +307,7 @@ compile-onefile: compile-first: $(COMPILE_FIRST) # In `compile-main' we could directly do -# ... | xargs $(MAKE) $(MFLAGS) EMACS="$(EMACS)" +# ... | xargs $(MAKE) EMACS="$(EMACS)" # and it works, but it generates a lot of messages like # make[2]: gnus/gnus-mlspl.elc is up to date. # so instead, we use "xargs echo" to split the list of file into manageable @@ -316,7 +331,7 @@ compile-main: leim semantic compile-clean echo "$${el}c"; \ done | xargs $(XARGS_LIMIT) echo) | \ while read chunk; do \ - $(MAKE) $(MFLAGS) compile-targets EMACS="$(EMACS)" TARGETS="$$chunk"; \ + $(MAKE) compile-targets EMACS="$(EMACS)" TARGETS="$$chunk"; \ done .PHONY: compile-clean @@ -333,7 +348,7 @@ compile-clean: .PHONY: leim semantic leim: - cd ../leim && $(MAKE) $(MFLAGS) all EMACS="$(EMACS)" + $(MAKE) -C ../leim all EMACS="$(EMACS)" # FIXME. Yuck. semantic: @@ -341,7 +356,7 @@ semantic: .*) EMACS="../${EMACS}" ;; \ *) EMACS="${EMACS}" ;; \ esac; \ - cd ../admin/grammars && $(MAKE) $(MFLAGS) all EMACS="$${EMACS}" + $(MAKE) -C ../admin/grammars all EMACS="$${EMACS}" # Compile all Lisp files, but don't recompile those that are up to # date. Some .el files don't get compiled because they set the @@ -350,14 +365,14 @@ semantic: # Explicitly pass EMACS (sometimes ../src/bootstrap-emacs) to those # sub-makes that run rules that use it, for the sake of some non-GNU makes. compile: $(LOADDEFS) autoloads compile-first - $(MAKE) $(MFLAGS) compile-main EMACS="$(EMACS)" + $(MAKE) compile-main EMACS="$(EMACS)" # Compile all Lisp files. This is like `compile' but compiles files # unconditionally. Some files don't actually get compiled because they # set the local variable no-byte-compile. compile-always: doit cd $(lisp) && rm -f *.elc */*.elc */*/*.elc */*/*/*.elc - $(MAKE) $(MFLAGS) compile EMACS="$(EMACS)" + $(MAKE) compile EMACS="$(EMACS)" .PHONY: backup-compiled-files compile-after-backup @@ -416,7 +431,6 @@ $(MH_E_DIR)/mh-loaddefs.el: $(MH_E_SRC) $(emacs) -l autoload \ --eval "(setq generate-autoload-cookie \";;;###mh-autoload\")" \ --eval "(setq generated-autoload-file (expand-file-name (unmsys--file-name \"$@\")))" \ - --eval "(setq make-backup-files nil)" \ -f batch-update-autoloads $(MH_E_DIR) # Update TRAMP internal autoloads. Maybe we could move tramp*.el into @@ -434,7 +448,6 @@ $(TRAMP_DIR)/tramp-loaddefs.el: $(TRAMP_SRC) $(emacs) -l autoload \ --eval "(setq generate-autoload-cookie \";;;###tramp-autoload\")" \ --eval "(setq generated-autoload-file (expand-file-name (unmsys--file-name \"$@\")))" \ - --eval "(setq make-backup-files nil)" \ -f batch-update-autoloads $(TRAMP_DIR) CAL_DIR = $(lisp)/calendar @@ -456,21 +469,18 @@ $(CAL_DIR)/cal-loaddefs.el: $(CAL_SRC) $(emacs) -l autoload \ --eval "(setq generate-autoload-cookie \";;;###cal-autoload\")" \ --eval "(setq generated-autoload-file (expand-file-name (unmsys--file-name \"$@\")))" \ - --eval "(setq make-backup-files nil)" \ -f batch-update-autoloads $(CAL_DIR) $(CAL_DIR)/diary-loaddefs.el: $(CAL_SRC) $(emacs) -l autoload \ --eval "(setq generate-autoload-cookie \";;;###diary-autoload\")" \ --eval "(setq generated-autoload-file (expand-file-name (unmsys--file-name \"$@\")))" \ - --eval "(setq make-backup-files nil)" \ -f batch-update-autoloads $(CAL_DIR) $(CAL_DIR)/hol-loaddefs.el: $(CAL_SRC) $(emacs) -l autoload \ --eval "(setq generate-autoload-cookie \";;;###holiday-autoload\")" \ --eval "(setq generated-autoload-file (expand-file-name (unmsys--file-name \"$@\")))" \ - --eval "(setq make-backup-files nil)" \ -f batch-update-autoloads $(CAL_DIR) .PHONY: bootstrap-clean distclean maintainer-clean diff --git a/lisp/bookmark.el b/lisp/bookmark.el index eab2ea7144f..7ea54a8e2b4 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -1298,8 +1298,8 @@ is greater than `bookmark-alist-modification-count'." ;;;###autoload (defun bookmark-write () - "Write bookmarks to a file (reading the file name with the minibuffer). -Don't use this in Lisp programs; use `bookmark-save' instead." + "Write bookmarks to a file (reading the file name with the minibuffer)." + (declare (interactive-only bookmark-save)) (interactive) (bookmark-maybe-load-default-file) (bookmark-save t)) diff --git a/lisp/bs.el b/lisp/bs.el index f0f8b1dc351..73b3684e566 100644 --- a/lisp/bs.el +++ b/lisp/bs.el @@ -1143,7 +1143,7 @@ and move point to current buffer." (delete-char -1) (bs--set-window-height) (bs--goto-current-buffer) - (font-lock-fontify-buffer) + (font-lock-ensure) (bs-apply-sort-faces) (set-buffer-modified-p nil))) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index ba1c7de9967..04d852e5cb3 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -2773,9 +2773,18 @@ largest Emacs integer.") ;; Coerce integer A to be a bignum. [B S] (defun math-bignum (a) - (if (>= a 0) - (cons 'bigpos (math-bignum-big a)) - (cons 'bigneg (math-bignum-big (- a))))) + (cond + ((>= a 0) + (cons 'bigpos (math-bignum-big a))) + ((= a most-negative-fixnum) + ;; Note: cannot get the negation directly because + ;; (- most-negative-fixnum) is most-negative-fixnum. + ;; + ;; most-negative-fixnum := -most-positive-fixnum - 1 + (math-sub (cons 'bigneg (math-bignum-big most-positive-fixnum)) + 1)) + (t + (cons 'bigneg (math-bignum-big (- a)))))) (defun math-bignum-big (a) ; [L s] (if (= a 0) diff --git a/lisp/calculator.el b/lisp/calculator.el index d6eb892f7fb..52dc8c53661 100644 --- a/lisp/calculator.el +++ b/lisp/calculator.el @@ -1,4 +1,4 @@ -;;; calculator.el --- a [not so] simple calculator for Emacs -*- lexical-binding: t -*- +;;; calculator.el --- a calculator for Emacs -*- lexical-binding: t -*- ;; Copyright (C) 1998, 2000-2014 Free Software Foundation, Inc. @@ -33,15 +33,8 @@ ;; "Run the Emacs calculator." t) ;; (global-set-key [(control return)] 'calculator) ;; -;; Written by Eli Barzilay: Maze is Life! eli@barzilay.org -;; http://www.barzilay.org/ +;; Written by Eli Barzilay, eli@barzilay.org ;; -;; For latest version, check -;; http://www.barzilay.org/misc/calculator.el -;; - -;;; History: -;; I hate history. ;;;===================================================================== ;;; Customization: @@ -79,7 +72,7 @@ This determines the default behavior of unary operators." (defcustom calculator-prompt "Calc=%s> " "The prompt used by the Emacs calculator. -It should contain a \"%s\" somewhere that will indicate the i/o radices; +It should contain a \"%s\" somewhere that will indicate the i/o radixes; this will be a two-character string as described in the documentation for `calculator-mode'." :type 'string @@ -115,8 +108,8 @@ See `calculator-radix-grouping-mode'." (defcustom calculator-remove-zeros t "Non-nil value means delete all redundant zero decimal digits. -If this value is not t, and not nil, redundant zeros are removed except -for one and if it is nil, nothing is removed. +If this value is not t and not nil, redundant zeros are removed except +for one. Used by the `calculator-remove-zeros' function." :type '(choice (const t) (const leave-decimal) (const nil)) :group 'calculator) @@ -136,23 +129,27 @@ should be able to handle special symbol arguments, currently `left' and associated with the displayer function (for example to change the number of digits displayed). -An exception to the above is the case of the list (std C) where C is a -character, in this case the `calculator-standard-displayer' function -will be used with this character for a format string." - :type '(choice (function) (string) (list (const std) character) (sexp)) +An exception to the above is the case of the list (std C [G]) where C is +a character and G is an optional boolean, in this case the +`calculator-standard-displayer' function will be used with these as +arguments." + :type '(choice (function) (string) (sexp) + (list (const std) character) + (list (const std) character boolean)) :group 'calculator) (defcustom calculator-displayers '(((std ?n) "Standard display, decimal point or scientific") (calculator-eng-display "Eng display") - ((std ?f) "Standard display, decimal point") + ((std ?f t) "Standard display, decimal point with grouping") ((std ?e) "Standard display, scientific") ("%S" "Emacs printer")) "A list of displayers. Each element is a list of a displayer and a description string. The -first element is the one which is currently used, this is for the display -of result values not values in expressions. A displayer specification -is the same as the values that can be stored in `calculator-displayer'. +first element is the one which is currently used, this is for the +display of result values not values in expressions. A displayer +specification is the same as the values that can be stored in +`calculator-displayer'. `calculator-rotate-displayer' rotates this list." :type 'sexp @@ -182,7 +179,7 @@ Otherwise show as a negative number." (defcustom calculator-mode-hook nil "List of hook functions for `calculator-mode' to run. Note: if `calculator-electric-mode' is on, then this hook will get -activated in the minibuffer - in that case it should not do much more +activated in the minibuffer -- in that case it should not do much more than local key settings and other effects that will change things outside the scope of calculator related code." :type 'hook @@ -224,15 +221,14 @@ Examples: (\"tF\" mt-to-ft (/ X 0.3048) 1) (\"tM\" ft-to-mt (* X 0.3048) 1))) -* Using a function-like form is very simple, X for an argument (Y the - second in case of a binary operator), TX is a truncated version of X - and F does a recursive call, Here is a [very inefficient] Fibonacci - number calculation: +* Using a function-like form is very simple: use `X' for the argument + (`Y' for the second in case of a binary operator), `TX' is a truncated + version of `X' and `F' for a recursive call. Here is a [very + inefficient] Fibonacci number calculation: (add-to-list 'calculator-user-operators - '(\"F\" fib (if (<= TX 1) - 1 - (+ (F (- TX 1)) (F (- TX 2)))) 0)) + '(\"F\" fib + (if (<= TX 1) 1 (+ (F (- TX 1)) (F (- TX 2)))))) Note that this will be either postfix or prefix, according to `calculator-unary-style'." @@ -248,7 +244,7 @@ Examples: ;;; Variables (defvar calculator-initial-operators - '(;; "+"/"-" have keybindings of themselves, not calculator-ops + '(;; "+"/"-" have keybindings of their own, not calculator-ops ("=" = identity 1 -1) (nobind "+" + + 2 4) (nobind "-" - - 2 4) @@ -303,26 +299,27 @@ user-defined operators, use `calculator-user-operators' instead.") versions), `DX' (converted to radians if degrees mode is on), `D' (function for converting radians to degrees if deg mode is on), `L' (list of saved values), `F' (function for recursive iteration calls) - and evaluates to the function value - these variables are capital; + and evaluates to the function value -- these variables are capital; 4. The function's arity, optional, one of: 2 => binary, -1 => prefix - unary, +1 => postfix unary, 0 => a 0-arg operator func, non-number => - postfix/prefix as determined by `calculator-unary-style' (the - default); + unary, +1 => postfix unary, 0 => a 0-arg operator func (note that + using such a function replaces the currently entered number, if any), + non-number (the default) => postfix or prefix as determined by + `calculator-unary-style'; -5. The function's precedence - should be in the range of 1 (lowest) to +5. The function's precedence -- should be in the range of 1 (lowest) to 9 (highest) (optional, defaults to 1); It it possible have a unary prefix version of a binary operator if it comes later in this list. If the list begins with the symbol 'nobind, -then no key binding will take place - this is only useful for predefined +then no key binding will take place -- this is only useful for predefined keys. Use `calculator-user-operators' to add operators to this list, see its documentation for an example.") (defvar calculator-stack nil - "Stack contents - operations and operands.") + "Stack contents -- operations and operands.") (defvar calculator-curnum nil "Current number being entered (as a string).") @@ -427,9 +424,9 @@ Used for repeating operations in calculator-repR/L.") (calculator-backspace [backspace]) ))) (while p - ;; reverse the keys so first defs come last - makes the more - ;; sensible bindings visible in the menu - (let ((func (car (car p))) (keys (reverse (cdr (car p))))) + ;; reverse the keys so earlier definitions come last -- makes + ;; the more sensible bindings visible in the menu + (let ((func (caar p)) (keys (reverse (cdar p)))) (while keys (define-key map (car keys) func) (setq keys (cdr keys)))) @@ -441,7 +438,7 @@ Used for repeating operations in calculator-repR/L.") ;; make C-h work in text-mode (or window-system (define-key map [?\C-h] 'calculator-backspace)) ;; set up a menu - (if (and calculator-use-menu (not (boundp 'calculator-menu))) + (when (and calculator-use-menu (not (boundp 'calculator-menu))) (let ((radix-selectors (mapcar (lambda (x) `([,(nth 0 x) @@ -580,7 +577,7 @@ Used for repeating operations in calculator-repR/L.") "A [not so] simple calculator for Emacs. This calculator is used in the same way as other popular calculators -like xcalc or calc.exe - but using an Emacs interface. +like xcalc or calc.exe -- but using an Emacs interface. Expressions are entered using normal infix notation, parens are used as normal. Unary functions are usually postfix, but some depends on the @@ -589,8 +586,7 @@ specified, then it is fixed, otherwise it depends on this variable). `+' and `-' can be used as either binary operators or prefix unary operators. Numbers can be entered with exponential notation using `e', except when using a non-decimal radix mode for input (in this case `e' -will be the hexadecimal digit). If the result of a calculation is too -large (out of range for Emacs), the value of \"inf\" is returned. +will be the hexadecimal digit). Here are the editing keys: * `RET' `=' evaluate the current expression @@ -609,8 +605,8 @@ These operators are pre-defined: * `_' `;' postfix unary negation and reciprocal * `^' `L' binary operators for x^y and log(x) in base y * `Q' `!' unary square root and factorial -* `S' `C' `T' unary trigonometric operators - sin, cos and tan -* `|' `#' `&' `~' bitwise operators - or, xor, and, not +* `S' `C' `T' unary trigonometric operators: sin, cos and tan +* `|' `#' `&' `~' bitwise operators: or, xor, and, not The trigonometric functions can be inverted if prefixed with an `I', see below for the way to use degrees instead of the default radians. @@ -636,9 +632,9 @@ The prompt indicates the current modes: Also, the quote key can be used to switch display modes for decimal numbers (double-quote rotates back), and the two brace characters -\(\"{\" and \"}\" change display parameters that these displayers use (if -they handle such). If output is using any radix mode, then these keys -toggle digit grouping mode and the chunk size. +\(\"{\" and \"}\" change display parameters that these displayers use, +if they handle such). If output is using any radix mode, then these +keys toggle digit grouping mode and the chunk size. Values can be saved for future reference in either a list of saved values, or in registers. @@ -680,19 +676,21 @@ more information. "Run the Emacs calculator. See the documentation for `calculator-mode' for more information." (interactive) - (if calculator-restart-other-mode + (when calculator-restart-other-mode (setq calculator-electric-mode (not calculator-electric-mode))) - (if calculator-initial-operators - (progn (calculator-add-operators calculator-initial-operators) - (setq calculator-initial-operators nil) - ;; don't change this since it is a customization variable, - ;; its set function will add any new operators - (calculator-add-operators calculator-user-operators))) + (when calculator-initial-operators + (calculator-add-operators calculator-initial-operators) + (setq calculator-initial-operators nil) + ;; don't change this since it is a customization variable, + ;; its set function will add any new operators + (calculator-add-operators calculator-user-operators)) (setq calculator-buffer (get-buffer-create "*calculator*")) (if calculator-electric-mode (save-window-excursion - (progn (require 'electric) (message nil)) ; hide load message - (let (old-g-map old-l-map (echo-keystrokes 0) + (require 'electric) (message nil) ; hide load message + (let (old-g-map old-l-map + (old-buf (window-buffer (minibuffer-window))) + (echo-keystrokes 0) (garbage-collection-messages nil)) ; no gc msg when electric (set-window-buffer (minibuffer-window) calculator-buffer) (select-window (minibuffer-window)) @@ -712,8 +710,8 @@ See the documentation for `calculator-mode' for more information." (lambda () 'noprompt) nil (lambda (_x _y) (calculator-update-display)))) - (and calculator-buffer - (catch 'calculator-done (calculator-quit))) + (set-window-buffer (minibuffer-window) old-buf) + (kill-buffer calculator-buffer) (use-local-map old-l-map) (use-global-map old-g-map)))) (progn @@ -722,45 +720,8 @@ See the documentation for `calculator-mode' for more information." (let ((window-min-height 2)) ;; maybe leave two lines for our window because of the ;; normal `raised' mode line - (select-window - (split-window-below - ;; If the mode line might interfere with the calculator - ;; buffer, use 3 lines instead. - (if (and (fboundp 'face-attr-construct) - (let* ((dh (plist-get (face-attr-construct 'default) :height)) - (mf (face-attr-construct 'mode-line)) - (mh (plist-get mf :height))) - ;; If the mode line is shorter than the default, - ;; stick with 2 lines. (It may be necessary to - ;; check how much shorter.) - (and - (not - (or (and (integerp dh) - (integerp mh) - (< mh dh)) - (and (numberp mh) - (not (integerp mh)) - (< mh 1)))) - (or - ;; If the mode line is taller than the default, - ;; use 3 lines. - (and (integerp dh) - (integerp mh) - (> mh dh)) - (and (numberp mh) - (not (integerp mh)) - (> mh 1)) - ;; If the mode line has a box with non-negative line-width, - ;; use 3 lines. - (let* ((bx (plist-get mf :box)) - (lh (plist-get bx :line-width))) - (and bx - (or - (not lh) - (> lh 0)))) - ;; If the mode line has an overline, use 3 lines. - (plist-get (face-attr-construct 'mode-line) :overline))))) - -3 -2))) + (select-window (split-window-below + (if (calculator-need-3-lines) -3 -2))) (switch-to-buffer calculator-buffer))) ((not (eq (current-buffer) calculator-buffer)) (select-window (get-buffer-window calculator-buffer)))) @@ -768,24 +729,46 @@ See the documentation for `calculator-mode' for more information." (setq buffer-read-only t) (calculator-reset) (message "Hit `?' For a quick help screen."))) - (if (and calculator-restart-other-mode calculator-electric-mode) + (when (and calculator-restart-other-mode calculator-electric-mode) (calculator))) +(defun calculator-need-3-lines () + ;; If the mode line might interfere with the calculator buffer, use 3 + ;; lines instead. + (let* ((dh (face-attribute 'default :height)) + (mh (face-attribute 'mode-line :height))) + ;; if the mode line is shorter than the default, stick with 2 lines + ;; (it may be necessary to check how much shorter) + (and (not (or (and (integerp dh) (integerp mh) (< mh dh)) + (and (numberp mh) (not (integerp mh)) (< mh 1)))) + (or ;; if the mode line is taller than the default, use 3 lines + (and (integerp dh) (integerp mh) (> mh dh)) + (and (numberp mh) (not (integerp mh)) (> mh 1)) + ;; if the mode line has a box with non-negative line-width, + ;; use 3 lines + (let* ((bx (face-attribute 'mode-line :box)) + (lh (plist-get bx :line-width))) + (and bx (or (not lh) (> lh 0)))) + ;; if the mode line has an overline, use 3 lines + (not (memq (face-attribute 'mode-line :overline) + '(nil unspecified))))))) + (defun calculator-message (string &rest arguments) - "Same as `message', but special handle of electric mode." + "Same as `message', but also handle electric mode." (apply 'message string arguments) - (if calculator-electric-mode - (progn (sit-for 1) (message nil)))) + (when calculator-electric-mode (sit-for 1) (message nil))) ;;;--------------------------------------------------------------------- ;;; Operators (defun calculator-op-arity (op) - "Return OP's arity, 2, +1 or -1." - (let ((arity (or (nth 3 op) 'x))) - (if (numberp arity) - arity - (if (eq calculator-unary-style 'postfix) +1 -1)))) + "Return OP's arity. +Current results are one of 2 (binary), +1 (postfix), -1 (prefix), or +0 (nullary)." + (let ((arity (nth 3 op))) + (cond ((numberp arity) arity) + ((eq calculator-unary-style 'postfix) +1) + (t -1)))) (defun calculator-op-prec (op) "Return OP's precedence for reducing when inserting into the stack. @@ -798,8 +781,8 @@ Adds MORE-OPS to `calculator-operator', called initially to handle `calculator-initial-operators' and `calculator-user-operators'." (let ((added-ops nil)) (while more-ops - (or (eq (car (car more-ops)) 'nobind) - (let ((i -1) (key (car (car more-ops)))) + (or (eq (caar more-ops) 'nobind) + (let ((i -1) (key (caar more-ops))) ;; make sure the key is undefined, so it's easy to define ;; prefix keys (while (< (setq i (1+ i)) (length key)) @@ -811,8 +794,8 @@ Adds MORE-OPS to `calculator-operator', called initially to handle calculator-mode-map (substring key 0 (1+ i)) nil) (setq i (length key))))) (define-key calculator-mode-map key 'calculator-op))) - (setq added-ops (cons (if (eq (car (car more-ops)) 'nobind) - (cdr (car more-ops)) + (setq added-ops (cons (if (eq (caar more-ops) 'nobind) + (cdar more-ops) (car more-ops)) added-ops)) (setq more-ops (cdr more-ops))) @@ -833,50 +816,37 @@ Adds MORE-OPS to `calculator-operator', called initially to handle (setq calculator-restart-other-mode nil) (calculator-update-display)) -(defun calculator-get-prompt () +(defun calculator-get-display () "Return a string to display. -The string is set not to exceed the screen width." - (let* ((calculator-prompt - (format calculator-prompt +The result should not exceed the screen width." + (let* ((in-r (and calculator-input-radix + (char-to-string + (car (rassq calculator-input-radix + calculator-char-radix))))) + (out-r (and calculator-output-radix + (char-to-string + (car (rassq calculator-output-radix + calculator-char-radix))))) + (prompt (format calculator-prompt + (cond ((or in-r out-r) + (concat (or in-r "=") + (if (equal in-r out-r) "=" + (or out-r "=")))) + (calculator-deg "D=") + (t "==")))) + (expr + (concat (cdr calculator-stack-display) (cond - ((or calculator-output-radix calculator-input-radix) - (if (eq calculator-output-radix - calculator-input-radix) - (concat - (char-to-string - (car (rassq calculator-output-radix - calculator-char-radix))) - "=") - (concat - (if calculator-input-radix - (char-to-string - (car (rassq calculator-input-radix - calculator-char-radix))) - "=") - (char-to-string - (car (rassq calculator-output-radix - calculator-char-radix)))))) - (calculator-deg "D=") - (t "==")))) - (prompt - (concat calculator-prompt - (cdr calculator-stack-display) - (cond (calculator-curnum - ;; number being typed - (concat calculator-curnum "_")) - ((and (= 1 (length calculator-stack)) - calculator-display-fragile) - ;; only the result is shown, next number will - ;; restart - nil) - (t - ;; waiting for a number or an operator - "?")))) - (trim (- (length prompt) (1- (window-width))))) - (if (<= trim 0) - prompt - (concat calculator-prompt - (substring prompt (+ trim (length calculator-prompt))))))) + ;; entering a number + (calculator-curnum (concat calculator-curnum "_")) + ;; showing a result + ((and (= 1 (length calculator-stack)) + calculator-display-fragile) + nil) + ;; waiting for a number or an operator + (t "?")))) + (trim (+ (length expr) (length prompt) 1 (- (window-width))))) + (concat prompt (if (<= trim 0) expr (substring expr trim))))) (defun calculator-string-to-number (str) "Convert the given STR to a number, according to the value of @@ -902,7 +872,7 @@ The string is set not to exceed the screen width." "Warning: Ignoring bad input character `%c'." ch) (sit-for 1) value)))) - (if (if (< new-value 0) (> value 0) (< value 0)) + (when (if (< new-value 0) (> value 0) (< value 0)) (calculator-message "Warning: Overflow in input.")) (setq value new-value)) value) @@ -916,9 +886,12 @@ The string is set not to exceed the screen width." ((stringp str) (concat str ".0")) (t "0.0")))))) -(defun calculator-curnum-value () - "Get the numeric value of the displayed number string as a float." - (calculator-string-to-number calculator-curnum)) +(defun calculator-push-curnum () + "Push the numeric value of the displayed number to the stack." + (when calculator-curnum + (push (calculator-string-to-number calculator-curnum) + calculator-stack) + (setq calculator-curnum nil))) (defun calculator-rotate-displayer (&optional new-disp) "Switch to the next displayer on the `calculator-displayers' list. @@ -956,7 +929,7 @@ If radix output mode is active, toggle digit grouping." (calculator-rotate-displayer (car (last calculator-displayers)))) (defun calculator-displayer-prev () - "Send the current displayer function a 'left argument. + "Send the current displayer function a `left' argument. This is used to modify display arguments (if the current displayer function supports this). If radix output mode is active, increase the grouping size." @@ -967,13 +940,12 @@ If radix output mode is active, increase the grouping size." (calculator-enter)) (and (car calculator-displayers) (let ((disp (caar calculator-displayers))) - (cond - ((symbolp disp) (funcall disp 'left)) - ((and (consp disp) (eq 'std (car disp))) - (calculator-standard-displayer 'left (cadr disp)))))))) + (cond ((symbolp disp) (funcall disp 'left)) + ((and (consp disp) (eq 'std (car disp))) + (calculator-standard-displayer 'left))))))) (defun calculator-displayer-next () - "Send the current displayer function a 'right argument. + "Send the current displayer function a `right' argument. This is used to modify display arguments (if the current displayer function supports this). If radix output mode is active, decrease the grouping size." @@ -984,44 +956,51 @@ If radix output mode is active, decrease the grouping size." (calculator-enter)) (and (car calculator-displayers) (let ((disp (caar calculator-displayers))) - (cond - ((symbolp disp) (funcall disp 'right)) - ((and (consp disp) (eq 'std (car disp))) - (calculator-standard-displayer 'right (cadr disp)))))))) + (cond ((symbolp disp) (funcall disp 'right)) + ((and (consp disp) (eq 'std (car disp))) + (calculator-standard-displayer 'right))))))) (defun calculator-remove-zeros (numstr) "Get a number string NUMSTR and remove unnecessary zeros. The behavior of this function is controlled by `calculator-remove-zeros'." - (cond ((and (eq calculator-remove-zeros t) - (string-match "\\.0+\\([eE][+-]?[0-9]*\\)?$" numstr)) - ;; remove all redundant zeros leaving an integer - (if (match-beginning 1) - (concat (substring numstr 0 (match-beginning 0)) - (match-string 1 numstr)) - (substring numstr 0 (match-beginning 0)))) - ((and calculator-remove-zeros - (string-match - "\\..\\([0-9]*[1-9]\\)?\\(0+\\)\\([eE][+-]?[0-9]*\\)?$" - numstr)) - ;; remove zeros, except for first after the "." - (if (match-beginning 3) - (concat (substring numstr 0 (match-beginning 2)) - (match-string 3 numstr)) - (substring numstr 0 (match-beginning 2)))) - (t numstr))) - -(defun calculator-standard-displayer (num char) + (let* ((s (if (not (eq calculator-remove-zeros t)) numstr + ;; remove all redundant zeros leaving an integer + (replace-regexp-in-string + "\\.0+\\([eE].*\\)?$" "\\1" numstr))) + (s (if (not calculator-remove-zeros) s + ;; remove zeros, except for first after the "." + (replace-regexp-in-string + "\\(\\..[0-9]*?\\)0+\\([eE].*\\)?$" "\\1\\2" s)))) + s)) + +(defun calculator-groupize-number (str n sep &optional fromleft) + "Return the input string STR with occurrences of SEP that separate +every N characters starting from the right, or from the left if +FROMLEFT is true." + (let* ((len (length str)) (i (/ len n)) (j (% len n)) + (r (if (or (not fromleft) (= j 0)) '() + (list (substring str (- len j)))))) + (while (> i 0) + (let* ((e (* i n)) (e (if fromleft e (+ e j)))) + (push (substring str (- e n) e) r)) + (setq i (1- i))) + (when (and (not fromleft) (> j 0)) + (push (substring str 0 j) r)) + (mapconcat 'identity r sep))) + +(defun calculator-standard-displayer (num &optional char group-p) "Standard display function, used to display NUM. Its behavior is determined by `calculator-number-digits' and the given CHAR argument (both will be used to compose a format string). If the char is \"n\" then this function will choose one between %f or %e, this is a work around %g jumping to exponential notation too fast. -The special 'left and 'right symbols will make it change the current -number of digits displayed (`calculator-number-digits'). +It will also split digit sequences into comma-separated groups +and/or remove redundant zeros. -It will also remove redundant zeros from the result." +The special `left' and `right' symbols will make it change the current +number of digits displayed (`calculator-number-digits')." (if (symbolp num) (cond ((eq num 'left) (and (> calculator-number-digits 0) @@ -1032,56 +1011,50 @@ It will also remove redundant zeros from the result." (setq calculator-number-digits (1+ calculator-number-digits)) (calculator-enter))) - (let ((str (if (zerop num) - "0" - (format - (concat "%." - (number-to-string calculator-number-digits) - (if (eq char ?n) - (let ((n (abs num))) - (if (or (< n 0.001) (> n 1e8)) "e" "f")) - (string char))) - num)))) - (calculator-remove-zeros str)))) + (let* ((s (if (eq char ?n) + (let ((n (abs num))) + (if (or (and (< 0 n) (< n 0.001)) (< 1e8 n)) ?e ?f)) + char)) + (s (format "%%.%s%c" calculator-number-digits s)) + (s (calculator-remove-zeros (format s num))) + (s (if (or (not group-p) (string-match-p "[eE]" s)) s + (replace-regexp-in-string + "\\([0-9]+\\)\\(?:\\.\\|$\\)" + (lambda (s) (calculator-groupize-number s 3 ",")) + s nil nil 1)))) + s))) (defun calculator-eng-display (num) "Display NUM in engineering notation. The number of decimal digits used is controlled by `calculator-number-digits', so to change it at runtime you have to use -the 'left or 'right when one of the standard modes is used." +the `left' or `right' when one of the standard modes is used." (if (symbolp num) (cond ((eq num 'left) (setq calculator-eng-extra - (if calculator-eng-extra - (1+ calculator-eng-extra) - 1)) + (if calculator-eng-extra (1+ calculator-eng-extra) 1)) (let ((calculator-eng-tmp-show t)) (calculator-enter))) ((eq num 'right) (setq calculator-eng-extra - (if calculator-eng-extra - (1- calculator-eng-extra) - -1)) + (if calculator-eng-extra (1- calculator-eng-extra) -1)) (let ((calculator-eng-tmp-show t)) (calculator-enter)))) (let ((exp 0)) - (and (not (= 0 num)) - (progn - (while (< (abs num) 1.0) - (setq num (* num 1000.0)) (setq exp (- exp 3))) - (while (> (abs num) 999.0) - (setq num (/ num 1000.0)) (setq exp (+ exp 3))) - (and calculator-eng-tmp-show - (not (= 0 calculator-eng-extra)) - (let ((i calculator-eng-extra)) - (while (> i 0) - (setq num (* num 1000.0)) (setq exp (- exp 3)) - (setq i (1- i))) - (while (< i 0) - (setq num (/ num 1000.0)) (setq exp (+ exp 3)) - (setq i (1+ i))))))) + (unless (= 0 num) + (while (< (abs num) 1.0) + (setq num (* num 1000.0)) (setq exp (- exp 3))) + (while (> (abs num) 999.0) + (setq num (/ num 1000.0)) (setq exp (+ exp 3))) + (when (and calculator-eng-tmp-show + (not (= 0 calculator-eng-extra))) + (let ((i calculator-eng-extra)) + (while (> i 0) + (setq num (* num 1000.0)) (setq exp (- exp 3)) + (setq i (1- i))) + (while (< i 0) + (setq num (/ num 1000.0)) (setq exp (+ exp 3)) + (setq i (1+ i)))))) (or calculator-eng-tmp-show (setq calculator-eng-extra nil)) - (let ((str (format (concat "%." (number-to-string - calculator-number-digits) - "f") + (let ((str (format (format "%%.%sf" calculator-number-digits) num))) (concat (let ((calculator-remove-zeros ;; make sure we don't leave integers @@ -1092,56 +1065,48 @@ the 'left or 'right when one of the standard modes is used." (defun calculator-number-to-string (num) "Convert NUM to a displayable string." (cond - ((and (numberp num) calculator-output-radix) - ;; print with radix - for binary I convert the octal number - (let ((str (format (if (eq calculator-output-radix 'hex) "%x" "%o") - (calculator-truncate - (if calculator-2s-complement num (abs num)))))) - (if (eq calculator-output-radix 'bin) - (let ((i -1) (s "")) - (while (< (setq i (1+ i)) (length str)) - (setq s - (concat s - (cdr (assq (aref str i) - '((?0 . "000") (?1 . "001") - (?2 . "010") (?3 . "011") - (?4 . "100") (?5 . "101") - (?6 . "110") (?7 . "111"))))))) - (string-match "^0*\\(.+\\)" s) - (setq str (match-string 1 s)))) - (if calculator-radix-grouping-mode - (let ((d (/ (length str) calculator-radix-grouping-digits)) - (r (% (length str) calculator-radix-grouping-digits))) - (while (>= (setq d (1- d)) (if (zerop r) 1 0)) - (let ((i (+ r (* d calculator-radix-grouping-digits)))) - (setq str (concat (substring str 0 i) - calculator-radix-grouping-separator - (substring str i))))))) - (upcase - (if (and (not calculator-2s-complement) (< num 0)) - (concat "-" str) - str)))) - ((and (numberp num) calculator-displayer) - (cond - ((stringp calculator-displayer) - (format calculator-displayer num)) - ((symbolp calculator-displayer) - (funcall calculator-displayer num)) - ((eq 'std (car-safe calculator-displayer)) - (calculator-standard-displayer num (cadr calculator-displayer))) - ((listp calculator-displayer) - (eval calculator-displayer `((num. ,num)))) - (t (prin1-to-string num t)))) - ;; operators are printed here - (t (prin1-to-string (nth 1 num) t)))) + ;; operators are printed here, the rest is for numbers + ((not (numberp num)) (prin1-to-string (nth 1 num) t)) + ;; %f/%e handle these, but avoid them in radix or in user displayers + ((and (floatp num) (isnan num)) "NaN") + ((<= 1.0e+INF num) "Inf") + ((<= num -1.0e+INF) "-Inf") + (calculator-output-radix + ;; print with radix -- for binary, convert the octal number + (let* ((fmt (if (eq calculator-output-radix 'hex) "%x" "%o")) + (str (if calculator-2s-complement num (abs num))) + (str (format fmt (calculator-truncate str))) + (bins '((?0 "000") (?1 "001") (?2 "010") (?3 "011") + (?4 "100") (?5 "101") (?6 "110") (?7 "111"))) + (str (if (not (eq calculator-output-radix 'bin)) str + (replace-regexp-in-string + "^0+\\(.\\)" "\\1" + (apply 'concat (mapcar (lambda (c) + (cadr (assq c bins))) + str))))) + (str (if (not calculator-radix-grouping-mode) str + (calculator-groupize-number + str calculator-radix-grouping-digits + calculator-radix-grouping-separator)))) + (upcase (if (or calculator-2s-complement (>= num 0)) str + (concat "-" str))))) + ((stringp calculator-displayer) (format calculator-displayer num)) + ((symbolp calculator-displayer) (funcall calculator-displayer num)) + ((eq 'std (car-safe calculator-displayer)) + (apply 'calculator-standard-displayer + num (cdr calculator-displayer))) + ((listp calculator-displayer) + (eval `(let ((num ',num)) ,calculator-displayer) t)) + ;; nil (or bad) displayer + (t (prin1-to-string num t)))) (defun calculator-update-display (&optional force) "Update the display. If optional argument FORCE is non-nil, don't use the cached string." (set-buffer calculator-buffer) ;; update calculator-stack-display - (if (or force - (not (eq (car calculator-stack-display) calculator-stack))) + (when (or force (not (eq (car calculator-stack-display) + calculator-stack))) (setq calculator-stack-display (cons calculator-stack (if calculator-stack @@ -1170,165 +1135,97 @@ If optional argument FORCE is non-nil, don't use the cached string." "")))) (let ((inhibit-read-only t)) (erase-buffer) - (insert (calculator-get-prompt))) + (insert (calculator-get-display))) (set-buffer-modified-p nil) - (if calculator-display-fragile - (goto-char (1+ (length calculator-prompt))) - (goto-char (1- (point))))) + (goto-char (if calculator-display-fragile + (1+ (length calculator-prompt)) + (1- (point))))) ;;;--------------------------------------------------------------------- ;;; Stack computations +(defun calculator-reduce-stack-once (prec) + "Worker for `calculator-reduce-stack'." + (cl-flet ((check (ar op) (and (listp op) + (<= prec (calculator-op-prec op)) + (= ar (calculator-op-arity op)))) + (call (op &rest args) (apply 'calculator-funcall + (nth 2 op) args))) + (pcase calculator-stack + ;; reduce "... ( x )" --> "... x" + (`((,_ \) . ,_) ,(and X (pred numberp)) (,_ \( . ,_) . ,rest) + (cons X rest)) + ;; reduce "... x op y" --> "... r", r is the result + (`(,(and Y (pred numberp)) + ,(and O (pred (check 2))) + ,(and X (pred numberp)) + . ,rest) + (cons (call O X Y) rest)) + ;; reduce "... op x" --> "... r" for prefix op + (`(,(and X (pred numberp)) ,(and O (pred (check -1))) . ,rest) + (cons (call O X) rest)) + ;; reduce "... x op" --> "... r" for postfix op + (`(,(and O (pred (check +1))) ,(and X (pred numberp)) . ,rest) + (cons (call O X) rest)) + ;; reduce "... op" --> "... r" for 0-ary op + (`(,(and O (pred (check 0))) . ,rest) + (cons (call O) rest)) + ;; reduce "... y x" --> "... x" + ;; (needed for 0-ary ops: replace current number with result) + (`(,(and X (pred numberp)) ,(and _Y (pred numberp)) . ,rest) + (cons X rest)) + (_ nil)))) ; nil = done + (defun calculator-reduce-stack (prec) - "Reduce the stack using top operator. -PREC is a precedence - reduce everything with higher precedence." - (while - (cond - ((and (cdr (cdr calculator-stack)) ; have three values - (consp (nth 0 calculator-stack)) ; two operators & num - (numberp (nth 1 calculator-stack)) - (consp (nth 2 calculator-stack)) - (eq '\) (nth 1 (nth 0 calculator-stack))) - (eq '\( (nth 1 (nth 2 calculator-stack)))) - ;; reduce "... ( x )" --> "... x" - (setq calculator-stack - (cons (nth 1 calculator-stack) - (nthcdr 3 calculator-stack))) - ;; another iteration - t) - ((and (cdr (cdr calculator-stack)) ; have three values - (numberp (nth 0 calculator-stack)) ; two nums & operator - (consp (nth 1 calculator-stack)) - (numberp (nth 2 calculator-stack)) - (= 2 (calculator-op-arity ; binary operator - (nth 1 calculator-stack))) - (<= prec ; with higher prec. - (calculator-op-prec (nth 1 calculator-stack)))) - ;; reduce "... x op y" --> "... r", r is the result - (setq calculator-stack - (cons (calculator-funcall - (nth 2 (nth 1 calculator-stack)) - (nth 2 calculator-stack) - (nth 0 calculator-stack)) - (nthcdr 3 calculator-stack))) - ;; another iteration - t) - ((and (>= (length calculator-stack) 2) ; have two values - (numberp (nth 0 calculator-stack)) ; number & operator - (consp (nth 1 calculator-stack)) - (= -1 (calculator-op-arity ; prefix-unary op - (nth 1 calculator-stack))) - (<= prec ; with higher prec. - (calculator-op-prec (nth 1 calculator-stack)))) - ;; reduce "... op x" --> "... r" for prefix op - (setq calculator-stack - (cons (calculator-funcall - (nth 2 (nth 1 calculator-stack)) - (nth 0 calculator-stack)) - (nthcdr 2 calculator-stack))) - ;; another iteration - t) - ((and (cdr calculator-stack) ; have two values - (consp (nth 0 calculator-stack)) ; operator & number - (numberp (nth 1 calculator-stack)) - (= +1 (calculator-op-arity ; postfix-unary op - (nth 0 calculator-stack))) - (<= prec ; with higher prec. - (calculator-op-prec (nth 0 calculator-stack)))) - ;; reduce "... x op" --> "... r" for postfix op - (setq calculator-stack - (cons (calculator-funcall - (nth 2 (nth 0 calculator-stack)) - (nth 1 calculator-stack)) - (nthcdr 2 calculator-stack))) - ;; another iteration - t) - ((and calculator-stack ; have one value - (consp (nth 0 calculator-stack)) ; an operator - (= 0 (calculator-op-arity ; 0-ary op - (nth 0 calculator-stack)))) - ;; reduce "... op" --> "... r" for 0-ary op - (setq calculator-stack - (cons (calculator-funcall - (nth 2 (nth 0 calculator-stack))) - (nthcdr 1 calculator-stack))) - ;; another iteration - t) - ((and (cdr calculator-stack) ; have two values - (numberp (nth 0 calculator-stack)) ; both numbers - (numberp (nth 1 calculator-stack))) - ;; get rid of redundant numbers: - ;; reduce "... y x" --> "... x" - ;; needed for 0-ary ops that puts more values - (setcdr calculator-stack (cdr (cdr calculator-stack)))) - (t ;; no more iterations - nil)))) + "Reduce the stack using top operators as long as possible. +PREC is a precedence -- reduce everything with higher precedence." + (let ((new nil)) + (while (setq new (calculator-reduce-stack-once prec)) + (setq calculator-stack new)))) (defun calculator-funcall (f &optional X Y) "If F is a symbol, evaluate (F X Y). Otherwise, it should be a list, evaluate it with X, Y bound to the arguments." ;; remember binary ops for calculator-repR/L - (if Y (setq calculator-last-opXY (list f X Y))) - (condition-case nil - ;; there used to be code here that returns 0 if the result was - ;; smaller than calculator-epsilon (1e-15). I don't think this is - ;; necessary now. - (if (symbolp f) - (cond ((and X Y) (funcall f X Y)) - (X (funcall f X)) - (t (funcall f))) - ;; f is an expression - (let* ((TX (calculator-truncate X)) - (TY (and Y (calculator-truncate Y))) - (DX (if calculator-deg (/ (* X pi) 180) X)) - (L calculator-saved-list)) - (cl-letf (((symbol-function 'F) - (lambda (&optional x y) (calculator-funcall f x y))) - ((symbol-function 'D) - (lambda (x) (if calculator-deg (/ (* x 180) float-pi) x)))) - (eval f `((X . ,X) - (Y . ,Y) - (TX . ,TX) - (TY . ,TY) - (DX . ,DX) - (L . ,L)))))) - (error 0))) + (when Y (setq calculator-last-opXY (list f X Y))) + (if (symbolp f) + (cond ((and X Y) (funcall f X Y)) + (X (funcall f X)) + (t (funcall f))) + ;; f is an expression + (let ((TX (and X (calculator-truncate X))) + (TY (and Y (calculator-truncate Y))) + (DX (if (and X calculator-deg) (/ (* X pi) 180) X)) + (L calculator-saved-list)) + (cl-flet ((F (&optional x y) (calculator-funcall f x y)) + (D (x) (if calculator-deg (/ (* x 180) float-pi) x))) + (eval `(let ((X ,X) (Y ,Y) (DX ,DX) (TX ,TX) (TY ,TY) (L ',L)) + ,f) + t))))) ;;;--------------------------------------------------------------------- ;;; Input interaction (defun calculator-last-input (&optional keys) "Last char (or event or event sequence) that was read. -Optional string argument KEYS will force using it as the keys entered." +Use KEYS if given, otherwise use `this-command-keys'." (let ((inp (or keys (this-command-keys)))) (if (or (stringp inp) (not (arrayp inp))) inp - ;; this translates kp-x to x and [tries to] create a string to - ;; lookup operators - (let* ((i -1) (converted-str (make-string (length inp) ? )) k) - ;; converts an array to a string the ops lookup with keypad - ;; input - (while (< (setq i (1+ i)) (length inp)) - (setq k (aref inp i)) - ;; if Emacs will someday have a event-key, then this would - ;; probably be modified anyway - (and (if (fboundp 'key-press-event-p) (key-press-event-p k)) - (if (fboundp 'event-key) - (and (event-key k) (setq k (event-key k))))) - ;; assume all symbols are translatable with an ascii-character - (and (symbolp k) - (setq k (or (get k 'ascii-character) ? ))) - (aset converted-str i k)) - converted-str)))) + ;; translates kp-x to x and [tries to] create a string to lookup + ;; operators; assume all symbols are translatable via + ;; `function-key-map' or with an 'ascii-character property + (concat (mapcar (lambda (k) + (if (numberp k) k (or (get k 'ascii-character) + (error "??bad key??")))) + (or (lookup-key function-key-map inp) inp)))))) (defun calculator-clear-fragile (&optional op) "Clear the fragile flag if it was set, then maybe reset all. OP is the operator (if any) that caused this call." - (if (and calculator-display-fragile - (or (not op) - (= -1 (calculator-op-arity op)) - (= 0 (calculator-op-arity op)))) + (when (and calculator-display-fragile + (or (not op) (memq (calculator-op-arity op) '(-1 0)))) ;; reset if last calc finished, and now get a num or prefix or 0-ary ;; op (calculator-reset)) @@ -1338,53 +1235,44 @@ OP is the operator (if any) that caused this call." "Enter a single digit." (interactive) (let ((inp (aref (calculator-last-input) 0))) - (if (and (or calculator-display-fragile - (not (numberp (car calculator-stack)))) - (cond - ((not calculator-input-radix) (<= inp ?9)) - ((eq calculator-input-radix 'bin) (<= inp ?1)) - ((eq calculator-input-radix 'oct) (<= inp ?7)) - (t t))) - ;; enter digit if starting a new computation or have an op on the - ;; stack - (progn - (calculator-clear-fragile) - (let ((digit (upcase (char-to-string inp)))) - (if (equal calculator-curnum "0") - (setq calculator-curnum nil)) - (setq calculator-curnum - (concat (or calculator-curnum "") digit))) - (calculator-update-display))))) + (when (and (or calculator-display-fragile + (not (numberp (car calculator-stack)))) + (<= inp (pcase calculator-input-radix + (`nil ?9) (`bin ?1) (`oct ?7) (_ 999)))) + (calculator-clear-fragile) + (setq calculator-curnum + (concat (if (equal calculator-curnum "0") "" + calculator-curnum) + (list (upcase inp)))) + (calculator-update-display)))) (defun calculator-decimal () "Enter a decimal period." (interactive) - (if (and (not calculator-input-radix) - (or calculator-display-fragile - (not (numberp (car calculator-stack)))) - (not (and calculator-curnum - (string-match-p "[.eE]" calculator-curnum)))) + (when (and (not calculator-input-radix) + (or calculator-display-fragile + (not (numberp (car calculator-stack)))) + (not (and calculator-curnum + (string-match-p "[.eE]" calculator-curnum)))) ;; enter the period on the same condition as a digit, only if no ;; period or exponent entered yet - (progn - (calculator-clear-fragile) - (setq calculator-curnum (concat (or calculator-curnum "0") ".")) - (calculator-update-display)))) + (calculator-clear-fragile) + (setq calculator-curnum (concat (or calculator-curnum "0") ".")) + (calculator-update-display))) (defun calculator-exp () "Enter an `E' exponent character, or a digit in hex input mode." (interactive) - (if calculator-input-radix - (calculator-digit) - (if (and (or calculator-display-fragile - (not (numberp (car calculator-stack)))) - (not (and calculator-curnum - (string-match-p "[eE]" calculator-curnum)))) - ;; same condition as above, also no E so far - (progn - (calculator-clear-fragile) - (setq calculator-curnum (concat (or calculator-curnum "1") "e")) - (calculator-update-display))))) + (cond + (calculator-input-radix (calculator-digit)) + ((and (or calculator-display-fragile + (not (numberp (car calculator-stack)))) + (not (and calculator-curnum + (string-match-p "[eE]" calculator-curnum)))) + ;; same condition as above, also no E so far + (calculator-clear-fragile) + (setq calculator-curnum (concat (or calculator-curnum "1") "e")) + (calculator-update-display)))) (defun calculator-op (&optional keys) "Enter an operator on the stack, doing all necessary reductions. @@ -1394,42 +1282,29 @@ Optional string argument KEYS will force using it as the keys entered." (let* ((last-inp (calculator-last-input keys)) (op (assoc last-inp calculator-operators))) (calculator-clear-fragile op) - (if (and calculator-curnum (/= (calculator-op-arity op) 0)) - (setq calculator-stack - (cons (calculator-curnum-value) calculator-stack))) - (setq calculator-curnum nil) - (if (and (= 2 (calculator-op-arity op)) - (not (and calculator-stack - (numberp (nth 0 calculator-stack))))) - ;; we have a binary operator but no number - search for a prefix - ;; version - (let ((rest-ops calculator-operators)) - (while (not (equal last-inp (car (car rest-ops)))) - (setq rest-ops (cdr rest-ops))) - (setq op (assoc last-inp (cdr rest-ops))) - (if (not (and op (= -1 (calculator-op-arity op)))) - ;;(error "Binary operator without a first operand") - (progn - (calculator-message - "Binary operator without a first operand") - (throw 'op-error nil))))) + (calculator-push-curnum) + (when (and (= 2 (calculator-op-arity op)) + (not (numberp (car calculator-stack)))) + ;; we have a binary operator but no number -- search for a + ;; prefix version + (setq op (assoc last-inp (cdr (memq op calculator-operators)))) + (unless (and op (= -1 (calculator-op-arity op))) + (calculator-message "Binary operator without a first operand") + (throw 'op-error nil))) (calculator-reduce-stack (cond ((eq (nth 1 op) '\() 10) ((eq (nth 1 op) '\)) 0) (t (calculator-op-prec op)))) - (if (or (and (= -1 (calculator-op-arity op)) - (numberp (car calculator-stack))) - (and (/= (calculator-op-arity op) -1) - (/= (calculator-op-arity op) 0) - (not (numberp (car calculator-stack))))) - ;;(error "Unterminated expression") - (progn - (calculator-message "Unterminated expression") - (throw 'op-error nil))) - (setq calculator-stack (cons op calculator-stack)) + (when (let ((hasnum (numberp (car calculator-stack)))) + (pcase (calculator-op-arity op) + (-1 hasnum) + ((or 1 2) (not hasnum)))) + (calculator-message "Incomplete expression") + (throw 'op-error nil)) + (push op calculator-stack) (calculator-reduce-stack (calculator-op-prec op)) (and (= (length calculator-stack) 1) - (numberp (nth 0 calculator-stack)) + (numberp (car calculator-stack)) ;; the display is fragile if it contains only one number (setq calculator-display-fragile t) ;; add number to the saved-list @@ -1445,7 +1320,8 @@ Optional string argument KEYS will force using it as the keys entered." (defun calculator-op-or-exp () "Either enter an operator or a digit. Used with +/- for entering them as digits in numbers like 1e-3 (there is -no need for negative numbers since these are handled by unary operators)." +no need for negative numbers since these are handled by unary +operators)." (interactive) (if (and (not calculator-display-fragile) calculator-curnum @@ -1459,14 +1335,11 @@ no need for negative numbers since these are handled by unary operators)." (defun calculator-dec/deg-mode () "Set decimal mode for display & input, if decimal, toggle deg mode." (interactive) - (if calculator-curnum - (setq calculator-stack - (cons (calculator-curnum-value) calculator-stack))) - (setq calculator-curnum nil) + (calculator-push-curnum) (if (or calculator-input-radix calculator-output-radix) (progn (setq calculator-input-radix nil) (setq calculator-output-radix nil)) - ;; already decimal - toggle degrees mode + ;; already decimal -- toggle degrees mode (setq calculator-deg (not calculator-deg))) (calculator-update-display t)) @@ -1481,10 +1354,7 @@ Optional string argument KEYS will force using it as the keys entered." "Set input radix modes. Optional string argument KEYS will force using it as the keys entered." (interactive) - (if calculator-curnum - (setq calculator-stack - (cons (calculator-curnum-value) calculator-stack))) - (setq calculator-curnum nil) + (calculator-push-curnum) (setq calculator-input-radix (let ((inp (calculator-last-input keys))) (cdr (assq (upcase (aref inp (1- (length inp)))) @@ -1495,10 +1365,7 @@ Optional string argument KEYS will force using it as the keys entered." "Set display radix modes. Optional string argument KEYS will force using it as the keys entered." (interactive) - (if calculator-curnum - (setq calculator-stack - (cons (calculator-curnum-value) calculator-stack))) - (setq calculator-curnum nil) + (calculator-push-curnum) (setq calculator-output-radix (let ((inp (calculator-last-input keys))) (cdr (assq (upcase (aref inp (1- (length inp)))) @@ -1524,19 +1391,18 @@ Optional string argument KEYS will force using it as the keys entered." (defun calculator-saved-move (n) "Go N elements up the list of saved values." (interactive) - (and calculator-saved-list - (or (null calculator-stack) calculator-display-fragile) - (progn - (setq calculator-saved-ptr - (max (min (+ n calculator-saved-ptr) - (length calculator-saved-list)) - 0)) - (if (nth calculator-saved-ptr calculator-saved-list) - (setq calculator-stack - (list (nth calculator-saved-ptr calculator-saved-list)) - calculator-display-fragile t) - (calculator-reset)) - (calculator-update-display)))) + (when (and calculator-saved-list + (or (null calculator-stack) calculator-display-fragile)) + (setq calculator-saved-ptr + (max (min (+ n calculator-saved-ptr) + (length calculator-saved-list)) + 0)) + (if (nth calculator-saved-ptr calculator-saved-list) + (setq calculator-stack (list (nth calculator-saved-ptr + calculator-saved-list)) + calculator-display-fragile t) + (calculator-reset)) + (calculator-update-display))) (defun calculator-saved-up () "Go up the list of saved values." @@ -1583,7 +1449,7 @@ Optional string argument KEYS will force using it as the keys entered." (interactive) (setq calculator-curnum nil) (cond - ;; if the current number is from the saved-list - remove it + ;; if the current number is from the saved-list remove it ((and calculator-display-fragile calculator-saved-list (= (car calculator-stack) @@ -1592,7 +1458,7 @@ Optional string argument KEYS will force using it as the keys entered." (setq calculator-saved-list (cdr calculator-saved-list)) (let ((p (nthcdr (1- calculator-saved-ptr) calculator-saved-list))) - (setcdr p (cdr (cdr p))) + (setcdr p (cddr p)) (setq calculator-saved-ptr (1- calculator-saved-ptr)))) (if calculator-saved-list (setq calculator-stack @@ -1613,15 +1479,16 @@ Optional string argument KEYS will force using it as the keys entered." (calculator-enter) ;; remove trailing spaces and an index (let ((s (cdr calculator-stack-display))) - (and s - (if (string-match "^\\([^ ]+\\) *\\(\\[[0-9/]+\\]\\)? *$" s) - (setq s (match-string 1 s))) - (kill-new s))))) + (when s + (kill-new (replace-regexp-in-string + "^\\([^ ]+\\) *\\(\\[[0-9/]+\\]\\)? *$" "\\1" s)))))) -;; FIXME this should use register-read-with-preview, but it -;; uses calculator-registers rather than register-alist. (defun calculator-set-register (reg) "Set a register value for REG." + ;; FIXME: this should use `register-read-with-preview', but it uses + ;; calculator-registers rather than `register-alist'. (Maybe + ;; dynamically rebinding it will get blessed?) Also in to + ;; `calculator-get-register'. (interactive "cRegister to store into: ") (let* ((as (assq reg calculator-registers)) (val (progn (calculator-enter) (car calculator-stack)))) @@ -1634,15 +1501,14 @@ Optional string argument KEYS will force using it as the keys entered." (defun calculator-put-value (val) "Paste VAL as if entered. Used by `calculator-paste' and `get-register'." - (if (and (numberp val) - ;; (not calculator-curnum) - (or calculator-display-fragile - (not (numberp (car calculator-stack))))) - (progn - (calculator-clear-fragile) - (setq calculator-curnum (let ((calculator-displayer "%S")) - (calculator-number-to-string val))) - (calculator-update-display)))) + (when (and (numberp val) + ;; (not calculator-curnum) + (or calculator-display-fragile + (not (numberp (car calculator-stack))))) + (calculator-clear-fragile) + (setq calculator-curnum (let ((calculator-displayer "%S")) + (calculator-number-to-string val))) + (calculator-update-display))) (defun calculator-paste () "Paste a value from the `kill-ring'." @@ -1662,8 +1528,6 @@ Used by `calculator-paste' and `get-register'." (or (match-string 3 str) "")))) (ignore-errors (calculator-string-to-number str))))) -;; FIXME this should use register-read-with-preview, but it -;; uses calculator-registers rather than register-alist. (defun calculator-get-register (reg) "Get a value from a register REG." (interactive "cRegister to get value from: ") @@ -1696,16 +1560,13 @@ Used by `calculator-paste' and `get-register'." (g-map (current-global-map)) (win (selected-window))) (require 'ehelp) - (if calculator-electric-mode + (when calculator-electric-mode (use-global-map calculator-saved-global-map)) - (if (or (not calculator-electric-mode) - ;; XEmacs has a problem with electric-describe-mode - (featurep 'xemacs)) - (describe-mode) - (electric-describe-mode)) (if calculator-electric-mode - (use-global-map g-map)) - (select-window win) ; these are for XEmacs (also below) + (electric-describe-mode) + (describe-mode)) + (when calculator-electric-mode (use-global-map g-map)) + (select-window win) (message nil)) (let ((one (one-window-p t)) (win (selected-window)) @@ -1713,12 +1574,11 @@ Used by `calculator-paste' and `get-register'." (save-window-excursion (with-output-to-temp-buffer "*Help*" (princ (documentation 'calculator-help))) - (if one - (shrink-window-if-larger-than-buffer - (get-buffer-window help-buf))) - (message - "`%s' again for more help, any other key continues normally." - (calculator-last-input)) + (when one (shrink-window-if-larger-than-buffer + (get-buffer-window help-buf))) + (message "`%s' again for more help, %s." + (calculator-last-input) + "any other key continues normally") (select-window win) (sit-for 360)) (select-window win)))) @@ -1731,11 +1591,12 @@ Used by `calculator-paste' and `get-register'." (unless calculator-electric-mode (ignore-errors (while (get-buffer-window calculator-buffer) - (delete-window (get-buffer-window calculator-buffer)))) - (kill-buffer calculator-buffer)) - (setq calculator-buffer nil) + (delete-window (get-buffer-window calculator-buffer))))) + (kill-buffer calculator-buffer) (message "Calculator done.") - (if calculator-electric-mode (throw 'calculator-done nil))) + (if calculator-electric-mode + (throw 'calculator-done nil) ; will kill the buffer + (setq calculator-buffer nil))) (defun calculator-save-and-quit () "Quit the calculator, saving the result on the `kill-ring'." @@ -1764,58 +1625,47 @@ To use this, apply a binary operator (evaluate it), then call this." (car calculator-last-opXY) (nth 1 calculator-last-opXY) x)) x)) -(defun calculator-integer-p (x) - "Non-nil if X is equal to an integer." - (ignore-errors (= x (ftruncate x)))) - (defun calculator-expt (x y) "Compute X^Y, dealing with errors appropriately." (condition-case nil (expt x y) (domain-error 0.0e+NaN) (range-error - (cond - ((and (< x 1.0) (> x -1.0)) - ;; For small x, the range error comes from large y. - 0.0) - ((and (> x 0.0) (< y 0.0)) - ;; For large positive x and negative y, the range error - ;; comes from large negative y. - 0.0) - ((and (> x 0.0) (> y 0.0)) - ;; For large positive x and positive y, the range error - ;; comes from large y. - 1.0e+INF) - ;; For the rest, x must be large and negative. - ;; The range errors come from large integer y. - ((< y 0.0) - 0.0) - ((eq (logand (truncate y) 1) 1) ; expansion of cl `oddp' - ;; If y is odd - -1.0e+INF) - (t - ;; - 1.0e+INF))) + (cond ((and (< x 1.0) (> x -1.0)) + ;; For small x, the range error comes from large y. + 0.0) + ((and (> x 0.0) (< y 0.0)) + ;; For large positive x and negative y, the range error + ;; comes from large negative y. + 0.0) + ((and (> x 0.0) (> y 0.0)) + ;; For large positive x and positive y, the range error + ;; comes from large y. + 1.0e+INF) + ;; For the rest, x must be large and negative. + ;; The range errors come from large integer y. + ((< y 0.0) + 0.0) + ((eq (logand (truncate y) 1) 1) ; expansion of cl `oddp' + ;; If y is odd + -1.0e+INF) + (t + ;; + 1.0e+INF))) (error 0.0e+NaN))) (defun calculator-fact (x) "Simple factorial of X." - (if (and (>= x 0) - (calculator-integer-p x)) - (if (= (calculator-expt (/ x 3.0) x) 1.0e+INF) - 1.0e+INF - (let ((r (if (<= x 10) 1 1.0))) - (while (> x 0) - (setq r (* r (truncate x))) - (setq x (1- x))) - (+ 0.0 r))) - (if (= x 1.0e+INF) - x - 0.0e+NaN))) + (cond ((>= x 1.0e+INF) x) + ((or (and (floatp x) (isnan x)) (< x 0)) 0.0e+NaN) + ((>= (calculator-expt (/ x 3.0) x) 1.0e+INF) 1.0e+INF) + (t (let ((x (truncate x)) (r 1.0)) + (while (> x 0) (setq r (* r x) x (1- x))) + r)))) (defun calculator-truncate (n) "Truncate N, return 0 in case of overflow." - (condition-case nil (truncate n) (error 0))) + (condition-case nil (truncate n) (range-error 0))) (provide 'calculator) diff --git a/lisp/calendar/cal-china.el b/lisp/calendar/cal-china.el index 538d2320b30..e266613680a 100644 --- a/lisp/calendar/cal-china.el +++ b/lisp/calendar/cal-china.el @@ -682,6 +682,124 @@ Echo Chinese date unless NOECHO is non-nil." "Chinese calendar equivalent of date diary entry." (format "Chinese date: %s" (calendar-chinese-date-string date))) +;;;; diary support + +(autoload 'calendar-mark-1 "diary-lib") +(autoload 'diary-mark-entries-1 "diary-lib") +(autoload 'diary-list-entries-1 "diary-lib") +(autoload 'diary-insert-entry-1 "diary-lib") +(autoload 'diary-date-display-form "diary-lib") +(autoload 'diary-make-date "diary-lib") +(autoload 'diary-ordinal-suffix "diary-lib") +(defvar diary-sexp-entry-symbol) +(defvar entry) ;used by `diary-chinese-anniversary' + +(defvar calendar-chinese-month-name-array + ["正月" "二月" "三月" "四月" "五月" "六月" + "七月" "八月" "九月" "十月" "冬月" "臘月"]) + +;;; NOTE: In the diary the cycle and year of a Chinese date is +;;; combined using this formula: (+ (* cycle 100) year). +;;; +;;; These two functions convert to and back from this representation. +(defun calendar-chinese-from-absolute-for-diary (date) + (pcase-let ((`(,c ,y ,m ,d) (calendar-chinese-from-absolute date))) + (list m d (+ (* c 100) y)))) + +(defun calendar-chinese-to-absolute-for-diary (date) + (pcase-let ((`(,m ,d ,y) date)) + (calendar-chinese-to-absolute + (list (floor y 100) (mod y 100) m d)))) + +(defun calendar-chinese-mark-date-pattern (month day year &optional color) + (calendar-mark-1 month day year + #'calendar-chinese-from-absolute-for-diary + #'calendar-chinese-to-absolute-for-diary + color)) + +;;;###cal-autoload +(defun diary-chinese-mark-entries () + "Mark days in the calendar window that have Chinese date diary entries. +Marks each entry in `diary-file' (or included files) visible in the calendar +window. See `diary-chinese-list-entries' for more information. + +This function is provided for use with `diary-nongregorian-marking-hook'." + (diary-mark-entries-1 #'calendar-chinese-mark-date-pattern + calendar-chinese-month-name-array + diary-chinese-entry-symbol + #'calendar-chinese-from-absolute-for-diary)) + +;;;###cal-autoload +(defun diary-chinese-list-entries () + "Add any Chinese date entries from the diary file to `diary-entries-list'. +Chinese date diary entries must be prefixed by `diary-chinese-entry-symbol' +\(normally a `C'). The same `diary-date-forms' govern the style +of the Chinese calendar entries. If a Chinese date diary entry begins with +`diary-nonmarking-symbol', the entry will appear in the diary listing, +but will not be marked in the calendar. + +This function is provided for use with `diary-nongregorian-listing-hook'." + (diary-list-entries-1 calendar-chinese-month-name-array + diary-chinese-entry-symbol + #'calendar-chinese-from-absolute-for-diary)) + +;;;###cal-autoload +(defun diary-chinese-anniversary (month day &optional year mark) + "Like `diary-anniversary' (which see) but accepts Chinese date." + (pcase-let* ((ddate (diary-make-date month day year)) + (`(,dc ,dy ,dm ,dd) ;diary chinese date + (if year + (calendar-chinese-from-absolute + (calendar-chinese-to-absolute-for-diary ddate)) + (list nil nil (calendar-extract-month ddate) + (calendar-extract-day ddate)))) + (`(,cc ,cy ,cm ,cd) ;current chinese date + (calendar-chinese-from-absolute + (calendar-absolute-from-gregorian date))) + (diff (if (and dc dy) + (+ (* 60 (- cc dc)) (- cy dy)) + 100))) + (and (> diff 0) (= dm cm) (= dd cd) + (cons mark (format entry diff (diary-ordinal-suffix diff)))))) + +;;;###cal-autoload +(defun diary-chinese-insert-anniversary-entry (&optional arg) + "Insert an anniversary diary entry for the Chinese date at point. +Prefix argument ARG makes the entry nonmarking." + (interactive "P") + (let ((calendar-date-display-form (diary-date-display-form))) + (diary-make-entry + (format "%s(diary-chinese-anniversary %s)" + diary-sexp-entry-symbol + (calendar-date-string + (calendar-chinese-from-absolute-for-diary + (calendar-absolute-from-gregorian (calendar-cursor-to-date t))))) + arg))) + +;;;###cal-autoload +(defun diary-chinese-insert-entry (&optional arg) + "Insert a diary entry for the Chinese date at point." + (interactive "P") + (diary-insert-entry-1 nil arg calendar-chinese-month-name-array + diary-chinese-entry-symbol + #'calendar-chinese-from-absolute-for-diary)) + +;;;###cal-autoload +(defun diary-chinese-insert-monthly-entry (&optional arg) + "Insert a monthly diary entry for the Chinese date at point." + (interactive "P") + (diary-insert-entry-1 'monthly arg calendar-chinese-month-name-array + diary-chinese-entry-symbol + #'calendar-chinese-from-absolute-for-diary)) + +;;;###cal-autoload +(defun diary-chinese-insert-yearly-entry (&optional arg) + "Insert a yearly diary entry for the Chinese date at point." + (interactive "P") + (diary-insert-entry-1 'yearly arg calendar-chinese-month-name-array + diary-chinese-entry-symbol + #'calendar-chinese-from-absolute-for-diary)) + (provide 'cal-china) ;;; cal-china.el ends here diff --git a/lisp/calendar/cal-menu.el b/lisp/calendar/cal-menu.el index e71fccf19bc..23e1b5e0e97 100644 --- a/lisp/calendar/cal-menu.el +++ b/lisp/calendar/cal-menu.el @@ -56,6 +56,11 @@ ["One time" diary-bahai-insert-entry] ["Monthly" diary-bahai-insert-monthly-entry] ["Yearly" diary-bahai-insert-yearly-entry]) + ("Insert Chinese" + ["One time" diary-chinese-insert-entry] + ["Monthly" diary-chinese-insert-monthly-entry] + ["Yearly" diary-chinese-insert-yearly-entry] + ["Anniversary" diary-chinese-insert-anniversary-entry]) ("Insert Islamic" ["One time" diary-islamic-insert-entry] ["Monthly" diary-islamic-insert-monthly-entry] diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 57cb488a838..581dd3437d9 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -1,7 +1,6 @@ ;;; calendar.el --- calendar functions -;; Copyright (C) 1988-1995, 1997, 2000-2014 Free Software Foundation, -;; Inc. +;; Copyright (C) 1988-1995, 1997, 2000-2014 Free Software Foundation, Inc. ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> ;; Maintainer: Glenn Morris <rgm@gnu.org> @@ -689,6 +688,12 @@ details, see the documentation for the variable `diary-list-entries-hook'." :type 'string :group 'diary) +(defcustom diary-chinese-entry-symbol "C" + "Symbol indicating a diary entry according to the Chinese calendar." + :type 'string + :group 'diary + :version "24.5") + (define-obsolete-variable-alias 'hebrew-diary-entry-symbol 'diary-hebrew-entry-symbol "23.1") @@ -1468,17 +1473,15 @@ Optional integers MON and YR are used instead of today's date." ;; combined don't fit height to that of its buffer. (set-window-vscroll nil 0)) (sit-for 0)) - (and (bound-and-true-p font-lock-mode) - (font-lock-fontify-buffer)) (and calendar-mark-holidays-flag -;;; (calendar-date-is-valid-p today) ; useful for BC dates + ;; (calendar-date-is-valid-p today) ; useful for BC dates (calendar-mark-holidays) (and in-calendar-window (sit-for 0))) (unwind-protect (if calendar-mark-diary-entries-flag (diary-mark-entries)) - (if today-visible - (run-hooks 'calendar-today-visible-hook) - (run-hooks 'calendar-today-invisible-hook))))) + (run-hooks (if today-visible + 'calendar-today-visible-hook + 'calendar-today-invisible-hook))))) (defun calendar-generate (month year) "Generate a three-month Gregorian calendar centered around MONTH, YEAR." @@ -1709,6 +1712,10 @@ line." (define-key map "iBd" 'diary-bahai-insert-entry) (define-key map "iBm" 'diary-bahai-insert-monthly-entry) (define-key map "iBy" 'diary-bahai-insert-yearly-entry) + (define-key map "iCd" 'diary-chinese-insert-entry) + (define-key map "iCm" 'diary-chinese-insert-monthly-entry) + (define-key map "iCy" 'diary-chinese-insert-yearly-entry) + (define-key map "iCa" 'diary-chinese-insert-anniversary-entry) (define-key map "?" 'calendar-goto-info-node) (define-key map "Hm" 'cal-html-cursor-month) (define-key map "Hy" 'cal-html-cursor-year) diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index c609cee7d6f..a4e36d9abe8 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -2374,6 +2374,7 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL." (defvar calendar-hebrew-month-name-array-leap-year) (defvar calendar-islamic-month-name-array) (defvar calendar-bahai-month-name-array) +(defvar calendar-chinese-month-name-array) ;;;###cal-autoload (defun diary-font-lock-keywords () @@ -2396,6 +2397,11 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL." cal-bahai calendar-bahai-month-name-array diary-bahai-entry-symbol) + (diary-font-lock-keywords-1 diary-chinese-mark-entries + diary-chinese-list-entries + cal-china + calendar-chinese-month-name-array + diary-chinese-entry-symbol) (list (cons (format "^%s.*$" (regexp-quote diary-include-string)) @@ -2412,7 +2418,8 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL." (regexp-opt (mapcar 'regexp-quote (list diary-hebrew-entry-symbol diary-islamic-entry-symbol - diary-bahai-entry-symbol)) + diary-bahai-entry-symbol + diary-chinese-entry-symbol)) t)) '(1 font-lock-constant-face)) '(diary-font-lock-sexps . font-lock-keyword-face) diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el index 79569f2142c..6bfccec94c6 100644 --- a/lisp/calendar/parse-time.el +++ b/lisp/calendar/parse-time.el @@ -218,6 +218,68 @@ unknown are returned as nil." (rplaca (nthcdr (pop slots) time) new-val)))))))) time)) +(defconst parse-time-iso8601-regexp + (let* ((dash "-?") + (colon ":?") + (4digit "\\([0-9][0-9][0-9][0-9]\\)") + (2digit "\\([0-9][0-9]\\)") + (date-fullyear 4digit) + (date-month 2digit) + (date-mday 2digit) + (time-hour 2digit) + (time-minute 2digit) + (time-second 2digit) + (time-secfrac "\\(\\.[0-9]+\\)?") + (time-numoffset (concat "[-+]\\(" time-hour "\\):" time-minute)) + (time-offset (concat "Z" time-numoffset)) + (partial-time (concat time-hour colon time-minute colon time-second + time-secfrac)) + (full-date (concat date-fullyear dash date-month dash date-mday)) + (full-time (concat partial-time time-offset)) + (date-time (concat full-date "T" full-time))) + (list (concat "^" full-date) + (concat "T" partial-time) + (concat "Z" time-numoffset))) + "List of regular expressions matching ISO 8601 dates. +1st regular expression matches the date. +2nd regular expression matches the time. +3rd regular expression matches the (optional) timezone specification.") + +(defun parse-iso8601-time-string (date-string) + (let* ((date-re (nth 0 parse-time-iso8601-regexp)) + (time-re (nth 1 parse-time-iso8601-regexp)) + (tz-re (nth 2 parse-time-iso8601-regexp)) + re-start + time seconds minute hour fractional-seconds + day month year day-of-week dst tz) + ;; We need to populate 'time' with + ;; (SEC MIN HOUR DAY MON YEAR DOW DST TZ) + + ;; Nobody else handles iso8601 correctly, let's do it ourselves. + (when (string-match date-re date-string re-start) + (setq year (string-to-number (match-string 1 date-string)) + month (string-to-number (match-string 2 date-string)) + day (string-to-number (match-string 3 date-string)) + re-start (match-end 0)) + (when (string-match time-re date-string re-start) + (setq hour (string-to-number (match-string 1 date-string)) + minute (string-to-number (match-string 2 date-string)) + seconds (string-to-number (match-string 3 date-string)) + fractional-seconds (string-to-number (or + (match-string 4 date-string) + "0")) + re-start (match-end 0)) + (when (string-match tz-re date-string re-start) + (setq tz (match-string 1 date-string))) + (setq time (list seconds minute hour day month year day-of-week dst tz)))) + + ;; Fall back to having Gnus do fancy things for us. + (when (not time) + (setq time (parse-time-string date-string))) + + (and time + (apply 'encode-time time)))) + (provide 'parse-time) ;;; parse-time.el ends here diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 3d62c5d789a..b04cfcd9fe4 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -388,6 +388,23 @@ This function does not work for SECONDS greater than `most-positive-fixnum'." t t string)))))) (replace-regexp-in-string "%%" "%" string)) +(defvar seconds-to-string + (list (list 1 "ms" 0.001) + (list 100 "s" 1) + (list (* 60 100) "m" 60.0) + (list (* 3600 30) "h" 3600.0) + (list (* 3600 24 400) "d" (* 3600.0 24.0)) + (list nil "y" (* 365.25 24 3600))) + "Formatting used by the function `seconds-to-string'.") +;;;###autoload +(defun seconds-to-string (delay) + "Convert the time interval in seconds to a short string." + (cond ((> 0 delay) (concat "-" (seconds-to-string (- delay)))) + ((= 0 delay) "0s") + (t (let ((sts seconds-to-string) here) + (while (and (car (setq here (pop sts))) + (<= (car here) delay))) + (concat (format "%.2f" (/ delay (car (cddr here)))) (cadr here)))))) (provide 'time-date) diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog index 750e0bca095..820e75260a9 100644 --- a/lisp/cedet/ChangeLog +++ b/lisp/cedet/ChangeLog @@ -1,3 +1,9 @@ +2014-06-19 Stefan Monnier <monnier@iro.umontreal.ca> + + * semantic/ia.el (semantic-ia-complete-symbol-menu): Use posn-at-point + instead of senator-completion-menu-point-as-event; un-comment, tho keep + the "no smart completion" fallback commented since it still doesn't work. + 2014-05-01 Glenn Morris <rgm@gnu.org> * ede.el (ede-project-directories, ede-check-project-directory): @@ -10,6 +16,14 @@ * ede/emacs.el (ede-emacs-version): Update AC_INIT regexp. (Bug#17160) +2014-03-29 Glenn Morris <rgm@gnu.org> + + * ede/dired.el (ede-dired-minor-mode): Add autoload cookie. + (generated-autoload-file, generated-autoload-load-name): + Set file-local values. + * ede.el: Load ede/loaddefs at compile time too. + (ede-dired-minor-mode): Remove hand-written autoload. + 2014-03-04 Glenn Morris <rgm@gnu.org> * semantic/util.el (semantic-complete-symbol): diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el index cbcc20f5039..a9a53d776e2 100644 --- a/lisp/cedet/ede.el +++ b/lisp/cedet/ede.el @@ -46,7 +46,8 @@ (require 'ede/base) (require 'ede/auto) -(load "ede/loaddefs" nil 'nomessage) +(eval-and-compile + (load "ede/loaddefs" nil 'nomessage)) (declare-function ede-commit-project "ede/custom") (declare-function ede-convert-path "ede/files") @@ -450,8 +451,6 @@ If optional argument CURRENT is non-nil, return sub-menu code." ;;; Mode Declarations ;; -(eval-and-compile - (autoload 'ede-dired-minor-mode "ede/dired" "EDE commands for dired" t)) (defun ede-apply-target-options () "Apply options to the current buffer for the active project/target." diff --git a/lisp/cedet/ede/dired.el b/lisp/cedet/ede/dired.el index ee17dc95fbc..4c17a91a984 100644 --- a/lisp/cedet/ede/dired.el +++ b/lisp/cedet/ede/dired.el @@ -55,6 +55,7 @@ map) "Keymap used for ede dired minor mode.") +;;;###autoload (define-minor-mode ede-dired-minor-mode "A minor mode that should only be activated in DIRED buffers. If ARG is nil or a positive number, force on, if @@ -83,4 +84,9 @@ negative, force off." (provide 'ede/dired) +;; Local variables: +;; generated-autoload-file: "loaddefs.el" +;; generated-autoload-load-name: "ede/dired" +;; End: + ;;; ede/dired.el ends here diff --git a/lisp/cedet/semantic/ia.el b/lisp/cedet/semantic/ia.el index 10e84880ab6..8a5cbac4129 100644 --- a/lisp/cedet/semantic/ia.el +++ b/lisp/cedet/semantic/ia.el @@ -150,45 +150,47 @@ Completion options are calculated with `semantic-analyze-possible-completions'." :group 'semantic :type semantic-format-tag-custom-list) -;; Disabled - see http://debbugs.gnu.org/14522 -;; ;;;###autoload -;; (defun semantic-ia-complete-symbol-menu (point) -;; "Complete the current symbol via a menu based at POINT. -;; Completion options are calculated with `semantic-analyze-possible-completions'." -;; (interactive "d") -;; (require 'imenu) -;; (let* ((a (semantic-analyze-current-context point)) -;; (syms (semantic-analyze-possible-completions a)) -;; ) -;; ;; Complete this symbol. -;; (if (not syms) -;; (progn -;; (message "No smart completions found. Trying Senator.") -;; (when (semantic-analyze-context-p a) -;; ;; This is a quick way of getting a nice completion list -;; ;; in the menu if the regular context mechanism fails. -;; (senator-completion-menu-popup))) -;; -;; (let* ((menu -;; (mapcar -;; (lambda (tag) -;; (cons -;; (funcall semantic-ia-completion-menu-format-tag-function tag) -;; (vector tag))) -;; syms)) -;; (ans -;; (imenu--mouse-menu -;; ;; XEmacs needs that the menu has at least 2 items. So, -;; ;; include a nil item that will be ignored by imenu. -;; (cons nil menu) -;; (senator-completion-menu-point-as-event) -;; "Completions"))) -;; (when ans -;; (if (not (semantic-tag-p ans)) -;; (setq ans (aref (cdr ans) 0))) -;; (delete-region (car (oref a bounds)) (cdr (oref a bounds))) -;; (semantic-ia-insert-tag ans)) -;; )))) +;;;###autoload +(defun semantic-ia-complete-symbol-menu (point) + "Complete the current symbol via a menu based at POINT. +Completion options are calculated with `semantic-analyze-possible-completions'." + (interactive "d") + (require 'imenu) + (let* ((a (semantic-analyze-current-context point)) + (syms (semantic-analyze-possible-completions a)) + ) + ;; Complete this symbol. + (if (not syms) + (progn + (message "No smart completions found.") + ;; Disabled - see http://debbugs.gnu.org/14522 + ;; (message "No smart completions found. Trying Senator.") + ;; (when (semantic-analyze-context-p a) + ;; ;; This is a quick way of getting a nice completion list + ;; ;; in the menu if the regular context mechanism fails. + ;; (senator-completion-menu-popup)) + ) + + (let* ((menu + (mapcar + (lambda (tag) + (cons + (funcall semantic-ia-completion-menu-format-tag-function tag) + (vector tag))) + syms)) + (ans + (imenu--mouse-menu + ;; XEmacs needs that the menu has at least 2 items. So, + ;; include a nil item that will be ignored by imenu. + (cons nil menu) + `(down-mouse-1 ,(posn-at-point)) + "Completions"))) + (when ans + (if (not (semantic-tag-p ans)) + (setq ans (aref (cdr ans) 0))) + (delete-region (car (oref a bounds)) (cdr (oref a bounds))) + (semantic-ia-insert-tag ans)) + )))) ;;; Completions Tip ;; diff --git a/lisp/comint.el b/lisp/comint.el index 00e193d642e..da3782717c0 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -746,11 +746,11 @@ The buffer name is made by surrounding the file name of PROGRAM with `*'s. The file name is used to make a symbol name, such as `comint-sh-hook', and any hooks on this symbol are run in the buffer. See `make-comint' and `comint-exec'." + (declare (interactive-only make-comint)) (interactive "sRun program: ") (let ((name (file-name-nondirectory program))) (switch-to-buffer (make-comint name program)) (run-hooks (intern-soft (concat "comint-" name "-hook"))))) -(put 'comint-run 'interactive-only 'make-comint) (defun comint-exec (buffer name command startfile switches) "Start up a process named NAME in buffer BUFFER for Comint modes. @@ -1769,6 +1769,12 @@ If the Comint is Lucid Common Lisp, Similarly for Soar, Scheme, etc." (interactive) + ;; If we're currently completing, stop. We're definitely done + ;; completing, and by sending the input, we might cause side effects + ;; that will confuse the code running in the completion + ;; post-command-hook. + (when completion-in-region-mode + (completion-in-region-mode -1)) ;; Note that the input string does not include its terminal newline. (let ((proc (get-buffer-process (current-buffer)))) (if (not proc) (user-error "Current buffer has no process") diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 2da67112bd3..b446a00bb8f 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -198,6 +198,8 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of ;; editfns.c (user-full-name mail string) + ;; emacs.c + (report-emacs-bug-address emacsbug string) ;; eval.c (max-specpdl-size limits integer) (max-lisp-eval-depth limits integer) @@ -317,7 +319,7 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (enable-recursive-minibuffers minibuffer boolean) (history-length minibuffer (choice (const :tag "Infinite" t) integer) - "22.1") + "24.5") ; 30 -> 100 (history-delete-duplicates minibuffer boolean "22.1") (read-buffer-completion-ignore-case minibuffer boolean "23.1") diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index b1d5f4e53b0..bb93cce6500 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1,7 +1,7 @@ ;;; dired-aux.el --- less commonly used parts of dired -;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2014 Free Software -;; Foundation, Inc. +;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2014 +;; Free Software Foundation, Inc. ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>. ;; Maintainer: emacs-devel@gnu.org @@ -215,19 +215,24 @@ condition. Two file items are considered to match if they are equal (dolist (file1 list1) (unless (let ((list list2)) (while (and list - (not (let* ((file2 (car list)) - (fa1 (car (cddr file1))) - (fa2 (car (cddr file2))) - (size1 (nth 7 fa1)) - (size2 (nth 7 fa2)) - (mtime1 (float-time (nth 5 fa1))) - (mtime2 (float-time (nth 5 fa2)))) - (and - (equal (car file1) (car file2)) - (not (eval predicate)))))) + (let* ((file2 (car list)) + (fa1 (car (cddr file1))) + (fa2 (car (cddr file2)))) + (or + (not (equal (car file1) (car file2))) + (eval predicate + `((fa1 . ,fa1) + (fa2 . ,fa2) + (size1 . ,(nth 7 fa1)) + (size2 . ,(nth 7 fa2)) + (mtime1 + . ,(float-time (nth 5 fa1))) + (mtime2 + . ,(float-time (nth 5 fa2))) + ))))) (setq list (cdr list))) list) - (setq res (cons file1 res)))) + (push file1 res))) (nreverse res)))) (defun dired-files-attributes (dir) @@ -1921,8 +1926,9 @@ Type SPC or `y' to %s one match, DEL or `n' to skip to next, (arg (if whole-name nil current-prefix-arg)) (regexp - (dired-read-regexp - (concat (if whole-name "Abs. " "") operation " from (regexp): "))) + (read-regexp + (concat (if whole-name "Abs. " "") operation " from (regexp): ") + nil 'dired-regexp-history)) (newname (read-string (concat (if whole-name "Abs. " "") operation " " regexp " to: ")))) diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 947de7cd9f8..25c6f8b69af 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -1,7 +1,6 @@ ;;; dired-x.el --- extra Dired functionality -*- lexical-binding:t -*- -;; Copyright (C) 1993-1994, 1997, 2001-2014 Free Software Foundation, -;; Inc. +;; Copyright (C) 1993-1994, 1997, 2001-2014 Free Software Foundation, Inc. ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de> ;; Lawrence R. Dodd <dodd@roebling.poly.edu> @@ -556,8 +555,9 @@ interactively, prompt for REGEXP. With prefix argument, unflag all those files. Optional fourth argument LOCALP is as in `dired-get-filename'." (interactive - (list (dired-read-regexp - "Mark unmarked files matching regexp (default all): ") + (list (read-regexp + "Mark unmarked files matching regexp (default all): " + nil 'dired-regexp-history) nil current-prefix-arg nil)) (let ((dired-marker-char (if unflag-p ?\s dired-marker-char))) (dired-mark-if diff --git a/lisp/dired.el b/lisp/dired.el index e4f297e8cc8..a241fb3b339 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1,7 +1,7 @@ ;;; dired.el --- directory-browsing commands -*- lexical-binding: t -*- -;; Copyright (C) 1985-1986, 1992-1997, 2000-2014 Free Software -;; Foundation, Inc. +;; Copyright (C) 1985-1986, 1992-1997, 2000-2014 +;; Free Software Foundation, Inc. ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de> ;; Maintainer: emacs-devel@gnu.org @@ -1912,7 +1912,7 @@ Type \\[dired-mark] to Mark a file or subdirectory for later commands. to see why something went wrong. Type \\[dired-unmark] to Unmark a file or all files of an inserted subdirectory. Type \\[dired-unmark-backward] to back up one line and unmark or unflag. -Type \\[dired-do-flagged-delete] to delete (eXecute) the files flagged `D'. +Type \\[dired-do-flagged-delete] to delete (eXpunge) the files flagged `D'. Type \\[dired-find-file] to Find the current line's file (or dired it in another buffer, if it is a directory). Type \\[dired-find-file-other-window] to find file or Dired directory in Other window. @@ -3302,6 +3302,7 @@ As always, hidden subdirs are not affected." (defun dired-read-regexp (prompt &optional default history) "Read a regexp using `read-regexp'." + (declare (obsolete read-regexp "24.5")) (read-regexp prompt default (or history 'dired-regexp-history))) (defun dired-mark-files-regexp (regexp &optional marker-char) @@ -3312,8 +3313,9 @@ A prefix argument means to unmark them instead. REGEXP is an Emacs regexp, not a shell wildcard. Thus, use `\\.o$' for object files--just `.o' will mark more than you might think." (interactive - (list (dired-read-regexp (concat (if current-prefix-arg "Unmark" "Mark") - " files (regexp): ")) + (list (read-regexp (concat (if current-prefix-arg "Unmark" "Mark") + " files (regexp): ") + nil 'dired-regexp-history) (if current-prefix-arg ?\040))) (let ((dired-marker-char (or marker-char dired-marker-char))) (dired-mark-if @@ -3328,8 +3330,9 @@ object files--just `.o' will mark more than you might think." A prefix argument means to unmark them instead. `.' and `..' are never marked." (interactive - (list (dired-read-regexp (concat (if current-prefix-arg "Unmark" "Mark") - " files containing (regexp): ")) + (list (read-regexp (concat (if current-prefix-arg "Unmark" "Mark") + " files containing (regexp): ") + nil 'dired-regexp-history) (if current-prefix-arg ?\040))) (let ((dired-marker-char (or marker-char dired-marker-char))) (dired-mark-if @@ -3359,7 +3362,8 @@ A prefix argument means to unmark them instead. The match is against the non-directory part of the filename. Use `^' and `$' to anchor matches. Exclude subdirs by hiding them. `.' and `..' are never flagged." - (interactive (list (dired-read-regexp "Flag for deletion (regexp): "))) + (interactive (list (read-regexp "Flag for deletion (regexp): " + nil 'dired-regexp-history))) (dired-mark-files-regexp regexp dired-del-marker)) (defun dired-mark-symlinks (unflag-p) @@ -3879,7 +3883,7 @@ Ask means pop up a menu for the user to select one of copy, move or link." ;;; Start of automatically extracted autoloads. -;;;### (autoloads nil "dired-aux" "dired-aux.el" "1a8e2a4a9117ab3a2586aa001358d3fb") +;;;### (autoloads nil "dired-aux" "dired-aux.el" "1448837b5f3e2b9ad63f723361f1e32e") ;;; Generated autoloads from dired-aux.el (autoload 'dired-diff "dired-aux" "\ @@ -4382,7 +4386,7 @@ instead. ;;;*** -;;;### (autoloads nil "dired-x" "dired-x.el" "291bc6e869bf72c900604c45d40f45ed") +;;;### (autoloads nil "dired-x" "dired-x.el" "994b5d9fc38059ab641ec271c728e56f") ;;; Generated autoloads from dired-x.el (autoload 'dired-jump "dired-x" "\ diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 09d5925b3e2..5d2c897e4f9 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -336,7 +336,7 @@ of the page moves to the previous page." ;; Don't do it if there's a conversion is running, since in that case, it ;; will be done later. (with-selected-window (car winprops) - (doc-view-goto-page 1))))) + (doc-view-goto-page (image-mode-window-get 'page t)))))) (defvar-local doc-view--current-files nil "Only used internally.") @@ -654,16 +654,10 @@ at the top edge of the page moves to the previous page." (defun doc-view-make-safe-dir (dir) (condition-case nil - (let ((umask (default-file-modes))) - (unwind-protect - (progn - ;; Create temp files with strict access rights. It's easy to - ;; loosen them later, whereas it's impossible to close the - ;; time-window of loose permissions otherwise. - (set-default-file-modes #o0700) - (make-directory dir)) - ;; Reset the umask. - (set-default-file-modes umask))) + ;; Create temp files with strict access rights. It's easy to + ;; loosen them later, whereas it's impossible to close the + ;; time-window of loose permissions otherwise. + (with-file-modes #o0700 (make-directory dir)) (file-already-exists (when (file-symlink-p dir) (error "Danger: %s points to a symbolic link" dir)) @@ -1621,24 +1615,25 @@ If BACKWARD is non-nil, jump to the previous match." "Figure out the current document type (`doc-view-doc-type')." (let ((name-types (when buffer-file-name - (cdr (assoc (file-name-extension buffer-file-name) - '( - ;; DVI - ("dvi" dvi) - ;; PDF - ("pdf" pdf) ("epdf" pdf) - ;; PostScript - ("ps" ps) ("eps" ps) - ;; DjVu - ("djvu" djvu) - ;; OpenDocument formats - ("odt" odf) ("ods" odf) ("odp" odf) ("odg" odf) - ("odc" odf) ("odi" odf) ("odm" odf) ("ott" odf) - ("ots" odf) ("otp" odf) ("otg" odf) - ;; Microsoft Office formats (also handled - ;; by the odf conversion chain) - ("doc" odf) ("docx" odf) ("xls" odf) ("xlsx" odf) - ("ppt" odf) ("pptx" odf)))))) + (cdr (assoc-ignore-case + (file-name-extension buffer-file-name) + '( + ;; DVI + ("dvi" dvi) + ;; PDF + ("pdf" pdf) ("epdf" pdf) + ;; PostScript + ("ps" ps) ("eps" ps) + ;; DjVu + ("djvu" djvu) + ;; OpenDocument formats. + ("odt" odf) ("ods" odf) ("odp" odf) ("odg" odf) + ("odc" odf) ("odi" odf) ("odm" odf) ("ott" odf) + ("ots" odf) ("otp" odf) ("otg" odf) + ;; Microsoft Office formats (also handled by the odf + ;; conversion chain). + ("doc" odf) ("docx" odf) ("xls" odf) ("xlsx" odf) + ("ppt" odf) ("pps" odf) ("pptx" odf)))))) (content-types (save-excursion (goto-char (point-min)) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index fe6640cc51e..ee0a5a11c7b 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -944,15 +944,6 @@ form (nth 1 form))) -(defun byte-optimize-zerop (form) - (cond ((numberp (nth 1 form)) - (eval form)) - (byte-compile-delete-errors - (list '= (nth 1 form) 0)) - (form))) - -(put 'zerop 'byte-optimizer 'byte-optimize-zerop) - (defun byte-optimize-and (form) ;; Simplify if less than 2 args. ;; if there is a literal nil in the args to `and', throw it and following diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 4b9e6d8fd23..0edcf6197b4 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -30,6 +30,17 @@ ;;; Code: +(defalias 'function-put + ;; We don't want people to just use `put' because we can't conveniently + ;; hook into `put' to remap old properties to new ones. But for now, there's + ;; no such remapping, so we just call `put'. + #'(lambda (f prop value) (put f prop value)) + "Set function F's property PROP to VALUE. +The namespace for PROP is shared with symbols. +So far, F can only be a symbol, not a lambda expression.") +(function-put 'defmacro 'doc-string-elt 3) +(function-put 'defmacro 'lisp-indent-function 2) + ;; `macro-declaration-function' are both obsolete (as marked at the end of this ;; file) but used in many .elc files. @@ -69,6 +80,7 @@ The return value of this function is not used." ;; handle declarations in macro definitions and this is the first file ;; loaded by loadup.el that uses declarations in macros. +;; Add any new entries to info node `(elisp)Declare Form'. (defvar defun-declarations-alist (list ;; We can only use backquotes inside the lambdas and not for those @@ -81,27 +93,47 @@ The return value of this function is not used." #'(lambda (f _args new-name when) (list 'make-obsolete (list 'quote f) (list 'quote new-name) (list 'quote when)))) + (list 'interactive-only + #'(lambda (f _args instead) + (list 'function-put (list 'quote f) + ''interactive-only (list 'quote instead)))) + ;; FIXME: Merge `pure' and `side-effect-free'. + (list 'pure + #'(lambda (f _args val) + (list 'function-put (list 'quote f) + ''pure (list 'quote val))) + "If non-nil, the compiler can replace calls with their return value. +This may shift errors from run-time to compile-time.") + (list 'side-effect-free + #'(lambda (f _args val) + (list 'function-put (list 'quote f) + ''side-effect-free (list 'quote val))) + "If non-nil, calls can be ignored if their value is unused. +If `error-free', drop calls even if `byte-compile-delete-errors' is nil.") (list 'compiler-macro #'(lambda (f args compiler-function) `(eval-and-compile - (put ',f 'compiler-macro - ,(if (eq (car-safe compiler-function) 'lambda) - `(lambda ,(append (cadr compiler-function) args) - ,@(cddr compiler-function)) - `#',compiler-function))))) + (function-put ',f 'compiler-macro + ,(if (eq (car-safe compiler-function) 'lambda) + `(lambda ,(append (cadr compiler-function) args) + ,@(cddr compiler-function)) + `#',compiler-function))))) (list 'doc-string #'(lambda (f _args pos) - (list 'put (list 'quote f) ''doc-string-elt (list 'quote pos)))) + (list 'function-put (list 'quote f) + ''doc-string-elt (list 'quote pos)))) (list 'indent #'(lambda (f _args val) - (list 'put (list 'quote f) + (list 'function-put (list 'quote f) ''lisp-indent-function (list 'quote val))))) "List associating function properties to their macro expansion. Each element of the list takes the form (PROP FUN) where FUN is a function. For each (PROP . VALUES) in a function's declaration, the FUN corresponding to PROP is called with the function name, the function's arglist, and the VALUES and should return the code to use -to set this property.") +to set this property. + +This is used by `declare'.") (defvar macro-declarations-alist (cons @@ -115,10 +147,10 @@ to set this property.") Each element of the list takes the form (PROP FUN) where FUN is a function. For each (PROP . VALUES) in a macro's declaration, the FUN corresponding to PROP is called with the macro name, the macro's arglist, and the VALUES -and should return the code to use to set this property.") +and should return the code to use to set this property. + +This is used by `declare'.") -(put 'defmacro 'doc-string-elt 3) -(put 'defmacro 'lisp-indent-function 2) (defalias 'defmacro (cons 'macro @@ -218,7 +250,8 @@ The return value is undefined. (cons arglist body)))))) (if declarations (cons 'prog1 (cons def declarations)) - def)))) + def)))) + ;; Redefined in byte-optimize.el. ;; This is not documented--it's not clear that we should promote it. @@ -389,13 +422,20 @@ If you think you need this, you're probably making a mistake somewhere." (defmacro eval-when-compile (&rest body) "Like `progn', but evaluates the body at compile time if you're compiling. -Thus, the result of the body appears to the compiler as a quoted constant. -In interpreted code, this is entirely equivalent to `progn'." +Thus, the result of the body appears to the compiler as a quoted +constant. In interpreted code, this is entirely equivalent to +`progn', except that the value of the expression may be (but is +not necessarily) computed at load time if eager macro expansion +is enabled." (declare (debug (&rest def-form)) (indent 0)) (list 'quote (eval (cons 'progn body) lexical-binding))) (defmacro eval-and-compile (&rest body) - "Like `progn', but evaluates the body at compile time and at load time." + "Like `progn', but evaluates the body at compile time and at +load time. In interpreted code, this is entirely equivalent to +`progn', except that the value of the expression may be (but is +not necessarily) computed at load time if eager macro expansion +is enabled." (declare (debug t) (indent 0)) ;; When the byte-compiler expands code, this macro is not used, so we're ;; either about to run `body' (plain interpretation) or we're doing eager diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index e5f8a8cc22a..9c52cc44eb4 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -421,31 +421,46 @@ Filled in `cconv-analyse-form' but initialized and consulted here.") (defvar byte-compiler-error-flag) +(defun byte-compile-recurse-toplevel (form non-toplevel-case) + "Implement `eval-when-compile' and `eval-and-compile'. +Return the compile-time value of FORM." + ;; Macroexpand (not macroexpand-all!) form at toplevel in case it + ;; expands into a toplevel-equivalent `progn'. See CLHS section + ;; 3.2.3.1, "Processing of Top Level Forms". The semantics are very + ;; subtle: see test/automated/bytecomp-tests.el for interesting + ;; cases. + (setf form (macroexpand form byte-compile-macro-environment)) + (if (eq (car-safe form) 'progn) + (cons 'progn + (mapcar (lambda (subform) + (byte-compile-recurse-toplevel + subform non-toplevel-case)) + (cdr form))) + (funcall non-toplevel-case form))) + (defconst byte-compile-initial-macro-environment - '( + `( ;; (byte-compiler-options . (lambda (&rest forms) ;; (apply 'byte-compiler-options-handler forms))) (declare-function . byte-compile-macroexpand-declare-function) - (eval-when-compile . (lambda (&rest body) - (list - 'quote - (byte-compile-eval - (byte-compile-top-level - (byte-compile-preprocess (cons 'progn body))))))) - (eval-and-compile . (lambda (&rest body) - ;; Byte compile before running it. Do it piece by - ;; piece, in case further expressions need earlier - ;; ones to be evaluated already, as is the case in - ;; eieio.el. - `(progn - ,@(mapcar (lambda (exp) - (let ((cexp - (byte-compile-top-level - (byte-compile-preprocess - exp)))) - (eval cexp) - cexp)) - body))))) + (eval-when-compile . ,(lambda (&rest body) + (let ((result nil)) + (byte-compile-recurse-toplevel + (cons 'progn body) + (lambda (form) + (setf result + (byte-compile-eval + (byte-compile-top-level + (byte-compile-preprocess form)))))) + (list 'quote result)))) + (eval-and-compile . ,(lambda (&rest body) + (byte-compile-recurse-toplevel + (cons 'progn body) + (lambda (form) + (let ((compiled (byte-compile-top-level + (byte-compile-preprocess form)))) + (eval compiled lexical-binding) + compiled)))))) "The default macro-environment passed to macroexpand by the compiler. Placing a macro here will cause a macro to have different semantics when expanded by the compiler as when expanded by the interpreter.") @@ -2198,9 +2213,12 @@ list that represents a doc string reference. (t form))) ;; byte-hunk-handlers cannot call this! -(defun byte-compile-toplevel-file-form (form) - (let ((byte-compile-current-form nil)) ; close over this for warnings. - (byte-compile-file-form (byte-compile-preprocess form t)))) +(defun byte-compile-toplevel-file-form (top-level-form) + (byte-compile-recurse-toplevel + top-level-form + (lambda (form) + (let ((byte-compile-current-form nil)) ; close over this for warnings. + (byte-compile-file-form (byte-compile-preprocess form t)))))) ;; byte-hunk-handlers can call this. (defun byte-compile-file-form (form) @@ -2942,8 +2960,11 @@ for symbols generated by the byte compiler itself." interactive-only)) (t ".")))) (if (eq (car-safe (symbol-function (car form))) 'macro) - (byte-compile-log-warning - (format "Forgot to expand macro %s" (car form)) nil :error)) + (progn + (debug) + (byte-compile-log-warning + (format "Forgot to expand macro %s in %S" (car form) form) + nil :error))) (if (and handler ;; Make sure that function exists. (and (functionp handler) diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 9b28289e0b9..3761d04c2c2 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -269,43 +269,20 @@ If so, return the true (non-nil) value returned by PREDICATE. ;;;###autoload (defun cl--map-overlays (cl-func &optional cl-buffer cl-start cl-end cl-arg) (or cl-buffer (setq cl-buffer (current-buffer))) - (if (fboundp 'overlay-lists) - - ;; This is the preferred algorithm, though overlay-lists is undocumented. - (let (cl-ovl) - (with-current-buffer cl-buffer - (setq cl-ovl (overlay-lists)) - (if cl-start (setq cl-start (copy-marker cl-start))) - (if cl-end (setq cl-end (copy-marker cl-end)))) - (setq cl-ovl (nconc (car cl-ovl) (cdr cl-ovl))) - (while (and cl-ovl - (or (not (overlay-start (car cl-ovl))) - (and cl-end (>= (overlay-start (car cl-ovl)) cl-end)) - (and cl-start (<= (overlay-end (car cl-ovl)) cl-start)) - (not (funcall cl-func (car cl-ovl) cl-arg)))) - (setq cl-ovl (cdr cl-ovl))) - (if cl-start (set-marker cl-start nil)) - (if cl-end (set-marker cl-end nil))) - - ;; This alternate algorithm fails to find zero-length overlays. - (let ((cl-mark (with-current-buffer cl-buffer - (copy-marker (or cl-start (point-min))))) - (cl-mark2 (and cl-end (with-current-buffer cl-buffer - (copy-marker cl-end)))) - cl-pos cl-ovl) - (while (save-excursion - (and (setq cl-pos (marker-position cl-mark)) - (< cl-pos (or cl-mark2 (point-max))) - (progn - (set-buffer cl-buffer) - (setq cl-ovl (overlays-at cl-pos)) - (set-marker cl-mark (next-overlay-change cl-pos))))) - (while (and cl-ovl - (or (/= (overlay-start (car cl-ovl)) cl-pos) - (not (and (funcall cl-func (car cl-ovl) cl-arg) - (set-marker cl-mark nil))))) - (setq cl-ovl (cdr cl-ovl)))) - (set-marker cl-mark nil) (if cl-mark2 (set-marker cl-mark2 nil))))) + (let (cl-ovl) + (with-current-buffer cl-buffer + (setq cl-ovl (overlay-lists)) + (if cl-start (setq cl-start (copy-marker cl-start))) + (if cl-end (setq cl-end (copy-marker cl-end)))) + (setq cl-ovl (nconc (car cl-ovl) (cdr cl-ovl))) + (while (and cl-ovl + (or (not (overlay-start (car cl-ovl))) + (and cl-end (>= (overlay-start (car cl-ovl)) cl-end)) + (and cl-start (<= (overlay-end (car cl-ovl)) cl-start)) + (not (funcall cl-func (car cl-ovl) cl-arg)))) + (setq cl-ovl (cdr cl-ovl))) + (if cl-start (set-marker cl-start nil)) + (if cl-end (set-marker cl-end nil)))) ;;; Support for `setf'. ;;;###autoload diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el index 6c62ce5c830..2d8a1c4c1c2 100644 --- a/lisp/emacs-lisp/cl-indent.el +++ b/lisp/emacs-lisp/cl-indent.el @@ -27,6 +27,8 @@ ;; This package supplies a single entry point, common-lisp-indent-function, ;; which performs indentation in the preferred style for Common Lisp code. +;; It is also a suitable function for indenting Emacs lisp code. +;; ;; To enable it: ;; ;; (setq lisp-indent-function 'common-lisp-indent-function) @@ -154,6 +156,15 @@ is set to `defun'.") (looking-at "\\sw")) (error t))) +(defun lisp-indent-find-method (symbol &optional no-compat) + "Find the lisp indentation function for SYMBOL. +If NO-COMPAT is non-nil, do not retrieve indenters intended for +the standard lisp indent package." + (or (and (derived-mode-p 'emacs-lisp-mode) + (get symbol 'common-lisp-indent-function-for-elisp)) + (get symbol 'common-lisp-indent-function) + (and (not no-compat) + (get symbol 'lisp-indent-function)))) (defun common-lisp-loop-part-indentation (indent-point state) "Compute the indentation of loop form constituents." @@ -245,9 +256,17 @@ For example, the function `case' has an indent property * indent the first argument by 4. * arguments after the first should be lists, and there may be any number of them. The first list element has an offset of 2, all the rest - have an offset of 2+1=3." + have an offset of 2+1=3. + +If the current mode is actually `emacs-lisp-mode', look for a +`common-lisp-indent-function-for-elisp' property before looking +at `common-lisp-indent-function' and, if set, use its value +instead." + ;; FIXME: why do we need to special-case loop? (if (save-excursion (goto-char (elt state 1)) - (looking-at "([Ll][Oo][Oo][Pp]")) + (looking-at (if (derived-mode-p 'emacs-lisp-mode) + "(\\(cl-\\)?[Ll][Oo][Oo][Pp]" + "([Ll][Oo][Oo][Pp]"))) (common-lisp-loop-part-indentation indent-point state) (common-lisp-indent-function-1 indent-point state))) @@ -291,18 +310,29 @@ For example, the function `case' has an indent property (setq function (downcase (buffer-substring-no-properties tem (point)))) (goto-char tem) + ;; Elisp generally provides CL functionality with a CL + ;; prefix, so if we have a special indenter for the + ;; unprefixed version, prefer it over whatever's defined + ;; for the cl- version. Users can override this + ;; heuristic by defining a + ;; common-lisp-indent-function-for-elisp property on the + ;; cl- version. + (when (and (derived-mode-p 'emacs-lisp-mode) + (not (lisp-indent-find-method + (intern-soft function) t)) + (string-match "\\`cl-" function) + (setf tem (intern-soft + (substring function (match-end 0)))) + (lisp-indent-find-method tem t)) + (setf function (symbol-name tem))) (setq tem (intern-soft function) - method (get tem 'common-lisp-indent-function)) - (cond ((and (null method) - (string-match ":[^:]+" function)) - ;; The pleblisp package feature - (setq function (substring function - (1+ (match-beginning 0))) - method (get (intern-soft function) - 'common-lisp-indent-function))) - ((and (null method)) - ;; backwards compatibility - (setq method (get tem 'lisp-indent-function))))) + method (lisp-indent-find-method tem)) + ;; The pleblisp package feature + (when (and (null tem) + (string-match ":[^:]+" function)) + (setq function (substring function (1+ (match-beginning 0))) + tem (intern-soft function) + method (lisp-indent-find-method tem)))) (let ((n 0)) ;; How far into the containing form is the current form? (if (< (point) indent-point) @@ -764,7 +794,11 @@ optional\\|rest\\|key\\|allow-other-keys\\|aux\\|whole\\|body\\|environment\ (put (car el) 'common-lisp-indent-function (if (symbolp (cdr el)) (get (cdr el) 'common-lisp-indent-function) - (car (cdr el)))))) + (car (cdr el)))))) + +;; In elisp, the else part of `if' is in an implicit progn, so indent +;; it more. +(put 'if 'common-lisp-indent-function-for-elisp 2) ;(defun foo (x) diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 219d76f85d1..c4b9673aa2a 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -152,9 +152,6 @@ an element already on the list. `(setq ,place (cl-adjoin ,x ,place ,@keys))) `(cl-callf2 cl-adjoin ,x ,place ,@keys))) -(defun cl--set-elt (seq n val) - (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val))) - (defun cl--set-buffer-substring (start end val) (save-excursion (delete-region start end) (goto-char start) @@ -361,7 +358,13 @@ SEQ, this is like `mapcar'. With several, it is like the Common Lisp (cl--defalias 'cl-first 'car) (cl--defalias 'cl-second 'cadr) (cl--defalias 'cl-rest 'cdr) -(cl--defalias 'cl-endp 'null) + +(defun cl-endp (x) + "Return true if X is the empty list; false if it is a cons. +Signal an error if X is not a list." + (if (listp x) + (null x) + (signal 'wrong-type-argument (list 'listp x 'x)))) (cl--defalias 'cl-third 'cl-caddr "Return the third element of the list X.") (cl--defalias 'cl-fourth 'cl-cadddr "Return the fourth element of the list X.") @@ -625,7 +628,6 @@ If ALIST is non-nil, the new pairs are prepended to it." `(insert (prog1 ,store (erase-buffer)))) (gv-define-simple-setter buffer-substring cl--set-buffer-substring) (gv-define-simple-setter current-buffer set-buffer) -(gv-define-simple-setter current-case-table set-case-table) (gv-define-simple-setter current-column move-to-column t) (gv-define-simple-setter current-global-map use-global-map t) (gv-define-setter current-input-mode (store) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 5640b1796c7..ce54337a3b1 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -135,7 +135,13 @@ (t t))) (defun cl--const-expr-val (x) - (and (macroexp-const-p x) (if (consp x) (nth 1 x) x))) + "Return the value of X known at compile-time. +If X is not known at compile time, return nil. Before testing +whether X is known at compile time, macroexpand it completely in +`macroexpand-all-environment'." + (let ((x (macroexpand-all x macroexpand-all-environment))) + (if (macroexp-const-p x) + (if (consp x) (nth 1 x) x)))) (defun cl--expr-contains (x y) "Count number of times X refers to Y. Return nil for 0 times." @@ -1542,7 +1548,7 @@ If BODY is `setq', then use SPECS for assignments rather than for bindings." (if (and (cl--unused-var-p temp) (null expr)) nil ;; Don't bother declaring/setting `temp' since it won't ;; be used when `expr' is nil, anyway. - (when (or (null temp) + (when (or (null temp) (and (eq body 'setq) (cl--unused-var-p temp))) ;; Prefer a fresh uninterned symbol over "_to", to avoid ;; warnings that we set an unused variable. @@ -1880,13 +1886,13 @@ This is like `cl-flet', but for macros instead of functions. cl-declarations body))) (if (cdr bindings) `(cl-macrolet (,(car bindings)) (cl-macrolet ,(cdr bindings) ,@body)) - (if (null bindings) (cons 'progn body) + (if (null bindings) (macroexp-progn body) (let* ((name (caar bindings)) (res (cl--transform-lambda (cdar bindings) name))) (eval (car res)) - (macroexpand-all (cons 'progn body) - (cons (cons name `(lambda ,@(cdr res))) - macroexpand-all-environment)))))) + (macroexpand-all (macroexp-progn body) + (cons (cons name `(lambda ,@(cdr res))) + macroexpand-all-environment)))))) (defconst cl--old-macroexpand (if (and (boundp 'cl--old-macroexpand) @@ -2059,10 +2065,21 @@ values. For compatibility, (cl-values A B C) is a synonym for (list A B C). (declare (debug t)) (cons 'progn body)) ;;;###autoload -(defmacro cl-the (_type form) - "At present this ignores TYPE and is simply equivalent to FORM." +(defmacro cl-the (type form) + "Return FORM. If type-checking is enabled, assert that it is of TYPE." (declare (indent 1) (debug (cl-type-spec form))) - form) + (if (not (or (not (cl--compiling-file)) + (< cl--optimize-speed 3) + (= cl--optimize-safety 3))) + form + (let* ((temp (if (cl--simple-expr-p form 3) + form (make-symbol "--cl-var--"))) + (body `(progn (unless ,(cl--make-type-test temp type) + (signal 'wrong-type-argument + (list ',type ,temp ',form))) + ,temp))) + (if (eq temp form) body + `(let ((,temp ,form)) ,body))))) (defvar cl--proclaim-history t) ; for future compilers (defvar cl--declare-stack t) ; for future compilers @@ -2574,21 +2591,38 @@ non-nil value, that slot cannot be set via `setf'. (put ',name 'cl-struct-include ',include) (put ',name 'cl-struct-print ,print-auto) ,@(mapcar (lambda (x) - `(put ',(car x) 'side-effect-free ',(cdr x))) + `(function-put ',(car x) 'side-effect-free ',(cdr x))) side-eff)) forms) `(progn ,@(nreverse (cons `',name forms))))) -;;; Types and assertions. - -;;;###autoload -(defmacro cl-deftype (name arglist &rest body) - "Define NAME as a new data type. -The type name can then be used in `cl-typecase', `cl-check-type', etc." - (declare (debug cl-defmacro) (doc-string 3) (indent 2)) - `(cl-eval-when (compile load eval) - (put ',name 'cl-deftype-handler - (cl-function (lambda (&cl-defs '('*) ,@arglist) ,@body))))) +(defun cl-struct-sequence-type (struct-type) + "Return the sequence used to build STRUCT-TYPE. +STRUCT-TYPE is a symbol naming a struct type. Return 'vector or +'list, or nil if STRUCT-TYPE is not a struct type. " + (declare (side-effect-free t) (pure t)) + (car (get struct-type 'cl-struct-type))) + +(defun cl-struct-slot-info (struct-type) + "Return a list of slot names of struct STRUCT-TYPE. +Each entry is a list (SLOT-NAME . OPTS), where SLOT-NAME is a +slot name symbol and OPTS is a list of slot options given to +`cl-defstruct'. Dummy slots that represent the struct name and +slots skipped by :initial-offset may appear in the list." + (declare (side-effect-free t) (pure t)) + (get struct-type 'cl-struct-slots)) + +(defun cl-struct-slot-offset (struct-type slot-name) + "Return the offset of slot SLOT-NAME in STRUCT-TYPE. +The returned zero-based slot index is relative to the start of +the structure data type and is adjusted for any structure name +and :initial-offset slots. Signal error if struct STRUCT-TYPE +does not contain SLOT-NAME." + (declare (side-effect-free t) (pure t)) + (or (cl-position slot-name + (cl-struct-slot-info struct-type) + :key #'car :test #'eq) + (error "struct %s has no slot %s" struct-type slot-name))) (defvar byte-compile-function-environment) (defvar byte-compile-macro-environment) @@ -2875,19 +2909,47 @@ The function's arguments should be treated as immutable. ;;; Things that are inline. (cl-proclaim '(inline cl-acons cl-map cl-concatenate cl-notany - cl-notevery cl--set-elt cl-revappend cl-nreconc gethash)) + cl-notevery cl-revappend cl-nreconc gethash)) ;;; Things that are side-effect-free. -(mapc (lambda (x) (put x 'side-effect-free t)) +(mapc (lambda (x) (function-put x 'side-effect-free t)) '(cl-oddp cl-evenp cl-signum last butlast cl-ldiff cl-pairlis cl-gcd cl-lcm cl-isqrt cl-floor cl-ceiling cl-truncate cl-round cl-mod cl-rem cl-subseq cl-list-length cl-get cl-getf)) ;;; Things that are side-effect-and-error-free. -(mapc (lambda (x) (put x 'side-effect-free 'error-free)) +(mapc (lambda (x) (function-put x 'side-effect-free 'error-free)) '(eql cl-list* cl-subst cl-acons cl-equalp cl-random-state-p copy-tree cl-sublis)) +;;; Types and assertions. + +;;;###autoload +(defmacro cl-deftype (name arglist &rest body) + "Define NAME as a new data type. +The type name can then be used in `cl-typecase', `cl-check-type', etc." + (declare (debug cl-defmacro) (doc-string 3) (indent 2)) + `(cl-eval-when (compile load eval) + (put ',name 'cl-deftype-handler + (cl-function (lambda (&cl-defs '('*) ,@arglist) ,@body))))) + +;;; Additional functions that we can now define because we've defined +;;; `cl-defsubst' and `cl-typep'. + +(cl-defsubst cl-struct-slot-value (struct-type slot-name inst) + ;; The use of `cl-defsubst' here gives us both a compiler-macro + ;; and a gv-expander "for free". + "Return the value of slot SLOT-NAME in INST of STRUCT-TYPE. +STRUCT and SLOT-NAME are symbols. INST is a structure instance." + (declare (side-effect-free t)) + (unless (cl-typep inst struct-type) + (signal 'wrong-type-argument (list struct-type inst))) + ;; We could use `elt', but since the byte compiler will resolve the + ;; branch below at compile time, it's more efficient to use the + ;; type-specific accessor. + (if (eq (cl-struct-sequence-type struct-type) 'vector) + (aref inst (cl-struct-slot-offset struct-type slot-name)) + (nth (cl-struct-slot-offset struct-type slot-name) inst))) (run-hooks 'cl-macs-load-hook) diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el index aa88264c4ab..a7078328748 100644 --- a/lisp/emacs-lisp/cl-seq.el +++ b/lisp/emacs-lisp/cl-seq.el @@ -166,7 +166,7 @@ SEQ1 is destructively modified, then returned. (cl-n (min (- (or cl-end1 cl-len) cl-start1) (- (or cl-end2 cl-len) cl-start2)))) (while (>= (setq cl-n (1- cl-n)) 0) - (cl--set-elt cl-seq1 (+ cl-start1 cl-n) + (setf (elt cl-seq1 (+ cl-start1 cl-n)) (elt cl-seq2 (+ cl-start2 cl-n)))))) (if (listp cl-seq1) (let ((cl-p1 (nthcdr cl-start1 cl-seq1)) @@ -392,7 +392,7 @@ to avoid corrupting the original SEQ. cl-seq (setq cl-seq (copy-sequence cl-seq)) (or cl-from-end - (progn (cl--set-elt cl-seq cl-i cl-new) + (progn (setf (elt cl-seq cl-i) cl-new) (setq cl-i (1+ cl-i) cl-count (1- cl-count)))) (apply 'cl-nsubstitute cl-new cl-old cl-seq :count cl-count :start cl-i cl-keys)))))) @@ -439,7 +439,7 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. (setq cl-end (1- cl-end)) (if (cl--check-test cl-old (elt cl-seq cl-end)) (progn - (cl--set-elt cl-seq cl-end cl-new) + (setf (elt cl-seq cl-end) cl-new) (setq cl-count (1- cl-count))))) (while (and (< cl-start cl-end) (> cl-count 0)) (if (cl--check-test cl-old (aref cl-seq cl-start)) diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index c64ec52decb..7102b5549eb 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -298,8 +298,8 @@ Otherwise work like `message'." ;;;###autoload -(defvar eldoc-documentation-function nil - "If non-nil, function to call to return doc string. +(defvar eldoc-documentation-function #'eldoc-documentation-function-default + "Function to call to return doc string. The function of no args should return a one-line string for displaying doc about a function etc. appropriate to the context around point. It should return nil if there's no doc appropriate for the context. @@ -323,22 +323,20 @@ Emacs Lisp mode) that support ElDoc.") (when eldoc-last-message (eldoc-message nil) nil)) - (if eldoc-documentation-function - (eldoc-message (funcall eldoc-documentation-function)) - (let* ((current-symbol (eldoc-current-symbol)) - (current-fnsym (eldoc-fnsym-in-current-sexp)) - (doc (cond - ((null current-fnsym) - nil) - ((eq current-symbol (car current-fnsym)) - (or (apply 'eldoc-get-fnsym-args-string - current-fnsym) - (eldoc-get-var-docstring current-symbol))) - (t - (or (eldoc-get-var-docstring current-symbol) - (apply 'eldoc-get-fnsym-args-string - current-fnsym)))))) - (eldoc-message doc)))))) + (eldoc-message (funcall eldoc-documentation-function))))) + +(defun eldoc-documentation-function-default () + "Default value for `eldoc-documentation-function' (which see)." + (let ((current-symbol (eldoc-current-symbol)) + (current-fnsym (eldoc-fnsym-in-current-sexp))) + (cond ((null current-fnsym) + nil) + ((eq current-symbol (car current-fnsym)) + (or (apply #'eldoc-get-fnsym-args-string current-fnsym) + (eldoc-get-var-docstring current-symbol))) + (t + (or (eldoc-get-var-docstring current-symbol) + (apply #'eldoc-get-fnsym-args-string current-fnsym)))))) (defun eldoc-get-fnsym-args-string (sym &optional index) "Return a string containing the parameter list of the function SYM. diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 1cdba5b371a..31df353321a 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -104,7 +104,8 @@ It has `lisp-mode-abbrev-table' as its parent." (regexp-opt '("defun" "defun*" "defsubst" "defmacro" "defadvice" "define-skeleton" - "define-minor-mode" "define-global-minor-mode" + "define-compilation-mode" "define-minor-mode" + "define-global-minor-mode" "define-globalized-minor-mode" "define-derived-mode" "define-generic-mode" "define-compiler-macro" "define-modify-macro" @@ -156,6 +157,24 @@ It has `lisp-mode-abbrev-table' as its parent." ;;;; Font-lock support. +(defun lisp--match-hidden-arg (limit) + (let ((res nil)) + (while + (let ((ppss (parse-partial-sexp (line-beginning-position) + (line-end-position) + -1))) + (skip-syntax-forward " )") + (if (or (>= (car ppss) 0) + (looking-at ";\\|$")) + (progn + (forward-line 1) + (< (point) limit)) + (looking-at ".*") ;Set the match-data. + (forward-line 1) + (setq res (point)) + nil))) + res)) + (pcase-let ((`(,vdefs ,tdefs ,el-defs-re ,cl-defs-re @@ -189,6 +208,7 @@ It has `lisp-mode-abbrev-table' as its parent." "with-category-table" "with-coding-priority" "with-current-buffer" "with-demoted-errors" "with-electric-help" "with-eval-after-load" + "with-file-modes" "with-local-quit" "with-no-warnings" "with-output-to-temp-buffer" "with-selected-window" "with-selected-frame" "with-silent-modifications" @@ -347,6 +367,9 @@ It has `lisp-mode-abbrev-table' as its parent." ;; and that they get the wrong color. ;; ;; CL `with-' and `do-' constructs ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face) + (lisp--match-hidden-arg + (0 '(face font-lock-warning-face + help-echo "Hidden behind deeper element; move to another line?"))) )) "Gaudy level highlighting for Emacs Lisp mode.") @@ -377,6 +400,9 @@ It has `lisp-mode-abbrev-table' as its parent." ;; and that they get the wrong color. ;; ;; CL `with-' and `do-' constructs ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face) + (lisp--match-hidden-arg + (0 '(face font-lock-warning-face + help-echo "Hidden behind deeper element; move to another line?"))) )) "Gaudy level highlighting for Lisp modes.")) @@ -387,6 +413,41 @@ It has `lisp-mode-abbrev-table' as its parent." (defvar lisp-cl-font-lock-keywords lisp-cl-font-lock-keywords-1 "Default expressions to highlight in Lisp modes.") +(defun lisp-string-in-doc-position-p (listbeg startpos) + (let* ((firstsym (and listbeg + (save-excursion + (goto-char listbeg) + (and (looking-at "([ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)") + (match-string 1))))) + (docelt (and firstsym + (function-get (intern-soft firstsym) + lisp-doc-string-elt-property)))) + (and docelt + ;; It's a string in a form that can have a docstring. + ;; Check whether it's in docstring position. + (save-excursion + (when (functionp docelt) + (goto-char (match-end 1)) + (setq docelt (funcall docelt))) + (goto-char listbeg) + (forward-char 1) + (condition-case nil + (while (and (> docelt 0) (< (point) startpos) + (progn (forward-sexp 1) t)) + (setq docelt (1- docelt))) + (error nil)) + (and (zerop docelt) (<= (point) startpos) + (progn (forward-comment (point-max)) t) + (= (point) startpos)))))) + +(defun lisp-string-after-doc-keyword-p (listbeg startpos) + (and listbeg ; We are inside a Lisp form. + (save-excursion + (goto-char startpos) + (ignore-errors + (progn (backward-sexp 1) + (looking-at ":documentation\\_>")))))) + (defun lisp-font-lock-syntactic-face-function (state) (if (nth 3 state) ;; This might be a (doc)string or a |...| symbol. @@ -394,32 +455,9 @@ It has `lisp-mode-abbrev-table' as its parent." (if (eq (char-after startpos) ?|) ;; This is not a string, but a |...| symbol. nil - (let* ((listbeg (nth 1 state)) - (firstsym (and listbeg - (save-excursion - (goto-char listbeg) - (and (looking-at "([ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)") - (match-string 1))))) - (docelt (and firstsym - (function-get (intern-soft firstsym) - lisp-doc-string-elt-property)))) - (if (and docelt - ;; It's a string in a form that can have a docstring. - ;; Check whether it's in docstring position. - (save-excursion - (when (functionp docelt) - (goto-char (match-end 1)) - (setq docelt (funcall docelt))) - (goto-char listbeg) - (forward-char 1) - (condition-case nil - (while (and (> docelt 0) (< (point) startpos) - (progn (forward-sexp 1) t)) - (setq docelt (1- docelt))) - (error nil)) - (and (zerop docelt) (<= (point) startpos) - (progn (forward-comment (point-max)) t) - (= (point) (nth 8 state))))) + (let ((listbeg (nth 1 state))) + (if (or (lisp-string-in-doc-position-p listbeg startpos) + (lisp-string-after-doc-keyword-p listbeg startpos)) font-lock-doc-face font-lock-string-face)))) font-lock-comment-face)) @@ -465,10 +503,10 @@ font-lock keywords will not be case sensitive." lisp-cl-font-lock-keywords-2)) nil ,keywords-case-insensitive nil nil (font-lock-mark-block-function . mark-defun) + (font-lock-extra-managed-props help-echo) (font-lock-syntactic-face-function . lisp-font-lock-syntactic-face-function))) (setq-local prettify-symbols-alist lisp--prettify-symbols-alist) - ;; electric (when elisp (setq-local electric-pair-text-pairs (cons '(?\` . ?\') electric-pair-text-pairs))) @@ -992,26 +1030,20 @@ If CHAR is not a character, return nil." (forward-sexp -1)))) (save-restriction - ;; vladimir@cs.ualberta.ca 30-Jul-1997: skip ` in - ;; `variable' so that the value is returned, not the - ;; name - (if (and ignore-quotes - (eq (following-char) ?`)) + (if (and ignore-quotes (eq (following-char) ?`)) + ;; vladimir@cs.ualberta.ca 30-Jul-1997: Skip ` in `variable' so + ;; that the value is returned, not the name. (forward-char)) + (when (looking-at ",@?") (goto-char (match-end 0))) (narrow-to-region (point-min) opoint) (setq expr (read (current-buffer))) - ;; If it's an (interactive ...) form, it's more - ;; useful to show how an interactive call would - ;; use it. - (and (consp expr) - (eq (car expr) 'interactive) + ;; If it's an (interactive ...) form, it's more useful to show how an + ;; interactive call would use it. + ;; FIXME: Is it really the right place for this? + (when (eq (car-safe expr) 'interactive) (setq expr - (list 'call-interactively - (list 'quote - (list 'lambda - '(&rest args) - expr - 'args))))) + `(call-interactively + (lambda (&rest args) ,expr args)))) expr))))) diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 80366db33d5..23b021df177 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -57,10 +57,14 @@ Should take the same arguments and behave similarly to `forward-sexp'.") (defun forward-sexp (&optional arg) "Move forward across one balanced expression (sexp). -With ARG, do it that many times. Negative arg -N means -move backward across N balanced expressions. -This command assumes point is not in a string or comment. -Calls `forward-sexp-function' to do the work, if that is non-nil." +With ARG, do it that many times. Negative arg -N means move +backward across N balanced expressions. This command assumes +point is not in a string or comment. Calls +`forward-sexp-function' to do the work, if that is non-nil. If +unable to move over a sexp, signal `scan-error' with three +arguments: a message, the start of the obstacle (usually a +parenthesis or list marker of some kind), and end of the +obstacle." (interactive "^p") (or arg (setq arg 1)) (if forward-sexp-function @@ -140,38 +144,92 @@ This command assumes point is not in a string or comment." (goto-char (or (scan-lists (point) inc -1) (buffer-end arg))) (setq arg (- arg inc))))) -(defun backward-up-list (&optional arg) +(defun backward-up-list (&optional arg escape-strings no-syntax-crossing) "Move backward out of one level of parentheses. This command will also work on other parentheses-like expressions -defined by the current language mode. -With ARG, do this that many times. -A negative argument means move forward but still to a less deep spot. -This command assumes point is not in a string or comment." - (interactive "^p") - (up-list (- (or arg 1)))) - -(defun up-list (&optional arg) +defined by the current language mode. With ARG, do this that +many times. A negative argument means move forward but still to +a less deep spot. If ESCAPE-STRINGS is non-nil (as it is +interactively), move out of enclosing strings as well. If +NO-SYNTAX-CROSSING is non-nil (as it is interactively), prefer to +break out of any enclosing string instead of moving to the start +of a list broken across multiple strings. On error, location of +point is unspecified." + (interactive "^p\nd\nd") + (up-list (- (or arg 1)) escape-strings no-syntax-crossing)) + +(defun up-list (&optional arg escape-strings no-syntax-crossing) "Move forward out of one level of parentheses. This command will also work on other parentheses-like expressions -defined by the current language mode. -With ARG, do this that many times. -A negative argument means move backward but still to a less deep spot. -This command assumes point is not in a string or comment." - (interactive "^p") +defined by the current language mode. With ARG, do this that +many times. A negative argument means move backward but still to +a less deep spot. If ESCAPE-STRINGS is non-nil (as it is +interactively), move out of enclosing strings as well. If +NO-SYNTAX-CROSSING is non-nil (as it is interactively), prefer to +break out of any enclosing string instead of moving to the start +of a list broken across multiple strings. On error, location of +point is unspecified." + (interactive "^p\nd\nd") (or arg (setq arg 1)) (let ((inc (if (> arg 0) 1 -1)) - pos) + (pos nil)) (while (/= arg 0) - (if (null forward-sexp-function) - (goto-char (or (scan-lists (point) inc 1) (buffer-end arg))) - (condition-case err - (while (progn (setq pos (point)) - (forward-sexp inc) - (/= (point) pos))) - (scan-error (goto-char (nth (if (> arg 0) 3 2) err)))) - (if (= (point) pos) - (signal 'scan-error - (list "Unbalanced parentheses" (point) (point))))) + (condition-case err + (save-restriction + ;; If we've been asked not to cross string boundaries + ;; and we're inside a string, narrow to that string so + ;; that scan-lists doesn't find a match in a different + ;; string. + (when no-syntax-crossing + (let* ((syntax (syntax-ppss)) + (string-comment-start (nth 8 syntax))) + (when string-comment-start + (save-excursion + (goto-char string-comment-start) + (narrow-to-region + (point) + (if (nth 3 syntax) ; in string + (condition-case nil + (progn (forward-sexp) (point)) + (scan-error (point-max))) + (forward-comment 1) + (point))))))) + (if (null forward-sexp-function) + (goto-char (or (scan-lists (point) inc 1) + (buffer-end arg))) + (condition-case err + (while (progn (setq pos (point)) + (forward-sexp inc) + (/= (point) pos))) + (scan-error (goto-char (nth (if (> arg 0) 3 2) err)))) + (if (= (point) pos) + (signal 'scan-error + (list "Unbalanced parentheses" (point) (point)))))) + (scan-error + (let ((syntax nil)) + (or + ;; If we bumped up against the end of a list, see whether + ;; we're inside a string: if so, just go to the beginning + ;; or end of that string. + (and escape-strings + (or syntax (setf syntax (syntax-ppss))) + (nth 3 syntax) + (goto-char (nth 8 syntax)) + (progn (when (> inc 0) + (forward-sexp)) + t)) + ;; If we narrowed to a comment above and failed to escape + ;; it, the error might be our fault, not an indication + ;; that we're out of syntax. Try again from beginning or + ;; end of the comment. + (and no-syntax-crossing + (or syntax (setf syntax (syntax-ppss))) + (nth 4 syntax) + (goto-char (nth 8 syntax)) + (or (< inc 0) + (forward-comment 1)) + (setf arg (+ arg inc))) + (signal (car err) (cdr err)))))) (setq arg (- arg inc))))) (defun kill-sexp (&optional arg) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index e3a746fa69e..44727daf76a 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -97,7 +97,10 @@ each clause." (defun macroexp--compiler-macro (handler form) (condition-case err (apply handler form (cdr form)) - (error (message "Compiler-macro error for %S: %S" (car form) err) + (error + (message "--------------------------------------------------") + (backtrace) + (message "Compiler-macro error for %S: %S" (car form) err) form))) (defun macroexp--funcall-if-compiled (_form) @@ -402,7 +405,7 @@ symbol itself." (defvar macroexp--pending-eager-loads nil "Stack of files currently undergoing eager macro-expansion.") -(defun internal-macroexpand-for-load (form) +(defun internal-macroexpand-for-load (form full-p) ;; Called from the eager-macroexpansion in readevalloop. (cond ;; Don't repeat the same warning for every top-level element. @@ -425,7 +428,9 @@ symbol itself." (condition-case err (let ((macroexp--pending-eager-loads (cons load-file-name macroexp--pending-eager-loads))) - (macroexpand-all form)) + (if full-p + (macroexpand-all form) + (macroexpand form))) (error ;; Hopefully this shouldn't happen thanks to the cycle detection, ;; but in case it does happen, let's catch the error and give the diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 1c8641249cf..bfd939d69e2 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -236,11 +236,12 @@ different, but `function-equal' will hopefully ignore those differences.") ;; This function acts like the t special value in buffer-local hooks. (lambda (&rest args) (apply (default-value var) args))))) -(defun advice--normalize-place (place) - (cond ((eq 'local (car-safe place)) `(advice--buffer-local ,@(cdr place))) - ((eq 'var (car-safe place)) (nth 1 place)) - ((symbolp place) `(default-value ',place)) - (t place))) +(eval-and-compile + (defun advice--normalize-place (place) + (cond ((eq 'local (car-safe place)) `(advice--buffer-local ,@(cdr place))) + ((eq 'var (car-safe place)) (nth 1 place)) + ((symbolp place) `(default-value ',place)) + (t place)))) ;;;###autoload (defmacro add-function (where place function &optional props) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 6985a2b58cc..7ca62464bd0 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -657,6 +657,7 @@ EXTRA-PROPERTIES is currently unused." (let* ((auto-name (format "%s-autoloads.el" name)) ;;(ignore-name (concat name "-pkg.el")) (generated-autoload-file (expand-file-name auto-name pkg-dir)) + (backup-inhibited t) (version-control 'never)) (package-autoload-ensure-default-file generated-autoload-file) (update-directory-autoloads pkg-dir) @@ -698,6 +699,7 @@ untar into a directory named DIR; otherwise, signal an error." (print-length nil)) (write-region (concat + ";;; -*- no-byte-compile: t -*-\n" (prin1-to-string (nconc (list 'define-package @@ -712,14 +714,25 @@ untar into a directory named DIR; otherwise, signal an error." (list (car elt) (package-version-join (cadr elt)))) requires)))) - (package--alist-to-plist - (package-desc-extras pkg-desc)))) + (let ((alist (package-desc-extras pkg-desc)) + flat) + (while alist + (let* ((pair (pop alist)) + (key (car pair)) + (val (cdr pair))) + ;; Don't bother ‘quote’ing ‘key’; it is always a keyword. + (push key flat) + (push (if (and (not (consp val)) + (or (keywordp val) + (not (symbolp val)) + (memq val '(nil t)))) + val + `',val) + flat))) + (nreverse flat)))) "\n") nil pkg-file nil 'silent)))) -(defun package--alist-to-plist (alist) - (apply #'nconc (mapcar (lambda (pair) (list (car pair) (cdr pair))) alist))) - (defun package-unpack (pkg-desc) "Install the contents of the current buffer as a package." (let* ((name (package-desc-name pkg-desc)) diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el index b2d4f2b71dd..ff9388171a6 100644 --- a/lisp/emacs-lisp/regexp-opt.el +++ b/lisp/emacs-lisp/regexp-opt.el @@ -205,9 +205,7 @@ Merges keywords to avoid backtracking in Emacs's regexp matcher." (regexp-opt-group suffixes t t) close-group)) - (let* ((sgnirts (mapcar (lambda (s) - (concat (nreverse (string-to-list s)))) - strings)) + (let* ((sgnirts (mapcar #'reverse strings)) (xiffus (try-completion "" sgnirts))) (if (> (length xiffus) 0) ;; common suffix: take it and recurse on the prefixes. @@ -218,8 +216,7 @@ Merges keywords to avoid backtracking in Emacs's regexp matcher." 'string-lessp))) (concat open-group (regexp-opt-group prefixes t t) - (regexp-quote - (concat (nreverse (string-to-list xiffus)))) + (regexp-quote (nreverse xiffus)) close-group)) ;; Otherwise, divide the list into those that start with a diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index d0d71ddb935..3ee261aa06b 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -323,7 +323,8 @@ to the entry with the same ID element as the current line." (if saved-pt (progn (goto-char saved-pt) (move-to-column saved-col) - (recenter)) + (when (eq (window-buffer) (current-buffer)) + (recenter))) (goto-char (point-min))))) (defun tabulated-list-print-entry (id cols) diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index 96c9ba1e095..ee70071b7ec 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -1156,19 +1156,6 @@ If ARG is the atom `-', scroll upward by nearly full screen." (cancel-timer cua--prefix-override-timer)) (setq cua--prefix-override-timer nil)) - (cond - ;; Only symbol commands can have necessary properties - ((not (symbolp this-command)) - nil) - - ((not (eq (get this-command 'CUA) 'move)) - nil) - - ;; Set mark if user explicitly said to do so - (cua--rectangle ;FIXME: ?? - (unless mark-active - (push-mark-command nil nil)))) - ;; Detect extension of rectangles by mouse or other movement (setq cua--buffer-and-point-before-command (if cua--rectangle (cons (current-buffer) (point))))) @@ -1367,36 +1354,6 @@ If ARG is the atom `-', scroll upward by nearly full screen." ) -;; Setup standard movement commands to be recognized by CUA. - -(dolist (cmd - '(forward-char backward-char - right-char left-char - right-word left-word - next-line previous-line - forward-word backward-word - end-of-line beginning-of-line - end-of-visual-line beginning-of-visual-line - move-end-of-line move-beginning-of-line - end-of-buffer beginning-of-buffer - scroll-up scroll-down - scroll-up-command scroll-down-command - up-list down-list backward-up-list - end-of-defun beginning-of-defun - forward-sexp backward-sexp - forward-list backward-list - forward-sentence backward-sentence - forward-paragraph backward-paragraph - ;; CC mode motion commands - c-forward-conditional c-backward-conditional - c-down-conditional c-up-conditional - c-down-conditional-with-else c-up-conditional-with-else - c-beginning-of-statement c-end-of-statement)) - (put cmd 'CUA 'move)) - -;; Only called if pc-selection-mode is t, which means pc-select is loaded. -(declare-function pc-selection-mode "pc-select" (&optional arg)) - ;; State prior to enabling cua-mode ;; Value is a list with the following elements: ;; delete-selection-mode diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el index 9a096a0a709..d1ed679c0f1 100644 --- a/lisp/epa-mail.el +++ b/lisp/epa-mail.el @@ -70,27 +70,24 @@ USAGE would be `sign' or `encrypt'." ;;;###autoload (defun epa-mail-decrypt () "Decrypt OpenPGP armors in the current buffer. -The buffer is expected to contain a mail message. - -Don't use this command in Lisp programs!" +The buffer is expected to contain a mail message." + (declare (interactive-only t)) (interactive) (epa-decrypt-armor-in-region (point-min) (point-max))) ;;;###autoload (defun epa-mail-verify () "Verify OpenPGP cleartext signed messages in the current buffer. -The buffer is expected to contain a mail message. - -Don't use this command in Lisp programs!" +The buffer is expected to contain a mail message." + (declare (interactive-only t)) (interactive) (epa-verify-cleartext-in-region (point-min) (point-max))) ;;;###autoload (defun epa-mail-sign (start end signers mode) "Sign the current buffer. -The buffer is expected to contain a mail message. - -Don't use this command in Lisp programs!" +The buffer is expected to contain a mail message." + (declare (interactive-only t)) (interactive (save-excursion (goto-char (point-min)) @@ -234,9 +231,8 @@ If no one is selected, symmetric encryption will be performed. " ;;;###autoload (defun epa-mail-import-keys () "Import keys in the OpenPGP armor format in the current buffer. -The buffer is expected to contain a mail message. - -Don't use this command in Lisp programs!" +The buffer is expected to contain a mail message." + (declare (interactive-only t)) (interactive) (epa-import-armor-in-region (point-min) (point-max))) diff --git a/lisp/epa.el b/lisp/epa.el index be439ef241d..0c833ab84d6 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -834,6 +834,7 @@ For example: Don't use this command in Lisp programs! See the reason described in the `epa-decrypt-region' documentation." + (declare (interactive-only t)) (interactive "r") (save-excursion (save-restriction @@ -873,6 +874,7 @@ For example: (decode-coding-string (epg-verify-string context (buffer-substring start end)) 'utf-8))" + (declare (interactive-only t)) (interactive "r") (let ((context (epg-make-context epa-protocol)) plain) @@ -914,6 +916,7 @@ between START and END. Don't use this command in Lisp programs! See the reason described in the `epa-verify-region' documentation." + (declare (interactive-only t)) (interactive "r") (save-excursion (save-restriction @@ -956,6 +959,7 @@ For example: (epg-sign-string context (encode-coding-string (buffer-substring start end) 'utf-8)))" + (declare (interactive-only t)) (interactive (let ((verbose current-prefix-arg)) (setq epa-last-coding-system-specified @@ -1037,6 +1041,7 @@ For example: context (encode-coding-string (buffer-substring start end) 'utf-8) nil))" + (declare (interactive-only t)) (interactive (let ((verbose current-prefix-arg) (context (epg-make-context epa-protocol)) @@ -1205,6 +1210,7 @@ If no one is selected, default public key is exported. "))) ;; If a prefix-arg is specified, the signature is marked as non exportable. ;; Don't use this command in Lisp programs!" +;; (declare (interactive-only t)) ;; (interactive ;; (let ((keys (epa--marked-keys))) ;; (unless keys diff --git a/lisp/epg.el b/lisp/epg.el index 77181a1a342..26e3b3d2501 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -1206,7 +1206,6 @@ This function is for internal use only." (coding-system-for-read 'binary) process-connection-type (process-environment process-environment) - (orig-mode (default-file-modes)) (buffer (generate-new-buffer " *epg*")) process terminal-name @@ -1265,14 +1264,9 @@ This function is for internal use only." (setq epg-agent-file agent-file) (make-local-variable 'epg-agent-mtime) (setq epg-agent-mtime agent-mtime)) - (unwind-protect - (progn - (set-default-file-modes 448) - (setq process - (apply #'start-process "epg" buffer - (epg-context-program context) - args))) - (set-default-file-modes orig-mode)) + (with-file-modes 448 + (setq process (apply #'start-process "epg" buffer + (epg-context-program context) args))) (set-process-filter process #'epg--process-filter) (epg-context-set-process context process))) diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog index 6d99fdf73d9..2e5d2772c58 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog @@ -1,3 +1,22 @@ +2014-06-19 Kelvin White <kelvin.white77@gmail.com> + + * erc-backend.el: Handle user modes in relevant server responses + * erc.el: Better user mode support. + (erc-channel-user): Add members for new modes. + (erc-channel-member-halfop-p, erc-channel-user-admin-p) + (erc-channel-user-owner-p): Use new struct members. + (erc-format-nick, erc-format-@nick): Display user modes as nick prefix. + (erc-nick-prefix-face, erc-my-nick-prefix-face): Add new faces + (erc-get-user-mode-prefix): Return symbol for mode prefix. + (erc-update-channel-member, erc-update-current-channel-member) + (erc-channel-receive-names): Update channel users. + (erc-nick-at-point): Return correct user info. + +2014-04-04 Stefan Monnier <monnier@iro.umontreal.ca> + + * erc.el (erc-invite-only-mode, erc-toggle-channel-mode): Simplify. + (erc-load-script): Tighten a regexp. + 2014-02-25 Julien Danjou <julien@danjou.info> * erc-networks.el (erc-determine-network): Check that NETWORK as a @@ -610,4 +629,3 @@ See ChangeLog.08 for earlier changes. ;; coding: utf-8 ;; add-log-time-zone-rule: t ;; End: - diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 01fdfc54d1d..8751a194e3b 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -679,7 +679,7 @@ Conditionally try to reconnect and take appropriate action." (when (buffer-live-p buf) (with-current-buffer buf (erc-log (format - "SENTINEL: proc: %S status: %S event: %S (quitting: %S)" + "SENTINEL: proc: %S status: %S event: %S (quitting: %S)" cproc (process-status cproc) event erc-server-quitting)) (if (string-match "^open" event) ;; newly opened connection (no wait) @@ -1208,7 +1208,6 @@ add things to `%s' instead." parsed 'notice 'active 'INVITE ?n nick ?u login ?h host ?c chnl))))) - (define-erc-response-handler (JOIN) "Handle join messages." nil @@ -1244,7 +1243,7 @@ add things to `%s' instead." (erc-format-message 'JOIN ?n nick ?u login ?h host ?c chnl)))))) (when buffer (set-buffer buffer)) - (erc-update-channel-member chnl nick nick t nil nil host login) + (erc-update-channel-member chnl nick nick t nil nil nil nil nil host login) ;; on join, we want to stay in the new channel buffer ;;(set-buffer ob) (erc-display-message parsed nil buffer str)))))) @@ -1413,7 +1412,7 @@ add things to `%s' instead." ;; message. We will accumulate private identities indefinitely ;; at this point. (erc-update-channel-member (if privp nick tgt) nick nick - privp nil nil host login nil nil t) + privp nil nil nil nil nil host login nil nil t) (let ((cdata (erc-get-channel-user nick))) (setq fnick (funcall erc-format-nick-function (car cdata) (cdr cdata)))))) @@ -1470,7 +1469,7 @@ add things to `%s' instead." (current-time)))) (pcase-let ((`(,nick ,login ,host) (erc-parse-user (erc-response.sender parsed)))) - (erc-update-channel-member ch nick nick nil nil nil host login) + (erc-update-channel-member ch nick nick nil nil nil nil nil nil host login) (erc-update-channel-topic ch (format "%s\C-o (%s, %s)" topic nick time)) (erc-display-message parsed 'notice (erc-get-buffer ch proc) 'TOPIC ?n nick ?u login ?h host @@ -1800,8 +1799,7 @@ See `erc-display-server-message'." nil (when (string-match "\\(^[0-9]+ \\)\\(.*\\)$" full-name) (setq hopcount (match-string 1 full-name)) (setq full-name (match-string 2 full-name))) - (erc-update-channel-member channel nick nick nil nil nil host - user full-name) + (erc-update-channel-member channel nick nick nil nil nil nil nil nil host user full-name) (erc-display-message parsed 'notice 'active 's352 ?c channel ?n nick ?a away-flag ?u user ?h host ?f full-name)))) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index d93e9e02156..8d2ea62b231 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -9,6 +9,7 @@ ;; Andreas Fuchs (afs@void.at) ;; Gergely Nagy (algernon@midgard.debian.net) ;; David Edmondson (dme@dme.org) +;; Kelvin White <kelvin.white77@gmail.com> ;; Maintainer: emacs-devel@gnu.org ;; Keywords: IRC, chat, client, Internet ;; Version: 5.3 @@ -143,7 +144,7 @@ See function `erc-compute-server' for more details on connection parameters and authentication." :group 'erc :type '(choice (const :tag "None" nil) - (string :tag "Server"))) + (string :tag "Server"))) (defcustom erc-port nil "IRC port to use if not specified. @@ -151,8 +152,8 @@ parameters and authentication." This can be either a string or a number." :group 'erc :type '(choice (const :tag "None" nil) - (integer :tag "Port number") - (string :tag "Port string"))) + (integer :tag "Port number") + (string :tag "Port string"))) (defcustom erc-nick nil "Nickname to use if one is not provided. @@ -165,8 +166,8 @@ See function `erc-compute-nick' for more details on connection parameters and authentication." :group 'erc :type '(choice (const :tag "None" nil) - (string :tag "Nickname") - (repeat (string :tag "Nickname")))) + (string :tag "Nickname") + (repeat (string :tag "Nickname")))) (defcustom erc-nick-uniquifier "`" "The string to append to the nick if it is already in use." @@ -190,10 +191,10 @@ See function `erc-compute-full-name' for more details on connection parameters and authentication." :group 'erc :type '(choice (const :tag "No name" nil) - (string :tag "Name") - (function :tag "Get from function")) + (string :tag "Name") + (function :tag "Get from function")) :set (lambda (sym val) - (set sym (if (functionp val) (funcall val) val)))) + (set sym (if (functionp val) (funcall val) val)))) (defvar erc-password nil "Password to use when authenticating to an IRC server. @@ -243,12 +244,12 @@ If nil, only \"> \" will be shown." (define-widget 'erc-message-type 'set "A set of standard IRC Message types." :args '((const "JOIN") - (const "KICK") - (const "NICK") - (const "PART") - (const "QUIT") - (const "MODE") - (repeat :inline t :tag "Others" (string :tag "IRC Message Type")))) + (const "KICK") + (const "NICK") + (const "PART") + (const "QUIT") + (const "MODE") + (repeat :inline t :tag "Others" (string :tag "IRC Message Type")))) (defcustom erc-hide-list nil "List of IRC type messages to hide. @@ -339,14 +340,14 @@ nicknames with erc-server-user struct instances.") (defun erc-downcase (string) "Convert STRING to IRC standard conforming downcase." (let ((s (downcase string)) - (c '((?\[ . ?\{) - (?\] . ?\}) - (?\\ . ?\|) - (?~ . ?^)))) + (c '((?\[ . ?\{) + (?\] . ?\}) + (?\\ . ?\|) + (?~ . ?^)))) (save-match-data (while (string-match "[]\\[~]" s) - (aset s (match-beginning 0) - (cdr (assq (aref s (match-beginning 0)) c))))) + (aset s (match-beginning 0) + (cdr (assq (aref s (match-beginning 0)) c))))) s)) (defmacro erc-with-server-buffer (&rest body) @@ -356,8 +357,8 @@ If no server buffer exists, return nil." (let ((buffer (make-symbol "buffer"))) `(let ((,buffer (erc-server-buffer))) (when (buffer-live-p ,buffer) - (with-current-buffer ,buffer - ,@body))))) + (with-current-buffer ,buffer + ,@body))))) (cl-defstruct (erc-server-user (:type vector) :named) ;; User data @@ -370,7 +371,7 @@ If no server buffer exists, return nil." ) (cl-defstruct (erc-channel-user (:type vector) :named) - op voice + voice halfop op admin owner ;; Last message time (in the form of the return value of ;; (current-time) ;; @@ -419,11 +420,11 @@ other buffers are also changed." (puthash (erc-downcase new-nick) user erc-server-users)) (dolist (buf (erc-server-user-buffers user)) (if (buffer-live-p buf) - (with-current-buffer buf - (let ((cdata (erc-get-channel-user nick))) - (remhash (erc-downcase nick) erc-channel-users) - (puthash (erc-downcase new-nick) cdata - erc-channel-users))))))) + (with-current-buffer buf + (let ((cdata (erc-get-channel-user nick))) + (remhash (erc-downcase nick) erc-channel-users) + (puthash (erc-downcase new-nick) cdata + erc-channel-users))))))) (defun erc-remove-channel-user (nick) "This function is for internal use only. @@ -437,12 +438,12 @@ See also: `erc-remove-server-user' and `erc-remove-user'." (let ((channel-data (erc-get-channel-user nick))) (when channel-data (let ((user (car channel-data))) - (setf (erc-server-user-buffers user) - (delq (current-buffer) - (erc-server-user-buffers user))) - (remhash (erc-downcase nick) erc-channel-users) - (if (null (erc-server-user-buffers user)) - (erc-remove-server-user nick)))))) + (setf (erc-server-user-buffers user) + (delq (current-buffer) + (erc-server-user-buffers user))) + (remhash (erc-downcase nick) erc-channel-users) + (if (null (erc-server-user-buffers user)) + (erc-remove-server-user nick)))))) (defun erc-remove-user (nick) "This function is for internal use only. @@ -455,11 +456,11 @@ See also: `erc-remove-server-user' and (let ((user (erc-get-server-user nick))) (when user (let ((buffers (erc-server-user-buffers user))) - (dolist (buf buffers) - (if (buffer-live-p buf) - (with-current-buffer buf - (remhash (erc-downcase nick) erc-channel-users) - (run-hooks 'erc-channel-members-changed-hook))))) + (dolist (buf buffers) + (if (buffer-live-p buf) + (with-current-buffer buf + (remhash (erc-downcase nick) erc-channel-users) + (run-hooks 'erc-channel-members-changed-hook))))) (erc-remove-server-user nick)))) (defun erc-remove-channel-users () @@ -468,28 +469,52 @@ See also: `erc-remove-server-user' and Removes all users in the current channel. This is called by `erc-server-PART' and `erc-server-QUIT'." (when (and erc-server-connected - (erc-server-process-alive) - (hash-table-p erc-channel-users)) + (erc-server-process-alive) + (hash-table-p erc-channel-users)) (maphash (lambda (nick _cdata) - (erc-remove-channel-user nick)) - erc-channel-users) + (erc-remove-channel-user nick)) + erc-channel-users) (clrhash erc-channel-users))) +(defsubst erc-channel-user-owner-p (nick) + "Return non-nil if NICK is an owner of the current channel." + (and nick + (hash-table-p erc-channel-users) + (let ((cdata (erc-get-channel-user nick))) + (and cdata (cdr cdata) + (erc-channel-user-owner (cdr cdata)))))) + +(defsubst erc-channel-user-admin-p (nick) + "Return non-nil if NICK is an admin in the current channel." + (and nick + (hash-table-p erc-channel-users) + (let ((cdata (erc-get-channel-user nick))) + (and cdata (cdr cdata) + (erc-channel-user-admin (cdr cdata)))))) + (defsubst erc-channel-user-op-p (nick) - "Return t if NICK is an operator in the current channel." + "Return non-nil if NICK is an operator in the current channel." + (and nick + (hash-table-p erc-channel-users) + (let ((cdata (erc-get-channel-user nick))) + (and cdata (cdr cdata) + (erc-channel-user-op (cdr cdata)))))) + +(defsubst erc-channel-user-halfop-p (nick) + "Return non-nil if NICK is a half-operator in the current channel." (and nick (hash-table-p erc-channel-users) (let ((cdata (erc-get-channel-user nick))) - (and cdata (cdr cdata) - (erc-channel-user-op (cdr cdata)))))) + (and cdata (cdr cdata) + (erc-channel-user-halfop (cdr cdata)))))) (defsubst erc-channel-user-voice-p (nick) - "Return t if NICK has voice in the current channel." + "Return non-nil if NICK has voice in the current channel." (and nick (hash-table-p erc-channel-users) (let ((cdata (erc-get-channel-user nick))) - (and cdata (cdr cdata) - (erc-channel-user-voice (cdr cdata)))))) + (and cdata (cdr cdata) + (erc-channel-user-voice (cdr cdata)))))) (defun erc-get-channel-user-list () "Return a list of users in the current channel. Each element @@ -500,9 +525,9 @@ erc-channel-user struct. See also: `erc-sort-channel-users-by-activity'" (let (users) (if (hash-table-p erc-channel-users) - (maphash (lambda (_nick cdata) - (setq users (cons cdata users))) - erc-channel-users)) + (maphash (lambda (_nick cdata) + (setq users (cons cdata users))) + erc-channel-users)) users)) (defun erc-get-server-nickname-list () @@ -510,22 +535,22 @@ See also: `erc-sort-channel-users-by-activity'" (erc-with-server-buffer (let (nicks) (when (hash-table-p erc-server-users) - (maphash (lambda (_n user) - (setq nicks - (cons (erc-server-user-nickname user) - nicks))) - erc-server-users) - nicks)))) + (maphash (lambda (_n user) + (setq nicks + (cons (erc-server-user-nickname user) + nicks))) + erc-server-users) + nicks)))) (defun erc-get-channel-nickname-list () "Return a list of known nicknames on the current channel." (let (nicks) (when (hash-table-p erc-channel-users) (maphash (lambda (_n cdata) - (setq nicks - (cons (erc-server-user-nickname (car cdata)) - nicks))) - erc-channel-users) + (setq nicks + (cons (erc-server-user-nickname (car cdata)) + nicks))) + erc-channel-users) nicks))) (defun erc-get-server-nickname-alist () @@ -533,22 +558,22 @@ See also: `erc-sort-channel-users-by-activity'" (erc-with-server-buffer (let (nicks) (when (hash-table-p erc-server-users) - (maphash (lambda (_n user) - (setq nicks - (cons (cons (erc-server-user-nickname user) nil) - nicks))) - erc-server-users) - nicks)))) + (maphash (lambda (_n user) + (setq nicks + (cons (cons (erc-server-user-nickname user) nil) + nicks))) + erc-server-users) + nicks)))) (defun erc-get-channel-nickname-alist () "Return an alist of known nicknames on the current channel." (let (nicks) (when (hash-table-p erc-channel-users) (maphash (lambda (_n cdata) - (setq nicks - (cons (cons (erc-server-user-nickname (car cdata)) nil) - nicks))) - erc-channel-users) + (setq nicks + (cons (cons (erc-server-user-nickname (car cdata)) nil) + nicks))) + erc-channel-users) nicks))) (defun erc-sort-channel-users-by-activity (list) @@ -557,13 +582,13 @@ LIST must be of the form (USER . CHANNEL-DATA). See also: `erc-get-channel-user-list'." (sort list - (lambda (x y) - (when (and (cdr x) (cdr y)) - (let ((tx (erc-channel-user-last-message-time (cdr x))) - (ty (erc-channel-user-last-message-time (cdr y)))) - (and tx - (or (not ty) - (time-less-p ty tx)))))))) + (lambda (x y) + (when (and (cdr x) (cdr y)) + (let ((tx (erc-channel-user-last-message-time (cdr x))) + (ty (erc-channel-user-last-message-time (cdr y)))) + (and tx + (or (not ty) + (time-less-p ty tx)))))))) (defun erc-sort-channel-users-alphabetically (list) "Sort LIST so that users' nicknames are in alphabetical order. @@ -571,13 +596,13 @@ LIST must be of the form (USER . CHANNEL-DATA). See also: `erc-get-channel-user-list'." (sort list - (lambda (x y) - (when (and (cdr x) (cdr y)) - (let ((nickx (downcase (erc-server-user-nickname (car x)))) - (nicky (downcase (erc-server-user-nickname (car y))))) - (and nickx - (or (not nicky) - (string-lessp nickx nicky)))))))) + (lambda (x y) + (when (and (cdr x) (cdr y)) + (let ((nickx (downcase (erc-server-user-nickname (car x)))) + (nicky (downcase (erc-server-user-nickname (car y))))) + (and nickx + (or (not nicky) + (string-lessp nickx nicky)))))))) (defvar erc-channel-topic nil "A topic string for the channel. Should only be used in channel-buffers.") @@ -613,10 +638,10 @@ E.g. '(\"i\" \"m\" \"s\" \"b Quake!*@*\") See also the variable `erc-prompt'." (let ((prompt (if (functionp erc-prompt) - (funcall erc-prompt) - erc-prompt))) + (funcall erc-prompt) + erc-prompt))) (if (> (length prompt) 0) - (concat prompt " ") + (concat prompt " ") prompt))) (defcustom erc-command-indicator nil @@ -635,11 +660,11 @@ If nil, the prompt will be constructed from the variable `erc-prompt'." This only has any meaning if the variable `erc-command-indicator' is non-nil." (and erc-command-indicator (let ((prompt (if (functionp erc-command-indicator) - (funcall erc-command-indicator) - erc-command-indicator))) - (if (> (length prompt) 0) - (concat prompt " ") - prompt)))) + (funcall erc-command-indicator) + erc-command-indicator))) + (if (> (length prompt) 0) + (concat prompt " ") + prompt)))) (defcustom erc-notice-prefix "*** " "Prefix for all notices." @@ -658,8 +683,8 @@ The following values are allowed: Any other value disables notice's highlighting altogether." :group 'erc-display :type '(choice (const :tag "highlight notice prefix only" prefix) - (const :tag "highlight the entire notice" all) - (const :tag "don't highlight notices at all" nil))) + (const :tag "highlight the entire notice" all) + (const :tag "don't highlight notices at all" nil))) (defcustom erc-echo-notice-hook nil "List of functions to call to echo a private notice. @@ -682,14 +707,14 @@ See also: `erc-echo-notice-always-hook', :group 'erc-hooks :type 'hook :options '(erc-echo-notice-in-default-buffer - erc-echo-notice-in-target-buffer - erc-echo-notice-in-minibuffer - erc-echo-notice-in-server-buffer - erc-echo-notice-in-active-non-server-buffer - erc-echo-notice-in-active-buffer - erc-echo-notice-in-user-buffers - erc-echo-notice-in-user-and-target-buffers - erc-echo-notice-in-first-user-buffer)) + erc-echo-notice-in-target-buffer + erc-echo-notice-in-minibuffer + erc-echo-notice-in-server-buffer + erc-echo-notice-in-active-non-server-buffer + erc-echo-notice-in-active-buffer + erc-echo-notice-in-user-buffers + erc-echo-notice-in-user-and-target-buffers + erc-echo-notice-in-first-user-buffer)) (defcustom erc-echo-notice-always-hook '(erc-echo-notice-in-default-buffer) @@ -713,14 +738,14 @@ See also: `erc-echo-notice-hook', :group 'erc-hooks :type 'hook :options '(erc-echo-notice-in-default-buffer - erc-echo-notice-in-target-buffer - erc-echo-notice-in-minibuffer - erc-echo-notice-in-server-buffer - erc-echo-notice-in-active-non-server-buffer - erc-echo-notice-in-active-buffer - erc-echo-notice-in-user-buffers - erc-echo-notice-in-user-and-target-buffers - erc-echo-notice-in-first-user-buffer)) + erc-echo-notice-in-target-buffer + erc-echo-notice-in-minibuffer + erc-echo-notice-in-server-buffer + erc-echo-notice-in-active-non-server-buffer + erc-echo-notice-in-active-buffer + erc-echo-notice-in-user-buffers + erc-echo-notice-in-user-and-target-buffers + erc-echo-notice-in-first-user-buffer)) ;; other tunable parameters @@ -747,7 +772,7 @@ Many consider it impolite to do so automatically." "The nickname to take when you are marked as being away." :group 'erc :type '(choice (const nil) - string)) + string)) (defcustom erc-paranoid nil "If non-nil, then all incoming CTCP requests will be shown." @@ -782,7 +807,7 @@ set if some hacker is trying to flood you away." If nil, ERC will call `system-name' to get this information." :group 'erc :type '(choice (const :tag "Default system name" nil) - string)) + string)) (defcustom erc-ignore-list nil "List of regexps matching user identifiers to ignore. @@ -824,8 +849,8 @@ See `erc-server-flood-margin' for other flood-related parameters.") (defcustom erc-startup-file-list (list (concat erc-user-emacs-directory ".ercrc.el") - (concat erc-user-emacs-directory ".ercrc") - "~/.ercrc.el" "~/.ercrc" ".ercrc.el" ".ercrc") + (concat erc-user-emacs-directory ".ercrc") + "~/.ercrc.el" "~/.ercrc" ".ercrc.el" ".ercrc") "List of files to try for a startup script. The first existent and readable one will get executed. @@ -884,9 +909,9 @@ If no elements match, then the empty string is used. As an example: (setq erc-quit-reason-various-alist '((\"xmms\" dme:now-playing) - (\"version\" erc-quit-reason-normal) - (\"home\" \"Gone home !\") - (\"^$\" \"Default Reason\"))) + (\"version\" erc-quit-reason-normal) + (\"home\" \"Gone home !\") + (\"^$\" \"Default Reason\"))) If the user types \"/quit home\", then \"Gone home !\" will be used as the quit message." :group 'erc-quit-and-part @@ -907,9 +932,9 @@ If no elements match, then the empty string is used. As an example: (setq erc-part-reason-various-alist '((\"xmms\" dme:now-playing) - (\"version\" erc-part-reason-normal) - (\"home\" \"Gone home !\") - (\"^$\" \"Default Reason\"))) + (\"version\" erc-part-reason-normal) + (\"home\" \"Gone home !\") + (\"^$\" \"Default Reason\"))) If the user types \"/part home\", then \"Gone home !\" will be used as the part message." :group 'erc-quit-and-part @@ -922,8 +947,8 @@ The function is passed a single argument, the string typed by the user after \"/quit\"." :group 'erc-quit-and-part :type '(choice (const erc-quit-reason-normal) - (const erc-quit-reason-various) - (symbol))) + (const erc-quit-reason-various) + (symbol))) (defcustom erc-part-reason 'erc-part-reason-normal "A function which returns the reason for parting a channel. @@ -932,8 +957,8 @@ The function is passed a single argument, the string typed by the user after \"/PART\"." :group 'erc-quit-and-part :type '(choice (const erc-part-reason-normal) - (const erc-part-reason-various) - (symbol))) + (const erc-part-reason-various) + (symbol))) (defvar erc-grab-buffer-name "*erc-grab*" "The name of the buffer created by `erc-grab-region'.") @@ -1017,8 +1042,8 @@ At this point, all modifications from prior hook functions are done." :group 'erc-hooks :type 'hook :options '(erc-truncate-buffer - erc-make-read-only - erc-save-buffer-in-logs)) + erc-make-read-only + erc-save-buffer-in-logs)) (defcustom erc-send-modify-hook nil "Sending hook for functions that will change the text's appearance. @@ -1048,8 +1073,8 @@ This function is called with narrowing, ala `erc-send-modify-hook'." (defcustom erc-send-completed-hook (when (fboundp 'emacspeak-auditory-icon) (list (byte-compile - (lambda (_str) - (emacspeak-auditory-icon 'select-object))))) + (lambda (_str) + (emacspeak-auditory-icon 'select-object))))) "Hook called after a message has been parsed by ERC. The single argument to the functions is the unmodified string @@ -1122,6 +1147,14 @@ which the local user typed." "ERC default face." :group 'erc-faces) +(defface erc-nick-prefix-face '((t :inherit erc-nick-default-face :weight bold)) + "ERC face used for user mode prefix." + :group 'erc-faces) + +(defface erc-my-nick-prefix-face '((t :inherit erc-nick-default-face :weight bold)) + "ERC face used for my user mode prefix." + :group 'erc-faces) + (defface erc-direct-msg-face '((t :foreground "IndianRed")) "ERC face used for messages you receive in the main erc buffer." :group 'erc-faces) @@ -1189,7 +1222,7 @@ See also `erc-show-my-nick'." (make-variable-buffer-local 'erc-dbuf) (defmacro define-erc-module (name alias doc enable-body disable-body - &optional local-p) + &optional local-p) "Define a new minor mode using ERC conventions. Symbol NAME is the name of the module. Symbol ALIAS is the alias to use, or nil. @@ -1209,50 +1242,50 @@ Example: (define-erc-module replace nil \"This mode replaces incoming text according to `erc-replace-alist'.\" ((add-hook 'erc-insert-modify-hook - 'erc-replace-insert)) + 'erc-replace-insert)) ((remove-hook 'erc-insert-modify-hook - 'erc-replace-insert)))" + 'erc-replace-insert)))" (declare (doc-string 3)) (let* ((sn (symbol-name name)) - (mode (intern (format "erc-%s-mode" (downcase sn)))) - (group (intern (format "erc-%s" (downcase sn)))) - (enable (intern (format "erc-%s-enable" (downcase sn)))) - (disable (intern (format "erc-%s-disable" (downcase sn))))) + (mode (intern (format "erc-%s-mode" (downcase sn)))) + (group (intern (format "erc-%s" (downcase sn)))) + (enable (intern (format "erc-%s-enable" (downcase sn)))) + (disable (intern (format "erc-%s-disable" (downcase sn))))) `(progn (erc-define-minor-mode - ,mode - ,(format "Toggle ERC %S mode. + ,mode + ,(format "Toggle ERC %S mode. With a prefix argument ARG, enable %s if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. %s" name name doc) - nil nil nil - :global ,(not local-p) :group (quote ,group) - (if ,mode - (,enable) - (,disable))) + nil nil nil + :global ,(not local-p) :group (quote ,group) + (if ,mode + (,enable) + (,disable))) (defun ,enable () - ,(format "Enable ERC %S mode." - name) - (interactive) - (add-to-list 'erc-modules (quote ,name)) - (setq ,mode t) - ,@enable-body) + ,(format "Enable ERC %S mode." + name) + (interactive) + (add-to-list 'erc-modules (quote ,name)) + (setq ,mode t) + ,@enable-body) (defun ,disable () - ,(format "Disable ERC %S mode." - name) - (interactive) - (setq erc-modules (delq (quote ,name) erc-modules)) - (setq ,mode nil) - ,@disable-body) + ,(format "Disable ERC %S mode." + name) + (interactive) + (setq erc-modules (delq (quote ,name) erc-modules)) + (setq ,mode nil) + ,@disable-body) ,(when (and alias (not (eq name alias))) - `(defalias - (quote - ,(intern - (format "erc-%s-mode" - (downcase (symbol-name alias))))) - (quote - ,mode))) + `(defalias + (quote + ,(intern + (format "erc-%s-mode" + (downcase (symbol-name alias))))) + (quote + ,mode))) ;; For find-function and find-variable. (put ',mode 'definition-name ',name) (put ',enable 'definition-name ',name) @@ -1278,13 +1311,13 @@ capabilities." (error "You should only run `erc-once-with-server-event' in a server buffer")) (let ((fun (make-symbol "fun")) - (hook (erc-get-hook event))) + (hook (erc-get-hook event))) (put fun 'erc-original-buffer (current-buffer)) (fset fun (lambda (proc parsed) - (with-current-buffer (get fun 'erc-original-buffer) - (remove-hook hook fun t)) - (fmakunbound fun) - (funcall f proc parsed))) + (with-current-buffer (get fun 'erc-original-buffer) + (remove-hook hook fun t)) + (fmakunbound fun) + (funcall f proc parsed))) (add-hook hook fun nil t) fun)) @@ -1311,7 +1344,7 @@ the process buffer." If BUFFER is nil, the current buffer is used." (with-current-buffer (or buffer (current-buffer)) (and (eq major-mode 'erc-mode) - (null (erc-default-target))))) + (null (erc-default-target))))) (defun erc-open-server-buffer-p (&optional buffer) "Return non-nil if argument BUFFER is an ERC server buffer that @@ -1327,8 +1360,8 @@ If BUFFER is nil, the current buffer is used." (with-current-buffer (or buffer (current-buffer)) (let ((target (erc-default-target))) (and (eq major-mode 'erc-mode) - target - (not (memq (aref target 0) '(?# ?& ?+ ?!))))))) + target + (not (memq (aref target 0) '(?# ?& ?+ ?!))))))) (defun erc-ison-p (nick) "Return non-nil if NICK is online." @@ -1338,39 +1371,39 @@ If BUFFER is nil, the current buffer is used." (erc-once-with-server-event 303 (lambda (_proc parsed) - (let ((ison (split-string (aref parsed 3)))) - (setq erc-online-p (car (erc-member-ignore-case nick ison))) - t))) + (let ((ison (split-string (aref parsed 3)))) + (setq erc-online-p (car (erc-member-ignore-case nick ison))) + t))) (erc-server-send (format "ISON %s" nick)) (while (eq erc-online-p 'unknown) (accept-process-output)) (if (called-interactively-p 'interactive) - (message "%s is %sonline" - (or erc-online-p nick) - (if erc-online-p "" "not ")) - erc-online-p)))) + (message "%s is %sonline" + (or erc-online-p nick) + (if erc-online-p "" "not ")) + erc-online-p)))) (defun erc-log-aux (string) "Do the debug logging of STRING." (let ((cb (current-buffer)) - (point 1) - (was-eob nil) - (session-buffer (erc-server-buffer))) + (point 1) + (was-eob nil) + (session-buffer (erc-server-buffer))) (if session-buffer - (progn - (set-buffer session-buffer) - (if (not (and erc-dbuf (bufferp erc-dbuf) (buffer-live-p erc-dbuf))) - (progn - (setq erc-dbuf (get-buffer-create - (concat "*ERC-DEBUG: " - erc-session-server "*"))))) - (set-buffer erc-dbuf) - (setq point (point)) - (setq was-eob (eobp)) - (goto-char (point-max)) - (insert (concat "** " string "\n")) - (if was-eob (goto-char (point-max)) - (goto-char point)) - (set-buffer cb)) + (progn + (set-buffer session-buffer) + (if (not (and erc-dbuf (bufferp erc-dbuf) (buffer-live-p erc-dbuf))) + (progn + (setq erc-dbuf (get-buffer-create + (concat "*ERC-DEBUG: " + erc-session-server "*"))))) + (set-buffer erc-dbuf) + (setq point (point)) + (setq was-eob (eobp)) + (goto-char (point-max)) + (insert (concat "** " string "\n")) + (if was-eob (goto-char (point-max)) + (goto-char point)) + (set-buffer cb)) (message "ERC: ** %s" string)))) ;; Last active buffer, to print server messages in the right place @@ -1386,15 +1419,15 @@ server buffer.") Defaults to the server buffer." (erc-with-server-buffer (if (buffer-live-p erc-active-buffer) - erc-active-buffer + erc-active-buffer (setq erc-active-buffer (current-buffer))))) (defun erc-set-active-buffer (buffer) "Set the value of `erc-active-buffer' to BUFFER." (cond ((erc-server-buffer) - (with-current-buffer (erc-server-buffer) - (setq erc-active-buffer buffer))) - (t (setq erc-active-buffer buffer)))) + (with-current-buffer (erc-server-buffer) + (setq erc-active-buffer buffer))) + (t (setq erc-active-buffer buffer)))) ;; Mode activation routines @@ -1431,19 +1464,19 @@ The available choices are: any other value - in place of the current buffer." :group 'erc-buffers :type '(choice (const :tag "Split window and select" window) - (const :tag "Split window, don't select" window-noselect) - (const :tag "New frame" frame) - (const :tag "Bury in new buffer" bury) - (const :tag "Use current buffer" buffer) - (const :tag "Use current buffer" t))) + (const :tag "Split window, don't select" window-noselect) + (const :tag "New frame" frame) + (const :tag "Bury in new buffer" bury) + (const :tag "Use current buffer" buffer) + (const :tag "Use current buffer" t))) (defcustom erc-frame-alist nil "Alist of frame parameters for creating erc frames. A value of nil means to use `default-frame-alist'." :group 'erc-buffers :type '(repeat (cons :format "%v" - (symbol :tag "Parameter") - (sexp :tag "Value")))) + (symbol :tag "Parameter") + (sexp :tag "Value")))) (defcustom erc-frame-dedicated-flag nil "Non-nil means the erc frames are dedicated to that buffer. @@ -1462,11 +1495,11 @@ effect when `erc-join-buffer' is set to `frame'." (defun erc-channel-p (channel) "Return non-nil if CHANNEL seems to be an IRC channel name." (cond ((stringp channel) - (memq (aref channel 0) '(?# ?& ?+ ?!))) - ((and (bufferp channel) (buffer-live-p channel)) - (with-current-buffer channel - (erc-channel-p (erc-default-target)))) - (t nil))) + (memq (aref channel 0) '(?# ?& ?+ ?!))) + ((and (bufferp channel) (buffer-live-p channel)) + (with-current-buffer channel + (erc-channel-p (erc-default-target)))) + (t nil))) (defcustom erc-reuse-buffers t "If nil, create new buffers on joining a channel/query. @@ -1492,17 +1525,17 @@ symbol, it may have these values: (let ((port-nr (string-to-number port))) (cond ((> port-nr 0) - port-nr) + port-nr) ((string-equal port "irc") - 194) + 194) ((string-equal port "ircs") - 994) + 994) ((string-equal port "ircd") - 6667) + 6667) ((string-equal port "ircd-dalnet") - 7000) + 7000) (t - nil)))) + nil)))) ((numberp port) port) (t @@ -1557,8 +1590,8 @@ All strings are compared according to IRC protocol case rules, see (catch 'result (while list (if (string= string (erc-downcase (car list))) - (throw 'result list) - (setq list (cdr list)))))) + (throw 'result list) + (setq list (cdr list)))))) (defmacro erc-with-buffer (spec &rest body) "Execute BODY in the buffer associated with SPEC. @@ -1578,21 +1611,21 @@ See also `with-current-buffer'. \(fn (TARGET [PROCESS]) BODY...)" (declare (indent 1) (debug ((form &optional form) body))) (let ((buf (make-symbol "buf")) - (proc (make-symbol "proc")) - (target (make-symbol "target")) - (process (make-symbol "process"))) + (proc (make-symbol "proc")) + (target (make-symbol "target")) + (process (make-symbol "process"))) `(let* ((,target ,(car spec)) - (,process ,(cadr spec)) - (,buf (if (bufferp ,target) - ,target - (let ((,proc (or ,process - (and (processp erc-server-process) - erc-server-process)))) - (if (and ,target ,proc) - (erc-get-buffer ,target ,proc)))))) + (,process ,(cadr spec)) + (,buf (if (bufferp ,target) + ,target + (let ((,proc (or ,process + (and (processp erc-server-process) + erc-server-process)))) + (if (and ,target ,proc) + (erc-get-buffer ,target ,proc)))))) (when (buffer-live-p ,buf) - (with-current-buffer ,buf - ,@body))))) + (with-current-buffer ,buf + ,@body))))) (defun erc-get-buffer (target &optional proc) "Return the buffer matching TARGET in the process PROC. @@ -1601,10 +1634,10 @@ If PROC is not supplied, all processes are searched." (catch 'buffer (erc-buffer-filter (lambda () - (let ((current (erc-default-target))) - (and (stringp current) - (string-equal downcased-target (erc-downcase current)) - (throw 'buffer (current-buffer))))) + (let ((current (erc-default-target))) + (and (stringp current) + (string-equal downcased-target (erc-downcase current)) + (throw 'buffer (current-buffer))))) proc)))) (defun erc-buffer-filter (predicate &optional proc) @@ -1618,14 +1651,14 @@ server connection, or nil which means all open connections." (delq nil (mapcar (lambda (buf) - (when (buffer-live-p buf) - (with-current-buffer buf - (and (eq major-mode 'erc-mode) - (or (not proc) - (eq proc erc-server-process)) - (funcall predicate) - buf)))) - (buffer-list))))) + (when (buffer-live-p buf) + (with-current-buffer buf + (and (eq major-mode 'erc-mode) + (or (not proc) + (eq proc erc-server-process)) + (funcall predicate) + buf)))) + (buffer-list))))) (defun erc-buffer-list (&optional predicate proc) "Return a list of ERC buffers. @@ -1645,14 +1678,14 @@ nil." (declare (indent 1) (debug (form form body))) ;; Make the evaluation have the correct order (let ((pre (make-symbol "pre")) - (pro (make-symbol "pro"))) + (pro (make-symbol "pro"))) `(let* ((,pro ,process) - (,pre ,pred) - (res (mapcar (lambda (buffer) - (with-current-buffer buffer - ,@forms)) - (erc-buffer-list ,pre - ,pro)))) + (,pre ,pred) + (res (mapcar (lambda (buffer) + (with-current-buffer buffer + ,@forms)) + (erc-buffer-list ,pre + ,pro)))) ;; Silence the byte-compiler by binding the result of mapcar to ;; a variable. res))) @@ -1660,7 +1693,7 @@ nil." ;; (iswitchb-mode) will autoload iswitchb.el (defvar iswitchb-temp-buflist) (declare-function iswitchb-read-buffer "iswitchb" - (prompt &optional default require-match start matches-set)) + (prompt &optional default require-match start matches-set)) (defvar iswitchb-make-buflist-hook) (defun erc-iswitchb (&optional arg) @@ -1676,20 +1709,20 @@ needs to be active for this function to work." (let ((enabled (bound-and-true-p iswitchb-mode))) (or enabled (iswitchb-mode 1)) (unwind-protect - (let ((iswitchb-make-buflist-hook - (lambda () - (setq iswitchb-temp-buflist - (mapcar 'buffer-name - (erc-buffer-list - nil - (when arg erc-server-process))))))) - (switch-to-buffer - (iswitchb-read-buffer - "Switch-to: " - (if (boundp 'erc-modified-channels-alist) - (buffer-name (caar (last erc-modified-channels-alist))) - nil) - t))) + (let ((iswitchb-make-buflist-hook + (lambda () + (setq iswitchb-temp-buflist + (mapcar 'buffer-name + (erc-buffer-list + nil + (when arg erc-server-process))))))) + (switch-to-buffer + (iswitchb-read-buffer + "Switch-to: " + (if (boundp 'erc-modified-channels-alist) + (buffer-name (caar (last erc-modified-channels-alist))) + nil) + t))) (or enabled (iswitchb-mode -1))))) (defun erc-channel-list (proc) @@ -1699,7 +1732,7 @@ all channel buffers on all servers." (erc-buffer-filter (lambda () (and (erc-default-target) - (erc-channel-p (erc-default-target)))) + (erc-channel-p (erc-default-target)))) proc)) (defun erc-buffer-list-with-nick (nick proc) @@ -1707,8 +1740,8 @@ all channel buffers on all servers." (with-current-buffer (process-buffer proc) (let ((user (gethash (erc-downcase nick) erc-server-users))) (if user - (erc-server-user-buffers user) - nil)))) + (erc-server-user-buffers user) + nil)))) ;; Some local variables @@ -1766,31 +1799,31 @@ buffer rather than a server buffer.") (let ((transforms '((pcomplete . completion)))) (erc-delete-dups (mapcar (lambda (m) (or (cdr (assoc m transforms)) m)) - mods)))) + mods)))) (defcustom erc-modules '(netsplit fill button match track completion readonly - networks ring autojoin noncommands irccontrols - move-to-prompt stamp menu list) + networks ring autojoin noncommands irccontrols + move-to-prompt stamp menu list) "A list of modules which ERC should enable. If you set the value of this without using `customize' remember to call \(erc-update-modules) after you change it. When using `customize', modules removed from the list will be disabled." :get (lambda (sym) - ;; replace outdated names with their newer equivalents - (erc-migrate-modules (symbol-value sym))) + ;; replace outdated names with their newer equivalents + (erc-migrate-modules (symbol-value sym))) :set (lambda (sym val) - ;; disable modules which have just been removed - (when (and (boundp 'erc-modules) erc-modules val) - (dolist (module erc-modules) - (unless (member module val) - (let ((f (intern-soft (format "erc-%s-mode" module)))) - (when (and (fboundp f) (boundp f) (symbol-value f)) - (message "Disabling `erc-%s'" module) - (funcall f 0)))))) - (set sym val) - ;; this test is for the case where erc hasn't been loaded yet - (when (fboundp 'erc-update-modules) - (erc-update-modules))) + ;; disable modules which have just been removed + (when (and (boundp 'erc-modules) erc-modules val) + (dolist (module erc-modules) + (unless (member module val) + (let ((f (intern-soft (format "erc-%s-mode" module)))) + (when (and (fboundp f) (boundp f) (symbol-value f)) + (message "Disabling `erc-%s'" module) + (funcall f 0)))))) + (set sym val) + ;; this test is for the case where erc hasn't been loaded yet + (when (fboundp 'erc-update-modules) + (erc-update-modules))) :type '(set :greedy t @@ -1798,42 +1831,42 @@ removed from the list will be disabled." (const :tag "autojoin: Join channels automatically" autojoin) (const :tag "button: Buttonize URLs, nicknames, and other text" button) (const :tag "capab: Mark unidentified users on servers supporting CAPAB" - capab-identify) + capab-identify) (const :tag "completion: Complete nicknames and commands (programmable)" - completion) + completion) (const :tag "hecomplete: Complete nicknames and commands (obsolete, use \"completion\")" hecomplete) (const :tag "dcc: Provide Direct Client-to-Client support" dcc) (const :tag "fill: Wrap long lines" fill) (const :tag "identd: Launch an identd server on port 8113" identd) (const :tag "irccontrols: Highlight or remove IRC control characters" - irccontrols) + irccontrols) (const :tag "keep-place: Leave point above un-viewed text" keep-place) (const :tag "list: List channels in a separate buffer" list) (const :tag "log: Save buffers in logs" log) (const :tag "match: Highlight pals, fools, and other keywords" match) (const :tag "menu: Display a menu in ERC buffers" menu) (const :tag "move-to-prompt: Move to the prompt when typing text" - move-to-prompt) + move-to-prompt) (const :tag "netsplit: Detect netsplits" netsplit) (const :tag "networks: Provide data about IRC networks" networks) (const :tag "noncommands: Don't display non-IRC commands after evaluation" - noncommands) + noncommands) (const :tag - "notify: Notify when the online status of certain users changes" - notify) + "notify: Notify when the online status of certain users changes" + notify) (const :tag "notifications: Send notifications on PRIVMSG or nickname mentions" - notifications) + notifications) (const :tag "page: Process CTCP PAGE requests from IRC" page) (const :tag "readonly: Make displayed lines read-only" readonly) (const :tag "replace: Replace text in messages" replace) (const :tag "ring: Enable an input history" ring) (const :tag "scrolltobottom: Scroll to the bottom of the buffer" - scrolltobottom) + scrolltobottom) (const :tag "services: Identify to Nickserv (IRC Services) automatically" - services) + services) (const :tag "smiley: Convert smileys to pretty icons" smiley) (const :tag "sound: Play sounds when you receive CTCP SOUND requests" - sound) + sound) (const :tag "stamp: Add timestamps to messages" stamp) (const :tag "spelling: Check spelling" spelling) (const :tag "track: Track channel activity in the mode-line" track) @@ -1851,27 +1884,27 @@ removed from the list will be disabled." (cond ;; yuck. perhaps we should bring the filenames into sync? ((string= req "erc-capab-identify") - (setq req "erc-capab")) + (setq req "erc-capab")) ((string= req "erc-completion") - (setq req "erc-pcomplete")) + (setq req "erc-pcomplete")) ((string= req "erc-pcomplete") - (setq mod 'completion)) + (setq mod 'completion)) ((string= req "erc-autojoin") - (setq req "erc-join"))) + (setq req "erc-join"))) (condition-case nil - (require (intern req)) - (error nil)) + (require (intern req)) + (error nil)) (let ((sym (intern-soft (concat "erc-" (symbol-name mod) "-mode")))) - (if (fboundp sym) - (funcall sym 1) - (error "`%s' is not a known ERC module" mod)))))) + (if (fboundp sym) + (funcall sym 1) + (error "`%s' is not a known ERC module" mod)))))) (defun erc-setup-buffer (buffer) "Consults `erc-join-buffer' to find out how to display `BUFFER'." (pcase erc-join-buffer (`window (if (active-minibuffer-window) - (display-buffer buffer) + (display-buffer buffer) (switch-to-buffer-other-window buffer))) (`window-noselect (display-buffer buffer)) @@ -1879,21 +1912,21 @@ removed from the list will be disabled." nil) (`frame (when (or (not erc-reuse-frames) - (not (get-buffer-window buffer t))) + (not (get-buffer-window buffer t))) (let ((frame (make-frame (or erc-frame-alist - default-frame-alist)))) - (raise-frame frame) - (select-frame frame)) + default-frame-alist)))) + (raise-frame frame) + (select-frame frame)) (switch-to-buffer buffer) (when erc-frame-dedicated-flag - (set-window-dedicated-p (selected-window) t)))) + (set-window-dedicated-p (selected-window) t)))) (_ (if (active-minibuffer-window) - (display-buffer buffer) + (display-buffer buffer) (switch-to-buffer buffer))))) (defun erc-open (&optional server port nick full-name - connect passwd tgt-list channel process) + connect passwd tgt-list channel process) "Connect to SERVER on PORT as NICK with FULL-NAME. If CONNECT is non-nil, connect to the server. Otherwise assume @@ -1905,13 +1938,13 @@ non-nil, use it to initialize `erc-default-recipients'. Returns the buffer for the given server or channel." (let ((server-announced-name (when (and (boundp 'erc-session-server) - (string= server erc-session-server)) - erc-server-announced-name)) - (connected-p (unless connect erc-server-connected)) - (buffer (erc-get-buffer-create server port channel)) - (old-buffer (current-buffer)) - old-point - continued-session) + (string= server erc-session-server)) + erc-server-announced-name)) + (connected-p (unless connect erc-server-connected)) + (buffer (erc-get-buffer-create server port channel)) + (old-buffer (current-buffer)) + old-point + continued-session) (when connect (run-hook-with-args 'erc-before-connect server port nick)) (erc-update-modules) (set-buffer buffer) @@ -1930,8 +1963,8 @@ Returns the buffer for the given server or channel." (when (get-text-property (point) 'erc-prompt) (setq continued-session t) (set-marker erc-input-marker - (or (next-single-property-change (point) 'erc-prompt) - (point-max)))) + (or (next-single-property-change (point) 'erc-prompt) + (point-max)))) (unless continued-session (goto-char (point-max)) (insert "\n")) @@ -1941,14 +1974,14 @@ Returns the buffer for the given server or channel." (setq erc-server-current-nick nil) ;; Initialize erc-server-users and erc-channel-users (if connect - (progn ;; server buffer - (setq erc-server-users - (make-hash-table :test 'equal)) - (setq erc-channel-users nil)) + (progn ;; server buffer + (setq erc-server-users + (make-hash-table :test 'equal)) + (setq erc-channel-users nil)) (progn ;; target buffer - (setq erc-server-users nil) - (setq erc-channel-users - (make-hash-table :test 'equal)))) + (setq erc-server-users nil) + (setq erc-channel-users + (make-hash-table :test 'equal)))) ;; clear last incomplete line read (setq erc-server-filter-data nil) (setq erc-channel-topic "") @@ -1969,29 +2002,29 @@ Returns the buffer for the given server or channel." (setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick))) ;; password stuff (setq erc-session-password - (or passwd - (let ((secret - (plist-get - (nth 0 - (auth-source-search :host server - :max 1 - :user nick - :port port - :require '(:secret))) - :secret))) - (if (functionp secret) - (funcall secret) - secret)))) + (or passwd + (let ((secret + (plist-get + (nth 0 + (auth-source-search :host server + :max 1 + :user nick + :port port + :require '(:secret))) + :secret))) + (if (functionp secret) + (funcall secret) + secret)))) ;; debug output buffer (setq erc-dbuf - (when erc-log-p - (get-buffer-create (concat "*ERC-DEBUG: " server "*")))) + (when erc-log-p + (get-buffer-create (concat "*ERC-DEBUG: " server "*")))) ;; set up prompt (unless continued-session (goto-char (point-max)) (insert "\n")) (if continued-session - (goto-char old-point) + (goto-char old-point) (set-marker erc-insert-marker (point)) (erc-display-prompt) (goto-char (point-max))) @@ -2008,9 +2041,9 @@ Returns the buffer for the given server or channel." ;; Now display the buffer in a window as per user wishes. (unless (eq buffer old-buffer) (when erc-log-p - ;; we can't log to debug buffer, it may not exist yet - (message "erc: old buffer %s, switching to %s" - old-buffer buffer)) + ;; we can't log to debug buffer, it may not exist yet + (message "erc: old buffer %s, switching to %s" + old-buffer buffer)) (erc-setup-buffer buffer)) buffer)) @@ -2021,7 +2054,7 @@ BUFFER is the current buffer." (with-current-buffer buffer (setq erc-last-saved-position (make-marker)) (move-marker erc-last-saved-position - (1- (marker-position erc-insert-marker))))) + (1- (marker-position erc-insert-marker))))) ;; interactive startup @@ -2039,9 +2072,9 @@ If no buffer matches, return nil." (erc-buffer-list (lambda () (and (erc-server-process-alive) - (string= erc-session-server server) - (erc-port-equal erc-session-port port) - (erc-current-nick-p nick))))) + (string= erc-session-server server) + (erc-port-equal erc-session-port port) + (erc-current-nick-p nick))))) (defcustom erc-before-connect nil "Hook called before connecting to a server. @@ -2063,38 +2096,38 @@ functions in here get called with the parameters SERVER and NICK." "Prompt the user for values of nick, server, port, and password." (let (user-input server port nick passwd) (setq user-input (read-from-minibuffer - "IRC server: " - (erc-compute-server) nil nil 'erc-server-history-list)) + "IRC server: " + (erc-compute-server) nil nil 'erc-server-history-list)) (if (string-match "\\(.*\\):\\(.*\\)\\'" user-input) - (setq port (erc-string-to-port (match-string 2 user-input)) - user-input (match-string 1 user-input)) + (setq port (erc-string-to-port (match-string 2 user-input)) + user-input (match-string 1 user-input)) (setq port - (erc-string-to-port (read-from-minibuffer - "IRC port: " (erc-port-to-string - (erc-compute-port)))))) + (erc-string-to-port (read-from-minibuffer + "IRC port: " (erc-port-to-string + (erc-compute-port)))))) (if (string-match "\\`\\(.*\\)@\\(.*\\)" user-input) - (setq nick (match-string 1 user-input) - user-input (match-string 2 user-input)) + (setq nick (match-string 1 user-input) + user-input (match-string 2 user-input)) (setq nick - (if (erc-already-logged-in server port nick) - (read-from-minibuffer - (erc-format-message 'nick-in-use ?n nick) - nick - nil nil 'erc-nick-history-list) - (read-from-minibuffer - "Nickname: " (erc-compute-nick nick) - nil nil 'erc-nick-history-list)))) + (if (erc-already-logged-in server port nick) + (read-from-minibuffer + (erc-format-message 'nick-in-use ?n nick) + nick + nil nil 'erc-nick-history-list) + (read-from-minibuffer + "Nickname: " (erc-compute-nick nick) + nil nil 'erc-nick-history-list)))) (setq server user-input) (setq passwd (if erc-prompt-for-password - (if (and erc-password - (y-or-n-p "Use the default password? ")) - erc-password - (read-passwd "Password: ")) - erc-password)) + (if (and erc-password + (y-or-n-p "Use the default password? ")) + erc-password + (read-passwd "Password: ")) + erc-password)) (when (and passwd (string= "" passwd)) (setq passwd nil)) @@ -2105,17 +2138,17 @@ functions in here get called with the parameters SERVER and NICK." ;; bncs transparent, so that erc-compute-buffer-name displays ;; the server one is connected to. (setq nick (read-from-minibuffer - (erc-format-message 'nick-in-use ?n nick) - nick - nil nil 'erc-nick-history-list))) + (erc-format-message 'nick-in-use ?n nick) + nick + nil nil 'erc-nick-history-list))) (list :server server :port port :nick nick :password passwd))) ;;;###autoload (cl-defun erc (&key (server (erc-compute-server)) - (port (erc-compute-port)) - (nick (erc-compute-nick)) - password - (full-name (erc-compute-full-name))) + (port (erc-compute-port)) + (nick (erc-compute-nick)) + password + (full-name (erc-compute-full-name))) "ERC is a powerful, modular, and extensible IRC client. This function is the main entry point for ERC. @@ -2155,7 +2188,7 @@ Arguments are the same as for `erc'." The process will be given the name NAME, its target buffer will be BUFFER. HOST and PORT specify the connection target." (open-network-stream name buffer host port - :type 'tls)) + :type 'tls)) ;;; Displaying error messages @@ -2195,36 +2228,36 @@ If OUTBOUND is non-nil, STRING is being sent to the IRC server and appears in face `erc-input-face' in the buffer." (when erc-debug-irc-protocol (let ((network-name (or (ignore-errors (erc-network-name)) - "???"))) + "???"))) (with-current-buffer (get-buffer-create "*erc-protocol*") - (save-excursion - (goto-char (point-max)) - (let ((inhibit-read-only t)) - (insert (if (not outbound) - ;; Cope with the fact that string might - ;; contain multiple lines of text. - (let ((lines (delete "" (split-string string - "\n\\|\r\n"))) - (result "")) - (dolist (line lines) - (setq result (concat result network-name - " << " line "\n"))) - result) - (erc-propertize - (concat network-name " >> " string - (if (/= ?\n - (aref string - (1- (length string)))) - "\n")) - 'face 'erc-input-face))))) - (let ((orig-win (selected-window)) - (debug-buffer-window (get-buffer-window (current-buffer) t))) - (when debug-buffer-window - (select-window debug-buffer-window) - (when (= 1 (count-lines (point) (point-max))) - (goto-char (point-max)) - (recenter -1)) - (select-window orig-win))))))) + (save-excursion + (goto-char (point-max)) + (let ((inhibit-read-only t)) + (insert (if (not outbound) + ;; Cope with the fact that string might + ;; contain multiple lines of text. + (let ((lines (delete "" (split-string string + "\n\\|\r\n"))) + (result "")) + (dolist (line lines) + (setq result (concat result network-name + " << " line "\n"))) + result) + (erc-propertize + (concat network-name " >> " string + (if (/= ?\n + (aref string + (1- (length string)))) + "\n")) + 'face 'erc-input-face))))) + (let ((orig-win (selected-window)) + (debug-buffer-window (get-buffer-window (current-buffer) t))) + (when debug-buffer-window + (select-window debug-buffer-window) + (when (= 1 (count-lines (point) (point-max))) + (goto-char (point-max)) + (recenter -1)) + (select-window orig-win))))))) (defun erc-toggle-debug-irc-protocol (&optional arg) "Toggle the value of `erc-debug-irc-protocol'. @@ -2235,26 +2268,26 @@ If ARG is non-nil, show the *erc-protocol* buffer." (with-current-buffer buf (erc-view-mode-enter) (when (null (current-local-map)) - (let ((inhibit-read-only t)) - (insert (erc-make-notice "This buffer displays all IRC protocol traffic exchanged with each server.\n")) - (insert (erc-make-notice "Kill this buffer to terminate protocol logging.\n\n"))) - (use-local-map (make-sparse-keymap)) - (local-set-key (kbd "t") 'erc-toggle-debug-irc-protocol)) + (let ((inhibit-read-only t)) + (insert (erc-make-notice "This buffer displays all IRC protocol traffic exchanged with each server.\n")) + (insert (erc-make-notice "Kill this buffer to terminate protocol logging.\n\n"))) + (use-local-map (make-sparse-keymap)) + (local-set-key (kbd "t") 'erc-toggle-debug-irc-protocol)) (add-hook 'kill-buffer-hook - #'(lambda () (setq erc-debug-irc-protocol nil)) - nil 'local) + #'(lambda () (setq erc-debug-irc-protocol nil)) + nil 'local) (goto-char (point-max)) (let ((inhibit-read-only t)) - (insert (erc-make-notice - (format "IRC protocol logging %s at %s -- Press `t' to toggle logging.\n" - (if erc-debug-irc-protocol "disabled" "enabled") - (current-time-string)))))) + (insert (erc-make-notice + (format "IRC protocol logging %s at %s -- Press `t' to toggle logging.\n" + (if erc-debug-irc-protocol "disabled" "enabled") + (current-time-string)))))) (setq erc-debug-irc-protocol (not erc-debug-irc-protocol)) (if (and arg - (not (get-buffer-window "*erc-protocol*" t))) - (display-buffer buf t)) + (not (get-buffer-window "*erc-protocol*" t))) + (display-buffer buf t)) (message "IRC protocol traffic logging %s (see buffer *erc-protocol*)." - (if erc-debug-irc-protocol "enabled" "disabled")))) + (if erc-debug-irc-protocol "enabled" "disabled")))) ;;; I/O interface @@ -2293,69 +2326,69 @@ If STRING is nil, the function does nothing." (when string (with-current-buffer (or buffer (process-buffer erc-server-process)) (let ((insert-position (or (marker-position erc-insert-marker) - (point-max)))) - (let ((string string) ;; FIXME! Can this be removed? - (buffer-undo-list t) - (inhibit-read-only t)) - (unless (string-match "\n$" string) - (setq string (concat string "\n")) - (when (erc-string-invisible-p string) - (erc-put-text-properties 0 (length string) - '(invisible intangible) string))) - (erc-log (concat "erc-display-line: " string - (format "(%S)" string) " in buffer " - (format "%s" buffer))) - (setq erc-insert-this t) - (run-hook-with-args 'erc-insert-pre-hook string) - (if (null erc-insert-this) - ;; Leave erc-insert-this set to t as much as possible. Fran - ;; Litterio <franl> has seen erc-insert-this set to nil while - ;; erc-send-pre-hook is running, which should never happen. This - ;; may cure it. - (setq erc-insert-this t) - (save-excursion ;; to restore point in the new buffer - (save-restriction - (widen) - (goto-char insert-position) - (insert-before-markers string) - ;; run insertion hook, with point at restored location - (save-restriction - (narrow-to-region insert-position (point)) - (run-hooks 'erc-insert-modify-hook) - (run-hooks 'erc-insert-post-hook) - (when erc-remove-parsed-property - (remove-text-properties (point-min) (point-max) - '(erc-parsed nil)))))))) - (erc-update-undo-list (- (or (marker-position erc-insert-marker) - (point-max)) - insert-position)))))) + (point-max)))) + (let ((string string) ;; FIXME! Can this be removed? + (buffer-undo-list t) + (inhibit-read-only t)) + (unless (string-match "\n$" string) + (setq string (concat string "\n")) + (when (erc-string-invisible-p string) + (erc-put-text-properties 0 (length string) + '(invisible intangible) string))) + (erc-log (concat "erc-display-line: " string + (format "(%S)" string) " in buffer " + (format "%s" buffer))) + (setq erc-insert-this t) + (run-hook-with-args 'erc-insert-pre-hook string) + (if (null erc-insert-this) + ;; Leave erc-insert-this set to t as much as possible. Fran + ;; Litterio <franl> has seen erc-insert-this set to nil while + ;; erc-send-pre-hook is running, which should never happen. This + ;; may cure it. + (setq erc-insert-this t) + (save-excursion ;; to restore point in the new buffer + (save-restriction + (widen) + (goto-char insert-position) + (insert-before-markers string) + ;; run insertion hook, with point at restored location + (save-restriction + (narrow-to-region insert-position (point)) + (run-hooks 'erc-insert-modify-hook) + (run-hooks 'erc-insert-post-hook) + (when erc-remove-parsed-property + (remove-text-properties (point-min) (point-max) + '(erc-parsed nil)))))))) + (erc-update-undo-list (- (or (marker-position erc-insert-marker) + (point-max)) + insert-position)))))) (defun erc-update-undo-list (shift) ;; Translate buffer positions in buffer-undo-list by SHIFT. (unless (or (zerop shift) (atom buffer-undo-list)) (let ((list buffer-undo-list) elt) (while list - (setq elt (car list)) - (cond ((integerp elt) ; POSITION - (cl-incf (car list) shift)) - ((or (atom elt) ; nil, EXTENT - ;; (eq t (car elt)) ; (t . TIME) - (markerp (car elt))) ; (MARKER . DISTANCE) - nil) - ((integerp (car elt)) ; (BEGIN . END) - (cl-incf (car elt) shift) - (cl-incf (cdr elt) shift)) - ((stringp (car elt)) ; (TEXT . POSITION) - (cl-incf (cdr elt) (* (if (natnump (cdr elt)) 1 -1) shift))) - ((null (car elt)) ; (nil PROPERTY VALUE BEG . END) - (let ((cons (nthcdr 3 elt))) - (cl-incf (car cons) shift) - (cl-incf (cdr cons) shift))) - ((and (featurep 'xemacs) - (extentp (car elt))) ; (EXTENT START END) - (cl-incf (nth 1 elt) shift) - (cl-incf (nth 2 elt) shift))) - (setq list (cdr list)))))) + (setq elt (car list)) + (cond ((integerp elt) ; POSITION + (cl-incf (car list) shift)) + ((or (atom elt) ; nil, EXTENT + ;; (eq t (car elt)) ; (t . TIME) + (markerp (car elt))) ; (MARKER . DISTANCE) + nil) + ((integerp (car elt)) ; (BEGIN . END) + (cl-incf (car elt) shift) + (cl-incf (cdr elt) shift)) + ((stringp (car elt)) ; (TEXT . POSITION) + (cl-incf (cdr elt) (* (if (natnump (cdr elt)) 1 -1) shift))) + ((null (car elt)) ; (nil PROPERTY VALUE BEG . END) + (let ((cons (nthcdr 3 elt))) + (cl-incf (car cons) shift) + (cl-incf (cdr cons) shift))) + ((and (featurep 'xemacs) + (extentp (car elt))) ; (EXTENT START END) + (cl-incf (nth 1 elt) shift) + (cl-incf (nth 2 elt) shift))) + (setq list (cdr list)))))) (defvar erc-valid-nick-regexp "[]a-zA-Z^[;\\`_{}|][]^[;\\`_{}|a-zA-Z0-9-]*" "Regexp which matches all valid characters in a IRC nickname.") @@ -2376,41 +2409,41 @@ buffer is used. `erc-display-line-1' is used to display STRING. If STRING is nil, the function does nothing." (let ((inhibit-point-motion-hooks t) - new-bufs) + new-bufs) (dolist (buf (cond - ((bufferp buffer) (list buffer)) - ((listp buffer) buffer) - ((processp buffer) (list (process-buffer buffer))) - ((eq 'all buffer) - ;; Hmm, or all of the same session server? - (erc-buffer-list nil erc-server-process)) - ((and (eq 'active buffer) (erc-active-buffer)) - (list (erc-active-buffer))) - ((erc-server-buffer-live-p) - (list (process-buffer erc-server-process))) - (t (list (current-buffer))))) + ((bufferp buffer) (list buffer)) + ((listp buffer) buffer) + ((processp buffer) (list (process-buffer buffer))) + ((eq 'all buffer) + ;; Hmm, or all of the same session server? + (erc-buffer-list nil erc-server-process)) + ((and (eq 'active buffer) (erc-active-buffer)) + (list (erc-active-buffer))) + ((erc-server-buffer-live-p) + (list (process-buffer erc-server-process))) + (t (list (current-buffer))))) (when (buffer-live-p buf) - (erc-display-line-1 string buf) - (push buf new-bufs))) + (erc-display-line-1 string buf) + (push buf new-bufs))) (when (null new-bufs) (erc-display-line-1 string (if (erc-server-buffer-live-p) - (process-buffer erc-server-process) - (current-buffer)))))) + (process-buffer erc-server-process) + (current-buffer)))))) (defun erc-display-message-highlight (type string) "Highlight STRING according to TYPE, where erc-TYPE-face is an ERC face. See also `erc-make-notice'." (cond ((eq type 'notice) - (erc-make-notice string)) - (t - (erc-put-text-property - 0 (length string) - 'face (or (intern-soft - (concat "erc-" (symbol-name type) "-face")) - "erc-default-face") - string) - string))) + (erc-make-notice string)) + (t + (erc-put-text-property + 0 (length string) + 'face (or (intern-soft + (concat "erc-" (symbol-name type) "-face")) + "erc-default-face") + string) + string))) (defvar erc-lurker-state nil "Track the time of the last PRIVMSG for each (server,nick) pair. @@ -2487,15 +2520,15 @@ consumption for long-lived IRC or Emacs sessions." (lambda (server hash) (maphash (lambda (nick last-PRIVMSG-time) - (when - (> (float-time (time-subtract - (current-time) - last-PRIVMSG-time)) - erc-lurker-threshold-time) - (remhash nick hash))) + (when + (> (float-time (time-subtract + (current-time) + last-PRIVMSG-time)) + erc-lurker-threshold-time) + (remhash nick hash))) hash) (if (zerop (hash-table-count hash)) - (remhash server erc-lurker-state))) + (remhash server erc-lurker-state))) erc-lurker-state)) (defvar erc-lurker-cleanup-count 0 @@ -2535,7 +2568,7 @@ updates of `erc-lurker-state'." (erc-canonicalize-server-name erc-server-announced-name))) (when (equal command "PRIVMSG") (when (>= (cl-incf erc-lurker-cleanup-count) - erc-lurker-cleanup-interval) + erc-lurker-cleanup-interval) (setq erc-lurker-cleanup-count 0) (erc-lurker-cleanup)) (unless (gethash server erc-lurker-state) @@ -2550,14 +2583,14 @@ Lurking is the condition where NICK has issued no PRIVMSG on this server within `erc-lurker-threshold-time'. See also `erc-lurker-trim-nicks' and `erc-lurker-ignore-chars'." (unless erc-lurker-state (erc-lurker-initialize)) - (let* ((server - (erc-canonicalize-server-name erc-server-announced-name)) - (last-PRIVMSG-time - (gethash (erc-lurker-maybe-trim nick) - (gethash server erc-lurker-state (make-hash-table))))) - (or (null last-PRIVMSG-time) - (> (float-time - (time-subtract (current-time) last-PRIVMSG-time)) + (let* ((server + (erc-canonicalize-server-name erc-server-announced-name)) + (last-PRIVMSG-time + (gethash (erc-lurker-maybe-trim nick) + (gethash server erc-lurker-state (make-hash-table))))) + (or (null last-PRIVMSG-time) + (> (float-time + (time-subtract (current-time) last-PRIVMSG-time)) erc-lurker-threshold-time)))) (defcustom erc-common-server-suffixes @@ -2577,8 +2610,8 @@ otherwise `erc-server-announced-name'. SERVER is matched against `erc-common-server-suffixes'." (when server (or (cdar (erc-remove-if-not - (lambda (net) (string-match (car net) server)) - erc-common-server-suffixes)) + (lambda (net) (string-match (car net) server)) + erc-common-server-suffixes)) erc-server-announced-name))) (defun erc-hide-current-message-p (parsed) @@ -2599,27 +2632,27 @@ ARGS, PARSED, and TYPE are used to format MSG sensibly. See also `erc-format-message' and `erc-display-line'." (let ((string (if (symbolp msg) - (apply 'erc-format-message msg args) - msg))) + (apply 'erc-format-message msg args) + msg))) (setq string - (cond - ((null type) - string) - ((listp type) - (mapc (lambda (type) - (setq string - (erc-display-message-highlight type string))) - type) - string) - ((symbolp type) - (erc-display-message-highlight type string)))) + (cond + ((null type) + string) + ((listp type) + (mapc (lambda (type) + (setq string + (erc-display-message-highlight type string))) + type) + string) + ((symbolp type) + (erc-display-message-highlight type string)))) (if (not (erc-response-p parsed)) - (erc-display-line string buffer) + (erc-display-line string buffer) (unless (erc-hide-current-message-p parsed) - (erc-put-text-property 0 (length string) 'erc-parsed parsed string) - (erc-put-text-property 0 (length string) 'rear-sticky t string) - (erc-display-line string buffer))))) + (erc-put-text-property 0 (length string) 'erc-parsed parsed string) + (erc-put-text-property 0 (length string) 'rear-sticky t string) + (erc-display-line string buffer))))) (defun erc-message-type-member (position list) "Return non-nil if the erc-parsed text-property at POSITION is in LIST. @@ -2637,19 +2670,19 @@ present." See also `erc-server-send'." (setq line (format "PRIVMSG %s :%s" - target - ;; If the line is empty, we still want to - ;; send it - i.e. an empty pasted line. - (if (string= line "\n") - " \n" - line))) + target + ;; If the line is empty, we still want to + ;; send it - i.e. an empty pasted line. + (if (string= line "\n") + " \n" + line))) (erc-server-send line force target)) (defun erc-get-arglist (fun) "Return the argument list of a function without the parens." (let ((arglist (format "%S" (erc-function-arglist fun)))) (if (string-match "^(\\(.*\\))$" arglist) - (match-string 1 arglist) + (match-string 1 arglist) arglist))) (defun erc-command-no-process-p (str) @@ -2657,15 +2690,15 @@ See also `erc-server-send'." is not alive, nil otherwise." (let ((fun (erc-extract-command-from-line str))) (and fun - (symbolp (car fun)) - (get (car fun) 'process-not-needed)))) + (symbolp (car fun)) + (get (car fun) 'process-not-needed)))) (defun erc-command-name (cmd) "For CMD being the function name of a ERC command, something like erc-cmd-FOO, this returns a string /FOO." (let ((command-name (symbol-name cmd))) (if (string-match "^erc-cmd-\\(.*\\)$" command-name) - (concat "/" (match-string 1 command-name)) + (concat "/" (match-string 1 command-name)) command-name))) (defun erc-process-input-line (line &optional force no-command) @@ -2681,30 +2714,30 @@ An optional FORCE argument forces sending the line when flood protection is in effect. The optional NO-COMMAND argument prohibits this function from interpreting the line as a command." (let ((command-list (erc-extract-command-from-line line))) - (if (and command-list - (not no-command)) - (let* ((cmd (nth 0 command-list)) - (args (nth 1 command-list))) - (condition-case nil - (if (listp args) - (apply cmd args) - (funcall cmd args)) - (wrong-number-of-arguments - (erc-display-message nil 'error (current-buffer) 'incorrect-args - ?c (erc-command-name cmd) - ?u (or (erc-get-arglist cmd) - "") - ?d (format "%s\n" - (or (documentation cmd) ""))) - nil))) + (if (and command-list + (not no-command)) + (let* ((cmd (nth 0 command-list)) + (args (nth 1 command-list))) + (condition-case nil + (if (listp args) + (apply cmd args) + (funcall cmd args)) + (wrong-number-of-arguments + (erc-display-message nil 'error (current-buffer) 'incorrect-args + ?c (erc-command-name cmd) + ?u (or (erc-get-arglist cmd) + "") + ?d (format "%s\n" + (or (documentation cmd) ""))) + nil))) (let ((r (erc-default-target))) - (if r - (funcall erc-send-input-line-function r line force) - (erc-display-message nil 'error (current-buffer) 'no-target) - nil))))) + (if r + (funcall erc-send-input-line-function r line force) + (erc-display-message nil 'error (current-buffer) 'no-target) + nil))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Input commands handlers +;; Input commands handlers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun erc-cmd-AMSG (line) @@ -2712,9 +2745,9 @@ this function from interpreting the line as a command." (interactive "sSend to all channels you're on: ") (setq line (erc-trim-string line)) (erc-with-all-buffers-of-server nil - (lambda () - (erc-channel-p (erc-default-target))) - (erc-send-message line))) + (lambda () + (erc-channel-p (erc-default-target))) + (erc-send-message line))) (put 'erc-cmd-AMSG 'do-not-parse-args t) (defun erc-cmd-SAY (line) @@ -2735,35 +2768,35 @@ VALUE is computed by evaluating the rest of LINE in Lisp." (cond ((string-match "^\\s-*\\(\\S-+\\)\\s-+\\(.*\\)$" line) (let ((var (read (concat "erc-" (match-string 1 line)))) - (val (read (match-string 2 line)))) + (val (read (match-string 2 line)))) (if (boundp var) - (progn - (set var (eval val)) - (erc-display-message - nil nil 'active (format "Set %S to %S" var val)) - t) - (setq var (read (match-string 1 line))) - (if (boundp var) - (progn - (set var (eval val)) - (erc-display-message - nil nil 'active (format "Set %S to %S" var val)) - t) - (erc-display-message nil 'error 'active 'variable-not-bound) - nil)))) + (progn + (set var (eval val)) + (erc-display-message + nil nil 'active (format "Set %S to %S" var val)) + t) + (setq var (read (match-string 1 line))) + (if (boundp var) + (progn + (set var (eval val)) + (erc-display-message + nil nil 'active (format "Set %S to %S" var val)) + t) + (erc-display-message nil 'error 'active 'variable-not-bound) + nil)))) ((string-match "^\\s-*$" line) (erc-display-line (concat "Available user variables:\n" - (apply - 'concat - (mapcar - (lambda (var) - (let ((val (symbol-value var))) - (concat (format "%S:" var) - (if (consp val) - (concat "\n" (pp-to-string val)) - (format " %S\n" val))))) - (apropos-internal "^erc-" 'custom-variable-p)))) + (apply + 'concat + (mapcar + (lambda (var) + (let ((val (symbol-value var))) + (concat (format "%S:" var) + (if (consp val) + (concat "\n" (pp-to-string val)) + (format " %S\n" val))))) + (apropos-internal "^erc-" 'custom-variable-p)))) (current-buffer)) t) (t nil))) (defalias 'erc-cmd-VAR 'erc-cmd-SET) @@ -2786,42 +2819,42 @@ therefore has to contain the command itself as well." If no USER argument is specified, list the contents of `erc-ignore-list'." (if user (let ((quoted (regexp-quote user))) - (when (and (not (string= user quoted)) - (y-or-n-p (format "Use regexp-quoted form (%s) instead? " - quoted))) - (setq user quoted)) - (erc-display-line - (erc-make-notice (format "Now ignoring %s" user)) - 'active) - (erc-with-server-buffer (add-to-list 'erc-ignore-list user))) + (when (and (not (string= user quoted)) + (y-or-n-p (format "Use regexp-quoted form (%s) instead? " + quoted))) + (setq user quoted)) + (erc-display-line + (erc-make-notice (format "Now ignoring %s" user)) + 'active) + (erc-with-server-buffer (add-to-list 'erc-ignore-list user))) (if (null (erc-with-server-buffer erc-ignore-list)) - (erc-display-line (erc-make-notice "Ignore list is empty") 'active) + (erc-display-line (erc-make-notice "Ignore list is empty") 'active) (erc-display-line (erc-make-notice "Ignore list:") 'active) (mapc #'(lambda (item) - (erc-display-line (erc-make-notice item) - 'active)) - (erc-with-server-buffer erc-ignore-list)))) + (erc-display-line (erc-make-notice item) + 'active)) + (erc-with-server-buffer erc-ignore-list)))) t) (defun erc-cmd-UNIGNORE (user) "Remove the user specified in USER from the ignore list." (let ((ignored-nick (car (erc-with-server-buffer - (erc-member-ignore-case (regexp-quote user) - erc-ignore-list))))) + (erc-member-ignore-case (regexp-quote user) + erc-ignore-list))))) (unless ignored-nick (if (setq ignored-nick (erc-ignored-user-p user)) - (unless (y-or-n-p (format "Remove this regexp (%s)? " - ignored-nick)) - (setq ignored-nick nil)) - (erc-display-line - (erc-make-notice (format "%s is not currently ignored!" user)) - 'active))) + (unless (y-or-n-p (format "Remove this regexp (%s)? " + ignored-nick)) + (setq ignored-nick nil)) + (erc-display-line + (erc-make-notice (format "%s is not currently ignored!" user)) + 'active))) (when ignored-nick (erc-display-line (erc-make-notice (format "No longer ignoring %s" user)) 'active) (erc-with-server-buffer - (setq erc-ignore-list (delete ignored-nick erc-ignore-list))))) + (setq erc-ignore-list (delete ignored-nick erc-ignore-list))))) t) (defun erc-cmd-CLEAR () @@ -2835,20 +2868,20 @@ If no USER argument is specified, list the contents of `erc-ignore-list'." (interactive) (let ((ops nil)) (if erc-channel-users - (maphash (lambda (_nick user-data) - (let ((cuser (cdr user-data))) - (if (and cuser - (erc-channel-user-op cuser)) - (setq ops (cons (erc-server-user-nickname - (car user-data)) - ops))))) - erc-channel-users)) + (maphash (lambda (_nick user-data) + (let ((cuser (cdr user-data))) + (if (and cuser + (erc-channel-user-op cuser)) + (setq ops (cons (erc-server-user-nickname + (car user-data)) + ops))))) + erc-channel-users)) (setq ops (sort ops 'string-lessp)) (if ops - (erc-display-message - nil 'notice (current-buffer) 'ops - ?i (length ops) ?s (if (> (length ops) 1) "s" "") - ?o (mapconcat 'identity ops " ")) + (erc-display-message + nil 'notice (current-buffer) 'ops + ?i (length ops) ?s (if (> (length ops) 1) "s" "") + ?o (mapconcat 'identity ops " ")) (erc-display-message nil 'notice (current-buffer) 'ops-none))) t) @@ -2857,11 +2890,11 @@ If no USER argument is specified, list the contents of `erc-ignore-list'." (require 'mail-extr) (let ((co (ignore-errors (what-domain tld)))) (if co - (erc-display-message - nil 'notice 'active 'country ?c co ?d tld) + (erc-display-message + nil 'notice 'active 'country ?c co ?d tld) (erc-display-message nil 'notice 'active 'country-unknown ?d tld)) - t)) + t)) (put 'erc-cmd-COUNTRY 'process-not-needed t) (defun erc-cmd-AWAY (line) @@ -2872,8 +2905,8 @@ If no reason is given, unset away status." (erc-log (format "cmd: AWAY: %s" reason)) (erc-server-send (if (string= reason "") - "AWAY" - (concat "AWAY :" reason)))) + "AWAY" + (concat "AWAY :" reason)))) t)) (put 'erc-cmd-AWAY 'do-not-parse-args t) @@ -2891,8 +2924,8 @@ If no reason is given, unset away status." CMD is the CTCP command, possible values being ECHO, FINGER, CLIENTINFO, TIME, VERSION and so on. It is called with ARGS." (let ((str (concat cmd - (when args - (concat " " (mapconcat #'identity args " ")))))) + (when args + (concat " " (mapconcat #'identity args " ")))))) (erc-log (format "cmd: CTCP [%s]: [%s]" nick str)) (erc-send-ctcp-message nick str) t)) @@ -2915,29 +2948,29 @@ For help about the WHOIS command, do: For a list of user commands (/join /part, ...): /help." (if func - (let* ((sym (or (let ((sym (intern-soft - (concat "erc-cmd-" (upcase func))))) - (if (and sym (or (boundp sym) (fboundp sym))) - sym - nil)) - (let ((sym (intern-soft func))) - (if (and sym (or (boundp sym) (fboundp sym))) - sym - nil)) - (let ((sym (intern-soft (concat "erc-" func)))) - (if (and sym (or (boundp sym) (fboundp sym))) - sym - nil))))) - (if sym - (cond - ((boundp sym) (describe-variable sym)) - ((fboundp sym) (describe-function sym)) - (t nil)) - (apropos-command (concat "erc-.*" func) nil - (lambda (x) - (or (commandp x) - (get x 'custom-type)))) - t)) + (let* ((sym (or (let ((sym (intern-soft + (concat "erc-cmd-" (upcase func))))) + (if (and sym (or (boundp sym) (fboundp sym))) + sym + nil)) + (let ((sym (intern-soft func))) + (if (and sym (or (boundp sym) (fboundp sym))) + sym + nil)) + (let ((sym (intern-soft (concat "erc-" func)))) + (if (and sym (or (boundp sym) (fboundp sym))) + sym + nil))))) + (if sym + (cond + ((boundp sym) (describe-variable sym)) + ((fboundp sym) (describe-function sym)) + (t nil)) + (apropos-command (concat "erc-.*" func) nil + (lambda (x) + (or (commandp x) + (get x 'custom-type)))) + t)) (apropos "erc-cmd-") (message "Type C-h m to get additional information about keybindings.") t)) @@ -2951,23 +2984,23 @@ If CHANNEL is specified as \"-invite\", join the channel to which you were most recently invited. See also `invitation'." (let (chnl) (if (string= (upcase channel) "-INVITE") - (if erc-invitation - (setq chnl erc-invitation) - (erc-display-message nil 'error (current-buffer) 'no-invitation)) + (if erc-invitation + (setq chnl erc-invitation) + (erc-display-message nil 'error (current-buffer) 'no-invitation)) (setq chnl (erc-ensure-channel-name channel))) (when chnl ;; Prevent double joining of same channel on same server. (let ((joined-channels - (mapcar #'(lambda (chanbuf) - (with-current-buffer chanbuf (erc-default-target))) - (erc-channel-list erc-server-process)))) - (if (erc-member-ignore-case chnl joined-channels) - (switch-to-buffer (car (erc-member-ignore-case chnl - joined-channels))) - (erc-log (format "cmd: JOIN: %s" chnl)) - (erc-server-send (if (and chnl key) - (format "JOIN %s %s" chnl key) - (format "JOIN %s" chnl))))))) + (mapcar #'(lambda (chanbuf) + (with-current-buffer chanbuf (erc-default-target))) + (erc-channel-list erc-server-process)))) + (if (erc-member-ignore-case chnl joined-channels) + (switch-to-buffer (car (erc-member-ignore-case chnl + joined-channels))) + (erc-log (format "cmd: JOIN: %s" chnl)) + (erc-server-send (if (and chnl key) + (format "JOIN %s %s" chnl key) + (format "JOIN %s" chnl))))))) t) (defalias 'erc-cmd-CHANNEL 'erc-cmd-JOIN) @@ -2986,14 +3019,14 @@ If CHANNEL is not specified, display the users in the current channel. This function clears the channel name list first, then sends the command." (let ((tgt (or (and (erc-channel-p channel) channel) - (erc-default-target)))) + (erc-default-target)))) (if (and tgt (erc-channel-p tgt)) - (progn - (erc-log (format "cmd: DEFAULT: NAMES %s" tgt)) - (erc-with-buffer - (tgt) - (erc-channel-begin-receiving-names)) - (erc-server-send (concat "NAMES " tgt))) + (progn + (erc-log (format "cmd: DEFAULT: NAMES %s" tgt)) + (erc-with-buffer + (tgt) + (erc-channel-begin-receiving-names)) + (erc-server-send (concat "NAMES " tgt))) (erc-display-message nil 'error (current-buffer) 'no-default-channel))) t) (defalias 'erc-cmd-N 'erc-cmd-NAMES) @@ -3003,27 +3036,27 @@ command." LINE has the format: \"#CHANNEL NICK REASON\" or \"NICK REASON\"." (let ((reasonstring (mapconcat 'identity reasonwords " "))) (if (string= "" reasonstring) - (setq reasonstring (format "Kicked by %s" (erc-current-nick)))) + (setq reasonstring (format "Kicked by %s" (erc-current-nick)))) (if (erc-channel-p target) - (let ((nick reason-or-nick)) - (erc-log (format "cmd: KICK: %s/%s: %s" nick target reasonstring)) - (erc-server-send (format "KICK %s %s :%s" target nick reasonstring) - nil target) - t) + (let ((nick reason-or-nick)) + (erc-log (format "cmd: KICK: %s/%s: %s" nick target reasonstring)) + (erc-server-send (format "KICK %s %s :%s" target nick reasonstring) + nil target) + t) (when target - (let ((ch (erc-default-target))) - (setq reasonstring (concat - (if reason-or-nick (concat reason-or-nick " ")) - reasonstring)) - (if ch - (progn - (erc-log - (format "cmd: KICK: %s/%s: %s" target ch reasonstring)) - (erc-server-send - (format "KICK %s %s :%s" ch target reasonstring) nil ch)) - (erc-display-message nil 'error (current-buffer) - 'no-default-channel)) - t))))) + (let ((ch (erc-default-target))) + (setq reasonstring (concat + (if reason-or-nick (concat reason-or-nick " ")) + reasonstring)) + (if ch + (progn + (erc-log + (format "cmd: KICK: %s/%s: %s" target ch reasonstring)) + (erc-server-send + (format "KICK %s %s :%s" ch target reasonstring) nil ch)) + (erc-display-message nil 'error (current-buffer) + 'no-default-channel)) + t))))) (defvar erc-script-args nil) @@ -3038,20 +3071,20 @@ a script after exceeding the flood threshold." (cond ((string-match "^\\s-*\\(\\S-+\\)\\(.*\\)$" line) (let* ((file-to-find (match-string 1 line)) - (erc-script-args (match-string 2 line)) - (file (erc-find-file file-to-find erc-script-path))) + (erc-script-args (match-string 2 line)) + (file (erc-find-file file-to-find erc-script-path))) (erc-log (format "cmd: LOAD: %s" file-to-find)) (cond ((not file) - (erc-display-message nil 'error (current-buffer) - 'cannot-find-file ?f file-to-find)) + (erc-display-message nil 'error (current-buffer) + 'cannot-find-file ?f file-to-find)) ((not (file-readable-p file)) - (erc-display-message nil 'error (current-buffer) - 'cannot-read-file ?f file)) + (erc-display-message nil 'error (current-buffer) + 'cannot-read-file ?f file)) (t - (message "Loading \'%s\'..." file) - (erc-load-script file) - (message "Loading \'%s\'...done" file)))) + (message "Loading \'%s\'..." file) + (erc-load-script file) + (message "Loading \'%s\'...done" file)))) t) (t nil))) @@ -3061,11 +3094,11 @@ a script after exceeding the flood threshold." If SERVER is non-nil, use that, rather than the current server." ;; FIXME: is the above docstring correct? -- Lawrence 2004-01-08 (let ((send (if server - (format "WHOIS %s %s" user server) - (format "WHOIS %s" user)))) + (format "WHOIS %s %s" user server) + (format "WHOIS %s" user)))) (erc-log (format "cmd: %s" send)) (erc-server-send send) - t)) + t)) (defalias 'erc-cmd-WI 'erc-cmd-WHOIS) (defun erc-cmd-WHOAMI () @@ -3076,78 +3109,78 @@ If SERVER is non-nil, use that, rather than the current server." (defun erc-cmd-IDLE (nick) "Show the length of time NICK has been idle." (let ((origbuf (current-buffer)) - symlist) + symlist) (erc-with-server-buffer - (push (cons (erc-once-with-server-event - 311 (lambda (_proc parsed) - (string= nick - (nth 1 (erc-response.command-args - parsed))))) - 'erc-server-311-functions) - symlist) - (push (cons (erc-once-with-server-event - 312 (lambda (_proc parsed) - (string= nick - (nth 1 (erc-response.command-args - parsed))))) - 'erc-server-312-functions) - symlist) - (push (cons (erc-once-with-server-event - 318 (lambda (_proc parsed) - (string= nick - (nth 1 (erc-response.command-args - parsed))))) - 'erc-server-318-functions) - symlist) - (push (cons (erc-once-with-server-event - 319 (lambda (_proc parsed) - (string= nick - (nth 1 (erc-response.command-args - parsed))))) - 'erc-server-319-functions) - symlist) - (push (cons (erc-once-with-server-event - 320 (lambda (_proc parsed) - (string= nick - (nth 1 (erc-response.command-args - parsed))))) - 'erc-server-320-functions) - symlist) - (push (cons (erc-once-with-server-event - 330 (lambda (_proc parsed) - (string= nick - (nth 1 (erc-response.command-args - parsed))))) - 'erc-server-330-functions) - symlist) - (push (cons (erc-once-with-server-event - 317 - (lambda (_proc parsed) - (let ((idleseconds - (string-to-number - (cl-third - (erc-response.command-args parsed))))) - (erc-display-line - (erc-make-notice - (format "%s has been idle for %s." - (erc-string-no-properties nick) - (erc-seconds-to-string idleseconds))) - origbuf) - t))) - 'erc-server-317-functions) - symlist) - - ;; Send the WHOIS command. - (erc-cmd-WHOIS nick) - - ;; Remove the uninterned symbols from the server hooks that did not run. - (run-at-time 20 nil (lambda (buf symlist) - (with-current-buffer buf - (dolist (sym symlist) - (let ((hooksym (cdr sym)) - (funcsym (car sym))) - (remove-hook hooksym funcsym t))))) - (current-buffer) symlist))) + (push (cons (erc-once-with-server-event + 311 (lambda (_proc parsed) + (string= nick + (nth 1 (erc-response.command-args + parsed))))) + 'erc-server-311-functions) + symlist) + (push (cons (erc-once-with-server-event + 312 (lambda (_proc parsed) + (string= nick + (nth 1 (erc-response.command-args + parsed))))) + 'erc-server-312-functions) + symlist) + (push (cons (erc-once-with-server-event + 318 (lambda (_proc parsed) + (string= nick + (nth 1 (erc-response.command-args + parsed))))) + 'erc-server-318-functions) + symlist) + (push (cons (erc-once-with-server-event + 319 (lambda (_proc parsed) + (string= nick + (nth 1 (erc-response.command-args + parsed))))) + 'erc-server-319-functions) + symlist) + (push (cons (erc-once-with-server-event + 320 (lambda (_proc parsed) + (string= nick + (nth 1 (erc-response.command-args + parsed))))) + 'erc-server-320-functions) + symlist) + (push (cons (erc-once-with-server-event + 330 (lambda (_proc parsed) + (string= nick + (nth 1 (erc-response.command-args + parsed))))) + 'erc-server-330-functions) + symlist) + (push (cons (erc-once-with-server-event + 317 + (lambda (_proc parsed) + (let ((idleseconds + (string-to-number + (cl-third + (erc-response.command-args parsed))))) + (erc-display-line + (erc-make-notice + (format "%s has been idle for %s." + (erc-string-no-properties nick) + (erc-seconds-to-string idleseconds))) + origbuf) + t))) + 'erc-server-317-functions) + symlist) + + ;; Send the WHOIS command. + (erc-cmd-WHOIS nick) + + ;; Remove the uninterned symbols from the server hooks that did not run. + (run-at-time 20 nil (lambda (buf symlist) + (with-current-buffer buf + (dolist (sym symlist) + (let ((hooksym (cdr sym)) + (funcsym (car sym))) + (remove-hook hooksym funcsym t))))) + (current-buffer) symlist))) t) (defun erc-cmd-DESCRIBE (line) @@ -3157,7 +3190,7 @@ LINE has the format \"USER ACTION\"." ((string-match "^\\s-*\\(\\S-+\\)\\s-\\(.*\\)$" line) (let ((dst (match-string 1 line)) - (s (match-string 2 line))) + (s (match-string 2 line))) (erc-log (format "cmd: DESCRIBE: [%s] %s" dst s)) (erc-send-action dst s)) t) @@ -3203,7 +3236,7 @@ See also `erc-message' and `erc-display-line'." (erc-message "PRIVMSG" (concat (erc-default-target) " " line) force) (erc-display-line (concat (erc-format-my-nick) line) - (current-buffer)) + (current-buffer)) ;; FIXME - treat multiline, run hooks, or remove me? t) @@ -3229,7 +3262,7 @@ URL `http://freenode.net/using_the_network.shtml'." "Send a notice to the channel or user given as the first word. The rest is the message to send." (erc-message "NOTICE" (concat channel-or-user " " - (mapconcat #'identity message " ")))) + (mapconcat #'identity message " ")))) (defun erc-cmd-MSG (line) "Send a message to the channel or user given as the first word in LINE. @@ -3250,16 +3283,16 @@ The rest of LINE is the message to send." "Change current nickname to NICK." (erc-log (format "cmd: NICK: %s (erc-bad-nick: %S)" nick erc-bad-nick)) (let ((nicklen (cdr (assoc "NICKLEN" (erc-with-server-buffer - erc-server-parameters))))) + erc-server-parameters))))) (and nicklen (> (length nick) (string-to-number nicklen)) - (erc-display-message - nil 'notice 'active 'nick-too-long - ?i (length nick) ?l nicklen))) + (erc-display-message + nil 'notice 'active 'nick-too-long + ?i (length nick) ?l nicklen))) (erc-server-send (format "NICK %s" nick)) (cond (erc-bad-nick - (erc-set-current-nick nick) - (erc-update-mode-line) - (setq erc-bad-nick nil))) + (erc-set-current-nick nick) + (erc-update-mode-line) + (setq erc-bad-nick nil))) t) (defun erc-cmd-PART (line) @@ -3268,26 +3301,26 @@ Otherwise leave the channel indicated by LINE." (cond ((string-match "^\\s-*\\([&#+!]\\S-+\\)\\s-?\\(.*\\)$" line) (let* ((ch (match-string 1 line)) - (msg (match-string 2 line)) - (reason (funcall erc-part-reason (if (equal msg "") nil msg)))) + (msg (match-string 2 line)) + (reason (funcall erc-part-reason (if (equal msg "") nil msg)))) (erc-log (format "cmd: PART: %s: %s" ch reason)) (erc-server-send (if (string= reason "") - (format "PART %s" ch) - (format "PART %s :%s" ch reason)) - nil ch)) + (format "PART %s" ch) + (format "PART %s :%s" ch reason)) + nil ch)) t) ((string-match "^\\s-*\\(.*\\)$" line) (let* ((ch (erc-default-target)) - (msg (match-string 1 line)) - (reason (funcall erc-part-reason (if (equal msg "") nil msg)))) + (msg (match-string 1 line)) + (reason (funcall erc-part-reason (if (equal msg "") nil msg)))) (if (and ch (erc-channel-p ch)) - (progn - (erc-log (format "cmd: PART: %s: %s" ch reason)) - (erc-server-send (if (string= reason "") - (format "PART %s" ch) - (format "PART %s :%s" ch reason)) - nil ch)) - (erc-display-message nil 'error (current-buffer) 'no-target))) + (progn + (erc-log (format "cmd: PART: %s: %s" ch reason)) + (erc-server-send (if (string= reason "") + (format "PART %s" ch) + (format "PART %s :%s" ch reason)) + nil ch)) + (erc-display-message nil 'error (current-buffer) 'no-target))) t) (t nil))) (put 'erc-cmd-PART 'do-not-parse-args t) @@ -3322,11 +3355,11 @@ See also `erc-auto-query' to decide how private messages from other people should be displayed." :group 'erc-query :type '(choice (const :tag "Split window and select" window) - (const :tag "Split window, don't select" window-noselect) - (const :tag "New frame" frame) - (const :tag "Bury in new buffer" bury) - (const :tag "Use current buffer" buffer) - (const :tag "Use current buffer" t))) + (const :tag "Split window, don't select" window-noselect) + (const :tag "New frame" frame) + (const :tag "Bury in new buffer" bury) + (const :tag "Use current buffer" buffer) + (const :tag "Use current buffer" t))) (defun erc-cmd-QUERY (&optional user) "Open a query with USER. @@ -3338,11 +3371,11 @@ If USER is omitted, close the current query buffer if one exists (interactive (list (read-from-minibuffer "Start a query with: " nil))) (let ((session-buffer (erc-server-buffer)) - (erc-join-buffer erc-query-display)) + (erc-join-buffer erc-query-display)) (if user - (erc-query user session-buffer) + (erc-query user session-buffer) ;; currently broken, evil hack to display help anyway - ;(erc-delete-query)))) + ;(erc-delete-query)))) (signal 'wrong-number-of-arguments "")))) (defalias 'erc-cmd-Q 'erc-cmd-QUERY) @@ -3352,8 +3385,8 @@ If USER is omitted, close the current query buffer if one exists If S is non-nil, it will be used as the quit reason." (or s (format "\C-bERC\C-b %s (IRC client for Emacs)"; - \C-b%s\C-b" - erc-version-string) ; erc-official-location) - )) + erc-version-string) ; erc-official-location) + )) (defun erc-quit-reason-zippy (&optional s) "Zippy quit message. @@ -3361,8 +3394,8 @@ If S is non-nil, it will be used as the quit reason." If S is non-nil, it will be used as the quit reason." (or s (if (fboundp 'yow) - (erc-replace-regexp-in-string "\n" "" (yow)) - (erc-quit-reason-normal)))) + (erc-replace-regexp-in-string "\n" "" (yow)) + (erc-quit-reason-normal)))) (make-obsolete 'erc-quit-reason-zippy "it will be removed." "24.4") @@ -3370,7 +3403,7 @@ If S is non-nil, it will be used as the quit reason." "Choose a quit reason based on S (a string)." (when (featurep 'xemacs) (require 'poe)) (let ((res (car (assoc-default (or s "") - erc-quit-reason-various-alist 'string-match)))) + erc-quit-reason-various-alist 'string-match)))) (cond ((functionp res) (funcall res)) ((stringp res) res) @@ -3383,8 +3416,8 @@ If S is non-nil, it will be used as the quit reason." If S is non-nil, it will be used as the quit reason." (or s (format "\C-bERC\C-b %s (IRC client for Emacs)"; - \C-b%s\C-b" - erc-version-string) ; erc-official-location) - )) + erc-version-string) ; erc-official-location) + )) (defun erc-part-reason-zippy (&optional s) "Zippy part message. @@ -3392,8 +3425,8 @@ If S is non-nil, it will be used as the quit reason." If S is non-nil, it will be used as the quit reason." (or s (if (fboundp 'yow) - (erc-replace-regexp-in-string "\n" "" (yow)) - (erc-part-reason-normal)))) + (erc-replace-regexp-in-string "\n" "" (yow)) + (erc-part-reason-normal)))) (make-obsolete 'erc-part-reason-zippy "it will be removed." "24.4") @@ -3401,7 +3434,7 @@ If S is non-nil, it will be used as the quit reason." "Choose a part reason based on S (a string)." (when (featurep 'xemacs) (require 'poe)) (let ((res (car (assoc-default (or s "") - erc-part-reason-various-alist 'string-match)))) + erc-part-reason-various-alist 'string-match)))) (cond ((functionp res) (funcall res)) ((stringp res) res) @@ -3417,28 +3450,28 @@ the message given by REASON." (cond ((string-match "^\\s-*\\(.*\\)$" reason) (let* ((s (match-string 1 reason)) - (buffer (erc-server-buffer)) - (reason (funcall erc-quit-reason (if (equal s "") nil s))) - server-proc) + (buffer (erc-server-buffer)) + (reason (funcall erc-quit-reason (if (equal s "") nil s))) + server-proc) (with-current-buffer (if (and buffer - (bufferp buffer)) - buffer - (current-buffer)) - (erc-log (format "cmd: QUIT: %s" reason)) - (setq erc-server-quitting t) - (erc-set-active-buffer (erc-server-buffer)) - (setq server-proc erc-server-process) - (erc-server-send (format "QUIT :%s" reason))) + (bufferp buffer)) + buffer + (current-buffer)) + (erc-log (format "cmd: QUIT: %s" reason)) + (setq erc-server-quitting t) + (erc-set-active-buffer (erc-server-buffer)) + (setq server-proc erc-server-process) + (erc-server-send (format "QUIT :%s" reason))) (run-hook-with-args 'erc-quit-hook server-proc) (when erc-kill-queries-on-quit - (erc-kill-query-buffers server-proc)) + (erc-kill-query-buffers server-proc)) ;; if the process has not been killed within 4 seconds, kill it (run-at-time 4 nil - (lambda (proc) - (when (and (processp proc) - (memq (process-status proc) '(run open))) - (delete-process proc))) - server-proc)) + (lambda (proc) + (when (and (processp proc) + (memq (process-status proc) '(run open))) + (delete-process proc))) + server-proc)) t) (t nil))) @@ -3451,7 +3484,7 @@ the message given by REASON." (defun erc-cmd-GQUIT (reason) "Disconnect from all servers at once with the same quit REASON." (erc-with-all-buffers-of-server nil #'erc-open-server-buffer-p - (erc-cmd-QUIT reason)) + (erc-cmd-QUIT reason)) (when erc-kill-queries-on-quit ;; if the query buffers have not been killed within 4 seconds, ;; kill them @@ -3459,8 +3492,8 @@ the message given by REASON." 4 nil (lambda () (dolist (buffer (erc-buffer-list (lambda (buf) - (not (erc-server-buffer-p buf))))) - (kill-buffer buffer))))) + (not (erc-server-buffer-p buf))))) + (kill-buffer buffer))))) t) (defalias 'erc-cmd-GQ 'erc-cmd-GQUIT) @@ -3470,7 +3503,7 @@ the message given by REASON." (defun erc-cmd-RECONNECT () "Try to reconnect to the current IRC server." (let ((buffer (erc-server-buffer)) - (process nil)) + (process nil)) (unless (buffer-live-p buffer) (setq buffer (current-buffer))) (with-current-buffer buffer @@ -3479,8 +3512,8 @@ the message given by REASON." (setq erc-server-reconnect-count 0) (setq process (get-buffer-process (erc-server-buffer))) (if process - (delete-process process) - (erc-server-reconnect)) + (delete-process process) + (erc-server-reconnect)) (setq erc-server-reconnecting nil))) t) (put 'erc-cmd-RECONNECT 'process-not-needed t) @@ -3501,54 +3534,54 @@ the message given by REASON." (defun erc-cmd-SV () "Say the current ERC and Emacs version into channel." (erc-send-message (format "I'm using ERC %s with %s %s (%s%s) of %s." - erc-version-string - (if (featurep 'xemacs) "XEmacs" "GNU Emacs") - emacs-version - system-configuration - (concat - (cond ((featurep 'motif) - (concat ", " (substring - motif-version-string 4))) - ((featurep 'gtk) - (concat ", GTK+ Version " - gtk-version-string)) - ((featurep 'x-toolkit) ", X toolkit") - (t "")) - (if (and (boundp 'x-toolkit-scroll-bars) - (memq x-toolkit-scroll-bars - '(xaw xaw3d))) - (format ", %s scroll bars" - (capitalize (symbol-name - x-toolkit-scroll-bars))) - "") - (if (featurep 'multi-tty) ", multi-tty" "")) - erc-emacs-build-time)) + erc-version-string + (if (featurep 'xemacs) "XEmacs" "GNU Emacs") + emacs-version + system-configuration + (concat + (cond ((featurep 'motif) + (concat ", " (substring + motif-version-string 4))) + ((featurep 'gtk) + (concat ", GTK+ Version " + gtk-version-string)) + ((featurep 'x-toolkit) ", X toolkit") + (t "")) + (if (and (boundp 'x-toolkit-scroll-bars) + (memq x-toolkit-scroll-bars + '(xaw xaw3d))) + (format ", %s scroll bars" + (capitalize (symbol-name + x-toolkit-scroll-bars))) + "") + (if (featurep 'multi-tty) ", multi-tty" "")) + erc-emacs-build-time)) t) (defun erc-cmd-SM () "Say the current ERC modes into channel." (erc-send-message (format "I'm using the following modules: %s!" - (erc-modes))) + (erc-modes))) t) (defun erc-cmd-DEOP (&rest people) "Remove the operator setting from user(s) given in PEOPLE." (when (> (length people) 0) (erc-server-send (concat "MODE " (erc-default-target) - " -" - (make-string (length people) ?o) - " " - (mapconcat 'identity people " "))) + " -" + (make-string (length people) ?o) + " " + (mapconcat 'identity people " "))) t)) (defun erc-cmd-OP (&rest people) "Add the operator setting to users(s) given in PEOPLE." (when (> (length people) 0) (erc-server-send (concat "MODE " (erc-default-target) - " +" - (make-string (length people) ?o) - " " - (mapconcat 'identity people " "))) + " +" + (make-string (length people) ?o) + " " + (mapconcat 'identity people " "))) t)) (defun erc-cmd-TIME (&optional line) @@ -3574,7 +3607,7 @@ be displayed." ;; /topic #channel TOPIC ((string-match "^\\s-*\\([&#+!]\\S-+\\)\\s-\\(.*\\)$" topic) (let ((ch (match-string 1 topic)) - (topic (match-string 2 topic))) + (topic (match-string 2 topic))) (erc-log (format "cmd: TOPIC [%s]: %s" ch topic)) (erc-server-send (format "TOPIC %s :%s" ch topic) nil ch)) t) @@ -3591,12 +3624,12 @@ be displayed." ;; /topic TOPIC ((string-match "^\\s-*\\(.*\\)$" topic) (let ((ch (erc-default-target)) - (topic (match-string 1 topic))) + (topic (match-string 1 topic))) (if (and ch (erc-channel-p ch)) - (progn - (erc-log (format "cmd: TOPIC [%s]: %s" ch topic)) - (erc-server-send (format "TOPIC %s :%s" ch topic) nil ch)) - (erc-display-message nil 'error (current-buffer) 'no-target))) + (progn + (erc-log (format "cmd: TOPIC [%s]: %s" ch topic)) + (erc-server-send (format "TOPIC %s :%s" ch topic) nil ch)) + (erc-display-message nil 'error (current-buffer) 'no-target))) t) (t nil))) (defalias 'erc-cmd-T 'erc-cmd-TOPIC) @@ -3641,69 +3674,69 @@ or not the ban list has been requested from the server.") The ban list is fetched from the server if necessary." (let ((chnl (erc-default-target)) - (chnl-name (buffer-name))) + (chnl-name (buffer-name))) (cond ((not (erc-channel-p chnl)) (erc-display-line (erc-make-notice "You're not on a channel\n") - 'active)) + 'active)) ((not (get 'erc-channel-banlist 'received-from-server)) (let ((old-367-hook erc-server-367-functions)) - (setq erc-server-367-functions 'erc-banlist-store - erc-channel-banlist nil) - ;; fetch the ban list then callback - (erc-with-server-buffer - (erc-once-with-server-event - 368 - (lambda (_proc _parsed) - (with-current-buffer chnl-name - (put 'erc-channel-banlist 'received-from-server t) - (setq erc-server-367-functions old-367-hook) - (erc-cmd-BANLIST) - t))) - (erc-server-send (format "MODE %s b" chnl))))) + (setq erc-server-367-functions 'erc-banlist-store + erc-channel-banlist nil) + ;; fetch the ban list then callback + (erc-with-server-buffer + (erc-once-with-server-event + 368 + (lambda (_proc _parsed) + (with-current-buffer chnl-name + (put 'erc-channel-banlist 'received-from-server t) + (setq erc-server-367-functions old-367-hook) + (erc-cmd-BANLIST) + t))) + (erc-server-send (format "MODE %s b" chnl))))) ((null erc-channel-banlist) (erc-display-line (erc-make-notice - (format "No bans for channel: %s\n" chnl)) - 'active) + (format "No bans for channel: %s\n" chnl)) + 'active) (put 'erc-channel-banlist 'received-from-server nil)) (t (let* ((erc-fill-column (or (and (boundp 'erc-fill-column) - erc-fill-column) - (and (boundp 'fill-column) - fill-column) - (1- (window-width)))) - (separator (make-string erc-fill-column ?=)) - (fmt (concat - "%-" (number-to-string (/ erc-fill-column 2)) "s" - "%" (number-to-string (/ erc-fill-column 2)) "s"))) - - (erc-display-line - (erc-make-notice (format "Ban list for channel: %s\n" - (erc-default-target))) - 'active) - - (erc-display-line separator 'active) - (erc-display-line (format fmt "Ban Mask" "Banned By") 'active) - (erc-display-line separator 'active) - - (mapc - (lambda (x) - (erc-display-line - (format fmt - (truncate-string-to-width (cdr x) (/ erc-fill-column 2)) - (if (car x) - (truncate-string-to-width (car x) (/ erc-fill-column 2)) - "")) - 'active)) - erc-channel-banlist) - - (erc-display-line (erc-make-notice "End of Ban list") - 'active) - (put 'erc-channel-banlist 'received-from-server nil))))) + erc-fill-column) + (and (boundp 'fill-column) + fill-column) + (1- (window-width)))) + (separator (make-string erc-fill-column ?=)) + (fmt (concat + "%-" (number-to-string (/ erc-fill-column 2)) "s" + "%" (number-to-string (/ erc-fill-column 2)) "s"))) + + (erc-display-line + (erc-make-notice (format "Ban list for channel: %s\n" + (erc-default-target))) + 'active) + + (erc-display-line separator 'active) + (erc-display-line (format fmt "Ban Mask" "Banned By") 'active) + (erc-display-line separator 'active) + + (mapc + (lambda (x) + (erc-display-line + (format fmt + (truncate-string-to-width (cdr x) (/ erc-fill-column 2)) + (if (car x) + (truncate-string-to-width (car x) (/ erc-fill-column 2)) + "")) + 'active)) + erc-channel-banlist) + + (erc-display-line (erc-make-notice "End of Ban list") + 'active) + (put 'erc-channel-banlist 'received-from-server nil))))) t) (defalias 'erc-cmd-BL 'erc-cmd-BANLIST) @@ -3722,31 +3755,31 @@ Unban all currently banned users in the current channel." ((not (get 'erc-channel-banlist 'received-from-server)) (let ((old-367-hook erc-server-367-functions)) - (setq erc-server-367-functions 'erc-banlist-store) - ;; fetch the ban list then callback - (erc-with-server-buffer - (erc-once-with-server-event - 368 - (lambda (_proc _parsed) - (with-current-buffer chnl - (put 'erc-channel-banlist 'received-from-server t) - (setq erc-server-367-functions old-367-hook) - (erc-cmd-MASSUNBAN) - t))) - (erc-server-send (format "MODE %s b" chnl))))) + (setq erc-server-367-functions 'erc-banlist-store) + ;; fetch the ban list then callback + (erc-with-server-buffer + (erc-once-with-server-event + 368 + (lambda (_proc _parsed) + (with-current-buffer chnl + (put 'erc-channel-banlist 'received-from-server t) + (setq erc-server-367-functions old-367-hook) + (erc-cmd-MASSUNBAN) + t))) + (erc-server-send (format "MODE %s b" chnl))))) (t (let ((bans (mapcar 'cdr erc-channel-banlist))) - (when bans - ;; Glob the bans into groups of three, and carry out the unban. - ;; eg. /mode #foo -bbb a*!*@* b*!*@* c*!*@* - (mapc - (lambda (x) - (erc-server-send - (format "MODE %s -%s %s" (erc-default-target) - (make-string (length x) ?b) - (mapconcat 'identity x " ")))) - (erc-group-list bans 3)))) - t)))) + (when bans + ;; Glob the bans into groups of three, and carry out the unban. + ;; eg. /mode #foo -bbb a*!*@* b*!*@* c*!*@* + (mapc + (lambda (x) + (erc-server-send + (format "MODE %s -%s %s" (erc-default-target) + (make-string (length x) ?b) + (mapconcat 'identity x " ")))) + (erc-group-list bans 3)))) + t)))) (defalias 'erc-cmd-MUB 'erc-cmd-MASSUNBAN) @@ -3770,12 +3803,12 @@ text again." (erc-set-active-buffer (current-buffer)) (save-excursion (let* ((cb (current-buffer)) - (buf (generate-new-buffer erc-grab-buffer-name)) - (region (buffer-substring start end)) - (lines (erc-split-multiline-safe region))) + (buf (generate-new-buffer erc-grab-buffer-name)) + (region (buffer-substring start end)) + (lines (erc-split-multiline-safe region))) (set-buffer buf) (dolist (line lines) - (insert (concat line "\n"))) + (insert (concat line "\n"))) (set-buffer cb) (switch-to-buffer-other-window buf))) (message "erc-grab-region doesn't grab colors etc. anymore. If you use this, please tell the maintainers.") @@ -3791,8 +3824,8 @@ If POS is nil, PROMPT will be displayed at `point'. If FACE is non-nil, it will be used to propertize the prompt. If it is nil, `erc-prompt-face' will be used." (let* ((prompt (or prompt (erc-prompt))) - (l (length prompt)) - (ob (current-buffer))) + (l (length prompt)) + (ob (current-buffer))) ;; We cannot use save-excursion because we move point, therefore ;; we resort to the ol' ob trick to restore this. (when (and buffer (bufferp buffer)) @@ -3804,20 +3837,20 @@ If FACE is non-nil, it will be used to propertize the prompt. If it is nil, (setq pos (or pos (point))) (goto-char pos) (when (> l 0) - ;; Do not extend the text properties when typing at the end - ;; of the prompt, but stuff typed in front of the prompt - ;; shall remain part of the prompt. - (setq prompt (erc-propertize prompt - 'start-open t ; XEmacs - 'rear-nonsticky t ; Emacs - 'erc-prompt t - 'field t - 'front-sticky t - 'read-only t)) - (erc-put-text-property 0 (1- (length prompt)) - 'face (or face 'erc-prompt-face) - prompt) - (insert prompt)) + ;; Do not extend the text properties when typing at the end + ;; of the prompt, but stuff typed in front of the prompt + ;; shall remain part of the prompt. + (setq prompt (erc-propertize prompt + 'start-open t ; XEmacs + 'rear-nonsticky t ; Emacs + 'erc-prompt t + 'field t + 'front-sticky t + 'read-only t)) + (erc-put-text-property 0 (1- (length prompt)) + 'face (or face 'erc-prompt-face) + prompt) + (insert prompt)) ;; Set the input marker (set-marker erc-input-marker (point))) @@ -3837,11 +3870,11 @@ If FACE is non-nil, it will be used to propertize the prompt. If it is nil, "Read input from the minibuffer." (interactive) (let ((minibuffer-allow-text-properties t) - (read-map minibuffer-local-map)) + (read-map minibuffer-local-map)) (insert (read-from-minibuffer "Message: " - (string (if (featurep 'xemacs) - last-command-char - last-command-event)) read-map)) + (string (if (featurep 'xemacs) + last-command-char + last-command-event)) read-map)) (erc-send-current-line))) (defvar erc-action-history-list () @@ -3852,9 +3885,9 @@ If FACE is non-nil, it will be used to propertize the prompt. If it is nil, (interactive "") (erc-set-active-buffer (current-buffer)) (let ((action (read-from-minibuffer - "Action: " nil nil nil 'erc-action-history-list))) + "Action: " nil nil nil 'erc-action-history-list))) (if (not (string-match "^\\s-*$" action)) - (erc-send-action (erc-default-target) action)))) + (erc-send-action (erc-default-target) action)))) (defun erc-join-channel (channel &optional key) "Join CHANNEL. @@ -3863,9 +3896,9 @@ If `point' is at the beginning of a channel name, use that as default." (interactive (list (let ((chnl (if (looking-at "\\([&#+!][^ \n]+\\)") (match-string 1) "")) - (table (when (erc-server-buffer-live-p) - (set-buffer (process-buffer erc-server-process)) - erc-channel-list))) + (table (when (erc-server-buffer-live-p) + (set-buffer (process-buffer erc-server-process)) + erc-channel-list))) (completing-read "Join channel: " table nil nil nil nil chnl)) (when (or current-prefix-arg erc-prompt-for-channel-key) (read-from-minibuffer "Channel key (RET for none): " nil)))) @@ -3876,9 +3909,9 @@ If `point' is at the beginning of a channel name, use that as default." (interactive (list (if (and (boundp 'reason) (stringp reason) (not (string= reason ""))) - reason + reason (read-from-minibuffer (concat "Reason for leaving " (erc-default-target) - ": "))))) + ": "))))) (erc-cmd-PART (concat (erc-default-target)" " reason))) (defun erc-set-topic (topic) @@ -3889,8 +3922,8 @@ If `point' is at the beginning of a channel name, use that as default." (concat "Set topic of " (erc-default-target) ": ") (when erc-channel-topic (let ((ss (split-string erc-channel-topic "\C-o"))) - (cons (apply 'concat (if (cdr ss) (butlast ss) ss)) - 0)))))) + (cons (apply 'concat (if (cdr ss) (butlast ss) ss)) + 0)))))) (let ((topic-list (split-string topic "\C-o"))) ; strip off the topic setter (erc-cmd-TOPIC (concat (erc-default-target) " " (car topic-list))))) @@ -3898,31 +3931,31 @@ If `point' is at the beginning of a channel name, use that as default." "Set a LIMIT for the current channel. Remove limit if nil. Prompt for one if called interactively." (interactive (list (read-from-minibuffer - (format "Limit for %s (RET to remove limit): " - (erc-default-target))))) + (format "Limit for %s (RET to remove limit): " + (erc-default-target))))) (let ((tgt (erc-default-target))) (erc-server-send (if (and limit (>= (length limit) 1)) - (format "MODE %s +l %s" tgt limit) - (format "MODE %s -l" tgt))))) + (format "MODE %s +l %s" tgt limit) + (format "MODE %s -l" tgt))))) (defun erc-set-channel-key (&optional key) "Set a KEY for the current channel. Remove key if nil. Prompt for one if called interactively." (interactive (list (read-from-minibuffer - (format "Key for %s (RET to remove key): " - (erc-default-target))))) + (format "Key for %s (RET to remove key): " + (erc-default-target))))) (let ((tgt (erc-default-target))) (erc-server-send (if (and key (>= (length key) 1)) - (format "MODE %s +k %s" tgt key) - (format "MODE %s -k" tgt))))) + (format "MODE %s +k %s" tgt key) + (format "MODE %s -k" tgt))))) (defun erc-quit-server (reason) "Disconnect from current server after prompting for REASON. `erc-quit-reason' works with this just like with `erc-cmd-QUIT'." (interactive (list (read-from-minibuffer - (format "Reason for quitting %s: " - (or erc-server-announced-name - erc-session-server))))) + (format "Reason for quitting %s: " + (or erc-server-announced-name + erc-session-server))))) (erc-cmd-QUIT reason)) ;; Movement of point @@ -3941,10 +3974,10 @@ This places `point' just after the prompt, or at the beginning of the line." "Kill current input line using `erc-bol' followed by `kill-line'." (interactive) (when (and (erc-bol) - (/= (point) (point-max))) ;; Prevent a (ding) and an error when - ;; there's nothing to kill + (/= (point) (point-max))) ;; Prevent a (ding) and an error when + ;; there's nothing to kill (if (boundp 'erc-input-ring-index) - (setq erc-input-ring-index nil)) + (setq erc-input-ring-index nil)) (kill-line))) (defun erc-complete-word-at-point () @@ -3954,7 +3987,7 @@ This places `point' just after the prompt, or at the beginning of the line." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; -;; IRC SERVER INPUT HANDLING +;; IRC SERVER INPUT HANDLING ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -3964,7 +3997,7 @@ This places `point' just after the prompt, or at the beginning of the line." ; experiment area. (defcustom erc-default-server-hook '(erc-debug-missing-hooks - erc-default-server-handler) + erc-default-server-handler) "Default for server messages which aren't covered by `erc-server-hooks'." :group 'erc-server-hooks :type 'hook) @@ -3979,9 +4012,9 @@ Displays PROC and PARSED appropriately using `erc-display-message'." 'identity (let (res) (mapc #'(lambda (x) - (if (stringp x) - (setq res (append res (list x))))) - parsed) + (if (stringp x) + (setq res (append res (list x))))) + parsed) res) " "))) @@ -4003,18 +4036,18 @@ See `erc-default-server-hook'." To change how this query window is displayed, use `let' to bind `erc-join-buffer' before calling this." (unless (and server - (buffer-live-p server) - (set-buffer server)) + (buffer-live-p server) + (set-buffer server)) (error "Couldn't switch to server buffer")) (let ((buf (erc-open erc-session-server - erc-session-port - (erc-current-nick) - erc-session-user-full-name - nil - nil - (list target) - target - erc-server-process))) + erc-session-port + (erc-current-nick) + erc-session-user-full-name + nil + nil + (list target) + target + erc-server-process))) (unless buf (error "Couldn't open query window")) (erc-update-mode-line) @@ -4030,12 +4063,12 @@ a new window, but not to select it. See the documentation for `erc-join-buffer' for a description of the available choices." :group 'erc-query :type '(choice (const :tag "Don't create query window" nil) - (const :tag "Split window and select" window) - (const :tag "Split window, don't select" window-noselect) - (const :tag "New frame" frame) - (const :tag "Bury in new buffer" bury) - (const :tag "Use current buffer" buffer) - (const :tag "Use current buffer" t))) + (const :tag "Split window and select" window) + (const :tag "Split window, don't select" window-noselect) + (const :tag "New frame" frame) + (const :tag "Bury in new buffer" bury) + (const :tag "Use current buffer" buffer) + (const :tag "Use current buffer" t))) (defcustom erc-query-on-unjoined-chan-privmsg t "If non-nil create query buffer on receiving any PRIVMSG at all. @@ -4069,15 +4102,15 @@ unmodified if nothing can be removed. E.g. \"Read error to Nick [user@some.host]: 110\" would be shortened to \"Read error: 110\". The same applies for \"Ping Timeout\"." (setq nick (regexp-quote nick) - login (regexp-quote login) - host (regexp-quote host)) + login (regexp-quote login) + host (regexp-quote host)) (or (when (string-match (concat "^\\(Read error\\) to " - nick "\\[" host "\\]: " - "\\(.+\\)$") reason) - (concat (match-string 1 reason) ": " (match-string 2 reason))) + nick "\\[" host "\\]: " + "\\(.+\\)$") reason) + (concat (match-string 1 reason) ": " (match-string 2 reason))) (when (string-match (concat "^\\(Ping timeout\\) for " - nick "\\[" host "\\]$") reason) - (match-string 1 reason)) + nick "\\[" host "\\]$") reason) + (match-string 1 reason)) reason)) (defun erc-nickname-in-use (nick reason) @@ -4085,40 +4118,40 @@ E.g. \"Read error to Nick [user@some.host]: 110\" would be shortened to See also `erc-display-error-notice'." (if (or (not erc-try-new-nick-p) - ;; how many default-nicks are left + one more try... - (eq erc-nick-change-attempt-count - (if (consp erc-nick) - (+ (length erc-nick) 1) - 1))) + ;; how many default-nicks are left + one more try... + (eq erc-nick-change-attempt-count + (if (consp erc-nick) + (+ (length erc-nick) 1) + 1))) (erc-display-error-notice nil (format "Nickname %s is %s, try another." nick reason)) (setq erc-nick-change-attempt-count (+ erc-nick-change-attempt-count 1)) (let ((newnick (nth 1 erc-default-nicks)) - (nicklen (cdr (assoc "NICKLEN" - (erc-with-server-buffer - erc-server-parameters))))) + (nicklen (cdr (assoc "NICKLEN" + (erc-with-server-buffer + erc-server-parameters))))) (setq erc-bad-nick t) ;; try to use a different nick (if erc-default-nicks - (setq erc-default-nicks (cdr erc-default-nicks))) + (setq erc-default-nicks (cdr erc-default-nicks))) (if (not newnick) - (setq newnick (concat (truncate-string-to-width - nick - (if (and erc-server-connected nicklen) - (- (string-to-number nicklen) - (length erc-nick-uniquifier)) - ;; rfc2812 max nick length = 9 - ;; we must assume this is the - ;; server's setting if we haven't - ;; established a connection yet - (- 9 (length erc-nick-uniquifier)))) - erc-nick-uniquifier))) + (setq newnick (concat (truncate-string-to-width + nick + (if (and erc-server-connected nicklen) + (- (string-to-number nicklen) + (length erc-nick-uniquifier)) + ;; rfc2812 max nick length = 9 + ;; we must assume this is the + ;; server's setting if we haven't + ;; established a connection yet + (- 9 (length erc-nick-uniquifier)))) + erc-nick-uniquifier))) (erc-cmd-NICK newnick) (erc-display-error-notice nil (format "Nickname %s is %s, trying %s" - nick reason newnick))))) + nick reason newnick))))) ;;; Server messages @@ -4142,21 +4175,21 @@ and as second argument the event parsed as a vector." "Put this on `erc-server-PRIVMSG-functions'." (when erc-auto-query (let* ((nick (car (erc-parse-user (erc-response.sender parsed)))) - (target (car (erc-response.command-args parsed))) - (msg (erc-response.contents parsed)) - (query (if (not erc-query-on-unjoined-chan-privmsg) - nick - (if (erc-current-nick-p target) - nick - target)))) + (target (car (erc-response.command-args parsed))) + (msg (erc-response.contents parsed)) + (query (if (not erc-query-on-unjoined-chan-privmsg) + nick + (if (erc-current-nick-p target) + nick + target)))) (and (not (erc-ignored-user-p (erc-response.sender parsed))) - (or erc-query-on-unjoined-chan-privmsg - (string= target (erc-current-nick))) - (not (erc-get-buffer query proc)) - (not (erc-is-message-ctcp-and-not-action-p msg)) - (let ((erc-query-display erc-auto-query)) - (erc-cmd-QUERY query)) - nil)))) + (or erc-query-on-unjoined-chan-privmsg + (string= target (erc-current-nick))) + (not (erc-get-buffer query proc)) + (not (erc-is-message-ctcp-and-not-action-p msg)) + (let ((erc-query-display erc-auto-query)) + (erc-cmd-QUERY query)) + nil)))) (defun erc-is-message-ctcp-p (message) "Check if MESSAGE is a CTCP message or not." @@ -4170,16 +4203,16 @@ and as second argument the event parsed as a vector." (defun erc-format-privmessage (nick msg privp msgp) "Format a PRIVMSG in an insertable fashion." (let* ((mark-s (if msgp (if privp "*" "<") "-")) - (mark-e (if msgp (if privp "*" ">") "-")) - (str (format "%s%s%s %s" mark-s nick mark-e msg)) - (nick-face (if privp 'erc-nick-msg-face 'erc-nick-default-face)) - (msg-face (if privp 'erc-direct-msg-face 'erc-default-face))) + (mark-e (if msgp (if privp "*" ">") "-")) + (str (format "%s%s%s %s" mark-s nick mark-e msg)) + (nick-face (if privp 'erc-nick-msg-face 'erc-nick-default-face)) + (msg-face (if privp 'erc-direct-msg-face 'erc-default-face))) ;; add text properties to text before the nick, the nick and after the nick (erc-put-text-property 0 (length mark-s) 'face msg-face str) (erc-put-text-property (length mark-s) (+ (length mark-s) (length nick)) - 'face nick-face str) + 'face nick-face str) (erc-put-text-property (+ (length mark-s) (length nick)) (length str) - 'face msg-face str) + 'face msg-face str) str)) (defcustom erc-format-nick-function 'erc-format-nick @@ -4190,28 +4223,49 @@ and as second argument the event parsed as a vector." (defun erc-format-nick (&optional user _channel-data) "Return the nickname of USER. See also `erc-format-nick-function'." - (when user (erc-server-user-nickname user))) + (let ((nick (erc-server-user-nickname user))) + (concat (erc-propertize + (erc-get-user-mode-prefix nick) + 'face 'erc-nick-prefix-face) nick))) + +(defun erc-get-user-mode-prefix (user) + (when user + (cond ((erc-channel-user-owner-p user) + (erc-propertize "~" 'help-echo "owner")) + ((erc-channel-user-admin-p user) + (erc-propertize "&" 'help-echo "admin")) + ((erc-channel-user-op-p user) + (erc-propertize "@" 'help-echo "operator")) + ((erc-channel-user-halfop-p user) + (erc-propertize "%" 'help-echo "half-op")) + ((erc-channel-user-voice-p user) + (erc-propertize "+" 'help-echo "voice")) + (t "")))) (defun erc-format-@nick (&optional user channel-data) - "Format the nickname of USER showing if USER is an operator or has voice. -Operators have \"@\" and users with voice have \"+\" as a prefix. -Use CHANNEL-DATA to determine op and voice status. -See also `erc-format-nick-function'." + "Format the nickname of USER showing if USER has a voice, is an +operator, half-op, admin or owner. Owners have \"~\", admins have +\"&\", operators have \"@\" and users with voice have \"+\" as a +prefix. Use CHANNEL-DATA to determine op and voice status. See +also `erc-format-nick-function'." (when user - (let ((op (and channel-data (erc-channel-user-op channel-data) "@")) - (voice (and channel-data (erc-channel-user-voice channel-data) "+"))) - (concat voice op (erc-server-user-nickname user))))) + (let ((nick (erc-server-user-nickname user))) + (concat (erc-propertize + (erc-get-user-mode-prefix nick) + 'face 'erc-nick-prefix-face) nick nick)))) (defun erc-format-my-nick () "Return the beginning of this user's message, correctly propertized." (if erc-show-my-nick - (let ((open "<") - (close "> ") - (nick (erc-current-nick))) - (concat - (erc-propertize open 'face 'erc-default-face) - (erc-propertize nick 'face 'erc-my-nick-face) - (erc-propertize close 'face 'erc-default-face))) + (let* ((open "<") + (close "> ") + (nick (erc-current-nick)) + (mode (erc-get-user-mode-prefix nick))) + (concat + (erc-propertize open 'face 'erc-default-face) + (erc-propertize mode 'face 'erc-my-nick-prefix-face) + (erc-propertize nick 'face 'erc-my-nick-face) + (erc-propertize close 'face 'erc-default-face))) (let ((prefix "> ")) (erc-propertize prefix 'face 'erc-default-face)))) @@ -4275,7 +4329,7 @@ See also: `erc-echo-notice-in-first-user-buffer', `erc-buffer-list-with-nick'." (let ((buffers (erc-buffer-list-with-nick sender erc-server-process))) (if buffers - (progn (erc-display-message parsed nil buffers s) t) + (progn (erc-display-message parsed nil buffers s) t) nil))) (defun erc-echo-notice-in-user-and-target-buffers (s parsed buffer sender) @@ -4290,8 +4344,8 @@ See also: `erc-echo-notice-in-user-buffers', `erc-buffer-list-with-nick'." (let ((buffers (erc-buffer-list-with-nick sender erc-server-process))) (unless (memq buffer buffers) (push buffer buffers)) - (if buffers ;FIXME: How could it be nil? - (progn (erc-display-message parsed nil buffers s) t) + (if buffers ;FIXME: How could it be nil? + (progn (erc-display-message parsed nil buffers s) t) nil))) (defun erc-echo-notice-in-first-user-buffer (s parsed _buffer sender) @@ -4305,7 +4359,7 @@ See also: `erc-echo-notice-in-user-buffers', `erc-buffer-list-with-nick'." (let ((buffers (erc-buffer-list-with-nick sender erc-server-process))) (if buffers - (progn (erc-display-message parsed nil (car buffers) s) t) + (progn (erc-display-message parsed nil (car buffers) s) t) nil))) ;;; Ban manipulation @@ -4313,61 +4367,61 @@ See also: `erc-echo-notice-in-user-buffers', (defun erc-banlist-store (proc parsed) "Record ban entries for a channel." (pcase-let ((`(,channel ,mask ,whoset) - (cdr (erc-response.command-args parsed)))) + (cdr (erc-response.command-args parsed)))) ;; Determine to which buffer the message corresponds (let ((buffer (erc-get-buffer channel proc))) (with-current-buffer buffer - (unless (member (cons whoset mask) erc-channel-banlist) - (setq erc-channel-banlist (cons (cons whoset mask) - erc-channel-banlist)))))) + (unless (member (cons whoset mask) erc-channel-banlist) + (setq erc-channel-banlist (cons (cons whoset mask) + erc-channel-banlist)))))) nil) (defun erc-banlist-finished (proc parsed) "Record that we have received the banlist." (let* ((channel (nth 1 (erc-response.command-args parsed))) - (buffer (erc-get-buffer channel proc))) + (buffer (erc-get-buffer channel proc))) (with-current-buffer buffer (put 'erc-channel-banlist 'received-from-server t))) - t) ; suppress the 'end of banlist' message + t) ; suppress the 'end of banlist' message (defun erc-banlist-update (proc parsed) "Check MODE commands for bans and update the banlist appropriately." ;; FIXME: Possibly incorrect. -- Lawrence 2004-05-11 (let* ((tgt (car (erc-response.command-args parsed))) - (mode (erc-response.contents parsed)) - (whoset (erc-response.sender parsed)) - (buffer (erc-get-buffer tgt proc))) + (mode (erc-response.contents parsed)) + (whoset (erc-response.sender parsed)) + (buffer (erc-get-buffer tgt proc))) (when buffer (with-current-buffer buffer - (cond ((not (get 'erc-channel-banlist 'received-from-server)) nil) - ((string-match "^\\([+-]\\)b" mode) - ;; This is a ban - (cond - ((string-match "^-" mode) - ;; Remove the unbanned masks from the ban list - (setq erc-channel-banlist - (erc-delete-if - #'(lambda (y) - (member (upcase (cdr y)) - (mapcar #'upcase - (cdr (split-string mode))))) - erc-channel-banlist))) - ((string-match "^+" mode) - ;; Add the banned mask(s) to the ban list - (mapc - (lambda (mask) - (unless (member (cons whoset mask) erc-channel-banlist) - (setq erc-channel-banlist - (cons (cons whoset mask) erc-channel-banlist)))) - (cdr (split-string mode)))))))))) + (cond ((not (get 'erc-channel-banlist 'received-from-server)) nil) + ((string-match "^\\([+-]\\)b" mode) + ;; This is a ban + (cond + ((string-match "^-" mode) + ;; Remove the unbanned masks from the ban list + (setq erc-channel-banlist + (erc-delete-if + #'(lambda (y) + (member (upcase (cdr y)) + (mapcar #'upcase + (cdr (split-string mode))))) + erc-channel-banlist))) + ((string-match "^+" mode) + ;; Add the banned mask(s) to the ban list + (mapc + (lambda (mask) + (unless (member (cons whoset mask) erc-channel-banlist) + (setq erc-channel-banlist + (cons (cons whoset mask) erc-channel-banlist)))) + (cdr (split-string mode)))))))))) nil) ;; used for the banlist cmds (defun erc-group-list (list n) "Group LIST into sublists of length N." (cond ((null list) nil) - ((null (nthcdr n list)) (list list)) - (t (cons (erc-subseq list 0 n) (erc-group-list (nthcdr n list) n))))) + ((null (nthcdr n list)) (list list)) + (t (cons (erc-subseq list 0 n) (erc-group-list (nthcdr n list) n))))) ;;; MOTD numreplies @@ -4380,7 +4434,7 @@ See also: `erc-echo-notice-in-user-buffers', ;; execute a startup script (let ((f (erc-select-startup-file))) (when f - (erc-load-script f))))) + (erc-load-script f))))) (defun erc-connection-established (proc parsed) "Run just after connection. @@ -4389,14 +4443,14 @@ Set user modes and run `erc-after-connect' hook." (with-current-buffer (process-buffer proc) (unless erc-server-connected ; only once per session (let ((server (or erc-server-announced-name - (erc-response.sender parsed))) - (nick (car (erc-response.command-args parsed))) - (buffer (process-buffer proc))) - (setq erc-server-connected t) - (erc-update-mode-line) - (erc-set-initial-user-mode nick buffer) - (erc-server-setup-periodical-ping buffer) - (run-hook-with-args 'erc-after-connect server nick))))) + (erc-response.sender parsed))) + (nick (car (erc-response.command-args parsed))) + (buffer (process-buffer proc))) + (setq erc-server-connected t) + (erc-update-mode-line) + (erc-set-initial-user-mode nick buffer) + (erc-server-setup-periodical-ping buffer) + (run-hook-with-args 'erc-after-connect server nick))))) (defun erc-set-initial-user-mode (nick buffer) "If `erc-user-mode' is non-nil for NICK, set the user modes. @@ -4404,11 +4458,11 @@ The server buffer is given by BUFFER." (with-current-buffer buffer (when erc-user-mode (let ((mode (if (functionp erc-user-mode) - (funcall erc-user-mode) - erc-user-mode))) - (when (stringp mode) - (erc-log (format "changing mode for %s to %s" nick mode)) - (erc-server-send (format "MODE %s %s" nick mode))))))) + (funcall erc-user-mode) + erc-user-mode))) + (when (stringp mode) + (erc-log (format "changing mode for %s to %s" nick mode)) + (erc-server-send (format "MODE %s %s" nick mode))))))) (defun erc-display-error-notice (parsed string) "Display STRING as an error notice. @@ -4421,41 +4475,41 @@ See also `erc-display-message'." ;; FIXME: This needs a proper docstring -- Lawrence 2004-01-08 "Process a CTCP query." (let ((queries (delete "" (split-string (erc-response.contents parsed) - "\C-a")))) + "\C-a")))) (if (> (length queries) 4) - (erc-display-message - parsed (list 'notice 'error) proc 'ctcp-too-many) + (erc-display-message + parsed (list 'notice 'error) proc 'ctcp-too-many) (if (= 0 (length queries)) - (erc-display-message - parsed (list 'notice 'error) proc - 'ctcp-empty ?n nick) - (while queries - (let* ((type (upcase (car (split-string (car queries))))) - (hook (intern-soft (concat "erc-ctcp-query-" type "-hook")))) - (if (and hook (boundp hook)) - (if (string-equal type "ACTION") - (run-hook-with-args-until-success - hook proc parsed nick login host - (car (erc-response.command-args parsed)) - (car queries)) - (when erc-paranoid - (if (erc-current-nick-p - (car (erc-response.command-args parsed))) - (erc-display-message - parsed 'error 'active 'ctcp-request - ?n nick ?u login ?h host ?r (car queries)) - (erc-display-message - parsed 'error 'active 'ctcp-request-to - ?n nick ?u login ?h host ?r (car queries) - ?t (car (erc-response.command-args parsed))))) - (run-hook-with-args-until-success - hook proc nick login host - (car (erc-response.command-args parsed)) - (car queries))) - (erc-display-message - parsed (list 'notice 'error) proc - 'undefined-ctcp))) - (setq queries (cdr queries))))))) + (erc-display-message + parsed (list 'notice 'error) proc + 'ctcp-empty ?n nick) + (while queries + (let* ((type (upcase (car (split-string (car queries))))) + (hook (intern-soft (concat "erc-ctcp-query-" type "-hook")))) + (if (and hook (boundp hook)) + (if (string-equal type "ACTION") + (run-hook-with-args-until-success + hook proc parsed nick login host + (car (erc-response.command-args parsed)) + (car queries)) + (when erc-paranoid + (if (erc-current-nick-p + (car (erc-response.command-args parsed))) + (erc-display-message + parsed 'error 'active 'ctcp-request + ?n nick ?u login ?h host ?r (car queries)) + (erc-display-message + parsed 'error 'active 'ctcp-request-to + ?n nick ?u login ?h host ?r (car queries) + ?t (car (erc-response.command-args parsed))))) + (run-hook-with-args-until-success + hook proc nick login host + (car (erc-response.command-args parsed)) + (car queries))) + (erc-display-message + parsed (list 'notice 'error) proc + 'undefined-ctcp))) + (setq queries (cdr queries))))))) (defvar erc-ctcp-query-ACTION-hook '(erc-ctcp-query-ACTION)) @@ -4463,9 +4517,9 @@ See also `erc-display-message'." "Respond to a CTCP ACTION query." (when (string-match "^ACTION\\s-\\(.*\\)\\s-*$" msg) (let ((s (match-string 1 msg)) - (buf (or (erc-get-buffer to proc) - (erc-get-buffer nick proc) - (process-buffer proc)))) + (buf (or (erc-get-buffer to proc) + (erc-get-buffer nick proc) + (process-buffer proc)))) (erc-display-message parsed 'action buf 'ACTION ?n nick ?u login ?h host ?a s)))) @@ -4477,7 +4531,7 @@ See also `erc-display-message'." (when (string-match "^CLIENTINFO\\(\\s-*\\|\\s-+.*\\)$" msg) (let ((s (erc-client-info (erc-trim-string (match-string 1 msg))))) (unless erc-disable-ctcp-replies - (erc-send-ctcp-notice nick (format "CLIENTINFO %s" s))))) + (erc-send-ctcp-notice nick (format "CLIENTINFO %s" s))))) nil) (defvar erc-ctcp-query-ECHO-hook '(erc-ctcp-query-ECHO)) @@ -4486,7 +4540,7 @@ See also `erc-display-message'." (when (string-match "^ECHO\\s-+\\(.*\\)\\s-*$" msg) (let ((s (match-string 1 msg))) (unless erc-disable-ctcp-replies - (erc-send-ctcp-notice nick (format "ECHO %s" s))))) + (erc-send-ctcp-notice nick (format "ECHO %s" s))))) nil) (defvar erc-ctcp-query-FINGER-hook '(erc-ctcp-query-FINGER)) @@ -4494,15 +4548,15 @@ See also `erc-display-message'." "Respond to a CTCP FINGER query." (unless erc-disable-ctcp-replies (let ((s (if erc-anonymous-login - (format "FINGER I'm %s." (erc-current-nick)) - (format "FINGER %s (%s@%s)." - (user-full-name) - (user-login-name) - (system-name)))) - (ns (erc-time-diff erc-server-last-sent-time (erc-current-time)))) - (when (> ns 0) - (setq s (concat s " Idle for " (erc-sec-to-time ns)))) - (erc-send-ctcp-notice nick s))) + (format "FINGER I'm %s." (erc-current-nick)) + (format "FINGER %s (%s@%s)." + (user-full-name) + (user-login-name) + (system-name)))) + (ns (erc-time-diff erc-server-last-sent-time (erc-current-time)))) + (when (> ns 0) + (setq s (concat s " Idle for " (erc-sec-to-time ns)))) + (erc-send-ctcp-notice nick s))) nil) (defvar erc-ctcp-query-PING-hook '(erc-ctcp-query-PING)) @@ -4511,7 +4565,7 @@ See also `erc-display-message'." (when (string-match "^PING\\s-+\\(.*\\)" msg) (unless erc-disable-ctcp-replies (let ((arg (match-string 1 msg))) - (erc-send-ctcp-notice nick (format "PING %s" arg))))) + (erc-send-ctcp-notice nick (format "PING %s" arg))))) nil) (defvar erc-ctcp-query-TIME-hook '(erc-ctcp-query-TIME)) @@ -4534,19 +4588,19 @@ See also `erc-display-message'." (unless erc-disable-ctcp-replies (erc-send-ctcp-notice nick (format - "VERSION \C-bERC\C-b %s - an IRC client for emacs (\C-b%s\C-b)" - erc-version-string - erc-official-location))) + "VERSION \C-bERC\C-b %s - an IRC client for emacs (\C-b%s\C-b)" + erc-version-string + erc-official-location))) nil) (defun erc-process-ctcp-reply (proc parsed nick login host msg) "Process MSG as a CTCP reply." (let* ((type (car (split-string msg))) - (hook (intern (concat "erc-ctcp-reply-" type "-hook")))) + (hook (intern (concat "erc-ctcp-reply-" type "-hook")))) (if (boundp hook) - (run-hook-with-args-until-success - hook proc nick login host - (car (erc-response.command-args parsed)) msg) + (run-hook-with-args-until-success + hook proc nick login host + (car (erc-response.command-args parsed)) msg) (erc-display-message parsed 'notice 'active 'CTCP-UNKNOWN ?n nick ?u login ?h host ?m msg)))) @@ -4588,16 +4642,16 @@ See also `erc-display-message'." nil (let ((time (match-string 1 msg))) (condition-case nil - (let ((delta (erc-time-diff (string-to-number time) - (erc-current-time)))) - (erc-display-message - nil 'notice 'active - 'CTCP-PING ?n nick - ?t (erc-sec-to-time delta))) - (range-error - (erc-display-message - nil 'error 'active - 'bad-ping-response ?n nick ?t time)))))) + (let ((delta (erc-time-diff (string-to-number time) + (erc-current-time)))) + (erc-display-message + nil 'notice 'active + 'CTCP-PING ?n nick + ?t (erc-sec-to-time delta))) + (range-error + (erc-display-message + nil 'error 'active + 'bad-ping-response ?n nick ?t time)))))) (defvar erc-ctcp-reply-TIME-hook '(erc-ctcp-reply-TIME)) (defun erc-ctcp-reply-TIME (_proc nick _login _host _to msg) @@ -4627,31 +4681,31 @@ If non-nil, return from being away." (let ((sessionbuf (process-buffer proc))) (when sessionbuf (with-current-buffer sessionbuf - (when erc-away-nickname - (erc-log (format "erc-process-away: away-nick: %s, away-p: %s" - erc-away-nickname away-p)) - (erc-cmd-NICK (if away-p - erc-away-nickname - erc-nick))) - (cond - (away-p - (setq erc-away (current-time))) - (t - (let ((away-time erc-away)) - ;; away must be set to NIL BEFORE sending anything to prevent - ;; an infinite recursion - (setq erc-away nil) - (with-current-buffer (erc-active-buffer) - (when erc-public-away-p - (erc-send-action - (erc-default-target) - (if away-time - (format "is back (gone for %s)" - (erc-sec-to-time - (erc-time-diff - (erc-emacs-time-to-erc-time away-time) - (erc-current-time)))) - "is back"))))))))) + (when erc-away-nickname + (erc-log (format "erc-process-away: away-nick: %s, away-p: %s" + erc-away-nickname away-p)) + (erc-cmd-NICK (if away-p + erc-away-nickname + erc-nick))) + (cond + (away-p + (setq erc-away (current-time))) + (t + (let ((away-time erc-away)) + ;; away must be set to NIL BEFORE sending anything to prevent + ;; an infinite recursion + (setq erc-away nil) + (with-current-buffer (erc-active-buffer) + (when erc-public-away-p + (erc-send-action + (erc-default-target) + (if away-time + (format "is back (gone for %s)" + (erc-sec-to-time + (erc-time-diff + (erc-emacs-time-to-erc-time away-time) + (erc-current-time)))) + "is back"))))))))) (erc-update-mode-line))) ;;;; List of channel members handling @@ -4674,30 +4728,30 @@ channel buffer. See also `erc-channel-begin-receiving-names'." (maphash (lambda (nick _user) - (if (null (gethash nick erc-channel-new-member-names)) - (erc-remove-channel-user nick))) - erc-channel-users) + (if (null (gethash nick erc-channel-new-member-names)) + (erc-remove-channel-user nick))) + erc-channel-users) (setq erc-channel-new-member-names nil)) (defun erc-parse-prefix () "Return an alist of valid prefix character types and their representations. Example: (operator) o => @, (voiced) v => +." (let ((str (or (cdr (assoc "PREFIX" (erc-with-server-buffer - erc-server-parameters))) - ;; provide a sane default - "(ov)@+")) - types chars) + erc-server-parameters))) + ;; provide a sane default + "(qaohv)~&@%+")) + types chars) (when (string-match "^(\\([^)]+\\))\\(.+\\)$" str) (setq types (match-string 1 str) - chars (match-string 2 str)) + chars (match-string 2 str)) (let ((len (min (length types) (length chars))) - (i 0) - (alist nil)) - (while (< i len) - (setq alist (cons (cons (elt types i) (elt chars i)) - alist)) - (setq i (1+ i))) - alist)))) + (i 0) + (alist nil)) + (while (< i len) + (setq alist (cons (cons (elt types i) (elt chars i)) + alist)) + (setq i (1+ i))) + alist)))) (defun erc-channel-receive-names (names-string) "This function is for internal use only. @@ -4705,40 +4759,45 @@ Example: (operator) o => @, (voiced) v => +." Update `erc-channel-users' according to NAMES-STRING. NAMES-STRING is a string listing some of the names on the channel." - (let (prefix op-ch voice-ch names name op voice) - (setq prefix (erc-parse-prefix)) - (setq op-ch (cdr (assq ?o prefix)) - voice-ch (cdr (assq ?v prefix))) - ;; We need to delete "" because in XEmacs, (split-string "a ") - ;; returns ("a" ""). + (let* ((prefix (erc-parse-prefix)) + (voice-ch (cdr (assq ?v prefix))) + (op-ch (cdr (assq ?o prefix))) + (hop-ch (cdr (assq ?h prefix))) + (adm-ch (cdr (assq ?a prefix))) + (own-ch (cdr (assq ?q prefix))) + names name op voice halfop admin owner) (setq names (delete "" (split-string names-string))) (let ((erc-channel-members-changed-hook nil)) (dolist (item names) - (let ((updatep t)) - (if (rassq (elt item 0) prefix) - (cond ((= (length item) 1) - (setq updatep nil)) - ((eq (elt item 0) op-ch) - (setq name (substring item 1) - op 'on - voice 'off)) - ((eq (elt item 0) voice-ch) - (setq name (substring item 1) - op 'off - voice 'on)) - (t (setq name (substring item 1) - op 'off - voice 'off))) - (setq name item - op 'off - voice 'off)) - (when updatep - (puthash (erc-downcase name) t - erc-channel-new-member-names) - (erc-update-current-channel-member - name name t op voice))))) + (let ((updatep t)) + (setq name item op 'off voice 'off halfop 'off admin 'off owner 'off) + (if (rassq (elt item 0) prefix) + (cond ((= (length item) 1) + (setq updatep nil)) + ((eq (elt item 0) voice-ch) + (setq name (substring item 1) + voice 'on)) + ((eq (elt item 0) hop-ch) + (setq name (substring item 1) + halfop 'on)) + ((eq (elt item 0) op-ch) + (setq name (substring item 1) + op 'on)) + ((eq (elt item 0) adm-ch) + (setq name (substring item 1) + admin 'on)) + ((eq (elt item 0) own-ch) + (setq name (substring item 1) + owner 'on)) + (t (setq name (substring item 1))))) + (when updatep + (puthash (erc-downcase name) t + erc-channel-new-member-names) + (erc-update-current-channel-member + name name t voice halfop op admin owner))))) (run-hooks 'erc-channel-members-changed-hook))) + (defcustom erc-channel-members-changed-hook nil "This hook is called every time the variable `channel-members' changes. The buffer where the change happened is current while this hook is called." @@ -4746,15 +4805,15 @@ The buffer where the change happened is current while this hook is called." :type 'hook) (defun erc-update-user-nick (nick &optional new-nick - host login full-name info) + host login full-name info) "Update the stored user information for the user with nickname NICK. See also: `erc-update-user'." (erc-update-user (erc-get-server-user nick) new-nick - host login full-name info)) + host login full-name info)) (defun erc-update-user (user &optional new-nick - host login full-name info) + host login full-name info) "Update user info for USER. USER must be an erc-server-user struct. Any of NEW-NICK, HOST, LOGIN, FULL-NAME, INFO which are non-nil and not equal to the existing values for USER are used to @@ -4766,45 +4825,44 @@ which USER is a member, and t is returned." (let (changed) (when user (when (and new-nick - (not (equal (erc-server-user-nickname user) - new-nick))) - (setq changed t) - (erc-change-user-nickname user new-nick)) + (not (equal (erc-server-user-nickname user) + new-nick))) + (setq changed t) + (erc-change-user-nickname user new-nick)) (when (and host - (not (equal (erc-server-user-host user) host))) - (setq changed t) - (setf (erc-server-user-host user) host)) + (not (equal (erc-server-user-host user) host))) + (setq changed t) + (setf (erc-server-user-host user) host)) (when (and login - (not (equal (erc-server-user-login user) login))) - (setq changed t) - (setf (erc-server-user-login user) login)) + (not (equal (erc-server-user-login user) login))) + (setq changed t) + (setf (erc-server-user-login user) login)) (when (and full-name - (not (equal (erc-server-user-full-name user) - full-name))) - (setq changed t) - (setf (erc-server-user-full-name user) full-name)) + (not (equal (erc-server-user-full-name user) + full-name))) + (setq changed t) + (setf (erc-server-user-full-name user) full-name)) (when (and info - (not (equal (erc-server-user-info user) info))) - (setq changed t) - (setf (erc-server-user-info user) info)) + (not (equal (erc-server-user-info user) info))) + (setq changed t) + (setf (erc-server-user-info user) info)) (if changed - (dolist (buf (erc-server-user-buffers user)) - (if (buffer-live-p buf) - (with-current-buffer buf - (run-hooks 'erc-channel-members-changed-hook)))))) + (dolist (buf (erc-server-user-buffers user)) + (if (buffer-live-p buf) + (with-current-buffer buf + (run-hooks 'erc-channel-members-changed-hook)))))) changed)) (defun erc-update-current-channel-member - (nick new-nick &optional add op voice host login full-name info - update-message-time) + (nick new-nick &optional add voice halfop op admin owner host login full-name info + update-message-time) "Update the stored user information for the user with nickname NICK. `erc-update-user' is called to handle changes to nickname, -HOST, LOGIN, FULL-NAME, and INFO. If OP or VOICE are non-nil, -they must be equal to either `on' or `off', in which case the -operator or voice status of the user in the current channel is -changed accordingly. If UPDATE-MESSAGE-TIME is non-nil, the -last-message-time of the user in the current channel is set -to (current-time). +HOST, LOGIN, FULL-NAME, and INFO. If VOICE HALFOP OP ADMIN or OWNER +are non-nil, they must be equal to either `on' or `off', in which +case the status of the user in the current channel is changed accordingly. +If UPDATE-MESSAGE-TIME is non-nil, the last-message-time of the user + in the current channel is set to (current-time). If ADD is non-nil, the user will be added with the specified information if it is not already present in the user or channel @@ -4815,74 +4873,104 @@ If, and only if, changes are made, or the user is added, See also: `erc-update-user' and `erc-update-channel-member'." (let* (changed user-changed - (channel-data (erc-get-channel-user nick)) - (cuser (cdr channel-data)) - (user (if channel-data (car channel-data) - (erc-get-server-user nick)))) + (channel-data (erc-get-channel-user nick)) + (cuser (cdr channel-data)) + (user (if channel-data (car channel-data) + (erc-get-server-user nick)))) (if cuser - (progn - (erc-log (format "update-member: user = %S, cuser = %S" user cuser)) - (when (and op - (not (eq (erc-channel-user-op cuser) op))) - (setq changed t) - (setf (erc-channel-user-op cuser) - (cond ((eq op 'on) t) - ((eq op 'off) nil) - (t op)))) - (when (and voice - (not (eq (erc-channel-user-voice cuser) voice))) - (setq changed t) - (setf (erc-channel-user-voice cuser) - (cond ((eq voice 'on) t) - ((eq voice 'off) nil) - (t voice)))) - (when update-message-time - (setf (erc-channel-user-last-message-time cuser) (current-time))) - (setq user-changed - (erc-update-user user new-nick - host login full-name info))) + (progn + (erc-log (format "update-member: user = %S, cuser = %S" user cuser)) + (when (and voice + (not (eq (erc-channel-user-voice cuser) voice))) + (setq changed t) + (setf (erc-channel-user-voice cuser) + (cond ((eq voice 'on) t) + ((eq voice 'off) nil) + (t voice)))) + (when (and halfop + (not (eq (erc-channel-user-halfop cuser) halfop))) + (setq changed t) + (setf (erc-channel-user-halfop cuser) + (cond ((eq halfop 'on) t) + ((eq halfop 'off) nil) + (t halfop)))) + (when (and op + (not (eq (erc-channel-user-op cuser) op))) + (setq changed t) + (setf (erc-channel-user-op cuser) + (cond ((eq op 'on) t) + ((eq op 'off) nil) + (t op)))) + (when (and admin + (not (eq (erc-channel-user-admin cuser) admin))) + (setq changed t) + (setf (erc-channel-user-admin cuser) + (cond ((eq admin 'on) t) + ((eq admin 'off) nil) + (t admin)))) + (when (and owner + (not (eq (erc-channel-user-owner cuser) owner))) + (setq changed t) + (setf (erc-channel-user-owner cuser) + (cond ((eq owner 'on) t) + ((eq owner 'off) nil) + (t owner)))) + (when update-message-time + (setf (erc-channel-user-last-message-time cuser) (current-time))) + (setq user-changed + (erc-update-user user new-nick + host login full-name info))) (when add - (if (null user) - (progn - (setq user (make-erc-server-user - :nickname nick - :host host - :full-name full-name - :login login - :info info - :buffers (list (current-buffer)))) - (erc-add-server-user nick user)) - (setf (erc-server-user-buffers user) - (cons (current-buffer) - (erc-server-user-buffers user)))) - (setq cuser (make-erc-channel-user - :op (cond ((eq op 'on) t) - ((eq op 'off) nil) - (t op)) - :voice (cond ((eq voice 'on) t) - ((eq voice 'off) nil) - (t voice)) - :last-message-time - (if update-message-time (current-time)))) - (puthash (erc-downcase nick) (cons user cuser) - erc-channel-users) - (setq changed t))) + (if (null user) + (progn + (setq user (make-erc-server-user + :nickname nick + :host host + :full-name full-name + :login login + :info info + :buffers (list (current-buffer)))) + (erc-add-server-user nick user)) + (setf (erc-server-user-buffers user) + (cons (current-buffer) + (erc-server-user-buffers user)))) + (setq cuser (make-erc-channel-user + :voice (cond ((eq voice 'on) t) + ((eq voice 'off) nil) + (t voice)) + :halfop (cond ((eq halfop 'on) t) + ((eq halfop 'off) nil) + (t halfop)) + :op (cond ((eq op 'on) t) + ((eq op 'off) nil) + (t op)) + :admin (cond ((eq admin 'on) t) + ((eq admin 'off) nil) + (t admin)) + :owner (cond ((eq owner 'on) t) + ((eq owner 'off) nil) + (t owner)) + :last-message-time + (if update-message-time (current-time)))) + (puthash (erc-downcase nick) (cons user cuser) + erc-channel-users) + (setq changed t))) (when (and changed (null user-changed)) (run-hooks 'erc-channel-members-changed-hook)) (or changed user-changed add))) (defun erc-update-channel-member (channel nick new-nick - &optional add op voice host login - full-name info update-message-time) + &optional add voice halfop op admin owner host login + full-name info update-message-time) "Update user and channel information for the user with nickname NICK in channel CHANNEL. See also: `erc-update-current-channel-member'." (erc-with-buffer - (channel) - (erc-update-current-channel-member nick new-nick add op voice host - login full-name info - update-message-time))) + (channel) + (erc-update-current-channel-member nick new-nick add voice halfop op admin owner host + login full-name info + update-message-time))) (defun erc-remove-current-channel-member (nick) "Remove NICK from current channel membership list. @@ -4897,8 +4985,8 @@ Runs `erc-channel-members-changed-hook'." See also `erc-remove-current-channel-member'." (erc-with-buffer - (channel) - (erc-remove-current-channel-member nick))) + (channel) + (erc-remove-current-channel-member nick))) (defun erc-update-channel-topic (channel topic &optional modify) "Find a buffer for CHANNEL and set the TOPIC for it. @@ -4907,40 +4995,40 @@ If optional MODIFY is 'append or 'prepend, then append or prepend the TOPIC string to the current topic." (erc-with-buffer (channel) (cond ((eq modify 'append) - (setq erc-channel-topic (concat erc-channel-topic topic))) - ((eq modify 'prepend) - (setq erc-channel-topic (concat topic erc-channel-topic))) - (t (setq erc-channel-topic topic))) + (setq erc-channel-topic (concat erc-channel-topic topic))) + ((eq modify 'prepend) + (setq erc-channel-topic (concat topic erc-channel-topic))) + (t (setq erc-channel-topic topic))) (erc-update-mode-line-buffer (current-buffer)))) (defun erc-set-modes (tgt mode-string) "Set the modes for the TGT provided as MODE-STRING." (let* ((modes (erc-parse-modes mode-string)) - (add-modes (nth 0 modes)) - ;; list of triples: (mode-char 'on/'off argument) - (arg-modes (nth 2 modes))) + (add-modes (nth 0 modes)) + ;; list of triples: (mode-char 'on/'off argument) + (arg-modes (nth 2 modes))) (cond ((erc-channel-p tgt); channel modes - (let ((buf (and erc-server-process - (erc-get-buffer tgt erc-server-process)))) - (when buf - (with-current-buffer buf - (setq erc-channel-modes add-modes) - (setq erc-channel-user-limit nil) - (setq erc-channel-key nil) - (while arg-modes - (let ((mode (nth 0 (car arg-modes))) - (onoff (nth 1 (car arg-modes))) - (arg (nth 2 (car arg-modes)))) - (cond ((string-match "^[Ll]" mode) - (erc-update-channel-limit tgt onoff arg)) - ((string-match "^[Kk]" mode) - (erc-update-channel-key tgt onoff arg)) - (t nil))) - (setq arg-modes (cdr arg-modes))) - (erc-update-mode-line-buffer buf))))) - ;; we do not keep our nick's modes yet - ;;(t (setq erc-user-modes add-modes)) - ) + (let ((buf (and erc-server-process + (erc-get-buffer tgt erc-server-process)))) + (when buf + (with-current-buffer buf + (setq erc-channel-modes add-modes) + (setq erc-channel-user-limit nil) + (setq erc-channel-key nil) + (while arg-modes + (let ((mode (nth 0 (car arg-modes))) + (onoff (nth 1 (car arg-modes))) + (arg (nth 2 (car arg-modes)))) + (cond ((string-match "^[Ll]" mode) + (erc-update-channel-limit tgt onoff arg)) + ((string-match "^[Kk]" mode) + (erc-update-channel-key tgt onoff arg)) + (t nil))) + (setq arg-modes (cdr arg-modes))) + (erc-update-mode-line-buffer buf))))) + ;; we do not keep our nick's modes yet + ;;(t (setq erc-user-modes add-modes)) + ) )) (defun erc-sort-strings (list-of-strings) @@ -4963,42 +5051,42 @@ arg-modes is a list of triples of the form: (MODE-CHAR ON/OFF ARGUMENT)." (if (string-match "^\\s-*\\(\\S-+\\)\\(\\s-.*$\\|$\\)" mode-string) (let ((chars (mapcar 'char-to-string (match-string 1 mode-string))) - ;; arguments in channel modes - (args-str (match-string 2 mode-string)) - (args nil) - (add-modes nil) - (remove-modes nil) - (arg-modes nil); list of triples: (mode-char 'on/'off argument) - (add-p t)) - ;; make the argument list - (while (string-match "^\\s-*\\(\\S-+\\)\\(\\s-+.*$\\|$\\)" args-str) - (setq args (cons (match-string 1 args-str) args)) - (setq args-str (match-string 2 args-str))) - (setq args (nreverse args)) - ;; collect what modes changed, and match them with arguments - (while chars - (cond ((string= (car chars) "+") (setq add-p t)) - ((string= (car chars) "-") (setq add-p nil)) - ((string-match "^[ovbOVB]" (car chars)) - (setq arg-modes (cons (list (car chars) - (if add-p 'on 'off) - (if args (car args) nil)) - arg-modes)) - (if args (setq args (cdr args)))) - ((string-match "^[LlKk]" (car chars)) - (setq arg-modes (cons (list (car chars) - (if add-p 'on 'off) - (if (and add-p args) - (car args) nil)) - arg-modes)) - (if (and add-p args) (setq args (cdr args)))) - (add-p (setq add-modes (cons (car chars) add-modes))) - (t (setq remove-modes (cons (car chars) remove-modes)))) - (setq chars (cdr chars))) - (setq add-modes (nreverse add-modes)) - (setq remove-modes (nreverse remove-modes)) - (setq arg-modes (nreverse arg-modes)) - (list add-modes remove-modes arg-modes)) + ;; arguments in channel modes + (args-str (match-string 2 mode-string)) + (args nil) + (add-modes nil) + (remove-modes nil) + (arg-modes nil); list of triples: (mode-char 'on/'off argument) + (add-p t)) + ;; make the argument list + (while (string-match "^\\s-*\\(\\S-+\\)\\(\\s-+.*$\\|$\\)" args-str) + (setq args (cons (match-string 1 args-str) args)) + (setq args-str (match-string 2 args-str))) + (setq args (nreverse args)) + ;; collect what modes changed, and match them with arguments + (while chars + (cond ((string= (car chars) "+") (setq add-p t)) + ((string= (car chars) "-") (setq add-p nil)) + ((string-match "^[qaovhbQAOVHB]" (car chars)) + (setq arg-modes (cons (list (car chars) + (if add-p 'on 'off) + (if args (car args) nil)) + arg-modes)) + (if args (setq args (cdr args)))) + ((string-match "^[LlKk]" (car chars)) + (setq arg-modes (cons (list (car chars) + (if add-p 'on 'off) + (if (and add-p args) + (car args) nil)) + arg-modes)) + (if (and add-p args) (setq args (cdr args)))) + (add-p (setq add-modes (cons (car chars) add-modes))) + (t (setq remove-modes (cons (car chars) remove-modes)))) + (setq chars (cdr chars))) + (setq add-modes (nreverse add-modes)) + (setq remove-modes (nreverse remove-modes)) + (setq arg-modes (nreverse arg-modes)) + (list add-modes remove-modes arg-modes)) nil)) (defun erc-update-modes (tgt mode-string &optional nick host login) @@ -5007,65 +5095,70 @@ Optional arguments: NICK, HOST and LOGIN - the attributes of the person who changed the modes." ;; FIXME: neither of nick, host, and login are used! (let* ((modes (erc-parse-modes mode-string)) - (add-modes (nth 0 modes)) - (remove-modes (nth 1 modes)) - ;; list of triples: (mode-char 'on/'off argument) - (arg-modes (nth 2 modes))) + (add-modes (nth 0 modes)) + (remove-modes (nth 1 modes)) + ;; list of triples: (mode-char 'on/'off argument) + (arg-modes (nth 2 modes))) ;; now parse the modes changes and do the updates (cond ((erc-channel-p tgt); channel modes - (let ((buf (and erc-server-process - (erc-get-buffer tgt erc-server-process)))) - (when buf - ;; FIXME! This used to have an original buffer - ;; variable, but it never switched back to the original - ;; buffer. Is this wanted behavior? - (set-buffer buf) - (if (not (boundp 'erc-channel-modes)) - (setq erc-channel-modes nil)) - (while remove-modes - (setq erc-channel-modes (delete (car remove-modes) - erc-channel-modes) - remove-modes (cdr remove-modes))) - (while add-modes - (setq erc-channel-modes (cons (car add-modes) - erc-channel-modes) - add-modes (cdr add-modes))) - (setq erc-channel-modes (erc-sort-strings erc-channel-modes)) - (while arg-modes - (let ((mode (nth 0 (car arg-modes))) - (onoff (nth 1 (car arg-modes))) - (arg (nth 2 (car arg-modes)))) - (cond ((string-match "^[oO]" mode) - (erc-update-channel-member tgt arg arg nil onoff)) - ((string-match "^[Vv]" mode) - (erc-update-channel-member tgt arg arg nil nil - onoff)) - ((string-match "^[Ll]" mode) - (erc-update-channel-limit tgt onoff arg)) - ((string-match "^[Kk]" mode) - (erc-update-channel-key tgt onoff arg)) - (t nil)); only ops are tracked now - (setq arg-modes (cdr arg-modes)))) - (erc-update-mode-line buf)))) - ;; nick modes - ignored at this point - (t nil)))) + (let ((buf (and erc-server-process + (erc-get-buffer tgt erc-server-process)))) + (when buf + ;; FIXME! This used to have an original buffer + ;; variable, but it never switched back to the original + ;; buffer. Is this wanted behavior? + (set-buffer buf) + (if (not (boundp 'erc-channel-modes)) + (setq erc-channel-modes nil)) + (while remove-modes + (setq erc-channel-modes (delete (car remove-modes) + erc-channel-modes) + remove-modes (cdr remove-modes))) + (while add-modes + (setq erc-channel-modes (cons (car add-modes) + erc-channel-modes) + add-modes (cdr add-modes))) + (setq erc-channel-modes (erc-sort-strings erc-channel-modes)) + (while arg-modes + (let ((mode (nth 0 (car arg-modes))) + (onoff (nth 1 (car arg-modes))) + (arg (nth 2 (car arg-modes)))) + (cond ((string-match "^[Vv]" mode) + (erc-update-channel-member tgt arg arg nil onoff)) + ((string-match "^[hH]" mode) + (erc-update-channel-member tgt arg arg nil nil onoff)) + ((string-match "^[oO]" mode) + (erc-update-channel-member tgt arg arg nil nil nil onoff)) + ((string-match "^[aA]" mode) + (erc-update-channel-member tgt arg arg nil nil nil nil onoff)) + ((string-match "^[qQ]" mode) + (erc-update-channel-member tgt arg arg nil nil nil nil nil onoff)) + ((string-match "^[Ll]" mode) + (erc-update-channel-limit tgt onoff arg)) + ((string-match "^[Kk]" mode) + (erc-update-channel-key tgt onoff arg)) + (t nil)); only ops are tracked now + (setq arg-modes (cdr arg-modes)))) + (erc-update-mode-line buf)))) + ;; nick modes - ignored at this point + (t nil)))) (defun erc-update-channel-limit (channel onoff n) ;; FIXME: what does ONOFF actually do? -- Lawrence 2004-01-08 "Update CHANNEL's user limit to N." (if (or (not (eq onoff 'on)) - (and (stringp n) (string-match "^[0-9]+$" n))) + (and (stringp n) (string-match "^[0-9]+$" n))) (erc-with-buffer - (channel) - (cond ((eq onoff 'on) (setq erc-channel-user-limit (string-to-number n))) - (t (setq erc-channel-user-limit nil)))))) + (channel) + (cond ((eq onoff 'on) (setq erc-channel-user-limit (string-to-number n))) + (t (setq erc-channel-user-limit nil)))))) (defun erc-update-channel-key (channel onoff key) "Update CHANNEL's key to KEY if ONOFF is 'on or to nil if it's 'off." (erc-with-buffer - (channel) - (cond ((eq onoff 'on) (setq erc-channel-key key)) - (t (setq erc-channel-key nil))))) + (channel) + (cond ((eq onoff 'on) (setq erc-channel-key key)) + (t (setq erc-channel-key nil))))) (defun erc-handle-user-status-change (type nlh &optional l) "Handle changes in any user's status. @@ -5078,9 +5171,9 @@ and L is a list containing additional TYPE-specific arguments. So far the following TYPE/L pairs are supported: - Event TYPE L + Event TYPE L - nickname change 'nick (NEW-NICK)" + nickname change 'nick (NEW-NICK)" (erc-log (format "user-change: type: %S nlh: %S l: %S" type nlh l)) (cond ;; nickname change @@ -5095,7 +5188,7 @@ See also variable `erc-notice-highlight-type'." (cond ((eq erc-notice-highlight-type 'prefix) (erc-put-text-property 0 (length erc-notice-prefix) - 'face 'erc-notice-face s) + 'face 'erc-notice-face s) s) ((eq erc-notice-highlight-type 'all) (erc-put-text-property 0 (length s) 'face 'erc-notice-face s) @@ -5139,13 +5232,13 @@ Return a list of the three separate tokens." (cond ((string-match "^\\([^!\n]*\\)!\\([^@\n]*\\)@\\(.*\\)$" string) (list (match-string 1 string) - (match-string 2 string) - (match-string 3 string))) + (match-string 2 string) + (match-string 3 string))) ;; Some bogus bouncers send Nick!(null), try to live with that. ((string-match "^\\([^!\n]*\\)!\\(.*\\)$" string) (list (match-string 1 string) - "" - (match-string 2 string))) + "" + (match-string 2 string))) (t (list string "" "")))) @@ -5156,7 +5249,7 @@ See also `erc-parse-user'." (car (erc-parse-user string))) (defun erc-put-text-properties (start end properties - &optional object value-list) + &optional object value-list) "Set text-properties for OBJECT. START and END describe positions in OBJECT. @@ -5164,7 +5257,7 @@ If VALUE-LIST is nil, set each property in PROPERTIES to t, else set each property to the corresponding value in VALUE-LIST." (unless value-list (setq value-list (mapcar (lambda (_x) t) - properties))) + properties))) (while (and properties value-list) (erc-put-text-property start end (pop properties) (pop value-list) object))) @@ -5176,7 +5269,7 @@ each property to the corresponding value in VALUE-LIST." Specifically, return the position of `erc-insert-marker'." (or (and (boundp 'erc-insert-marker) - (markerp erc-insert-marker)) + (markerp erc-insert-marker)) (error "erc-insert-marker has no value, please report a bug")) (marker-position erc-insert-marker)) @@ -5206,43 +5299,43 @@ submitted line to be intentional." (interactive) (let ((now (float-time))) (if (or (not erc-accidental-paste-threshold-seconds) - (< erc-accidental-paste-threshold-seconds - (- now erc-last-input-time))) - (save-restriction - (widen) - (if (< (point) (erc-beg-of-input-line)) - (erc-error "Point is not in the input area") - (let ((inhibit-read-only t) - (str (erc-user-input)) - (old-buf (current-buffer))) - (if (and (not (erc-server-buffer-live-p)) - (not (erc-command-no-process-p str))) - (erc-error "ERC: No process running") - (erc-set-active-buffer (current-buffer)) - ;; Kill the input and the prompt - (delete-region (erc-beg-of-input-line) - (erc-end-of-input-line)) - (unwind-protect - (erc-send-input str) - ;; Fix the buffer if the command didn't kill it - (when (buffer-live-p old-buf) - (with-current-buffer old-buf - (save-restriction - (widen) - (goto-char (point-max)) - (when (processp erc-server-process) - (set-marker (process-mark erc-server-process) (point))) - (set-marker erc-insert-marker (point)) - (let ((buffer-modified (buffer-modified-p))) - (erc-display-prompt) - (set-buffer-modified-p buffer-modified)))))) - - ;; Only when last hook has been run... - (run-hook-with-args 'erc-send-completed-hook str)))) - (setq erc-last-input-time now)) + (< erc-accidental-paste-threshold-seconds + (- now erc-last-input-time))) + (save-restriction + (widen) + (if (< (point) (erc-beg-of-input-line)) + (erc-error "Point is not in the input area") + (let ((inhibit-read-only t) + (str (erc-user-input)) + (old-buf (current-buffer))) + (if (and (not (erc-server-buffer-live-p)) + (not (erc-command-no-process-p str))) + (erc-error "ERC: No process running") + (erc-set-active-buffer (current-buffer)) + ;; Kill the input and the prompt + (delete-region (erc-beg-of-input-line) + (erc-end-of-input-line)) + (unwind-protect + (erc-send-input str) + ;; Fix the buffer if the command didn't kill it + (when (buffer-live-p old-buf) + (with-current-buffer old-buf + (save-restriction + (widen) + (goto-char (point-max)) + (when (processp erc-server-process) + (set-marker (process-mark erc-server-process) (point))) + (set-marker erc-insert-marker (point)) + (let ((buffer-modified (buffer-modified-p))) + (erc-display-prompt) + (set-buffer-modified-p buffer-modified)))))) + + ;; Only when last hook has been run... + (run-hook-with-args 'erc-send-completed-hook str)))) + (setq erc-last-input-time now)) (switch-to-buffer "*ERC Accidental Paste Overflow*") (lwarn 'erc :warning - "You seem to have accidentally pasted some text!")))) + "You seem to have accidentally pasted some text!")))) (defun erc-user-input () "Return the input of the user in the current buffer." @@ -5261,7 +5354,7 @@ This returns non-nil only if we actually send anything." (cond ;; Ignore empty input ((if erc-send-whitespace-lines - (string= input "") + (string= input "") (string-match "\\`[ \t\r\f\n]*\\'" input)) (when erc-warn-about-blank-lines (message "Blank line - ignoring...") @@ -5269,48 +5362,48 @@ This returns non-nil only if we actually send anything." nil) (t (let ((str input) - (erc-insert-this t)) + (erc-insert-this t)) (setq erc-send-this t) (run-hook-with-args 'erc-send-pre-hook input) (when erc-send-this - (if (or (string-match "\n" str) - (not (string-match erc-command-regexp str))) - (mapc - (lambda (line) - (mapc - (lambda (line) - ;; Insert what has to be inserted for this. - (erc-display-msg line) - (erc-process-input-line (concat line "\n") - (null erc-flood-protect) t)) - (or (and erc-flood-protect (erc-split-line line)) - (list line)))) - (split-string str "\n")) - ;; Insert the prompt along with the command. - (erc-display-command str) - (erc-process-input-line (concat str "\n") t nil)) - t))))) + (if (or (string-match "\n" str) + (not (string-match erc-command-regexp str))) + (mapc + (lambda (line) + (mapc + (lambda (line) + ;; Insert what has to be inserted for this. + (erc-display-msg line) + (erc-process-input-line (concat line "\n") + (null erc-flood-protect) t)) + (or (and erc-flood-protect (erc-split-line line)) + (list line)))) + (split-string str "\n")) + ;; Insert the prompt along with the command. + (erc-display-command str) + (erc-process-input-line (concat str "\n") t nil)) + t))))) (defun erc-display-command (line) (when erc-insert-this (let ((insert-position (point))) (unless erc-hide-prompt - (erc-display-prompt nil nil (erc-command-indicator) - (and (erc-command-indicator) - 'erc-command-indicator-face))) + (erc-display-prompt nil nil (erc-command-indicator) + (and (erc-command-indicator) + 'erc-command-indicator-face))) (let ((beg (point))) - (insert line) - (erc-put-text-property beg (point) - 'face 'erc-command-indicator-face) - (insert "\n")) + (insert line) + (erc-put-text-property beg (point) + 'face 'erc-command-indicator-face) + (insert "\n")) (when (processp erc-server-process) - (set-marker (process-mark erc-server-process) (point))) + (set-marker (process-mark erc-server-process) (point))) (set-marker erc-insert-marker (point)) (save-excursion - (save-restriction - (narrow-to-region insert-position (point)) - (run-hooks 'erc-send-modify-hook) - (run-hooks 'erc-send-post-hook)))))) + (save-restriction + (narrow-to-region insert-position (point)) + (run-hooks 'erc-send-modify-hook) + (run-hooks 'erc-send-post-hook)))))) (defun erc-display-msg (line) "Display LINE as a message of the user to the current target at the @@ -5319,18 +5412,18 @@ current position." (let ((insert-position (point))) (insert (erc-format-my-nick)) (let ((beg (point))) - (insert line) - (erc-put-text-property beg (point) - 'face 'erc-input-face)) + (insert line) + (erc-put-text-property beg (point) + 'face 'erc-input-face)) (insert "\n") (when (processp erc-server-process) - (set-marker (process-mark erc-server-process) (point))) + (set-marker (process-mark erc-server-process) (point))) (set-marker erc-insert-marker (point)) (save-excursion - (save-restriction - (narrow-to-region insert-position (point)) - (run-hooks 'erc-send-modify-hook) - (run-hooks 'erc-send-post-hook)))))) + (save-restriction + (narrow-to-region insert-position (point)) + (run-hooks 'erc-send-modify-hook) + (run-hooks 'erc-send-post-hook)))))) (defun erc-command-symbol (command) "Return the ERC command symbol for COMMAND if it exists and is bound." @@ -5343,16 +5436,16 @@ If no command was given, return nil. If command matches, return a list of the form: (command args) where both elements are strings." (when (string-match erc-command-regexp line) (let* ((cmd (erc-command-symbol (match-string 1 line))) - ;; note: return is nil, we apply this simply for side effects - (_canon-defun (while (and cmd (symbolp (symbol-function cmd))) - (setq cmd (symbol-function cmd)))) - (cmd-fun (or cmd #'erc-cmd-default)) - (arg (if cmd - (if (get cmd-fun 'do-not-parse-args) - (format "%s" (match-string 2 line)) - (delete "" (split-string (erc-trim-string - (match-string 2 line)) " "))) - line))) + ;; note: return is nil, we apply this simply for side effects + (_canon-defun (while (and cmd (symbolp (symbol-function cmd))) + (setq cmd (symbol-function cmd)))) + (cmd-fun (or cmd #'erc-cmd-default)) + (arg (if cmd + (if (get cmd-fun 'do-not-parse-args) + (format "%s" (match-string 2 line)) + (delete "" (split-string (erc-trim-string + (match-string 2 line)) " "))) + line))) (list cmd-fun arg)))) (defun erc-split-multiline-safe (string) @@ -5360,16 +5453,16 @@ list of the form: (command args) where both elements are strings." Do it only for STRING as the complete input, do not carry unfinished strings over to the next call." (let ((l ()) - (i0 0) - (doit t)) + (i0 0) + (doit t)) (while doit (let ((i (string-match "\r?\n" string i0)) - (s (substring string i0))) - (cond (i (setq l (cons (substring string i0 i) l)) - (setq i0 (match-end 0))) - ((> (length s) 0) - (setq l (cons s l))(setq doit nil)) - (t (setq doit nil))))) + (s (substring string i0))) + (cond (i (setq l (cons (substring string i0 i) l)) + (setq i0 (match-end 0))) + ((> (length s) 0) + (setq l (cons s l))(setq doit nil)) + (t (setq doit nil))))) (nreverse l))) ;; nick handling @@ -5377,15 +5470,15 @@ strings over to the next call." (defun erc-set-current-nick (nick) "Set the current nickname to NICK." (with-current-buffer (if (buffer-live-p (erc-server-buffer)) - (erc-server-buffer) - (current-buffer)) + (erc-server-buffer) + (current-buffer)) (setq erc-server-current-nick nick))) (defun erc-current-nick () "Return the current nickname." (with-current-buffer (if (buffer-live-p (erc-server-buffer)) - (erc-server-buffer) - (current-buffer)) + (erc-server-buffer) + (current-buffer)) erc-server-current-nick)) (defun erc-current-nick-p (nick) @@ -5399,7 +5492,7 @@ This matches strings according to the IRC protocol's case convention. See also `erc-downcase'." (string= (erc-downcase nick1) - (erc-downcase nick2))) + (erc-downcase nick2))) ;; default target handling @@ -5414,38 +5507,38 @@ See also `erc-downcase'." (defun erc-add-default-channel (channel) "Add CHANNEL to the default channel list." (let ((chl (downcase channel))) - (setq erc-default-recipients - (cons chl erc-default-recipients)))) + (setq erc-default-recipients + (cons chl erc-default-recipients)))) (defun erc-delete-default-channel (channel &optional buffer) "Delete CHANNEL from the default channel list." (with-current-buffer (if (and buffer - (bufferp buffer)) - buffer - (current-buffer)) + (bufferp buffer)) + buffer + (current-buffer)) (setq erc-default-recipients (delete (downcase channel) - erc-default-recipients)))) + erc-default-recipients)))) (defun erc-add-query (nickname) "Add QUERY'd NICKNAME to the default channel list. The previous default target of QUERY type gets removed." (let ((d1 (car erc-default-recipients)) - (d2 (cdr erc-default-recipients)) - (qt (cons 'QUERY (downcase nickname)))) + (d2 (cdr erc-default-recipients)) + (qt (cons 'QUERY (downcase nickname)))) (setq erc-default-recipients (cons qt (if (and (listp d1) - (eq (car d1) 'QUERY)) - d2 - erc-default-recipients))))) + (eq (car d1) 'QUERY)) + d2 + erc-default-recipients))))) (defun erc-delete-query () "Delete the topmost target if it is a QUERY." (let ((d1 (car erc-default-recipients)) - (d2 (cdr erc-default-recipients))) + (d2 (cdr erc-default-recipients))) (if (and (listp d1) - (eq (car d1) 'QUERY)) - (setq erc-default-recipients d2) + (eq (car d1) 'QUERY)) + (setq erc-default-recipients d2) (error "Current target is not a QUERY")))) (defun erc-ignored-user-p (spec) @@ -5457,7 +5550,7 @@ match, returns that regexp." (catch 'found (dolist (ignored (erc-with-server-buffer erc-ignore-list)) (if (string-match ignored spec) - (throw 'found ignored))))) + (throw 'found ignored))))) (defun erc-ignored-reply-p (msg tgt proc) ;; FIXME: this docstring needs fixing -- Lawrence 2004-01-08 @@ -5467,12 +5560,12 @@ Takes a message MSG to a channel and returns non-nil if the addressed user matches any regexp in `erc-ignore-reply-list'." (let ((target-nick (erc-message-target msg))) (if (not target-nick) - nil + nil (erc-with-buffer (tgt proc) - (let ((user (erc-get-server-user target-nick))) - (when user - (erc-list-match erc-ignore-reply-list - (erc-user-spec user)))))))) + (let ((user (erc-get-server-user target-nick))) + (when user + (erc-list-match erc-ignore-reply-list + (erc-user-spec user)))))))) (defun erc-message-target (msg) "Return the addressed target in MSG. @@ -5485,19 +5578,19 @@ The addressed target is the string before the first colon in MSG." (defun erc-user-spec (user) "Create a nick!user@host spec from a user struct." (let ((nick (erc-server-user-nickname user)) - (host (erc-server-user-host user)) - (login (erc-server-user-login user))) - (concat (or nick "") - "!" - (or login "") - "@" - (or host "")))) + (host (erc-server-user-host user)) + (login (erc-server-user-login user))) + (concat (or nick "") + "!" + (or login "") + "@" + (or host "")))) (defun erc-list-match (lst str) "Return non-nil if any regexp in LST matches STR." (memq nil (mapcar (lambda (regexp) - (not (string-match regexp str))) - lst))) + (not (string-match regexp str))) + lst))) ;; other "toggles" @@ -5509,9 +5602,9 @@ If ARG is positive, turns CTCP replies on. If ARG is non-nil and not positive, turns CTCP replies off." (interactive "P") (cond ((and (numberp arg) (> arg 0)) - (setq erc-disable-ctcp-replies t)) - (arg (setq erc-disable-ctcp-replies nil)) - (t (setq erc-disable-ctcp-replies (not erc-disable-ctcp-replies)))) + (setq erc-disable-ctcp-replies t)) + (arg (setq erc-disable-ctcp-replies nil)) + (t (setq erc-disable-ctcp-replies (not erc-disable-ctcp-replies)))) (message "ERC CTCP replies are %s" (if erc-disable-ctcp-replies "OFF" "ON"))) (defun erc-toggle-flood-control (&optional arg) @@ -5524,12 +5617,12 @@ See `erc-server-flood-margin' for an explanation of the available flood control parameters." (interactive "P") (cond ((and (numberp arg) (> arg 0)) - (setq erc-flood-protect t)) - (arg (setq erc-flood-protect nil)) - (t (setq erc-flood-protect (not erc-flood-protect)))) + (setq erc-flood-protect t)) + (arg (setq erc-flood-protect nil)) + (t (setq erc-flood-protect (not erc-flood-protect)))) (message "ERC flood control is %s" - (cond (erc-flood-protect "ON") - (t "OFF")))) + (cond (erc-flood-protect "ON") + (t "OFF")))) ;; Some useful channel and nick commands for fast key bindings @@ -5542,12 +5635,11 @@ This command is sent even if excess flood is detected." (interactive "P") (erc-set-active-buffer (current-buffer)) (let ((tgt (erc-default-target))) - (cond ((or (not tgt) (not (erc-channel-p tgt))) - (erc-display-message nil 'error (current-buffer) 'no-target)) - (arg (erc-load-irc-script-lines (list (concat "/mode " tgt " -i")) - t)) - (t (erc-load-irc-script-lines (list (concat "/mode " tgt " +i")) - t))))) + (if (or (not tgt) (not (erc-channel-p tgt))) + (erc-display-message nil 'error (current-buffer) 'no-target) + (erc-load-irc-script-lines + (list (concat "/mode " tgt (if arg " -i" " +i"))) + t)))) (defun erc-get-channel-mode-from-keypress (key) "Read a key sequence and call the corresponding channel mode function. @@ -5562,14 +5654,14 @@ Anything else will be sent to `erc-toggle-channel-mode'." (when (featurep 'xemacs) (setq key (char-to-string (event-to-character (aref key 0))))) (cond ((equal key "\C-g") - (keyboard-quit)) - ((equal key "\C-m") - (erc-insert-mode-command)) - ((equal key "l") - (call-interactively 'erc-set-channel-limit)) - ((equal key "k") - (call-interactively 'erc-set-channel-key)) - (t (erc-toggle-channel-mode key)))) + (keyboard-quit)) + ((equal key "\C-m") + (erc-insert-mode-command)) + ((equal key "l") + (call-interactively 'erc-set-channel-limit)) + ((equal key "k") + (call-interactively 'erc-set-channel-key)) + (t (erc-toggle-channel-mode key)))) (defun erc-toggle-channel-mode (mode &optional channel) "Toggle channel MODE. @@ -5579,15 +5671,14 @@ If CHANNEL is non-nil, toggle MODE for that channel, otherwise use (interactive "P") (erc-set-active-buffer (current-buffer)) (let ((tgt (or channel (erc-default-target)))) - (cond ((or (null tgt) (null (erc-channel-p tgt))) - (erc-display-message nil 'error 'active 'no-target)) - ((member mode erc-channel-modes) - (erc-log (format "%s: Toggle mode %s OFF" tgt mode)) - (message "Toggle channel mode %s OFF" mode) - (erc-server-send (format "MODE %s -%s" tgt mode))) - (t (erc-log (format "%s: Toggle channel mode %s ON" tgt mode)) - (message "Toggle channel mode %s ON" mode) - (erc-server-send (format "MODE %s +%s" tgt mode)))))) + (if (or (null tgt) (null (erc-channel-p tgt))) + (erc-display-message nil 'error 'active 'no-target) + (let* ((active (member mode erc-channel-modes)) + (newstate (if active "OFF" "ON"))) + (erc-log (format "%s: Toggle mode %s %s" tgt mode newstate)) + (message "Toggle channel mode %s %s" mode newstate) + (erc-server-send (format "MODE %s %s%s" + tgt (if active "-" "+") mode)))))) (defun erc-insert-mode-command () "Insert the line \"/mode <current target> \" at `point'." @@ -5623,9 +5714,9 @@ If FILE is found, return the path to it." (let ((filepath file)) (if (file-readable-p filepath) filepath (while (and path - (progn (setq filepath (expand-file-name file (car path))) - (not (file-readable-p filepath)))) - (setq path (cdr path))) + (progn (setq filepath (expand-file-name file (car path))) + (not (file-readable-p filepath)))) + (setq path (cdr path))) (if path filepath nil)))) (defun erc-select-startup-file () @@ -5635,7 +5726,7 @@ See also `erc-startup-file-list'." (dolist (f erc-startup-file-list) (setq f (convert-standard-filename f)) (when (file-readable-p f) - (throw 'found f))))) + (throw 'found f))))) (defun erc-find-script-file (file) "Search for FILE in `default-directory', and any in `erc-script-path'." @@ -5650,7 +5741,7 @@ as an Emacs Lisp program. Otherwise, treat it as a regular IRC script." (erc-log (concat "erc-load-script: " file)) (cond - ((string-match "\\.el$" file) + ((string-match "\\.el\\'" file) (load file)) (t (erc-load-irc-script file)))) @@ -5668,15 +5759,15 @@ $* = the entire argument string, $1 = the first argument, $2 = the second, and so on." (if (not args) (setq args "")) (let* ((arg-esc-regexp "\\(\\$\\(\\*\\|[1-9][0-9]*\\)\\)\\([^0-9]\\|$\\)") - (percent-regexp "\\(%.\\)") - (esc-regexp (concat arg-esc-regexp "\\|" percent-regexp)) - (tgt (erc-default-target)) - (server (and (boundp 'erc-session-server) erc-session-server)) - (nick (erc-current-nick)) - (res "") - (tmp nil) - (arg-list nil) - (arg-num 0)) + (percent-regexp "\\(%.\\)") + (esc-regexp (concat arg-esc-regexp "\\|" percent-regexp)) + (tgt (erc-default-target)) + (server (and (boundp 'erc-session-server) erc-session-server)) + (nick (erc-current-nick)) + (res "") + (tmp nil) + (arg-list nil) + (arg-num 0)) (if (not tgt) (setq tgt "")) (if (not server) (setq server "")) (if (not nick) (setq nick "")) @@ -5692,36 +5783,36 @@ and so on." (while tmp ;;(message "beginning of while: tmp=%S" tmp) (let* ((hd (substring line 0 tmp)) - (esc "") - (subst "") - (tail (substring line tmp))) - (cond ((string-match (concat "^" arg-esc-regexp) tail) - (setq esc (match-string 1 tail)) - (setq tail (substring tail (match-end 1)))) - ((string-match (concat "^" percent-regexp) tail) - (setq esc (match-string 1 tail)) - (setq tail (substring tail (match-end 1))))) - ;;(message "hd=%S, esc=%S, tail=%S, arg-num=%S" hd esc tail arg-num) - (setq res (concat res hd)) - (setq subst - (cond ((string= esc "") "") - ((string-match "^\\$\\*$" esc) args) - ((string-match "^\\$\\([0-9]+\\)$" esc) - (let ((n (string-to-number (match-string 1 esc)))) - (message "n = %S, integerp(n)=%S" n (integerp n)) - (if (<= n arg-num) (nth (1- n) arg-list) ""))) - ((string-match "^%[Cc]$" esc) tgt) - ((string-match "^%[Ss]$" esc) server) - ((string-match "^%[Nn]$" esc) nick) - ((string-match "^%\\(.\\)$" esc) (match-string 1 esc)) - (t (erc-log (format "BUG in erc-process-script-line: bad escape sequence: %S\n" esc)) - (message "BUG IN ERC: esc=%S" esc) - ""))) - (setq line tail) - (setq tmp (string-match esc-regexp line)) - (setq res (concat res subst)) - ;;(message "end of while: line=%S, res=%S, tmp=%S" line res tmp) - )) + (esc "") + (subst "") + (tail (substring line tmp))) + (cond ((string-match (concat "^" arg-esc-regexp) tail) + (setq esc (match-string 1 tail)) + (setq tail (substring tail (match-end 1)))) + ((string-match (concat "^" percent-regexp) tail) + (setq esc (match-string 1 tail)) + (setq tail (substring tail (match-end 1))))) + ;;(message "hd=%S, esc=%S, tail=%S, arg-num=%S" hd esc tail arg-num) + (setq res (concat res hd)) + (setq subst + (cond ((string= esc "") "") + ((string-match "^\\$\\*$" esc) args) + ((string-match "^\\$\\([0-9]+\\)$" esc) + (let ((n (string-to-number (match-string 1 esc)))) + (message "n = %S, integerp(n)=%S" n (integerp n)) + (if (<= n arg-num) (nth (1- n) arg-list) ""))) + ((string-match "^%[Cc]$" esc) tgt) + ((string-match "^%[Ss]$" esc) server) + ((string-match "^%[Nn]$" esc) nick) + ((string-match "^%\\(.\\)$" esc) (match-string 1 esc)) + (t (erc-log (format "BUG in erc-process-script-line: bad escape sequence: %S\n" esc)) + (message "BUG IN ERC: esc=%S" esc) + ""))) + (setq line tail) + (setq tmp (string-match esc-regexp line)) + (setq res (concat res subst)) + ;;(message "end of while: line=%S, res=%S, tmp=%S" line res tmp) + )) (setq res (concat res line)) res)) @@ -5729,8 +5820,8 @@ and so on." "Load an IRC script from FILE." (erc-log (concat "erc-load-script: " file)) (let ((str (with-temp-buffer - (insert-file-contents file) - (buffer-string)))) + (insert-file-contents file) + (buffer-string)))) (erc-load-irc-script-lines (erc-split-multiline-safe str) force))) (defun erc-load-irc-script-lines (lines &optional force noexpand) @@ -5740,25 +5831,25 @@ If optional NOEXPAND is non-nil, do not expand script-specific sequences, process the lines verbatim. Use this for multiline user input." (let* ((cb (current-buffer)) - (s "") - (sp (or (erc-command-indicator) (erc-prompt))) - (args (and (boundp 'erc-script-args) erc-script-args))) + (s "") + (sp (or (erc-command-indicator) (erc-prompt))) + (args (and (boundp 'erc-script-args) erc-script-args))) (if (and args (string-match "^ " args)) - (setq args (substring args 1))) + (setq args (substring args 1))) ;; prepare the prompt string for echo (erc-put-text-property 0 (length sp) - 'face 'erc-command-indicator-face sp) + 'face 'erc-command-indicator-face sp) (while lines (setq s (car lines)) (erc-log (concat "erc-load-script: CMD: " s)) (unless (string-match "^\\s-*$" s) - (let ((line (if noexpand s (erc-process-script-line s args)))) - (if (and (erc-process-input-line line force) - erc-script-echo) - (progn - (erc-put-text-property 0 (length line) - 'face 'erc-input-face line) - (erc-display-line (concat sp line) cb))))) + (let ((line (if noexpand s (erc-process-script-line s args)))) + (if (and (erc-process-input-line line force) + erc-script-echo) + (progn + (erc-put-text-property 0 (length line) + 'face 'erc-input-face line) + (erc-display-line (concat sp line) cb))))) (setq lines (cdr lines))))) ;; authentication @@ -5766,21 +5857,21 @@ user input." (defun erc-login () "Perform user authentication at the IRC server." (erc-log (format "login: nick: %s, user: %s %s %s :%s" - (erc-current-nick) - (user-login-name) - (or erc-system-name (system-name)) - erc-session-server - erc-session-user-full-name)) + (erc-current-nick) + (user-login-name) + (or erc-system-name (system-name)) + erc-session-server + erc-session-user-full-name)) (if erc-session-password (erc-server-send (format "PASS %s" erc-session-password)) (message "Logging in without password")) (erc-server-send (format "NICK %s" (erc-current-nick))) (erc-server-send (format "USER %s %s %s :%s" - ;; hacked - S.B. - (if erc-anonymous-login erc-email-userid (user-login-name)) - "0" "*" - erc-session-user-full-name)) + ;; hacked - S.B. + (if erc-anonymous-login erc-email-userid (user-login-name)) + "0" "*" + erc-session-user-full-name)) (erc-update-mode-line)) ;; connection properties' heuristics @@ -5796,8 +5887,8 @@ Sets the buffer local variables: - `erc-server-current-nick'" (setq erc-session-connector erc-server-connect-function erc-session-server (erc-compute-server server) - erc-session-port (or port erc-default-port) - erc-session-user-full-name (erc-compute-full-name name)) + erc-session-port (or port erc-default-port) + erc-session-user-full-name (erc-compute-full-name name)) (erc-set-current-nick (erc-compute-nick nick))) (defun erc-compute-server (&optional server) @@ -5865,7 +5956,7 @@ non-nil value is found. Returns a list of the form (HIGH LOW), compatible with Emacs time format." (let* ((n (string-to-number (concat string ".0")))) (list (truncate (/ n 65536)) - (truncate (mod n 65536))))) + (truncate (mod n 65536))))) (defun erc-emacs-time-to-erc-time (time) "Convert Emacs TIME to a number of seconds since the epoch." @@ -5891,33 +5982,33 @@ See also `erc-emacs-time-to-erc-time'." "Convert NS to a time string HH:MM.SS." (setq ns (truncate ns)) (format "%02d:%02d.%02d" - (/ ns 3600) - (/ (% ns 3600) 60) - (% ns 60))) + (/ ns 3600) + (/ (% ns 3600) 60) + (% ns 60))) (defun erc-seconds-to-string (seconds) "Convert a number of SECONDS into an English phrase." (let (days hours minutes format-args output) - (setq days (/ seconds 86400) - seconds (% seconds 86400) - hours (/ seconds 3600) - seconds (% seconds 3600) - minutes (/ seconds 60) - seconds (% seconds 60) - format-args (if (> days 0) - `("%d days, %d hours, %d minutes, %d seconds" - ,days ,hours ,minutes ,seconds) - (if (> hours 0) - `("%d hours, %d minutes, %d seconds" - ,hours ,minutes ,seconds) - (if (> minutes 0) - `("%d minutes, %d seconds" ,minutes ,seconds) - `("%d seconds" ,seconds)))) - output (apply 'format format-args)) + (setq days (/ seconds 86400) + seconds (% seconds 86400) + hours (/ seconds 3600) + seconds (% seconds 3600) + minutes (/ seconds 60) + seconds (% seconds 60) + format-args (if (> days 0) + `("%d days, %d hours, %d minutes, %d seconds" + ,days ,hours ,minutes ,seconds) + (if (> hours 0) + `("%d hours, %d minutes, %d seconds" + ,hours ,minutes ,seconds) + (if (> minutes 0) + `("%d minutes, %d seconds" ,minutes ,seconds) + `("%d seconds" ,seconds)))) + output (apply 'format format-args)) ;; Change all "1 units" to "1 unit". (while (string-match "\\([^0-9]\\|^\\)1 \\S-+\\(s\\)" output) (setq output (erc-replace-match-subexpression-in-string - "" output (match-string 2 output) 2 (match-beginning 2)))) + "" output (match-string 2 output) 2 (match-beginning 2)))) output)) @@ -5940,14 +6031,14 @@ If S is nil or an empty string then return general CLIENTINFO." (if (or (not s) (string= s "")) (concat (apply #'concat - (mapcar (lambda (e) - (concat (car e) " ")) - erc-clientinfo-alist)) + (mapcar (lambda (e) + (concat (car e) " ")) + erc-clientinfo-alist)) ": use CLIENTINFO <COMMAND> to get more specific information") (let ((h (assoc (upcase s) erc-clientinfo-alist))) (if h - (concat s " " (cdr h)) - (concat s ": unknown command"))))) + (concat s " " (cdr h)) + (concat s ": unknown command"))))) ;; Hook functions @@ -5962,9 +6053,9 @@ If it doesn't exist, create it." ;; here, we only want to match the channel buffers, to avoid ;; "selecting killed buffers" b0rkage. (erc-with-all-buffers-of-server process - (lambda () - (not (erc-server-buffer-p))) - (kill-buffer (current-buffer)))) + (lambda () + (not (erc-server-buffer-p))) + (kill-buffer (current-buffer)))) (defun erc-nick-at-point () "Give information about the nickname at `point'. @@ -5975,31 +6066,37 @@ entry of `channel-members'." (interactive) (require 'thingatpt) (let* ((word (word-at-point)) - (channel-data (erc-get-channel-user word)) - (cuser (cdr channel-data)) - (user (if channel-data - (car channel-data) - (erc-get-server-user word))) - host login full-name nick op voice) + (channel-data (erc-get-channel-user word)) + (cuser (cdr channel-data)) + (user (if channel-data + (car channel-data) + (erc-get-server-user word))) + host login full-name nick voice halfop op admin owner) (when user (setq nick (erc-server-user-nickname user) - host (erc-server-user-host user) - login (erc-server-user-login user) - full-name (erc-server-user-full-name user)) + host (erc-server-user-host user) + login (erc-server-user-login user) + full-name (erc-server-user-full-name user)) (if cuser - (setq op (erc-channel-user-op cuser) - voice (erc-channel-user-voice cuser))) - (if (called-interactively-p 'interactive) - (message "%s is %s@%s%s%s" - nick login host - (if full-name (format " (%s)" full-name) "") - (if (or op voice) - (format " and is +%s%s on %s" - (if op "o" "") - (if voice "v" "") - (erc-default-target)) - "")) - user)))) + (setq voice (erc-channel-user-voice cuser) + halfop (erc-channel-user-halfop cuser) + op (erc-channel-user-op cuser) + admin (erc-channel-user-admin cuser) + owner (erc-channel-user-owner cuser)))) + (if (called-interactively-p 'interactive) + (message "%s is %s@%s%s%s" + nick login host + (if full-name (format " (%s)" full-name) "") + (if (or voice halfop op admin owner) + (format " and is +%s%s on %s" + (if voice "v" "") + (if halfop "h" "") + (if op "o" "") + (if admin "a" "") + (if owner "q" "") + (erc-default-target)) + "")) + user))) (defun erc-away-time () "Return non-nil if the current ERC process is set away. @@ -6044,11 +6141,11 @@ displayed. See `erc-mode-line-format' for which characters are can be used." :group 'erc-mode-line-and-header :set (lambda (sym val) - (set sym val) - (when (fboundp 'erc-update-mode-line) - (erc-update-mode-line nil))) + (set sym val) + (when (fboundp 'erc-update-mode-line) + (erc-update-mode-line nil))) :type '(choice (const :tag "Disabled" nil) - string)) + string)) (defcustom erc-header-line-uses-tabbar-p nil "Use tabbar mode instead of the header line to display the header." @@ -6069,8 +6166,8 @@ If given a function, call it and use the resulting face name. Otherwise, use the `erc-header-line' face." :group 'erc-mode-line-and-header :type '(choice (const :tag "Don't colorize" nil) - (const :tag "Use the erc-header-line face" t) - (function :tag "Call a function"))) + (const :tag "Use the erc-header-line face" t) + (function :tag "Call a function"))) (defcustom erc-show-channel-key-p t "Show the channel key in the header line." @@ -6089,40 +6186,40 @@ This should be a string with substitution variables recognized by "Shorten SERVER-NAME according to `erc-common-server-suffixes'." (if (stringp server-name) (with-temp-buffer - (insert server-name) - (let ((alist erc-common-server-suffixes)) - (while alist - (goto-char (point-min)) - (if (re-search-forward (caar alist) nil t) - (replace-match (cdar alist))) - (setq alist (cdr alist)))) - (buffer-string)))) + (insert server-name) + (let ((alist erc-common-server-suffixes)) + (while alist + (goto-char (point-min)) + (if (re-search-forward (caar alist) nil t) + (replace-match (cdar alist))) + (setq alist (cdr alist)))) + (buffer-string)))) (defun erc-format-target () "Return the name of the target (channel or nickname or servername:port)." (let ((target (erc-default-target))) (or target - (concat (erc-shorten-server-name - (or erc-server-announced-name - erc-session-server)) - ":" (erc-port-to-string erc-session-port))))) + (concat (erc-shorten-server-name + (or erc-server-announced-name + erc-session-server)) + ":" (erc-port-to-string erc-session-port))))) (defun erc-format-target-and/or-server () "Return the server name or the current target and server name combined." (let ((server-name (erc-shorten-server-name - (or erc-server-announced-name - erc-session-server)))) + (or erc-server-announced-name + erc-session-server)))) (cond ((erc-default-target) - (concat (erc-string-no-properties (erc-default-target)) - "@" server-name)) - (server-name server-name) - (t (buffer-name (current-buffer)))))) + (concat (erc-string-no-properties (erc-default-target)) + "@" server-name)) + (server-name server-name) + (t (buffer-name (current-buffer)))))) (defun erc-format-network () "Return the name of the network we are currently on." (let ((network (and (fboundp 'erc-network-name) (erc-network-name)))) (if (and network (symbolp network)) - (symbol-name network) + (symbol-name network) ""))) (defun erc-format-target-and/or-network () @@ -6130,48 +6227,48 @@ This should be a string with substitution variables recognized by If the name of the network is not available, then use the shortened server name instead." (let ((network-name (or (and (fboundp 'erc-network-name) (erc-network-name)) - (erc-shorten-server-name - (or erc-server-announced-name - erc-session-server))))) + (erc-shorten-server-name + (or erc-server-announced-name + erc-session-server))))) (when (and network-name (symbolp network-name)) (setq network-name (symbol-name network-name))) (cond ((erc-default-target) - (concat (erc-string-no-properties (erc-default-target)) - "@" network-name)) - (network-name network-name) - (t (buffer-name (current-buffer)))))) + (concat (erc-string-no-properties (erc-default-target)) + "@" network-name)) + (network-name network-name) + (t (buffer-name (current-buffer)))))) (defun erc-format-away-status () "Return a formatted `erc-mode-line-away-status-format' if `erc-away' is non-nil." (let ((a (erc-away-time))) (if a - (format-time-string erc-mode-line-away-status-format a) + (format-time-string erc-mode-line-away-status-format a) ""))) (defun erc-format-channel-modes () "Return the current channel's modes." (concat (apply 'concat - "+" erc-channel-modes) - (cond ((and erc-channel-user-limit erc-channel-key) - (if erc-show-channel-key-p - (format "lk %.0f %s" erc-channel-user-limit - erc-channel-key) - (format "kl %.0f" erc-channel-user-limit))) - (erc-channel-user-limit - ;; Emacs has no bignums - (format "l %.0f" erc-channel-user-limit)) - (erc-channel-key - (if erc-show-channel-key-p - (format "k %s" erc-channel-key) - "k")) - (t nil)))) + "+" erc-channel-modes) + (cond ((and erc-channel-user-limit erc-channel-key) + (if erc-show-channel-key-p + (format "lk %.0f %s" erc-channel-user-limit + erc-channel-key) + (format "kl %.0f" erc-channel-user-limit))) + (erc-channel-user-limit + ;; Emacs has no bignums + (format "l %.0f" erc-channel-user-limit)) + (erc-channel-key + (if erc-show-channel-key-p + (format "k %s" erc-channel-key) + "k")) + (t nil)))) (defun erc-format-lag-time () "Return the estimated lag time to server, `erc-server-lag'." (let ((lag (erc-with-server-buffer erc-server-lag))) (cond (lag (format "lag:%.0f" lag)) - (t "")))) + (t "")))) ;; erc-goodies is required at end of this file. (declare-function erc-controls-strip "erc-goodies" (str)) @@ -6182,66 +6279,66 @@ if `erc-away' is non-nil." "Update the mode line in a single ERC buffer BUFFER." (with-current-buffer buffer (let ((spec (format-spec-make - ?a (erc-format-away-status) - ?l (erc-format-lag-time) - ?m (erc-format-channel-modes) - ?n (or (erc-current-nick) "") - ?N (erc-format-network) - ?o (or (erc-controls-strip erc-channel-topic) "") - ?p (erc-port-to-string erc-session-port) - ?s (erc-format-target-and/or-server) - ?S (erc-format-target-and/or-network) - ?t (erc-format-target))) - (process-status (cond ((and (erc-server-process-alive) - (not erc-server-connected)) - ":connecting") - ((erc-server-process-alive) - "") - (t - ": CLOSED"))) - (face (cond ((eq erc-header-line-face-method nil) - nil) - ((functionp erc-header-line-face-method) - (funcall erc-header-line-face-method)) - (t - 'erc-header-line)))) + ?a (erc-format-away-status) + ?l (erc-format-lag-time) + ?m (erc-format-channel-modes) + ?n (or (erc-current-nick) "") + ?N (erc-format-network) + ?o (or (erc-controls-strip erc-channel-topic) "") + ?p (erc-port-to-string erc-session-port) + ?s (erc-format-target-and/or-server) + ?S (erc-format-target-and/or-network) + ?t (erc-format-target))) + (process-status (cond ((and (erc-server-process-alive) + (not erc-server-connected)) + ":connecting") + ((erc-server-process-alive) + "") + (t + ": CLOSED"))) + (face (cond ((eq erc-header-line-face-method nil) + nil) + ((functionp erc-header-line-face-method) + (funcall erc-header-line-face-method)) + (t + 'erc-header-line)))) (cond ((featurep 'xemacs) - (setq modeline-buffer-identification - (list (format-spec erc-mode-line-format spec))) - (setq modeline-process (list process-status))) - (t - (setq mode-line-buffer-identification - (list (format-spec erc-mode-line-format spec))) - (setq mode-line-process (list process-status)))) + (setq modeline-buffer-identification + (list (format-spec erc-mode-line-format spec))) + (setq modeline-process (list process-status))) + (t + (setq mode-line-buffer-identification + (list (format-spec erc-mode-line-format spec))) + (setq mode-line-process (list process-status)))) (when (boundp 'header-line-format) - (let ((header (if erc-header-line-format - (format-spec erc-header-line-format spec) - nil))) - (cond (erc-header-line-uses-tabbar-p - (set (make-local-variable 'tabbar--local-hlf) - header-line-format) - (kill-local-variable 'header-line-format)) - ((null header) - (setq header-line-format nil)) - (erc-header-line-uses-help-echo-p - (let ((help-echo (with-temp-buffer - (insert header) - (fill-region (point-min) (point-max)) - (buffer-string)))) - (setq header-line-format - (erc-replace-regexp-in-string - "%" - "%%" - (if face - (erc-propertize header 'help-echo help-echo - 'face face) - (erc-propertize header 'help-echo help-echo)))))) - (t (setq header-line-format - (if face - (erc-propertize header 'face face) - header))))))) + (let ((header (if erc-header-line-format + (format-spec erc-header-line-format spec) + nil))) + (cond (erc-header-line-uses-tabbar-p + (set (make-local-variable 'tabbar--local-hlf) + header-line-format) + (kill-local-variable 'header-line-format)) + ((null header) + (setq header-line-format nil)) + (erc-header-line-uses-help-echo-p + (let ((help-echo (with-temp-buffer + (insert header) + (fill-region (point-min) (point-max)) + (buffer-string)))) + (setq header-line-format + (erc-replace-regexp-in-string + "%" + "%%" + (if face + (erc-propertize header 'help-echo help-echo + 'face face) + (erc-propertize header 'help-echo help-echo)))))) + (t (setq header-line-format + (if face + (erc-propertize header 'face face) + header))))))) (if (featurep 'xemacs) - (redraw-modeline) + (redraw-modeline) (force-mode-line-update)))) (defun erc-update-mode-line (&optional buffer) @@ -6252,7 +6349,7 @@ If BUFFER is nil, update the mode line in all ERC buffers." (erc-update-mode-line-buffer buffer) (dolist (buf (erc-buffer-list)) (when (buffer-live-p buf) - (erc-update-mode-line-buffer buf))))) + (erc-update-mode-line-buffer buf))))) ;; Miscellaneous @@ -6269,40 +6366,40 @@ P may be an integer or a service name." s (let ((n (string-to-number s))) (if (= n 0) - s - n)))) + s + n)))) (defun erc-version (&optional here) "Show the version number of ERC in the minibuffer. If optional argument HERE is non-nil, insert version number at point." (interactive "P") (let ((version-string - (format "ERC %s (GNU Emacs %s)" erc-version-string emacs-version))) + (format "ERC %s (GNU Emacs %s)" erc-version-string emacs-version))) (if here - (insert version-string) + (insert version-string) (if (called-interactively-p 'interactive) - (message "%s" version-string) - version-string)))) + (message "%s" version-string) + version-string)))) (defun erc-modes (&optional here) "Show the active ERC modes in the minibuffer. If optional argument HERE is non-nil, insert version number at point." (interactive "P") (let ((string - (mapconcat 'identity - (let (modes (case-fold-search nil)) - (dolist (var (apropos-internal "^erc-.*mode$")) - (when (and (boundp var) - (symbol-value var)) - (setq modes (cons (symbol-name var) - modes)))) - modes) - ", "))) + (mapconcat 'identity + (let (modes (case-fold-search nil)) + (dolist (var (apropos-internal "^erc-.*mode$")) + (when (and (boundp var) + (symbol-value var)) + (setq modes (cons (symbol-name var) + modes)))) + modes) + ", "))) (if here - (insert string) + (insert string) (if (called-interactively-p 'interactive) - (message "%s" string) - string)))) + (message "%s" string) + string)))) (defun erc-trim-string (s) "Trim leading and trailing spaces off S." @@ -6328,34 +6425,34 @@ All windows are opened in the current frame." (switch-to-buffer (car bufs)) (setq bufs (cdr bufs)) (while bufs - (split-window) - (other-window 1) - (switch-to-buffer (car bufs)) - (setq bufs (cdr bufs)) - (balance-windows))))) + (split-window) + (other-window 1) + (switch-to-buffer (car bufs)) + (setq bufs (cdr bufs)) + (balance-windows))))) (defun erc-popup-input-buffer () "Provide an input buffer." - (interactive) - (let ((buffer-name (generate-new-buffer-name "*ERC input*")) - (mode (intern - (completing-read - "Mode: " - (mapcar (lambda (e) - (list (symbol-name e))) - (apropos-internal "-mode$" 'commandp)) - nil t)))) - (pop-to-buffer (make-indirect-buffer (current-buffer) buffer-name)) - (funcall mode) - (narrow-to-region (point) (point)) - (shrink-window-if-larger-than-buffer))) + (interactive) + (let ((buffer-name (generate-new-buffer-name "*ERC input*")) + (mode (intern + (completing-read + "Mode: " + (mapcar (lambda (e) + (list (symbol-name e))) + (apropos-internal "-mode$" 'commandp)) + nil t)))) + (pop-to-buffer (make-indirect-buffer (current-buffer) buffer-name)) + (funcall mode) + (narrow-to-region (point) (point)) + (shrink-window-if-larger-than-buffer))) ;;; Message catalog (defun erc-make-message-variable-name (catalog entry) "Create a variable name corresponding to CATALOG's ENTRY." (intern (concat "erc-message-" - (symbol-name catalog) "-" (symbol-name entry)))) + (symbol-name catalog) "-" (symbol-name entry)))) (defun erc-define-catalog-entry (catalog entry format-spec) "Set CATALOG's ENTRY to FORMAT-SPEC." @@ -6497,18 +6594,18 @@ All windows are opened in the current frame." This function is an example on what could be done with formatting functions." (let ((nick (cadr (memq ?n args))) - (user (cadr (memq ?u args))) - (host (cadr (memq ?h args))) - (channel (cadr (memq ?c args))) - (reason (cadr (memq ?r args)))) + (user (cadr (memq ?u args))) + (host (cadr (memq ?h args))) + (channel (cadr (memq ?c args))) + (reason (cadr (memq ?r args)))) (if (string= nick (erc-current-nick)) - (format "You have left channel %s" channel) + (format "You have left channel %s" channel) (format "%s (%s@%s) has left channel %s%s" - nick user host channel - (if (not (string= reason "")) - (format ": %s" - (erc-replace-regexp-in-string "%" "%%" reason)) - ""))))) + nick user host channel + (if (not (string= reason "")) + (format ": %s" + (erc-replace-regexp-in-string "%" "%%" reason)) + ""))))) (defvar erc-current-message-catalog 'english) @@ -6524,15 +6621,15 @@ english, catalog." (unless catalog (setq catalog erc-current-message-catalog)) (let ((var (erc-make-message-variable-name catalog entry))) (if (boundp var) - (symbol-value var) + (symbol-value var) (when (boundp (erc-make-message-variable-name 'english entry)) - (symbol-value (erc-make-message-variable-name 'english entry)))))) + (symbol-value (erc-make-message-variable-name 'english entry)))))) (defun erc-format-message (msg &rest args) "Format MSG according to ARGS. See also `format-spec'." - (when (eq (logand (length args) 1) 1) ; oddp + (when (eq (logand (length args) 1) 1) ; oddp (error "Obscure usage of this function appeared")) (let ((entry (erc-retrieve-catalog-entry msg))) (when (not entry) @@ -6593,8 +6690,8 @@ This function should be on `erc-kill-channel-hook'." (when (erc-server-process-alive) (let ((tgt (erc-default-target))) (erc-server-send (format "PART %s :%s" tgt - (funcall erc-part-reason nil)) - nil tgt)))) + (funcall erc-part-reason nil)) + nil tgt)))) ;;; Dealing with `erc-parsed' @@ -6616,10 +6713,10 @@ This function should be on `erc-kill-channel-hook'." (defun erc-get-parsed-vector-nick (vect) "Return nickname in the parsed vector VECT." (let* ((untreated-nick (and vect (erc-response.sender vect))) - (maybe-nick (when untreated-nick - (car (split-string untreated-nick "!"))))) + (maybe-nick (when untreated-nick + (car (split-string untreated-nick "!"))))) (when (and (not (null maybe-nick)) - (erc-is-valid-nick-p maybe-nick)) + (erc-is-valid-nick-p maybe-nick)) untreated-nick))) (defun erc-get-parsed-vector-type (vect) @@ -6636,18 +6733,18 @@ This function should be on `erc-kill-channel-hook'." If ERC is already connected to HOST:PORT, simply /join CHANNEL. Otherwise, connect to HOST:PORT as USER and /join CHANNEL." (let ((server-buffer - (car (erc-buffer-filter - (lambda () - (and (string-equal erc-session-server host) - (= erc-session-port port) - (erc-open-server-buffer-p))))))) + (car (erc-buffer-filter + (lambda () + (and (string-equal erc-session-server host) + (= erc-session-port port) + (erc-open-server-buffer-p))))))) (with-current-buffer (or server-buffer (current-buffer)) (if (and server-buffer channel) - (erc-cmd-JOIN channel) - (erc-open host port (or user (erc-compute-nick)) (erc-compute-full-name) - (not server-buffer) password nil channel - (when server-buffer - (get-buffer-process server-buffer))))))) + (erc-cmd-JOIN channel) + (erc-open host port (or user (erc-compute-nick)) (erc-compute-full-name) + (not server-buffer) password nil channel + (when server-buffer + (get-buffer-process server-buffer))))))) (provide 'erc) diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 5286f280b39..3bb6e8f31c7 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -539,20 +539,17 @@ Unless optional argument INPLACE is non-nil, return a new string." (defmacro eshell-with-file-modes (modes &rest forms) "Evaluate, with file-modes set to MODES, the given FORMS." - `(let ((modes (default-file-modes))) - (set-default-file-modes ,modes) - (unwind-protect - (progn ,@forms) - (set-default-file-modes modes)))) + (declare (obsolete with-file-modes "24.5")) + `(with-file-modes ,modes ,@forms)) (defmacro eshell-with-private-file-modes (&rest forms) "Evaluate FORMS with private file modes set." - `(eshell-with-file-modes ,eshell-private-file-modes ,@forms)) + `(with-file-modes ,eshell-private-file-modes ,@forms)) (defsubst eshell-make-private-directory (dir &optional parents) "Make DIR with file-modes set to `eshell-private-directory-modes'." - (eshell-with-file-modes eshell-private-directory-modes - (make-directory dir parents))) + (with-file-modes eshell-private-directory-modes + (make-directory dir parents))) (defsubst eshell-substring (string sublen) "Return the beginning of STRING, up to SUBLEN bytes." diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el index 5590483a54b..af67266e67b 100644 --- a/lisp/eshell/eshell.el +++ b/lisp/eshell/eshell.el @@ -170,56 +170,7 @@ ;; @ 4nt ;; @ csh -;;;_* Speeding up load time -;; -;; If you find that Eshell loads too slowly, there is something you -;; can do to speed it up. -;; -;; Create a file, named /tmp/elc, containing this filelist: -;; -;; esh-util.elc -;; eshell.elc -;; esh-module.elc -;; esh-var.elc -;; esh-proc.elc -;; esh-arg.elc -;; esh-io.elc -;; esh-ext.elc -;; esh-cmd.elc -;; esh-mode.elc -;; esh-opt.elc -;; em-alias.elc -;; em-banner.elc -;; em-basic.elc -;; em-cmpl.elc -;; em-dirs.elc -;; em-pred.elc -;; em-glob.elc -;; em-hist.elc -;; em-ls.elc -;; em-prompt.elc -;; em-rebind.elc -;; em-script.elc -;; em-smart.elc -;; em-term.elc -;; em-unix.elc -;; em-xtra.elc -;; -;; The order is very important. Remove from the filelist any features -;; you don't use. These all begin with "em-". If you don't use -;; Eshell's key rebinding module, you can remove "em-rebind.elc" from -;; the filelist. The modules you are currently using are listed in -;; `eshell-modules-list'. -;; -;; Now, concatenating all of the above mentioned .elc files, in that -;; order, to another file. Here is how to do this on UNIX: -;; -;; cat `cat /tmp/elc` > tmp.elc ; mv tmp.elc eshell.elc -;; -;; Now your eshell.elc file contains all of the .elc files that make -;; up Eshell, in the right load order. When you next load Eshell, it -;; will only have to read in this one file, which will greatly speed -;; things up. +;;; Code: (eval-when-compile (require 'cl-lib)) diff --git a/lisp/faces.el b/lisp/faces.el index 7caba9a96c2..d8b3c7a6b0f 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -35,6 +35,26 @@ the terminal-initialization file to be loaded." (string :tag "Name of directory with term files")) :group 'terminals) +(defcustom term-file-aliases + '(("apollo" . "vt100") + ("vt102" . "vt100") + ("vt125" . "vt100") + ("vt201" . "vt200") + ("vt220" . "vt200") + ("vt240" . "vt200") + ("vt300" . "vt200") + ("vt320" . "vt200") + ("vt400" . "vt200") + ("vt420" . "vt200") + ) + "Alist of terminal type aliases. +Entries are of the form (TYPE . ALIAS), where both elements are strings. +This means to treat a terminal of type TYPE as if it were of type ALIAS." + :type '(alist :key-type (string :tag "Terminal") + :value-type (string :tag "Alias")) + :group 'terminals + :version "24.5") + (declare-function xw-defined-colors "term/common-win" (&optional frame)) (defvar help-xref-stack-item) @@ -129,15 +149,11 @@ REGISTRY, ALTERNATIVE1, ALTERNATIVE2, and etc." "Return a list of all defined faces." (mapcar #'car face-new-frame-defaults)) -(defun make-face (face &optional no-init-from-resources) +(defun make-face (face) "Define a new face with name FACE, a symbol. Do not call this directly from Lisp code; use `defface' instead. -If FACE is already known as a face, leave it unmodified. Return FACE. - -NO-INIT-FROM-RESOURCES has been deprecated and is no longer used -and will go away. Handling of conditional X resources application -has been pushed down to make-x-resource-internal itself." +If FACE is already known as a face, leave it unmodified. Return FACE." (interactive (list (read-from-minibuffer "Make face: " nil nil t 'face-name-history))) (unless (facep face) @@ -151,11 +167,6 @@ has been pushed down to make-x-resource-internal itself." (make-face-x-resource-internal face)) face) -;; Handling of whether to apply X resources or not, has been pushed down -;; to make-face-x-resource-internal itself, thus the optional arg is no -;; longer evaluated at all and going away. -(set-advertised-calling-convention 'make-face '(face) "24.4") - (defun make-empty-face (face) "Define a new, empty face with name FACE. Do not call this directly from Lisp code; use `defface' instead." @@ -2054,17 +2065,16 @@ Calculate the face definitions using the face specs, custom theme settings, X resources, and `face-new-frame-defaults'. Finally, apply any relevant face attributes found amongst the frame parameters in PARAMETERS." - (let ((window-system-p (memq (window-system frame) '(x w32)))) - ;; The `reverse' is so that `default' goes first. - (dolist (face (nreverse (face-list))) - (condition-case () - (progn - ;; Initialize faces from face spec and custom theme. - (face-spec-recalc face frame) - ;; Apply attributes specified by face-new-frame-defaults - (internal-merge-in-global-face face frame)) - ;; Don't let invalid specs prevent frame creation. - (error nil)))) + ;; The `reverse' is so that `default' goes first. + (dolist (face (nreverse (face-list))) + (condition-case () + (progn + ;; Initialize faces from face spec and custom theme. + (face-spec-recalc face frame) + ;; Apply attributes specified by face-new-frame-defaults + (internal-merge-in-global-face face frame)) + ;; Don't let invalid specs prevent frame creation. + (error nil))) ;; Apply attributes specified by frame parameters. (let ((face-params '((foreground-color default :foreground) @@ -2146,11 +2156,16 @@ This can be used to fine tune the `input-decode-map', for example.") The optional TYPE parameter may be used to override the autodetected terminal type to a different value. +This consults `term-file-aliases' to map terminal types to their aliases. + If optional argument RUN-HOOK is non-nil, then as a final step, this runs the hook `tty-setup-hook'. If you set `term-file-prefix' to nil, this function does nothing." (setq type (or type (tty-type frame))) + (let ((alias (tty-find-type + (lambda (typ) (assoc typ term-file-aliases)) type))) + (if alias (setq type (cdr (assoc alias term-file-aliases))))) ;; Load library for our terminal type. ;; User init file can set term-file-prefix to nil to prevent this. (with-selected-frame frame diff --git a/lisp/ffap.el b/lisp/ffap.el index 119e0ad3078..95a651bbde6 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -163,6 +163,12 @@ schemes (e.g. \"ftp\"); in that case, only convert those URLs." :group 'ffap :version "24.3") +(defcustom ffap-lax-url nil + "If non-nil, allow lax URL matching." + :type 'boolean + :group 'ffap + :version "24.5") + (defcustom ffap-ftp-default-user "anonymous" "User name in FTP file names generated by `ffap-host-to-path'. Note this name may be omitted if it equals the default @@ -1096,7 +1102,7 @@ Assumes the buffer has not changed." (w3-view-this-url t)) (let ((thing-at-point-beginning-of-url-regexp ffap-url-regexp) (thing-at-point-default-mail-uri-scheme ffap-foo-at-bar-prefix)) - (thing-at-point-url-at-point t + (thing-at-point-url-at-point ffap-lax-url (if (use-region-p) (cons (region-beginning) (region-end)))))))) @@ -1253,7 +1259,8 @@ which may actually result in an URL rather than a filename." (not (ffap-file-exists-string dir)) (not (equal dir (setq dir (file-name-directory (directory-file-name dir))))))) - (ffap-file-exists-string dir))) + (and (not (string= dir "/")) + (ffap-file-exists-string dir)))) ) (set-match-data data)))) diff --git a/lisp/files.el b/lisp/files.el index 718421b1899..9017cc96703 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -559,14 +559,6 @@ A value of nil means ignore them; anything else means query." (other :tag "Query" other)) :group 'find-file) -;; Avoid losing in versions where CLASH_DETECTION is disabled. -(or (fboundp 'lock-buffer) - (defalias 'lock-buffer 'ignore)) -(or (fboundp 'unlock-buffer) - (defalias 'unlock-buffer 'ignore)) -(or (fboundp 'file-locked-p) - (defalias 'file-locked-p 'ignore)) - (defcustom view-read-only nil "Non-nil means buffers visiting files read-only do so in view mode. In fact, this means that all read-only buffers normally have @@ -891,7 +883,7 @@ which we're looking." ;; ;; Represent /home/luser/foo as ~/foo so that we don't try to look for ;; `name' in /home or in /. - (setq file (abbreviate-file-name file)) + (setq file (abbreviate-file-name (expand-file-name file))) (let ((root nil) ;; `user' is not initialized outside the loop because ;; `file' may not exist, so we may have to walk up part of the @@ -949,14 +941,10 @@ directory if it does not exist." (if (file-directory-p user-emacs-directory) (or (file-accessible-directory-p user-emacs-directory) (setq errtype "access")) - (let ((umask (default-file-modes))) - (unwind-protect - (progn - (set-default-file-modes ?\700) - (condition-case nil - (make-directory user-emacs-directory) - (error (setq errtype "create")))) - (set-default-file-modes umask)))) + (with-file-modes ?\700 + (condition-case nil + (make-directory user-emacs-directory) + (error (setq errtype "create"))))) (when (and errtype user-emacs-directory-warning (not (get 'user-emacs-directory-warning 'this-session))) @@ -1281,36 +1269,31 @@ You can then use `write-region' to write new data into the file. If DIR-FLAG is non-nil, create a new empty directory instead of a file. If SUFFIX is non-nil, add that at the end of the file name." - (let ((umask (default-file-modes)) - file) - (unwind-protect - (progn - ;; Create temp files with strict access rights. It's easy to - ;; loosen them later, whereas it's impossible to close the - ;; time-window of loose permissions otherwise. - (set-default-file-modes ?\700) - (while (condition-case () - (progn - (setq file - (make-temp-name - (if (zerop (length prefix)) - (file-name-as-directory - temporary-file-directory) - (expand-file-name prefix - temporary-file-directory)))) - (if suffix - (setq file (concat file suffix))) - (if dir-flag - (make-directory file) - (write-region "" nil file nil 'silent nil 'excl)) - nil) - (file-already-exists t)) - ;; the file was somehow created by someone else between - ;; `make-temp-name' and `write-region', let's try again. - nil) - file) - ;; Reset the umask. - (set-default-file-modes umask)))) + ;; Create temp files with strict access rights. It's easy to + ;; loosen them later, whereas it's impossible to close the + ;; time-window of loose permissions otherwise. + (with-file-modes ?\700 + (let (file) + (while (condition-case () + (progn + (setq file + (make-temp-name + (if (zerop (length prefix)) + (file-name-as-directory + temporary-file-directory) + (expand-file-name prefix + temporary-file-directory)))) + (if suffix + (setq file (concat file suffix))) + (if dir-flag + (make-directory file) + (write-region "" nil file nil 'silent nil 'excl)) + nil) + (file-already-exists t)) + ;; the file was somehow created by someone else between + ;; `make-temp-name' and `write-region', let's try again. + nil) + file))) (defun recode-file-name (file coding new-coding &optional ok-if-already-exists) "Change the encoding of FILE's name from CODING to NEW-CODING. @@ -2091,9 +2074,9 @@ This function ensures that none of these modifications will take place." This function is meant for the user to run interactively. Don't call it from programs! Use `insert-file-contents-literally' instead. \(Its calling sequence is different; see its documentation)." + (declare (interactive-only insert-file-contents-literally)) (interactive "*fInsert file literally: ") (insert-file-1 filename #'insert-file-contents-literally)) -(put 'insert-file-literally 'interactive-only 'insert-file-contents-literally) (defvar find-file-literally nil "Non-nil if this buffer was made by `find-file-literally' or equivalent. @@ -2457,7 +2440,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" . archive-mode) ("/\\.\\(?:enigma\\|gltron\\|gtk\\|hxplayer\\|net\\|neverball\\|qt/.+\\|realplayer\\|scummvm\\|sversion\\|sylpheed/.+\\|xmp\\)rc\\'" . conf-mode) ("/\\.\\(?:gdbtkinit\\|grip\\|orbital/.+txt\\|rhosts\\|tuxracer/options\\)\\'" . conf-mode) ("/\\.?X\\(?:default\\|resource\\|re\\)s\\>" . conf-xdefaults-mode) - ("/X11.+app-defaults/" . conf-xdefaults-mode) + ("/X11.+app-defaults/\\|\\.ad\\'" . conf-xdefaults-mode) ("/X11.+locale/.+/Compose\\'" . conf-colon-mode) ;; this contains everything twice, with space and with colon :-( ("/X11.+locale/compose\\.dir\\'" . conf-javaprop-mode) @@ -2520,6 +2503,7 @@ and `magic-mode-alist', which determines modes based on file contents.") ("[acjkwz]sh" . sh-mode) ("r?bash2?" . sh-mode) ("dash" . sh-mode) + ("mksh" . sh-mode) ("\\(dt\\|pd\\|w\\)ksh" . sh-mode) ("es" . sh-mode) ("i?tcsh" . sh-mode) @@ -4081,31 +4065,26 @@ BACKUPNAME is the backup file name, which is the old file renamed." (file-error nil)))))) (defun backup-buffer-copy (from-name to-name modes extended-attributes) - (let ((umask (default-file-modes))) - (unwind-protect - (progn - ;; Create temp files with strict access rights. It's easy to - ;; loosen them later, whereas it's impossible to close the - ;; time-window of loose permissions otherwise. - (set-default-file-modes ?\700) - (when (condition-case nil - ;; Try to overwrite old backup first. - (copy-file from-name to-name t t t) - (error t)) - (while (condition-case nil - (progn - (when (file-exists-p to-name) - (delete-file to-name)) - (copy-file from-name to-name nil t t) - nil) - (file-already-exists t)) - ;; The file was somehow created by someone else between - ;; `delete-file' and `copy-file', so let's try again. - ;; rms says "I think there is also a possible race - ;; condition for making backup files" (emacs-devel 20070821). - nil))) - ;; Reset the umask. - (set-default-file-modes umask))) + ;; Create temp files with strict access rights. It's easy to + ;; loosen them later, whereas it's impossible to close the + ;; time-window of loose permissions otherwise. + (with-file-modes ?\700 + (when (condition-case nil + ;; Try to overwrite old backup first. + (copy-file from-name to-name t t t) + (error t)) + (while (condition-case nil + (progn + (when (file-exists-p to-name) + (delete-file to-name)) + (copy-file from-name to-name nil t t) + nil) + (file-already-exists t)) + ;; The file was somehow created by someone else between + ;; `delete-file' and `copy-file', so let's try again. + ;; rms says "I think there is also a possible race + ;; condition for making backup files" (emacs-devel 20070821). + nil))) ;; If set-file-extended-attributes fails, fall back on set-file-modes. (unless (and extended-attributes (with-demoted-errors @@ -5006,6 +4985,7 @@ With prefix ARG, mark buffer as modified, so \\[save-buffer] will save. It is not a good idea to use this function in Lisp programs, because it prints a message in the minibuffer. Instead, use `set-buffer-modified-p'." + (declare (interactive-only set-buffer-modified-p)) (interactive "P") (message (if arg "Modification-flag set" "Modification-flag cleared")) @@ -5025,9 +5005,9 @@ Set mark after the inserted text. This function is meant for the user to run interactively. Don't call it from programs! Use `insert-file-contents' instead. \(Its calling sequence is different; see its documentation)." + (declare (interactive-only insert-file-contents)) (interactive "*fInsert file: ") (insert-file-1 filename #'insert-file-contents)) -(put 'insert-file 'interactive-only 'insert-file-contents) (defun append-to-file (start end filename) "Append the contents of the region to the end of file FILENAME. @@ -5996,10 +5976,9 @@ default directory. However, if FULL is non-nil, they are absolute." (file-expand-wildcards (directory-file-name dirpart))) (list dirpart))) contents) - (while dirs - (when (or (null (car dirs)) ; Possible if DIRPART is not wild. - (and (file-directory-p (directory-file-name (car dirs))) - (file-readable-p (car dirs)))) + (dolist (dir dirs) + (when (or (null dir) ; Possible if DIRPART is not wild. + (file-accessible-directory-p dir)) (let ((this-dir-contents ;; Filter out "." and ".." (delq nil @@ -6007,16 +5986,15 @@ default directory. However, if FULL is non-nil, they are absolute." (unless (string-match "\\`\\.\\.?\\'" (file-name-nondirectory name)) name)) - (directory-files (or (car dirs) ".") full + (directory-files (or dir ".") full (wildcard-to-regexp nondir)))))) (setq contents (nconc - (if (and (car dirs) (not full)) - (mapcar (function (lambda (name) (concat (car dirs) name))) + (if (and dir (not full)) + (mapcar #'(lambda (name) (concat dir name)) this-dir-contents) this-dir-contents) - contents)))) - (setq dirs (cdr dirs))) + contents))))) contents))) ;; Let Tramp know that `file-expand-wildcards' does not need an advice. @@ -6874,15 +6852,11 @@ Otherwise, trash FILENAME using the freedesktop.org conventions, trash-info-dir filename)) ;; Ensure that the trash directory exists; otherwise, create it. - (let ((saved-default-file-modes (default-file-modes))) - (unwind-protect - (progn - (set-default-file-modes #o700) - (unless (file-exists-p trash-files-dir) - (make-directory trash-files-dir t)) - (unless (file-exists-p trash-info-dir) - (make-directory trash-info-dir t))) - (set-default-file-modes saved-default-file-modes))) + (with-file-modes #o700 + (unless (file-exists-p trash-files-dir) + (make-directory trash-files-dir t)) + (unless (file-exists-p trash-info-dir) + (make-directory trash-info-dir t))) ;; Try to move to trash with .trashinfo undo information (save-excursion diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 82e97c4da62..fe37c24579b 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -601,14 +601,14 @@ This is normally set via `font-lock-defaults'.") Currently, valid mode names are `fast-lock-mode', `jit-lock-mode' and `lazy-lock-mode'. This is normally set via `font-lock-defaults'.") -(defvar font-lock-multiline nil +(defvar-local font-lock-multiline nil "Whether font-lock should cater to multiline keywords. If nil, don't try to handle multiline patterns. If t, always handle multiline patterns. If `undecided', don't try to handle multiline patterns until you see one. Major/minor modes can set this variable if they know which option applies.") -(defvar font-lock-fontified nil) ; Whether we have fontified the buffer. +(defvar-local font-lock-fontified nil) ; Whether we have fontified the buffer. ;; Font Lock mode. @@ -626,6 +626,8 @@ Major/minor modes can set this variable if they know which option applies.") ;; Shut up the byte compiler. (defvar font-lock-face-attributes)) ; Obsolete but respected if set. +(defvar-local font-lock-set-defaults nil) ; Whether we have set up defaults. + (defun font-lock-specified-p (mode) "Return non-nil if the current buffer is ready for fontification. The MODE argument, if non-nil, means Font Lock mode is about to @@ -634,7 +636,6 @@ be enabled." (and (boundp 'font-lock-keywords) font-lock-keywords) (and mode - (boundp 'font-lock-set-defaults) font-lock-set-defaults font-lock-major-mode (not (eq font-lock-major-mode major-mode))))) @@ -921,6 +922,14 @@ The value of this variable is used when Font Lock mode is turned on." ;; Prepare for jit-lock (remove-hook 'after-change-functions 'font-lock-after-change-function t) + (set (make-local-variable 'font-lock-flush-function) + 'jit-lock-refontify) + (set (make-local-variable 'font-lock-ensure-function) + 'jit-lock-fontify-now) + ;; Prevent font-lock-fontify-buffer from fontifying eagerly the whole + ;; buffer. This is important for things like CWarn mode which + ;; adds/removes a few keywords and does a refontify (which takes ages on + ;; large files). (set (make-local-variable 'font-lock-fontify-buffer-function) 'jit-lock-refontify) ;; Don't fontify eagerly (and don't abort if the buffer is large). @@ -1025,12 +1034,23 @@ This function should preserve the match-data. The region it returns may start or end in the middle of a line.") (make-variable-buffer-local 'font-lock-extend-after-change-region-function) -(defun font-lock-fontify-buffer () +(defun font-lock-fontify-buffer (&optional interactively) "Fontify the current buffer the way the function `font-lock-mode' would." - (interactive) + (declare + ;; When called from Lisp, this function is a big mess. The caller usually + ;; expects one of the following behaviors: + ;; - refresh the highlighting (because the font-lock-keywords have been + ;; changed). + ;; - apply font-lock highlighting even if font-lock-mode is not enabled. + ;; - reset the highlighting rules because font-lock-defaults + ;; has been changed (and then rehighlight everything). + ;; Of course, this function doesn't do all of the above in all situations + ;; (e.g. depending on whether jit-lock is in use) and it can't guess what + ;; the caller wants. + (interactive-only "use font-lock-ensure or font-lock-flush instead.")) + (interactive "p") (font-lock-set-defaults) - (let ((font-lock-verbose (or font-lock-verbose - (called-interactively-p 'interactive)))) + (let ((font-lock-verbose (or font-lock-verbose interactively))) (funcall font-lock-fontify-buffer-function))) (defun font-lock-unfontify-buffer () @@ -1049,6 +1069,31 @@ This works by calling `font-lock-unfontify-region-function'." (save-buffer-state (funcall font-lock-unfontify-region-function beg end))) +(defvar font-lock-flush-function #'font-lock-after-change-function + "Function to use to mark a region for refontification. +Called with two arguments BEG and END.") + +(defun font-lock-flush (&optional beg end) + "Declare the region BEG...END's fontification as out-of-date. +If the region is not specified, it defaults to the whole buffer." + (and font-lock-mode + font-lock-fontified + (funcall font-lock-flush-function + (or beg (point-min)) (or end (point-max))))) + +(defvar font-lock-ensure-function + (lambda (_beg _end) + (unless font-lock-fontified (font-lock-default-fontify-buffer))) + "Function to make sure a region has been fontified. +Called with two arguments BEG and END.") + +(defun font-lock-ensure (&optional beg end) + "Make sure the region BEG...END has been fontified. +If the region is not specified, it defaults to the whole buffer." + (font-lock-set-defaults) + (funcall font-lock-ensure-function + (or beg (point-min)) (or end (point-max)))) + (defun font-lock-default-fontify-buffer () "Fontify the whole buffer using `font-lock-fontify-region-function'." (let ((verbose (if (numberp font-lock-verbose) @@ -1059,7 +1104,7 @@ This works by calling `font-lock-unfontify-region-function'." (format "Fontifying %s..." (buffer-name))) ;; Make sure we fontify etc. in the whole buffer. (save-restriction - (widen) + (unless font-lock-dont-widen (widen)) (condition-case nil (save-excursion (save-match-data @@ -1201,7 +1246,7 @@ This function is the default `font-lock-unfontify-region-function'." '(face font-lock-multiline))))) ;; Called when any modification is made to buffer text. -(defun font-lock-after-change-function (beg end old-len) +(defun font-lock-after-change-function (beg end &optional old-len) (save-excursion (let ((inhibit-point-motion-hooks t) (inhibit-quit t) @@ -1786,8 +1831,6 @@ A LEVEL of nil is equal to a LEVEL of 0, a LEVEL of t is equal to (t (car keywords)))) -(defvar font-lock-set-defaults nil) ; Whether we have set up defaults. - (defun font-lock-refresh-defaults () "Restart fontification in current buffer after recomputing from defaults. Recompute fontification variables using `font-lock-defaults' and @@ -1815,9 +1858,7 @@ Sets various variables using `font-lock-defaults' and (unless (and font-lock-set-defaults (eq font-lock-major-mode major-mode)) (setq font-lock-major-mode major-mode) - (set (make-local-variable 'font-lock-set-defaults) t) - (make-local-variable 'font-lock-fontified) - (make-local-variable 'font-lock-multiline) + (setq font-lock-set-defaults t) (let* ((defaults font-lock-defaults) (keywords (font-lock-choose-keywords (nth 0 defaults) @@ -1825,7 +1866,6 @@ Sets various variables using `font-lock-defaults' and (local (cdr (assq major-mode font-lock-keywords-alist))) (removed-keywords (cdr-safe (assq major-mode font-lock-removed-keywords-alist)))) - (set (make-local-variable 'font-lock-defaults) defaults) ;; Syntactic fontification? (if (nth 1 defaults) (set (make-local-variable 'font-lock-keywords-only) t) @@ -1868,7 +1908,8 @@ Sets various variables using `font-lock-defaults' and ;; Now compile the keywords. (unless (eq (car font-lock-keywords) t) (setq font-lock-keywords - (font-lock-compile-keywords font-lock-keywords)))))) + (font-lock-compile-keywords font-lock-keywords)))) + (font-lock-flush))) ;;; Color etc. support. diff --git a/lisp/frame.el b/lisp/frame.el index 5e9b5351005..9a170134e3d 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1,7 +1,6 @@ ;;; frame.el --- multi-frame management independent of window systems -;; Copyright (C) 1993-1994, 1996-1997, 2000-2014 Free Software -;; Foundation, Inc. +;; Copyright (C) 1993-1994, 1996-1997, 2000-2014 Free Software Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org ;; Keywords: internal @@ -149,12 +148,6 @@ This function runs the hook `focus-out-hook'." ;; 3) Once the init file is done, we apply any newly set parameters ;; in initial-frame-alist to the frame. -;; These are now called explicitly at the proper times, -;; since that is easier to understand. -;; Actually using hooks within Emacs is bad for future maintenance. --rms. -;; (add-hook 'before-init-hook 'frame-initialize) -;; (add-hook 'window-setup-hook 'frame-notice-user-settings) - ;; If we create the initial frame, this is it. (defvar frame-initial-frame nil) diff --git a/lisp/frameset.el b/lisp/frameset.el index 9a474519813..b943d47e7bf 100644 --- a/lisp/frameset.el +++ b/lisp/frameset.el @@ -1266,6 +1266,17 @@ Called from `jump-to-register'. Internal use only." (with-current-buffer buffer (goto-char (aref data 2))))))) ;;;###autoload +(defun frameset--print-register (data) + "Print basic info about frameset stored in DATA. +Called from `list-registers' and `view-register'. Internal use only." + (let* ((fs (aref data 0)) + (ns (length (frameset-states fs)))) + (princ (format "a frameset (%d frame%s, saved on %s)." + ns + (if (= 1 ns) "" "s") + (format-time-string "%c" (frameset-timestamp fs)))))) + +;;;###autoload (defun frameset-to-register (register) "Store the current frameset in register REGISTER. Use \\[jump-to-register] to restore the frameset. @@ -1282,7 +1293,7 @@ Interactively, reads the register using `register-read-with-preview'." ;; in the current buffer, so record that separately. (frameset-frame-id nil) (point-marker)) - :print-func (lambda (_data) (princ "a frameset.")) + :print-func #'frameset--print-register :jump-func #'frameset--jump-to-register))) (provide 'frameset) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index c9a23e47e6c..543a5b1a433 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,18 +1,277 @@ -2014-05-28 Andreas Schwab <schwab@linux-m68k.org> +2014-06-05 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-edit-part): Don't modifiy markers. + (gnus-article-read-summary-keys): + Don't bug out when there is no article in the summary buffer. + (gnus-mime-buttonize-attachments-in-header): + Improve criterion that finds parts to display. + + * gnus-art.el (gnus-mm-display-part): + * mm-decode.el (mm-shr): + * mm-view.el (mm-inline-text-html-render-with-w3m, mm-inline-text) + (mm-insert-inline): Revert last changes. + +2014-06-05 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-mm-display-part): + * mm-decode.el (mm-shr): + * mm-view.el (mm-inline-text-html-render-with-w3m, mm-inline-text) + (mm-insert-inline): Set insertion type of end-marker, not only + start-marker, of undisplayer so as to stay after inserted text. + +2014-06-02 Andreas Schwab <schwab@linux-m68k.org> * html2text.el (html2text-get-attr): Fix typo when splitting value from attribute. (Bug#17613) -2014-05-06 Glenn Morris <rgm@gnu.org> +2014-05-29 Stefan Monnier <monnier@iro.umontreal.ca> + + * mm-view.el (mm-display-inline-fontify): Use font-lock-ensure. + * gnus-cite.el (gnus-message-citation-mode): Use font-lock-flush. + +2014-05-15 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-mime-inline-part, gnus-mm-display-part): + Don't delete next part button; keep spacing between buttons. + +2014-05-14 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-mime-inline-part, gnus-mm-display-part): + Work for the last MIME part in an article. + (gnus-mime-display-single): Suppress excessive newlines between parts. + + * mm-uu.el (mm-uu-dissect): Assume that separators may be accompanied + by leading or trailing newline. + +2014-05-09 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-mm-display-part): Don't put article out of sight + while prompting a user for a file name, etc. + (gnus-mime-display-single): Display part with a common appearance no + matter whether MIME button is omitted or not; don't add duplicate entry + to gnus-article-mime-handle-alist. + (gnus-mime-buttonize-attachments-in-header): Use copied buttons. + +2014-05-08 Adam Sjøgren <asjo@koldfront.dk> + + * mml2015.el (mml2015-display-key-image): New variable. + +2014-05-08 Glenn Morris <rgm@gnu.org> * gnus-fun.el (gnus-grab-cam-face): Do not use predictable temp-file name. (http://bugs.debian.org/747100) This is CVE-2014-3421. -2014-05-01 Glenn Morris <rgm@gnu.org> +2014-05-04 Glenn Morris <rgm@gnu.org> * gnus-registry.el (gnus-registry-install-p): Doc fix. +2014-05-02 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-mime-inline-part): Redisplay a button so as to show + the displaying state of a part. + (gnus-mm-display-part): Don't insert a newline in the beginning of + a part like gnus-mime-inline-part doesn't; work for XEmacs. + + * mm-decode.el (mm-display-part): Don't insert a newline in the top. + (mm-shr): Make undisplayer unbreakable. + + * mm-view.el (mm-inline-image-emacs, mm-inline-image-xemacs): + Don't insert excessive newline. + (mm-inline-text-html-render-with-w3m, mm-inline-text) + (mm-insert-inline): Make undisplayer unbreakable. + +2014-05-01 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-mm-display-part): + Highlight header attachment buttons. + +2014-04-30 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-mm-display-part): Don't move point while toggling + a part; redisplay a button (enbugged in 2014-03-23). + +2014-04-27 Teodor Zlatanov <tzz@lifelogs.com> + + * auth-source.el (auth-source-search, auth-source-search-backends): + Treat :max 0 as an indicator that a boolean return is wanted, as + documented. Reported by Joe Bloggs. + +2014-04-20 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-icalendar.el: Require gnus-art. + +2014-04-20 Jan Tatarik <jan.tatarik@gmail.com> + + * gnus-icalendar.el (gnus-icalendar-event->org-entry) + (gnus-icalendar--update-org-event): put event timestamp in + the org entry body instead of the drawer. + (gnus-icalendar-event--get-attendee-names): list of participants should + contain even attendees without common name attribute. + (gnus-icalendar--update-org-event): don't generate duplicates of empty + property tags in org drawers. + +2014-04-15 Katsumi Yamaoka <yamaoka@jpl.org> + + * gmm-utils.el (gmm-format-time-string): New function. + + * message.el (message-insert-formatted-citation-line): Use the original + author's time zone to express a date string. + +2014-04-06 Stefan Monnier <monnier@iro.umontreal.ca> + + * gnus-srvr.el (gnus-tmp-how, gnus-tmp-name, gnus-tmp-where) + (gnus-tmp-status, gnus-tmp-agent, gnus-tmp-cloud) + (gnus-tmp-news-server, gnus-tmp-news-method, gnus-tmp-user-defined): + Silence compiler warnings. + (gnus-server-insert-server-line): Don't use dyn-bind var as argument. + +2014-03-24 Katsumi Yamaoka <yamaoka@jpl.org> + + * mml.el: Require url when compiling. + + * gnus-cloud.el (gnus-cloud-parse-version-1): + Use plist-get rather than CL's getf. + (gnus-activate-group, gnus-subscribe-group): Declare. + + * gnus-sum.el (gnus-mime-buttonize-attachments-in-header): Declare. + +2014-03-23 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-sum.el (gnus-summary-toggle-header): Display header attachment + buttons when toggling the header off. + +2014-03-23 Daiki Ueno <ueno@gnu.org> + + * mml2015.el (mml2015-use): Don't check the availability of GnuPG + commands here; instead, only check if epg-config.el is available. + +2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> + + * mml.el (mml-expand-html-into-multipart-related): Allow sending HTML + messages with embedded images. + (mml-generate-mime): Don't bug out if you don't have libxml. + +2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> + + * message.el (message-make-html-message-with-image-files): New command. + +2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> + + * mml.el (mml-insert-mime-headers): Allow `recipient-filename'. + +2014-03-23 David Engster <deng@randomsample.de> + + * auth-source.el (auth-source-netrc-saver): Do not depend on `cl-lib' + to stay compatible with older Emacsen, so replace `cl-loop' with + `loop'. + +2014-03-23 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-prepare, gnus-article-prepare-display): + Display header attachment buttons by gnus-article-prepare-display + rather than gnus-article-prepare so as to view in mml-preview as well. + +2014-03-23 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-goto-part): Find a button in the body first. + (gnus-mime-buttonize-attachments-in-header): Number hidden buttons. + +2014-03-23 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-mime-buttonize-attachments-in-header): + Display buttons that are hidden in unselected alternative part as well. + (gnus-mime-display-alternative): Redraw attachment buttons in header. + + * gmm-utils.el (gmm-labels): Add edebug spec. + +2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> + + * gnus-srvr.el (gnus-server-toggle-cloud-server): New command and + keystroke. + (gnus-server-toggle-cloud-server): Only allow clouding applicable + types. + +2014-03-23 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus.el (gnus-copy-overlay, gnus-overlays-at): New functions. + + * gnus-art.el (gnus-mime-display-attachment-buttons-in-header): + New user option. + (gnus-mime-buttonize-attachments-in-header): New function. + (gnus-article-prepare): Use it. + (gnus-mime-inline-part): Suppress extra newline. + (gnus-mm-display-part): Save excursion; + remove useless deleting and adding of buttons. + (gnus-insert-mime-button): Allow insertion in the middle of a line. + + * gnus-sum.el (gnus-summary-wash-mime-map, gnus-summary-article-menu): + Add gnus-mime-buttonize-attachments-in-header. + +2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> + + * nnimap.el (nnimap-request-articles): New command to download several + articles at once. + + * gnus.el (gnus-variable-list): Save Cloud variables. + +2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> + + * gnus-cloud.el: New file to provide the Emacs Cloud. + + * gravatar.el (gravatar-retrieve-synchronously): XEmacs also has + `url-retrieve-synchronously', apparently. + + * gnus-notifications.el (gravatar-retrieve-synchronously): Declare for + XEmacs. + + * nnrss.el (libxml-parse-html-region): Silence compilation error. + +2014-03-23 Daniel Dehennin <daniel.dehennin@baby-gnu.org> + + * gnus-mlspl.el (gnus-group-split-fancy): Use `gnus-parameters' in + `gnus-group-split-fancy'. + +2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> + + * message.el (message-remove-header): Doc fix. + (message-forward-included-headers): New variable. + (message-remove-ignored-headers): Use it. + +2014-03-23 Dave Abrahams <dave@boostpro.com> + + * gnus-sum.el (gnus-summary-open-group-with-article): New command. + +2014-03-23 Rasmus Pank Roulund <emacs@pank.eu> + + * gnus-fun.el (gnus-x-face-omit-files): Regexp to omit matched results + from random face commands. + (gnus-face-directory): Like `gnus-x-face-directory` for png files and + Face. + (gnus-face-omit-files): Like `gnus-x-face-omit-files` for Face. + (gnus--random-face-with-type): Generic function returning a face-type + as a string. + (gnus--insert-random-face-with-type): Generic function inserting a face + in a message buffer header. + (gnus-random-x-face): Rewritten to use `gnus--random-face-with-type`. + (gnus-insert-random-x-face-header): Rewritten to use + `gnus--insert-random-face-with-type`. + (gnus-random-face): Return random (png) Face as string. + (nus-insert-random-face-header): Insert random (png) Face in a message + buffer. + +2014-03-23 Lars Ingebrigtsen <larsi@gnus.org> + + * mm-url.el: Remove all usage of w3. + + * nnrss.el: Ditto. + + * mm-decode.el: Ditto. + + * mm-view.el: Ditto. + + * gnus-setup.el: Remove outdated file. + 2014-03-07 Lars Ingebrigtsen <larsi@gnus.org> * nnimap.el (nnimap-request-accept-article): Make respooling to nnimap diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index a50ad75063b..2efb16b8611 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el @@ -654,9 +654,11 @@ Use `auth-source-delete' in ELisp code instead of calling 'secrets are the only ones supported right now. :max N means to try to return at most N items (defaults to 1). -When 0 the function will return just t or nil to indicate if any -matches were found. More than N items may be returned, depending -on the search and the backend. +More than N items may be returned, depending on the search and +the backend. + +When :max is 0 the function will return just t or nil to indicate +if any matches were found. :host (X Y Z) means to match only hosts X, Y, or Z according to the match rules above. Defaults to t. @@ -757,18 +759,22 @@ must call it to obtain the actual value." (when auth-source-do-cache (auth-source-remember spec found))) - found)) + (if (zerop max) + (not (null found)) + found))) (defun auth-source-search-backends (backends spec max create delete require) - (let (matches) + (let ((max (if (zerop max) 1 max)) ; stop with 1 match if we're asked for zero + matches) (dolist (backend backends) - (when (> max (length matches)) ; when we need more matches... + (when (> max (length matches)) ; if we need more matches... (let* ((bmatches (apply (slot-value backend 'search-function) :backend backend :type (slot-value backend :type) ;; note we're overriding whatever the spec - ;; has for :require, :create, and :delete + ;; has for :max, :require, :create, and :delete + :max max :require require :create create :delete delete @@ -783,6 +789,7 @@ must call it to obtain the actual value." (setq matches (append matches bmatches)))))) matches)) +;; (auth-source-search :max 0) ;; (auth-source-search :max 1) ;; (funcall (plist-get (nth 0 (auth-source-search :max 1)) :secret)) ;; (auth-source-search :host "nonesuch" :type 'netrc :K 1) @@ -1524,10 +1531,10 @@ list, it matches the original pattern." (heads (if (stringp value) (list (list key value)) (mapcar (lambda (v) (list key v)) value)))) - (cl-loop + (loop for h in heads nconc - (cl-loop + (loop for tl in tails collect (append h tl)))))) @@ -1653,6 +1660,7 @@ authentication tokens: ;; (let ((auth-sources '("macos-keychain-internet:/Users/tzz/Library/Keychains/login.keychain"))) (auth-source-search :max 1)) ;; (let ((auth-sources '("macos-keychain-generic:Login"))) (auth-source-search :max 1 :host "git.gnus.org")) +;; (let ((auth-sources '("macos-keychain-generic:Login"))) (auth-source-search :max 1)) (defun* auth-source-macos-keychain-search (&rest spec diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el index 8ce29323088..70ef27a7e90 100644 --- a/lisp/gnus/gmm-utils.el +++ b/lisp/gnus/gmm-utils.el @@ -441,6 +441,39 @@ rather than relying on `lexical-binding'. `(,(progn (require 'cl) (if (fboundp 'cl-labels) 'cl-labels 'labels)) ,bindings ,@body)) (put 'gmm-labels 'lisp-indent-function 1) +(put 'gmm-labels 'edebug-form-spec '((&rest (sexp sexp &rest form)) &rest form)) + +(defun gmm-format-time-string (format-string &optional time tz) + "Use FORMAT-STRING to format the time TIME, or now if omitted. +The optional TZ specifies the time zone in a number of seconds; any +other non-nil value will be treated as 0. Note that both the format +specifiers `%Z' and `%z' will be replaced with a numeric form. " +;; FIXME: is there a smart way to replace %Z with a time zone name? + (if (and (numberp tz) (not (zerop tz))) + (let ((st 0) + (case-fold-search t) + ls nd rest) + (setq time (if time + (copy-sequence time) + (current-time))) + (if (>= (setq ls (- (cadr time) (car (current-time-zone)) (- tz))) 0) + (setcar (cdr time) ls) + (setcar (cdr time) (+ ls 65536)) + (setcar time (1- (car time)))) + (setq tz (format "%s%02d%02d" + (if (>= tz 0) "+" "-") + (/ (abs tz) 3600) + (/ (% (abs tz) 3600) 60))) + (while (string-match "%+z" format-string st) + (if (zerop (% (- (setq nd (match-end 0)) (match-beginning 0)) 2)) + (progn + (push (substring format-string st (- nd 2)) rest) + (push tz rest)) + (push (substring format-string st nd) rest)) + (setq st nd)) + (push (substring format-string st) rest) + (format-time-string (apply 'concat (nreverse rest)) time)) + (format-time-string format-string time tz))) (provide 'gmm-utils) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 29d70aa1a86..b08e523c440 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -24,9 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (eval-when-compile (require 'cl)) (defvar tool-bar-map) @@ -4728,7 +4725,10 @@ If ALL-HEADERS is non-nil, no headers are hidden." gnus-article-image-alist nil) (gnus-run-hooks 'gnus-tmp-internal-hook) (when gnus-display-mime-function - (funcall gnus-display-mime-function)))) + (funcall gnus-display-mime-function)) + ;; Add attachment buttons to the header. + (when gnus-mime-display-attachment-buttons-in-header + (gnus-mime-buttonize-attachments-in-header)))) ;;; ;;; Gnus Sticky Article Mode @@ -4987,7 +4987,6 @@ and `gnus-mime-delete-part', and not provided at run-time normally." (gnus-article-edit-article `(lambda () (buffer-disable-undo) - (erase-buffer) (let ((mail-parse-charset (or gnus-article-charset ',gnus-newsgroup-charset)) (mail-parse-ignored-charsets @@ -4995,7 +4994,14 @@ and `gnus-mime-delete-part', and not provided at run-time normally." ',gnus-newsgroup-ignored-charsets)) (mbl mml-buffer-list)) (setq mml-buffer-list nil) - (insert-buffer-substring gnus-original-article-buffer) + ;; A new text must be inserted before deleting existing ones + ;; at the end so as not to move existing markers of which + ;; the insertion type is t. + (delete-region + (point-min) + (prog1 + (goto-char (point-max)) + (insert-buffer-substring gnus-original-article-buffer))) (mime-to-mml ',handles) (setq gnus-article-mime-handles nil) (let ((mbl1 mml-buffer-list)) @@ -5300,12 +5306,26 @@ are decompressed." Compressed files like .gz and .bz2 are decompressed." (interactive (list nil current-prefix-arg)) (gnus-article-check-buffer) - (unless handle - (setq handle (get-text-property (point) 'gnus-data))) - (when handle - (let ((b (point)) - (inhibit-read-only t) - contents charset coding-system) + (let* ((inhibit-read-only t) + (b (point)) + (btn ;; position where the MIME button exists + (if handle + (if (eq handle (get-text-property b 'gnus-data)) + b + (article-goto-body) + (or (text-property-any (point) (point-max) 'gnus-data handle) + (text-property-any (point-min) (point) 'gnus-data handle))) + (setq handle (get-text-property b 'gnus-data)) + b)) + start contents charset coding-system) + (when handle + (when (= b (prog1 + btn + (setq start (next-single-property-change btn 'gnus-data + nil (point-max)) + btn (previous-single-property-change start + 'gnus-data)))) + (setq b btn)) (if (and (not arg) (mm-handle-undisplayer handle)) (mm-remove-part handle) (mm-with-unibyte-buffer @@ -5331,9 +5351,48 @@ Compressed files like .gz and .bz2 are decompressed." (mm-read-coding-system "Charset: ")))) ((mm-handle-undisplayer handle) (mm-remove-part handle))) - (forward-line 2) - (mm-display-inline handle) - (goto-char b))))) + (goto-char start) + (unless (bolp) + ;; This is a header button. + (forward-line 1)) + (mm-display-inline handle)) + ;; Toggle the button appearance between `[button]...' and `[button]'. + (goto-char btn) + (let ((displayed-p (mm-handle-displayed-p handle))) + (gnus-insert-mime-button handle (get-text-property btn 'gnus-part) + (list displayed-p)) + (if (featurep 'emacs) + (delete-region + (point) + (next-single-property-change (point) 'gnus-data nil (point-max))) + (let* ((end (next-single-property-change (point) 'gnus-data)) + (annots (annotations-at (or end (point-max))))) + (delete-region (point) + (if end + (if annots (1+ end) end) + (point-max))) + (dolist (annot annots) + (set-extent-endpoints annot (point) (point))))) + (setq start (point)) + (if (search-backward "\n\n" nil t) + (progn + (goto-char start) + (unless (or displayed-p (eolp)) + ;; Add extra newline. + (insert (propertize (buffer-substring (1- start) start) + 'gnus-undeletable t)))) + ;; We're in the article header. + (delete-char -1) + (dolist (ovl (gnus-overlays-in btn (point))) + (gnus-overlay-put ovl 'gnus-button-attachment-extra t) + (gnus-overlay-put ovl 'face nil)) + (save-restriction + (message-narrow-to-field) + (let ((gnus-treatment-function-alist + '((gnus-treat-highlight-headers + gnus-article-highlight-headers)))) + (gnus-treat-article 'head))))) + (goto-char b)))) (defun gnus-mime-set-charset-parameters (handle charset) "Set CHARSET to parameters in HANDLE. @@ -5635,54 +5694,106 @@ all parts." "Display HANDLE and fix MIME button." (let ((id (get-text-property (point) 'gnus-part)) (point (point)) - (inhibit-read-only t)) - (forward-line 1) - (prog1 - (let ((window (selected-window)) - (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets - (if (gnus-buffer-live-p gnus-summary-buffer) - (with-current-buffer gnus-summary-buffer - gnus-newsgroup-ignored-charsets) - nil))) - (save-excursion - (unwind-protect - (let ((win (gnus-get-buffer-window (current-buffer) t)) - (beg (point))) - (when win - (select-window win)) - (goto-char point) - (forward-line) - (if (mm-handle-displayed-p handle) - ;; This will remove the part. - (mm-display-part handle) - (save-restriction - (narrow-to-region (point) - (if (eobp) (point) (1+ (point)))) - (gnus-bind-safe-url-regexp (mm-display-part handle)) - ;; We narrow to the part itself and - ;; then call the treatment functions. - (goto-char (point-min)) - (forward-line 1) - (narrow-to-region (point) (point-max)) - (gnus-treat-article - nil id - (gnus-article-mime-total-parts) - (mm-handle-media-type handle))))) - (if (window-live-p window) - (select-window window))))) + (inhibit-read-only t) + (window (selected-window)) + (mail-parse-charset gnus-newsgroup-charset) + (mail-parse-ignored-charsets + (if (gnus-buffer-live-p gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer + gnus-newsgroup-ignored-charsets) + nil)) + start retval) + (unwind-protect + (progn + (let ((win (gnus-get-buffer-window (current-buffer) t))) + (when win + (select-window win) + (goto-char point))) + (setq start (next-single-property-change point 'gnus-data + nil (point-max)) + point (previous-single-property-change start 'gnus-data)) + (if (mm-handle-displayed-p handle) + ;; This will remove the part. + (setq retval (mm-display-part handle)) + (let ((part (or (and (mm-inlinable-p handle) + (mm-inlined-p handle) + t) + (with-temp-buffer + (gnus-bind-safe-url-regexp + (setq retval (mm-display-part handle))) + (unless (zerop (buffer-size)) + (buffer-string)))))) + (goto-char start) + (unless (bolp) + ;; This is a header button. + (forward-line 1)) + (cond ((stringp part) + (save-restriction + (narrow-to-region (point) + (progn + (insert part) + (unless (bolp) (insert "\n")) + (point))) + (gnus-treat-article nil id + (gnus-article-mime-total-parts) + (mm-handle-media-type handle)) + (mm-handle-set-undisplayer + handle + `(lambda () + (let ((inhibit-read-only t)) + (delete-region ,(copy-marker (point-min) t) + ,(point-max-marker))))))) + (part + (mm-display-inline handle)))))) (goto-char point) - (gnus-delete-line) - (gnus-insert-mime-button - handle id (list (mm-handle-displayed-p handle))) - (goto-char point)))) + ;; Toggle the button appearance between `[button]...' and `[button]'. + (let ((displayed-p (mm-handle-displayed-p handle))) + (gnus-insert-mime-button handle id (list displayed-p)) + (if (featurep 'emacs) + (delete-region + (point) + (next-single-property-change (point) 'gnus-data nil (point-max))) + (let* ((end (next-single-property-change (point) 'gnus-data)) + (annots (annotations-at (or end (point-max))))) + (delete-region (point) + (if end + (if annots (1+ end) end) + (point-max))) + (dolist (annot annots) + (set-extent-endpoints annot (point) (point))))) + (setq start (point)) + (if (search-backward "\n\n" nil t) + (progn + (goto-char start) + (unless (or displayed-p (eolp)) + ;; Add extra newline. + (insert (propertize (buffer-substring (1- start) start) + 'gnus-undeletable t)))) + ;; We're in the article header. + (delete-char -1) + (dolist (ovl (gnus-overlays-in point (point))) + (gnus-overlay-put ovl 'gnus-button-attachment-extra t) + (gnus-overlay-put ovl 'face nil)) + (save-restriction + (message-narrow-to-field) + (let ((gnus-treatment-function-alist + '((gnus-treat-highlight-headers + gnus-article-highlight-headers)))) + (gnus-treat-article 'head))))) + (goto-char point) + (if (window-live-p window) + (select-window window))) + retval)) (defun gnus-article-goto-part (n) "Go to MIME part N." (when gnus-break-pages (widen)) + (article-goto-body) (prog1 - (let ((start (text-property-any (point-min) (point-max) 'gnus-part n)) + (let ((start (or (text-property-any (point) (point-max) 'gnus-part n) + ;; There may be header buttons. + (text-property-any (point-min) (point) 'gnus-part n))) part handle end next handles) (when start (goto-char start) @@ -5736,8 +5847,6 @@ all parts." (concat "; " gnus-tmp-name)))) (unless (equal gnus-tmp-description "") (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long))) - (unless (bolp) - (insert "\n")) (setq b (point)) (gnus-eval-format gnus-mime-button-line-format gnus-mime-button-line-format-alist @@ -5862,6 +5971,16 @@ If displaying \"text/html\" is discouraged \(see :group 'gnus-article-mime :type 'boolean) +(defcustom gnus-mime-display-attachment-buttons-in-header t + "Add attachment buttons in the end of the header of an article. +Since MIME attachments tend to be put at the end of an article, we may +overlook them if there is a huge body. This option offers you a copy +of all non-inlinable MIME parts as buttons shown in front of an article. +If nil, don't show those extra buttons." + :version "24.5" + :group 'gnus-article-mime + :type 'boolean) + (defun gnus-mime-display-part (handle) (cond ;; Maybe a broken MIME message. @@ -5884,14 +6003,6 @@ If displaying \"text/html\" is discouraged \(see ((and (equal (car handle) "multipart/related") (not (or gnus-mime-display-multipart-as-mixed gnus-mime-display-multipart-related-as-mixed))) - ;;;!!!We should find the start part, but we just default - ;;;!!!to the first part. - ;;(gnus-mime-display-part (cadr handle)) - ;;;!!! Most multipart/related is an HTML message plus images. - ;;;!!! Unfortunately we are unable to let W3 display those - ;;;!!! included images, so we just display it as a mixed multipart. - ;;(gnus-mime-display-mixed (cdr handle)) - ;;;!!! No, w3 can display everything just fine. (gnus-mime-display-part (cadr handle))) ((equal (car handle) "multipart/signed") (gnus-add-wash-type 'signed) @@ -5915,7 +6026,6 @@ If displaying \"text/html\" is discouraged \(see (let ((type (mm-handle-media-type handle)) (ignored gnus-ignored-mime-types) (not-attachment t) - (move nil) display text) (catch 'ignored (progn @@ -5941,9 +6051,11 @@ If displaying \"text/html\" is discouraged \(see (setq display t) (when (equal (mm-handle-media-supertype handle) "text") (setq text t))) - (let ((id (1+ (length gnus-article-mime-handle-alist))) + (let ((id (car (rassq handle gnus-article-mime-handle-alist))) beg) - (push (cons id handle) gnus-article-mime-handle-alist) + (unless id + (setq id (1+ (length gnus-article-mime-handle-alist))) + (push (cons id handle) gnus-article-mime-handle-alist)) (when (and display (equal (mm-handle-media-supertype handle) "message")) (insert-char @@ -5955,31 +6067,28 @@ If displaying \"text/html\" is discouraged \(see (not (gnus-unbuttonized-mime-type-p type)) (eq id gnus-mime-buttonized-part-id)) (gnus-insert-mime-button - handle id (list (or display (and not-attachment text)))) - (gnus-article-insert-newline) - ;; Remember modify the number of forward lines. - (setq move t)) + handle id (list (or display (and not-attachment text))))) (setq beg (point)) (cond (display - (when move - (forward-line -1) - (setq beg (point))) (let ((mail-parse-charset gnus-newsgroup-charset) (mail-parse-ignored-charsets (save-excursion (condition-case () (set-buffer gnus-summary-buffer) (error)) gnus-newsgroup-ignored-charsets))) - (gnus-bind-safe-url-regexp (mm-display-part handle t))) - (goto-char (point-max))) + (gnus-bind-safe-url-regexp (mm-display-part handle t)))) ((and text not-attachment) - (when move - (forward-line -1) - (setq beg (point))) - (gnus-article-insert-newline) - (mm-display-inline handle) - (goto-char (point-max)))) + (mm-display-inline handle))) + (goto-char (point-max)) + (if (string-match "\\`image/" type) + (gnus-article-insert-newline) + (if (prog1 + (= (skip-chars-backward "\n") -1) + (forward-char 1)) + (gnus-article-insert-newline) + (put-text-property (point) (point-max) 'gnus-undeletable t)) + (goto-char (point-max))) ;; Do highlighting. (save-excursion (save-restriction @@ -6110,7 +6219,10 @@ If displaying \"text/html\" is discouraged \(see (goto-char (point-max)) (setcdr begend (point-marker))))) (when ibegend - (goto-char point)))) + (goto-char point))) + ;; Redraw attachment buttons in the header. + (when gnus-mime-display-attachment-buttons-in-header + (gnus-mime-buttonize-attachments-in-header))) (defconst gnus-article-wash-status-strings (let ((alist '((cite "c" "Possible hidden citation text" @@ -6216,6 +6328,116 @@ Provided for backwards compatibility." (when image (gnus-add-image 'shr image)))) +(defun gnus-mime-buttonize-attachments-in-header (&optional interactive) + "Show attachments as buttons in the end of the header of an article. +This function toggles the display when called interactively. Note that +buttons to be added to the header are only the ones that aren't inlined +in the body. Use `gnus-header-face-alist' to highlight buttons." + (interactive (list t)) + (gnus-with-article-buffer + (gmm-labels + ;; Function that returns a flattened version of + ;; `gnus-article-mime-handle-alist'. + ((flattened-alist + (&optional alist id all) + (if alist + (let ((i 1) newid flat) + (dolist (handle alist flat) + (setq newid (append id (list i)) + i (1+ i)) + (if (stringp (car handle)) + (setq flat (nconc flat (flattened-alist (cdr handle) + newid all))) + (delq (rassq handle all) all) + (setq flat (nconc flat (list (cons newid handle))))))) + (let ((flat (list nil))) + ;; Assume that elements of `gnus-article-mime-handle-alist' + ;; are in the decreasing order, but unnumbered subsidiaries + ;; in each element are in the increasing order. + (dolist (handle (reverse gnus-article-mime-handle-alist)) + (if (stringp (cadr handle)) + (setq flat (nconc flat (flattened-alist (cddr handle) + (list (car handle)) + flat))) + (delq (rassq (cdr handle) flat) flat) + (setq flat (nconc flat (list (cons (list (car handle)) + (cdr handle))))))) + (setq flat (cdr flat)) + (mapc (lambda (handle) + (if (cdar handle) + ;; This is a hidden (i.e. unnumbered) handle. + (progn + (setcar handle + (1+ (caar gnus-article-mime-handle-alist))) + (push handle gnus-article-mime-handle-alist)) + (setcar handle (caar handle)))) + flat) + flat)))) + (let ((case-fold-search t) buttons handle type st) + (save-excursion + (save-restriction + (widen) + (article-narrow-to-head) + ;; Header buttons exist? + (while (and (not buttons) + (re-search-forward "^attachments?:[\n ]+" nil t)) + (when (get-char-property (match-end 0) + 'gnus-button-attachment-extra) + (setq buttons (match-beginning 0)))) + (widen) + (when buttons + ;; Delete header buttons. + (delete-region buttons (if (re-search-forward "^[^ ]" nil t) + (match-beginning 0) + (point-max)))) + (unless (and interactive buttons) + ;; Find buttons. + (setq buttons nil) + (dolist (button (flattened-alist)) + (setq handle (cdr button) + type (mm-handle-media-type handle)) + (when (or (and (if (gnus-buffer-live-p gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer + gnus-inhibit-images) + gnus-inhibit-images) + (string-match "\\`image/" type)) + (mm-inline-override-p handle) + (and (mm-handle-disposition handle) + (not (equal (car (mm-handle-disposition handle)) + "inline")) + (not (mm-attachment-override-p handle))) + (not (mm-automatic-display-p handle)) + (not (or (and (mm-inlinable-p handle) + (mm-inlined-p handle)) + (mm-automatic-external-display-p type)))) + (push button buttons))) + (when buttons + ;; Add header buttons. + (article-goto-body) + (forward-line -1) + (narrow-to-region (point) (point)) + (insert "Attachment" (if (cdr buttons) "s" "") ":") + (dolist (button (nreverse buttons)) + (setq st (point)) + (insert " ") + (mm-handle-set-undisplayer + (setq handle (copy-sequence (cdr button))) nil) + (gnus-insert-mime-button handle (car button)) + (skip-chars-backward "\t\n ") + (delete-region (point) (point-max)) + (when (> (current-column) (window-width)) + (goto-char st) + (insert "\n") + (end-of-line))) + (insert "\n") + (dolist (ovl (gnus-overlays-in (point-min) (point))) + (gnus-overlay-put ovl 'gnus-button-attachment-extra t) + (gnus-overlay-put ovl 'face nil)) + (let ((gnus-treatment-function-alist + '((gnus-treat-highlight-headers + gnus-article-highlight-headers)))) + (gnus-treat-article 'head)))))))))) + ;;; Article savers. (defun gnus-output-to-file (file-name) @@ -6584,7 +6806,7 @@ not have a face in `gnus-article-boring-faces'." (when (eq obuf (current-buffer)) (set-buffer in-buffer) t)) - (setq selected (gnus-summary-select-article)) + (setq selected (ignore-errors (gnus-summary-select-article))) (set-buffer obuf) (unless not-restore-window (set-window-configuration owin)) diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index d58acbd18ca..544d6672a8c 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el @@ -24,10 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) (require 'gnus) diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index db6a0f63e38..5a6d6f8f243 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el @@ -1204,7 +1204,8 @@ When enabled, it automatically turns on `font-lock-mode'." nil ;; init-value "" ;; lighter nil ;; keymap - (when (eq major-mode 'message-mode) + (when (eq major-mode 'message-mode) ;FIXME: Use derived-mode-p. + ;; FIXME: Use font-lock-add-keywords! (let ((defaults (car (if (featurep 'xemacs) (get 'message-mode 'font-lock-defaults) font-lock-defaults))) @@ -1233,8 +1234,10 @@ When enabled, it automatically turns on `font-lock-mode'." font-lock-keywords nil)) (setq font-lock-set-defaults nil)) (font-lock-set-defaults) - (cond ((symbol-value 'font-lock-mode) - (font-lock-fontify-buffer)) + (cond (font-lock-mode + (if (fboundp 'font-lock-flush) + (font-lock-flush) + (font-lock-fontify-buffer))) (gnus-message-citation-mode (font-lock-mode 1))))) diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el new file mode 100644 index 00000000000..c47976bdcfa --- /dev/null +++ b/lisp/gnus/gnus-cloud.el @@ -0,0 +1,332 @@ +;;; gnus-cloud.el --- storing and retrieving data via IMAP + +;; Copyright (C) 2014 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> +;; Keywords: 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 'parse-time) +(require 'nnimap) + +(defgroup gnus-cloud nil + "Syncing Gnus data via IMAP." + :group 'gnus) + +(defcustom gnus-cloud-synced-files + '(;;"~/.authinfo" + "~/.authinfo.gpg" + "~/.gnus.el" + (:directory "~/News" :match ".*.SCORE\\'")) + "List of file regexps that should be kept up-to-date via the cloud." + :group 'gnus-cloud + :type '(repeat regexp)) + +(defvar gnus-cloud-group-name "*Emacs Cloud*") +(defvar gnus-cloud-covered-servers nil) + +(defvar gnus-cloud-version 1) +(defvar gnus-cloud-sequence 1) + +(defvar gnus-cloud-method nil + "The IMAP select method used to store the cloud data.") + +(defun gnus-cloud-make-chunk (elems) + (with-temp-buffer + (insert (format "Version %s\n" gnus-cloud-version)) + (insert (gnus-cloud-insert-data elems)) + (buffer-string))) + +(defun gnus-cloud-insert-data (elems) + (mm-with-unibyte-buffer + (dolist (elem elems) + (cond + ((eq (plist-get elem :type) :file) + (let (length data) + (mm-with-unibyte-buffer + (insert-file-contents-literally (plist-get elem :file-name)) + (setq length (buffer-size) + data (buffer-string))) + (insert (format "(:type :file :file-name %S :timestamp %S :length %d)\n" + (plist-get elem :file-name) + (plist-get elem :timestamp) + length)) + (insert data) + (insert "\n"))) + ((eq (plist-get elem :type) :data) + (insert (format "(:type :data :name %S :length %d)\n" + (plist-get elem :name) + (with-current-buffer (plist-get elem :buffer) + (buffer-size)))) + (insert-buffer-substring (plist-get elem :buffer)) + (insert "\n")) + ((eq (plist-get elem :type) :delete) + (insert (format "(:type :delete :file-name %S)\n" + (plist-get elem :file-name)))))) + (gnus-cloud-encode-data) + (buffer-string))) + +(defun gnus-cloud-encode-data () + (call-process-region (point-min) (point-max) "gzip" + t (current-buffer) nil + "-c") + (base64-encode-region (point-min) (point-max))) + +(defun gnus-cloud-decode-data () + (base64-decode-region (point-min) (point-max)) + (call-process-region (point-min) (point-max) "gunzip" + t (current-buffer) nil + "-c")) + +(defun gnus-cloud-parse-chunk () + (save-excursion + (goto-char (point-min)) + (unless (looking-at "Version \\([0-9]+\\)") + (error "Not a valid Cloud chunk in the current buffer")) + (forward-line 1) + (let ((version (string-to-number (match-string 1))) + (data (buffer-substring (point) (point-max)))) + (mm-with-unibyte-buffer + (insert data) + (cond + ((= version 1) + (gnus-cloud-decode-data) + (goto-char (point-min)) + (gnus-cloud-parse-version-1)) + (t + (error "Unsupported Cloud chunk version %s" version))))))) + +(defun gnus-cloud-parse-version-1 () + (let ((elems nil)) + (while (not (eobp)) + (while (and (not (eobp)) + (not (looking-at "(:type"))) + (forward-line 1)) + (unless (eobp) + (let ((spec (ignore-errors (read (current-buffer)))) + length) + (when (and (consp spec) + (memq (plist-get spec :type) '(:file :data :deleta))) + (setq length (plist-get spec :length)) + (push (append spec + (list + :contents (buffer-substring (1+ (point)) + (+ (point) 1 length)))) + elems) + (goto-char (+ (point) 1 length)))))) + (nreverse elems))) + +(defun gnus-cloud-update-data (elems) + (dolist (elem elems) + (let ((type (plist-get elem :type))) + (cond + ((eq type :data) + ) + ((eq type :delete) + (gnus-cloud-delete-file (plist-get elem :file-name)) + ) + ((eq type :file) + (gnus-cloud-update-file elem)) + (t + (message "Unknown type %s; ignoring" type)))))) + +(defun gnus-cloud-update-file (elem) + (let ((file-name (plist-get elem :file-name)) + (date (plist-get elem :timestamp)) + (contents (plist-get elem :contents))) + (unless (gnus-cloud-file-covered-p file-name) + (message "%s isn't covered by the cloud; ignoring" file-name)) + (when (or (not (file-exists-p file-name)) + (and (file-exists-p file-name) + (mm-with-unibyte-buffer + (insert-file-contents-literally file-name) + (not (equal (buffer-string) contents))))) + (gnus-cloud-replace-file file-name date contents)))) + +(defun gnus-cloud-replace-file (file-name date new-contents) + (mm-with-unibyte-buffer + (insert new-contents) + (when (file-exists-p file-name) + (rename-file file-name (car (find-backup-file-name file-name)))) + (write-region (point-min) (point-max) file-name) + (set-file-times file-name (parse-iso8601-time-string date)))) + +(defun gnus-cloud-delete-file (file-name) + (unless (gnus-cloud-file-covered-p file-name) + (message "%s isn't covered by the cloud; ignoring" file-name)) + (when (file-exists-p file-name) + (rename-file file-name (car (find-backup-file-name file-name))))) + +(defun gnus-cloud-file-covered-p (file-name) + (let ((matched nil)) + (dolist (elem gnus-cloud-synced-files) + (cond + ((stringp elem) + (when (equal elem file-name) + (setq matched t))) + ((consp elem) + (when (and (equal (directory-file-name (plist-get elem :directory)) + (directory-file-name (file-name-directory file-name))) + (string-match (plist-get elem :match) + (file-name-nondirectory file-name))) + (setq matched t))))) + matched)) + +(defun gnus-cloud-all-files () + (let ((files nil)) + (dolist (elem gnus-cloud-synced-files) + (cond + ((stringp elem) + (push elem files)) + ((consp elem) + (dolist (file (directory-files (plist-get elem :directory) + nil + (plist-get elem :match))) + (push (format "%s/%s" + (directory-file-name (plist-get elem :directory)) + file) + files))))) + (nreverse files))) + +(defvar gnus-cloud-file-timestamps nil) + +(defun gnus-cloud-files-to-upload (&optional full) + (let ((files nil) + timestamp) + (dolist (file (gnus-cloud-all-files)) + (if (file-exists-p file) + (when (setq timestamp (gnus-cloud-file-new-p file full)) + (push `(:type :file :file-name ,file :timestamp ,timestamp) files)) + (when (assoc file gnus-cloud-file-timestamps) + (push `(:type :delete :file-name ,file) files)))) + (nreverse files))) + +(defun gnus-cloud-file-new-p (file full) + (let ((timestamp (format-time-string + "%FT%T%z" (nth 5 (file-attributes file)))) + (old (cadr (assoc file gnus-cloud-file-timestamps)))) + (when (or full + (null old) + (string< old timestamp)) + timestamp))) + +(declare-function gnus-activate-group "gnus-start" + (group &optional scan dont-check method dont-sub-check)) +(declare-function gnus-subscribe-group "gnus-start" + (group &optional previous method)) + +(defun gnus-cloud-ensure-cloud-group () + (let ((method (if (stringp gnus-cloud-method) + (gnus-server-to-method gnus-cloud-method) + gnus-cloud-method))) + (unless (or (gnus-active gnus-cloud-group-name) + (gnus-activate-group gnus-cloud-group-name nil nil + gnus-cloud-method)) + (and (gnus-request-create-group gnus-cloud-group-name gnus-cloud-method) + (gnus-activate-group gnus-cloud-group-name nil nil gnus-cloud-method) + (gnus-subscribe-group gnus-cloud-group-name))))) + +(defun gnus-cloud-upload-data (&optional full) + (gnus-cloud-ensure-cloud-group) + (with-temp-buffer + (let ((elems (gnus-cloud-files-to-upload full))) + (insert (format "Subject: (sequence: %d type: %s)\n" + gnus-cloud-sequence + (if full :full :partial))) + (insert "From: nobody@invalid.com\n") + (insert "\n") + (insert (gnus-cloud-make-chunk elems)) + (when (gnus-request-accept-article gnus-cloud-group-name gnus-cloud-method + t t) + (setq gnus-cloud-sequence (1+ gnus-cloud-sequence)) + (gnus-cloud-add-timestamps elems))))) + +(defun gnus-cloud-add-timestamps (elems) + (dolist (elem elems) + (let* ((file-name (plist-get elem :file-name)) + (old (assoc file-name gnus-cloud-file-timestamps))) + (when old + (setq gnus-cloud-file-timestamps + (delq old gnus-cloud-file-timestamps))) + (push (list file-name (plist-get elem :timestamp)) + gnus-cloud-file-timestamps)))) + +(defun gnus-cloud-available-chunks () + (gnus-activate-group gnus-cloud-group-name nil nil gnus-cloud-method) + (let* ((group (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method)) + (active (gnus-active group)) + headers head) + (when (gnus-retrieve-headers (gnus-uncompress-range active) group) + (with-current-buffer nntp-server-buffer + (goto-char (point-min)) + (while (and (not (eobp)) + (setq head (nnheader-parse-head))) + (push head headers)))) + (sort (nreverse headers) + (lambda (h1 h2) + (> (gnus-cloud-chunk-sequence (mail-header-subject h1)) + (gnus-cloud-chunk-sequence (mail-header-subject h2))))))) + +(defun gnus-cloud-chunk-sequence (string) + (if (string-match "sequence: \\([0-9]+\\)" string) + (string-to-number (match-string 1 string)) + 0)) + +(defun gnus-cloud-prune-old-chunks (headers) + (let ((headers (reverse headers)) + (found nil)) + (while (and headers + (not found)) + (when (string-match "type: :full" (mail-header-subject (car headers))) + (setq found t)) + (pop headers)) + ;; All the chunks that are older than the newest :full chunk can be + ;; deleted. + (when headers + (gnus-request-expire-articles + (mapcar (lambda (h) + (mail-header-number h)) + (nreverse headers)) + (gnus-group-full-name gnus-cloud-group-name gnus-cloud-method))))) + +(defun gnus-cloud-download-data () + (let ((articles nil) + chunks) + (dolist (header (gnus-cloud-available-chunks)) + (when (> (gnus-cloud-chunk-sequence (mail-header-subject header)) + gnus-cloud-sequence) + (push (mail-header-number header) articles))) + (when articles + (nnimap-request-articles (nreverse articles) gnus-cloud-group-name) + (with-current-buffer nntp-server-buffer + (goto-char (point-min)) + (while (re-search-forward "^Version " nil t) + (beginning-of-line) + (push (gnus-cloud-parse-chunk) chunks) + (forward-line 1)))))) + +(defun gnus-cloud-server-p (server) + (member server gnus-cloud-covered-servers)) + +(provide 'gnus-cloud) + +;;; gnus-cloud.el ends here diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el index 28c6a4d3312..e0d1578f49a 100644 --- a/lisp/gnus/gnus-fun.el +++ b/lisp/gnus/gnus-fun.el @@ -24,10 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) @@ -44,6 +40,24 @@ :group 'gnus-fun :type 'directory) +(defcustom gnus-x-face-omit-files nil + "Regexp to match faces in `gnus-x-face-directory' to be omitted." + :version "24.5" + :group 'gnus-fun + :type 'string) + +(defcustom gnus-face-directory (expand-file-name "faces" gnus-directory) + "*Directory where Face PNG files are stored." + :version "24.5" + :group 'gnus-fun + :type 'directory) + +(defcustom gnus-face-omit-files nil + "Regexp to match faces in `gnus-face-directory' to be omitted." + :version "24.5" + :group 'gnus-fun + :type 'string) + (defcustom gnus-convert-pbm-to-x-face-command "pbmtoxbm %s | compface" "Command for converting a PBM to an X-Face." :version "22.1" @@ -86,35 +100,57 @@ PNG format." nil shell-command-switch command))) ;;;###autoload -(defun gnus-random-x-face () - "Return X-Face header data chosen randomly from `gnus-x-face-directory'." - (interactive) - (when (file-exists-p gnus-x-face-directory) - (let* ((files (directory-files gnus-x-face-directory t "\\.pbm$")) - (file (nth (random (length files)) files))) +(defun gnus--random-face-with-type (dir ext omit fun) + "Return file from DIR with extension EXT, omitting matches of OMIT, processed by FUN." + (when (file-exists-p dir) + (let* ((files + (remove nil (mapcar + (lambda (f) (unless (string-match (or omit "^$") f) f)) + (directory-files dir t ext)))) + (file (nth (random (length files)) files))) (when file - (gnus-shell-command-to-string - (format gnus-convert-pbm-to-x-face-command - (shell-quote-argument file))))))) + (funcall fun file))))) +;;;###autoload (autoload 'message-goto-eoh "message" nil t) +(autoload 'message-insert-header "message" nil t) + +(defun gnus--insert-random-face-with-type (fun type) + "Get a random face using FUN and insert it as a header TYPE. + +For instance, to insert an X-Face use `gnus-random-x-face' as FUN + and \"X-Face\" as TYPE." + (let ((data (funcall fun))) + (save-excursion + (if data + (progn (message-goto-eoh) + (insert type ": " data "\n")) + (message + "No face returned by the function %s." (symbol-name fun)))))) + + + +;;;###autoload +(defun gnus-random-x-face () + "Return X-Face header data chosen randomly from `gnus-x-face-directory'. + +Files matching `gnus-x-face-omit-files' are not considered." + (interactive) + (gnus--random-face-with-type gnus-x-face-directory "\\.pbm$" gnus-x-face-omit-files + (lambda (file) + (gnus-shell-command-to-string + (format gnus-convert-pbm-to-x-face-command + (shell-quote-argument file)))))) ;;;###autoload (defun gnus-insert-random-x-face-header () "Insert a random X-Face header from `gnus-x-face-directory'." (interactive) - (let ((data (gnus-random-x-face))) - (save-excursion - (message-goto-eoh) - (if data - (insert "X-Face: " data) - (message - "No face returned by `gnus-random-x-face'. Does %s/*.pbm exist?" - gnus-x-face-directory))))) + (gnus--insert-random-face-with-type 'gnus-random-x-face 'X-Face)) ;;;###autoload (defun gnus-x-face-from-file (file) - "Insert an X-Face header based on an image file. + "Insert an X-Face header based on an image FILE. Depending on `gnus-convert-image-to-x-face-command' it may accept different input formats." @@ -126,7 +162,7 @@ different input formats." ;;;###autoload (defun gnus-face-from-file (file) - "Return a Face header based on an image file. + "Return a Face header based on an image FILE. Depending on `gnus-convert-image-to-face-command' it may accept different input formats." @@ -191,6 +227,21 @@ FILE should be a PNG file that's 48x48 and smaller than or equal to (buffer-size))) (gnus-face-encode))) +;;;###autoload +(defun gnus-random-face () + "Return randomly chosen Face from `gnus-face-directory'. + +Files matching `gnus-face-omit-files' are not considered." + (interactive) + (gnus--random-face-with-type gnus-face-directory "\\.png$" + gnus-face-omit-files + 'gnus-convert-png-to-face)) + +;;;###autoload +(defun gnus-insert-random-face-header () + "Insert a randome Face header from `gnus-face-directory'." + (gnus--insert-random-face-with-type 'gnus-random-face 'Face)) + (defface gnus-x-face '((t (:foreground "black" :background "white"))) "Face to show X-Face. The colors from this face are used as the foreground and background diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index d8260b40434..31078be48aa 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -24,10 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) (defvar tool-bar-mode) diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index 90947fe4d8c..540694f34fb 100644 --- a/lisp/gnus/gnus-html.el +++ b/lisp/gnus/gnus-html.el @@ -28,10 +28,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) (require 'gnus-art) diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index 79f1e2fe203..9027c53a6f3 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el @@ -38,6 +38,7 @@ (require 'gmm-utils) (require 'mm-decode) (require 'gnus-sum) +(require 'gnus-art) (eval-when-compile (require 'cl)) @@ -170,7 +171,9 @@ (caddr event)))) (gmm-labels ((attendee-role (prop) (plist-get (cadr prop) 'ROLE)) - (attendee-name (prop) (plist-get (cadr prop) 'CN)) + (attendee-name (prop) + (or (plist-get (cadr prop) 'CN) + (replace-regexp-in-string "^.*MAILTO:" "" (caddr prop)))) (attendees-by-type (type) (gnus-remove-if-not (lambda (p) (string= (attendee-role p) type)) @@ -452,7 +455,6 @@ Return nil for non-recurring EVENT." "Not replied yet")) (props `(("ICAL_EVENT" . "t") ("ID" . ,uid) - ("DT" . ,(gnus-icalendar-event:org-timestamp event)) ("ORGANIZER" . ,(gnus-icalendar-event:organizer event)) ("LOCATION" . ,(gnus-icalendar-event:location event)) ("PARTICIPATION_TYPE" . ,(symbol-name (gnus-icalendar-event:participation-type event))) @@ -470,7 +472,9 @@ Return nil for non-recurring EVENT." (when description (save-restriction (narrow-to-region (point) (point)) - (insert description) + (insert (gnus-icalendar-event:org-timestamp event) + "\n\n" + description) (indent-region (point-min) (point-max) 2) (fill-region (point-min) (point-max)))) @@ -551,20 +555,31 @@ is searched." (when description (save-restriction (narrow-to-region (point) (point)) - (insert "\n" (replace-regexp-in-string "[\n]+$" "\n" description) "\n") + (insert "\n" + (gnus-icalendar-event:org-timestamp event) + "\n\n" + (replace-regexp-in-string "[\n]+$" "\n" description) + "\n") (indent-region (point-min) (point-max) (1+ entry-outline-level)) (fill-region (point-min) (point-max)))) ;; update entry properties - (org-entry-put event-pos "DT" (gnus-icalendar-event:org-timestamp event)) - (org-entry-put event-pos "ORGANIZER" organizer) - (org-entry-put event-pos "LOCATION" location) - (org-entry-put event-pos "PARTICIPATION_TYPE" (symbol-name participation-type)) - (org-entry-put event-pos "REQ_PARTICIPANTS" (gnus-icalendar--format-participant-list req-participants)) - (org-entry-put event-pos "OPT_PARTICIPANTS" (gnus-icalendar--format-participant-list opt-participants)) - (org-entry-put event-pos "RRULE" recur) - (when reply-status (org-entry-put event-pos "REPLY" - (capitalize (symbol-name reply-status)))) + (gmm-labels + ((update-org-entry (position property value) + (if (or (null value) + (string= value "")) + (org-entry-delete position property) + (org-entry-put position property value)))) + + (update-org-entry event-pos "ORGANIZER" organizer) + (update-org-entry event-pos "LOCATION" location) + (update-org-entry event-pos "PARTICIPATION_TYPE" (symbol-name participation-type)) + (update-org-entry event-pos "REQ_PARTICIPANTS" (gnus-icalendar--format-participant-list req-participants)) + (update-org-entry event-pos "OPT_PARTICIPANTS" (gnus-icalendar--format-participant-list opt-participants)) + (update-org-entry event-pos "RRULE" recur) + (update-org-entry event-pos "REPLY" + (if reply-status (capitalize (symbol-name reply-status)) + "Not replied yet"))) (save-buffer))))))))) diff --git a/lisp/gnus/gnus-mlspl.el b/lisp/gnus/gnus-mlspl.el index 8dec6f24217..2d86d0b81ad 100644 --- a/lisp/gnus/gnus-mlspl.el +++ b/lisp/gnus/gnus-mlspl.el @@ -146,20 +146,27 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\") returns: (any \"\\\\(foo@nowhere\\\\.gov\\\\|foo@localhost\\\\|foo-redist@home\\\\)\" - \"bugs-foo\" - \"rambling-foo\" \"mail.foo\")) \"mail.others\")" - (let* ((newsrc (cdr gnus-newsrc-alist)) - split) - (dolist (info newsrc) - (let ((group (gnus-info-group info)) - (params (gnus-info-params info))) - ;; For all GROUPs that match the specified GROUPS - (when (or (not groups) - (and (listp groups) - (memq group groups)) - (and (stringp groups) - (string-match groups group))) - (let ((split-spec (assoc 'split-spec params)) group-clean) - ;; Remove backend from group name - (setq group-clean (string-match ":" group)) + (let ((group-names (if (and (listp groups) + (not (null groups))) + groups + (delete-dups + (delq nil + (mapcar + (lambda (info) + (let ((group (gnus-info-group info))) + (if (or (not groups) + (and (stringp groups) + (string-match groups group))) + group))) + (append gnus-newsrc-alist gnus-parameters)))))) + split) + (dolist (group group-names) + (let ((params (gnus-group-find-parameter group))) + ;; Skip groups without param (or nonexistent) + (when (not (null params)) + (let ((split-spec (assoc 'split-spec params)) group-clean) + ;; Remove backend from group name + (setq group-clean (string-match ":" group)) (setq group-clean (if group-clean (substring group (1+ group-clean)) diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el index 0621c23c20c..ee1083d8005 100644 --- a/lisp/gnus/gnus-notifications.el +++ b/lisp/gnus/gnus-notifications.el @@ -102,6 +102,9 @@ Return a notification id if any, or t on success." ;; Don't return an id t)) +(declare-function gravatar-retrieve-synchronously "gravatar.el" + (mail-address)) + (defun gnus-notifications-get-photo (mail-address) "Get photo for mail address." (let ((google-photo (when (and gnus-notifications-use-google-contacts diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el index 83629df1713..05301673a50 100644 --- a/lisp/gnus/gnus-picon.el +++ b/lisp/gnus/gnus-picon.el @@ -37,10 +37,6 @@ ;; ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) (require 'gnus) diff --git a/lisp/gnus/gnus-setup.el b/lisp/gnus/gnus-setup.el deleted file mode 100644 index 7ef8dc52530..00000000000 --- a/lisp/gnus/gnus-setup.el +++ /dev/null @@ -1,191 +0,0 @@ -;;; gnus-setup.el --- Initialization & Setup for Gnus 5 - -;; Copyright (C) 1995-1996, 2000-2014 Free Software Foundation, Inc. - -;; Author: Steven L. Baur <steve@miranova.com> -;; 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: -;; My head is starting to spin with all the different mail/news packages. -;; Stop The Madness! - -;; Given that Emacs Lisp byte codes may be diverging, it is probably best -;; not to byte compile this, and just arrange to have the .el loaded out -;; of .emacs. - -;;; Code: - -(eval-when-compile (require 'cl)) - -(defvar gnus-use-installed-gnus t - "*If non-nil use installed version of Gnus.") - -(defvar gnus-use-installed-mailcrypt (featurep 'xemacs) - "*If non-nil use installed version of mailcrypt.") - -(defvar gnus-emacs-lisp-directory (if (featurep 'xemacs) - "/usr/local/lib/xemacs/" - "/usr/local/share/emacs/") - "Directory where Emacs site lisp is located.") - -(defvar gnus-gnus-lisp-directory (concat gnus-emacs-lisp-directory - "gnus/lisp/") - "Directory where Gnus Emacs lisp is found.") - -(defvar gnus-mailcrypt-lisp-directory (concat gnus-emacs-lisp-directory - "site-lisp/mailcrypt/") - "Directory where Mailcrypt Emacs Lisp is found.") - -(defvar gnus-bbdb-lisp-directory (concat gnus-emacs-lisp-directory - "site-lisp/bbdb/") - "Directory where Big Brother Database is found.") - -(defvar gnus-use-mhe nil - "Set this if you want to use MH-E for mail reading.") -(defvar gnus-use-rmail nil - "Set this if you want to use RMAIL for mail reading.") -(defvar gnus-use-sendmail nil - "Set this if you want to use SENDMAIL for mail reading.") -(defvar gnus-use-vm nil - "Set this if you want to use the VM package for mail reading.") -(defvar gnus-use-sc nil - "Set this if you want to use Supercite.") -(defvar gnus-use-mailcrypt t - "Set this if you want to use Mailcrypt for dealing with PGP messages.") -(defvar gnus-use-bbdb nil - "Set this if you want to use the Big Brother DataBase.") - -(when (and (not gnus-use-installed-gnus) - (null (member gnus-gnus-lisp-directory load-path))) - (push gnus-gnus-lisp-directory load-path)) - -;;; We can't do this until we know where Gnus is. -(require 'message) - -;;; Mailcrypt by -;;; Jin Choi <jin@atype.com> -;;; Patrick LoPresti <patl@lcs.mit.edu> - -(when gnus-use-mailcrypt - (when (and (not gnus-use-installed-mailcrypt) - (null (member gnus-mailcrypt-lisp-directory load-path))) - (setq load-path (cons gnus-mailcrypt-lisp-directory load-path))) - (autoload 'mc-install-write-mode "mailcrypt" nil t) - (autoload 'mc-install-read-mode "mailcrypt" nil t) -;;; (add-hook 'message-mode-hook 'mc-install-write-mode) -;;; (add-hook 'gnus-summary-mode-hook 'mc-install-read-mode) - (when gnus-use-mhe - (add-hook 'mh-folder-mode-hook 'mc-install-read-mode) - (add-hook 'mh-letter-mode-hook 'mc-install-write-mode))) - -;;; BBDB by -;;; Jamie Zawinski <jwz@lucid.com> - -(when gnus-use-bbdb - ;; bbdb will never be installed with emacs. - (when (null (member gnus-bbdb-lisp-directory load-path)) - (setq load-path (cons gnus-bbdb-lisp-directory load-path))) - (autoload 'bbdb "bbdb-com" - "Insidious Big Brother Database" t) - (autoload 'bbdb-name "bbdb-com" - "Insidious Big Brother Database" t) - (autoload 'bbdb-company "bbdb-com" - "Insidious Big Brother Database" t) - (autoload 'bbdb-net "bbdb-com" - "Insidious Big Brother Database" t) - (autoload 'bbdb-notes "bbdb-com" - "Insidious Big Brother Database" t) - - (when gnus-use-vm - (autoload 'bbdb-insinuate-vm "bbdb-vm" - "Hook BBDB into VM" t)) - - (when gnus-use-rmail - (autoload 'bbdb-insinuate-rmail "bbdb-rmail" - "Hook BBDB into RMAIL" t) - (add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail)) - - (when gnus-use-mhe - (autoload 'bbdb-insinuate-mh "bbdb-mh" - "Hook BBDB into MH-E" t) - (add-hook 'mh-folder-mode-hook 'bbdb-insinuate-mh)) - - (autoload 'bbdb-insinuate-gnus "bbdb-gnus" - "Hook BBDB into Gnus" t) - (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus) - - (when gnus-use-sendmail - (autoload 'bbdb-insinuate-sendmail "bbdb" - "Insidious Big Brother Database" t) - (add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail) - (add-hook 'message-setup-hook 'bbdb-insinuate-sendmail))) - -(when gnus-use-sc - (add-hook 'mail-citation-hook 'sc-cite-original) - (setq message-cite-function 'sc-cite-original)) - -;;;### (autoloads (gnus gnus-slave gnus-no-server) "gnus" "lisp/gnus.el" (12473 2137)) -;;; Generated autoloads from lisp/gnus.el - -;; Don't redo this if autoloads already exist -(unless (fboundp 'gnus) - (autoload 'gnus-slave-no-server "gnus" "\ -Read network news as a slave without connecting to local server." t nil) - - (autoload 'gnus-no-server "gnus" "\ -Read network news. -If ARG is a positive number, Gnus will use that as the -startup level. If ARG is nil, Gnus will be started at level 2. -If ARG is non-nil and not a positive number, Gnus will -prompt the user for the name of an NNTP server to use. -As opposed to `gnus', this command will not connect to the local server." t nil) - - (autoload 'gnus-slave "gnus" "\ -Read news as a slave." t nil) - - (autoload 'gnus "gnus" "\ -Read network news. -If ARG is non-nil and a positive number, Gnus will use that as the -startup level. If ARG is non-nil and not a positive number, Gnus will -prompt the user for the name of an NNTP server to use." t nil) - -;;;*** - -;;; These have moved out of gnus.el into other files. -;;; FIX FIX FIX: should other things be in gnus-setup? or these not in it? - (autoload 'gnus-update-format "gnus-spec" "\ -Update the format specification near point." t nil) - - (autoload 'gnus-fetch-group "gnus-group" "\ -Start Gnus if necessary and enter GROUP. -Returns whether the fetching was successful or not." t nil) - - (defalias 'gnus-batch-kill 'gnus-batch-score) - - (autoload 'gnus-batch-score "gnus-kill" "\ -Run batched scoring. -Usage: emacs -batch -l gnus -f gnus-batch-score <newsgroups> ... -Newsgroups is a list of strings in Bnews format. If you want to score -the comp hierarchy, you'd say \"comp.all\". If you would not like to -score the alt hierarchy, you'd say \"!alt.all\"." t nil)) - -(provide 'gnus-setup) - -(run-hooks 'gnus-setup-load-hook) - -;;; gnus-setup.el ends here diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el index 54714d503bc..e11ddc4c4f5 100644 --- a/lisp/gnus/gnus-spec.el +++ b/lisp/gnus/gnus-spec.el @@ -24,9 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (eval-when-compile (require 'cl)) (defvar gnus-newsrc-file-version) diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index 319f7a8cbce..083a3d68183 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -45,7 +45,7 @@ :group 'gnus-server :type 'hook) -(defcustom gnus-server-line-format " {%(%h:%w%)} %s%a\n" +(defcustom gnus-server-line-format " {%(%h:%w%)} %s%a%c\n" "Format of server lines. It works along the same lines as a normal formatting string, with some simple extensions. @@ -78,6 +78,16 @@ If nil, a faster, but more primitive, buffer is used instead." ;;; Internal variables. +(defvar gnus-tmp-how) +(defvar gnus-tmp-name) +(defvar gnus-tmp-where) +(defvar gnus-tmp-status) +(defvar gnus-tmp-agent) +(defvar gnus-tmp-cloud) +(defvar gnus-tmp-news-server) +(defvar gnus-tmp-news-method) +(defvar gnus-tmp-user-defined) + (defvar gnus-inserted-opened-servers nil) (defvar gnus-server-line-format-alist @@ -85,7 +95,8 @@ If nil, a faster, but more primitive, buffer is used instead." (?n gnus-tmp-name ?s) (?w gnus-tmp-where ?s) (?s gnus-tmp-status ?s) - (?a gnus-tmp-agent ?s))) + (?a gnus-tmp-agent ?s) + (?c gnus-tmp-cloud ?s))) (defvar gnus-server-mode-line-format-alist `((?S gnus-tmp-news-server ?s) @@ -127,6 +138,7 @@ If nil, a faster, but more primitive, buffer is used instead." ["Close" gnus-server-close-server t] ["Offline" gnus-server-offline-server t] ["Deny" gnus-server-deny-server t] + ["Toggle Cloud" gnus-server-toggle-cloud-server t] "---" ["Open All" gnus-server-open-all-servers t] ["Close All" gnus-server-close-all-servers t] @@ -172,6 +184,8 @@ If nil, a faster, but more primitive, buffer is used instead." "z" gnus-server-compact-server + "i" gnus-server-toggle-cloud-server + "\C-c\C-i" gnus-info-find-node "\C-c\C-b" gnus-bug)) @@ -185,6 +199,13 @@ If nil, a faster, but more primitive, buffer is used instead." (put 'gnus-server-agent-face 'face-alias 'gnus-server-agent) (put 'gnus-server-agent-face 'obsolete-face "22.1") +(defface gnus-server-cloud + '((((class color) (background light)) (:foreground "ForestGreen" :bold t)) + (((class color) (background dark)) (:foreground "PaleGreen" :bold t)) + (t (:bold t))) + "Face used for displaying AGENTIZED servers" + :group 'gnus-server-visual) + (defface gnus-server-opened '((((class color) (background light)) (:foreground "Green3" :bold t)) (((class color) (background dark)) (:foreground "Green1" :bold t)) @@ -228,6 +249,7 @@ If nil, a faster, but more primitive, buffer is used instead." (defvar gnus-server-font-lock-keywords '(("(\\(agent\\))" 1 'gnus-server-agent) + ("(\\(cloud\\))" 1 'gnus-server-cloud) ("(\\(opened\\))" 1 'gnus-server-opened) ("(\\(closed\\))" 1 'gnus-server-closed) ("(\\(offline\\))" 1 'gnus-server-offline) @@ -264,8 +286,9 @@ The following commands are available: '(gnus-server-font-lock-keywords t))) (gnus-run-mode-hooks 'gnus-server-mode-hook)) -(defun gnus-server-insert-server-line (gnus-tmp-name method) - (let* ((gnus-tmp-how (car method)) +(defun gnus-server-insert-server-line (name method) + (let* ((gnus-tmp-name name) + (gnus-tmp-how (car method)) (gnus-tmp-where (nth 1 method)) (elem (assoc method gnus-opened-servers)) (gnus-tmp-status @@ -282,6 +305,9 @@ The following commands are available: (gnus-tmp-agent (if (and gnus-agent (gnus-agent-method-p method)) " (agent)" + "")) + (gnus-tmp-cloud (if (gnus-cloud-server-p gnus-tmp-name) + " (cloud)" ""))) (beginning-of-line) (gnus-add-text-properties @@ -1084,6 +1110,27 @@ Requesting compaction of %s... (this may take a long time)" (let ((original (get-buffer gnus-original-article-buffer))) (and original (gnus-kill-buffer original)))))) +(defun gnus-server-toggle-cloud-server () + "Make the server under point be replicated in the Emacs Cloud." + (interactive) + (let ((server (gnus-server-server-name))) + (unless server + (error "No server on the current line")) + + (unless (gnus-method-option-p server 'cloud) + (error "The server under point doesn't support cloudiness")) + + (if (gnus-cloud-server-p server) + (setq gnus-cloud-covered-servers + (delete server gnus-cloud-covered-servers)) + (push server gnus-cloud-covered-servers)) + + (gnus-server-update-server server) + (gnus-message 1 (if (gnus-cloud-server-p server) + "Replication of %s in the cloud will start" + "Replication of %s in the cloud will stop") + server))) + (provide 'gnus-srvr) ;;; gnus-srvr.el ends here diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index b9b259e0d18..b79b96e4fc1 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -30,6 +30,7 @@ (require 'gnus-spec) (require 'gnus-range) (require 'gnus-util) +(require 'gnus-cloud) (autoload 'message-make-date "message") (autoload 'gnus-agent-read-servers-validate "gnus-agent") (autoload 'gnus-agent-save-local "gnus-agent") diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index d6c801fdd39..090cbede76d 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -24,9 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (eval-when-compile (require 'cl)) (eval-when-compile @@ -2188,6 +2185,7 @@ increase the score of each group you read." (gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map) "w" gnus-article-decode-mime-words "c" gnus-article-decode-charset + "h" gnus-mime-buttonize-attachments-in-header "v" gnus-mime-view-all-parts "b" gnus-article-view-part) @@ -2394,6 +2392,8 @@ increase the score of each group you read." ["QP" gnus-article-de-quoted-unreadable t] ["Base64" gnus-article-de-base64-unreadable t] ["View MIME buttons" gnus-summary-display-buttonized t] + ["View MIME buttons in header" + gnus-mime-buttonize-attachments-in-header t] ["View all" gnus-mime-view-all-parts t] ["Verify and Decrypt" gnus-summary-force-verify-and-decrypt t] ["Encrypt body" gnus-article-encrypt-body @@ -9085,6 +9085,41 @@ non-numeric or nil fetch the number specified by the (gnus-summary-limit-include-thread id))) (gnus-summary-show-thread)) +(defun gnus-summary-open-group-with-article (message-id) + "Open a group containing the article with the given MESSAGE-ID." + (interactive "sMessage-ID: ") + (require 'nndoc) + (with-temp-buffer + ;; Prepare a dummy article + (erase-buffer) + (insert "From nobody Tue Sep 13 22:05:34 2011\n\n") + + ;; Prepare pretty modelines for summary and article buffers + (let ((gnus-summary-mode-line-format "Found %G") + (gnus-article-mode-line-format + ;; Group names just get in the way here, especially the + ;; abbreviated ones + (if (string-match "%[gG]" gnus-article-mode-line-format) + (concat (substring gnus-article-mode-line-format + 0 (match-beginning 0)) + (substring gnus-article-mode-line-format (match-end 0))) + gnus-article-mode-line-format))) + + ;; Build an ephemeral group containing the dummy article (hidden) + (gnus-group-read-ephemeral-group + message-id + `(nndoc ,message-id + (nndoc-address ,(current-buffer)) + (nndoc-article-type mbox)) + :activate + (cons (current-buffer) gnus-current-window-configuration) + (not :request-only) + '(-1) ; :select-articles + (not :parameters) + 0)) ; :number + ;; Fetch the desired article + (gnus-summary-refer-article message-id))) + (defun gnus-summary-refer-article (message-id) "Fetch an article specified by MESSAGE-ID." (interactive "sMessage-ID: ") @@ -9748,6 +9783,8 @@ If ARG is a negative number, turn header display off." (declare-function article-narrow-to-head "gnus-art" ()) (declare-function gnus-article-hidden-text-p "gnus-art" (type)) (declare-function gnus-delete-wash-type "gnus-art" (type)) +(declare-function gnus-mime-buttonize-attachments-in-header + "gnus-art" (&optional interactive)) (defun gnus-summary-toggle-header (&optional arg) "Show the headers if they are hidden, or hide them if they are shown. @@ -9779,7 +9816,10 @@ If ARG is a negative number, hide the unwanted header lines." (gnus-treat-hide-boring-headers nil)) (gnus-delete-wash-type 'headers) (gnus-treat-article 'head)) - (gnus-treat-article 'head)) + (gnus-treat-article 'head) + ;; Add attachment buttons to the header. + (when gnus-mime-display-attachment-buttons-in-header + (gnus-mime-buttonize-attachments-in-header))) (widen) (if window (set-window-start window (goto-char (point-min)))) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index a3038a1bfe5..62977576a00 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -32,9 +32,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (eval-when-compile (require 'cl)) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index b1d60de93d9..206f5a502fc 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -29,10 +29,6 @@ (eval '(run-hooks 'gnus-load-hook)) -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) (require 'wid-edit) (require 'mm-util) @@ -309,6 +305,7 @@ be set in `.emacs' instead." (unless (featurep 'gnus-xmas) (defalias 'gnus-make-overlay 'make-overlay) + (defalias 'gnus-copy-overlay 'copy-overlay) (defalias 'gnus-delete-overlay 'delete-overlay) (defalias 'gnus-overlay-get 'overlay-get) (defalias 'gnus-overlay-put 'overlay-put) @@ -316,6 +313,7 @@ be set in `.emacs' instead." (defalias 'gnus-overlay-buffer 'overlay-buffer) (defalias 'gnus-overlay-start 'overlay-start) (defalias 'gnus-overlay-end 'overlay-end) + (defalias 'gnus-overlays-at 'overlays-at) (defalias 'gnus-overlays-in 'overlays-in) (defalias 'gnus-extent-detached-p 'ignore) (defalias 'gnus-extent-start-open 'ignore) @@ -1614,7 +1612,7 @@ slower." :type 'string) (defcustom gnus-valid-select-methods - '(("nntp" post address prompt-address physical-address) + '(("nntp" post address prompt-address physical-address cloud) ("nnspool" post address) ("nnvirtual" post-mail virtual prompt-address) ("nnmbox" mail respool address) @@ -1631,7 +1629,7 @@ slower." ("nnrss" none global) ("nnagent" post-mail) ("nnimap" post-mail address prompt-address physical-address respool - server-marks) + server-marks cloud) ("nnmaildir" mail respool address server-marks) ("nnnil" none)) "*An alist of valid select methods. @@ -2703,7 +2701,10 @@ such as a mark that says whether an article is stored in the cache gnus-newsrc-last-checked-date gnus-newsrc-alist gnus-server-alist gnus-killed-list gnus-zombie-list - gnus-topic-topology gnus-topic-alist) + gnus-topic-topology gnus-topic-alist + gnus-cloud-sequence + gnus-cloud-covered-servers + gnus-cloud-file-timestamps) "Gnus variables saved in the quick startup file.") (defvar gnus-newsrc-alist nil diff --git a/lisp/gnus/gravatar.el b/lisp/gnus/gravatar.el index 650564e2802..ffbc37ae158 100644 --- a/lisp/gnus/gravatar.el +++ b/lisp/gnus/gravatar.el @@ -138,9 +138,7 @@ You can provide a list of argument to pass to CB in CBARGS." "Retrieve MAIL-ADDRESS gravatar and returns it." (let ((url (gravatar-build-url mail-address))) (if (gravatar-cache-expired url) - (with-current-buffer (if (featurep 'xemacs) - (url-retrieve url) - (url-retrieve-synchronously url)) + (with-current-buffer (url-retrieve-synchronously url) (when gravatar-automatic-caching (url-store-in-cache (current-buffer))) (let ((data (gravatar-data->image))) diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index d54377fae19..51b9c911545 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -24,10 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (require 'format-spec) (eval-when-compile (require 'cl) diff --git a/lisp/gnus/mailcap.el b/lisp/gnus/mailcap.el index 5515a348b4c..4f1bdf4b1df 100644 --- a/lisp/gnus/mailcap.el +++ b/lisp/gnus/mailcap.el @@ -216,10 +216,6 @@ This is a compatibility function for different Emacsen." (test . (fboundp 'vm-mode)) (type . "message/rfc822")) ("rfc-*822" - (viewer . w3-mode) - (test . (fboundp 'w3-mode)) - (type . "message/rfc822")) - ("rfc-*822" (viewer . view-mode) (type . "message/rfc822"))) ("image" @@ -253,10 +249,6 @@ This is a compatibility function for different Emacsen." ("needsx11"))) ("text" ("plain" - (viewer . w3-mode) - (test . (fboundp 'w3-mode)) - (type . "text/plain")) - ("plain" (viewer . view-mode) (test . (fboundp 'view-mode)) (type . "text/plain")) @@ -267,10 +259,6 @@ This is a compatibility function for different Emacsen." (viewer . enriched-decode) (test . (fboundp 'enriched-decode)) (type . "text/enriched")) - ("html" - (viewer . mm-w3-prepare-buffer) - (test . (fboundp 'w3-prepare-buffer)) - (type . "text/html")) ("dns" (viewer . dns-mode) (test . (fboundp 'dns-mode)) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 5300de5eabb..ca0280c874f 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -28,9 +28,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (eval-when-compile (require 'cl)) @@ -50,6 +47,7 @@ (require 'mml) (require 'rfc822) (require 'format-spec) +(require 'dired) (autoload 'mailclient-send-it "mailclient") ;; Emacs 22 or contrib/ @@ -606,7 +604,8 @@ Done before generating the new subject of a forward." regexp)) (defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus" - "*All headers that match this regexp will be deleted when forwarding a message." + "*All headers that match this regexp will be deleted when forwarding a message. +This may also be a list of regexps." :version "21.1" :group 'message-forwarding :type '(repeat :value-to-internal (lambda (widget value) @@ -616,6 +615,19 @@ Done before generating the new subject of a forward." (widget-editable-list-match widget value))) regexp)) +(defcustom message-forward-included-headers nil + "If non-nil, delete non-matching headers when forwarding a message. +Only headers that match this regexp will be included. This +variable should be a regexp or a list of regexps." + :version "24.5" + :group 'message-forwarding + :type '(repeat :value-to-internal (lambda (widget value) + (custom-split-regexp-maybe value)) + :match (lambda (widget value) + (or (stringp value) + (widget-editable-list-match widget value))) + regexp)) + (defcustom message-ignored-cited-headers "." "*Delete these headers from the messages you yank." :group 'message-insertion @@ -970,8 +982,8 @@ configuration. See the variable `gnus-cite-attribution-suffix'." (defcustom message-citation-line-format "On %a, %b %d %Y, %N wrote:\n" "Format of the \"Whomever writes:\" line. -The string is formatted using `format-spec'. The following -constructs are replaced: +The string is formatted using `format-spec'. The following constructs +are replaced: %f The full From, e.g. \"John Doe <john.doe@example.invalid>\". %n The mail address, e.g. \"john.doe@example.invalid\". @@ -979,11 +991,14 @@ constructs are replaced: back to the mail address. %F The first name if present, e.g.: \"John\". %L The last name if present, e.g.: \"Doe\". + %Z, %z The time zone in the numeric form, e.g.:\"+0000\". All other format specifiers are passed to `format-time-string' -which is called using the date from the article your replying to. -Extracting the first (%F) and last name (%L) is done -heuristically, so you should always check it yourself. +which is called using the date from the article your replying to, but +the date in the formatted string will be expressed in the author's +time zone as much as possible. +Extracting the first (%F) and last name (%L) is done heuristically, +so you should always check it yourself. Please also read the note in the documentation of `message-citation-line-function'." @@ -2451,6 +2466,7 @@ With prefix-argument just set Follow-Up, don't cross-post." "Remove HEADER in the narrowed buffer. If IS-REGEXP, HEADER is a regular expression. If FIRST, only remove the first instance of the header. +If REVERSE, remove headers that doesn't match HEADER. Return the number of headers removed." (goto-char (point-min)) (let ((regexp (if is-regexp header (concat "^" (regexp-quote header) ":"))) @@ -3907,9 +3923,13 @@ This function uses `mail-citation-hook' if that is non-nil." (defvar gnus-extract-address-components) (autoload 'format-spec "format-spec") +(autoload 'gnus-date-get-time "gnus-util") -(defun message-insert-formatted-citation-line (&optional from date) +(defun message-insert-formatted-citation-line (&optional from date tz) "Function that inserts a formatted citation line. +The optional FROM, and DATE are strings containing the contents of +the From header and the Date header respectively. The optional TZ +is a number of seconds, overrides the time zone of DATE. See `message-citation-line-format'." ;; The optional args are for testing/debugging. They will disappear later. @@ -3917,7 +3937,7 @@ See `message-citation-line-format'." ;; (with-temp-buffer ;; (message-insert-formatted-citation-line ;; "John Doe <john.doe@example.invalid>" - ;; (current-time)) + ;; (message-make-date)) ;; (buffer-string)) (when (or message-reply-headers (and from date)) (unless from @@ -3934,28 +3954,43 @@ See `message-citation-line-format'." (net (car (cdr data))) (name-or-net (or (car data) (car (cdr data)) from)) - (replydate - (or - date - ;; We need Gnus functionality if the user wants date or time from - ;; the original article: - (when (string-match "%[^fnNFL]" message-citation-line-format) - (autoload 'gnus-date-get-time "gnus-util") - (gnus-date-get-time (mail-header-date message-reply-headers))))) + (time + (when (string-match "%[^fnNFL]" message-citation-line-format) + (cond ((numberp (car-safe date)) date) ;; backward compatibility + (date (gnus-date-get-time date)) + (t + (gnus-date-get-time + (setq date (mail-header-date message-reply-headers))))))) + (tz (or tz + (when (stringp date) + (nth 8 (parse-time-string date))))) (flist (let ((i ?A) lst) (when (stringp name) ;; Guess first name and last name: - (let* ((names (delq nil (mapcar (lambda (x) - (if (string-match "\\`\\(\\w\\|[-.]\\)+\\'" x) x nil)) - (split-string name "[ \t]+")))) - (count (length names))) - (cond ((= count 1) (setq fname (car names) - lname "")) - ((or (= count 2) (= count 3)) (setq fname (car names) - lname (mapconcat 'identity (cdr names) " "))) - ((> count 3) (setq fname (mapconcat 'identity (butlast names (- count 2)) " ") - lname (mapconcat 'identity (nthcdr 2 names) " "))) ) + (let* ((names (delq + nil + (mapcar + (lambda (x) + (if (string-match "\\`\\(\\w\\|[-.]\\)+\\'" + x) + x + nil)) + (split-string name "[ \t]+")))) + (count (length names))) + (cond ((= count 1) + (setq fname (car names) + lname "")) + ((or (= count 2) (= count 3)) + (setq fname (car names) + lname (mapconcat 'identity (cdr names) " "))) + ((> count 3) + (setq fname (mapconcat 'identity + (butlast names (- count 2)) + " ") + lname (mapconcat 'identity + (nthcdr 2 names) + " ")))) (when (string-match "\\(.*\\),\\'" fname) (let ((newlname (match-string 1 fname))) (setq fname lname lname newlname))))) @@ -3985,7 +4020,7 @@ See `message-citation-line-format'." (>= i ?a))) (push i lst) (push (condition-case nil - (format-time-string (format "%%%c" i) replydate) + (gmm-format-time-string (format "%%%c" i) time tz) (error (format ">%c<" i))) lst)) (setq i (1+ i))) @@ -7374,17 +7409,25 @@ Optional DIGEST will use digest to forward." (message-remove-ignored-headers b e))) (defun message-remove-ignored-headers (b e) - (when message-forward-ignored-headers + (when (or message-forward-ignored-headers + message-forward-included-headers) (save-restriction (narrow-to-region b e) (goto-char b) (narrow-to-region (point) (or (search-forward "\n\n" nil t) (point))) - (let ((ignored (if (stringp message-forward-ignored-headers) - (list message-forward-ignored-headers) - message-forward-ignored-headers))) - (dolist (elem ignored) - (message-remove-header elem t)))))) + (when message-forward-ignored-headers + (let ((ignored (if (stringp message-forward-ignored-headers) + (list message-forward-ignored-headers) + message-forward-ignored-headers))) + (dolist (elem ignored) + (message-remove-header elem t)))) + (when message-forward-included-headers + (message-remove-header + (if (listp message-forward-included-headers) + (regexp-opt message-forward-included-headers) + message-forward-included-headers) + t nil t))))) (defun message-forward-make-body-mime (forward-buffer &optional beg end) (let ((b (point))) @@ -7432,8 +7475,7 @@ Optional DIGEST will use digest to forward." (goto-char (point-max)))) (setq e (point)) (insert "<#/mml>\n") - (when (and (not message-forward-decoded-p) - message-forward-ignored-headers) + (when (not message-forward-decoded-p) (message-remove-ignored-headers b e)))) (defun message-forward-make-body-digest-plain (forward-buffer) @@ -8421,6 +8463,17 @@ Used in `message-simplify-recipients'." (message-fetch-field hdr) t)) ", ")))) +;;; multipart/related and HTML support. + +(defun message-make-html-message-with-image-files (files) + (interactive (list (dired-get-marked-files nil current-prefix-arg))) + (message-mail) + (message-goto-body) + (insert "<#part type=text/html>\n\n") + (dolist (file files) + (insert (format "<img src=%S>\n\n" file))) + (message-goto-to)) + (when (featurep 'xemacs) (require 'messagexmas) (message-xmas-redefine)) diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el index 49724597382..c2f6df9c62a 100644 --- a/lisp/gnus/mm-bodies.el +++ b/lisp/gnus/mm-bodies.el @@ -23,10 +23,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (require 'mm-util) (require 'rfc2047) (require 'mm-encode) diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 17c8fb1b8db..cde0af036a5 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -23,10 +23,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (require 'mail-parse) (require 'mm-bodies) (eval-when-compile (require 'cl)) @@ -124,7 +120,6 @@ ((executable-find "w3m") 'gnus-w3m) ((executable-find "links") 'links) ((executable-find "lynx") 'lynx) - ((locate-library "w3") 'w3) ((locate-library "html2text") 'html2text) (t nil)) "Render of HTML contents. @@ -136,13 +131,11 @@ The defined renderer types are: `w3m-standalone': use plain w3m; `links': use links; `lynx': use lynx; -`w3': use Emacs/W3; `html2text': use html2text; nil : use external viewer (default web browser)." :version "24.1" :type '(choice (const shr) (const gnus-w3m) - (const w3) (const w3m :tag "emacs-w3m") (const w3m-standalone :tag "standalone w3m" ) (const links) @@ -153,9 +146,9 @@ nil : use external viewer (default web browser)." :group 'mime-display) (defcustom mm-inline-text-html-with-images nil - "If non-nil, Gnus will allow retrieving images in HTML contents with -the <img> tags. It has no effect on Emacs/w3. See also the -documentation for the `mm-w3m-safe-url-regexp' variable." + "If non-nil, Gnus will allow retrieving images in HTML that has <img> tags. +See also the documentation for the `mm-w3m-safe-url-regexp' +variable." :version "22.1" :type 'boolean :group 'mime-display) @@ -828,7 +821,6 @@ external if displayed external." 'inline) ((and (mm-inlinable-p ehandle) (mm-inlined-p ehandle)) - (forward-line 1) (mm-display-inline handle) 'inline) ((or method @@ -1875,7 +1867,7 @@ If RECURSIVE, search recursively." handle `(lambda () (let ((inhibit-read-only t)) - (delete-region ,(point-min-marker) + (delete-region ,(copy-marker (point-min) t) ,(point-max-marker)))))))) (defvar shr-map) diff --git a/lisp/gnus/mm-extern.el b/lisp/gnus/mm-extern.el index 882c8545e59..d574b9d51df 100644 --- a/lisp/gnus/mm-extern.el +++ b/lisp/gnus/mm-extern.el @@ -24,10 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) (require 'mm-util) diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index 4b46ab74f52..bb342d6b8b1 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el @@ -21,7 +21,7 @@ ;;; Commentary: -;; Some codes are stolen from w3 and url packages. Some are moved from +;; Some code is stolen from w3 and url packages. Some are moved from ;; nnweb. ;; TODO: Support POST, cookie. @@ -264,8 +264,6 @@ This is taken from RFC 2396.") (require 'url-parse) (require 'url-vars)) (error nil)) - ;; w3-4.0pre0.46 or earlier version. - (require 'w3-vars) (require 'url))) ;;;###autoload diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index 38ee8a563e5..0d02e1db758 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -23,10 +23,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) (require 'mail-prsvr) diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el index 423324a86f4..d91d2a41c8f 100644 --- a/lisp/gnus/mm-uu.el +++ b/lisp/gnus/mm-uu.el @@ -673,22 +673,34 @@ value of `mm-uu-text-plain-type'." (goto-char text-start) (re-search-forward "." start-point t))) (push - (mm-make-handle (mm-uu-copy-to-buffer text-start start-point) - mm-uu-text-plain-type) + (mm-make-handle + (mm-uu-copy-to-buffer + text-start + ;; A start-separator is likely accompanied by + ;; a leading newline. + (if (and (eq (char-before start-point) ?\n) + (eq (char-before (1- start-point)) ?\n)) + (1- start-point) + start-point)) + mm-uu-text-plain-type) result)) (push (funcall (mm-uu-function-extract entry)) result) (goto-char (setq text-start end-point)))) (when result - (if (and (> (point-max) (1+ text-start)) - (save-excursion - (goto-char text-start) - (re-search-forward "." nil t))) - (push - (mm-make-handle (mm-uu-copy-to-buffer text-start (point-max)) - mm-uu-text-plain-type) - result)) + (goto-char text-start) + (when (re-search-forward "." nil t) + (push (mm-make-handle + (mm-uu-copy-to-buffer + ;; An end-separator is likely accompanied by + ;; a trailing newline. + (if (eq (char-after text-start) ?\n) + (1+ text-start) + text-start) + (point-max)) + mm-uu-text-plain-type) + result)) (setq result (cons "multipart/mixed" (nreverse result)))) result))) diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index a764fa51c5d..ecfa2ac9582 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -22,9 +22,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (eval-when-compile (require 'cl)) (require 'mail-parse) (require 'mailcap) @@ -51,7 +48,6 @@ (defvar mm-text-html-renderer-alist '((shr . mm-shr) - (w3 . mm-inline-text-html-render-with-w3) (w3m . mm-inline-text-html-render-with-w3m) (w3m-standalone . mm-inline-text-html-render-with-w3m-standalone) (gnus-w3m . gnus-article-html) @@ -100,19 +96,19 @@ (- (nth 3 edges) (nth 1 edges))))))) image)) b) - (insert "\n\n") + (insert "\n") (mm-handle-set-undisplayer handle `(lambda () (let ((b ,b) (inhibit-read-only t)) (remove-images b b) - (delete-region b (+ b 2))))))) + (delete-region b (1+ b))))))) (defun mm-inline-image-xemacs (handle) (when (featurep 'xemacs) - (insert "\n\n") - (forward-char -2) + (insert "\n") + (forward-char -1) (let ((annot (make-annotation (mm-get-image handle) nil 'text)) (inhibit-read-only t)) (mm-handle-set-undisplayer @@ -121,7 +117,7 @@ (let ((b ,(point-marker)) (inhibit-read-only t)) (delete-annotation ,annot) - (delete-region (- b 2) b)))) + (delete-region (1- b) b)))) (set-extent-property annot 'mm t) (set-extent-property annot 'duplicable t)))) @@ -130,91 +126,6 @@ (defalias 'mm-inline-image 'mm-inline-image-xemacs) (defalias 'mm-inline-image 'mm-inline-image-emacs))) -;; External. -(declare-function w3-do-setup "ext:w3" ()) -(declare-function w3-region "ext:w3-display" (st nd)) -(declare-function w3-prepare-buffer "ext:w3-display" (&rest args)) - -(defvar mm-w3-setup nil) -(defun mm-setup-w3 () - (unless mm-w3-setup - (require 'w3) - (w3-do-setup) - (require 'url) - (require 'w3-vars) - (require 'url-vars) - (setq mm-w3-setup t))) - -(defun mm-inline-text-html-render-with-w3 (handle) - (mm-setup-w3) - (let ((text (mm-get-part handle)) - (b (point)) - (url-standalone-mode t) - (url-gateway-unplugged t) - (w3-honor-stylesheets nil) - (url-current-object - (url-generic-parse-url (format "cid:%s" (mm-handle-id handle)))) - (width (window-width)) - (charset (mail-content-type-get - (mm-handle-type handle) 'charset))) - (save-excursion - (insert (if charset (mm-decode-string text charset) text)) - (save-restriction - (narrow-to-region b (point)) - (unless charset - (goto-char (point-min)) - (when (or (and (boundp 'w3-meta-content-type-charset-regexp) - (re-search-forward - w3-meta-content-type-charset-regexp nil t)) - (and (boundp 'w3-meta-charset-content-type-regexp) - (re-search-forward - w3-meta-charset-content-type-regexp nil t))) - (setq charset - (let ((bsubstr (buffer-substring-no-properties - (match-beginning 2) - (match-end 2)))) - (if (fboundp 'w3-coding-system-for-mime-charset) - (w3-coding-system-for-mime-charset bsubstr) - (mm-charset-to-coding-system bsubstr nil t)))) - (delete-region (point-min) (point-max)) - (insert (mm-decode-string text charset)))) - (save-window-excursion - (save-restriction - (let ((w3-strict-width width) - ;; Don't let w3 set the global version of - ;; this variable. - (fill-column fill-column)) - (if (or debug-on-error debug-on-quit) - (w3-region (point-min) (point-max)) - (condition-case () - (w3-region (point-min) (point-max)) - (error - (delete-region (point-min) (point-max)) - (let ((b (point)) - (charset (mail-content-type-get - (mm-handle-type handle) 'charset))) - (if (or (eq charset 'gnus-decoded) - (eq mail-parse-charset 'gnus-decoded)) - (save-restriction - (narrow-to-region (point) (point)) - (mm-insert-part handle) - (goto-char (point-max))) - (insert (mm-decode-string (mm-get-part handle) - charset)))) - (message - "Error while rendering html; showing as text/plain"))))))) - (mm-handle-set-undisplayer - handle - `(lambda () - (let ((inhibit-read-only t)) - ,@(if (functionp 'remove-specifier) - '((dolist (prop '(background background-pixmap foreground)) - (remove-specifier - (face-property 'default prop) - (current-buffer))))) - (delete-region ,(point-min-marker) - ,(point-max-marker))))))))) - (defvar mm-w3m-setup nil "Whether gnus-article-mode has been setup to use emacs-w3m.") @@ -306,7 +217,7 @@ handle `(lambda () (let ((inhibit-read-only t)) - (delete-region ,(point-min-marker) + (delete-region ,(copy-marker (point-min) t) ,(point-max-marker))))))))) (defvar mm-w3m-standalone-supports-m17n-p (if (featurep 'mule) 'undecided) @@ -480,7 +391,7 @@ handle `(lambda () (let ((inhibit-read-only t)) - (delete-region ,(point-min-marker) + (delete-region ,(copy-marker (point-min) t) ,(point-max-marker)))))))) (defun mm-insert-inline (handle text) @@ -493,19 +404,12 @@ handle `(lambda () (let ((inhibit-read-only t)) - (delete-region ,(copy-marker b) - ,(copy-marker (point)))))))) + (delete-region ,(copy-marker b t) + ,(point-marker))))))) (defun mm-inline-audio (handle) (message "Not implemented")) -(defun mm-w3-prepare-buffer () - (require 'w3) - (let ((url-standalone-mode t) - (url-gateway-unplugged t) - (w3-honor-stylesheets nil)) - (w3-prepare-buffer))) - (defun mm-view-message () (mm-enable-multibyte) (let (handles) @@ -616,9 +520,11 @@ If MODE is not set, try to find mode automatically." (set-auto-mode))) ;; The mode function might have already turned on font-lock. ;; Do not fontify if the guess mode is fundamental. - (unless (or (symbol-value 'font-lock-mode) + (unless (or font-lock-mode (eq major-mode 'fundamental-mode)) - (font-lock-fontify-buffer)))) + (if (fboundp 'font-lock-ensure) + (font-lock-ensure) + (font-lock-fontify-buffer))))) ;; By default, XEmacs font-lock uses non-duplicable text ;; properties. This code forces all the text properties ;; to be copied along with the text. diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el index bd7a50f7184..caa1380a497 100644 --- a/lisp/gnus/mml-smime.el +++ b/lisp/gnus/mml-smime.el @@ -24,10 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) (require 'smime) diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 439d7c5dc13..726faeed6a0 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -22,16 +22,13 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (require 'mm-util) (require 'mm-bodies) (require 'mm-encode) (require 'mm-decode) (require 'mml-sec) (eval-when-compile (require 'cl)) +(eval-when-compile (require 'url)) (eval-when-compile (when (featurep 'xemacs) (require 'easy-mmode))) ; for `define-minor-mode' @@ -463,6 +460,9 @@ If MML is non-nil, return the buffer up till the correspondent mml tag." (defvar mml-multipart-number 0) (defvar mml-inhibit-compute-boundary nil) +(declare-function libxml-parse-html-region "xml.c" + (start end &optional base-url)) + (defun mml-generate-mime (&optional multipart-type) "Generate a MIME message based on the current MML document. MULTIPART-TYPE defaults to \"mixed\", but can also @@ -472,19 +472,69 @@ be \"related\" or \"alternate\"." (options message-options)) (if (not cont) nil + (when (and (consp (car cont)) + (= (length cont) 1) + (fboundp 'libxml-parse-html-region) + (equal (cdr (assq 'type (car cont))) "text/html")) + (setq cont (mml-expand-html-into-multipart-related (car cont)))) (prog1 (mm-with-multibyte-buffer (setq message-options options) - (if (and (consp (car cont)) - (= (length cont) 1)) - (mml-generate-mime-1 (car cont)) + (cond + ((and (consp (car cont)) + (= (length cont) 1)) + (mml-generate-mime-1 (car cont))) + ((eq (car cont) 'multipart) + (mml-generate-mime-1 cont)) + (t (mml-generate-mime-1 (nconc (list 'multipart (cons 'type (or multipart-type "mixed"))) - cont))) + cont)))) (setq options message-options) (buffer-string)) (setq message-options options))))) +(defun mml-expand-html-into-multipart-related (cont) + (let ((new-parts nil) + (cid 1)) + (mm-with-multibyte-buffer + (insert (cdr (assq 'contents cont))) + (goto-char (point-min)) + (with-syntax-table mml-syntax-table + (while (re-search-forward "<img\\b" nil t) + (goto-char (match-beginning 0)) + (let* ((start (point)) + (img (nth 2 + (nth 2 + (libxml-parse-html-region + (point) (progn (forward-sexp) (point)))))) + (end (point)) + (parsed (url-generic-parse-url (cdr (assq 'src (cadr img)))))) + (when (and (null (url-type parsed)) + (url-filename parsed) + (file-exists-p (url-filename parsed))) + (goto-char start) + (when (search-forward (url-filename parsed) end t) + (let ((cid (format "fsf.%d" cid))) + (replace-match (concat "cid:" cid) t t) + (push (list cid (url-filename parsed)) new-parts)) + (setq cid (1+ cid))))))) + ;; We have local images that we want to include. + (if (not new-parts) + (list cont) + (setcdr (assq 'contents cont) (buffer-string)) + (setq cont + (nconc (list 'multipart (cons 'type "related")) + (list cont))) + (dolist (new-part (nreverse new-parts)) + (setq cont + (nconc cont + (list `(part (type . "image/png") + (filename . ,(nth 1 new-part)) + (id . ,(concat "<" (nth 0 new-part) + ">"))))))) + cont)))) + (defun mml-generate-mime-1 (cont) (let ((mm-use-ultra-safe-encoding (or mm-use-ultra-safe-encoding (assq 'sign cont)))) diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el index 8c698edb06a..2663107133d 100644 --- a/lisp/gnus/mml1991.el +++ b/lisp/gnus/mml1991.el @@ -26,9 +26,6 @@ ;;; Code: (eval-and-compile - ;; For Emacs <22.2 and XEmacs. - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))) - (if (locate-library "password-cache") (require 'password-cache) (require 'password))) diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index 9fc8f6e8c0c..74290f45469 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -28,9 +28,6 @@ ;;; Code: (eval-and-compile - ;; For Emacs <22.2 and XEmacs. - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))) - (if (locate-library "password-cache") (require 'password-cache) (require 'password))) @@ -51,12 +48,10 @@ ;; Then mml1991 would not need to require mml2015, and mml1991-use ;; could be removed. (defvar mml2015-use (or - (condition-case nil - (progn - (require 'epg-config) - (epg-check-configuration (epg-configuration)) - 'epg) - (error)) + (progn + (ignore-errors (require 'epg-config)) + (and (fboundp 'epg-check-configuration) + 'epg)) (progn (let ((abs-file (locate-library "pgg"))) ;; Don't load PGG if it is marked as obsolete @@ -152,6 +147,12 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." :group 'mime-security :type 'integer) +(defcustom mml2015-display-key-image t + "If t, try to display key images." + :version "24.5" + :group 'mime-security + :type 'boolean) + ;; Extract plaintext from cleartext signature. IMO, this kind of task ;; should be done by GnuPG rather than Elisp, but older PGP backends ;; (such as Mailcrypt, and PGG) discard the output from GnuPG. @@ -903,7 +904,8 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (defun mml2015-epg-signature-to-string (signature) (concat (epg-signature-to-string signature) - (mml2015-epg-key-image-to-string (epg-signature-key-id signature)))) + (when mml2015-display-key-image + (mml2015-epg-key-image-to-string (epg-signature-key-id signature))))) (defun mml2015-epg-verify-result-to-string (verify-result) (mapconcat #'mml2015-epg-signature-to-string verify-result "\n")) diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el index 3e917b41b19..764314de0af 100644 --- a/lisp/gnus/nndraft.el +++ b/lisp/gnus/nndraft.el @@ -24,10 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (require 'nnheader) (require 'nnmail) (require 'gnus-start) diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el index 1a799d3c573..a403f3965c0 100644 --- a/lisp/gnus/nnfolder.el +++ b/lisp/gnus/nnfolder.el @@ -28,10 +28,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (require 'nnheader) (require 'message) (require 'nnmail) diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 3ce3dfa1e75..994c2d022c8 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -26,9 +26,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (eval-when-compile (require 'cl)) (defvar nnmail-extra-headers) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 2fc2dd6af79..1730bd4252c 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -26,10 +26,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-and-compile (require 'nnheader) ;; In Emacs 24, `open-protocol-stream' is an autoloaded alias for @@ -628,6 +624,26 @@ textual parts.") (nnheader-ms-strip-cr) (cons group article))))))) +(deffoo nnimap-request-articles (articles &optional group server) + (when group + (setq group (nnimap-decode-gnus-group group))) + (with-current-buffer nntp-server-buffer + (let ((result (nnimap-change-group group server))) + (when result + (erase-buffer) + (with-current-buffer (nnimap-buffer) + (erase-buffer) + (when (nnimap-command + (if (nnimap-ver4-p) + "UID FETCH %s BODY.PEEK[]" + "UID FETCH %s RFC822.PEEK") + (nnimap-article-ranges (gnus-compress-sequence articles))) + (let ((buffer (current-buffer))) + (with-current-buffer nntp-server-buffer + (nnheader-insert-buffer-substring buffer) + (nnheader-ms-strip-cr))) + t)))))) + (defun nnimap-get-whole-article (article &optional command) (let ((result (nnimap-command diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 5910cde1c3d..e2051dfd315 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -171,10 +171,6 @@ ;;; Setup: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (require 'nnoo) (require 'gnus-group) (require 'message) diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index ac4b638fda0..d1a0455a1b0 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -24,10 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) (require 'gnus) ; for macro gnus-kill-buffer, at least diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 7d33e511baa..21fa5b37aa4 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -59,10 +59,6 @@ ) ] -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (require 'nnheader) (require 'gnus) (require 'gnus-util) diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index 5ef91d0be7b..02a9513d07c 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -24,10 +24,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) (require 'gnus) @@ -398,8 +394,8 @@ otherwise return nil." nnrss-compatible-encoding-alist))))) (mm-coding-system-p 'utf-8))) -(declare-function w3-parse-buffer "ext:w3-parse" (&optional buff)) - +(declare-function libxml-parse-html-region "xml.c" + (start end &optional base-url)) (defun nnrss-fetch (url &optional local) "Fetch URL and put it in a the expected Lisp structure." (mm-with-unibyte-buffer @@ -426,22 +422,14 @@ otherwise return nil." (mm-enable-multibyte)))) (goto-char (point-min)) - ;; Because xml-parse-region can't deal with anything that isn't - ;; xml and w3-parse-buffer can't deal with some xml, we have to - ;; parse with xml-parse-region first and, if that fails, parse - ;; with w3-parse-buffer. Yuck. Eventually, someone should find out - ;; why w3-parse-buffer fails to parse some well-formed xml and - ;; fix it. - (condition-case err1 (setq xmlform (xml-parse-region (point-min) (point-max))) (error (condition-case err2 - (setq htmlform (caddar (w3-parse-buffer - (current-buffer)))) + (setq htmlform (libxml-parse-html-region (point-min) (point-max))) (error (message "\ -nnrss: %s: Not valid XML %s and w3-parse doesn't work %s" +nnrss: %s: Not valid XML %s and libxml-parse-html-region doesn't work %s" url err1 err2))))) (if htmlform htmlform @@ -599,7 +587,7 @@ which RSS 2.0 allows." (defun nnrss-no-cache (url) "") -(defun nnrss-insert-w3 (url) +(defun nnrss-insert (url) (mm-with-unibyte-current-buffer (condition-case err (mm-url-insert url) @@ -614,8 +602,6 @@ which RSS 2.0 allows." (mm-url-decode-entities-nbsp) (buffer-string)))) -(defalias 'nnrss-insert 'nnrss-insert-w3) - (defun nnrss-mime-encode-string (string) (mm-with-multibyte-buffer (insert string) @@ -880,8 +866,7 @@ Careful with this on large documents!" (defun nnrss-extract-hrefs (data) "Recursively extract hrefs from a page's source. -DATA should be the output of `xml-parse-region' or -`w3-parse-buffer'." +DATA should be the output of `xml-parse-region'." (mapcar (lambda (ahref) (cdr (assoc 'href (cadr ahref)))) (nnrss-find-el 'a data))) diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index 5ef13984abc..6035162d294 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -25,9 +25,7 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. (eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))) ;; In Emacs 24, `open-protocol-stream' is an autoloaded alias for ;; `make-network-stream'. (unless (fboundp 'open-protocol-stream) diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el index 3fb35b2278d..e909372e8a7 100644 --- a/lisp/gnus/nnweb.el +++ b/lisp/gnus/nnweb.el @@ -22,8 +22,6 @@ ;;; Commentary: -;; Note: You need to have `w3' installed for some functions to work. - ;;; Code: (eval-when-compile (require 'cl)) @@ -38,7 +36,6 @@ (eval-and-compile (ignore-errors (require 'url))) -(autoload 'w3-parse-buffer "w3-parse") (nnoo-declare nnweb) @@ -527,7 +524,7 @@ Valid types include `google', `dejanews', and `gmane'.") url)) ;;; -;;; General web/w3 interface utility functions +;;; General web interface utility functions ;;; (defun nnweb-insert-html (parse) diff --git a/lisp/gnus/rfc1843.el b/lisp/gnus/rfc1843.el index 09c2b723eb7..74e8f12fc30 100644 --- a/lisp/gnus/rfc1843.el +++ b/lisp/gnus/rfc1843.el @@ -31,10 +31,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) (require 'mm-util) diff --git a/lisp/gnus/sieve-manage.el b/lisp/gnus/sieve-manage.el index fd97c7d595b..62d185e2857 100644 --- a/lisp/gnus/sieve-manage.el +++ b/lisp/gnus/sieve-manage.el @@ -71,10 +71,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (if (locate-library "password-cache") (require 'password-cache) (require 'password)) diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el index 4a763caba8e..bcebe3ddc38 100644 --- a/lisp/gnus/smime.el +++ b/lisp/gnus/smime.el @@ -118,9 +118,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) (require 'dig) (if (locate-library "password-cache") diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index 82f98c4294f..664ac53a76f 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -38,10 +38,6 @@ ;;{{{ compilation directives and autoloads/requires -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) (require 'message) ;for the message-fetch-field functions diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 5b0739ed9ae..25ee1d3149f 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -1,6 +1,7 @@ ;;; help-fns.el --- Complex help functions -*- lexical-binding: t -*- -;; Copyright (C) 1985-1986, 1993-1994, 1998-2014 Free Software Foundation, Inc. +;; Copyright (C) 1985-1986, 1993-1994, 1998-2014 +;; Free Software Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org ;; Keywords: help, internal @@ -429,6 +430,28 @@ FILE is the file where FUNCTION was probably defined." (setq load-hist (cdr load-hist))) found)) +(defun help-fns--interactive-only (function) + "Insert some help blurb if FUNCTION should only be used interactively." + ;; Ignore lambda constructs, keyboard macros, etc. + (and (symbolp function) + (not (eq (car-safe (symbol-function function)) 'macro)) + (let* ((interactive-only + (or (get function 'interactive-only) + (if (boundp 'byte-compile-interactive-only-functions) + (memq function + byte-compile-interactive-only-functions))))) + (when interactive-only + (insert "\nThis function is for interactive use only" + ;; Cf byte-compile-form. + (cond ((stringp interactive-only) + (format ";\nin Lisp code %s" interactive-only)) + ((and (symbolp 'interactive-only) + (not (eq interactive-only t))) + (format ";\nin Lisp code use `%s' instead." + interactive-only)) + (t ".")) + "\n"))))) + ;;;###autoload (defun describe-function-1 (function) (let* ((advised (and (symbolp function) @@ -553,6 +576,7 @@ FILE is the file where FUNCTION was probably defined." ;; Add defaults to `help-fns-describe-function-functions'. (add-hook 'help-fns-describe-function-functions #'help-fns--obsolete) +(add-hook 'help-fns-describe-function-functions #'help-fns--interactive-only) (add-hook 'help-fns-describe-function-functions #'help-fns--parent-mode) (add-hook 'help-fns-describe-function-functions #'help-fns--compiler-macro) diff --git a/lisp/help.el b/lisp/help.el index 72a95244716..8ba3d86004b 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -32,10 +32,6 @@ ;; or run interpreted, but not when the compiled code is loaded. (eval-when-compile (require 'help-macro)) -;; This makes `with-output-to-temp-buffer' buffers use `help-mode'. -(add-hook 'temp-buffer-setup-hook 'help-mode-setup) -(add-hook 'temp-buffer-show-hook 'help-mode-finish) - ;; `help-window-point-marker' is a marker you can move to a valid ;; position of the buffer shown in the help window in order to override ;; the standard positioning mechanism (`point-min') chosen by @@ -296,10 +292,11 @@ If that doesn't give a function, return nil." (interactive) (view-help-file "COPYING")) +;; Maybe this command should just be removed. (defun describe-gnu-project () - "Display info on the GNU project." + "Browse online information on the GNU project." (interactive) - (view-help-file "THE-GNU-PROJECT")) + (browse-url "http://www.gnu.org/gnu/thegnuproject.html")) (define-obsolete-function-alias 'describe-project 'describe-gnu-project "22.2") @@ -520,8 +517,10 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer." (if fn (format "Where is command (default %s): " fn) "Where is command: ") - obarray 'commandp t)) - (list (if (equal val "") fn (intern val)) current-prefix-arg))) + obarray 'commandp t nil nil + (and fn (symbol-name fn)))) + (list (unless (equal val "") (intern val)) + current-prefix-arg))) (unless definition (error "No command")) (let ((func (indirect-function definition)) (defs nil) @@ -647,6 +646,68 @@ temporarily enables it to allow getting help on disabled items and buttons." (princ (format "%s%s is undefined" key-desc mouse-msg)) (princ (format "%s%s runs the command %S" key-desc mouse-msg defn))))) +(defun help--key-binding-keymap (key &optional accept-default no-remap position) + "Return a keymap holding a binding for KEY within current keymaps. +The effect of the arguments KEY, ACCEPT-DEFAULT, NO-REMAP and +POSITION is as documented in the function `key-binding'." + (let* ((active-maps (current-active-maps t position)) + map found) + ;; We loop over active maps like key-binding does. + (while (and + (not found) + (setq map (pop active-maps))) + (setq found (lookup-key map key accept-default)) + (when (integerp found) + ;; The first `found' characters of KEY were found but not the + ;; whole sequence. + (setq found nil))) + (when found + (if (and (symbolp found) + (not no-remap) + (command-remapping found)) + ;; The user might want to know in which map the binding is + ;; found, or in which map the remapping is found. The + ;; default is to show the latter. + (help--key-binding-keymap (vector 'remap found)) + map)))) + +(defun help--binding-locus (key position) + "Describe in which keymap KEY is defined. +Return a symbol pointing to that keymap if one exists ; otherwise +return nil." + (let ((map (help--key-binding-keymap key t nil position))) + (when map + (catch 'found + (let ((advertised-syms (nconc + (list 'overriding-terminal-local-map + 'overriding-local-map) + (delq nil + (mapcar + (lambda (mode-and-map) + (let ((mode (car mode-and-map))) + (when (symbol-value mode) + (intern-soft + (format "%s-map" mode))))) + minor-mode-map-alist)) + (list 'global-map + (intern-soft (format "%s-map" major-mode))))) + found) + ;; Look into these advertised symbols first. + (dolist (sym advertised-syms) + (when (and + (boundp sym) + (eq map (symbol-value sym))) + (throw 'found sym))) + ;; Only look in other symbols otherwise. + (mapatoms + (lambda (x) + (when (and (boundp x) + ;; Avoid let-bound symbols. + (special-variable-p x) + (eq (symbol-value x) map)) + (throw 'found x)))) + nil))))) + (defun describe-key (&optional key untranslated up-event) "Display documentation of the function invoked by KEY. KEY can be any kind of a key sequence; it can include keyboard events, @@ -709,6 +770,7 @@ temporarily enables it to allow getting help on disabled items and buttons." (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers) (memq 'drag modifiers)) " at that spot" "")) (defn (key-binding key t)) + key-locus key-locus-up key-locus-up-tricky defn-up defn-up-tricky ev-type mouse-1-remapped mouse-1-tricky) @@ -747,15 +809,19 @@ temporarily enables it to allow getting help on disabled items and buttons." (setcar up-event (elt mouse-1-remapped 0))) (t (setcar up-event 'mouse-2)))) (setq defn-up (key-binding sequence nil nil (event-start up-event))) + (setq key-locus-up (help--binding-locus sequence (event-start up-event))) (when mouse-1-tricky (setq sequence (vector up-event)) (aset sequence 0 'mouse-1) - (setq defn-up-tricky (key-binding sequence nil nil (event-start up-event)))))) + (setq defn-up-tricky (key-binding sequence nil nil (event-start up-event))) + (setq key-locus-up-tricky (help--binding-locus sequence (event-start up-event)))))) + (setq key-locus (help--binding-locus key (event-start event))) (with-help-window (help-buffer) (princ (help-key-description key untranslated)) - (princ (format "\ -%s runs the command %S, which is " - mouse-msg defn)) + (princ (format "%s runs the command %S%s, which is " + mouse-msg defn (if key-locus + (format " (found in %s)" key-locus) + ""))) (describe-function-1 defn) (when up-event (unless (or (null defn-up) @@ -765,13 +831,15 @@ temporarily enables it to allow getting help on disabled items and buttons." ----------------- up-event %s---------------- -%s%s%s runs the command %S, which is " +%s%s%s runs the command %S%s, which is " (if mouse-1-tricky "(short click) " "") (key-description (vector up-event)) mouse-msg (if mouse-1-remapped " is remapped to <mouse-2>, which" "") - defn-up)) + defn-up (if key-locus-up + (format " (found in %s)" key-locus-up) + ""))) (describe-function-1 defn-up)) (unless (or (null defn-up-tricky) (integerp defn-up-tricky) @@ -781,10 +849,12 @@ temporarily enables it to allow getting help on disabled items and buttons." ----------------- up-event (long click) ---------------- Pressing <%S>%s for longer than %d milli-seconds -runs the command %S, which is " +runs the command %S%s, which is " ev-type mouse-msg mouse-1-click-follows-link - defn-up-tricky)) + defn-up-tricky (if key-locus-up-tricky + (format " (found in %s)" key-locus-up-tricky) + ""))) (describe-function-1 defn-up-tricky))))))) (defun describe-mode (&optional buffer) diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index 78efd8671c4..98a26dd4634 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -391,7 +391,7 @@ versions before 22 use the following in your init file: (font-lock-remove-keywords nil hi-lock-file-patterns) (setq hi-lock-file-patterns nil)) (remove-overlays nil nil 'hi-lock-overlay t) - (when font-lock-fontified (font-lock-fontify-buffer))) + (font-lock-flush)) (define-key-after menu-bar-edit-menu [hi-lock] nil) (remove-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook t))) @@ -601,7 +601,7 @@ then remove all hi-lock highlighting." (delq keyword hi-lock-interactive-patterns)) (remove-overlays nil nil 'hi-lock-overlay-regexp (hi-lock--hashcons (car keyword))) - (when font-lock-fontified (font-lock-fontify-buffer))))) + (font-lock-flush)))) ;;;###autoload (defun hi-lock-write-interactive-patterns () @@ -695,7 +695,7 @@ with completion and history." (if (and font-lock-mode (font-lock-specified-p major-mode)) (progn (font-lock-add-keywords nil (list pattern) t) - (font-lock-fontify-buffer)) + (font-lock-flush)) (let* ((range-min (- (point) (/ hi-lock-highlight-range 2))) (range-max (+ (point) (/ hi-lock-highlight-range 2))) (search-start @@ -719,7 +719,7 @@ with completion and history." (font-lock-remove-keywords nil hi-lock-file-patterns) (setq hi-lock-file-patterns patterns) (font-lock-add-keywords nil hi-lock-file-patterns t) - (font-lock-fontify-buffer))) + (font-lock-flush))) (defun hi-lock-find-patterns () "Find patterns in current buffer for hi-lock." diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el index d3b8a2cf6c5..ec6007ebf82 100644 --- a/lisp/hippie-exp.el +++ b/lisp/hippie-exp.el @@ -637,15 +637,27 @@ string). It returns t if a new completion is found, nil otherwise." The argument OLD has to be nil the first call of this function, and t for subsequent calls (for further possible completions of the same string). It returns t if a new completion is found, nil otherwise." + (he--all-buffers + old + (lambda () (he-line-beg (and (get-buffer-process (current-buffer)) + comint-use-prompt-regexp + comint-prompt-regexp))) + (lambda (string) + (he-line-search string + (and (get-buffer-process (current-buffer)) + comint-use-prompt-regexp + comint-prompt-regexp) + nil)))) + +(defun he--all-buffers (old beg-function search-function) (let ((expansion ()) - (strip-prompt (and (get-buffer-process (current-buffer)) - comint-use-prompt-regexp - comint-prompt-regexp)) - (buf (current-buffer)) - (orig-case-fold-search case-fold-search)) + (buf (current-buffer)) + (only-buffers hippie-expand-only-buffers) + (ignore-buffers hippie-expand-ignore-buffers) + (orig-case-fold-search case-fold-search)) (if (not old) - (progn - (he-init-string (he-line-beg strip-prompt) (point)) + (progn + (he-init-string (funcall beg-function) (point)) (setq he-search-bufs (buffer-list)) (setq he-searched-n-bufs 0) (set-marker he-search-loc 1 (car he-search-bufs)))) @@ -654,24 +666,20 @@ string). It returns t if a new completion is found, nil otherwise." (while (and he-search-bufs (not expansion) (or (not hippie-expand-max-buffers) - (< he-searched-n-bufs hippie-expand-max-buffers))) - (set-buffer (car he-search-bufs)) - (if (and (not (eq (current-buffer) buf)) - (if hippie-expand-only-buffers - (he-buffer-member hippie-expand-only-buffers) - (not (he-buffer-member hippie-expand-ignore-buffers)))) - (save-excursion - (save-restriction - (if hippie-expand-no-restriction + (< he-searched-n-bufs hippie-expand-max-buffers))) + (set-buffer (car he-search-bufs)) + (if (and (not (eq (current-buffer) buf)) + (if only-buffers + (he-buffer-member only-buffers) + (not (he-buffer-member ignore-buffers)))) + (save-excursion + (save-restriction + (if hippie-expand-no-restriction (widen)) (goto-char he-search-loc) - (setq strip-prompt (and (get-buffer-process (current-buffer)) - comint-use-prompt-regexp - comint-prompt-regexp)) (setq expansion (let ((case-fold-search orig-case-fold-search)) - (he-line-search he-search-string - strip-prompt nil))) + (funcall search-function he-search-string))) (set-marker he-search-loc (point)) (if (not expansion) (progn @@ -686,9 +694,9 @@ string). It returns t if a new completion is found, nil otherwise." (progn (if old (he-reset-string)) ()) - (progn - (he-substitute-string expansion t) - t)))) + (progn + (he-substitute-string expansion t) + t)))) (defun he-line-search (str strip-prompt reverse) (let ((result ())) @@ -769,53 +777,9 @@ string). It returns t if a new completion is found, nil otherwise." The argument OLD has to be nil the first call of this function, and t for subsequent calls (for further possible completions of the same string). It returns t if a new completion is found, nil otherwise." - (let ((expansion ()) - (buf (current-buffer)) - (orig-case-fold-search case-fold-search)) - (if (not old) - (progn - (he-init-string (he-list-beg) (point)) - (setq he-search-bufs (buffer-list)) - (setq he-searched-n-bufs 0) - (set-marker he-search-loc 1 (car he-search-bufs)))) - - (if (not (equal he-search-string "")) - (while (and he-search-bufs - (not expansion) - (or (not hippie-expand-max-buffers) - (< he-searched-n-bufs hippie-expand-max-buffers))) - (set-buffer (car he-search-bufs)) - (if (and (not (eq (current-buffer) buf)) - (if hippie-expand-only-buffers - (he-buffer-member hippie-expand-only-buffers) - (not (he-buffer-member hippie-expand-ignore-buffers)))) - (save-excursion - (save-restriction - (if hippie-expand-no-restriction - (widen)) - (goto-char he-search-loc) - (setq expansion - (let ((case-fold-search orig-case-fold-search)) - (he-list-search he-search-string nil))) - (set-marker he-search-loc (point)) - (if (not expansion) - (progn - (setq he-search-bufs (cdr he-search-bufs)) - (setq he-searched-n-bufs (1+ he-searched-n-bufs)) - (set-marker he-search-loc 1 (car he-search-bufs)))))) - (setq he-search-bufs (cdr he-search-bufs)) - (set-marker he-search-loc 1 (car he-search-bufs))))) - - (set-buffer buf) - (if (not expansion) - (progn - (if old (he-reset-string)) - ()) - (progn - (he-substitute-string expansion t) - t)))) + (he--all-buffers old #'he-list-beg #'he-list-search)) -(defun he-list-search (str reverse) +(defun he-list-search (str &optional reverse) (let ((result ()) beg pos err) (while (and (not result) @@ -924,51 +888,7 @@ string). It returns t if a new expansion is found, nil otherwise." The argument OLD has to be nil the first call of this function, and t for subsequent calls (for further possible expansions of the same string). It returns t if a new expansion is found, nil otherwise." - (let ((expansion ()) - (buf (current-buffer)) - (orig-case-fold-search case-fold-search)) - (if (not old) - (progn - (he-init-string (he-dabbrev-beg) (point)) - (setq he-search-bufs (buffer-list)) - (setq he-searched-n-bufs 0) - (set-marker he-search-loc 1 (car he-search-bufs)))) - - (if (not (equal he-search-string "")) - (while (and he-search-bufs - (not expansion) - (or (not hippie-expand-max-buffers) - (< he-searched-n-bufs hippie-expand-max-buffers))) - (set-buffer (car he-search-bufs)) - (if (and (not (eq (current-buffer) buf)) - (if hippie-expand-only-buffers - (he-buffer-member hippie-expand-only-buffers) - (not (he-buffer-member hippie-expand-ignore-buffers)))) - (save-excursion - (save-restriction - (if hippie-expand-no-restriction - (widen)) - (goto-char he-search-loc) - (setq expansion - (let ((case-fold-search orig-case-fold-search)) - (he-dabbrev-search he-search-string nil))) - (set-marker he-search-loc (point)) - (if (not expansion) - (progn - (setq he-search-bufs (cdr he-search-bufs)) - (setq he-searched-n-bufs (1+ he-searched-n-bufs)) - (set-marker he-search-loc 1 (car he-search-bufs)))))) - (setq he-search-bufs (cdr he-search-bufs)) - (set-marker he-search-loc 1 (car he-search-bufs))))) - - (set-buffer buf) - (if (not expansion) - (progn - (if old (he-reset-string)) - ()) - (progn - (he-substitute-string expansion t) - t)))) + (he--all-buffers old #'he-dabbrev-beg #'he-dabbrev-search)) ;; Thanks go to Jeff Dairiki <dairiki@faraday.apl.washington.edu> who ;; suggested this one. diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index 56887f39bef..5128ca8f9c4 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -1809,17 +1809,25 @@ fontified. This is a simple convenience wrapper around (eval-and-compile (require 'font-lock)) (if (boundp 'font-lock-cache-position) (or font-lock-cache-position - (set 'font-lock-cache-position (make-marker)))) - (if (not noninteractive) - (progn - (message "hfy interactive mode (%S %S)" window-system major-mode) - (when (and font-lock-defaults - font-lock-mode) - (font-lock-fontify-region (point-min) (point-max) nil))) + (setq font-lock-cache-position (make-marker)))) + (cond + (noninteractive (message "hfy batch mode (%s:%S)" (or (buffer-file-name) (buffer-name)) major-mode) - (when font-lock-defaults - (font-lock-fontify-buffer)) )) + (if (fboundp 'font-lock-ensure) + (font-lock-ensure) + (when font-lock-defaults + (font-lock-fontify-buffer)))) + ((fboundp #'jit-lock-fontify-now) + (message "hfy jit-lock mode (%S %S)" window-system major-mode) + (jit-lock-fontify-now)) + (t + (message "hfy interactive mode (%S %S)" window-system major-mode) + ;; If jit-lock is not in use, then the buffer is already fontified! + ;; (when (and font-lock-defaults + ;; font-lock-mode) + ;; (font-lock-fontify-region (point-min) (point-max) nil)) + ))) ;;;###autoload (defun htmlfontify-buffer (&optional srcdir file) diff --git a/lisp/image-mode.el b/lisp/image-mode.el index de6bb85bcb6..b75946475dd 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -90,6 +90,8 @@ otherwise it defaults to t, used for times when the buffer is not displayed." (defun image-mode-window-put (prop val &optional winprops) (unless (consp winprops) (setq winprops (image-mode-winprops winprops))) + (unless (eq t (car winprops)) + (image-mode-window-put prop val t)) (setcdr winprops (cons (cons prop val) (delq (assq prop (cdr winprops)) (cdr winprops))))) diff --git a/lisp/info.el b/lisp/info.el index 2b2490b5bdc..89ca8bdbe33 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -1,4 +1,4 @@ -;; info.el --- info package for Emacs +;; info.el --- Info package for Emacs -*- lexical-binding:t -*- ;; Copyright (C) 1985-1986, 1992-2014 Free Software Foundation, Inc. @@ -32,17 +32,19 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + (defgroup info nil "Info subsystem." :group 'help :group 'docs) -(defvar Info-history nil +(defvar-local Info-history nil "Stack of Info nodes user has visited. Each element of the stack is a list (FILENAME NODENAME BUFFERPOS).") -(defvar Info-history-forward nil +(defvar-local Info-history-forward nil "Stack of Info nodes user has visited with `Info-history-back' command. Each element of the stack is a list (FILENAME NODENAME BUFFERPOS).") @@ -375,33 +377,33 @@ with wrapping around the current Info node." (make-obsolete-variable 'Info-edit-mode-hook "editing Info nodes by hand is not recommended." "24.4") -(defvar Info-current-file nil +(defvar-local Info-current-file nil "Info file that Info is now looking at, or nil. This is the name that was specified in Info, not the actual file name. It doesn't contain directory names or file name extensions added by Info.") -(defvar Info-current-subfile nil +(defvar-local Info-current-subfile nil "Info subfile that is actually in the *info* buffer now. It is nil if current Info file is not split into subfiles.") -(defvar Info-current-node nil +(defvar-local Info-current-node nil "Name of node that Info is now looking at, or nil.") -(defvar Info-tag-table-marker nil +(defvar-local Info-tag-table-marker nil "Marker pointing at beginning of current Info file's tag table. Marker points nowhere if file has no tag table.") -(defvar Info-tag-table-buffer nil +(defvar-local Info-tag-table-buffer nil "Buffer used for indirect tag tables.") -(defvar Info-current-file-completions nil +(defvar-local Info-current-file-completions nil "Cached completion list for current Info file.") (defvar Info-file-completions nil "Cached completion alist of visited Info files. Each element of the alist is (FILE . COMPLETIONS)") -(defvar Info-file-supports-index-cookies nil +(defvar-local Info-file-supports-index-cookies nil "Non-nil if current Info file supports index cookies.") (defvar Info-file-supports-index-cookies-list nil @@ -409,7 +411,7 @@ Each element of the alist is (FILE . COMPLETIONS)") Each element of the list is a list (FILENAME SUPPORTS-INDEX-COOKIES) where SUPPORTS-INDEX-COOKIES can be either t or nil.") -(defvar Info-index-alternatives nil +(defvar-local Info-index-alternatives nil "List of possible matches for last `Info-index' command.") (defvar Info-point-loc nil @@ -455,7 +457,7 @@ existing node names. OPERATION is one of the following operation symbols `find-node' that define what HANDLER function to call instead of calling the default corresponding function to override it.") -(defvar Info-current-node-virtual nil +(defvar-local Info-current-node-virtual nil "Non-nil if the current Info node is virtual.") (defun Info-virtual-file-p (filename) @@ -954,10 +956,10 @@ otherwise, that defaults to `Top'." (unless nodename (setq nodename "Top")) (info-initialize) (Info-mode) - (set (make-local-variable 'Info-current-file) - (or buffer-file-name - ;; If called on a non-file buffer, make a fake file name. - (concat default-directory (buffer-name)))) + (setq Info-current-file + (or buffer-file-name + ;; If called on a non-file buffer, make a fake file name. + (concat default-directory (buffer-name)))) (Info-find-node-2 nil nodename)) (defun Info-revert-find-node (filename nodename) @@ -1091,7 +1093,7 @@ is non-nil)." (set-marker Info-tag-table-marker nil) (setq buffer-read-only t) (set-buffer-modified-p nil) - (set (make-local-variable 'Info-current-node-virtual) t))) + (setq Info-current-node-virtual t))) ((not (and ;; Reread a file when moving from a virtual node. (not Info-current-node-virtual) @@ -1101,7 +1103,7 @@ is non-nil)." (let ((inhibit-read-only t)) (when Info-current-node-virtual ;; When moving from a virtual node. - (set (make-local-variable 'Info-current-node-virtual) nil) + (setq Info-current-node-virtual nil) (if (null filename) (setq filename Info-current-file))) (setq Info-current-file nil @@ -1112,7 +1114,7 @@ is non-nil)." (info-insert-file-contents filename nil) (setq default-directory (file-name-directory filename)) (set-buffer-modified-p nil) - (set (make-local-variable 'Info-file-supports-index-cookies) + (setq Info-file-supports-index-cookies (Info-file-supports-index-cookies filename)) ;; See whether file has a tag table. Record the location if yes. @@ -1251,17 +1253,17 @@ is non-nil)." ;; Cache the contents of the (virtual) dir file, once we have merged ;; it for the first time, so we can save time subsequently. -(defvar Info-dir-contents nil) +(defvar-local Info-dir-contents nil) ;; Cache for the directory we decided to use for the default-directory ;; of the merged dir text. -(defvar Info-dir-contents-directory nil) +(defvar-local Info-dir-contents-directory nil) ;; Record the file attributes of all the files from which we ;; constructed Info-dir-contents. -(defvar Info-dir-file-attributes nil) +(defvar-local Info-dir-file-attributes nil) -(defvar Info-dir-file-name nil) +(defvar-local Info-dir-file-name nil) ;; Construct the Info directory node by merging the files named `dir' ;; from various directories. Set the *info* buffer's @@ -1334,13 +1336,12 @@ is non-nil)." ;; knows... (let ((inhibit-null-byte-detection t)) (insert-file-contents file) - (set (make-local-variable 'Info-dir-file-name) - file) + (setq Info-dir-file-name file) (push (current-buffer) buffers) (push (cons file attrs) dir-file-attrs)) (error (kill-buffer (current-buffer)))))))) (unless (cdr dirs) - (set (make-local-variable 'Info-dir-contents-directory) + (setq Info-dir-contents-directory (file-name-as-directory (car dirs)))) (setq dirs (cdr dirs)))) @@ -1425,8 +1426,8 @@ is non-nil)." (if problems (message "Composing main Info directory...problems encountered, see `*Messages*'") (message "Composing main Info directory...done")) - (set (make-local-variable 'Info-dir-contents) (buffer-string)) - (set (make-local-variable 'Info-dir-file-attributes) dir-file-attrs))) + (setq Info-dir-contents (buffer-string)) + (setq Info-dir-file-attributes dir-file-attrs))) (setq default-directory Info-dir-contents-directory)) (defvar Info-streamline-headings @@ -1892,7 +1893,7 @@ the Top node in FILENAME." (cons (list (match-string-no-properties 1)) compl)))))))) (setq compl (cons '("*") (nreverse compl))) - (set (make-local-variable 'Info-current-file-completions) compl) + (setq Info-current-file-completions compl) compl)) @@ -2207,7 +2208,7 @@ End of submatch 0, 1, and 3 are the same, so you can safely concat." "[" (or allowedchars "^,\t\n") " ]" ;The last char can't be a space. "\\|\\)\\)")) ;Allow empty node names. -;;; For compatibility; other files have used this name. +;; For compatibility; other files have used this name. (defun Info-following-node-name () (and (looking-at (Info-following-node-name-re)) (match-string-no-properties 1))) @@ -2645,7 +2646,7 @@ Because of ambiguities, this should be concatenated with something like (defvar Info-complete-menu-buffer) (defvar Info-complete-next-re nil) (defvar Info-complete-nodes nil) -(defvar Info-complete-cache nil) +(defvar-local Info-complete-cache nil) (defconst Info-node-spec-re (concat (Info-following-node-name-re "^.,:") "[,:.]") @@ -2714,7 +2715,7 @@ Because of ambiguities, this should be concatenated with something like (unless (equal Info-current-node orignode) (Info-goto-node orignode)) ;; Update the cache. - (set (make-local-variable 'Info-complete-cache) + (setq Info-complete-cache (list Info-current-file Info-current-node Info-complete-next-re string completions Info-complete-nodes))) @@ -3562,9 +3563,9 @@ Return a list of matches where each element is in the format (goto-char (point-min)) (re-search-forward "\\* Menu: *\n" nil t) (while (re-search-forward "\\*.*: *(\\([^)]+\\))" nil t) - ;; add-to-list makes sure we don't have duplicates in `manuals', + ;; Make sure we don't have duplicates in `manuals', ;; so that the following dolist loop runs faster. - (add-to-list 'manuals (match-string 1))) + (cl-pushnew (match-string 1) manuals :test #'equal)) (dolist (manual (nreverse manuals)) (message "Searching %s" manual) (condition-case err @@ -3633,6 +3634,18 @@ Build a menu of the possible matches." (defvar finder-keywords-hash) (defvar package--builtins) ; finder requires package +(defun info--prettify-description (desc) + (if (stringp desc) + (with-temp-buffer + (insert desc) + (if (equal ?. (char-before)) + (delete-char -1)) + (goto-char (point-min)) + (or (let (case-fold-search) (looking-at-p "\\.\\|[[:upper:]]")) + (capitalize-word 1)) + (buffer-string)) + desc)) + (defun Info-finder-find-node (_filename nodename &optional _no-going-back) "Finder-specific implementation of `Info-find-node-2'." (require 'finder) @@ -3651,7 +3664,7 @@ Build a menu of the possible matches." (insert (format "* %s %s.\n" (concat (symbol-name keyword) ": " "Keyword " (symbol-name keyword) ".") - (cdr assoc)))))) + (info--prettify-description (cdr assoc))))))) ((equal nodename "Keyword unknown") ;; Display unknown keywords (insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n" @@ -3679,7 +3692,7 @@ Build a menu of the possible matches." (when (vectorp desc) (insert (format "* %-16s %s.\n" (concat (symbol-name (car package)) "::") - (aref desc 2))))))) + (info--prettify-description (aref desc 2)))))))) ((string-match "\\`Keyword " nodename) (setq nodename (substring nodename (match-end 0))) ;; Display packages that match the keyword @@ -3700,27 +3713,31 @@ Build a menu of the possible matches." (push (copy-tree (gethash keyword finder-keywords-hash)) hits)) (setq hits (delete-dups (apply 'append hits)) ;; Not a meaningful package. - hits (delete 'emacs hits)) + hits (delete 'emacs hits) + hits (sort hits (lambda (a b) (string< (symbol-name a) + (symbol-name b))))) (dolist (package hits) (setq desc (cdr-safe (assq package package--builtins))) (when (vectorp desc) (insert (format "* %-16s %s.\n" (concat (symbol-name package) "::") - (aref desc 2))))))) + (info--prettify-description (aref desc 2)))))))) (t ;; Display commentary section (insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n" Info-finder-file nodename)) - (insert "Finder Commentary\n") - (insert "*****************\n\n") + (insert "Package Description\n") + (insert "*******************\n\n") (insert - "Commentary section of the package `" nodename "':\n\n") - ;; FIXME this assumes that a file named package.el exists, + "Description of the package `" nodename "':\n\n") + ;; This assumes that a file named package.el exists, ;; which is not always true. E.g. for the nxml package, ;; there is no "nxml.el" (it's nxml-mode.el). - (let ((str (lm-commentary (find-library-name nodename)))) + ;; But package.el makes the same assumption. + ;; I think nxml is the only exception - maybe it should be just be renamed. + (let ((str (ignore-errors (lm-commentary (find-library-name nodename))))) (if (null str) - (insert "Can't find any Commentary section\n\n") + (insert "Can't find package description.\n\n") (insert (with-temp-buffer (insert str) @@ -4192,9 +4209,16 @@ With a zero prefix arg, put the name inside a function call to `info'." st) "Syntax table used in `Info-mode'.") +(defface Info-quoted + '((t :family "courier")) + "Face used for quoted elements.") + +(defvar Info-mode-font-lock-keywords + '(("‘\\([^’]*\\)’" (1 'Info-quoted)))) + ;; Autoload cookie needed by desktop.el ;;;###autoload -(define-derived-mode Info-mode nil "Info" +(define-derived-mode Info-mode nil "Info" ;FIXME: Derive from special-mode? "Info mode provides commands for browsing through the Info documentation tree. Documentation in Info is divided into \"nodes\", each of which discusses one topic and contains references to other nodes which discuss related @@ -4262,39 +4286,27 @@ Advanced commands: (add-hook 'activate-menubar-hook 'Info-menu-update nil t) (setq case-fold-search t) (setq buffer-read-only t) - (make-local-variable 'Info-current-file) - (make-local-variable 'Info-current-subfile) - (make-local-variable 'Info-current-node) - (set (make-local-variable 'Info-tag-table-marker) (make-marker)) - (set (make-local-variable 'Info-tag-table-buffer) nil) - (make-local-variable 'Info-history) - (make-local-variable 'Info-history-forward) - (make-local-variable 'Info-index-alternatives) + (setq Info-tag-table-marker (make-marker)) (if Info-use-header-line ; do not override global header lines (setq header-line-format '(:eval (get-text-property (point-min) 'header-line)))) - (set (make-local-variable 'tool-bar-map) info-tool-bar-map) + (setq-local tool-bar-map info-tool-bar-map) ;; This is for the sake of the invisible text we use handling titles. - (set (make-local-variable 'line-move-ignore-invisible) t) - (set (make-local-variable 'desktop-save-buffer) - 'Info-desktop-buffer-misc-data) - (set (make-local-variable 'widen-automatically) nil) + (setq-local line-move-ignore-invisible t) + (setq-local desktop-save-buffer 'Info-desktop-buffer-misc-data) + (setq-local widen-automatically nil) (add-hook 'kill-buffer-hook 'Info-kill-buffer nil t) (add-hook 'clone-buffer-hook 'Info-clone-buffer nil t) (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) (add-hook 'isearch-mode-hook 'Info-isearch-start nil t) - (set (make-local-variable 'isearch-search-fun-function) - 'Info-isearch-search) - (set (make-local-variable 'isearch-wrap-function) - 'Info-isearch-wrap) - (set (make-local-variable 'isearch-push-state-function) - 'Info-isearch-push-state) - (set (make-local-variable 'isearch-filter-predicate) #'Info-isearch-filter) - (set (make-local-variable 'revert-buffer-function) - 'Info-revert-buffer-function) + (setq-local isearch-search-fun-function #'Info-isearch-search) + (setq-local isearch-wrap-function #'Info-isearch-wrap) + (setq-local isearch-push-state-function #'Info-isearch-push-state) + (setq-local isearch-filter-predicate #'Info-isearch-filter) + (setq-local revert-buffer-function #'Info-revert-buffer-function) + (setq-local font-lock-defaults '(Info-mode-font-lock-keywords t t)) (Info-set-mode-line) - (set (make-local-variable 'bookmark-make-record-function) - 'Info-bookmark-make-record)) + (setq-local bookmark-make-record-function #'Info-bookmark-make-record)) ;; When an Info buffer is killed, make sure the associated tags buffer ;; is killed too. @@ -4323,7 +4335,7 @@ Advanced commands: map) "Local keymap used within `e' command of Info.") -(make-obsolete-variable 'Info-edit-map +(make-obsolete-variable 'Info-edit-mode-map "editing Info nodes by hand is not recommended." "24.4") @@ -4333,8 +4345,7 @@ Advanced commands: (define-derived-mode Info-edit-mode text-mode "Info Edit" "Major mode for editing the contents of an Info node. Like text mode with the addition of `Info-cease-edit' -which returns to Info mode for browsing. -\\{Info-edit-map}" +which returns to Info mode for browsing." (setq buffer-read-only nil) (force-mode-line-update) (buffer-enable-undo (current-buffer))) @@ -4347,7 +4358,7 @@ which returns to Info mode for browsing. (interactive) (Info-edit-mode) (message "%s" (substitute-command-keys - "Editing: Type \\<Info-edit-map>\\[Info-cease-edit] to return to info"))) + "Editing: Type \\<Info-edit-mode-map>\\[Info-cease-edit] to return to info"))) (put 'Info-edit 'disabled "Editing Info nodes by hand is not recommended. This feature will be removed in future.") diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 0a2f09029da..f6c0719e4c4 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -1,4 +1,4 @@ -;;; mule-cmds.el --- commands for multilingual environment -*-coding: utf-8 -*- +;;; mule-cmds.el --- commands for multilingual environment -*- lexical-binding:t -*- ;; Copyright (C) 1997-2014 Free Software Foundation, Inc. ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, @@ -2909,16 +2909,14 @@ on encoding." (defun ucs-names () "Return alist of (CHAR-NAME . CHAR-CODE) pairs cached in `ucs-names'." (or ucs-names - (let ((bmp-ranges + (let ((ranges '((#x0000 . #x33FF) ;; (#x3400 . #x4DBF) CJK Ideographs Extension A (#x4DC0 . #x4DFF) ;; (#x4E00 . #x9FFF) CJK Unified Ideographs (#xA000 . #xD7FF) ;; (#xD800 . #xFAFF) Surrogate/Private - (#xFB00 . #xFFFD))) - (upper-ranges - '((#x10000 . #x134FF) + (#xFB00 . #x134FF) ;; (#x13500 . #x167FF) unused (#x16800 . #x16A3F) ;; (#x16A40 . #x1AFFF) unused @@ -2928,23 +2926,20 @@ on encoding." ;; (#x20000 . #xDFFFF) CJK Ideograph Extension A, B, etc, unused (#xE0000 . #xE01FF))) (gc-cons-threshold 10000000) - c end name names) - (dolist (range bmp-ranges) - (setq c (car range) - end (cdr range)) + names) + (dolist (range ranges) + (let ((c (car range)) + (end (cdr range))) (while (<= c end) - (if (setq name (get-char-code-property c 'name)) - (push (cons name c) names)) - (if (setq name (get-char-code-property c 'old-name)) - (push (cons name c) names)) - (setq c (1+ c)))) - (dolist (range upper-ranges) - (setq c (car range) - end (cdr range)) - (while (<= c end) - (if (setq name (get-char-code-property c 'name)) - (push (cons name c) names)) - (setq c (1+ c)))) + (let ((new-name (get-char-code-property c 'name)) + (old-name (get-char-code-property c 'old-name))) + ;; In theory this code could end up pushing an "old-name" that + ;; shadows a "new-name" but in practice every time an + ;; `old-name' conflicts with a `new-name', the newer one has a + ;; higher code, so it gets pushed later! + (if new-name (push (cons new-name c) names)) + (if old-name (push (cons old-name c) names)) + (setq c (1+ c)))))) ;; Special case for "BELL" which is apparently the only char which ;; doesn't have a new name and whose old-name is shadowed by a newer ;; char with that name. diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el index efafb96538b..42bc5ef1e5c 100644 --- a/lisp/international/mule-util.el +++ b/lisp/international/mule-util.el @@ -56,6 +56,9 @@ (setq i (1+ i))))) string) +(defvar truncate-string-ellipsis "..." ;"…" + "String to use to indicate truncation.") + ;;;###autoload (defun truncate-string-to-width (str end-column &optional start-column padding ellipsis) @@ -80,11 +83,11 @@ If ELLIPSIS is non-nil, it should be a string which will replace the end of STR (including any padding) if it extends beyond END-COLUMN, unless the display width of STR is equal to or less than the display width of ELLIPSIS. If it is non-nil and not a string, then ELLIPSIS -defaults to \"...\"." +defaults to `truncate-string-ellipsis'." (or start-column (setq start-column 0)) (when (and ellipsis (not (stringp ellipsis))) - (setq ellipsis "...")) + (setq ellipsis truncate-string-ellipsis)) (let ((str-len (length str)) (str-width (string-width str)) (ellipsis-len (if ellipsis (length ellipsis) 0)) diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el index 42e6519e38c..d346f050415 100644 --- a/lisp/jit-lock.el +++ b/lisp/jit-lock.el @@ -318,10 +318,6 @@ Only applies to the current buffer." (remove-hook 'jit-lock-functions fun t) (unless jit-lock-functions (jit-lock-mode nil))) -;; This function is used to prevent font-lock-fontify-buffer from -;; fontifying eagerly the whole buffer. This is important for -;; things like CWarn mode which adds/removes a few keywords and -;; does a refontify (which takes ages on large files). (defun jit-lock-refontify (&optional beg end) "Force refontification of the region BEG..END (default whole buffer)." (with-buffer-prepared-for-jit-lock diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index ee312dc57fc..ffaaa1b7afc 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -3,7 +3,7 @@ ;;; Code: -;;;### (autoloads nil "5x5" "play/5x5.el" (21291 53104 0 0)) +;;;### (autoloads nil "5x5" "play/5x5.el" (21187 63826 213216 0)) ;;; Generated autoloads from play/5x5.el (autoload '5x5 "5x5" "\ @@ -65,8 +65,8 @@ should return a grid vector array that is the new solution. ;;;*** -;;;### (autoloads nil "ada-mode" "progmodes/ada-mode.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "ada-mode" "progmodes/ada-mode.el" (21220 61111 +;;;;;; 156047 0)) ;;; Generated autoloads from progmodes/ada-mode.el (autoload 'ada-add-extensions "ada-mode" "\ @@ -85,8 +85,8 @@ Ada mode is the major mode for editing Ada code. ;;;*** -;;;### (autoloads nil "ada-stmt" "progmodes/ada-stmt.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "ada-stmt" "progmodes/ada-stmt.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from progmodes/ada-stmt.el (autoload 'ada-header "ada-stmt" "\ @@ -96,8 +96,8 @@ Insert a descriptive header at the top of the file. ;;;*** -;;;### (autoloads nil "ada-xref" "progmodes/ada-xref.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "ada-xref" "progmodes/ada-xref.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from progmodes/ada-xref.el (autoload 'ada-find-file "ada-xref" "\ @@ -108,7 +108,8 @@ Completion is available. ;;;*** -;;;### (autoloads nil "add-log" "vc/add-log.el" (21291 53104 0 0)) +;;;### (autoloads nil "add-log" "vc/add-log.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from vc/add-log.el (put 'change-log-default-name 'safe-local-variable 'string-or-null-p) @@ -237,8 +238,8 @@ old-style time formats for entries are supported. ;;;*** -;;;### (autoloads nil "advice" "emacs-lisp/advice.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "advice" "emacs-lisp/advice.el" (21278 229 +;;;;;; 682967 799000)) ;;; Generated autoloads from emacs-lisp/advice.el (defvar ad-redefinition-action 'warn "\ @@ -367,13 +368,13 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) \(fn FUNCTION ARGS &rest BODY)" nil t) -(put 'defadvice 'doc-string-elt '3) +(function-put 'defadvice 'doc-string-elt '3) -(put 'defadvice 'lisp-indent-function '2) +(function-put 'defadvice 'lisp-indent-function '2) ;;;*** -;;;### (autoloads nil "align" "align.el" (21298 17013 0 0)) +;;;### (autoloads nil "align" "align.el" (21299 64170 881226 0)) ;;; Generated autoloads from align.el (autoload 'align "align" "\ @@ -476,7 +477,7 @@ A replacement function for `newline-and-indent', aligning as it goes. ;;;*** -;;;### (autoloads nil "allout" "allout.el" (21291 53104 0 0)) +;;;### (autoloads nil "allout" "allout.el" (21187 63826 213216 0)) ;;; Generated autoloads from allout.el (push (purecopy '(allout 2 3)) package--builtin-versions) @@ -836,8 +837,8 @@ for details on preparing Emacs for automatic allout activation. ;;;*** -;;;### (autoloads nil "allout-widgets" "allout-widgets.el" (21346 -;;;;;; 62196 0 0)) +;;;### (autoloads nil "allout-widgets" "allout-widgets.el" (21350 +;;;;;; 58112 380040 0)) ;;; Generated autoloads from allout-widgets.el (push (purecopy '(allout-widgets 1 0)) package--builtin-versions) @@ -895,7 +896,7 @@ outline hot-spot navigation (see `allout-mode'). ;;;*** -;;;### (autoloads nil "ange-ftp" "net/ange-ftp.el" (21291 53104 0 +;;;### (autoloads nil "ange-ftp" "net/ange-ftp.el" (21240 46395 727291 ;;;;;; 0)) ;;; Generated autoloads from net/ange-ftp.el @@ -917,7 +918,7 @@ directory, so that Emacs will know its current contents. ;;;*** -;;;### (autoloads nil "animate" "play/animate.el" (21291 53104 0 +;;;### (autoloads nil "animate" "play/animate.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from play/animate.el @@ -950,7 +951,7 @@ the buffer *Birthday-Present-for-Name*. ;;;*** -;;;### (autoloads nil "ansi-color" "ansi-color.el" (21291 53104 0 +;;;### (autoloads nil "ansi-color" "ansi-color.el" (21277 37159 898165 ;;;;;; 0)) ;;; Generated autoloads from ansi-color.el (push (purecopy '(ansi-color 3 4 2)) package--builtin-versions) @@ -977,8 +978,8 @@ This is a good function to put in `comint-output-filter-functions'. ;;;*** -;;;### (autoloads nil "antlr-mode" "progmodes/antlr-mode.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "antlr-mode" "progmodes/antlr-mode.el" (21208 +;;;;;; 39903 471297 312000)) ;;; Generated autoloads from progmodes/antlr-mode.el (push (purecopy '(antlr-mode 2 2 3)) package--builtin-versions) @@ -1014,7 +1015,8 @@ Used in `antlr-mode'. Also a useful function in `java-mode-hook'. ;;;*** -;;;### (autoloads nil "appt" "calendar/appt.el" (21291 53104 0 0)) +;;;### (autoloads nil "appt" "calendar/appt.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from calendar/appt.el (autoload 'appt-add "appt" "\ @@ -1035,7 +1037,8 @@ ARG is positive, otherwise off. ;;;*** -;;;### (autoloads nil "apropos" "apropos.el" (21291 53104 0 0)) +;;;### (autoloads nil "apropos" "apropos.el" (21259 10807 217062 +;;;;;; 0)) ;;; Generated autoloads from apropos.el (autoload 'apropos-read-pattern "apropos" "\ @@ -1150,7 +1153,8 @@ Returns list of symbols and documentation found. ;;;*** -;;;### (autoloads nil "arc-mode" "arc-mode.el" (21291 53104 0 0)) +;;;### (autoloads nil "arc-mode" "arc-mode.el" (21207 49087 974317 +;;;;;; 0)) ;;; Generated autoloads from arc-mode.el (autoload 'archive-mode "arc-mode" "\ @@ -1170,7 +1174,7 @@ archive. ;;;*** -;;;### (autoloads nil "array" "array.el" (21291 53104 0 0)) +;;;### (autoloads nil "array" "array.el" (21240 46395 727291 0)) ;;; Generated autoloads from array.el (autoload 'array-mode "array" "\ @@ -1241,8 +1245,8 @@ Entering array mode calls the function `array-mode-hook'. ;;;*** -;;;### (autoloads nil "artist" "textmodes/artist.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "artist" "textmodes/artist.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from textmodes/artist.el (push (purecopy '(artist 1 2 6)) package--builtin-versions) @@ -1448,8 +1452,8 @@ Keymap summary ;;;*** -;;;### (autoloads nil "asm-mode" "progmodes/asm-mode.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "asm-mode" "progmodes/asm-mode.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from progmodes/asm-mode.el (autoload 'asm-mode "asm-mode" "\ @@ -1476,8 +1480,8 @@ Special commands: ;;;*** -;;;### (autoloads nil "auth-source" "gnus/auth-source.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "auth-source" "gnus/auth-source.el" (21342 +;;;;;; 10917 902592 0)) ;;; Generated autoloads from gnus/auth-source.el (defvar auth-source-cache-expiry 7200 "\ @@ -1489,7 +1493,8 @@ let-binding.") ;;;*** -;;;### (autoloads nil "autoarg" "autoarg.el" (21291 53104 0 0)) +;;;### (autoloads nil "autoarg" "autoarg.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from autoarg.el (defvar autoarg-mode nil "\ @@ -1549,8 +1554,8 @@ This is similar to `autoarg-mode' but rebinds the keypad keys ;;;*** -;;;### (autoloads nil "autoconf" "progmodes/autoconf.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "autoconf" "progmodes/autoconf.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from progmodes/autoconf.el (autoload 'autoconf-mode "autoconf" "\ @@ -1560,7 +1565,7 @@ Major mode for editing Autoconf configure.ac files. ;;;*** -;;;### (autoloads nil "autoinsert" "autoinsert.el" (21291 53104 0 +;;;### (autoloads nil "autoinsert" "autoinsert.el" (21240 46395 727291 ;;;;;; 0)) ;;; Generated autoloads from autoinsert.el @@ -1599,8 +1604,8 @@ insert a template for the file depending on the mode of the buffer. ;;;*** -;;;### (autoloads nil "autoload" "emacs-lisp/autoload.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "autoload" "emacs-lisp/autoload.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from emacs-lisp/autoload.el (put 'generated-autoload-file 'safe-local-variable 'stringp) @@ -1649,7 +1654,7 @@ should be non-nil). ;;;*** -;;;### (autoloads nil "autorevert" "autorevert.el" (21310 8261 0 +;;;### (autoloads nil "autorevert" "autorevert.el" (21315 5521 187938 ;;;;;; 0)) ;;; Generated autoloads from autorevert.el @@ -1738,7 +1743,7 @@ specifies in the mode line. ;;;*** -;;;### (autoloads nil "avoid" "avoid.el" (21372 35662 356409 0)) +;;;### (autoloads nil "avoid" "avoid.el" (21379 5287 607434 0)) ;;; Generated autoloads from avoid.el (defvar mouse-avoidance-mode nil "\ @@ -1776,8 +1781,8 @@ definition of \"random distance\".) ;;;*** -;;;### (autoloads nil "bat-mode" "progmodes/bat-mode.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "bat-mode" "progmodes/bat-mode.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from progmodes/bat-mode.el (add-to-list 'auto-mode-alist '("\\.\\(bat\\|cmd\\)\\'" . bat-mode)) @@ -1795,7 +1800,7 @@ Run script using `bat-run' and `bat-run-args'. ;;;*** -;;;### (autoloads nil "battery" "battery.el" (21341 23900 0 0)) +;;;### (autoloads nil "battery" "battery.el" (21346 7974 405729 0)) ;;; Generated autoloads from battery.el (put 'battery-mode-line-string 'risky-local-variable t) @@ -1830,8 +1835,8 @@ seconds. ;;;*** -;;;### (autoloads nil "benchmark" "emacs-lisp/benchmark.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "benchmark" "emacs-lisp/benchmark.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from emacs-lisp/benchmark.el (autoload 'benchmark-run "benchmark" "\ @@ -1845,7 +1850,7 @@ See also `benchmark-run-compiled'. \(fn &optional REPETITIONS &rest FORMS)" nil t) -(put 'benchmark-run 'lisp-indent-function '1) +(function-put 'benchmark-run 'lisp-indent-function '1) (autoload 'benchmark-run-compiled "benchmark" "\ Time execution of compiled version of FORMS. @@ -1855,7 +1860,7 @@ result. The overhead of the `lambda's is accounted for. \(fn &optional REPETITIONS &rest FORMS)" nil t) -(put 'benchmark-run-compiled 'lisp-indent-function '1) +(function-put 'benchmark-run-compiled 'lisp-indent-function '1) (autoload 'benchmark "benchmark" "\ Print the time taken for REPETITIONS executions of FORM. @@ -1867,8 +1872,8 @@ For non-interactive use see also `benchmark-run' and ;;;*** -;;;### (autoloads nil "bibtex" "textmodes/bibtex.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "bibtex" "textmodes/bibtex.el" (21264 28773 +;;;;;; 629489 0)) ;;; Generated autoloads from textmodes/bibtex.el (autoload 'bibtex-initialize "bibtex" "\ @@ -1960,7 +1965,7 @@ A prefix arg negates the value of `bibtex-search-entry-globally'. ;;;*** ;;;### (autoloads nil "bibtex-style" "textmodes/bibtex-style.el" -;;;;;; (21291 53104 0 0)) +;;;;;; (21187 63826 213216 0)) ;;; Generated autoloads from textmodes/bibtex-style.el (autoload 'bibtex-style-mode "bibtex-style" "\ @@ -1970,7 +1975,8 @@ Major mode for editing BibTeX style files. ;;;*** -;;;### (autoloads nil "binhex" "mail/binhex.el" (21291 53104 0 0)) +;;;### (autoloads nil "binhex" "mail/binhex.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from mail/binhex.el (defconst binhex-begin-line "^:...............................................................$" "\ @@ -1994,8 +2000,8 @@ Binhex decode region between START and END. ;;;*** -;;;### (autoloads nil "blackbox" "play/blackbox.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "blackbox" "play/blackbox.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from play/blackbox.el (autoload 'blackbox "blackbox" "\ @@ -2114,7 +2120,8 @@ a reflection. ;;;*** -;;;### (autoloads nil "bookmark" "bookmark.el" (21291 53104 0 0)) +;;;### (autoloads nil "bookmark" "bookmark.el" (21294 46247 414129 +;;;;;; 0)) ;;; Generated autoloads from bookmark.el (define-key ctl-x-r-map "b" 'bookmark-jump) (define-key ctl-x-r-map "m" 'bookmark-set) @@ -2240,10 +2247,11 @@ probably because we were called from there. (autoload 'bookmark-write "bookmark" "\ Write bookmarks to a file (reading the file name with the minibuffer). -Don't use this in Lisp programs; use `bookmark-save' instead. \(fn)" t nil) +(function-put 'bookmark-write 'interactive-only 'bookmark-save) + (autoload 'bookmark-save "bookmark" "\ Save currently defined bookmarks. Saves by default in the file defined by the variable @@ -2307,8 +2315,8 @@ Incremental search of bookmarks, hiding the non-matches as we go. ;;;*** -;;;### (autoloads nil "browse-url" "net/browse-url.el" (21361 65337 -;;;;;; 555586 0)) +;;;### (autoloads nil "browse-url" "net/browse-url.el" (21364 37926 +;;;;;; 837230 0)) ;;; Generated autoloads from net/browse-url.el (defvar browse-url-browser-function 'browse-url-default-browser "\ @@ -2623,7 +2631,7 @@ from `browse-url-elinks-wrapper'. ;;;*** -;;;### (autoloads nil "bs" "bs.el" (21291 53104 0 0)) +;;;### (autoloads nil "bs" "bs.el" (21383 2343 498187 0)) ;;; Generated autoloads from bs.el (push (purecopy '(bs 1 17)) package--builtin-versions) @@ -2664,7 +2672,7 @@ name of buffer configuration. ;;;*** -;;;### (autoloads nil "bubbles" "play/bubbles.el" (21291 53104 0 +;;;### (autoloads nil "bubbles" "play/bubbles.el" (21202 31159 541460 ;;;;;; 0)) ;;; Generated autoloads from play/bubbles.el @@ -2687,7 +2695,7 @@ columns on its right towards the left. ;;;*** ;;;### (autoloads nil "bug-reference" "progmodes/bug-reference.el" -;;;;;; (21291 53104 0 0)) +;;;;;; (21187 63826 213216 0)) ;;; Generated autoloads from progmodes/bug-reference.el (put 'bug-reference-url-format 'safe-local-variable (lambda (s) (or (stringp s) (and (symbolp s) (get s 'bug-reference-url-format))))) @@ -2707,8 +2715,8 @@ Like `bug-reference-mode', but only buttonize in comments and strings. ;;;*** -;;;### (autoloads nil "bytecomp" "emacs-lisp/bytecomp.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "bytecomp" "emacs-lisp/bytecomp.el" (21334 +;;;;;; 16805 699731 0)) ;;; Generated autoloads from emacs-lisp/bytecomp.el (put 'byte-compile-dynamic 'safe-local-variable 'booleanp) (put 'byte-compile-disable-print-circle 'safe-local-variable 'booleanp) @@ -2828,8 +2836,8 @@ and corresponding effects. ;;;*** -;;;### (autoloads nil "cal-china" "calendar/cal-china.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "cal-china" "calendar/cal-china.el" (21350 +;;;;;; 5031 352444 0)) ;;; Generated autoloads from calendar/cal-china.el (put 'calendar-chinese-time-zone 'risky-local-variable t) @@ -2838,8 +2846,8 @@ and corresponding effects. ;;;*** -;;;### (autoloads nil "cal-dst" "calendar/cal-dst.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "cal-dst" "calendar/cal-dst.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from calendar/cal-dst.el (put 'calendar-daylight-savings-starts 'risky-local-variable t) @@ -2850,8 +2858,8 @@ and corresponding effects. ;;;*** -;;;### (autoloads nil "cal-hebrew" "calendar/cal-hebrew.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "cal-hebrew" "calendar/cal-hebrew.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from calendar/cal-hebrew.el (autoload 'calendar-hebrew-list-yahrzeits "cal-hebrew" "\ @@ -2865,7 +2873,7 @@ from the cursor position. ;;;*** -;;;### (autoloads nil "calc" "calc/calc.el" (21291 53104 0 0)) +;;;### (autoloads nil "calc" "calc/calc.el" (21377 49959 896066 0)) ;;; Generated autoloads from calc/calc.el (define-key ctl-x-map "*" 'calc-dispatch) @@ -2945,12 +2953,12 @@ See Info node `(calc)Defining Functions'. \(fn FUNC ARGS &rest BODY)" nil t) -(put 'defmath 'doc-string-elt '3) +(function-put 'defmath 'doc-string-elt '3) ;;;*** -;;;### (autoloads nil "calc-undo" "calc/calc-undo.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "calc-undo" "calc/calc-undo.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from calc/calc-undo.el (autoload 'calc-undo "calc-undo" "\ @@ -2960,7 +2968,7 @@ See Info node `(calc)Defining Functions'. ;;;*** -;;;### (autoloads nil "calculator" "calculator.el" (21291 53104 0 +;;;### (autoloads nil "calculator" "calculator.el" (21231 31415 579137 ;;;;;; 0)) ;;; Generated autoloads from calculator.el @@ -2972,8 +2980,8 @@ See the documentation for `calculator-mode' for more information. ;;;*** -;;;### (autoloads nil "calendar" "calendar/calendar.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "calendar" "calendar/calendar.el" (21383 2343 +;;;;;; 498187 0)) ;;; Generated autoloads from calendar/calendar.el (autoload 'calendar "calendar" "\ @@ -3016,7 +3024,7 @@ This function is suitable for execution in an init file. ;;;*** -;;;### (autoloads nil "canlock" "gnus/canlock.el" (21291 53104 0 +;;;### (autoloads nil "canlock" "gnus/canlock.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from gnus/canlock.el @@ -3034,55 +3042,15 @@ it fails. ;;;*** -;;;### (autoloads nil "cap-words" "progmodes/cap-words.el" (21291 -;;;;;; 53104 0 0)) -;;; Generated autoloads from progmodes/cap-words.el - -(autoload 'capitalized-words-mode "cap-words" "\ -Toggle Capitalized Words mode. -With a prefix argument ARG, enable Capitalized Words mode if ARG -is positive, and disable it otherwise. If called from Lisp, -enable the mode if ARG is omitted or nil. - -Capitalized Words mode is a buffer-local minor mode. When -enabled, a word boundary occurs immediately before an uppercase -letter in a symbol. This is in addition to all the normal -boundaries given by the syntax and category tables. There is no -restriction to ASCII. - -E.g. the beginning of words in the following identifier are as marked: - - capitalizedWorDD - ^ ^ ^^ - -Note that these word boundaries only apply for word motion and -marking commands such as \\[forward-word]. This mode does not affect word -boundaries found by regexp matching (`\\>', `\\w' &c). - -This style of identifiers is common in environments like Java ones, -where underscores aren't trendy enough. Capitalization rules are -sometimes part of the language, e.g. Haskell, which may thus encourage -such a style. It is appropriate to add `capitalized-words-mode' to -the mode hook for programming language modes in which you encounter -variables like this, e.g. `java-mode-hook'. It's unlikely to cause -trouble if such identifiers aren't used. - -See also `glasses-mode' and `studlify-word'. -Obsoletes `c-forward-into-nomenclature'. - -\(fn &optional ARG)" t nil) - -;;;*** - -;;;### (autoloads nil "cc-compat" "progmodes/cc-compat.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "cc-compat" "progmodes/cc-compat.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from progmodes/cc-compat.el (put 'c-indent-level 'safe-local-variable 'integerp) ;;;*** -;;;### (autoloads nil "cc-engine" "progmodes/cc-engine.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "cc-engine" "progmodes/cc-engine.el" (21385 +;;;;;; 6339 454454 0)) ;;; Generated autoloads from progmodes/cc-engine.el (autoload 'c-guess-basic-syntax "cc-engine" "\ @@ -3092,8 +3060,8 @@ Return the syntactic context of the current line. ;;;*** -;;;### (autoloads nil "cc-guess" "progmodes/cc-guess.el" (21307 46976 -;;;;;; 0 0)) +;;;### (autoloads nil "cc-guess" "progmodes/cc-guess.el" (21308 46599 +;;;;;; 181916 0)) ;;; Generated autoloads from progmodes/cc-guess.el (defvar c-guess-guessed-offsets-alist nil "\ @@ -3191,8 +3159,8 @@ the absolute file name of the file if STYLE-NAME is nil. ;;;*** -;;;### (autoloads nil "cc-mode" "progmodes/cc-mode.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "cc-mode" "progmodes/cc-mode.el" (21269 46645 +;;;;;; 763684 0)) ;;; Generated autoloads from progmodes/cc-mode.el (autoload 'c-initialize-cc-mode "cc-mode" "\ @@ -3349,8 +3317,8 @@ Key bindings: ;;;*** -;;;### (autoloads nil "cc-styles" "progmodes/cc-styles.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "cc-styles" "progmodes/cc-styles.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from progmodes/cc-styles.el (autoload 'c-set-style "cc-styles" "\ @@ -3401,8 +3369,8 @@ and exists only for compatibility reasons. ;;;*** -;;;### (autoloads nil "cc-vars" "progmodes/cc-vars.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "cc-vars" "progmodes/cc-vars.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from progmodes/cc-vars.el (put 'c-basic-offset 'safe-local-variable 'integerp) (put 'c-backslash-column 'safe-local-variable 'integerp) @@ -3410,7 +3378,7 @@ and exists only for compatibility reasons. ;;;*** -;;;### (autoloads nil "ccl" "international/ccl.el" (21291 53104 0 +;;;### (autoloads nil "ccl" "international/ccl.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from international/ccl.el @@ -3650,7 +3618,7 @@ MAP-ID := integer \(fn NAME CCL-PROGRAM &optional DOC)" nil t) -(put 'define-ccl-program 'doc-string-elt '3) +(function-put 'define-ccl-program 'doc-string-elt '3) (autoload 'check-ccl-program "ccl" "\ Check validity of CCL-PROGRAM. @@ -3671,8 +3639,8 @@ See the documentation of `define-ccl-program' for the detail of CCL program. ;;;*** -;;;### (autoloads nil "cconv" "emacs-lisp/cconv.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "cconv" "emacs-lisp/cconv.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from emacs-lisp/cconv.el (autoload 'cconv-closure-convert "cconv" "\ @@ -3691,14 +3659,15 @@ Add the warnings that closure conversion would encounter. ;;;*** -;;;### (autoloads nil "cedet" "cedet/cedet.el" (21291 53104 0 0)) +;;;### (autoloads nil "cedet" "cedet/cedet.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from cedet/cedet.el (push (purecopy '(cedet 2 0)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "cfengine" "progmodes/cfengine.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "cfengine" "progmodes/cfengine.el" (21226 13501 +;;;;;; 706948 0)) ;;; Generated autoloads from progmodes/cfengine.el (push (purecopy '(cfengine 1 3)) package--builtin-versions) @@ -3728,15 +3697,15 @@ on the buffer contents ;;;*** -;;;### (autoloads nil "chart" "emacs-lisp/chart.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "chart" "emacs-lisp/chart.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from emacs-lisp/chart.el (push (purecopy '(chart 0 2)) package--builtin-versions) ;;;*** ;;;### (autoloads nil "check-declare" "emacs-lisp/check-declare.el" -;;;;;; (21291 53104 0 0)) +;;;;;; (21187 63826 213216 0)) ;;; Generated autoloads from emacs-lisp/check-declare.el (autoload 'check-declare-file "check-declare" "\ @@ -3753,8 +3722,8 @@ Returns non-nil if any false statements are found. ;;;*** -;;;### (autoloads nil "checkdoc" "emacs-lisp/checkdoc.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "checkdoc" "emacs-lisp/checkdoc.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from emacs-lisp/checkdoc.el (push (purecopy '(checkdoc 0 6 2)) package--builtin-versions) (put 'checkdoc-force-docstrings-flag 'safe-local-variable #'booleanp) @@ -3954,8 +3923,8 @@ checking of documentation strings. ;;;*** -;;;### (autoloads nil "china-util" "language/china-util.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "china-util" "language/china-util.el" (21197 +;;;;;; 43194 200483 0)) ;;; Generated autoloads from language/china-util.el (autoload 'decode-hz-region "china-util" "\ @@ -3992,7 +3961,8 @@ Encode the text in the current buffer to HZ. ;;;*** -;;;### (autoloads nil "chistory" "chistory.el" (21291 53104 0 0)) +;;;### (autoloads nil "chistory" "chistory.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from chistory.el (autoload 'repeat-matching-complex-command "chistory" "\ @@ -4031,8 +4001,8 @@ and runs the normal hook `command-history-hook'. ;;;*** -;;;### (autoloads nil "cl-indent" "emacs-lisp/cl-indent.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "cl-indent" "emacs-lisp/cl-indent.el" (21318 +;;;;;; 28582 821557 0)) ;;; Generated autoloads from emacs-lisp/cl-indent.el (autoload 'common-lisp-indent-function "cl-indent" "\ @@ -4106,12 +4076,17 @@ For example, the function `case' has an indent property of them. The first list element has an offset of 2, all the rest have an offset of 2+1=3. +If the current mode is actually `emacs-lisp-mode', look for a +`common-lisp-indent-function-for-elisp' property before looking +at `common-lisp-indent-function' and, if set, use its value +instead. + \(fn INDENT-POINT STATE)" nil nil) ;;;*** -;;;### (autoloads nil "cl-lib" "emacs-lisp/cl-lib.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "cl-lib" "emacs-lisp/cl-lib.el" (21372 32036 +;;;;;; 731951 0)) ;;; Generated autoloads from emacs-lisp/cl-lib.el (push (purecopy '(cl-lib 1 0)) package--builtin-versions) @@ -4141,8 +4116,8 @@ a future Emacs interpreter will be able to use it.") ;;;*** -;;;### (autoloads nil "cmacexp" "progmodes/cmacexp.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "cmacexp" "progmodes/cmacexp.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from progmodes/cmacexp.el (autoload 'c-macro-expand "cmacexp" "\ @@ -4162,7 +4137,8 @@ For use inside Lisp programs, see also `c-macro-expansion'. ;;;*** -;;;### (autoloads nil "cmuscheme" "cmuscheme.el" (21291 53104 0 0)) +;;;### (autoloads nil "cmuscheme" "cmuscheme.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from cmuscheme.el (autoload 'run-scheme "cmuscheme" "\ @@ -4182,7 +4158,7 @@ is run). ;;;*** -;;;### (autoloads nil "color" "color.el" (21291 53104 0 0)) +;;;### (autoloads nil "color" "color.el" (21187 63826 213216 0)) ;;; Generated autoloads from color.el (autoload 'color-name-to-rgb "color" "\ @@ -4201,7 +4177,7 @@ If FRAME cannot display COLOR, return nil. ;;;*** -;;;### (autoloads nil "comint" "comint.el" (21341 23900 0 0)) +;;;### (autoloads nil "comint" "comint.el" (21339 34726 39547 0)) ;;; Generated autoloads from comint.el (defvar comint-output-filter-functions '(ansi-color-process-output comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt) "\ @@ -4263,6 +4239,8 @@ See `make-comint' and `comint-exec'. \(fn PROGRAM)" t nil) +(function-put 'comint-run 'interactive-only 'make-comint) + (defvar comint-file-name-prefix (purecopy "") "\ Prefix prepended to absolute file names taken from process input. This is used by Comint's and shell's completion functions, and by shell's @@ -4300,8 +4278,8 @@ REGEXP-GROUP is the regular expression group in REGEXP to use. ;;;*** -;;;### (autoloads nil "compare-w" "vc/compare-w.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "compare-w" "vc/compare-w.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from vc/compare-w.el (autoload 'compare-windows "compare-w" "\ @@ -4334,8 +4312,8 @@ on third call it again advances points to the next difference and so on. ;;;*** -;;;### (autoloads nil "compile" "progmodes/compile.el" (21356 47422 -;;;;;; 369946 0)) +;;;### (autoloads nil "compile" "progmodes/compile.el" (21383 2343 +;;;;;; 498187 0)) ;;; Generated autoloads from progmodes/compile.el (defvar compilation-mode-hook nil "\ @@ -4516,7 +4494,7 @@ This is the value of `next-error-function' in Compilation buffers. ;;;*** -;;;### (autoloads nil "completion" "completion.el" (21291 53104 0 +;;;### (autoloads nil "completion" "completion.el" (21240 46395 727291 ;;;;;; 0)) ;;; Generated autoloads from completion.el @@ -4539,8 +4517,8 @@ if ARG is omitted or nil. ;;;*** -;;;### (autoloads nil "conf-mode" "textmodes/conf-mode.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "conf-mode" "textmodes/conf-mode.el" (21383 +;;;;;; 2343 498187 0)) ;;; Generated autoloads from textmodes/conf-mode.el (autoload 'conf-mode "conf-mode" "\ @@ -4695,7 +4673,7 @@ For details see `conf-mode'. Example: ;;;*** -;;;### (autoloads nil "cookie1" "play/cookie1.el" (21291 53104 0 +;;;### (autoloads nil "cookie1" "play/cookie1.el" (21245 64312 799897 ;;;;;; 0)) ;;; Generated autoloads from play/cookie1.el @@ -4724,8 +4702,8 @@ and subsequent calls on the same file won't go to disk. ;;;*** -;;;### (autoloads nil "copyright" "emacs-lisp/copyright.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "copyright" "emacs-lisp/copyright.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from emacs-lisp/copyright.el (put 'copyright-at-end-flag 'safe-local-variable 'booleanp) (put 'copyright-names-regexp 'safe-local-variable 'stringp) @@ -4763,8 +4741,8 @@ If FIX is non-nil, run `copyright-fix-years' instead. ;;;*** -;;;### (autoloads nil "cperl-mode" "progmodes/cperl-mode.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "cperl-mode" "progmodes/cperl-mode.el" (21207 +;;;;;; 49087 974317 0)) ;;; Generated autoloads from progmodes/cperl-mode.el (put 'cperl-indent-level 'safe-local-variable 'integerp) (put 'cperl-brace-offset 'safe-local-variable 'integerp) @@ -4962,7 +4940,8 @@ Run a `perldoc' on the word around point. ;;;*** -;;;### (autoloads nil "cpp" "progmodes/cpp.el" (21291 53104 0 0)) +;;;### (autoloads nil "cpp" "progmodes/cpp.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from progmodes/cpp.el (autoload 'cpp-highlight-buffer "cpp" "\ @@ -4980,7 +4959,7 @@ Edit display information for cpp conditionals. ;;;*** -;;;### (autoloads nil "crisp" "emulation/crisp.el" (21291 53104 0 +;;;### (autoloads nil "crisp" "emulation/crisp.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from emulation/crisp.el @@ -5006,7 +4985,8 @@ if ARG is omitted or nil. ;;;*** -;;;### (autoloads nil "crm" "emacs-lisp/crm.el" (21291 53104 0 0)) +;;;### (autoloads nil "crm" "emacs-lisp/crm.el" (21263 7861 493097 +;;;;;; 0)) ;;; Generated autoloads from emacs-lisp/crm.el (autoload 'completing-read-multiple "crm" "\ @@ -5032,8 +5012,8 @@ with empty strings removed. ;;;*** -;;;### (autoloads nil "css-mode" "textmodes/css-mode.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "css-mode" "textmodes/css-mode.el" (21285 31272 +;;;;;; 331063 0)) ;;; Generated autoloads from textmodes/css-mode.el (autoload 'css-mode "css-mode" "\ @@ -5043,8 +5023,8 @@ Major mode to edit Cascading Style Sheets. ;;;*** -;;;### (autoloads nil "cua-base" "emulation/cua-base.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "cua-base" "emulation/cua-base.el" (21319 49445 +;;;;;; 508378 0)) ;;; Generated autoloads from emulation/cua-base.el (defvar cua-mode nil "\ @@ -5089,8 +5069,8 @@ Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings. ;;;*** -;;;### (autoloads nil "cua-rect" "emulation/cua-rect.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "cua-rect" "emulation/cua-rect.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from emulation/cua-rect.el (autoload 'cua-rectangle-mark-mode "cua-rect" "\ @@ -5101,7 +5081,8 @@ Activates the region if needed. Only lasts until the region is deactivated. ;;;*** -;;;### (autoloads nil "cus-edit" "cus-edit.el" (21291 53104 0 0)) +;;;### (autoloads nil "cus-edit" "cus-edit.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from cus-edit.el (defvar custom-browse-sort-alphabetically nil "\ @@ -5413,7 +5394,8 @@ The format is suitable for use with `easy-menu-define'. ;;;*** -;;;### (autoloads nil "cus-theme" "cus-theme.el" (21291 53104 0 0)) +;;;### (autoloads nil "cus-theme" "cus-theme.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from cus-theme.el (autoload 'customize-create-theme "cus-theme" "\ @@ -5446,8 +5428,8 @@ omitted, a buffer named *Custom Themes* is used. ;;;*** -;;;### (autoloads nil "cvs-status" "vc/cvs-status.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "cvs-status" "vc/cvs-status.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from vc/cvs-status.el (autoload 'cvs-status-mode "cvs-status" "\ @@ -5457,7 +5439,7 @@ Mode used for cvs status output. ;;;*** -;;;### (autoloads nil "cwarn" "progmodes/cwarn.el" (21291 53104 0 +;;;### (autoloads nil "cwarn" "progmodes/cwarn.el" (21383 2343 498187 ;;;;;; 0)) ;;; Generated autoloads from progmodes/cwarn.el (push (purecopy '(cwarn 1 3 1)) package--builtin-versions) @@ -5502,8 +5484,8 @@ See `cwarn-mode' for more information on Cwarn mode. ;;;*** -;;;### (autoloads nil "cyril-util" "language/cyril-util.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "cyril-util" "language/cyril-util.el" (21193 +;;;;;; 16180 875828 0)) ;;; Generated autoloads from language/cyril-util.el (autoload 'cyrillic-encode-koi8-r-char "cyril-util" "\ @@ -5531,7 +5513,8 @@ If the argument is nil, we return the display table to its standard state. ;;;*** -;;;### (autoloads nil "dabbrev" "dabbrev.el" (21291 53104 0 0)) +;;;### (autoloads nil "dabbrev" "dabbrev.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from dabbrev.el (put 'dabbrev-case-fold-search 'risky-local-variable t) (put 'dabbrev-case-replace 'risky-local-variable t) @@ -5577,8 +5560,8 @@ See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion]. ;;;*** -;;;### (autoloads nil "data-debug" "cedet/data-debug.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "data-debug" "cedet/data-debug.el" (21197 43194 +;;;;;; 200483 0)) ;;; Generated autoloads from cedet/data-debug.el (autoload 'data-debug-new-buffer "data-debug" "\ @@ -5588,7 +5571,7 @@ Create a new data-debug buffer with NAME. ;;;*** -;;;### (autoloads nil "dbus" "net/dbus.el" (21366 48109 32392 0)) +;;;### (autoloads nil "dbus" "net/dbus.el" (21379 5287 607434 0)) ;;; Generated autoloads from net/dbus.el (autoload 'dbus-handle-event "dbus" "\ @@ -5601,8 +5584,8 @@ If the HANDLER returns a `dbus-error', it is propagated as return message. ;;;*** -;;;### (autoloads nil "dcl-mode" "progmodes/dcl-mode.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "dcl-mode" "progmodes/dcl-mode.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from progmodes/dcl-mode.el (autoload 'dcl-mode "dcl-mode" "\ @@ -5728,8 +5711,8 @@ There is some minimal font-lock support (see vars ;;;*** -;;;### (autoloads nil "debug" "emacs-lisp/debug.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "debug" "emacs-lisp/debug.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from emacs-lisp/debug.el (setq debugger 'debug) @@ -5772,8 +5755,8 @@ To specify a nil argument interactively, exit with an empty minibuffer. ;;;*** -;;;### (autoloads nil "decipher" "play/decipher.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "decipher" "play/decipher.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from play/decipher.el (autoload 'decipher "decipher" "\ @@ -5801,7 +5784,8 @@ The most useful commands are: ;;;*** -;;;### (autoloads nil "delim-col" "delim-col.el" (21291 53104 0 0)) +;;;### (autoloads nil "delim-col" "delim-col.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from delim-col.el (push (purecopy '(delim-col 2 1)) package--builtin-versions) @@ -5826,7 +5810,7 @@ START and END delimits the corners of text rectangle. ;;;*** -;;;### (autoloads nil "delsel" "delsel.el" (21291 53104 0 0)) +;;;### (autoloads nil "delsel" "delsel.el" (21251 41787 268999 0)) ;;; Generated autoloads from delsel.el (defalias 'pending-delete-mode 'delete-selection-mode) @@ -5854,8 +5838,8 @@ point regardless of any selection. ;;;*** -;;;### (autoloads nil "derived" "emacs-lisp/derived.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "derived" "emacs-lisp/derived.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from emacs-lisp/derived.el (autoload 'define-derived-mode "derived" "\ @@ -5909,7 +5893,7 @@ See Info node `(elisp)Derived Modes' for more details. \(fn CHILD PARENT NAME &optional DOCSTRING &rest BODY)" nil t) -(put 'define-derived-mode 'doc-string-elt '4) +(function-put 'define-derived-mode 'doc-string-elt '4) (autoload 'derived-mode-init-mode-variables "derived" "\ Initialize variables for a new MODE. @@ -5921,7 +5905,7 @@ the first time the mode is used. ;;;*** -;;;### (autoloads nil "descr-text" "descr-text.el" (21291 53104 0 +;;;### (autoloads nil "descr-text" "descr-text.el" (21240 46395 727291 ;;;;;; 0)) ;;; Generated autoloads from descr-text.el @@ -5956,7 +5940,7 @@ relevant to POS. ;;;*** -;;;### (autoloads nil "desktop" "desktop.el" (21341 23900 0 0)) +;;;### (autoloads nil "desktop" "desktop.el" (21346 7974 405729 0)) ;;; Generated autoloads from desktop.el (defvar desktop-save-mode nil "\ @@ -6160,8 +6144,8 @@ Revert to the last loaded desktop. ;;;*** -;;;### (autoloads nil "deuglify" "gnus/deuglify.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "deuglify" "gnus/deuglify.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from gnus/deuglify.el (autoload 'gnus-article-outlook-unwrap-lines "deuglify" "\ @@ -6193,8 +6177,8 @@ Deuglify broken Outlook (Express) articles and redisplay. ;;;*** -;;;### (autoloads nil "diary-lib" "calendar/diary-lib.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "diary-lib" "calendar/diary-lib.el" (21350 +;;;;;; 58112 380040 0)) ;;; Generated autoloads from calendar/diary-lib.el (autoload 'diary "diary-lib" "\ @@ -6236,7 +6220,7 @@ Major mode for editing the diary file. ;;;*** -;;;### (autoloads nil "diff" "vc/diff.el" (21291 53104 0 0)) +;;;### (autoloads nil "diff" "vc/diff.el" (21240 46395 727291 0)) ;;; Generated autoloads from vc/diff.el (defvar diff-switches (purecopy "-c") "\ @@ -6284,8 +6268,8 @@ This requires the external program `diff' to be in your `exec-path'. ;;;*** -;;;### (autoloads nil "diff-mode" "vc/diff-mode.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "diff-mode" "vc/diff-mode.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from vc/diff-mode.el (autoload 'diff-mode "diff-mode" "\ @@ -6317,7 +6301,7 @@ the mode if ARG is omitted or nil. ;;;*** -;;;### (autoloads nil "dig" "net/dig.el" (21291 53104 0 0)) +;;;### (autoloads nil "dig" "net/dig.el" (21187 63826 213216 0)) ;;; Generated autoloads from net/dig.el (autoload 'dig "dig" "\ @@ -6328,7 +6312,7 @@ Optional arguments are passed to `dig-invoke'. ;;;*** -;;;### (autoloads nil "dired" "dired.el" (21356 47422 369946 0)) +;;;### (autoloads nil "dired" "dired.el" (21348 49701 793915 0)) ;;; Generated autoloads from dired.el (defvar dired-listing-switches (purecopy "-al") "\ @@ -6404,7 +6388,7 @@ Type \\[dired-mark] to Mark a file or subdirectory for later commands. to see why something went wrong. Type \\[dired-unmark] to Unmark a file or all files of an inserted subdirectory. Type \\[dired-unmark-backward] to back up one line and unmark or unflag. -Type \\[dired-do-flagged-delete] to delete (eXecute) the files flagged `D'. +Type \\[dired-do-flagged-delete] to delete (eXpunge) the files flagged `D'. Type \\[dired-find-file] to Find the current line's file (or dired it in another buffer, if it is a directory). Type \\[dired-find-file-other-window] to find file or Dired directory in Other window. @@ -6448,7 +6432,8 @@ Keybindings: ;;;*** -;;;### (autoloads nil "dirtrack" "dirtrack.el" (21291 53104 0 0)) +;;;### (autoloads nil "dirtrack" "dirtrack.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from dirtrack.el (autoload 'dirtrack-mode "dirtrack" "\ @@ -6478,8 +6463,8 @@ from `default-directory'. ;;;*** -;;;### (autoloads nil "disass" "emacs-lisp/disass.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "disass" "emacs-lisp/disass.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from emacs-lisp/disass.el (autoload 'disassemble "disass" "\ @@ -6493,7 +6478,7 @@ redefine OBJECT if it is a symbol. ;;;*** -;;;### (autoloads nil "disp-table" "disp-table.el" (21291 53104 0 +;;;### (autoloads nil "disp-table" "disp-table.el" (21240 46395 727291 ;;;;;; 0)) ;;; Generated autoloads from disp-table.el @@ -6615,8 +6600,8 @@ in `.emacs'. ;;;*** -;;;### (autoloads nil "dissociate" "play/dissociate.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "dissociate" "play/dissociate.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from play/dissociate.el (autoload 'dissociated-press "dissociate" "\ @@ -6632,7 +6617,7 @@ Default is 2. ;;;*** -;;;### (autoloads nil "dnd" "dnd.el" (21291 53104 0 0)) +;;;### (autoloads nil "dnd" "dnd.el" (21240 46395 727291 0)) ;;; Generated autoloads from dnd.el (defvar dnd-protocol-alist `((,(purecopy "^file:///") . dnd-open-local-file) (,(purecopy "^file://") . dnd-open-file) (,(purecopy "^file:") . dnd-open-local-file) (,(purecopy "^\\(https?\\|ftp\\|file\\|nfs\\)://") . dnd-open-file)) "\ @@ -6652,8 +6637,8 @@ if some action was made, or nil if the URL is ignored.") ;;;*** -;;;### (autoloads nil "dns-mode" "textmodes/dns-mode.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "dns-mode" "textmodes/dns-mode.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from textmodes/dns-mode.el (autoload 'dns-mode "dns-mode" "\ @@ -6676,7 +6661,8 @@ Locate SOA record and increment the serial field. ;;;*** -;;;### (autoloads nil "doc-view" "doc-view.el" (21312 16713 0 0)) +;;;### (autoloads nil "doc-view" "doc-view.el" (21364 37926 837230 +;;;;;; 0)) ;;; Generated autoloads from doc-view.el (autoload 'doc-view-mode-p "doc-view" "\ @@ -6722,7 +6708,8 @@ See the command `doc-view-mode' for more information on this mode. ;;;*** -;;;### (autoloads nil "doctor" "play/doctor.el" (21291 53104 0 0)) +;;;### (autoloads nil "doctor" "play/doctor.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from play/doctor.el (autoload 'doctor "doctor" "\ @@ -6732,7 +6719,7 @@ Switch to *doctor* buffer and start giving psychotherapy. ;;;*** -;;;### (autoloads nil "double" "double.el" (21291 53104 0 0)) +;;;### (autoloads nil "double" "double.el" (21187 63826 213216 0)) ;;; Generated autoloads from double.el (autoload 'double-mode "double" "\ @@ -6748,7 +6735,8 @@ strings when pressed twice. See `double-map' for details. ;;;*** -;;;### (autoloads nil "dunnet" "play/dunnet.el" (21291 53104 0 0)) +;;;### (autoloads nil "dunnet" "play/dunnet.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from play/dunnet.el (push (purecopy '(dunnet 2 1)) package--builtin-versions) @@ -6759,8 +6747,8 @@ Switch to *dungeon* buffer and start game. ;;;*** -;;;### (autoloads nil "easy-mmode" "emacs-lisp/easy-mmode.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "easy-mmode" "emacs-lisp/easy-mmode.el" (21259 +;;;;;; 10807 217062 0)) ;;; Generated autoloads from emacs-lisp/easy-mmode.el (defalias 'easy-mmode-define-minor-mode 'define-minor-mode) @@ -6832,7 +6820,7 @@ For example, you could write \(fn MODE DOC &optional INIT-VALUE LIGHTER KEYMAP &rest BODY)" nil t) -(put 'define-minor-mode 'doc-string-elt '2) +(function-put 'define-minor-mode 'doc-string-elt '2) (defalias 'easy-mmode-define-global-mode 'define-globalized-minor-mode) @@ -6863,7 +6851,7 @@ on if the hook has explicitly disabled it. \(fn GLOBAL-MODE MODE TURN-ON &rest KEYS)" nil t) -(put 'define-globalized-minor-mode 'doc-string-elt '2) +(function-put 'define-globalized-minor-mode 'doc-string-elt '2) (autoload 'easy-mmode-define-keymap "easy-mmode" "\ Return a keymap built from bindings BS. @@ -6899,8 +6887,8 @@ CSS contains a list of syntax specifications of the form (CHAR . SYNTAX). ;;;*** -;;;### (autoloads nil "easymenu" "emacs-lisp/easymenu.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "easymenu" "emacs-lisp/easymenu.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from emacs-lisp/easymenu.el (autoload 'easy-menu-define "easymenu" "\ @@ -7002,7 +6990,7 @@ MENU. This is a submenu. \(fn SYMBOL MAPS DOC MENU)" nil t) -(put 'easy-menu-define 'lisp-indent-function 'defun) +(function-put 'easy-menu-define 'lisp-indent-function 'defun) (autoload 'easy-menu-do-define "easymenu" "\ @@ -7038,8 +7026,8 @@ To implement dynamic menus, either call this from ;;;*** -;;;### (autoloads nil "ebnf2ps" "progmodes/ebnf2ps.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "ebnf2ps" "progmodes/ebnf2ps.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from progmodes/ebnf2ps.el (push (purecopy '(ebnf2ps 4 4)) package--builtin-versions) @@ -7304,8 +7292,8 @@ See `ebnf-style-database' documentation. ;;;*** -;;;### (autoloads nil "ebrowse" "progmodes/ebrowse.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "ebrowse" "progmodes/ebrowse.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from progmodes/ebrowse.el (autoload 'ebrowse-tree-mode "ebrowse" "\ @@ -7453,7 +7441,7 @@ Display statistics for a class tree. ;;;*** -;;;### (autoloads nil "ebuff-menu" "ebuff-menu.el" (21291 53104 0 +;;;### (autoloads nil "ebuff-menu" "ebuff-menu.el" (21240 46395 727291 ;;;;;; 0)) ;;; Generated autoloads from ebuff-menu.el @@ -7486,7 +7474,8 @@ Run hooks in `electric-buffer-menu-mode-hook' on entry. ;;;*** -;;;### (autoloads nil "echistory" "echistory.el" (21291 53104 0 0)) +;;;### (autoloads nil "echistory" "echistory.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from echistory.el (autoload 'Electric-command-history-redo-expression "echistory" "\ @@ -7497,8 +7486,8 @@ With prefix arg NOCONFIRM, execute current line as-is without editing. ;;;*** -;;;### (autoloads nil "ecomplete" "gnus/ecomplete.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "ecomplete" "gnus/ecomplete.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from gnus/ecomplete.el (autoload 'ecomplete-setup "ecomplete" "\ @@ -7508,7 +7497,7 @@ With prefix arg NOCONFIRM, execute current line as-is without editing. ;;;*** -;;;### (autoloads nil "ede" "cedet/ede.el" (21346 62196 0 0)) +;;;### (autoloads nil "ede" "cedet/ede.el" (21350 58112 380040 0)) ;;; Generated autoloads from cedet/ede.el (push (purecopy '(ede 1 2)) package--builtin-versions) @@ -7534,8 +7523,8 @@ an EDE controlled project. ;;;*** -;;;### (autoloads nil "edebug" "emacs-lisp/edebug.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "edebug" "emacs-lisp/edebug.el" (21261 4402 +;;;;;; 232258 508000)) ;;; Generated autoloads from emacs-lisp/edebug.el (defvar edebug-all-defs nil "\ @@ -7599,7 +7588,7 @@ Toggle edebugging of all forms. ;;;*** -;;;### (autoloads nil "ediff" "vc/ediff.el" (21307 46976 0 0)) +;;;### (autoloads nil "ediff" "vc/ediff.el" (21308 46599 181916 0)) ;;; Generated autoloads from vc/ediff.el (push (purecopy '(ediff 2 81 4)) package--builtin-versions) @@ -7871,8 +7860,8 @@ With optional NODE, goes to that node. ;;;*** -;;;### (autoloads nil "ediff-help" "vc/ediff-help.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "ediff-help" "vc/ediff-help.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from vc/ediff-help.el (autoload 'ediff-customize "ediff-help" "\ @@ -7882,8 +7871,8 @@ With optional NODE, goes to that node. ;;;*** -;;;### (autoloads nil "ediff-mult" "vc/ediff-mult.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "ediff-mult" "vc/ediff-mult.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from vc/ediff-mult.el (autoload 'ediff-show-registry "ediff-mult" "\ @@ -7895,8 +7884,8 @@ Display Ediff's registry. ;;;*** -;;;### (autoloads nil "ediff-util" "vc/ediff-util.el" (21349 10841 -;;;;;; 0 0)) +;;;### (autoloads nil "ediff-util" "vc/ediff-util.el" (21350 58112 +;;;;;; 380040 0)) ;;; Generated autoloads from vc/ediff-util.el (autoload 'ediff-toggle-multiframe "ediff-util" "\ @@ -7915,7 +7904,8 @@ To change the default, set the variable `ediff-use-toolbar-p', which see. ;;;*** -;;;### (autoloads nil "edmacro" "edmacro.el" (21291 53104 0 0)) +;;;### (autoloads nil "edmacro" "edmacro.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from edmacro.el (push (purecopy '(edmacro 2 1)) package--builtin-versions) @@ -7964,7 +7954,8 @@ or nil, use a compact 80-column format. ;;;*** -;;;### (autoloads nil "edt" "emulation/edt.el" (21291 53104 0 0)) +;;;### (autoloads nil "edt" "emulation/edt.el" (21260 31670 94248 +;;;;;; 0)) ;;; Generated autoloads from emulation/edt.el (autoload 'edt-set-scroll-margins "edt" "\ @@ -7981,7 +7972,7 @@ Turn on EDT Emulation. ;;;*** -;;;### (autoloads nil "ehelp" "ehelp.el" (21291 53104 0 0)) +;;;### (autoloads nil "ehelp" "ehelp.el" (21240 46395 727291 0)) ;;; Generated autoloads from ehelp.el (autoload 'with-electric-help "ehelp" "\ @@ -8017,15 +8008,15 @@ BUFFER is put back into its original major mode. ;;;*** -;;;### (autoloads nil "eieio" "emacs-lisp/eieio.el" (21364 41525 -;;;;;; 730218 0)) +;;;### (autoloads nil "eieio" "emacs-lisp/eieio.el" (21379 5529 990138 +;;;;;; 255000)) ;;; Generated autoloads from emacs-lisp/eieio.el (push (purecopy '(eieio 1 4)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "eieio-core" "emacs-lisp/eieio-core.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "eieio-core" "emacs-lisp/eieio-core.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from emacs-lisp/eieio-core.el (push (purecopy '(eieio-core 1 4)) package--builtin-versions) @@ -8041,8 +8032,8 @@ It creates an autoload function for CNAME's constructor. ;;;*** -;;;### (autoloads nil "eldoc" "emacs-lisp/eldoc.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "eldoc" "emacs-lisp/eldoc.el" (21305 16557 +;;;;;; 836987 0)) ;;; Generated autoloads from emacs-lisp/eldoc.el (defvar eldoc-minor-mode-string (purecopy " ElDoc") "\ @@ -8067,8 +8058,8 @@ expression point is on. (define-obsolete-function-alias 'turn-on-eldoc-mode 'eldoc-mode "24.4") -(defvar eldoc-documentation-function nil "\ -If non-nil, function to call to return doc string. +(defvar eldoc-documentation-function #'eldoc-documentation-function-default "\ +Function to call to return doc string. The function of no args should return a one-line string for displaying doc about a function etc. appropriate to the context around point. It should return nil if there's no doc appropriate for the context. @@ -8085,7 +8076,8 @@ Emacs Lisp mode) that support ElDoc.") ;;;*** -;;;### (autoloads nil "elec-pair" "elec-pair.el" (21341 23900 0 0)) +;;;### (autoloads nil "elec-pair" "elec-pair.el" (21327 43559 923043 +;;;;;; 0)) ;;; Generated autoloads from elec-pair.el (defvar electric-pair-text-pairs '((34 . 34)) "\ @@ -8120,7 +8112,7 @@ closing parenthesis. (Likewise for brackets, etc.). ;;;*** -;;;### (autoloads nil "elide-head" "elide-head.el" (21291 53104 0 +;;;### (autoloads nil "elide-head" "elide-head.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from elide-head.el @@ -8136,8 +8128,8 @@ This is suitable as an entry on `find-file-hook' or appropriate mode hooks. ;;;*** -;;;### (autoloads nil "elint" "emacs-lisp/elint.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "elint" "emacs-lisp/elint.el" (21195 23530 +;;;;;; 495420 0)) ;;; Generated autoloads from emacs-lisp/elint.el (autoload 'elint-file "elint" "\ @@ -8172,7 +8164,8 @@ optional prefix argument REINIT is non-nil. ;;;*** -;;;### (autoloads nil "elp" "emacs-lisp/elp.el" (21291 53104 0 0)) +;;;### (autoloads nil "elp" "emacs-lisp/elp.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from emacs-lisp/elp.el (autoload 'elp-instrument-function "elp" "\ @@ -8206,7 +8199,7 @@ displayed. ;;;*** -;;;### (autoloads nil "emacs-lock" "emacs-lock.el" (21291 53104 0 +;;;### (autoloads nil "emacs-lock" "emacs-lock.el" (21240 46395 727291 ;;;;;; 0)) ;;; Generated autoloads from emacs-lock.el @@ -8234,8 +8227,8 @@ Other values are interpreted as usual. ;;;*** -;;;### (autoloads nil "emacsbug" "mail/emacsbug.el" (21295 7741 0 -;;;;;; 0)) +;;;### (autoloads nil "emacsbug" "mail/emacsbug.el" (21302 89 140834 +;;;;;; 615000)) ;;; Generated autoloads from mail/emacsbug.el (autoload 'report-emacs-bug "emacsbug" "\ @@ -8246,7 +8239,7 @@ Prompts for bug subject. Leaves you in a mail buffer. ;;;*** -;;;### (autoloads nil "emerge" "vc/emerge.el" (21363 20664 637808 +;;;### (autoloads nil "emerge" "vc/emerge.el" (21364 37926 837230 ;;;;;; 0)) ;;; Generated autoloads from vc/emerge.el @@ -8307,8 +8300,8 @@ Emerge two RCS revisions of a file, with another revision as ancestor. ;;;*** -;;;### (autoloads nil "enriched" "textmodes/enriched.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "enriched" "textmodes/enriched.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from textmodes/enriched.el (autoload 'enriched-mode "enriched" "\ @@ -8343,7 +8336,7 @@ Commands: ;;;*** -;;;### (autoloads nil "epa" "epa.el" (21291 53104 0 0)) +;;;### (autoloads nil "epa" "epa.el" (21294 46247 414129 0)) ;;; Generated autoloads from epa.el (autoload 'epa-list-keys "epa" "\ @@ -8420,6 +8413,8 @@ See the reason described in the `epa-decrypt-region' documentation. \(fn START END)" t nil) +(function-put 'epa-decrypt-armor-in-region 'interactive-only 't) + (autoload 'epa-verify-region "epa" "\ Verify the current region between START and END. @@ -8440,6 +8435,8 @@ For example: \(fn START END)" t nil) +(function-put 'epa-verify-region 'interactive-only 't) + (autoload 'epa-verify-cleartext-in-region "epa" "\ Verify OpenPGP cleartext signed messages in the current region between START and END. @@ -8449,6 +8446,8 @@ See the reason described in the `epa-verify-region' documentation. \(fn START END)" t nil) +(function-put 'epa-verify-cleartext-in-region 'interactive-only 't) + (autoload 'epa-sign-region "epa" "\ Sign the current region between START and END by SIGNERS keys selected. @@ -8468,6 +8467,8 @@ For example: \(fn START END SIGNERS MODE)" t nil) +(function-put 'epa-sign-region 'interactive-only 't) + (autoload 'epa-encrypt-region "epa" "\ Encrypt the current region between START and END for RECIPIENTS. @@ -8488,6 +8489,8 @@ For example: \(fn START END RECIPIENTS SIGN SIGNERS)" t nil) +(function-put 'epa-encrypt-region 'interactive-only 't) + (autoload 'epa-delete-keys "epa" "\ Delete selected KEYS. @@ -8521,7 +8524,8 @@ Insert selected KEYS after the point. ;;;*** -;;;### (autoloads nil "epa-dired" "epa-dired.el" (21291 53104 0 0)) +;;;### (autoloads nil "epa-dired" "epa-dired.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from epa-dired.el (autoload 'epa-dired-do-decrypt "epa-dired" "\ @@ -8546,7 +8550,8 @@ Encrypt marked files. ;;;*** -;;;### (autoloads nil "epa-file" "epa-file.el" (21291 53104 0 0)) +;;;### (autoloads nil "epa-file" "epa-file.el" (21205 7349 58947 +;;;;;; 0)) ;;; Generated autoloads from epa-file.el (autoload 'epa-file-handler "epa-file" "\ @@ -8566,7 +8571,8 @@ Encrypt marked files. ;;;*** -;;;### (autoloads nil "epa-mail" "epa-mail.el" (21291 53104 0 0)) +;;;### (autoloads nil "epa-mail" "epa-mail.el" (21294 46247 414129 +;;;;;; 0)) ;;; Generated autoloads from epa-mail.el (autoload 'epa-mail-mode "epa-mail" "\ @@ -8581,26 +8587,26 @@ if ARG is omitted or nil. Decrypt OpenPGP armors in the current buffer. The buffer is expected to contain a mail message. -Don't use this command in Lisp programs! - \(fn)" t nil) +(function-put 'epa-mail-decrypt 'interactive-only 't) + (autoload 'epa-mail-verify "epa-mail" "\ Verify OpenPGP cleartext signed messages in the current buffer. The buffer is expected to contain a mail message. -Don't use this command in Lisp programs! - \(fn)" t nil) +(function-put 'epa-mail-verify 'interactive-only 't) + (autoload 'epa-mail-sign "epa-mail" "\ Sign the current buffer. The buffer is expected to contain a mail message. -Don't use this command in Lisp programs! - \(fn START END SIGNERS MODE)" t nil) +(function-put 'epa-mail-sign 'interactive-only 't) + (autoload 'epa-mail-encrypt "epa-mail" "\ Encrypt the outgoing mail message in the current buffer. Takes the recipients from the text in the header in the buffer @@ -8620,10 +8626,10 @@ SIGNERS is a list of keys to sign the message with. Import keys in the OpenPGP armor format in the current buffer. The buffer is expected to contain a mail message. -Don't use this command in Lisp programs! - \(fn)" t nil) +(function-put 'epa-mail-import-keys 'interactive-only 't) + (defvar epa-global-mail-mode nil "\ Non-nil if Epa-Global-Mail mode is enabled. See the command `epa-global-mail-mode' for a description of this minor mode. @@ -8643,7 +8649,7 @@ if ARG is omitted or nil. ;;;*** -;;;### (autoloads nil "epg" "epg.el" (21291 53104 0 0)) +;;;### (autoloads nil "epg" "epg.el" (21364 37926 837230 0)) ;;; Generated autoloads from epg.el (push (purecopy '(epg 1 0 0)) package--builtin-versions) @@ -8654,7 +8660,7 @@ Return a context object. ;;;*** -;;;### (autoloads nil "epg-config" "epg-config.el" (21291 53104 0 +;;;### (autoloads nil "epg-config" "epg-config.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from epg-config.el @@ -8675,7 +8681,7 @@ Look at CONFIG and try to expand GROUP. ;;;*** -;;;### (autoloads nil "erc" "erc/erc.el" (21291 53104 0 0)) +;;;### (autoloads nil "erc" "erc/erc.el" (21311 55332 986627 0)) ;;; Generated autoloads from erc/erc.el (push (purecopy '(erc 5 3)) package--builtin-versions) @@ -8724,35 +8730,36 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL. ;;;*** -;;;### (autoloads nil "erc-autoaway" "erc/erc-autoaway.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "erc-autoaway" "erc/erc-autoaway.el" (21240 +;;;;;; 46395 727291 0)) ;;; Generated autoloads from erc/erc-autoaway.el (autoload 'erc-autoaway-mode "erc-autoaway") ;;;*** -;;;### (autoloads nil "erc-button" "erc/erc-button.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "erc-button" "erc/erc-button.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from erc/erc-button.el (autoload 'erc-button-mode "erc-button" nil t) ;;;*** -;;;### (autoloads nil "erc-capab" "erc/erc-capab.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "erc-capab" "erc/erc-capab.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from erc/erc-capab.el (autoload 'erc-capab-identify-mode "erc-capab" nil t) ;;;*** -;;;### (autoloads nil "erc-compat" "erc/erc-compat.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "erc-compat" "erc/erc-compat.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from erc/erc-compat.el (autoload 'erc-define-minor-mode "erc-compat") ;;;*** -;;;### (autoloads nil "erc-dcc" "erc/erc-dcc.el" (21291 53104 0 0)) +;;;### (autoloads nil "erc-dcc" "erc/erc-dcc.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from erc/erc-dcc.el (autoload 'erc-dcc-mode "erc-dcc") @@ -8782,14 +8789,14 @@ that subcommand. ;;;*** ;;;### (autoloads nil "erc-desktop-notifications" "erc/erc-desktop-notifications.el" -;;;;;; (21291 53104 0 0)) +;;;;;; (21187 63826 213216 0)) ;;; Generated autoloads from erc/erc-desktop-notifications.el (autoload 'erc-notifications-mode "erc-desktop-notifications" "" t) ;;;*** -;;;### (autoloads nil "erc-ezbounce" "erc/erc-ezbounce.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "erc-ezbounce" "erc/erc-ezbounce.el" (21240 +;;;;;; 46395 727291 0)) ;;; Generated autoloads from erc/erc-ezbounce.el (autoload 'erc-cmd-ezb "erc-ezbounce" "\ @@ -8851,7 +8858,7 @@ Add EZBouncer convenience functions to ERC. ;;;*** -;;;### (autoloads nil "erc-fill" "erc/erc-fill.el" (21291 53104 0 +;;;### (autoloads nil "erc-fill" "erc/erc-fill.el" (21240 46395 727291 ;;;;;; 0)) ;;; Generated autoloads from erc/erc-fill.el (autoload 'erc-fill-mode "erc-fill" nil t) @@ -8864,8 +8871,8 @@ You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'. ;;;*** -;;;### (autoloads nil "erc-identd" "erc/erc-identd.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "erc-identd" "erc/erc-identd.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from erc/erc-identd.el (autoload 'erc-identd-mode "erc-identd") @@ -8886,8 +8893,8 @@ system. ;;;*** -;;;### (autoloads nil "erc-imenu" "erc/erc-imenu.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "erc-imenu" "erc/erc-imenu.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from erc/erc-imenu.el (autoload 'erc-create-imenu-index "erc-imenu" "\ @@ -8897,21 +8904,22 @@ system. ;;;*** -;;;### (autoloads nil "erc-join" "erc/erc-join.el" (21291 53104 0 +;;;### (autoloads nil "erc-join" "erc/erc-join.el" (21240 46395 727291 ;;;;;; 0)) ;;; Generated autoloads from erc/erc-join.el (autoload 'erc-autojoin-mode "erc-join" nil t) ;;;*** -;;;### (autoloads nil "erc-list" "erc/erc-list.el" (21307 46976 0 +;;;### (autoloads nil "erc-list" "erc/erc-list.el" (21308 46599 181916 ;;;;;; 0)) ;;; Generated autoloads from erc/erc-list.el (autoload 'erc-list-mode "erc-list") ;;;*** -;;;### (autoloads nil "erc-log" "erc/erc-log.el" (21291 53104 0 0)) +;;;### (autoloads nil "erc-log" "erc/erc-log.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from erc/erc-log.el (autoload 'erc-log-mode "erc-log" nil t) @@ -8940,8 +8948,8 @@ You can save every individual message by putting this function on ;;;*** -;;;### (autoloads nil "erc-match" "erc/erc-match.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "erc-match" "erc/erc-match.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from erc/erc-match.el (autoload 'erc-match-mode "erc-match") @@ -8987,15 +8995,15 @@ Delete dangerous-host interactively to `erc-dangerous-hosts'. ;;;*** -;;;### (autoloads nil "erc-menu" "erc/erc-menu.el" (21291 53104 0 +;;;### (autoloads nil "erc-menu" "erc/erc-menu.el" (21240 46395 727291 ;;;;;; 0)) ;;; Generated autoloads from erc/erc-menu.el (autoload 'erc-menu-mode "erc-menu" nil t) ;;;*** -;;;### (autoloads nil "erc-netsplit" "erc/erc-netsplit.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "erc-netsplit" "erc/erc-netsplit.el" (21240 +;;;;;; 46395 727291 0)) ;;; Generated autoloads from erc/erc-netsplit.el (autoload 'erc-netsplit-mode "erc-netsplit") @@ -9006,8 +9014,8 @@ Show who's gone. ;;;*** -;;;### (autoloads nil "erc-networks" "erc/erc-networks.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "erc-networks" "erc/erc-networks.el" (21260 +;;;;;; 55795 711190 0)) ;;; Generated autoloads from erc/erc-networks.el (autoload 'erc-determine-network "erc-networks" "\ @@ -9024,8 +9032,8 @@ Interactively select a server to connect to using `erc-server-alist'. ;;;*** -;;;### (autoloads nil "erc-notify" "erc/erc-notify.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "erc-notify" "erc/erc-notify.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from erc/erc-notify.el (autoload 'erc-notify-mode "erc-notify" nil t) @@ -9043,36 +9051,36 @@ with args, toggle notify status of people. ;;;*** -;;;### (autoloads nil "erc-page" "erc/erc-page.el" (21291 53104 0 +;;;### (autoloads nil "erc-page" "erc/erc-page.el" (21240 46395 727291 ;;;;;; 0)) ;;; Generated autoloads from erc/erc-page.el (autoload 'erc-page-mode "erc-page") ;;;*** -;;;### (autoloads nil "erc-pcomplete" "erc/erc-pcomplete.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "erc-pcomplete" "erc/erc-pcomplete.el" (21240 +;;;;;; 46395 727291 0)) ;;; Generated autoloads from erc/erc-pcomplete.el (autoload 'erc-completion-mode "erc-pcomplete" nil t) ;;;*** -;;;### (autoloads nil "erc-replace" "erc/erc-replace.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "erc-replace" "erc/erc-replace.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from erc/erc-replace.el (autoload 'erc-replace-mode "erc-replace") ;;;*** -;;;### (autoloads nil "erc-ring" "erc/erc-ring.el" (21291 53104 0 +;;;### (autoloads nil "erc-ring" "erc/erc-ring.el" (21240 46395 727291 ;;;;;; 0)) ;;; Generated autoloads from erc/erc-ring.el (autoload 'erc-ring-mode "erc-ring" nil t) ;;;*** -;;;### (autoloads nil "erc-services" "erc/erc-services.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "erc-services" "erc/erc-services.el" (21240 +;;;;;; 46395 727291 0)) ;;; Generated autoloads from erc/erc-services.el (autoload 'erc-services-mode "erc-services" nil t) @@ -9089,15 +9097,15 @@ When called interactively, read the password using `read-passwd'. ;;;*** -;;;### (autoloads nil "erc-sound" "erc/erc-sound.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "erc-sound" "erc/erc-sound.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from erc/erc-sound.el (autoload 'erc-sound-mode "erc-sound") ;;;*** -;;;### (autoloads nil "erc-speedbar" "erc/erc-speedbar.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "erc-speedbar" "erc/erc-speedbar.el" (21240 +;;;;;; 46395 727291 0)) ;;; Generated autoloads from erc/erc-speedbar.el (autoload 'erc-speedbar-browser "erc-speedbar" "\ @@ -9108,22 +9116,22 @@ This will add a speedbar major display mode. ;;;*** -;;;### (autoloads nil "erc-spelling" "erc/erc-spelling.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "erc-spelling" "erc/erc-spelling.el" (21240 +;;;;;; 46395 727291 0)) ;;; Generated autoloads from erc/erc-spelling.el (autoload 'erc-spelling-mode "erc-spelling" nil t) ;;;*** -;;;### (autoloads nil "erc-stamp" "erc/erc-stamp.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "erc-stamp" "erc/erc-stamp.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from erc/erc-stamp.el (autoload 'erc-timestamp-mode "erc-stamp" nil t) ;;;*** -;;;### (autoloads nil "erc-track" "erc/erc-track.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "erc-track" "erc/erc-track.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from erc/erc-track.el (defvar erc-track-minor-mode nil "\ @@ -9148,8 +9156,8 @@ keybindings will not do anything useful. ;;;*** -;;;### (autoloads nil "erc-truncate" "erc/erc-truncate.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "erc-truncate" "erc/erc-truncate.el" (21240 +;;;;;; 46395 727291 0)) ;;; Generated autoloads from erc/erc-truncate.el (autoload 'erc-truncate-mode "erc-truncate" nil t) @@ -9168,7 +9176,7 @@ Meant to be used in hooks, like `erc-insert-post-hook'. ;;;*** -;;;### (autoloads nil "erc-xdcc" "erc/erc-xdcc.el" (21291 53104 0 +;;;### (autoloads nil "erc-xdcc" "erc/erc-xdcc.el" (21240 46395 727291 ;;;;;; 0)) ;;; Generated autoloads from erc/erc-xdcc.el (autoload 'erc-xdcc-mode "erc-xdcc") @@ -9180,7 +9188,8 @@ Add a file to `erc-xdcc-files'. ;;;*** -;;;### (autoloads nil "ert" "emacs-lisp/ert.el" (21291 53104 0 0)) +;;;### (autoloads nil "ert" "emacs-lisp/ert.el" (21261 52533 628241 +;;;;;; 0)) ;;; Generated autoloads from emacs-lisp/ert.el (autoload 'ert-deftest "ert" "\ @@ -9245,8 +9254,8 @@ Display the documentation for TEST-OR-TEST-NAME (a symbol or ert-test). ;;;*** -;;;### (autoloads nil "ert-x" "emacs-lisp/ert-x.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "ert-x" "emacs-lisp/ert-x.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from emacs-lisp/ert-x.el (put 'ert-with-test-buffer 'lisp-indent-function 1) @@ -9258,8 +9267,8 @@ Kill all test buffers that are still live. ;;;*** -;;;### (autoloads nil "esh-mode" "eshell/esh-mode.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "esh-mode" "eshell/esh-mode.el" (21213 1461 +;;;;;; 513511 0)) ;;; Generated autoloads from eshell/esh-mode.el (autoload 'eshell-mode "esh-mode" "\ @@ -9269,7 +9278,7 @@ Emacs shell interactive mode. ;;;*** -;;;### (autoloads nil "eshell" "eshell/eshell.el" (21291 53104 0 +;;;### (autoloads nil "eshell" "eshell/eshell.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from eshell/eshell.el (push (purecopy '(eshell 2 4 2)) package--builtin-versions) @@ -9305,7 +9314,7 @@ corresponding to a successful execution. ;;;*** -;;;### (autoloads nil "etags" "progmodes/etags.el" (21291 53104 0 +;;;### (autoloads nil "etags" "progmodes/etags.el" (21240 46395 727291 ;;;;;; 0)) ;;; Generated autoloads from progmodes/etags.el @@ -9614,8 +9623,8 @@ for \\[find-tag] (which see). ;;;*** -;;;### (autoloads nil "ethio-util" "language/ethio-util.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "ethio-util" "language/ethio-util.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from language/ethio-util.el (autoload 'setup-ethiopic-environment-internal "ethio-util" "\ @@ -9783,7 +9792,7 @@ With ARG, insert that many delimiters. ;;;*** -;;;### (autoloads nil "eudc" "net/eudc.el" (21291 53104 0 0)) +;;;### (autoloads nil "eudc" "net/eudc.el" (21187 63826 213216 0)) ;;; Generated autoloads from net/eudc.el (autoload 'eudc-set-server "eudc" "\ @@ -9837,7 +9846,7 @@ This does nothing except loading eudc by autoload side-effect. ;;;*** -;;;### (autoloads nil "eudc-bob" "net/eudc-bob.el" (21291 53104 0 +;;;### (autoloads nil "eudc-bob" "net/eudc-bob.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from net/eudc-bob.el @@ -9873,8 +9882,8 @@ Display a button for the JPEG DATA. ;;;*** -;;;### (autoloads nil "eudc-export" "net/eudc-export.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "eudc-export" "net/eudc-export.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from net/eudc-export.el (autoload 'eudc-insert-record-at-point-into-bbdb "eudc-export" "\ @@ -9890,8 +9899,8 @@ Call `eudc-insert-record-at-point-into-bbdb' if on a record. ;;;*** -;;;### (autoloads nil "eudc-hotlist" "net/eudc-hotlist.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "eudc-hotlist" "net/eudc-hotlist.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from net/eudc-hotlist.el (autoload 'eudc-edit-hotlist "eudc-hotlist" "\ @@ -9901,7 +9910,7 @@ Edit the hotlist of directory servers in a specialized buffer. ;;;*** -;;;### (autoloads nil "ewoc" "emacs-lisp/ewoc.el" (21291 53104 0 +;;;### (autoloads nil "ewoc" "emacs-lisp/ewoc.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from emacs-lisp/ewoc.el @@ -9928,7 +9937,7 @@ fourth arg NOSEP non-nil inhibits this. ;;;*** -;;;### (autoloads nil "eww" "net/eww.el" (21291 53104 0 0)) +;;;### (autoloads nil "eww" "net/eww.el" (21271 29460 497806 0)) ;;; Generated autoloads from net/eww.el (autoload 'eww "eww" "\ @@ -9951,8 +9960,8 @@ Render a file using EWW. ;;;*** -;;;### (autoloads nil "executable" "progmodes/executable.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "executable" "progmodes/executable.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from progmodes/executable.el (autoload 'executable-command-find-posix-p "executable" "\ @@ -9993,7 +10002,7 @@ file modes. ;;;*** -;;;### (autoloads nil "expand" "expand.el" (21291 53104 0 0)) +;;;### (autoloads nil "expand" "expand.el" (21187 63826 213216 0)) ;;; Generated autoloads from expand.el (autoload 'expand-add-abbrevs "expand" "\ @@ -10042,7 +10051,8 @@ This is used only in conjunction with `expand-add-abbrevs'. ;;;*** -;;;### (autoloads nil "f90" "progmodes/f90.el" (21291 53104 0 0)) +;;;### (autoloads nil "f90" "progmodes/f90.el" (21383 2343 498187 +;;;;;; 0)) ;;; Generated autoloads from progmodes/f90.el (autoload 'f90-mode "f90" "\ @@ -10109,7 +10119,7 @@ with no args, if that value is non-nil. ;;;*** -;;;### (autoloads nil "face-remap" "face-remap.el" (21291 53104 0 +;;;### (autoloads nil "face-remap" "face-remap.el" (21241 18251 378509 ;;;;;; 0)) ;;; Generated autoloads from face-remap.el @@ -10269,8 +10279,8 @@ Besides the choice of face, it is the same as `buffer-face-mode'. ;;;*** -;;;### (autoloads nil "feedmail" "mail/feedmail.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "feedmail" "mail/feedmail.el" (21002 1963 769129 +;;;;;; 0)) ;;; Generated autoloads from mail/feedmail.el (push (purecopy '(feedmail 11)) package--builtin-versions) @@ -10324,7 +10334,7 @@ you can set `feedmail-queue-reminder-alist' to nil. ;;;*** -;;;### (autoloads nil "ffap" "ffap.el" (21291 53104 0 0)) +;;;### (autoloads nil "ffap" "ffap.el" (21293 25385 120083 0)) ;;; Generated autoloads from ffap.el (autoload 'ffap-next "ffap" "\ @@ -10387,7 +10397,8 @@ Evaluate the forms in variable `ffap-bindings'. ;;;*** -;;;### (autoloads nil "filecache" "filecache.el" (21291 53104 0 0)) +;;;### (autoloads nil "filecache" "filecache.el" (21265 49588 918402 +;;;;;; 0)) ;;; Generated autoloads from filecache.el (autoload 'file-cache-add-directory "filecache" "\ @@ -10444,7 +10455,7 @@ the name is considered already unique; only the second substitution ;;;*** -;;;### (autoloads nil "filenotify" "filenotify.el" (21291 53104 0 +;;;### (autoloads nil "filenotify" "filenotify.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from filenotify.el @@ -10457,7 +10468,8 @@ Otherwise, signal a `file-notify-error'. ;;;*** -;;;### (autoloads nil "files-x" "files-x.el" (21291 53104 0 0)) +;;;### (autoloads nil "files-x" "files-x.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from files-x.el (autoload 'add-file-local-variable "files-x" "\ @@ -10522,7 +10534,8 @@ Copy directory-local variables to the -*- line. ;;;*** -;;;### (autoloads nil "filesets" "filesets.el" (21291 53104 0 0)) +;;;### (autoloads nil "filesets" "filesets.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from filesets.el (autoload 'filesets-init "filesets" "\ @@ -10533,7 +10546,8 @@ Set up hooks, load the cache file -- if existing -- and build the menu. ;;;*** -;;;### (autoloads nil "find-cmd" "find-cmd.el" (21291 53104 0 0)) +;;;### (autoloads nil "find-cmd" "find-cmd.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from find-cmd.el (push (purecopy '(find-cmd 0 6)) package--builtin-versions) @@ -10553,7 +10567,7 @@ result is a string that should be ready for the command line. ;;;*** -;;;### (autoloads nil "find-dired" "find-dired.el" (21291 53104 0 +;;;### (autoloads nil "find-dired" "find-dired.el" (21264 57319 597552 ;;;;;; 0)) ;;; Generated autoloads from find-dired.el @@ -10594,7 +10608,8 @@ use in place of \"-ls\" as the final argument. ;;;*** -;;;### (autoloads nil "find-file" "find-file.el" (21291 53104 0 0)) +;;;### (autoloads nil "find-file" "find-file.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from find-file.el (defvar ff-special-constructs `((,(purecopy "^#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]") lambda nil (buffer-substring (match-beginning 2) (match-end 2)))) "\ @@ -10684,8 +10699,8 @@ Visit the file you click on in another window. ;;;*** -;;;### (autoloads nil "find-func" "emacs-lisp/find-func.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "find-func" "emacs-lisp/find-func.el" (21230 +;;;;;; 10550 983182 0)) ;;; Generated autoloads from emacs-lisp/find-func.el (autoload 'find-library "find-func" "\ @@ -10843,7 +10858,8 @@ Define some key bindings for the find-function family of functions. ;;;*** -;;;### (autoloads nil "find-lisp" "find-lisp.el" (21291 53104 0 0)) +;;;### (autoloads nil "find-lisp" "find-lisp.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from find-lisp.el (autoload 'find-lisp-find-dired "find-lisp" "\ @@ -10863,7 +10879,7 @@ Change the filter on a `find-lisp-find-dired' buffer to REGEXP. ;;;*** -;;;### (autoloads nil "finder" "finder.el" (21291 53104 0 0)) +;;;### (autoloads nil "finder" "finder.el" (21283 26898 123687 848000)) ;;; Generated autoloads from finder.el (push (purecopy '(finder 1 0)) package--builtin-versions) @@ -10885,7 +10901,8 @@ Find packages matching a given keyword. ;;;*** -;;;### (autoloads nil "flow-ctrl" "flow-ctrl.el" (21291 53104 0 0)) +;;;### (autoloads nil "flow-ctrl" "flow-ctrl.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from flow-ctrl.el (autoload 'enable-flow-control "flow-ctrl" "\ @@ -10906,8 +10923,8 @@ to get the effect of a C-q. ;;;*** -;;;### (autoloads nil "flow-fill" "gnus/flow-fill.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "flow-fill" "gnus/flow-fill.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from gnus/flow-fill.el (autoload 'fill-flowed-encode "flow-fill" "\ @@ -10922,8 +10939,8 @@ to get the effect of a C-q. ;;;*** -;;;### (autoloads nil "flymake" "progmodes/flymake.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "flymake" "progmodes/flymake.el" (21245 64312 +;;;;;; 799897 0)) ;;; Generated autoloads from progmodes/flymake.el (push (purecopy '(flymake 0 3)) package--builtin-versions) @@ -10953,8 +10970,8 @@ Turn flymake mode off. ;;;*** -;;;### (autoloads nil "flyspell" "textmodes/flyspell.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "flyspell" "textmodes/flyspell.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from textmodes/flyspell.el (autoload 'flyspell-prog-mode "flyspell" "\ @@ -11024,13 +11041,14 @@ Flyspell whole buffer. ;;;*** -;;;### (autoloads nil "foldout" "foldout.el" (21291 53104 0 0)) +;;;### (autoloads nil "foldout" "foldout.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from foldout.el (push (purecopy '(foldout 1 10)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "follow" "follow.el" (21291 53104 0 0)) +;;;### (autoloads nil "follow" "follow.el" (21240 46395 727291 0)) ;;; Generated autoloads from follow.el (autoload 'turn-on-follow-mode "follow" "\ @@ -11098,8 +11116,8 @@ selected if the original window is the first one in the frame. ;;;*** -;;;### (autoloads nil "footnote" "mail/footnote.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "footnote" "mail/footnote.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from mail/footnote.el (push (purecopy '(footnote 0 19)) package--builtin-versions) @@ -11118,7 +11136,7 @@ play around with the following keys: ;;;*** -;;;### (autoloads nil "forms" "forms.el" (21291 53104 0 0)) +;;;### (autoloads nil "forms" "forms.el" (21187 63826 213216 0)) ;;; Generated autoloads from forms.el (autoload 'forms-mode "forms" "\ @@ -11154,8 +11172,8 @@ Visit a file in Forms mode in other window. ;;;*** -;;;### (autoloads nil "fortran" "progmodes/fortran.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "fortran" "progmodes/fortran.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from progmodes/fortran.el (autoload 'fortran-mode "fortran" "\ @@ -11232,7 +11250,7 @@ with no args, if that value is non-nil. ;;;*** -;;;### (autoloads nil "fortune" "play/fortune.el" (21291 53104 0 +;;;### (autoloads nil "fortune" "play/fortune.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from play/fortune.el @@ -11281,7 +11299,8 @@ and choose the directory as the fortune-file. ;;;*** -;;;### (autoloads nil "frameset" "frameset.el" (21300 58261 0 0)) +;;;### (autoloads nil "frameset" "frameset.el" (21300 27302 473448 +;;;;;; 0)) ;;; Generated autoloads from frameset.el (defvar frameset-session-filter-alist '((name . :never) (left . frameset-filter-iconified) (minibuffer . frameset-filter-minibuffer) (top . frameset-filter-iconified)) "\ @@ -11450,6 +11469,12 @@ Called from `jump-to-register'. Internal use only. \(fn DATA)" nil nil) +(autoload 'frameset--print-register "frameset" "\ +Print basic info about frameset stored in DATA. +Called from `list-registers' and `view-register'. Internal use only. + +\(fn DATA)" nil nil) + (autoload 'frameset-to-register "frameset" "\ Store the current frameset in register REGISTER. Use \\[jump-to-register] to restore the frameset. @@ -11461,15 +11486,15 @@ Interactively, reads the register using `register-read-with-preview'. ;;;*** -;;;### (autoloads nil "gamegrid" "play/gamegrid.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "gamegrid" "play/gamegrid.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from play/gamegrid.el (push (purecopy '(gamegrid 1 2)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "gdb-mi" "progmodes/gdb-mi.el" (21346 62196 -;;;;;; 0 0)) +;;;### (autoloads nil "gdb-mi" "progmodes/gdb-mi.el" (21350 58112 +;;;;;; 380040 0)) ;;; Generated autoloads from progmodes/gdb-mi.el (defvar gdb-enable-debug nil "\ @@ -11546,8 +11571,8 @@ detailed description of this mode. ;;;*** -;;;### (autoloads nil "generic" "emacs-lisp/generic.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "generic" "emacs-lisp/generic.el" (21202 31159 +;;;;;; 541460 0)) ;;; Generated autoloads from emacs-lisp/generic.el (defvar generic-mode-list nil "\ @@ -11591,9 +11616,9 @@ See the file generic-x.el for some examples of `define-generic-mode'. \(fn MODE COMMENT-LIST KEYWORD-LIST FONT-LOCK-LIST AUTO-MODE-LIST FUNCTION-LIST &optional DOCSTRING)" nil t) -(put 'define-generic-mode 'lisp-indent-function '1) +(function-put 'define-generic-mode 'lisp-indent-function '1) -(put 'define-generic-mode 'doc-string-elt '7) +(function-put 'define-generic-mode 'doc-string-elt '7) (autoload 'generic-mode-internal "generic" "\ Go into the generic mode MODE. @@ -11627,8 +11652,8 @@ regular expression that can be used as an element of ;;;*** -;;;### (autoloads nil "glasses" "progmodes/glasses.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "glasses" "progmodes/glasses.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from progmodes/glasses.el (autoload 'glasses-mode "glasses" "\ @@ -11642,8 +11667,8 @@ add virtual separators (like underscores) at places they belong to. ;;;*** -;;;### (autoloads nil "gmm-utils" "gnus/gmm-utils.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "gmm-utils" "gnus/gmm-utils.el" (21326 22692 +;;;;;; 123234 0)) ;;; Generated autoloads from gnus/gmm-utils.el (autoload 'gmm-regexp-concat "gmm-utils" "\ @@ -11697,7 +11722,7 @@ DEFAULT-MAP specifies the default key map for ICON-LIST. ;;;*** -;;;### (autoloads nil "gnus" "gnus/gnus.el" (21291 53104 0 0)) +;;;### (autoloads nil "gnus" "gnus/gnus.el" (21296 1575 438327 0)) ;;; Generated autoloads from gnus/gnus.el (push (purecopy '(gnus 5 13)) package--builtin-versions) (when (fboundp 'custom-autoload) @@ -11747,8 +11772,8 @@ prompt the user for the name of an NNTP server to use. ;;;*** -;;;### (autoloads nil "gnus-agent" "gnus/gnus-agent.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "gnus-agent" "gnus/gnus-agent.el" (21274 64565 +;;;;;; 737222 0)) ;;; Generated autoloads from gnus/gnus-agent.el (autoload 'gnus-unplugged "gnus-agent" "\ @@ -11838,8 +11863,8 @@ CLEAN is obsolete and ignored. ;;;*** -;;;### (autoloads nil "gnus-art" "gnus/gnus-art.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "gnus-art" "gnus/gnus-art.el" (21365 58789 +;;;;;; 638999 0)) ;;; Generated autoloads from gnus/gnus-art.el (autoload 'gnus-article-prepare-display "gnus-art" "\ @@ -11849,8 +11874,8 @@ Make the current buffer look like a nice article. ;;;*** -;;;### (autoloads nil "gnus-bookmark" "gnus/gnus-bookmark.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "gnus-bookmark" "gnus/gnus-bookmark.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from gnus/gnus-bookmark.el (autoload 'gnus-bookmark-set "gnus-bookmark" "\ @@ -11873,8 +11898,8 @@ deletion, or > if it is flagged for displaying. ;;;*** -;;;### (autoloads nil "gnus-cache" "gnus/gnus-cache.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "gnus-cache" "gnus/gnus-cache.el" (21296 1575 +;;;;;; 438327 0)) ;;; Generated autoloads from gnus/gnus-cache.el (autoload 'gnus-jog-cache "gnus-cache" "\ @@ -11915,8 +11940,8 @@ supported. ;;;*** -;;;### (autoloads nil "gnus-delay" "gnus/gnus-delay.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "gnus-delay" "gnus/gnus-delay.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from gnus/gnus-delay.el (autoload 'gnus-delay-article "gnus-delay" "\ @@ -11951,8 +11976,8 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil. ;;;*** -;;;### (autoloads nil "gnus-diary" "gnus/gnus-diary.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "gnus-diary" "gnus/gnus-diary.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from gnus/gnus-diary.el (autoload 'gnus-user-format-function-d "gnus-diary" "\ @@ -11967,8 +11992,8 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil. ;;;*** -;;;### (autoloads nil "gnus-dired" "gnus/gnus-dired.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "gnus-dired" "gnus/gnus-dired.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from gnus/gnus-dired.el (autoload 'turn-on-gnus-dired-mode "gnus-dired" "\ @@ -11978,8 +12003,8 @@ Convenience method to turn on gnus-dired-mode. ;;;*** -;;;### (autoloads nil "gnus-draft" "gnus/gnus-draft.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "gnus-draft" "gnus/gnus-draft.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from gnus/gnus-draft.el (autoload 'gnus-draft-reminder "gnus-draft" "\ @@ -11989,13 +12014,22 @@ Reminder user if there are unsent drafts. ;;;*** -;;;### (autoloads nil "gnus-fun" "gnus/gnus-fun.el" (21352 50356 -;;;;;; 891885 0)) +;;;### (autoloads nil "gnus-fun" "gnus/gnus-fun.el" (21355 22953 +;;;;;; 61816 0)) ;;; Generated autoloads from gnus/gnus-fun.el +(autoload 'gnus--random-face-with-type "gnus-fun" "\ +Return file from DIR with extension EXT, omitting matches of OMIT, processed by FUN. + +\(fn DIR EXT OMIT FUN)" nil nil) + +(autoload 'message-goto-eoh "message" nil t) + (autoload 'gnus-random-x-face "gnus-fun" "\ Return X-Face header data chosen randomly from `gnus-x-face-directory'. +Files matching `gnus-x-face-omit-files' are not considered. + \(fn)" t nil) (autoload 'gnus-insert-random-x-face-header "gnus-fun" "\ @@ -12004,7 +12038,7 @@ Insert a random X-Face header from `gnus-x-face-directory'. \(fn)" t nil) (autoload 'gnus-x-face-from-file "gnus-fun" "\ -Insert an X-Face header based on an image file. +Insert an X-Face header based on an image FILE. Depending on `gnus-convert-image-to-x-face-command' it may accept different input formats. @@ -12012,7 +12046,7 @@ different input formats. \(fn FILE)" t nil) (autoload 'gnus-face-from-file "gnus-fun" "\ -Return a Face header based on an image file. +Return a Face header based on an image FILE. Depending on `gnus-convert-image-to-face-command' it may accept different input formats. @@ -12032,10 +12066,22 @@ FILE should be a PNG file that's 48x48 and smaller than or equal to \(fn FILE)" nil nil) +(autoload 'gnus-random-face "gnus-fun" "\ +Return randomly chosen Face from `gnus-face-directory'. + +Files matching `gnus-face-omit-files' are not considered. + +\(fn)" t nil) + +(autoload 'gnus-insert-random-face-header "gnus-fun" "\ +Insert a randome Face header from `gnus-face-directory'. + +\(fn)" nil nil) + ;;;*** -;;;### (autoloads nil "gnus-gravatar" "gnus/gnus-gravatar.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "gnus-gravatar" "gnus/gnus-gravatar.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from gnus/gnus-gravatar.el (autoload 'gnus-treat-from-gravatar "gnus-gravatar" "\ @@ -12052,8 +12098,8 @@ If gravatars are already displayed, remove them. ;;;*** -;;;### (autoloads nil "gnus-group" "gnus/gnus-group.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "gnus-group" "gnus/gnus-group.el" (21296 1575 +;;;;;; 438327 0)) ;;; Generated autoloads from gnus/gnus-group.el (autoload 'gnus-fetch-group "gnus-group" "\ @@ -12070,8 +12116,8 @@ Pop up a frame and enter GROUP. ;;;*** -;;;### (autoloads nil "gnus-html" "gnus/gnus-html.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "gnus-html" "gnus/gnus-html.el" (21296 1575 +;;;;;; 438327 0)) ;;; Generated autoloads from gnus/gnus-html.el (autoload 'gnus-article-html "gnus-html" "\ @@ -12086,8 +12132,8 @@ Pop up a frame and enter GROUP. ;;;*** -;;;### (autoloads nil "gnus-kill" "gnus/gnus-kill.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "gnus-kill" "gnus/gnus-kill.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from gnus/gnus-kill.el (defalias 'gnus-batch-kill 'gnus-batch-score) @@ -12100,7 +12146,7 @@ Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score ;;;*** -;;;### (autoloads nil "gnus-ml" "gnus/gnus-ml.el" (21291 53104 0 +;;;### (autoloads nil "gnus-ml" "gnus/gnus-ml.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from gnus/gnus-ml.el @@ -12124,8 +12170,8 @@ Minor mode for providing mailing-list commands. ;;;*** -;;;### (autoloads nil "gnus-mlspl" "gnus/gnus-mlspl.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "gnus-mlspl" "gnus/gnus-mlspl.el" (21296 1575 +;;;;;; 438327 0)) ;;; Generated autoloads from gnus/gnus-mlspl.el (autoload 'gnus-group-split-setup "gnus-mlspl" "\ @@ -12225,8 +12271,8 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\") returns: ;;;*** -;;;### (autoloads nil "gnus-msg" "gnus/gnus-msg.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "gnus-msg" "gnus/gnus-msg.el" (21235 28473 +;;;;;; 29431 0)) ;;; Generated autoloads from gnus/gnus-msg.el (autoload 'gnus-msg-mail "gnus-msg" "\ @@ -12253,7 +12299,7 @@ Like `message-reply'. ;;;*** ;;;### (autoloads nil "gnus-notifications" "gnus/gnus-notifications.el" -;;;;;; (21291 53104 0 0)) +;;;;;; (21296 1575 438327 0)) ;;; Generated autoloads from gnus/gnus-notifications.el (autoload 'gnus-notifications "gnus-notifications" "\ @@ -12269,8 +12315,8 @@ This is typically a function to add in ;;;*** -;;;### (autoloads nil "gnus-picon" "gnus/gnus-picon.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "gnus-picon" "gnus/gnus-picon.el" (21296 1575 +;;;;;; 438327 0)) ;;; Generated autoloads from gnus/gnus-picon.el (autoload 'gnus-treat-from-picon "gnus-picon" "\ @@ -12293,8 +12339,8 @@ If picons are already displayed, remove them. ;;;*** -;;;### (autoloads nil "gnus-range" "gnus/gnus-range.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "gnus-range" "gnus/gnus-range.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from gnus/gnus-range.el (autoload 'gnus-sorted-difference "gnus-range" "\ @@ -12361,8 +12407,8 @@ Add NUM into sorted LIST by side effect. ;;;*** -;;;### (autoloads nil "gnus-registry" "gnus/gnus-registry.el" (21346 -;;;;;; 62196 0 0)) +;;;### (autoloads nil "gnus-registry" "gnus/gnus-registry.el" (21350 +;;;;;; 58112 380040 0)) ;;; Generated autoloads from gnus/gnus-registry.el (autoload 'gnus-registry-initialize "gnus-registry" "\ @@ -12377,8 +12423,8 @@ Install the registry hooks. ;;;*** -;;;### (autoloads nil "gnus-sieve" "gnus/gnus-sieve.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "gnus-sieve" "gnus/gnus-sieve.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from gnus/gnus-sieve.el (autoload 'gnus-sieve-update "gnus-sieve" "\ @@ -12405,8 +12451,8 @@ See the documentation for these variables and functions for details. ;;;*** -;;;### (autoloads nil "gnus-spec" "gnus/gnus-spec.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "gnus-spec" "gnus/gnus-spec.el" (21296 1575 +;;;;;; 438327 0)) ;;; Generated autoloads from gnus/gnus-spec.el (autoload 'gnus-update-format "gnus-spec" "\ @@ -12416,8 +12462,8 @@ Update the format specification near point. ;;;*** -;;;### (autoloads nil "gnus-start" "gnus/gnus-start.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "gnus-start" "gnus/gnus-start.el" (21296 1575 +;;;;;; 438327 0)) ;;; Generated autoloads from gnus/gnus-start.el (autoload 'gnus-declare-backend "gnus-start" "\ @@ -12427,8 +12473,8 @@ Declare back end NAME with ABILITIES as a Gnus back end. ;;;*** -;;;### (autoloads nil "gnus-sum" "gnus/gnus-sum.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "gnus-sum" "gnus/gnus-sum.el" (21296 1575 438327 +;;;;;; 0)) ;;; Generated autoloads from gnus/gnus-sum.el (autoload 'gnus-summary-bookmark-jump "gnus-sum" "\ @@ -12439,8 +12485,8 @@ BOOKMARK is a bookmark name or a bookmark record. ;;;*** -;;;### (autoloads nil "gnus-sync" "gnus/gnus-sync.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "gnus-sync" "gnus/gnus-sync.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from gnus/gnus-sync.el (autoload 'gnus-sync-initialize "gnus-sync" "\ @@ -12455,8 +12501,8 @@ Install the sync hooks. ;;;*** -;;;### (autoloads nil "gnus-win" "gnus/gnus-win.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "gnus-win" "gnus/gnus-win.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from gnus/gnus-win.el (autoload 'gnus-add-configuration "gnus-win" "\ @@ -12466,7 +12512,8 @@ Add the window configuration CONF to `gnus-buffer-configuration'. ;;;*** -;;;### (autoloads nil "gnutls" "net/gnutls.el" (21291 53104 0 0)) +;;;### (autoloads nil "gnutls" "net/gnutls.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from net/gnutls.el (defvar gnutls-min-prime-bits 256 "\ @@ -12482,7 +12529,8 @@ A value of nil says to use the default GnuTLS value.") ;;;*** -;;;### (autoloads nil "gomoku" "play/gomoku.el" (21291 53104 0 0)) +;;;### (autoloads nil "gomoku" "play/gomoku.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from play/gomoku.el (autoload 'gomoku "gomoku" "\ @@ -12508,8 +12556,8 @@ Use \\[describe-mode] for more info. ;;;*** -;;;### (autoloads nil "goto-addr" "net/goto-addr.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "goto-addr" "net/goto-addr.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from net/goto-addr.el (define-obsolete-function-alias 'goto-address-at-mouse 'goto-address-at-point "22.1") @@ -12550,8 +12598,8 @@ Like `goto-address-mode', but only for comments and strings. ;;;*** -;;;### (autoloads nil "gravatar" "gnus/gravatar.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "gravatar" "gnus/gravatar.el" (21296 1575 438327 +;;;;;; 0)) ;;; Generated autoloads from gnus/gravatar.el (autoload 'gravatar-retrieve "gravatar" "\ @@ -12567,7 +12615,8 @@ Retrieve MAIL-ADDRESS gravatar and returns it. ;;;*** -;;;### (autoloads nil "grep" "progmodes/grep.el" (21291 53104 0 0)) +;;;### (autoloads nil "grep" "progmodes/grep.el" (21356 43818 957743 +;;;;;; 0)) ;;; Generated autoloads from progmodes/grep.el (defvar grep-window-height nil "\ @@ -12725,13 +12774,13 @@ Recursively grep for REGEXP in gzipped FILES in tree rooted at DIR. Like `rgrep' but uses `zgrep' for `grep-program', sets the default file name to `*.gz', and sets `grep-highlight-matches' to `always'. -\(fn REGEXP &optional FILES DIR CONFIRM GREP-FIND-TEMPLATE)" t nil) +\(fn REGEXP &optional FILES DIR CONFIRM TEMPLATE)" t nil) (defalias 'rzgrep 'zrgrep) ;;;*** -;;;### (autoloads nil "gs" "gs.el" (21291 53104 0 0)) +;;;### (autoloads nil "gs" "gs.el" (21240 46395 727291 0)) ;;; Generated autoloads from gs.el (autoload 'gs-load-image "gs" "\ @@ -12744,7 +12793,8 @@ the form \"WINDOW-ID PIXMAP-ID\". Value is non-nil if successful. ;;;*** -;;;### (autoloads nil "gud" "progmodes/gud.el" (21291 53104 0 0)) +;;;### (autoloads nil "gud" "progmodes/gud.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from progmodes/gud.el (autoload 'gud-gdb "gud" "\ @@ -12832,7 +12882,7 @@ it if ARG is omitted or nil. ;;;*** -;;;### (autoloads nil "gv" "emacs-lisp/gv.el" (21387 3002 678518 +;;;### (autoloads nil "gv" "emacs-lisp/gv.el" (21255 45558 780901 ;;;;;; 0)) ;;; Generated autoloads from emacs-lisp/gv.el @@ -12861,7 +12911,7 @@ all the parts of PLACE that can be evaluated and then runs E. \(fn (GETTER SETTER) PLACE &rest BODY)" nil t) -(put 'gv-letplace 'lisp-indent-function '2) +(function-put 'gv-letplace 'lisp-indent-function '2) (autoload 'gv-define-expander "gv" "\ Use HANDLER to handle NAME as a generalized var. @@ -12871,7 +12921,7 @@ arguments as NAME. DO is a function as defined in `gv-get'. \(fn NAME HANDLER)" nil t) -(put 'gv-define-expander 'lisp-indent-function '1) +(function-put 'gv-define-expander 'lisp-indent-function '1) (autoload 'gv--defun-declaration "gv" "\ @@ -12896,7 +12946,7 @@ to be pure and copyable. Example use: \(fn NAME ARGLIST &rest BODY)" nil t) -(put 'gv-define-setter 'lisp-indent-function '2) +(function-put 'gv-define-setter 'lisp-indent-function '2) (autoload 'gv-define-simple-setter "gv" "\ Define a simple setter method for generalized variable NAME. @@ -12935,8 +12985,8 @@ binding mode. ;;;*** -;;;### (autoloads nil "handwrite" "play/handwrite.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "handwrite" "play/handwrite.el" (21207 49087 +;;;;;; 974317 0)) ;;; Generated autoloads from play/handwrite.el (autoload 'handwrite "handwrite" "\ @@ -12953,7 +13003,8 @@ Variables: `handwrite-linespace' (default 12) ;;;*** -;;;### (autoloads nil "hanoi" "play/hanoi.el" (21291 53104 0 0)) +;;;### (autoloads nil "hanoi" "play/hanoi.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from play/hanoi.el (autoload 'hanoi "hanoi" "\ @@ -12980,8 +13031,8 @@ to be updated. ;;;*** -;;;### (autoloads nil "hashcash" "mail/hashcash.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "hashcash" "mail/hashcash.el" (21296 1575 438327 +;;;;;; 0)) ;;; Generated autoloads from mail/hashcash.el (autoload 'hashcash-insert-payment "hashcash" "\ @@ -13023,7 +13074,7 @@ Prefix arg sets default accept amount temporarily. ;;;*** -;;;### (autoloads nil "help-at-pt" "help-at-pt.el" (21291 53104 0 +;;;### (autoloads nil "help-at-pt" "help-at-pt.el" (21231 31415 579137 ;;;;;; 0)) ;;; Generated autoloads from help-at-pt.el @@ -13151,8 +13202,8 @@ different regions. With numeric argument ARG, behaves like ;;;*** -;;;### (autoloads nil "help-fns" "help-fns.el" (21352 829 634401 -;;;;;; 152000)) +;;;### (autoloads nil "help-fns" "help-fns.el" (21355 22953 61816 +;;;;;; 0)) ;;; Generated autoloads from help-fns.el (autoload 'describe-function "help-fns" "\ @@ -13231,7 +13282,7 @@ Produce a texinfo buffer with sorted doc-strings from the DOC file. ;;;*** -;;;### (autoloads nil "help-macro" "help-macro.el" (21291 53104 0 +;;;### (autoloads nil "help-macro" "help-macro.el" (21240 46395 727291 ;;;;;; 0)) ;;; Generated autoloads from help-macro.el @@ -13246,7 +13297,8 @@ gives the window that lists the options.") ;;;*** -;;;### (autoloads nil "help-mode" "help-mode.el" (21291 53104 0 0)) +;;;### (autoloads nil "help-mode" "help-mode.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from help-mode.el (autoload 'help-mode "help-mode" "\ @@ -13345,8 +13397,8 @@ BOOKMARK is a bookmark name or a bookmark record. ;;;*** -;;;### (autoloads nil "helper" "emacs-lisp/helper.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "helper" "emacs-lisp/helper.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from emacs-lisp/helper.el (autoload 'Helper-describe-bindings "helper" "\ @@ -13361,7 +13413,7 @@ Provide help for current mode. ;;;*** -;;;### (autoloads nil "hexl" "hexl.el" (21291 53104 0 0)) +;;;### (autoloads nil "hexl" "hexl.el" (21271 1974 113743 0)) ;;; Generated autoloads from hexl.el (autoload 'hexl-mode "hexl" "\ @@ -13455,7 +13507,7 @@ This discards the buffer's undo information. ;;;*** -;;;### (autoloads nil "hi-lock" "hi-lock.el" (21291 53104 0 0)) +;;;### (autoloads nil "hi-lock" "hi-lock.el" (21383 2343 498187 0)) ;;; Generated autoloads from hi-lock.el (autoload 'hi-lock-mode "hi-lock" "\ @@ -13622,8 +13674,8 @@ be found in variable `hi-lock-interactive-patterns'. ;;;*** -;;;### (autoloads nil "hideif" "progmodes/hideif.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "hideif" "progmodes/hideif.el" (21292 4516 +;;;;;; 491683 0)) ;;; Generated autoloads from progmodes/hideif.el (autoload 'hide-ifdef-mode "hideif" "\ @@ -13666,8 +13718,8 @@ Several variables affect how the hiding is done: ;;;*** -;;;### (autoloads nil "hideshow" "progmodes/hideshow.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "hideshow" "progmodes/hideshow.el" (21381 47015 +;;;;;; 637535 0)) ;;; Generated autoloads from progmodes/hideshow.el (defvar hs-special-modes-alist (mapcar 'purecopy '((c-mode "{" "}" "/[*/]" nil nil) (c++-mode "{" "}" "/[*/]" nil nil) (bibtex-mode ("@\\S(*\\(\\s(\\)" 1)) (java-mode "{" "}" "/[*/]" nil nil) (js-mode "{" "}" "/[*/]" nil))) "\ @@ -13729,7 +13781,8 @@ Unconditionally turn off `hs-minor-mode'. ;;;*** -;;;### (autoloads nil "hilit-chg" "hilit-chg.el" (21291 53104 0 0)) +;;;### (autoloads nil "hilit-chg" "hilit-chg.el" (21271 1974 113743 +;;;;;; 0)) ;;; Generated autoloads from hilit-chg.el (autoload 'highlight-changes-mode "hilit-chg" "\ @@ -13860,8 +13913,8 @@ See `highlight-changes-mode' for more information on Highlight-Changes mode. ;;;*** -;;;### (autoloads nil "hippie-exp" "hippie-exp.el" (21375 36695 783701 -;;;;;; 621000)) +;;;### (autoloads nil "hippie-exp" "hippie-exp.el" (21379 5287 607434 +;;;;;; 0)) ;;; Generated autoloads from hippie-exp.el (push (purecopy '(hippie-exp 1 6)) package--builtin-versions) @@ -13893,7 +13946,8 @@ argument VERBOSE non-nil makes the function verbose. ;;;*** -;;;### (autoloads nil "hl-line" "hl-line.el" (21291 53104 0 0)) +;;;### (autoloads nil "hl-line" "hl-line.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from hl-line.el (autoload 'hl-line-mode "hl-line" "\ @@ -13942,8 +13996,8 @@ Global-Hl-Line mode uses the functions `global-hl-line-unhighlight' and ;;;*** -;;;### (autoloads nil "holidays" "calendar/holidays.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "holidays" "calendar/holidays.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from calendar/holidays.el (define-obsolete-variable-alias 'general-holidays 'holiday-general-holidays "23.1") @@ -14091,8 +14145,8 @@ The optional LABEL is used to label the buffer created. ;;;*** -;;;### (autoloads nil "html2text" "gnus/html2text.el" (21381 50616 -;;;;;; 629676 0)) +;;;### (autoloads nil "html2text" "gnus/html2text.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from gnus/html2text.el (autoload 'html2text "html2text" "\ @@ -14102,8 +14156,8 @@ Convert HTML to plain text in the current buffer. ;;;*** -;;;### (autoloads nil "htmlfontify" "htmlfontify.el" (21341 23900 -;;;;;; 0 0)) +;;;### (autoloads nil "htmlfontify" "htmlfontify.el" (21383 2343 +;;;;;; 498187 0)) ;;; Generated autoloads from htmlfontify.el (push (purecopy '(htmlfontify 0 21)) package--builtin-versions) @@ -14136,7 +14190,8 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'. ;;;*** -;;;### (autoloads nil "ibuf-macs" "ibuf-macs.el" (21291 53104 0 0)) +;;;### (autoloads nil "ibuf-macs" "ibuf-macs.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from ibuf-macs.el (autoload 'define-ibuffer-column "ibuf-macs" "\ @@ -14224,7 +14279,8 @@ bound to the current value of the filter. ;;;*** -;;;### (autoloads nil "ibuffer" "ibuffer.el" (21291 53104 0 0)) +;;;### (autoloads nil "ibuffer" "ibuffer.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from ibuffer.el (autoload 'ibuffer-list-buffers "ibuffer" "\ @@ -14263,8 +14319,8 @@ FORMATS is the value to use for `ibuffer-formats'. ;;;*** -;;;### (autoloads nil "icalendar" "calendar/icalendar.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "icalendar" "calendar/icalendar.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from calendar/icalendar.el (push (purecopy '(icalendar 0 19)) package--builtin-versions) @@ -14317,7 +14373,8 @@ buffer `*icalendar-errors*'. ;;;*** -;;;### (autoloads nil "icomplete" "icomplete.el" (21291 53104 0 0)) +;;;### (autoloads nil "icomplete" "icomplete.el" (21268 25782 576189 +;;;;;; 0)) ;;; Generated autoloads from icomplete.el (defvar icomplete-mode nil "\ @@ -14352,7 +14409,8 @@ completions: ;;;*** -;;;### (autoloads nil "icon" "progmodes/icon.el" (21291 53104 0 0)) +;;;### (autoloads nil "icon" "progmodes/icon.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from progmodes/icon.el (autoload 'icon-mode "icon" "\ @@ -14392,8 +14450,8 @@ with no args, if that value is non-nil. ;;;*** -;;;### (autoloads nil "idlw-shell" "progmodes/idlw-shell.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "idlw-shell" "progmodes/idlw-shell.el" (21195 +;;;;;; 23530 495420 0)) ;;; Generated autoloads from progmodes/idlw-shell.el (autoload 'idlwave-shell "idlw-shell" "\ @@ -14418,8 +14476,8 @@ See also the variable `idlwave-shell-prompt-pattern'. ;;;*** -;;;### (autoloads nil "idlwave" "progmodes/idlwave.el" (21341 23900 -;;;;;; 0 0)) +;;;### (autoloads nil "idlwave" "progmodes/idlwave.el" (21339 34726 +;;;;;; 39547 0)) ;;; Generated autoloads from progmodes/idlwave.el (push (purecopy '(idlwave 6 1 22)) package--builtin-versions) @@ -14547,7 +14605,7 @@ The main features of this mode are ;;;*** -;;;### (autoloads nil "ido" "ido.el" (21291 53104 0 0)) +;;;### (autoloads nil "ido" "ido.el" (21268 25782 576189 0)) ;;; Generated autoloads from ido.el (defvar ido-mode nil "\ @@ -14809,7 +14867,7 @@ DEF, if non-nil, is the default value. ;;;*** -;;;### (autoloads nil "ielm" "ielm.el" (21291 53104 0 0)) +;;;### (autoloads nil "ielm" "ielm.el" (21240 46395 727291 0)) ;;; Generated autoloads from ielm.el (autoload 'ielm "ielm" "\ @@ -14821,7 +14879,7 @@ See `inferior-emacs-lisp-mode' for details. ;;;*** -;;;### (autoloads nil "iimage" "iimage.el" (21291 53104 0 0)) +;;;### (autoloads nil "iimage" "iimage.el" (21289 28325 826818 0)) ;;; Generated autoloads from iimage.el (define-obsolete-function-alias 'turn-on-iimage-mode 'iimage-mode "24.1") @@ -14837,7 +14895,7 @@ the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. ;;;*** -;;;### (autoloads nil "image" "image.el" (21291 53104 0 0)) +;;;### (autoloads nil "image" "image.el" (21261 4487 230861 399000)) ;;; Generated autoloads from image.el (autoload 'image-type-from-data "image" "\ @@ -15012,7 +15070,7 @@ Example: \(fn SYMBOL SPECS &optional DOC)" nil t) -(put 'defimage 'doc-string-elt '3) +(function-put 'defimage 'doc-string-elt '3) (autoload 'imagemagick-register-types "image" "\ Register file types that can be handled by ImageMagick. @@ -15030,8 +15088,8 @@ If Emacs is compiled without ImageMagick support, this does nothing. ;;;*** -;;;### (autoloads nil "image-dired" "image-dired.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "image-dired" "image-dired.el" (21194 37048 +;;;;;; 599945 0)) ;;; Generated autoloads from image-dired.el (push (purecopy '(image-dired 0 4 11)) package--builtin-versions) @@ -15168,7 +15226,7 @@ easy-to-use form. ;;;*** -;;;### (autoloads nil "image-file" "image-file.el" (21291 53104 0 +;;;### (autoloads nil "image-file" "image-file.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from image-file.el @@ -15231,7 +15289,7 @@ An image file is one whose name has an extension in ;;;*** -;;;### (autoloads nil "image-mode" "image-mode.el" (21291 53104 0 +;;;### (autoloads nil "image-mode" "image-mode.el" (21334 16805 699731 ;;;;;; 0)) ;;; Generated autoloads from image-mode.el @@ -15279,7 +15337,7 @@ on these modes. ;;;*** -;;;### (autoloads nil "imenu" "imenu.el" (21291 53104 0 0)) +;;;### (autoloads nil "imenu" "imenu.el" (21257 55477 969423 0)) ;;; Generated autoloads from imenu.el (defvar imenu-sort-function nil "\ @@ -15417,8 +15475,8 @@ for more information. ;;;*** -;;;### (autoloads nil "ind-util" "language/ind-util.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "ind-util" "language/ind-util.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from language/ind-util.el (autoload 'indian-compose-region "ind-util" "\ @@ -15448,8 +15506,8 @@ Convert old Emacs Devanagari characters to UCS. ;;;*** -;;;### (autoloads nil "inf-lisp" "progmodes/inf-lisp.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "inf-lisp" "progmodes/inf-lisp.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from progmodes/inf-lisp.el (autoload 'inferior-lisp "inf-lisp" "\ @@ -15467,7 +15525,7 @@ of `inferior-lisp-program'). Runs the hooks from ;;;*** -;;;### (autoloads nil "info" "info.el" (21291 53104 0 0)) +;;;### (autoloads nil "info" "info.el" (21359 20005 772941 0)) ;;; Generated autoloads from info.el (defcustom Info-default-directory-list (let* ((config-dir (file-name-as-directory (or (and (featurep 'ns) (let ((dir (expand-file-name "../info" data-directory))) (if (file-directory-p dir) dir))) configure-info-directory))) (prefixes (prune-directory-list '("/usr/local/" "/usr/" "/opt/" "/"))) (suffixes '("share/" "" "gnu/" "gnu/lib/" "gnu/lib/emacs/" "emacs/" "lib/" "lib/emacs/")) (standard-info-dirs (apply #'nconc (mapcar (lambda (pfx) (let ((dirs (mapcar (lambda (sfx) (concat pfx sfx "info/")) suffixes))) (prune-directory-list dirs))) prefixes))) (dirs (if (member config-dir standard-info-dirs) (nconc standard-info-dirs (list config-dir)) (cons config-dir standard-info-dirs)))) (if (not (eq system-type 'windows-nt)) dirs (let* ((instdir (file-name-directory invocation-directory)) (dir1 (expand-file-name "../info/" instdir)) (dir2 (expand-file-name "../../../info/" instdir))) (cond ((file-exists-p dir1) (append dirs (list dir1))) ((file-exists-p dir2) (append dirs (list dir2))) (t dirs))))) "\ @@ -15678,7 +15736,8 @@ Otherwise, visit the manual in a new Info buffer. ;;;*** -;;;### (autoloads nil "info-look" "info-look.el" (21291 53104 0 0)) +;;;### (autoloads nil "info-look" "info-look.el" (21238 4664 559807 +;;;;;; 0)) ;;; Generated autoloads from info-look.el (autoload 'info-lookup-reset "info-look" "\ @@ -15725,7 +15784,8 @@ Perform completion on file preceding point. ;;;*** -;;;### (autoloads nil "info-xref" "info-xref.el" (21291 53104 0 0)) +;;;### (autoloads nil "info-xref" "info-xref.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from info-xref.el (push (purecopy '(info-xref 3)) package--builtin-versions) @@ -15808,7 +15868,8 @@ the sources handy. ;;;*** -;;;### (autoloads nil "informat" "informat.el" (21291 53104 0 0)) +;;;### (autoloads nil "informat" "informat.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from informat.el (autoload 'Info-tagify "informat" "\ @@ -15853,8 +15914,8 @@ For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\" ;;;*** -;;;### (autoloads nil "inversion" "cedet/inversion.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "inversion" "cedet/inversion.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from cedet/inversion.el (push (purecopy '(inversion 1 3)) package--builtin-versions) @@ -15866,8 +15927,8 @@ Only checks one based on which kind of Emacs is being run. ;;;*** -;;;### (autoloads nil "isearch-x" "international/isearch-x.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "isearch-x" "international/isearch-x.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from international/isearch-x.el (autoload 'isearch-toggle-specified-input-method "isearch-x" "\ @@ -15887,7 +15948,8 @@ Toggle input method in interactive search. ;;;*** -;;;### (autoloads nil "isearchb" "isearchb.el" (21291 53104 0 0)) +;;;### (autoloads nil "isearchb" "isearchb.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from isearchb.el (push (purecopy '(isearchb 1 5)) package--builtin-versions) @@ -15901,8 +15963,8 @@ accessed via isearchb. ;;;*** -;;;### (autoloads nil "iso-cvt" "international/iso-cvt.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "iso-cvt" "international/iso-cvt.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from international/iso-cvt.el (autoload 'iso-spanish "iso-cvt" "\ @@ -15993,15 +16055,15 @@ Add submenus to the File menu, to convert to and from various formats. ;;;*** ;;;### (autoloads nil "iso-transl" "international/iso-transl.el" -;;;;;; (21291 53104 0 0)) +;;;;;; (21240 46395 727291 0)) ;;; Generated autoloads from international/iso-transl.el (define-key key-translation-map "\C-x8" 'iso-transl-ctl-x-8-map) (autoload 'iso-transl-ctl-x-8-map "iso-transl" "Keymap for C-x 8 prefix." t 'keymap) ;;;*** -;;;### (autoloads nil "ispell" "textmodes/ispell.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "ispell" "textmodes/ispell.el" (21356 43818 +;;;;;; 957743 0)) ;;; Generated autoloads from textmodes/ispell.el (put 'ispell-check-comments 'safe-local-variable (lambda (a) (memq a '(nil t exclusive)))) @@ -16234,8 +16296,36 @@ You can bind this to the key C-c i in GNUS or mail by adding to ;;;*** -;;;### (autoloads nil "japan-util" "language/japan-util.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "iswitchb" "obsolete/iswitchb.el" (21300 29848 +;;;;;; 351552 156000)) +;;; Generated autoloads from obsolete/iswitchb.el + +(defvar iswitchb-mode nil "\ +Non-nil if Iswitchb mode is enabled. +See the command `iswitchb-mode' for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `iswitchb-mode'.") + +(custom-autoload 'iswitchb-mode "iswitchb" nil) + +(autoload 'iswitchb-mode "iswitchb" "\ +Toggle Iswitchb mode. +With a prefix argument ARG, enable Iswitchb mode if ARG is +positive, and disable it otherwise. If called from Lisp, enable +the mode if ARG is omitted or nil. + +Iswitchb mode is a global minor mode that enables switching +between buffers using substrings. See `iswitchb' for details. + +\(fn &optional ARG)" t nil) + +(make-obsolete 'iswitchb-mode "use `icomplete-mode' or `ido-mode' instead." "24.4") + +;;;*** + +;;;### (autoloads nil "japan-util" "language/japan-util.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from language/japan-util.el (autoload 'setup-japanese-environment-internal "japan-util" "\ @@ -16312,7 +16402,8 @@ If non-nil, second arg INITIAL-INPUT is a string to insert before reading. ;;;*** -;;;### (autoloads nil "jka-compr" "jka-compr.el" (21291 53104 0 0)) +;;;### (autoloads nil "jka-compr" "jka-compr.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from jka-compr.el (defvar jka-compr-inhibit nil "\ @@ -16335,7 +16426,8 @@ by `jka-compr-installed'. ;;;*** -;;;### (autoloads nil "js" "progmodes/js.el" (21387 3002 678518 0)) +;;;### (autoloads nil "js" "progmodes/js.el" (21350 58112 380040 +;;;;;; 0)) ;;; Generated autoloads from progmodes/js.el (push (purecopy '(js 9)) package--builtin-versions) @@ -16347,14 +16439,14 @@ Major mode for editing JavaScript. ;;;*** -;;;### (autoloads nil "json" "json.el" (21291 53104 0 0)) +;;;### (autoloads nil "json" "json.el" (21187 63826 213216 0)) ;;; Generated autoloads from json.el (push (purecopy '(json 1 4)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "keypad" "emulation/keypad.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "keypad" "emulation/keypad.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from emulation/keypad.el (defvar keypad-setup nil "\ @@ -16409,8 +16501,8 @@ the decimal key on the keypad is mapped to DECIMAL instead of `.' ;;;*** -;;;### (autoloads nil "kinsoku" "international/kinsoku.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "kinsoku" "international/kinsoku.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from international/kinsoku.el (autoload 'kinsoku "kinsoku" "\ @@ -16431,7 +16523,7 @@ the context of text formatting. ;;;*** -;;;### (autoloads nil "kkc" "international/kkc.el" (21291 53104 0 +;;;### (autoloads nil "kkc" "international/kkc.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from international/kkc.el @@ -16454,7 +16546,7 @@ and the return value is the length of the conversion. ;;;*** -;;;### (autoloads nil "kmacro" "kmacro.el" (21291 53104 0 0)) +;;;### (autoloads nil "kmacro" "kmacro.el" (21244 11875 194797 0)) ;;; Generated autoloads from kmacro.el (global-set-key "\C-x(" 'kmacro-start-macro) (global-set-key "\C-x)" 'kmacro-end-macro) @@ -16566,8 +16658,8 @@ If kbd macro currently being defined end it before activating it. ;;;*** -;;;### (autoloads nil "korea-util" "language/korea-util.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "korea-util" "language/korea-util.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from language/korea-util.el (defvar default-korean-keyboard (purecopy (if (string-match "3" (or (getenv "HANGUL_KEYBOARD_TYPE") "")) "3" "")) "\ @@ -16581,8 +16673,8 @@ The kind of Korean keyboard for Korean input method. ;;;*** -;;;### (autoloads nil "landmark" "play/landmark.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "landmark" "play/landmark.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from play/landmark.el (defalias 'landmark-repeat 'landmark-test-run) @@ -16612,8 +16704,8 @@ Use \\[describe-mode] for more info. ;;;*** -;;;### (autoloads nil "lao-util" "language/lao-util.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "lao-util" "language/lao-util.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from language/lao-util.el (autoload 'lao-compose-string "lao-util" "\ @@ -16650,8 +16742,8 @@ Transcribe Romanized Lao string STR to Lao character string. ;;;*** -;;;### (autoloads nil "latexenc" "international/latexenc.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "latexenc" "international/latexenc.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from international/latexenc.el (defvar latex-inputenc-coding-alist (purecopy '(("ansinew" . windows-1252) ("applemac" . mac-roman) ("ascii" . us-ascii) ("cp1250" . windows-1250) ("cp1252" . windows-1252) ("cp1257" . cp1257) ("cp437de" . cp437) ("cp437" . cp437) ("cp850" . cp850) ("cp852" . cp852) ("cp858" . cp858) ("cp865" . cp865) ("latin1" . iso-8859-1) ("latin2" . iso-8859-2) ("latin3" . iso-8859-3) ("latin4" . iso-8859-4) ("latin5" . iso-8859-5) ("latin9" . iso-8859-15) ("next" . next) ("utf8" . utf-8) ("utf8x" . utf-8))) "\ @@ -16683,7 +16775,7 @@ coding system names is determined from `latex-inputenc-coding-alist'. ;;;*** ;;;### (autoloads nil "latin1-disp" "international/latin1-disp.el" -;;;;;; (21291 53104 0 0)) +;;;;;; (21187 63826 213216 0)) ;;; Generated autoloads from international/latin1-disp.el (defvar latin1-display nil "\ @@ -16724,8 +16816,8 @@ use either \\[customize] or the function `latin1-display'.") ;;;*** -;;;### (autoloads nil "ld-script" "progmodes/ld-script.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "ld-script" "progmodes/ld-script.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from progmodes/ld-script.el (autoload 'ld-script-mode "ld-script" "\ @@ -16735,7 +16827,7 @@ A major mode to edit GNU ld script files ;;;*** -;;;### (autoloads nil "life" "play/life.el" (21291 53104 0 0)) +;;;### (autoloads nil "life" "play/life.el" (21240 46395 727291 0)) ;;; Generated autoloads from play/life.el (autoload 'life "life" "\ @@ -16748,7 +16840,7 @@ generations (this defaults to 1). ;;;*** -;;;### (autoloads nil "linum" "linum.el" (21291 53104 0 0)) +;;;### (autoloads nil "linum" "linum.el" (21240 46395 727291 0)) ;;; Generated autoloads from linum.el (push (purecopy '(linum 0 9 24)) package--builtin-versions) @@ -16785,7 +16877,8 @@ See `linum-mode' for more information on Linum mode. ;;;*** -;;;### (autoloads nil "loadhist" "loadhist.el" (21291 53104 0 0)) +;;;### (autoloads nil "loadhist" "loadhist.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from loadhist.el (autoload 'unload-feature "loadhist" "\ @@ -16816,7 +16909,7 @@ something strange, such as redefining an Emacs function. ;;;*** -;;;### (autoloads nil "locate" "locate.el" (21291 53104 0 0)) +;;;### (autoloads nil "locate" "locate.el" (21187 63826 213216 0)) ;;; Generated autoloads from locate.el (defvar locate-ls-subdir-switches (purecopy "-al") "\ @@ -16868,7 +16961,7 @@ except that FILTER is not optional. ;;;*** -;;;### (autoloads nil "log-edit" "vc/log-edit.el" (21291 53104 0 +;;;### (autoloads nil "log-edit" "vc/log-edit.el" (21239 25528 651427 ;;;;;; 0)) ;;; Generated autoloads from vc/log-edit.el @@ -16900,7 +16993,7 @@ done. Otherwise, it uses the current buffer. ;;;*** -;;;### (autoloads nil "log-view" "vc/log-view.el" (21291 53104 0 +;;;### (autoloads nil "log-view" "vc/log-view.el" (21195 57908 940910 ;;;;;; 0)) ;;; Generated autoloads from vc/log-view.el @@ -16911,7 +17004,7 @@ Major mode for browsing CVS log output. ;;;*** -;;;### (autoloads nil "lpr" "lpr.el" (21291 53104 0 0)) +;;;### (autoloads nil "lpr" "lpr.el" (21240 46395 727291 0)) ;;; Generated autoloads from lpr.el (defvar lpr-windows-system (memq system-type '(ms-dos windows-nt)) "\ @@ -17006,7 +17099,8 @@ for further customization of the printer command. ;;;*** -;;;### (autoloads nil "ls-lisp" "ls-lisp.el" (21291 53104 0 0)) +;;;### (autoloads nil "ls-lisp" "ls-lisp.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from ls-lisp.el (defvar ls-lisp-support-shell-wildcards t "\ @@ -17017,7 +17111,7 @@ Otherwise they are treated as Emacs regexps (for backward compatibility).") ;;;*** -;;;### (autoloads nil "lunar" "calendar/lunar.el" (21291 53104 0 +;;;### (autoloads nil "lunar" "calendar/lunar.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from calendar/lunar.el @@ -17032,8 +17126,8 @@ This function is suitable for execution in an init file. ;;;*** -;;;### (autoloads nil "m4-mode" "progmodes/m4-mode.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "m4-mode" "progmodes/m4-mode.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from progmodes/m4-mode.el (autoload 'm4-mode "m4-mode" "\ @@ -17043,7 +17137,7 @@ A major mode to edit m4 macro files. ;;;*** -;;;### (autoloads nil "macros" "macros.el" (21291 53104 0 0)) +;;;### (autoloads nil "macros" "macros.el" (21240 46395 727291 0)) ;;; Generated autoloads from macros.el (autoload 'name-last-kbd-macro "macros" "\ @@ -17132,8 +17226,8 @@ and then select the region of un-tablified names and use ;;;*** -;;;### (autoloads nil "mail-extr" "mail/mail-extr.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "mail-extr" "mail/mail-extr.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from mail/mail-extr.el (autoload 'mail-extract-address-components "mail-extr" "\ @@ -17163,8 +17257,8 @@ Convert mail domain DOMAIN to the country it corresponds to. ;;;*** -;;;### (autoloads nil "mail-hist" "mail/mail-hist.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "mail-hist" "mail/mail-hist.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from mail/mail-hist.el (autoload 'mail-hist-define-keys "mail-hist" "\ @@ -17193,8 +17287,8 @@ This function normally would be called when the message is sent. ;;;*** -;;;### (autoloads nil "mail-utils" "mail/mail-utils.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "mail-utils" "mail/mail-utils.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from mail/mail-utils.el (defvar mail-use-rfc822 nil "\ @@ -17268,8 +17362,8 @@ matches may be returned from the message body. ;;;*** -;;;### (autoloads nil "mailabbrev" "mail/mailabbrev.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "mailabbrev" "mail/mailabbrev.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from mail/mailabbrev.el (defvar mail-abbrevs-mode nil "\ @@ -17318,8 +17412,8 @@ double-quotes. ;;;*** -;;;### (autoloads nil "mailalias" "mail/mailalias.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "mailalias" "mail/mailalias.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from mail/mailalias.el (defvar mail-complete-style 'angles "\ @@ -17372,8 +17466,8 @@ current header, calls `mail-complete-function' and passes prefix ARG if any. ;;;*** -;;;### (autoloads nil "mailclient" "mail/mailclient.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "mailclient" "mail/mailclient.el" (21215 8898 +;;;;;; 840126 623000)) ;;; Generated autoloads from mail/mailclient.el (autoload 'mailclient-send-it "mailclient" "\ @@ -17385,8 +17479,8 @@ The mail client is taken to be the handler of mailto URLs. ;;;*** -;;;### (autoloads nil "make-mode" "progmodes/make-mode.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "make-mode" "progmodes/make-mode.el" (21240 +;;;;;; 46395 727291 0)) ;;; Generated autoloads from progmodes/make-mode.el (autoload 'makefile-mode "make-mode" "\ @@ -17503,7 +17597,8 @@ An adapted `makefile-mode' that knows about imake. ;;;*** -;;;### (autoloads nil "makesum" "makesum.el" (21291 53104 0 0)) +;;;### (autoloads nil "makesum" "makesum.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from makesum.el (autoload 'make-command-summary "makesum" "\ @@ -17514,7 +17609,7 @@ Previous contents of that buffer are killed first. ;;;*** -;;;### (autoloads nil "man" "man.el" (21291 53104 0 0)) +;;;### (autoloads nil "man" "man.el" (21356 43818 957743 0)) ;;; Generated autoloads from man.el (defalias 'manual-entry 'man) @@ -17568,7 +17663,7 @@ Default bookmark handler for Man buffers. ;;;*** -;;;### (autoloads nil "master" "master.el" (21291 53104 0 0)) +;;;### (autoloads nil "master" "master.el" (21187 63826 213216 0)) ;;; Generated autoloads from master.el (push (purecopy '(master 1 0 2)) package--builtin-versions) @@ -17591,7 +17686,8 @@ yourself the value of `master-of' by calling `master-show-slave'. ;;;*** -;;;### (autoloads nil "mb-depth" "mb-depth.el" (21291 53104 0 0)) +;;;### (autoloads nil "mb-depth" "mb-depth.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from mb-depth.el (defvar minibuffer-depth-indicate-mode nil "\ @@ -17618,13 +17714,13 @@ recursion depth in the minibuffer prompt. This is only useful if ;;;*** -;;;### (autoloads nil "md4" "md4.el" (21291 53104 0 0)) +;;;### (autoloads nil "md4" "md4.el" (21187 63826 213216 0)) ;;; Generated autoloads from md4.el (push (purecopy '(md4 1 0)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "message" "gnus/message.el" (21291 53104 0 +;;;### (autoloads nil "message" "gnus/message.el" (21326 22692 123234 ;;;;;; 0)) ;;; Generated autoloads from gnus/message.el @@ -17790,8 +17886,8 @@ which specify the range to operate on. ;;;*** -;;;### (autoloads nil "meta-mode" "progmodes/meta-mode.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "meta-mode" "progmodes/meta-mode.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from progmodes/meta-mode.el (push (purecopy '(meta-mode 1 0)) package--builtin-versions) @@ -17807,8 +17903,8 @@ Major mode for editing MetaPost sources. ;;;*** -;;;### (autoloads nil "metamail" "mail/metamail.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "metamail" "mail/metamail.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from mail/metamail.el (autoload 'metamail-interpret-header "metamail" "\ @@ -17851,7 +17947,7 @@ redisplayed as output is inserted. ;;;*** -;;;### (autoloads nil "mh-comp" "mh-e/mh-comp.el" (21291 53104 0 +;;;### (autoloads nil "mh-comp" "mh-e/mh-comp.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from mh-e/mh-comp.el @@ -17942,7 +18038,7 @@ delete the draft message. ;;;*** -;;;### (autoloads nil "mh-e" "mh-e/mh-e.el" (21291 53104 0 0)) +;;;### (autoloads nil "mh-e" "mh-e/mh-e.el" (21356 43818 957743 0)) ;;; Generated autoloads from mh-e/mh-e.el (push (purecopy '(mh-e 8 5 -4)) package--builtin-versions) @@ -17959,8 +18055,8 @@ Display version information about MH-E and the MH mail handling system. ;;;*** -;;;### (autoloads nil "mh-folder" "mh-e/mh-folder.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "mh-folder" "mh-e/mh-folder.el" (21286 52150 +;;;;;; 476720 0)) ;;; Generated autoloads from mh-e/mh-folder.el (autoload 'mh-rmail "mh-folder" "\ @@ -18041,7 +18137,8 @@ perform the operation on all messages in that region. ;;;*** -;;;### (autoloads nil "midnight" "midnight.el" (21291 53104 0 0)) +;;;### (autoloads nil "midnight" "midnight.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from midnight.el (autoload 'clean-buffer-list "midnight" "\ @@ -18067,8 +18164,8 @@ to its second argument TM. ;;;*** -;;;### (autoloads nil "minibuf-eldef" "minibuf-eldef.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "minibuf-eldef" "minibuf-eldef.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from minibuf-eldef.el (defvar minibuffer-electric-default-mode nil "\ @@ -18097,7 +18194,7 @@ is modified to remove the default indication. ;;;*** -;;;### (autoloads nil "misc" "misc.el" (21291 53104 0 0)) +;;;### (autoloads nil "misc" "misc.el" (21240 46395 727291 0)) ;;; Generated autoloads from misc.el (autoload 'butterfly "misc" "\ @@ -18125,7 +18222,8 @@ The return value is always nil. ;;;*** -;;;### (autoloads nil "misearch" "misearch.el" (21291 53104 0 0)) +;;;### (autoloads nil "misearch" "misearch.el" (21245 64312 799897 +;;;;;; 0)) ;;; Generated autoloads from misearch.el (add-hook 'isearch-mode-hook 'multi-isearch-setup) @@ -18206,8 +18304,8 @@ whose file names match the specified wildcard. ;;;*** -;;;### (autoloads nil "mixal-mode" "progmodes/mixal-mode.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "mixal-mode" "progmodes/mixal-mode.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from progmodes/mixal-mode.el (push (purecopy '(mixal-mode 0 1)) package--builtin-versions) @@ -18218,8 +18316,8 @@ Major mode for the mixal asm language. ;;;*** -;;;### (autoloads nil "mm-encode" "gnus/mm-encode.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "mm-encode" "gnus/mm-encode.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from gnus/mm-encode.el (autoload 'mm-default-file-encoding "mm-encode" "\ @@ -18229,8 +18327,8 @@ Return a default encoding for FILE. ;;;*** -;;;### (autoloads nil "mm-extern" "gnus/mm-extern.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "mm-extern" "gnus/mm-extern.el" (21296 1575 +;;;;;; 438327 0)) ;;; Generated autoloads from gnus/mm-extern.el (autoload 'mm-extern-cache-contents "mm-extern" "\ @@ -18248,8 +18346,8 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing. ;;;*** -;;;### (autoloads nil "mm-partial" "gnus/mm-partial.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "mm-partial" "gnus/mm-partial.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from gnus/mm-partial.el (autoload 'mm-inline-partial "mm-partial" "\ @@ -18262,7 +18360,8 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing. ;;;*** -;;;### (autoloads nil "mm-url" "gnus/mm-url.el" (21291 53104 0 0)) +;;;### (autoloads nil "mm-url" "gnus/mm-url.el" (21296 1575 438327 +;;;;;; 0)) ;;; Generated autoloads from gnus/mm-url.el (autoload 'mm-url-insert-file-contents "mm-url" "\ @@ -18278,7 +18377,8 @@ Insert file contents of URL using `mm-url-program'. ;;;*** -;;;### (autoloads nil "mm-uu" "gnus/mm-uu.el" (21291 53104 0 0)) +;;;### (autoloads nil "mm-uu" "gnus/mm-uu.el" (21363 17065 850322 +;;;;;; 0)) ;;; Generated autoloads from gnus/mm-uu.el (autoload 'mm-uu-dissect "mm-uu" "\ @@ -18297,7 +18397,7 @@ Assume text has been decoded if DECODED is non-nil. ;;;*** -;;;### (autoloads nil "mml" "gnus/mml.el" (21291 53104 0 0)) +;;;### (autoloads nil "mml" "gnus/mml.el" (21296 1575 438327 0)) ;;; Generated autoloads from gnus/mml.el (autoload 'mml-to-mime "mml" "\ @@ -18322,7 +18422,7 @@ body) or \"attachment\" (separate from the body). ;;;*** -;;;### (autoloads nil "mml1991" "gnus/mml1991.el" (21291 53104 0 +;;;### (autoloads nil "mml1991" "gnus/mml1991.el" (21296 1575 438327 ;;;;;; 0)) ;;; Generated autoloads from gnus/mml1991.el @@ -18338,7 +18438,7 @@ body) or \"attachment\" (separate from the body). ;;;*** -;;;### (autoloads nil "mml2015" "gnus/mml2015.el" (21291 53104 0 +;;;### (autoloads nil "mml2015" "gnus/mml2015.el" (21356 43818 957743 ;;;;;; 0)) ;;; Generated autoloads from gnus/mml2015.el @@ -18379,16 +18479,16 @@ body) or \"attachment\" (separate from the body). ;;;*** -;;;### (autoloads nil "mode-local" "cedet/mode-local.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "mode-local" "cedet/mode-local.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from cedet/mode-local.el (put 'define-overloadable-function 'doc-string-elt 3) ;;;*** -;;;### (autoloads nil "modula2" "progmodes/modula2.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "modula2" "progmodes/modula2.el" (21282 19826 +;;;;;; 403614 0)) ;;; Generated autoloads from progmodes/modula2.el (defalias 'modula-2-mode 'm2-mode) @@ -18421,7 +18521,8 @@ followed by the first character of the construct. ;;;*** -;;;### (autoloads nil "morse" "play/morse.el" (21291 53104 0 0)) +;;;### (autoloads nil "morse" "play/morse.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from play/morse.el (autoload 'morse-region "morse" "\ @@ -18446,7 +18547,7 @@ Convert NATO phonetic alphabet in region to ordinary ASCII text. ;;;*** -;;;### (autoloads nil "mouse-drag" "mouse-drag.el" (21291 53104 0 +;;;### (autoloads nil "mouse-drag" "mouse-drag.el" (21202 31159 541460 ;;;;;; 0)) ;;; Generated autoloads from mouse-drag.el @@ -18494,7 +18595,7 @@ To test this function, evaluate: ;;;*** -;;;### (autoloads nil "mpc" "mpc.el" (21346 62196 0 0)) +;;;### (autoloads nil "mpc" "mpc.el" (21361 61732 646433 0)) ;;; Generated autoloads from mpc.el (autoload 'mpc "mpc" "\ @@ -18504,7 +18605,7 @@ Main entry point for MPC. ;;;*** -;;;### (autoloads nil "mpuz" "play/mpuz.el" (21291 53104 0 0)) +;;;### (autoloads nil "mpuz" "play/mpuz.el" (21187 63826 213216 0)) ;;; Generated autoloads from play/mpuz.el (autoload 'mpuz "mpuz" "\ @@ -18514,7 +18615,7 @@ Multiplication puzzle with GNU Emacs. ;;;*** -;;;### (autoloads nil "msb" "msb.el" (21291 53104 0 0)) +;;;### (autoloads nil "msb" "msb.el" (21240 46395 727291 0)) ;;; Generated autoloads from msb.el (defvar msb-mode nil "\ @@ -18539,8 +18640,8 @@ different buffer menu using the function `msb'. ;;;*** -;;;### (autoloads nil "mule-diag" "international/mule-diag.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "mule-diag" "international/mule-diag.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from international/mule-diag.el (autoload 'list-character-sets "mule-diag" "\ @@ -18672,8 +18773,8 @@ The default is 20. If LIMIT is negative, do not limit the listing. ;;;*** -;;;### (autoloads nil "mule-util" "international/mule-util.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "mule-util" "international/mule-util.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from international/mule-util.el (defsubst string-to-list (string) "\ @@ -18804,8 +18905,8 @@ per-character basis, this may not be accurate. ;;;*** -;;;### (autoloads nil "net-utils" "net/net-utils.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "net-utils" "net/net-utils.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from net/net-utils.el (autoload 'ifconfig "net-utils" "\ @@ -18899,7 +19000,8 @@ Open a network connection to HOST on PORT. ;;;*** -;;;### (autoloads nil "netrc" "net/netrc.el" (21291 53104 0 0)) +;;;### (autoloads nil "netrc" "net/netrc.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from net/netrc.el (autoload 'netrc-credentials "netrc" "\ @@ -18911,8 +19013,8 @@ listed in the PORTS list. ;;;*** -;;;### (autoloads nil "network-stream" "net/network-stream.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "network-stream" "net/network-stream.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from net/network-stream.el (autoload 'open-network-stream "network-stream" "\ @@ -19005,8 +19107,8 @@ a greeting from the server. ;;;*** -;;;### (autoloads nil "newst-backend" "net/newst-backend.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "newst-backend" "net/newst-backend.el" (21260 +;;;;;; 57908 370145 500000)) ;;; Generated autoloads from net/newst-backend.el (autoload 'newsticker-running-p "newst-backend" "\ @@ -19028,7 +19130,7 @@ Run `newsticker-start-hook' if newsticker was not running already. ;;;*** ;;;### (autoloads nil "newst-plainview" "net/newst-plainview.el" -;;;;;; (21291 53104 0 0)) +;;;;;; (21187 63826 213216 0)) ;;; Generated autoloads from net/newst-plainview.el (autoload 'newsticker-plainview "newst-plainview" "\ @@ -19038,8 +19140,8 @@ Start newsticker plainview. ;;;*** -;;;### (autoloads nil "newst-reader" "net/newst-reader.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "newst-reader" "net/newst-reader.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from net/newst-reader.el (autoload 'newsticker-show-news "newst-reader" "\ @@ -19049,8 +19151,8 @@ Start reading news. You may want to bind this to a key. ;;;*** -;;;### (autoloads nil "newst-ticker" "net/newst-ticker.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "newst-ticker" "net/newst-ticker.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from net/newst-ticker.el (autoload 'newsticker-ticker-running-p "newst-ticker" "\ @@ -19070,8 +19172,8 @@ running already. ;;;*** -;;;### (autoloads nil "newst-treeview" "net/newst-treeview.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "newst-treeview" "net/newst-treeview.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from net/newst-treeview.el (autoload 'newsticker-treeview "newst-treeview" "\ @@ -19081,14 +19183,14 @@ Start newsticker treeview. ;;;*** -;;;### (autoloads nil "newsticker" "net/newsticker.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "newsticker" "net/newsticker.el" (21194 37048 +;;;;;; 599945 0)) ;;; Generated autoloads from net/newsticker.el (push (purecopy '(newsticker 1 99)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "nndiary" "gnus/nndiary.el" (21291 53104 0 +;;;### (autoloads nil "nndiary" "gnus/nndiary.el" (21204 37210 187838 ;;;;;; 0)) ;;; Generated autoloads from gnus/nndiary.el @@ -19099,7 +19201,8 @@ Generate NOV databases in all nndiary directories. ;;;*** -;;;### (autoloads nil "nndoc" "gnus/nndoc.el" (21291 53104 0 0)) +;;;### (autoloads nil "nndoc" "gnus/nndoc.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from gnus/nndoc.el (autoload 'nndoc-add-type "nndoc" "\ @@ -19113,8 +19216,8 @@ symbol in the alist. ;;;*** -;;;### (autoloads nil "nnfolder" "gnus/nnfolder.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "nnfolder" "gnus/nnfolder.el" (21296 1575 438327 +;;;;;; 0)) ;;; Generated autoloads from gnus/nnfolder.el (autoload 'nnfolder-generate-active-file "nnfolder" "\ @@ -19125,7 +19228,7 @@ This command does not work if you use short group names. ;;;*** -;;;### (autoloads nil "nnml" "gnus/nnml.el" (21291 53104 0 0)) +;;;### (autoloads nil "nnml" "gnus/nnml.el" (21187 63826 213216 0)) ;;; Generated autoloads from gnus/nnml.el (autoload 'nnml-generate-nov-databases "nnml" "\ @@ -19135,7 +19238,7 @@ Generate NOV databases in all nnml directories. ;;;*** -;;;### (autoloads nil "novice" "novice.el" (21291 53104 0 0)) +;;;### (autoloads nil "novice" "novice.el" (21240 46395 727291 0)) ;;; Generated autoloads from novice.el (define-obsolete-variable-alias 'disabled-command-hook 'disabled-command-function "22.1") @@ -19167,8 +19270,8 @@ future sessions. ;;;*** -;;;### (autoloads nil "nroff-mode" "textmodes/nroff-mode.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "nroff-mode" "textmodes/nroff-mode.el" (21240 +;;;;;; 46395 727291 0)) ;;; Generated autoloads from textmodes/nroff-mode.el (autoload 'nroff-mode "nroff-mode" "\ @@ -19182,14 +19285,14 @@ closing requests for requests that are used in matched pairs. ;;;*** -;;;### (autoloads nil "ntlm" "net/ntlm.el" (21291 53104 0 0)) +;;;### (autoloads nil "ntlm" "net/ntlm.el" (21187 63826 213216 0)) ;;; Generated autoloads from net/ntlm.el (push (purecopy '(ntlm 1 0)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "nxml-glyph" "nxml/nxml-glyph.el" (21291 57968 -;;;;;; 0 0)) +;;;### (autoloads nil "nxml-glyph" "nxml/nxml-glyph.el" (21293 25385 +;;;;;; 120083 0)) ;;; Generated autoloads from nxml/nxml-glyph.el (autoload 'nxml-glyph-display-string "nxml-glyph" "\ @@ -19201,8 +19304,8 @@ Return nil if the face cannot display a glyph for N. ;;;*** -;;;### (autoloads nil "nxml-mode" "nxml/nxml-mode.el" (21373 1839 -;;;;;; 721535 649000)) +;;;### (autoloads nil "nxml-mode" "nxml/nxml-mode.el" (21383 2343 +;;;;;; 498187 0)) ;;; Generated autoloads from nxml/nxml-mode.el (autoload 'nxml-mode "nxml-mode" "\ @@ -19262,8 +19365,8 @@ Many aspects this mode can be customized using ;;;*** -;;;### (autoloads nil "nxml-uchnm" "nxml/nxml-uchnm.el" (21291 57968 -;;;;;; 0 0)) +;;;### (autoloads nil "nxml-uchnm" "nxml/nxml-uchnm.el" (21293 25385 +;;;;;; 120083 0)) ;;; Generated autoloads from nxml/nxml-uchnm.el (autoload 'nxml-enable-unicode-char-name-sets "nxml-uchnm" "\ @@ -19275,8 +19378,8 @@ the variable `nxml-enabled-unicode-blocks'. ;;;*** -;;;### (autoloads nil "octave" "progmodes/octave.el" (21321 34341 -;;;;;; 0 0)) +;;;### (autoloads nil "octave" "progmodes/octave.el" (21322 25639 +;;;;;; 363230 0)) ;;; Generated autoloads from progmodes/octave.el (autoload 'octave-mode "octave" "\ @@ -19313,8 +19416,8 @@ startup file, `~/.emacs-octave'. ;;;*** -;;;### (autoloads nil "opascal" "progmodes/opascal.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "opascal" "progmodes/opascal.el" (21282 19826 +;;;;;; 403614 0)) ;;; Generated autoloads from progmodes/opascal.el (define-obsolete-function-alias 'delphi-mode 'opascal-mode "24.4") @@ -19349,7 +19452,7 @@ Coloring: ;;;*** -;;;### (autoloads nil "org" "org/org.el" (21341 23900 0 0)) +;;;### (autoloads nil "org" "org/org.el" (21383 2343 498187 0)) ;;; Generated autoloads from org/org.el (autoload 'org-babel-do-load-languages "org" "\ @@ -19570,8 +19673,8 @@ Call the customize function with org as argument. ;;;*** -;;;### (autoloads nil "org-agenda" "org/org-agenda.el" (21341 23900 -;;;;;; 0 0)) +;;;### (autoloads nil "org-agenda" "org/org-agenda.el" (21335 37672 +;;;;;; 97862 0)) ;;; Generated autoloads from org/org-agenda.el (autoload 'org-toggle-sticky-agenda "org-agenda" "\ @@ -19844,8 +19947,8 @@ to override `appt-message-warning-time'. ;;;*** -;;;### (autoloads nil "org-capture" "org/org-capture.el" (21341 23900 -;;;;;; 0 0)) +;;;### (autoloads nil "org-capture" "org/org-capture.el" (21335 37672 +;;;;;; 97862 0)) ;;; Generated autoloads from org/org-capture.el (autoload 'org-capture-string "org-capture" "\ @@ -19887,8 +19990,8 @@ Set `org-capture-templates' to be similar to `org-remember-templates'. ;;;*** -;;;### (autoloads nil "org-colview" "org/org-colview.el" (21341 23900 -;;;;;; 0 0)) +;;;### (autoloads nil "org-colview" "org/org-colview.el" (21335 37672 +;;;;;; 97862 0)) ;;; Generated autoloads from org/org-colview.el (autoload 'org-columns-remove-overlays "org-colview" "\ @@ -19951,8 +20054,8 @@ Turn on or update column view in the agenda. ;;;*** -;;;### (autoloads nil "org-compat" "org/org-compat.el" (21341 23900 -;;;;;; 0 0)) +;;;### (autoloads nil "org-compat" "org/org-compat.el" (21383 2343 +;;;;;; 498187 0)) ;;; Generated autoloads from org/org-compat.el (autoload 'org-check-version "org-compat" "\ @@ -19962,7 +20065,7 @@ Try very hard to provide sensible version strings. ;;;*** -;;;### (autoloads nil "org-macs" "org/org-macs.el" (21291 53104 0 +;;;### (autoloads nil "org-macs" "org/org-macs.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from org/org-macs.el @@ -19973,8 +20076,8 @@ Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX a ;;;*** -;;;### (autoloads nil "org-version" "org/org-version.el" (21341 23900 -;;;;;; 0 0)) +;;;### (autoloads nil "org-version" "org/org-version.el" (21335 37672 +;;;;;; 97862 0)) ;;; Generated autoloads from org/org-version.el (autoload 'org-release "org-version" "\ @@ -19991,7 +20094,8 @@ The Git version of org-mode. ;;;*** -;;;### (autoloads nil "outline" "outline.el" (21291 53104 0 0)) +;;;### (autoloads nil "outline" "outline.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from outline.el (put 'outline-regexp 'safe-local-variable 'stringp) (put 'outline-heading-end-regexp 'safe-local-variable 'stringp) @@ -20052,8 +20156,8 @@ See the command `outline-mode' for more information on this mode. ;;;*** -;;;### (autoloads nil "package" "emacs-lisp/package.el" (21384 26818 -;;;;;; 168916 0)) +;;;### (autoloads nil "package" "emacs-lisp/package.el" (21381 47015 +;;;;;; 637535 0)) ;;; Generated autoloads from emacs-lisp/package.el (push (purecopy '(package 1 0 1)) package--builtin-versions) @@ -20125,7 +20229,7 @@ The list is displayed in a buffer named `*Packages*'. ;;;*** -;;;### (autoloads nil "paren" "paren.el" (21291 53104 0 0)) +;;;### (autoloads nil "paren" "paren.el" (21240 46395 727291 0)) ;;; Generated autoloads from paren.el (defvar show-paren-mode nil "\ @@ -20151,8 +20255,8 @@ matching parenthesis is highlighted in `show-paren-style' after ;;;*** -;;;### (autoloads nil "parse-time" "calendar/parse-time.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "parse-time" "calendar/parse-time.el" (21296 +;;;;;; 1575 438327 0)) ;;; Generated autoloads from calendar/parse-time.el (put 'parse-time-rules 'risky-local-variable t) @@ -20165,8 +20269,8 @@ unknown are returned as nil. ;;;*** -;;;### (autoloads nil "pascal" "progmodes/pascal.el" (21319 19378 -;;;;;; 0 0)) +;;;### (autoloads nil "pascal" "progmodes/pascal.el" (21319 49445 +;;;;;; 508378 0)) ;;; Generated autoloads from progmodes/pascal.el (autoload 'pascal-mode "pascal" "\ @@ -20215,8 +20319,8 @@ See also the user variables `pascal-type-keywords', `pascal-start-keywords' and ;;;*** -;;;### (autoloads nil "password-cache" "password-cache.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "password-cache" "password-cache.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from password-cache.el (defvar password-cache t "\ @@ -20237,8 +20341,8 @@ Check if KEY is in the cache. ;;;*** -;;;### (autoloads nil "pcase" "emacs-lisp/pcase.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "pcase" "emacs-lisp/pcase.el" (21190 39993 +;;;;;; 744837 0)) ;;; Generated autoloads from emacs-lisp/pcase.el (autoload 'pcase "pcase" "\ @@ -20277,7 +20381,7 @@ like `(,a . ,(pred (< a))) or, with more checks: \(fn EXP &rest CASES)" nil t) -(put 'pcase 'lisp-indent-function '1) +(function-put 'pcase 'lisp-indent-function '1) (autoload 'pcase-let* "pcase" "\ Like `let*' but where you can use `pcase' patterns for bindings. @@ -20286,7 +20390,7 @@ of the form (UPAT EXP). \(fn BINDINGS &rest BODY)" nil t) -(put 'pcase-let* 'lisp-indent-function '1) +(function-put 'pcase-let* 'lisp-indent-function '1) (autoload 'pcase-let "pcase" "\ Like `let' but where you can use `pcase' patterns for bindings. @@ -20295,11 +20399,12 @@ of the form (UPAT EXP). \(fn BINDINGS &rest BODY)" nil t) -(put 'pcase-let 'lisp-indent-function '1) +(function-put 'pcase-let 'lisp-indent-function '1) ;;;*** -;;;### (autoloads nil "pcmpl-cvs" "pcmpl-cvs.el" (21291 53104 0 0)) +;;;### (autoloads nil "pcmpl-cvs" "pcmpl-cvs.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from pcmpl-cvs.el (autoload 'pcomplete/cvs "pcmpl-cvs" "\ @@ -20309,7 +20414,8 @@ Completion rules for the `cvs' command. ;;;*** -;;;### (autoloads nil "pcmpl-gnu" "pcmpl-gnu.el" (21291 53104 0 0)) +;;;### (autoloads nil "pcmpl-gnu" "pcmpl-gnu.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from pcmpl-gnu.el (autoload 'pcomplete/gzip "pcmpl-gnu" "\ @@ -20336,8 +20442,8 @@ Completion for the GNU tar utility. ;;;*** -;;;### (autoloads nil "pcmpl-linux" "pcmpl-linux.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "pcmpl-linux" "pcmpl-linux.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from pcmpl-linux.el (autoload 'pcomplete/kill "pcmpl-linux" "\ @@ -20357,7 +20463,8 @@ Completion for GNU/Linux `mount'. ;;;*** -;;;### (autoloads nil "pcmpl-rpm" "pcmpl-rpm.el" (21291 53104 0 0)) +;;;### (autoloads nil "pcmpl-rpm" "pcmpl-rpm.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from pcmpl-rpm.el (autoload 'pcomplete/rpm "pcmpl-rpm" "\ @@ -20367,7 +20474,7 @@ Completion for the `rpm' command. ;;;*** -;;;### (autoloads nil "pcmpl-unix" "pcmpl-unix.el" (21291 53104 0 +;;;### (autoloads nil "pcmpl-unix" "pcmpl-unix.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from pcmpl-unix.el @@ -20423,7 +20530,8 @@ Includes files as well as host names followed by a colon. ;;;*** -;;;### (autoloads nil "pcmpl-x" "pcmpl-x.el" (21291 53104 0 0)) +;;;### (autoloads nil "pcmpl-x" "pcmpl-x.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from pcmpl-x.el (autoload 'pcomplete/tlmgr "pcmpl-x" "\ @@ -20447,7 +20555,8 @@ Completion for the `ag' command. ;;;*** -;;;### (autoloads nil "pcomplete" "pcomplete.el" (21291 53104 0 0)) +;;;### (autoloads nil "pcomplete" "pcomplete.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from pcomplete.el (autoload 'pcomplete "pcomplete" "\ @@ -20504,7 +20613,7 @@ Setup `shell-mode' to use pcomplete. ;;;*** -;;;### (autoloads nil "pcvs" "vc/pcvs.el" (21291 53104 0 0)) +;;;### (autoloads nil "pcvs" "vc/pcvs.el" (21280 13349 392544 0)) ;;; Generated autoloads from vc/pcvs.el (autoload 'cvs-checkout "pcvs" "\ @@ -20579,8 +20688,8 @@ The exact behavior is determined also by `cvs-dired-use-hook'." (when (stringp d ;;;*** -;;;### (autoloads nil "pcvs-defs" "vc/pcvs-defs.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "pcvs-defs" "vc/pcvs-defs.el" (21280 13349 +;;;;;; 392544 0)) ;;; Generated autoloads from vc/pcvs-defs.el (defvar cvs-global-menu (let ((m (make-sparse-keymap "PCL-CVS"))) (define-key m [status] `(menu-item ,(purecopy "Directory Status") cvs-status :help ,(purecopy "A more verbose status of a workarea"))) (define-key m [checkout] `(menu-item ,(purecopy "Checkout Module") cvs-checkout :help ,(purecopy "Check out a module from the repository"))) (define-key m [update] `(menu-item ,(purecopy "Update Directory") cvs-update :help ,(purecopy "Fetch updates from the repository"))) (define-key m [examine] `(menu-item ,(purecopy "Examine Directory") cvs-examine :help ,(purecopy "Examine the current state of a workarea"))) (fset 'cvs-global-menu m)) "\ @@ -20588,8 +20697,8 @@ Global menu used by PCL-CVS.") ;;;*** -;;;### (autoloads nil "perl-mode" "progmodes/perl-mode.el" (21341 -;;;;;; 23900 0 0)) +;;;### (autoloads nil "perl-mode" "progmodes/perl-mode.el" (21339 +;;;;;; 34726 39547 0)) ;;; Generated autoloads from progmodes/perl-mode.el (put 'perl-indent-level 'safe-local-variable 'integerp) (put 'perl-continued-statement-offset 'safe-local-variable 'integerp) @@ -20650,8 +20759,8 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'. ;;;*** -;;;### (autoloads nil "picture" "textmodes/picture.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "picture" "textmodes/picture.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from textmodes/picture.el (autoload 'picture-mode "picture" "\ @@ -20731,7 +20840,7 @@ they are not by default assigned to keys. ;;;*** -;;;### (autoloads nil "plstore" "gnus/plstore.el" (21291 53104 0 +;;;### (autoloads nil "plstore" "gnus/plstore.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from gnus/plstore.el @@ -20747,7 +20856,8 @@ Major mode for editing PLSTORE files. ;;;*** -;;;### (autoloads nil "po" "textmodes/po.el" (21291 53104 0 0)) +;;;### (autoloads nil "po" "textmodes/po.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from textmodes/po.el (autoload 'po-find-file-coding-system "po" "\ @@ -20758,7 +20868,7 @@ Called through `file-coding-system-alist', before the file is visited for real. ;;;*** -;;;### (autoloads nil "pong" "play/pong.el" (21291 53104 0 0)) +;;;### (autoloads nil "pong" "play/pong.el" (21187 63826 213216 0)) ;;; Generated autoloads from play/pong.el (autoload 'pong "pong" "\ @@ -20774,7 +20884,7 @@ pong-mode keybindings:\\<pong-mode-map> ;;;*** -;;;### (autoloads nil "pop3" "gnus/pop3.el" (21291 53104 0 0)) +;;;### (autoloads nil "pop3" "gnus/pop3.el" (21240 46395 727291 0)) ;;; Generated autoloads from gnus/pop3.el (autoload 'pop3-movemail "pop3" "\ @@ -20785,7 +20895,8 @@ Use streaming commands. ;;;*** -;;;### (autoloads nil "pp" "emacs-lisp/pp.el" (21291 53104 0 0)) +;;;### (autoloads nil "pp" "emacs-lisp/pp.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from emacs-lisp/pp.el (autoload 'pp-to-string "pp" "\ @@ -20835,7 +20946,7 @@ Ignores leading comment characters. ;;;*** -;;;### (autoloads nil "printing" "printing.el" (21359 23622 725850 +;;;### (autoloads nil "printing" "printing.el" (21364 37926 837230 ;;;;;; 0)) ;;; Generated autoloads from printing.el (push (purecopy '(printing 6 9 3)) package--builtin-versions) @@ -21424,7 +21535,7 @@ are both set to t. ;;;*** -;;;### (autoloads nil "proced" "proced.el" (21291 53104 0 0)) +;;;### (autoloads nil "proced" "proced.el" (21187 63826 213216 0)) ;;; Generated autoloads from proced.el (autoload 'proced "proced" "\ @@ -21442,7 +21553,8 @@ Proced buffers. ;;;*** -;;;### (autoloads nil "profiler" "profiler.el" (21291 53104 0 0)) +;;;### (autoloads nil "profiler" "profiler.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from profiler.el (autoload 'profiler-start "profiler" "\ @@ -21470,8 +21582,8 @@ Open profile FILENAME. ;;;*** -;;;### (autoloads nil "prolog" "progmodes/prolog.el" (21346 62196 -;;;;;; 0 0)) +;;;### (autoloads nil "prolog" "progmodes/prolog.el" (21383 2343 +;;;;;; 498187 0)) ;;; Generated autoloads from progmodes/prolog.el (autoload 'prolog-mode "prolog" "\ @@ -21504,7 +21616,7 @@ With prefix argument ARG, restart the Prolog process if running before. ;;;*** -;;;### (autoloads nil "ps-bdf" "ps-bdf.el" (21291 53104 0 0)) +;;;### (autoloads nil "ps-bdf" "ps-bdf.el" (21187 63826 213216 0)) ;;; Generated autoloads from ps-bdf.el (defvar bdf-directory-list (if (memq system-type '(ms-dos windows-nt)) (list (expand-file-name "fonts/bdf" installation-directory)) '("/usr/local/share/emacs/fonts/bdf")) "\ @@ -21515,8 +21627,8 @@ The default value is '(\"/usr/local/share/emacs/fonts/bdf\").") ;;;*** -;;;### (autoloads nil "ps-mode" "progmodes/ps-mode.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "ps-mode" "progmodes/ps-mode.el" (21342 10917 +;;;;;; 902592 0)) ;;; Generated autoloads from progmodes/ps-mode.el (push (purecopy '(ps-mode 1 1 9)) package--builtin-versions) @@ -21528,7 +21640,6 @@ Entry to this mode calls `ps-mode-hook'. The following variables hold user options, and can be set through the `customize' command: - `ps-mode-auto-indent' `ps-mode-tab' `ps-mode-paper-size' `ps-mode-print-function' @@ -21563,7 +21674,7 @@ Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number ;;;*** -;;;### (autoloads nil "ps-print" "ps-print.el" (21359 23622 725850 +;;;### (autoloads nil "ps-print" "ps-print.el" (21360 40869 887231 ;;;;;; 0)) ;;; Generated autoloads from ps-print.el (push (purecopy '(ps-print 7 3 5)) package--builtin-versions) @@ -21761,14 +21872,15 @@ If EXTENSION is any other symbol, it is ignored. ;;;*** -;;;### (autoloads nil "pulse" "cedet/pulse.el" (21291 53104 0 0)) +;;;### (autoloads nil "pulse" "cedet/pulse.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from cedet/pulse.el (push (purecopy '(pulse 1 0)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "python" "progmodes/python.el" (21313 59928 -;;;;;; 0 0)) +;;;### (autoloads nil "python" "progmodes/python.el" (21364 37926 +;;;;;; 837230 0)) ;;; Generated autoloads from progmodes/python.el (push (purecopy '(python 0 24 2)) package--builtin-versions) @@ -21802,7 +21914,7 @@ Major mode for editing Python files. ;;;*** -;;;### (autoloads nil "qp" "gnus/qp.el" (21291 53104 0 0)) +;;;### (autoloads nil "qp" "gnus/qp.el" (21187 63826 213216 0)) ;;; Generated autoloads from gnus/qp.el (autoload 'quoted-printable-decode-region "qp" "\ @@ -21821,8 +21933,8 @@ them into characters should be done separately. ;;;*** -;;;### (autoloads nil "quail" "international/quail.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "quail" "international/quail.el" (21215 43189 +;;;;;; 822371 0)) ;;; Generated autoloads from international/quail.el (autoload 'quail-title "quail" "\ @@ -22052,8 +22164,8 @@ of each directory. ;;;*** -;;;### (autoloads nil "quail/hangul" "leim/quail/hangul.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "quail/hangul" "leim/quail/hangul.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from leim/quail/hangul.el (autoload 'hangul-input-method-activate "quail/hangul" "\ @@ -22066,7 +22178,7 @@ HELP-TEXT is a text set in `hangul-input-method-help-text'. ;;;*** ;;;### (autoloads nil "quail/uni-input" "leim/quail/uni-input.el" -;;;;;; (21291 53104 0 0)) +;;;;;; (21187 63826 213216 0)) ;;; Generated autoloads from leim/quail/uni-input.el (autoload 'ucs-input-activate "quail/uni-input" "\ @@ -22080,7 +22192,7 @@ While this input method is active, the variable ;;;*** -;;;### (autoloads nil "quickurl" "net/quickurl.el" (21291 53104 0 +;;;### (autoloads nil "quickurl" "net/quickurl.el" (21222 16439 978802 ;;;;;; 0)) ;;; Generated autoloads from net/quickurl.el @@ -22152,7 +22264,8 @@ Display `quickurl-list' as a formatted list using `quickurl-list-mode'. ;;;*** -;;;### (autoloads nil "rcirc" "net/rcirc.el" (21291 53104 0 0)) +;;;### (autoloads nil "rcirc" "net/rcirc.el" (21361 61732 646433 +;;;;;; 0)) ;;; Generated autoloads from net/rcirc.el (autoload 'rcirc "rcirc" "\ @@ -22190,8 +22303,8 @@ if ARG is omitted or nil. ;;;*** -;;;### (autoloads nil "re-builder" "emacs-lisp/re-builder.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "re-builder" "emacs-lisp/re-builder.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from emacs-lisp/re-builder.el (defalias 'regexp-builder 're-builder) @@ -22209,7 +22322,8 @@ matching parts of the target buffer will be highlighted. ;;;*** -;;;### (autoloads nil "recentf" "recentf.el" (21291 53104 0 0)) +;;;### (autoloads nil "recentf" "recentf.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from recentf.el (defvar recentf-mode nil "\ @@ -22235,7 +22349,7 @@ were operated on recently. ;;;*** -;;;### (autoloads nil "rect" "rect.el" (21291 53104 0 0)) +;;;### (autoloads nil "rect" "rect.el" (21203 52022 581300 0)) ;;; Generated autoloads from rect.el (autoload 'delete-rectangle "rect" "\ @@ -22375,8 +22489,8 @@ Activates the region if needed. Only lasts until the region is deactivated. ;;;*** -;;;### (autoloads nil "refill" "textmodes/refill.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "refill" "textmodes/refill.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from textmodes/refill.el (autoload 'refill-mode "refill" "\ @@ -22396,9 +22510,13 @@ For true \"word wrap\" behavior, use `visual-line-mode' instead. ;;;*** -;;;### (autoloads nil "reftex" "textmodes/reftex.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "reftex" "textmodes/reftex.el" (21379 5529 +;;;;;; 990138 255000)) ;;; Generated autoloads from textmodes/reftex.el +(autoload 'reftex-citation "reftex-cite" nil t) +(autoload 'reftex-all-document-files "reftex-parse") +(autoload 'reftex-isearch-minor-mode "reftex-global" nil t) +(autoload 'reftex-index-phrases-mode "reftex-index" nil t) (autoload 'turn-on-reftex "reftex" "\ Turn on RefTeX mode. @@ -22446,101 +22564,8 @@ This enforces rescanning the buffer on next use. ;;;*** -;;;### (autoloads nil "reftex-cite" "textmodes/reftex-cite.el" (21291 -;;;;;; 53104 0 0)) -;;; Generated autoloads from textmodes/reftex-cite.el - -(autoload 'reftex-citation "reftex-cite" "\ -Make a citation using BibTeX database files. -After prompting for a regular expression, scans the buffers with -bibtex entries (taken from the \\bibliography command) and offers the -matching entries for selection. The selected entry is formatted according -to `reftex-cite-format' and inserted into the buffer. - -If NO-INSERT is non-nil, nothing is inserted, only the selected key returned. - -FORMAT-KEY can be used to pre-select a citation format. - -When called with a `C-u' prefix, prompt for optional arguments in -cite macros. When called with a numeric prefix, make that many -citations. When called with point inside the braces of a `\\cite' -command, it will add another key, ignoring the value of -`reftex-cite-format'. - -The regular expression uses an expanded syntax: && is interpreted as `and'. -Thus, `aaaa&&bbb' matches entries which contain both `aaaa' and `bbb'. -While entering the regexp, completion on knows citation keys is possible. -`=' is a good regular expression to match all entries in all files. - -\(fn &optional NO-INSERT FORMAT-KEY)" t nil) - -;;;*** - -;;;### (autoloads nil "reftex-global" "textmodes/reftex-global.el" -;;;;;; (21291 53104 0 0)) -;;; Generated autoloads from textmodes/reftex-global.el - -(autoload 'reftex-isearch-minor-mode "reftex-global" "\ -When on, isearch searches the whole document, not only the current file. -This minor mode allows isearch to search through all the files of -the current TeX document. - -With no argument, this command toggles -`reftex-isearch-minor-mode'. With a prefix argument ARG, turn -`reftex-isearch-minor-mode' on if ARG is positive, otherwise turn it off. - -\(fn &optional ARG)" t nil) - -;;;*** - -;;;### (autoloads nil "reftex-index" "textmodes/reftex-index.el" -;;;;;; (21291 53104 0 0)) -;;; Generated autoloads from textmodes/reftex-index.el - -(autoload 'reftex-index-phrases-mode "reftex-index" "\ -Major mode for managing the Index phrases of a LaTeX document. -This buffer was created with RefTeX. - -To insert new phrases, use - - `C-c \\' in the LaTeX document to copy selection or word - - `\\[reftex-index-new-phrase]' in the phrases buffer. - -To index phrases use one of: - -\\[reftex-index-this-phrase] index current phrase -\\[reftex-index-next-phrase] index next phrase (or N with prefix arg) -\\[reftex-index-all-phrases] index all phrases -\\[reftex-index-remaining-phrases] index current and following phrases -\\[reftex-index-region-phrases] index the phrases in the region - -You can sort the phrases in this buffer with \\[reftex-index-sort-phrases]. -To display information about the phrase at point, use \\[reftex-index-phrases-info]. - -For more information see the RefTeX User Manual. - -Here are all local bindings. - -\\{reftex-index-phrases-mode-map} - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads nil "reftex-parse" "textmodes/reftex-parse.el" -;;;;;; (21346 62196 0 0)) -;;; Generated autoloads from textmodes/reftex-parse.el - -(autoload 'reftex-all-document-files "reftex-parse" "\ -Return a list of all files belonging to the current document. -When RELATIVE is non-nil, give file names relative to directory -of master file. - -\(fn &optional RELATIVE)" nil nil) - -;;;*** - -;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (21194 +;;;;;; 37048 599945 0)) ;;; Generated autoloads from textmodes/reftex-vars.el (put 'reftex-vref-is-default 'safe-local-variable (lambda (x) (or (stringp x) (symbolp x)))) (put 'reftex-fref-is-default 'safe-local-variable (lambda (x) (or (stringp x) (symbolp x)))) @@ -22549,8 +22574,8 @@ of master file. ;;;*** -;;;### (autoloads nil "regexp-opt" "emacs-lisp/regexp-opt.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "regexp-opt" "emacs-lisp/regexp-opt.el" (21376 +;;;;;; 29092 815151 0)) ;;; Generated autoloads from emacs-lisp/regexp-opt.el (autoload 'regexp-opt "regexp-opt" "\ @@ -22579,15 +22604,15 @@ This means the number of non-shy regexp grouping constructs ;;;*** -;;;### (autoloads nil "regi" "emacs-lisp/regi.el" (21291 53104 0 +;;;### (autoloads nil "regi" "emacs-lisp/regi.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from emacs-lisp/regi.el (push (purecopy '(regi 1 8)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "remember" "textmodes/remember.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "remember" "textmodes/remember.el" (21252 37559 +;;;;;; 125878 0)) ;;; Generated autoloads from textmodes/remember.el (push (purecopy '(remember 2 0)) package--builtin-versions) @@ -22641,7 +22666,7 @@ to turn the *scratch* buffer into your notes buffer. ;;;*** -;;;### (autoloads nil "repeat" "repeat.el" (21291 53104 0 0)) +;;;### (autoloads nil "repeat" "repeat.el" (21239 25528 651427 0)) ;;; Generated autoloads from repeat.el (push (purecopy '(repeat 0 51)) package--builtin-versions) @@ -22664,8 +22689,8 @@ recently executed command not bound to an input event\". ;;;*** -;;;### (autoloads nil "reporter" "mail/reporter.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "reporter" "mail/reporter.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from mail/reporter.el (autoload 'reporter-submit-bug-report "reporter" "\ @@ -22696,7 +22721,7 @@ mail-sending package is used for editing and sending the message. ;;;*** -;;;### (autoloads nil "reposition" "reposition.el" (21291 53104 0 +;;;### (autoloads nil "reposition" "reposition.el" (21240 46395 727291 ;;;;;; 0)) ;;; Generated autoloads from reposition.el @@ -22723,7 +22748,7 @@ first comment line visible (if point is in a comment). ;;;*** -;;;### (autoloads nil "reveal" "reveal.el" (21291 53104 0 0)) +;;;### (autoloads nil "reveal" "reveal.el" (21359 20005 772941 0)) ;;; Generated autoloads from reveal.el (autoload 'reveal-mode "reveal" "\ @@ -22758,7 +22783,7 @@ the mode if ARG is omitted or nil. ;;;*** -;;;### (autoloads nil "ring" "emacs-lisp/ring.el" (21291 53104 0 +;;;### (autoloads nil "ring" "emacs-lisp/ring.el" (21240 46395 727291 ;;;;;; 0)) ;;; Generated autoloads from emacs-lisp/ring.el @@ -22774,7 +22799,8 @@ Make a ring that can contain SIZE elements. ;;;*** -;;;### (autoloads nil "rlogin" "net/rlogin.el" (21291 53104 0 0)) +;;;### (autoloads nil "rlogin" "net/rlogin.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from net/rlogin.el (autoload 'rlogin "rlogin" "\ @@ -22818,7 +22844,8 @@ variable. ;;;*** -;;;### (autoloads nil "rmail" "mail/rmail.el" (21349 10841 0 0)) +;;;### (autoloads nil "rmail" "mail/rmail.el" (21384 23211 329821 +;;;;;; 0)) ;;; Generated autoloads from mail/rmail.el (defvar rmail-file-name (purecopy "~/RMAIL") "\ @@ -23015,8 +23042,8 @@ Set PASSWORD to be used for retrieving mail from a POP or IMAP server. ;;;*** -;;;### (autoloads nil "rmailout" "mail/rmailout.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "rmailout" "mail/rmailout.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from mail/rmailout.el (put 'rmail-output-file-alist 'risky-local-variable t) @@ -23080,8 +23107,8 @@ than appending to it. Deletes the message after writing if ;;;*** -;;;### (autoloads nil "rng-cmpct" "nxml/rng-cmpct.el" (21319 19378 -;;;;;; 0 0)) +;;;### (autoloads nil "rng-cmpct" "nxml/rng-cmpct.el" (21319 49445 +;;;;;; 508378 0)) ;;; Generated autoloads from nxml/rng-cmpct.el (autoload 'rng-c-load-schema "rng-cmpct" "\ @@ -23092,8 +23119,8 @@ Return a pattern. ;;;*** -;;;### (autoloads nil "rng-nxml" "nxml/rng-nxml.el" (21291 57968 -;;;;;; 0 0)) +;;;### (autoloads nil "rng-nxml" "nxml/rng-nxml.el" (21293 25385 +;;;;;; 120083 0)) ;;; Generated autoloads from nxml/rng-nxml.el (autoload 'rng-nxml-mode-init "rng-nxml" "\ @@ -23105,8 +23132,8 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil. ;;;*** -;;;### (autoloads nil "rng-valid" "nxml/rng-valid.el" (21291 57968 -;;;;;; 0 0)) +;;;### (autoloads nil "rng-valid" "nxml/rng-valid.el" (21293 25385 +;;;;;; 120083 0)) ;;; Generated autoloads from nxml/rng-valid.el (autoload 'rng-validate-mode "rng-valid" "\ @@ -23136,7 +23163,7 @@ to use for finding the schema. ;;;*** -;;;### (autoloads nil "rng-xsd" "nxml/rng-xsd.el" (21291 57968 0 +;;;### (autoloads nil "rng-xsd" "nxml/rng-xsd.el" (21293 25385 120083 ;;;;;; 0)) ;;; Generated autoloads from nxml/rng-xsd.el @@ -23164,8 +23191,8 @@ must be equal. ;;;*** -;;;### (autoloads nil "robin" "international/robin.el" (20627 28607 -;;;;;; 0 0)) +;;;### (autoloads nil "robin" "international/robin.el" (20523 62082 +;;;;;; 997685 0)) ;;; Generated autoloads from international/robin.el (autoload 'robin-define-package "robin" "\ @@ -23197,7 +23224,7 @@ Start using robin package NAME, which is a string. ;;;*** -;;;### (autoloads nil "rot13" "rot13.el" (21291 53104 0 0)) +;;;### (autoloads nil "rot13" "rot13.el" (21240 46395 727291 0)) ;;; Generated autoloads from rot13.el (autoload 'rot13 "rot13" "\ @@ -23234,7 +23261,8 @@ Toggle the use of ROT13 encoding for the current window. ;;;*** -;;;### (autoloads nil "rst" "textmodes/rst.el" (21343 47921 0 0)) +;;;### (autoloads nil "rst" "textmodes/rst.el" (21346 7974 405729 +;;;;;; 0)) ;;; Generated autoloads from textmodes/rst.el (add-to-list 'auto-mode-alist (purecopy '("\\.re?st\\'" . rst-mode))) @@ -23264,8 +23292,8 @@ for modes derived from Text mode, like Mail mode. ;;;*** -;;;### (autoloads nil "ruby-mode" "progmodes/ruby-mode.el" (21352 -;;;;;; 50356 891885 0)) +;;;### (autoloads nil "ruby-mode" "progmodes/ruby-mode.el" (21355 +;;;;;; 22953 61816 0)) ;;; Generated autoloads from progmodes/ruby-mode.el (push (purecopy '(ruby-mode 1 2)) package--builtin-versions) @@ -23282,7 +23310,7 @@ Major mode for editing Ruby code. ;;;*** -;;;### (autoloads nil "ruler-mode" "ruler-mode.el" (21291 53104 0 +;;;### (autoloads nil "ruler-mode" "ruler-mode.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from ruler-mode.el (push (purecopy '(ruler-mode 1 6)) package--builtin-versions) @@ -23301,7 +23329,8 @@ if ARG is omitted or nil. ;;;*** -;;;### (autoloads nil "rx" "emacs-lisp/rx.el" (21291 53104 0 0)) +;;;### (autoloads nil "rx" "emacs-lisp/rx.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from emacs-lisp/rx.el (autoload 'rx-to-string "rx" "\ @@ -23612,14 +23641,15 @@ enclosed in `(and ...)'. ;;;*** -;;;### (autoloads nil "sasl-ntlm" "net/sasl-ntlm.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "sasl-ntlm" "net/sasl-ntlm.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from net/sasl-ntlm.el (push (purecopy '(sasl 1 0)) package--builtin-versions) ;;;*** -;;;### (autoloads nil "savehist" "savehist.el" (21291 53104 0 0)) +;;;### (autoloads nil "savehist" "savehist.el" (21326 22692 123234 +;;;;;; 0)) ;;; Generated autoloads from savehist.el (push (purecopy '(savehist 24)) package--builtin-versions) @@ -23651,8 +23681,8 @@ histories, which is probably undesirable. ;;;*** -;;;### (autoloads nil "scheme" "progmodes/scheme.el" (21372 35662 -;;;;;; 356409 0)) +;;;### (autoloads nil "scheme" "progmodes/scheme.el" (21379 5287 +;;;;;; 607434 0)) ;;; Generated autoloads from progmodes/scheme.el (autoload 'scheme-mode "scheme" "\ @@ -23691,8 +23721,8 @@ that variable's value is a string. ;;;*** -;;;### (autoloads nil "score-mode" "gnus/score-mode.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "score-mode" "gnus/score-mode.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from gnus/score-mode.el (autoload 'gnus-score-mode "score-mode" "\ @@ -23705,7 +23735,7 @@ This mode is an extended emacs-lisp mode. ;;;*** -;;;### (autoloads nil "scroll-all" "scroll-all.el" (21291 53104 0 +;;;### (autoloads nil "scroll-all" "scroll-all.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from scroll-all.el @@ -23731,8 +23761,8 @@ one window apply to all visible windows in the same frame. ;;;*** -;;;### (autoloads nil "scroll-lock" "scroll-lock.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "scroll-lock" "scroll-lock.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from scroll-lock.el (autoload 'scroll-lock-mode "scroll-lock" "\ @@ -23748,15 +23778,16 @@ vertically fixed relative to window boundaries during scrolling. ;;;*** -;;;### (autoloads nil "secrets" "net/secrets.el" (21291 53104 0 0)) +;;;### (autoloads nil "secrets" "net/secrets.el" (21256 34613 967717 +;;;;;; 0)) ;;; Generated autoloads from net/secrets.el (when (featurep 'dbusbind) (autoload 'secrets-show-secrets "secrets" nil t)) ;;;*** -;;;### (autoloads nil "semantic" "cedet/semantic.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "semantic" "cedet/semantic.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from cedet/semantic.el (push (purecopy '(semantic 2 2)) package--builtin-versions) @@ -23814,7 +23845,7 @@ Semantic mode. ;;;*** ;;;### (autoloads nil "semantic/bovine/grammar" "cedet/semantic/bovine/grammar.el" -;;;;;; (21291 53104 0 0)) +;;;;;; (21187 63826 213216 0)) ;;; Generated autoloads from cedet/semantic/bovine/grammar.el (autoload 'bovine-grammar-mode "semantic/bovine/grammar" "\ @@ -23825,7 +23856,7 @@ Major mode for editing Bovine grammars. ;;;*** ;;;### (autoloads nil "semantic/wisent/grammar" "cedet/semantic/wisent/grammar.el" -;;;;;; (21291 53104 0 0)) +;;;;;; (21187 63826 213216 0)) ;;; Generated autoloads from cedet/semantic/wisent/grammar.el (autoload 'wisent-grammar-mode "semantic/wisent/grammar" "\ @@ -23835,8 +23866,8 @@ Major mode for editing Wisent grammars. ;;;*** -;;;### (autoloads nil "sendmail" "mail/sendmail.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "sendmail" "mail/sendmail.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from mail/sendmail.el (defvar mail-from-style 'default "\ @@ -24117,7 +24148,7 @@ Like `mail' command, but display mail buffer in another frame. ;;;*** -;;;### (autoloads nil "server" "server.el" (21291 53104 0 0)) +;;;### (autoloads nil "server" "server.el" (21351 25893 518259 0)) ;;; Generated autoloads from server.el (put 'server-host 'risky-local-variable t) @@ -24184,7 +24215,7 @@ only these files will be asked to be saved. ;;;*** -;;;### (autoloads nil "ses" "ses.el" (21291 53104 0 0)) +;;;### (autoloads nil "ses" "ses.el" (21220 61111 156047 0)) ;;; Generated autoloads from ses.el (autoload 'ses-mode "ses" "\ @@ -24228,8 +24259,8 @@ formula: ;;;*** -;;;### (autoloads nil "sgml-mode" "textmodes/sgml-mode.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "sgml-mode" "textmodes/sgml-mode.el" (21240 +;;;;;; 46395 727291 0)) ;;; Generated autoloads from textmodes/sgml-mode.el (autoload 'sgml-mode "sgml-mode" "\ @@ -24294,8 +24325,8 @@ To work around that, do: ;;;*** -;;;### (autoloads nil "sh-script" "progmodes/sh-script.el" (21346 -;;;;;; 62196 0 0)) +;;;### (autoloads nil "sh-script" "progmodes/sh-script.el" (21383 +;;;;;; 2343 498187 0)) ;;; Generated autoloads from progmodes/sh-script.el (push (purecopy '(sh-script 2 0 6)) package--builtin-versions) (put 'sh-shell 'safe-local-variable 'symbolp) @@ -24359,8 +24390,8 @@ with your script for an edit-interpret-debug cycle. ;;;*** -;;;### (autoloads nil "shadow" "emacs-lisp/shadow.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "shadow" "emacs-lisp/shadow.el" (21271 54940 +;;;;;; 492268 31000)) ;;; Generated autoloads from emacs-lisp/shadow.el (autoload 'list-load-path-shadows "shadow" "\ @@ -24409,7 +24440,7 @@ function, `load-path-shadows-find'. ;;;*** -;;;### (autoloads nil "shadowfile" "shadowfile.el" (21291 53104 0 +;;;### (autoloads nil "shadowfile" "shadowfile.el" (21222 16439 978802 ;;;;;; 0)) ;;; Generated autoloads from shadowfile.el @@ -24448,7 +24479,7 @@ Set up file shadowing. ;;;*** -;;;### (autoloads nil "shell" "shell.el" (21313 65162 0 0)) +;;;### (autoloads nil "shell" "shell.el" (21374 22080 740835 768000)) ;;; Generated autoloads from shell.el (defvar shell-dumb-shell-regexp (purecopy "cmd\\(proxy\\)?\\.exe") "\ @@ -24496,7 +24527,7 @@ Otherwise, one argument `-i' is passed to the shell. ;;;*** -;;;### (autoloads nil "shr" "net/shr.el" (21341 23900 0 0)) +;;;### (autoloads nil "shr" "net/shr.el" (21327 43559 923043 0)) ;;; Generated autoloads from net/shr.el (autoload 'shr-render-region "shr" "\ @@ -24513,7 +24544,8 @@ DOM should be a parse tree as generated by ;;;*** -;;;### (autoloads nil "sieve" "gnus/sieve.el" (21291 53104 0 0)) +;;;### (autoloads nil "sieve" "gnus/sieve.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from gnus/sieve.el (autoload 'sieve-manage "sieve" "\ @@ -24538,8 +24570,8 @@ DOM should be a parse tree as generated by ;;;*** -;;;### (autoloads nil "sieve-mode" "gnus/sieve-mode.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "sieve-mode" "gnus/sieve-mode.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from gnus/sieve-mode.el (autoload 'sieve-mode "sieve-mode" "\ @@ -24554,8 +24586,8 @@ Turning on Sieve mode runs `sieve-mode-hook'. ;;;*** -;;;### (autoloads nil "simula" "progmodes/simula.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "simula" "progmodes/simula.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from progmodes/simula.el (autoload 'simula-mode "simula" "\ @@ -24603,7 +24635,8 @@ with no arguments, if that value is non-nil. ;;;*** -;;;### (autoloads nil "skeleton" "skeleton.el" (21291 53104 0 0)) +;;;### (autoloads nil "skeleton" "skeleton.el" (21293 25385 120083 +;;;;;; 0)) ;;; Generated autoloads from skeleton.el (defvar skeleton-filter-function 'identity "\ @@ -24616,7 +24649,7 @@ SKELETON is as defined under `skeleton-insert'. \(fn COMMAND DOCUMENTATION &rest SKELETON)" nil t) -(put 'define-skeleton 'doc-string-elt '2) +(function-put 'define-skeleton 'doc-string-elt '2) (autoload 'skeleton-proxy-new "skeleton" "\ Insert SKELETON. @@ -24714,8 +24747,8 @@ symmetrical ones, and the same character twice for the others. ;;;*** -;;;### (autoloads nil "smerge-mode" "vc/smerge-mode.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "smerge-mode" "vc/smerge-mode.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from vc/smerge-mode.el (autoload 'smerge-ediff "smerge-mode" "\ @@ -24742,7 +24775,8 @@ If no conflict maker is found, turn off `smerge-mode'. ;;;*** -;;;### (autoloads nil "smiley" "gnus/smiley.el" (21291 53104 0 0)) +;;;### (autoloads nil "smiley" "gnus/smiley.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from gnus/smiley.el (autoload 'smiley-region "smiley" "\ @@ -24759,8 +24793,8 @@ interactively. If there's no argument, do it at the current buffer. ;;;*** -;;;### (autoloads nil "smtpmail" "mail/smtpmail.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "smtpmail" "mail/smtpmail.el" (21322 25639 +;;;;;; 363230 0)) ;;; Generated autoloads from mail/smtpmail.el (autoload 'smtpmail-send-it "smtpmail" "\ @@ -24775,7 +24809,8 @@ Send mail that was queued as a result of setting `smtpmail-queue-mail'. ;;;*** -;;;### (autoloads nil "snake" "play/snake.el" (21291 53104 0 0)) +;;;### (autoloads nil "snake" "play/snake.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from play/snake.el (autoload 'snake "snake" "\ @@ -24798,8 +24833,8 @@ Snake mode keybindings: ;;;*** -;;;### (autoloads nil "snmp-mode" "net/snmp-mode.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "snmp-mode" "net/snmp-mode.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from net/snmp-mode.el (autoload 'snmp-mode "snmp-mode" "\ @@ -24828,7 +24863,7 @@ then `snmpv2-mode-hook'. ;;;*** -;;;### (autoloads nil "solar" "calendar/solar.el" (21291 53104 0 +;;;### (autoloads nil "solar" "calendar/solar.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from calendar/solar.el @@ -24844,8 +24879,8 @@ This function is suitable for execution in an init file. ;;;*** -;;;### (autoloads nil "solitaire" "play/solitaire.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "solitaire" "play/solitaire.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from play/solitaire.el (autoload 'solitaire "solitaire" "\ @@ -24920,7 +24955,7 @@ Pick your favorite shortcuts: ;;;*** -;;;### (autoloads nil "sort" "sort.el" (21291 53104 0 0)) +;;;### (autoloads nil "sort" "sort.el" (21240 46395 727291 0)) ;;; Generated autoloads from sort.el (put 'sort-fold-case 'safe-local-variable 'booleanp) @@ -25095,7 +25130,7 @@ is non-nil, it also prints a message describing the number of deletions. ;;;*** -;;;### (autoloads nil "spam" "gnus/spam.el" (21291 53104 0 0)) +;;;### (autoloads nil "spam" "gnus/spam.el" (21296 1575 438327 0)) ;;; Generated autoloads from gnus/spam.el (autoload 'spam-initialize "spam" "\ @@ -25109,8 +25144,8 @@ installed through `spam-necessary-extra-headers'. ;;;*** -;;;### (autoloads nil "spam-report" "gnus/spam-report.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "spam-report" "gnus/spam-report.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from gnus/spam-report.el (autoload 'spam-report-process-queue "spam-report" "\ @@ -25152,7 +25187,8 @@ Spam reports will be queued with the method used when ;;;*** -;;;### (autoloads nil "speedbar" "speedbar.el" (21341 23900 0 0)) +;;;### (autoloads nil "speedbar" "speedbar.el" (21335 37672 97862 +;;;;;; 0)) ;;; Generated autoloads from speedbar.el (defalias 'speedbar 'speedbar-frame-mode) @@ -25176,7 +25212,8 @@ selected. If the speedbar frame is active, then select the attached frame. ;;;*** -;;;### (autoloads nil "spook" "play/spook.el" (21291 53104 0 0)) +;;;### (autoloads nil "spook" "play/spook.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from play/spook.el (autoload 'spook "spook" "\ @@ -25191,7 +25228,8 @@ Return a vector containing the lines from `spook-phrases-file'. ;;;*** -;;;### (autoloads nil "sql" "progmodes/sql.el" (21291 53104 0 0)) +;;;### (autoloads nil "sql" "progmodes/sql.el" (21263 60346 30834 +;;;;;; 928000)) ;;; Generated autoloads from progmodes/sql.el (push (purecopy '(sql 3 4)) package--builtin-versions) @@ -25652,7 +25690,7 @@ buffer. ;;;*** -;;;### (autoloads nil "srecode" "cedet/srecode.el" (21291 53104 0 +;;;### (autoloads nil "srecode" "cedet/srecode.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from cedet/srecode.el (push (purecopy '(srecode 1 2)) package--builtin-versions) @@ -25660,7 +25698,7 @@ buffer. ;;;*** ;;;### (autoloads nil "srecode/srt-mode" "cedet/srecode/srt-mode.el" -;;;;;; (21291 53104 0 0)) +;;;;;; (21187 63826 213216 0)) ;;; Generated autoloads from cedet/srecode/srt-mode.el (autoload 'srecode-template-mode "srecode/srt-mode" "\ @@ -25672,8 +25710,8 @@ Major-mode for writing SRecode macros. ;;;*** -;;;### (autoloads nil "starttls" "gnus/starttls.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "starttls" "gnus/starttls.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from gnus/starttls.el (autoload 'starttls-open-stream "starttls" "\ @@ -25696,7 +25734,7 @@ GnuTLS requires a port number. ;;;*** -;;;### (autoloads nil "strokes" "strokes.el" (21291 53104 0 0)) +;;;### (autoloads nil "strokes" "strokes.el" (21271 1974 113743 0)) ;;; Generated autoloads from strokes.el (autoload 'strokes-global-set-stroke "strokes" "\ @@ -25809,7 +25847,8 @@ Read a complex stroke and insert its glyph into the current buffer. ;;;*** -;;;### (autoloads nil "studly" "play/studly.el" (21291 53104 0 0)) +;;;### (autoloads nil "studly" "play/studly.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from play/studly.el (autoload 'studlify-region "studly" "\ @@ -25829,18 +25868,20 @@ Studlify-case the current buffer. ;;;*** -;;;### (autoloads nil "subword" "progmodes/subword.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "subword" "progmodes/subword.el" (21377 49959 +;;;;;; 896066 0)) ;;; Generated autoloads from progmodes/subword.el +(define-obsolete-function-alias 'capitalized-words-mode 'subword-mode "24.5") + (autoload 'subword-mode "subword" "\ Toggle subword movement and editing (Subword mode). With a prefix argument ARG, enable Subword mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. -Subword mode is a buffer-local minor mode. Enabling it remaps -word-based editing commands to subword-based commands that handle +Subword mode is a buffer-local minor mode. Enabling it changes +the definition of a word so that word-based commands stop inside symbols with mixed uppercase and lowercase letters, e.g. \"GtkWidget\", \"EmacsFrameClass\", \"NSGraphicsContext\". @@ -25854,9 +25895,8 @@ called a `subword'. Here are some examples: EmacsFrameClass => \"Emacs\", \"Frame\" and \"Class\" NSGraphicsContext => \"NS\", \"Graphics\" and \"Context\" -The subword oriented commands activated in this minor mode recognize -subwords in a nomenclature to move between subwords and to edit them -as words. +This mode changes the definition of a word so that word commands +treat nomenclature boundaries as word bounaries. \\{subword-mode-map} @@ -25889,13 +25929,10 @@ With a prefix argument ARG, enable Superword mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. -Superword mode is a buffer-local minor mode. Enabling it remaps -word-based editing commands to superword-based commands that -treat symbols as words, e.g. \"this_is_a_symbol\". - -The superword oriented commands activated in this minor mode -recognize symbols as superwords to move between superwords and to -edit them as words. +Superword mode is a buffer-local minor mode. Enabling it changes +the definition of words such that symbols characters are treated +as parts of words: e.g., in `superword-mode', +\"this_is_a_symbol\" counts as one word. \\{superword-mode-map} @@ -25924,8 +25961,8 @@ See `superword-mode' for more information on Superword mode. ;;;*** -;;;### (autoloads nil "supercite" "mail/supercite.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "supercite" "mail/supercite.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from mail/supercite.el (autoload 'sc-cite-original "supercite" "\ @@ -25957,7 +25994,8 @@ and `sc-post-hook' is run after the guts of this function. ;;;*** -;;;### (autoloads nil "t-mouse" "t-mouse.el" (21291 53104 0 0)) +;;;### (autoloads nil "t-mouse" "t-mouse.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from t-mouse.el (define-obsolete-function-alias 't-mouse-mode 'gpm-mouse-mode "23.1") @@ -25985,7 +26023,7 @@ It relies on the `gpm' daemon being activated. ;;;*** -;;;### (autoloads nil "tabify" "tabify.el" (21291 53104 0 0)) +;;;### (autoloads nil "tabify" "tabify.el" (21240 46395 727291 0)) ;;; Generated autoloads from tabify.el (autoload 'untabify "tabify" "\ @@ -26014,7 +26052,7 @@ The variable `tab-width' controls the spacing of tab stops. ;;;*** -;;;### (autoloads nil "table" "textmodes/table.el" (21291 53104 0 +;;;### (autoloads nil "table" "textmodes/table.el" (21194 37048 599945 ;;;;;; 0)) ;;; Generated autoloads from textmodes/table.el @@ -26607,7 +26645,7 @@ converts a table into plain text without frames. It is a companion to ;;;*** -;;;### (autoloads nil "talk" "talk.el" (21291 53104 0 0)) +;;;### (autoloads nil "talk" "talk.el" (21240 46395 727291 0)) ;;; Generated autoloads from talk.el (autoload 'talk-connect "talk" "\ @@ -26622,7 +26660,8 @@ Connect to the Emacs talk group from the current X display or tty frame. ;;;*** -;;;### (autoloads nil "tar-mode" "tar-mode.el" (21291 53104 0 0)) +;;;### (autoloads nil "tar-mode" "tar-mode.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from tar-mode.el (autoload 'tar-mode "tar-mode" "\ @@ -26645,7 +26684,8 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. ;;;*** -;;;### (autoloads nil "tcl" "progmodes/tcl.el" (21291 53104 0 0)) +;;;### (autoloads nil "tcl" "progmodes/tcl.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from progmodes/tcl.el (autoload 'tcl-mode "tcl" "\ @@ -26693,7 +26733,8 @@ Prefix argument means invert sense of `tcl-use-smart-word-finder'. ;;;*** -;;;### (autoloads nil "telnet" "net/telnet.el" (21291 53104 0 0)) +;;;### (autoloads nil "telnet" "net/telnet.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from net/telnet.el (autoload 'telnet "telnet" "\ @@ -26718,7 +26759,7 @@ Normally input is edited in Emacs and sent a line at a time. ;;;*** -;;;### (autoloads nil "term" "term.el" (21341 23900 0 0)) +;;;### (autoloads nil "term" "term.el" (21339 34726 39547 0)) ;;; Generated autoloads from term.el (autoload 'make-term "term" "\ @@ -26760,8 +26801,8 @@ use in that buffer. ;;;*** -;;;### (autoloads nil "testcover" "emacs-lisp/testcover.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "testcover" "emacs-lisp/testcover.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from emacs-lisp/testcover.el (autoload 'testcover-this-defun "testcover" "\ @@ -26771,7 +26812,8 @@ Start coverage on function under point. ;;;*** -;;;### (autoloads nil "tetris" "play/tetris.el" (21291 53104 0 0)) +;;;### (autoloads nil "tetris" "play/tetris.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from play/tetris.el (push (purecopy '(tetris 2 1)) package--builtin-versions) @@ -26796,8 +26838,8 @@ tetris-mode keybindings: ;;;*** -;;;### (autoloads nil "tex-mode" "textmodes/tex-mode.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "tex-mode" "textmodes/tex-mode.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from textmodes/tex-mode.el (defvar tex-shell-file-name nil "\ @@ -27098,8 +27140,8 @@ Major mode to edit DocTeX files. ;;;*** -;;;### (autoloads nil "texinfmt" "textmodes/texinfmt.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "texinfmt" "textmodes/texinfmt.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from textmodes/texinfmt.el (autoload 'texinfo-format-buffer "texinfmt" "\ @@ -27138,8 +27180,8 @@ if large. You can use `Info-split' to do this manually. ;;;*** -;;;### (autoloads nil "texinfo" "textmodes/texinfo.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "texinfo" "textmodes/texinfo.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from textmodes/texinfo.el (defvar texinfo-open-quote (purecopy "``") "\ @@ -27223,8 +27265,8 @@ value of `texinfo-mode-hook'. ;;;*** -;;;### (autoloads nil "thai-util" "language/thai-util.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "thai-util" "language/thai-util.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from language/thai-util.el (autoload 'thai-compose-region "thai-util" "\ @@ -27251,7 +27293,8 @@ Compose Thai characters in the current buffer. ;;;*** -;;;### (autoloads nil "thingatpt" "thingatpt.el" (21291 53104 0 0)) +;;;### (autoloads nil "thingatpt" "thingatpt.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from thingatpt.el (autoload 'forward-thing "thingatpt" "\ @@ -27315,7 +27358,7 @@ Return the Lisp list at point, or nil if none is found. ;;;*** -;;;### (autoloads nil "thumbs" "thumbs.el" (21291 53104 0 0)) +;;;### (autoloads nil "thumbs" "thumbs.el" (21240 46395 727291 0)) ;;; Generated autoloads from thumbs.el (autoload 'thumbs-find-thumb "thumbs" "\ @@ -27349,8 +27392,8 @@ In dired, call the setroot program on the image at point. ;;;*** -;;;### (autoloads nil "tibet-util" "language/tibet-util.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "tibet-util" "language/tibet-util.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from language/tibet-util.el (autoload 'tibetan-char-p "tibet-util" "\ @@ -27423,10 +27466,10 @@ See also docstring of the function tibetan-compose-region. ;;;*** -;;;### (autoloads nil "tildify" "textmodes/tildify.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "tildify" "textmodes/tildify.el" (21381 47015 +;;;;;; 637535 0)) ;;; Generated autoloads from textmodes/tildify.el -(push (purecopy '(tildify 4 5)) package--builtin-versions) +(push (purecopy '(tildify 4 5 1)) package--builtin-versions) (autoload 'tildify-region "tildify" "\ Add hard spaces in the region between BEG and END. @@ -27434,8 +27477,10 @@ See variables `tildify-pattern-alist', `tildify-string-alist', and `tildify-ignored-environments-alist' for information about configuration parameters. This function performs no refilling of the changed text. +If DONT-ASK is set, or called interactively with prefix argument, user +won't be prompted for confirmation of each substitution. -\(fn BEG END)" t nil) +\(fn BEG END &optional DONT-ASK)" t nil) (autoload 'tildify-buffer "tildify" "\ Add hard spaces in the current buffer. @@ -27443,12 +27488,14 @@ See variables `tildify-pattern-alist', `tildify-string-alist', and `tildify-ignored-environments-alist' for information about configuration parameters. This function performs no refilling of the changed text. +If DONT-ASK is set, or called interactively with prefix argument, user +won't be prompted for confirmation of each substitution. -\(fn)" t nil) +\(fn &optional DONT-ASK)" t nil) ;;;*** -;;;### (autoloads nil "time" "time.el" (21291 53104 0 0)) +;;;### (autoloads nil "time" "time.el" (21240 46395 727291 0)) ;;; Generated autoloads from time.el (defvar display-time-day-and-date nil "\ @@ -27510,8 +27557,8 @@ Return a string giving the duration of the Emacs initialization. ;;;*** -;;;### (autoloads nil "time-date" "calendar/time-date.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "time-date" "calendar/time-date.el" (21361 +;;;;;; 61732 646433 0)) ;;; Generated autoloads from calendar/time-date.el (autoload 'date-to-time "time-date" "\ @@ -27620,9 +27667,14 @@ This function does not work for SECONDS greater than `most-positive-fixnum'. \(fn STRING SECONDS)" nil nil) +(autoload 'seconds-to-string "time-date" "\ +Convert the time interval in seconds to a short string. + +\(fn DELAY)" nil nil) + ;;;*** -;;;### (autoloads nil "time-stamp" "time-stamp.el" (21291 53104 0 +;;;### (autoloads nil "time-stamp" "time-stamp.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from time-stamp.el (put 'time-stamp-format 'safe-local-variable 'stringp) @@ -27663,8 +27715,8 @@ With ARG, turn time stamping on if and only if arg is positive. ;;;*** -;;;### (autoloads nil "timeclock" "calendar/timeclock.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "timeclock" "calendar/timeclock.el" (21222 +;;;;;; 16439 978802 0)) ;;; Generated autoloads from calendar/timeclock.el (push (purecopy '(timeclock 2 6 1)) package--builtin-versions) @@ -27774,7 +27826,7 @@ relative only to the time worked today, and not to past time. ;;;*** ;;;### (autoloads nil "titdic-cnv" "international/titdic-cnv.el" -;;;;;; (21291 53104 0 0)) +;;;;;; (21187 63826 213216 0)) ;;; Generated autoloads from international/titdic-cnv.el (autoload 'titdic-convert "titdic-cnv" "\ @@ -27796,7 +27848,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\". ;;;*** -;;;### (autoloads nil "tmm" "tmm.el" (21291 53104 0 0)) +;;;### (autoloads nil "tmm" "tmm.el" (21240 46395 727291 0)) ;;; Generated autoloads from tmm.el (define-key global-map "\M-`" 'tmm-menubar) (define-key global-map [menu-bar mouse-1] 'tmm-menubar-mouse) @@ -27838,8 +27890,8 @@ Its value should be an event that has a binding in MENU. ;;;*** -;;;### (autoloads nil "todo-mode" "calendar/todo-mode.el" (21375 -;;;;;; 36659 236206 0)) +;;;### (autoloads nil "todo-mode" "calendar/todo-mode.el" (21379 +;;;;;; 5287 607434 0)) ;;; Generated autoloads from calendar/todo-mode.el (autoload 'todo-show "todo-mode" "\ @@ -27906,7 +27958,8 @@ Mode for displaying and reprioritizing top priority Todo. ;;;*** -;;;### (autoloads nil "tool-bar" "tool-bar.el" (21291 53104 0 0)) +;;;### (autoloads nil "tool-bar" "tool-bar.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from tool-bar.el (autoload 'toggle-tool-bar-mode-from-frame "tool-bar" "\ @@ -27976,8 +28029,8 @@ holds a keymap. ;;;*** -;;;### (autoloads nil "tpu-edt" "emulation/tpu-edt.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "tpu-edt" "emulation/tpu-edt.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from emulation/tpu-edt.el (push (purecopy '(tpu-edt 4 5)) package--builtin-versions) @@ -28007,8 +28060,8 @@ Turn on TPU/edt emulation. ;;;*** -;;;### (autoloads nil "tpu-mapper" "emulation/tpu-mapper.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "tpu-mapper" "emulation/tpu-mapper.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from emulation/tpu-mapper.el (autoload 'tpu-mapper "tpu-mapper" "\ @@ -28042,7 +28095,8 @@ your local X guru can try to figure out why the key is being ignored. ;;;*** -;;;### (autoloads nil "tq" "emacs-lisp/tq.el" (21291 53104 0 0)) +;;;### (autoloads nil "tq" "emacs-lisp/tq.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from emacs-lisp/tq.el (autoload 'tq-create "tq" "\ @@ -28055,8 +28109,8 @@ to a tcp server on another machine. ;;;*** -;;;### (autoloads nil "trace" "emacs-lisp/trace.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "trace" "emacs-lisp/trace.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from emacs-lisp/trace.el (defvar trace-buffer "*trace-output*" "\ @@ -28101,7 +28155,8 @@ the output buffer or changing the window configuration. ;;;*** -;;;### (autoloads nil "tramp" "net/tramp.el" (21341 23900 0 0)) +;;;### (autoloads nil "tramp" "net/tramp.el" (21330 19750 309501 +;;;;;; 0)) ;;; Generated autoloads from net/tramp.el (defvar tramp-mode t "\ @@ -28216,8 +28271,8 @@ Discard Tramp from loading remote files. ;;;*** -;;;### (autoloads nil "tramp-ftp" "net/tramp-ftp.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "tramp-ftp" "net/tramp-ftp.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from net/tramp-ftp.el (autoload 'tramp-ftp-enable-ange-ftp "tramp-ftp" "\ @@ -28227,7 +28282,8 @@ Discard Tramp from loading remote files. ;;;*** -;;;### (autoloads nil "tutorial" "tutorial.el" (21291 53104 0 0)) +;;;### (autoloads nil "tutorial" "tutorial.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from tutorial.el (autoload 'help-with-tutorial "tutorial" "\ @@ -28251,8 +28307,8 @@ resumed later. ;;;*** -;;;### (autoloads nil "tv-util" "language/tv-util.el" (20352 35897 -;;;;;; 0 0)) +;;;### (autoloads nil "tv-util" "language/tv-util.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from language/tv-util.el (autoload 'tai-viet-composition-function "tv-util" "\ @@ -28262,8 +28318,8 @@ resumed later. ;;;*** -;;;### (autoloads nil "two-column" "textmodes/two-column.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "two-column" "textmodes/two-column.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from textmodes/two-column.el (autoload '2C-command "two-column" () t 'keymap) (global-set-key "\C-x6" '2C-command) @@ -28310,7 +28366,7 @@ First column's text sSs Second column's text ;;;*** -;;;### (autoloads nil "type-break" "type-break.el" (21291 53104 0 +;;;### (autoloads nil "type-break" "type-break.el" (21222 16439 978802 ;;;;;; 0)) ;;; Generated autoloads from type-break.el @@ -28443,7 +28499,7 @@ FRAC should be the inverse of the fractional value; for example, a value of ;;;*** -;;;### (autoloads nil "uce" "mail/uce.el" (21291 53104 0 0)) +;;;### (autoloads nil "uce" "mail/uce.el" (21199 54969 178188 0)) ;;; Generated autoloads from mail/uce.el (autoload 'uce-reply-to-uce "uce" "\ @@ -28457,7 +28513,7 @@ You might need to set `uce-mail-reader' before using this. ;;;*** ;;;### (autoloads nil "ucs-normalize" "international/ucs-normalize.el" -;;;;;; (21291 53104 0 0)) +;;;;;; (21194 37048 599945 0)) ;;; Generated autoloads from international/ucs-normalize.el (autoload 'ucs-normalize-NFD-region "ucs-normalize" "\ @@ -28522,8 +28578,8 @@ Normalize the string STR by the Unicode NFC and Mac OS's HFS Plus. ;;;*** -;;;### (autoloads nil "underline" "textmodes/underline.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "underline" "textmodes/underline.el" (21240 +;;;;;; 46395 727291 0)) ;;; Generated autoloads from textmodes/underline.el (autoload 'underline-region "underline" "\ @@ -28543,7 +28599,7 @@ which specify the range to operate on. ;;;*** -;;;### (autoloads nil "unrmail" "mail/unrmail.el" (21291 53104 0 +;;;### (autoloads nil "unrmail" "mail/unrmail.el" (21240 46395 727291 ;;;;;; 0)) ;;; Generated autoloads from mail/unrmail.el @@ -28564,8 +28620,8 @@ The variable `unrmail-mbox-format' controls which mbox format to use. ;;;*** -;;;### (autoloads nil "unsafep" "emacs-lisp/unsafep.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "unsafep" "emacs-lisp/unsafep.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from emacs-lisp/unsafep.el (autoload 'unsafep "unsafep" "\ @@ -28577,7 +28633,7 @@ UNSAFEP-VARS is a list of symbols with local bindings. ;;;*** -;;;### (autoloads nil "url" "url/url.el" (21291 53104 0 0)) +;;;### (autoloads nil "url" "url/url.el" (21302 6641 882267 783000)) ;;; Generated autoloads from url/url.el (autoload 'url-retrieve "url" "\ @@ -28624,7 +28680,7 @@ no further processing). URL is either a string or a parsed URL. ;;;*** -;;;### (autoloads nil "url-auth" "url/url-auth.el" (21291 53104 0 +;;;### (autoloads nil "url-auth" "url/url-auth.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from url/url-auth.el @@ -28666,8 +28722,8 @@ RATING a rating between 1 and 10 of the strength of the authentication. ;;;*** -;;;### (autoloads nil "url-cache" "url/url-cache.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "url-cache" "url/url-cache.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from url/url-cache.el (autoload 'url-store-in-cache "url-cache" "\ @@ -28688,7 +28744,8 @@ Extract FNAM from the local disk cache. ;;;*** -;;;### (autoloads nil "url-cid" "url/url-cid.el" (21291 53104 0 0)) +;;;### (autoloads nil "url-cid" "url/url-cid.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from url/url-cid.el (autoload 'url-cid "url-cid" "\ @@ -28698,7 +28755,8 @@ Extract FNAM from the local disk cache. ;;;*** -;;;### (autoloads nil "url-dav" "url/url-dav.el" (21291 53104 0 0)) +;;;### (autoloads nil "url-dav" "url/url-dav.el" (21302 6606 390237 +;;;;;; 377000)) ;;; Generated autoloads from url/url-dav.el (autoload 'url-dav-supported-p "url-dav" "\ @@ -28732,7 +28790,7 @@ added to this list, so most requests can just pass in nil. ;;;*** -;;;### (autoloads nil "url-file" "url/url-file.el" (21291 53104 0 +;;;### (autoloads nil "url-file" "url/url-file.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from url/url-file.el @@ -28743,7 +28801,8 @@ Handle file: and ftp: URLs. ;;;*** -;;;### (autoloads nil "url-gw" "url/url-gw.el" (21291 53104 0 0)) +;;;### (autoloads nil "url-gw" "url/url-gw.el" (21302 6606 390237 +;;;;;; 377000)) ;;; Generated autoloads from url/url-gw.el (autoload 'url-gateway-nslookup-host "url-gw" "\ @@ -28761,8 +28820,8 @@ Might do a non-blocking connection; use `process-status' to check. ;;;*** -;;;### (autoloads nil "url-handlers" "url/url-handlers.el" (21358 -;;;;;; 2749 405170 0)) +;;;### (autoloads nil "url-handlers" "url/url-handlers.el" (21360 +;;;;;; 40869 887231 0)) ;;; Generated autoloads from url/url-handlers.el (defvar url-handler-mode nil "\ @@ -28816,8 +28875,8 @@ accessible. ;;;*** -;;;### (autoloads nil "url-http" "url/url-http.el" (21291 53104 0 -;;;;;; 0)) +;;;### (autoloads nil "url-http" "url/url-http.el" (21302 6606 390237 +;;;;;; 377000)) ;;; Generated autoloads from url/url-http.el (autoload 'url-default-expander "url-expand") @@ -28829,7 +28888,8 @@ accessible. ;;;*** -;;;### (autoloads nil "url-irc" "url/url-irc.el" (21291 53104 0 0)) +;;;### (autoloads nil "url-irc" "url/url-irc.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from url/url-irc.el (autoload 'url-irc "url-irc" "\ @@ -28839,7 +28899,7 @@ accessible. ;;;*** -;;;### (autoloads nil "url-ldap" "url/url-ldap.el" (21291 53104 0 +;;;### (autoloads nil "url-ldap" "url/url-ldap.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from url/url-ldap.el @@ -28853,8 +28913,8 @@ URL can be a URL string, or a URL vector of the type returned by ;;;*** -;;;### (autoloads nil "url-mailto" "url/url-mailto.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "url-mailto" "url/url-mailto.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from url/url-mailto.el (autoload 'url-mail "url-mailto" "\ @@ -28869,7 +28929,7 @@ Handle the mailto: URL syntax. ;;;*** -;;;### (autoloads nil "url-misc" "url/url-misc.el" (21291 53104 0 +;;;### (autoloads nil "url-misc" "url/url-misc.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from url/url-misc.el @@ -28901,8 +28961,8 @@ Fetch a data URL (RFC 2397). ;;;*** -;;;### (autoloads nil "url-news" "url/url-news.el" (21291 53104 0 -;;;;;; 0)) +;;;### (autoloads nil "url-news" "url/url-news.el" (21301 65237 320114 +;;;;;; 350000)) ;;; Generated autoloads from url/url-news.el (autoload 'url-news "url-news" "\ @@ -28917,7 +28977,8 @@ Fetch a data URL (RFC 2397). ;;;*** -;;;### (autoloads nil "url-ns" "url/url-ns.el" (21291 53104 0 0)) +;;;### (autoloads nil "url-ns" "url/url-ns.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from url/url-ns.el (autoload 'isPlainHostName "url-ns" "\ @@ -28957,8 +29018,8 @@ Fetch a data URL (RFC 2397). ;;;*** -;;;### (autoloads nil "url-parse" "url/url-parse.el" (21346 62196 -;;;;;; 0 0)) +;;;### (autoloads nil "url-parse" "url/url-parse.el" (21350 58112 +;;;;;; 380040 0)) ;;; Generated autoloads from url/url-parse.el (autoload 'url-recreate-url "url-parse" "\ @@ -29009,8 +29070,8 @@ parses to ;;;*** -;;;### (autoloads nil "url-privacy" "url/url-privacy.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "url-privacy" "url/url-privacy.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from url/url-privacy.el (autoload 'url-setup-privacy-info "url-privacy" "\ @@ -29020,8 +29081,8 @@ Setup variables that expose info about you and your system. ;;;*** -;;;### (autoloads nil "url-queue" "url/url-queue.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "url-queue" "url/url-queue.el" (21193 16180 +;;;;;; 875828 0)) ;;; Generated autoloads from url/url-queue.el (autoload 'url-queue-retrieve "url-queue" "\ @@ -29035,7 +29096,26 @@ The variable `url-queue-timeout' sets a timeout. ;;;*** -;;;### (autoloads nil "url-util" "url/url-util.el" (21291 53104 0 +;;;### (autoloads nil "url-tramp" "url/url-tramp.el" (21307 58279 +;;;;;; 19956 0)) +;;; Generated autoloads from url/url-tramp.el + +(defvar url-tramp-protocols '("ftp" "ssh" "scp" "rsync" "telnet") "\ +List of URL protocols the work is handled by Tramp. +They must also be covered by `url-handler-regexp'.") + +(custom-autoload 'url-tramp-protocols "url-tramp" t) + +(autoload 'url-tramp-file-handler "url-tramp" "\ +Function called from the `file-name-handler-alist' routines. +OPERATION is what needs to be done. ARGS are the arguments that +would have been passed to OPERATION. + +\(fn OPERATION &rest ARGS)" nil nil) + +;;;*** + +;;;### (autoloads nil "url-util" "url/url-util.el" (21364 37926 837230 ;;;;;; 0)) ;;; Generated autoloads from url/url-util.el @@ -29204,7 +29284,8 @@ This uses `url-current-object', set locally to the buffer. ;;;*** -;;;### (autoloads nil "userlock" "userlock.el" (21291 53104 0 0)) +;;;### (autoloads nil "userlock" "userlock.el" (21260 57764 872288 +;;;;;; 374000)) ;;; Generated autoloads from userlock.el (autoload 'ask-user-about-lock "userlock" "\ @@ -29232,8 +29313,8 @@ The buffer in question is current when this function is called. ;;;*** -;;;### (autoloads nil "utf-7" "international/utf-7.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "utf-7" "international/utf-7.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from international/utf-7.el (autoload 'utf-7-post-read-conversion "utf-7" "\ @@ -29258,7 +29339,7 @@ The buffer in question is current when this function is called. ;;;*** -;;;### (autoloads nil "utf7" "gnus/utf7.el" (21291 53104 0 0)) +;;;### (autoloads nil "utf7" "gnus/utf7.el" (21187 63826 213216 0)) ;;; Generated autoloads from gnus/utf7.el (autoload 'utf7-encode "utf7" "\ @@ -29268,8 +29349,8 @@ Encode UTF-7 STRING. Use IMAP modification if FOR-IMAP is non-nil. ;;;*** -;;;### (autoloads nil "uudecode" "mail/uudecode.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "uudecode" "mail/uudecode.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from mail/uudecode.el (autoload 'uudecode-decode-region-external "uudecode" "\ @@ -29293,7 +29374,7 @@ If FILE-NAME is non-nil, save the result to FILE-NAME. ;;;*** -;;;### (autoloads nil "vc" "vc/vc.el" (21291 53104 0 0)) +;;;### (autoloads nil "vc" "vc/vc.el" (21332 61483 90708 0)) ;;; Generated autoloads from vc/vc.el (defvar vc-checkout-hook nil "\ @@ -29401,6 +29482,12 @@ saving the buffer. \(fn HISTORIC &optional NOT-URGENT)" t nil) +(autoload 'vc-root-dir "vc" "\ +Return the root directory for the current VC tree. +Return nil if the root directory cannot be identified. + +\(fn)" nil nil) + (autoload 'vc-revision-other-window "vc" "\ Visit revision REV of the current file in another window. If the current file is named `F', the revision is named `F.~REV~'. @@ -29574,8 +29661,8 @@ Return the branch part of a revision number REV. ;;;*** -;;;### (autoloads nil "vc-annotate" "vc/vc-annotate.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "vc-annotate" "vc/vc-annotate.el" (21240 46395 +;;;;;; 727291 0)) ;;; Generated autoloads from vc/vc-annotate.el (autoload 'vc-annotate "vc-annotate" "\ @@ -29612,7 +29699,8 @@ mode-specific menu. `vc-annotate-color-map' and ;;;*** -;;;### (autoloads nil "vc-arch" "vc/vc-arch.el" (21291 53104 0 0)) +;;;### (autoloads nil "vc-arch" "vc/vc-arch.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from vc/vc-arch.el (defun vc-arch-registered (file) (if (vc-find-root file "{arch}/=tagging-method") @@ -29622,7 +29710,8 @@ mode-specific menu. `vc-annotate-color-map' and ;;;*** -;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (21291 53104 0 0)) +;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from vc/vc-bzr.el (defconst vc-bzr-admin-dirname ".bzr" "\ @@ -29638,7 +29727,8 @@ Name of the format file in a .bzr directory.") ;;;*** -;;;### (autoloads nil "vc-cvs" "vc/vc-cvs.el" (21291 53104 0 0)) +;;;### (autoloads nil "vc-cvs" "vc/vc-cvs.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from vc/vc-cvs.el (defun vc-cvs-registered (f) "Return non-nil if file F is registered with CVS." @@ -29649,7 +29739,8 @@ Name of the format file in a .bzr directory.") ;;;*** -;;;### (autoloads nil "vc-dir" "vc/vc-dir.el" (21291 53104 0 0)) +;;;### (autoloads nil "vc-dir" "vc/vc-dir.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from vc/vc-dir.el (autoload 'vc-dir "vc-dir" "\ @@ -29673,8 +29764,8 @@ These are the commands available for use in the file status buffer: ;;;*** -;;;### (autoloads nil "vc-dispatcher" "vc/vc-dispatcher.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "vc-dispatcher" "vc/vc-dispatcher.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from vc/vc-dispatcher.el (autoload 'vc-do-command "vc-dispatcher" "\ @@ -29697,7 +29788,8 @@ case, and the process object in the asynchronous case. ;;;*** -;;;### (autoloads nil "vc-git" "vc/vc-git.el" (21291 53104 0 0)) +;;;### (autoloads nil "vc-git" "vc/vc-git.el" (21274 64565 737222 +;;;;;; 0)) ;;; Generated autoloads from vc/vc-git.el (defun vc-git-registered (file) "Return non-nil if FILE is registered with git." @@ -29708,7 +29800,7 @@ case, and the process object in the asynchronous case. ;;;*** -;;;### (autoloads nil "vc-hg" "vc/vc-hg.el" (21359 23622 725850 0)) +;;;### (autoloads nil "vc-hg" "vc/vc-hg.el" (21360 40869 887231 0)) ;;; Generated autoloads from vc/vc-hg.el (defun vc-hg-registered (file) "Return non-nil if FILE is registered with hg." @@ -29719,7 +29811,8 @@ case, and the process object in the asynchronous case. ;;;*** -;;;### (autoloads nil "vc-mtn" "vc/vc-mtn.el" (21291 53104 0 0)) +;;;### (autoloads nil "vc-mtn" "vc/vc-mtn.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from vc/vc-mtn.el (defconst vc-mtn-admin-dir "_MTN" "\ @@ -29735,7 +29828,7 @@ Name of the monotone directory's format file.") ;;;*** -;;;### (autoloads nil "vc-rcs" "vc/vc-rcs.el" (21372 35662 356409 +;;;### (autoloads nil "vc-rcs" "vc/vc-rcs.el" (21379 5287 607434 ;;;;;; 0)) ;;; Generated autoloads from vc/vc-rcs.el @@ -29749,7 +29842,8 @@ For a description of possible values, see `vc-check-master-templates'.") ;;;*** -;;;### (autoloads nil "vc-sccs" "vc/vc-sccs.el" (21291 53104 0 0)) +;;;### (autoloads nil "vc-sccs" "vc/vc-sccs.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from vc/vc-sccs.el (defvar vc-sccs-master-templates (purecopy '("%sSCCS/s.%s" "%ss.%s" vc-sccs-search-project-dir)) "\ @@ -29767,7 +29861,8 @@ find any project directory." (let ((project-dir (getenv "PROJECTDIR")) dirs dir) ;;;*** -;;;### (autoloads nil "vc-svn" "vc/vc-svn.el" (21291 53104 0 0)) +;;;### (autoloads nil "vc-svn" "vc/vc-svn.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from vc/vc-svn.el (defun vc-svn-registered (f) (let ((admin-dir (cond ((and (eq system-type 'windows-nt) @@ -29780,8 +29875,8 @@ find any project directory." (let ((project-dir (getenv "PROJECTDIR")) dirs dir) ;;;*** -;;;### (autoloads nil "vera-mode" "progmodes/vera-mode.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "vera-mode" "progmodes/vera-mode.el" (21383 +;;;;;; 2343 498187 0)) ;;; Generated autoloads from progmodes/vera-mode.el (push (purecopy '(vera-mode 2 28)) package--builtin-versions) (add-to-list 'auto-mode-alist (cons (purecopy "\\.vr[hi]?\\'") 'vera-mode)) @@ -29840,7 +29935,7 @@ Key bindings: ;;;*** ;;;### (autoloads nil "verilog-mode" "progmodes/verilog-mode.el" -;;;;;; (21346 62196 0 0)) +;;;;;; (21383 2343 498187 0)) ;;; Generated autoloads from progmodes/verilog-mode.el (autoload 'verilog-mode "verilog-mode" "\ @@ -29979,8 +30074,8 @@ Key bindings specific to `verilog-mode-map' are: ;;;*** -;;;### (autoloads nil "vhdl-mode" "progmodes/vhdl-mode.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "vhdl-mode" "progmodes/vhdl-mode.el" (21305 +;;;;;; 16557 836987 0)) ;;; Generated autoloads from progmodes/vhdl-mode.el (autoload 'vhdl-mode "vhdl-mode" "\ @@ -30534,7 +30629,8 @@ Key bindings: ;;;*** -;;;### (autoloads nil "vi" "emulation/vi.el" (21291 53104 0 0)) +;;;### (autoloads nil "vi" "emulation/vi.el" (20929 34089 117790 +;;;;;; 0)) ;;; Generated autoloads from emulation/vi.el (autoload 'vi-mode "vi" "\ @@ -30586,8 +30682,8 @@ Syntax table and abbrevs while in vi mode remain as they were in Emacs. ;;;*** -;;;### (autoloads nil "viet-util" "language/viet-util.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "viet-util" "language/viet-util.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from language/viet-util.el (autoload 'viet-encode-viscii-char "viet-util" "\ @@ -30631,7 +30727,7 @@ Convert Vietnamese characters of the current buffer to `VIQR' mnemonics. ;;;*** -;;;### (autoloads nil "view" "view.el" (21291 53104 0 0)) +;;;### (autoloads nil "view" "view.el" (21187 63826 213216 0)) ;;; Generated autoloads from view.el (defvar view-remove-frame-by-deleting t "\ @@ -30887,7 +30983,8 @@ Exit View mode and make the current buffer editable. ;;;*** -;;;### (autoloads nil "vip" "emulation/vip.el" (21291 53104 0 0)) +;;;### (autoloads nil "vip" "emulation/vip.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from emulation/vip.el (autoload 'vip-setup "vip" "\ @@ -30902,7 +30999,7 @@ Turn on VIP emulation of VI. ;;;*** -;;;### (autoloads nil "viper" "emulation/viper.el" (21291 53104 0 +;;;### (autoloads nil "viper" "emulation/viper.el" (21222 16439 978802 ;;;;;; 0)) ;;; Generated autoloads from emulation/viper.el (push (purecopy '(viper 3 14 1)) package--builtin-versions) @@ -30920,8 +31017,8 @@ Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'. ;;;*** -;;;### (autoloads nil "warnings" "emacs-lisp/warnings.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "warnings" "emacs-lisp/warnings.el" (21240 +;;;;;; 46395 727291 0)) ;;; Generated autoloads from emacs-lisp/warnings.el (defvar warning-prefix-function nil "\ @@ -31011,7 +31108,7 @@ this is equivalent to `display-warning', using ;;;*** -;;;### (autoloads nil "wdired" "wdired.el" (21291 53104 0 0)) +;;;### (autoloads nil "wdired" "wdired.el" (21187 63826 213216 0)) ;;; Generated autoloads from wdired.el (push (purecopy '(wdired 2 0)) package--builtin-versions) @@ -31029,7 +31126,8 @@ See `wdired-mode'. ;;;*** -;;;### (autoloads nil "webjump" "net/webjump.el" (21291 53104 0 0)) +;;;### (autoloads nil "webjump" "net/webjump.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from net/webjump.el (autoload 'webjump "webjump" "\ @@ -31045,8 +31143,8 @@ Please submit bug reports and other feedback to the author, Neil W. Van Dyke ;;;*** -;;;### (autoloads nil "which-func" "progmodes/which-func.el" (21291 -;;;;;; 53104 0 0)) +;;;### (autoloads nil "which-func" "progmodes/which-func.el" (21187 +;;;;;; 63826 213216 0)) ;;; Generated autoloads from progmodes/which-func.el (put 'which-func-format 'risky-local-variable t) (put 'which-func-current 'risky-local-variable t) @@ -31076,7 +31174,7 @@ in certain major modes. ;;;*** -;;;### (autoloads nil "whitespace" "whitespace.el" (21291 53104 0 +;;;### (autoloads nil "whitespace" "whitespace.el" (21384 23211 329821 ;;;;;; 0)) ;;; Generated autoloads from whitespace.el (push (purecopy '(whitespace 13 2 2)) package--builtin-versions) @@ -31391,43 +31489,7 @@ documentation. (autoload 'whitespace-report "whitespace" "\ Report some whitespace problems in buffer. -Return nil if there is no whitespace problem; otherwise, return -non-nil. - -If FORCE is non-nil or \\[universal-argument] was pressed just -before calling `whitespace-report' interactively, it forces -`whitespace-style' to have: - - empty - trailing - indentation - space-before-tab - space-after-tab - -If REPORT-IF-BOGUS is non-nil, it reports only when there are any -whitespace problems in buffer. - -Report if some of the following whitespace problems exist: - -* If `indent-tabs-mode' is non-nil: - empty 1. empty lines at beginning of buffer. - empty 2. empty lines at end of buffer. - trailing 3. SPACEs or TABs at end of line. - indentation 4. 8 or more SPACEs at beginning of line. - space-before-tab 5. SPACEs before TAB. - space-after-tab 6. 8 or more SPACEs after TAB. - -* If `indent-tabs-mode' is nil: - empty 1. empty lines at beginning of buffer. - empty 2. empty lines at end of buffer. - trailing 3. SPACEs or TABs at end of line. - indentation 4. TABS at beginning of line. - space-before-tab 5. SPACEs before TAB. - space-after-tab 6. 8 or more SPACEs after TAB. - -See `whitespace-style' for documentation. -See also `whitespace-cleanup' and `whitespace-cleanup-region' for -cleaning up these problems. +Perform `whitespace-report-region' on the current buffer. \(fn &optional FORCE REPORT-IF-BOGUS)" t nil) @@ -31442,13 +31504,14 @@ before calling `whitespace-report-region' interactively, it forces `whitespace-style' to have: empty + trailing indentation space-before-tab - trailing space-after-tab -If REPORT-IF-BOGUS is non-nil, it reports only when there are any -whitespace problems in buffer. +If REPORT-IF-BOGUS is t, it reports only when there are any +whitespace problems in buffer; if it is `never', it does not +report problems. Report if some of the following whitespace problems exist: @@ -31476,7 +31539,7 @@ cleaning up these problems. ;;;*** -;;;### (autoloads nil "wid-browse" "wid-browse.el" (21291 53104 0 +;;;### (autoloads nil "wid-browse" "wid-browse.el" (21187 63826 213216 ;;;;;; 0)) ;;; Generated autoloads from wid-browse.el @@ -31505,7 +31568,8 @@ if ARG is omitted or nil. ;;;*** -;;;### (autoloads nil "wid-edit" "wid-edit.el" (21291 53104 0 0)) +;;;### (autoloads nil "wid-edit" "wid-edit.el" (21240 46395 727291 +;;;;;; 0)) ;;; Generated autoloads from wid-edit.el (autoload 'widgetp "wid-edit" "\ @@ -31547,7 +31611,8 @@ Setup current buffer so editing string widgets works. ;;;*** -;;;### (autoloads nil "windmove" "windmove.el" (21291 53104 0 0)) +;;;### (autoloads nil "windmove" "windmove.el" (21187 63826 213216 +;;;;;; 0)) ;;; Generated autoloads from windmove.el (autoload 'windmove-left "windmove" "\ @@ -31599,7 +31664,7 @@ Default MODIFIER is 'shift. ;;;*** -;;;### (autoloads nil "winner" "winner.el" (21291 53104 0 0)) +;;;### (autoloads nil "winner" "winner.el" (21187 63826 213216 0)) ;;; Generated autoloads from winner.el (defvar winner-mode nil "\ @@ -31622,7 +31687,7 @@ the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. ;;;*** -;;;### (autoloads nil "woman" "woman.el" (21291 53104 0 0)) +;;;### (autoloads nil "woman" "woman.el" (21240 46395 727291 0)) ;;; Generated autoloads from woman.el (push (purecopy '(woman 0 551)) package--builtin-versions) @@ -31671,8 +31736,8 @@ Default bookmark handler for Woman buffers. ;;;*** -;;;### (autoloads nil "ws-mode" "emulation/ws-mode.el" (21291 53104 -;;;;;; 0 0)) +;;;### (autoloads nil "ws-mode" "emulation/ws-mode.el" (21187 63826 +;;;;;; 213216 0)) ;;; Generated autoloads from emulation/ws-mode.el (push (purecopy '(ws-mode 0 7)) package--builtin-versions) @@ -31693,7 +31758,7 @@ Emacs-like. ;;;*** -;;;### (autoloads nil "xml" "xml.el" (21291 53104 0 0)) +;;;### (autoloads nil "xml" "xml.el" (21187 63826 213216 0)) ;;; Generated autoloads from xml.el (autoload 'xml-parse-file "xml" "\ @@ -31749,7 +31814,8 @@ Both features can be combined by providing a cons cell ;;;*** -;;;### (autoloads nil "xmltok" "nxml/xmltok.el" (21341 23900 0 0)) +;;;### (autoloads nil "xmltok" "nxml/xmltok.el" (21327 43559 923043 +;;;;;; 0)) ;;; Generated autoloads from nxml/xmltok.el (autoload 'xmltok-get-declared-encoding-position "xmltok" "\ @@ -31767,7 +31833,7 @@ If LIMIT is non-nil, then do not consider characters beyond LIMIT. ;;;*** -;;;### (autoloads nil "xt-mouse" "xt-mouse.el" (21355 26558 898613 +;;;### (autoloads nil "xt-mouse" "xt-mouse.el" (21359 20005 772941 ;;;;;; 0)) ;;; Generated autoloads from xt-mouse.el @@ -31797,7 +31863,7 @@ down the SHIFT key while pressing the mouse button. ;;;*** -;;;### (autoloads nil "yenc" "gnus/yenc.el" (21291 53104 0 0)) +;;;### (autoloads nil "yenc" "gnus/yenc.el" (21187 63826 213216 0)) ;;; Generated autoloads from gnus/yenc.el (autoload 'yenc-decode-region "yenc" "\ @@ -31812,7 +31878,7 @@ Extract file name from an yenc header. ;;;*** -;;;### (autoloads nil "zone" "play/zone.el" (21291 53104 0 0)) +;;;### (autoloads nil "zone" "play/zone.el" (21187 63826 213216 0)) ;;; Generated autoloads from play/zone.el (autoload 'zone "zone" "\ @@ -31857,16 +31923,14 @@ Zone out, completely. ;;;;;; "cedet/ede/util.el" "cedet/semantic/analyze.el" "cedet/semantic/analyze/complete.el" ;;;;;; "cedet/semantic/analyze/debug.el" "cedet/semantic/analyze/fcn.el" ;;;;;; "cedet/semantic/analyze/refs.el" "cedet/semantic/bovine.el" -;;;;;; "cedet/semantic/bovine/c-by.el" "cedet/semantic/bovine/c.el" -;;;;;; "cedet/semantic/bovine/debug.el" "cedet/semantic/bovine/el.el" -;;;;;; "cedet/semantic/bovine/gcc.el" "cedet/semantic/bovine/make-by.el" -;;;;;; "cedet/semantic/bovine/make.el" "cedet/semantic/bovine/scm-by.el" -;;;;;; "cedet/semantic/bovine/scm.el" "cedet/semantic/chart.el" -;;;;;; "cedet/semantic/complete.el" "cedet/semantic/ctxt.el" "cedet/semantic/db-debug.el" -;;;;;; "cedet/semantic/db-ebrowse.el" "cedet/semantic/db-el.el" -;;;;;; "cedet/semantic/db-file.el" "cedet/semantic/db-find.el" "cedet/semantic/db-global.el" -;;;;;; "cedet/semantic/db-javascript.el" "cedet/semantic/db-mode.el" -;;;;;; "cedet/semantic/db-ref.el" "cedet/semantic/db-typecache.el" +;;;;;; "cedet/semantic/bovine/c.el" "cedet/semantic/bovine/debug.el" +;;;;;; "cedet/semantic/bovine/el.el" "cedet/semantic/bovine/gcc.el" +;;;;;; "cedet/semantic/bovine/make.el" "cedet/semantic/bovine/scm.el" +;;;;;; "cedet/semantic/chart.el" "cedet/semantic/complete.el" "cedet/semantic/ctxt.el" +;;;;;; "cedet/semantic/db-debug.el" "cedet/semantic/db-ebrowse.el" +;;;;;; "cedet/semantic/db-el.el" "cedet/semantic/db-file.el" "cedet/semantic/db-find.el" +;;;;;; "cedet/semantic/db-global.el" "cedet/semantic/db-javascript.el" +;;;;;; "cedet/semantic/db-mode.el" "cedet/semantic/db-ref.el" "cedet/semantic/db-typecache.el" ;;;;;; "cedet/semantic/db.el" "cedet/semantic/debug.el" "cedet/semantic/decorate.el" ;;;;;; "cedet/semantic/decorate/include.el" "cedet/semantic/decorate/mode.el" ;;;;;; "cedet/semantic/dep.el" "cedet/semantic/doc.el" "cedet/semantic/ede-grammar.el" @@ -31884,26 +31948,23 @@ Zone out, completely. ;;;;;; "cedet/semantic/tag.el" "cedet/semantic/texi.el" "cedet/semantic/util-modes.el" ;;;;;; "cedet/semantic/util.el" "cedet/semantic/wisent.el" "cedet/semantic/wisent/comp.el" ;;;;;; "cedet/semantic/wisent/java-tags.el" "cedet/semantic/wisent/javascript.el" -;;;;;; "cedet/semantic/wisent/javat-wy.el" "cedet/semantic/wisent/js-wy.el" -;;;;;; "cedet/semantic/wisent/python-wy.el" "cedet/semantic/wisent/python.el" -;;;;;; "cedet/semantic/wisent/wisent.el" "cedet/srecode/args.el" -;;;;;; "cedet/srecode/compile.el" "cedet/srecode/cpp.el" "cedet/srecode/ctxt.el" -;;;;;; "cedet/srecode/dictionary.el" "cedet/srecode/document.el" +;;;;;; "cedet/semantic/wisent/python.el" "cedet/semantic/wisent/wisent.el" +;;;;;; "cedet/srecode/args.el" "cedet/srecode/compile.el" "cedet/srecode/cpp.el" +;;;;;; "cedet/srecode/ctxt.el" "cedet/srecode/dictionary.el" "cedet/srecode/document.el" ;;;;;; "cedet/srecode/el.el" "cedet/srecode/expandproto.el" "cedet/srecode/extract.el" ;;;;;; "cedet/srecode/fields.el" "cedet/srecode/filters.el" "cedet/srecode/find.el" ;;;;;; "cedet/srecode/getset.el" "cedet/srecode/insert.el" "cedet/srecode/java.el" ;;;;;; "cedet/srecode/map.el" "cedet/srecode/mode.el" "cedet/srecode/semantic.el" -;;;;;; "cedet/srecode/srt-wy.el" "cedet/srecode/srt.el" "cedet/srecode/table.el" -;;;;;; "cedet/srecode/template.el" "cedet/srecode/texi.el" "cus-dep.el" -;;;;;; "dframe.el" "dired-aux.el" "dired-x.el" "dos-fns.el" "dos-vars.el" -;;;;;; "dos-w32.el" "dynamic-setting.el" "emacs-lisp/authors.el" -;;;;;; "emacs-lisp/avl-tree.el" "emacs-lisp/bindat.el" "emacs-lisp/byte-opt.el" -;;;;;; "emacs-lisp/cl-extra.el" "emacs-lisp/cl-macs.el" "emacs-lisp/cl-seq.el" -;;;;;; "emacs-lisp/cl.el" "emacs-lisp/eieio-base.el" "emacs-lisp/eieio-custom.el" -;;;;;; "emacs-lisp/eieio-datadebug.el" "emacs-lisp/eieio-opt.el" -;;;;;; "emacs-lisp/eieio-speedbar.el" "emacs-lisp/gulp.el" "emacs-lisp/lisp-mnt.el" -;;;;;; "emacs-lisp/package-x.el" "emacs-lisp/smie.el" "emacs-lisp/subr-x.el" -;;;;;; "emacs-lisp/tcover-ses.el" "emacs-lisp/tcover-unsafep.el" +;;;;;; "cedet/srecode/srt.el" "cedet/srecode/table.el" "cedet/srecode/template.el" +;;;;;; "cedet/srecode/texi.el" "cus-dep.el" "dframe.el" "dired-aux.el" +;;;;;; "dired-x.el" "dos-fns.el" "dos-vars.el" "dos-w32.el" "dynamic-setting.el" +;;;;;; "emacs-lisp/authors.el" "emacs-lisp/avl-tree.el" "emacs-lisp/bindat.el" +;;;;;; "emacs-lisp/byte-opt.el" "emacs-lisp/cl-extra.el" "emacs-lisp/cl-macs.el" +;;;;;; "emacs-lisp/cl-seq.el" "emacs-lisp/cl.el" "emacs-lisp/eieio-base.el" +;;;;;; "emacs-lisp/eieio-custom.el" "emacs-lisp/eieio-datadebug.el" +;;;;;; "emacs-lisp/eieio-opt.el" "emacs-lisp/eieio-speedbar.el" +;;;;;; "emacs-lisp/lisp-mnt.el" "emacs-lisp/package-x.el" "emacs-lisp/smie.el" +;;;;;; "emacs-lisp/subr-x.el" "emacs-lisp/tcover-ses.el" "emacs-lisp/tcover-unsafep.el" ;;;;;; "emulation/cua-gmrk.el" "emulation/edt-lk201.el" "emulation/edt-mapper.el" ;;;;;; "emulation/edt-pc.el" "emulation/edt-vt100.el" "emulation/tpu-extras.el" ;;;;;; "emulation/viper-cmd.el" "emulation/viper-ex.el" "emulation/viper-init.el" @@ -31920,11 +31981,11 @@ Zone out, completely. ;;;;;; "eshell/esh-opt.el" "eshell/esh-proc.el" "eshell/esh-util.el" ;;;;;; "eshell/esh-var.el" "ezimage.el" "format-spec.el" "fringe.el" ;;;;;; "generic-x.el" "gnus/compface.el" "gnus/gnus-async.el" "gnus/gnus-bcklg.el" -;;;;;; "gnus/gnus-cite.el" "gnus/gnus-cus.el" "gnus/gnus-demon.el" -;;;;;; "gnus/gnus-dup.el" "gnus/gnus-eform.el" "gnus/gnus-ems.el" -;;;;;; "gnus/gnus-icalendar.el" "gnus/gnus-int.el" "gnus/gnus-logic.el" -;;;;;; "gnus/gnus-mh.el" "gnus/gnus-salt.el" "gnus/gnus-score.el" -;;;;;; "gnus/gnus-setup.el" "gnus/gnus-srvr.el" "gnus/gnus-topic.el" +;;;;;; "gnus/gnus-cite.el" "gnus/gnus-cloud.el" "gnus/gnus-cus.el" +;;;;;; "gnus/gnus-demon.el" "gnus/gnus-dup.el" "gnus/gnus-eform.el" +;;;;;; "gnus/gnus-ems.el" "gnus/gnus-icalendar.el" "gnus/gnus-int.el" +;;;;;; "gnus/gnus-logic.el" "gnus/gnus-mh.el" "gnus/gnus-salt.el" +;;;;;; "gnus/gnus-score.el" "gnus/gnus-srvr.el" "gnus/gnus-topic.el" ;;;;;; "gnus/gnus-undo.el" "gnus/gnus-util.el" "gnus/gnus-uu.el" ;;;;;; "gnus/gnus-vm.el" "gnus/gssapi.el" "gnus/ietf-drums.el" "gnus/legacy-gnus-agent.el" ;;;;;; "gnus/mail-parse.el" "gnus/mail-prsvr.el" "gnus/mail-source.el" @@ -31942,15 +32003,8 @@ Zone out, completely. ;;;;;; "gnus/spam-wash.el" "hex-util.el" "hfy-cmap.el" "ibuf-ext.el" ;;;;;; "international/cp51932.el" "international/eucjp-ms.el" "international/fontset.el" ;;;;;; "international/iso-ascii.el" "international/ja-dic-cnv.el" -;;;;;; "international/ja-dic-utl.el" "international/ogonek.el" "international/uni-bidi.el" -;;;;;; "international/uni-category.el" "international/uni-combining.el" -;;;;;; "international/uni-comment.el" "international/uni-decimal.el" -;;;;;; "international/uni-decomposition.el" "international/uni-digit.el" -;;;;;; "international/uni-lowercase.el" "international/uni-mirrored.el" -;;;;;; "international/uni-name.el" "international/uni-numeric.el" -;;;;;; "international/uni-old-name.el" "international/uni-titlecase.el" -;;;;;; "international/uni-uppercase.el" "kermit.el" "language/hanja-util.el" -;;;;;; "language/thai-word.el" "ldefs-boot.el" "leim/ja-dic/ja-dic.el" +;;;;;; "international/ja-dic-utl.el" "international/ogonek.el" "kermit.el" +;;;;;; "language/hanja-util.el" "language/thai-word.el" "ldefs-boot.el" ;;;;;; "leim/quail/arabic.el" "leim/quail/croatian.el" "leim/quail/cyril-jis.el" ;;;;;; "leim/quail/cyrillic.el" "leim/quail/czech.el" "leim/quail/ethiopic.el" ;;;;;; "leim/quail/georgian.el" "leim/quail/greek.el" "leim/quail/hanja-jis.el" @@ -31974,43 +32028,58 @@ Zone out, completely. ;;;;;; "mh-e/mh-loaddefs.el" "mh-e/mh-mime.el" "mh-e/mh-print.el" ;;;;;; "mh-e/mh-scan.el" "mh-e/mh-search.el" "mh-e/mh-seq.el" "mh-e/mh-show.el" ;;;;;; "mh-e/mh-speed.el" "mh-e/mh-thread.el" "mh-e/mh-tool-bar.el" -;;;;;; "mh-e/mh-utils.el" "mh-e/mh-xface.el" "mouse-copy.el" "mouse.el" -;;;;;; "mwheel.el" "net/dns.el" "net/eudc-vars.el" "net/eudcb-bbdb.el" -;;;;;; "net/eudcb-ldap.el" "net/eudcb-mab.el" "net/eudcb-ph.el" -;;;;;; "net/hmac-def.el" "net/hmac-md5.el" "net/imap.el" "net/ldap.el" -;;;;;; "net/mairix.el" "net/sasl-cram.el" "net/sasl-digest.el" "net/sasl.el" -;;;;;; "net/shr-color.el" "net/soap-client.el" "net/soap-inspect.el" -;;;;;; "net/socks.el" "net/tls.el" "net/tramp-adb.el" "net/tramp-cache.el" -;;;;;; "net/tramp-cmds.el" "net/tramp-compat.el" "net/tramp-gvfs.el" -;;;;;; "net/tramp-gw.el" "net/tramp-loaddefs.el" "net/tramp-sh.el" -;;;;;; "net/tramp-smb.el" "net/tramp-uu.el" "net/trampver.el" "net/zeroconf.el" -;;;;;; "notifications.el" "nxml/nxml-enc.el" "nxml/nxml-maint.el" +;;;;;; "mh-e/mh-utils.el" "mh-e/mh-xface.el" "mouse-copy.el" "mwheel.el" +;;;;;; "net/dns.el" "net/eudc-vars.el" "net/eudcb-bbdb.el" "net/eudcb-ldap.el" +;;;;;; "net/eudcb-mab.el" "net/eudcb-ph.el" "net/hmac-def.el" "net/hmac-md5.el" +;;;;;; "net/imap.el" "net/ldap.el" "net/mairix.el" "net/sasl-cram.el" +;;;;;; "net/sasl-digest.el" "net/sasl.el" "net/shr-color.el" "net/soap-client.el" +;;;;;; "net/soap-inspect.el" "net/socks.el" "net/tls.el" "net/tramp-adb.el" +;;;;;; "net/tramp-cache.el" "net/tramp-cmds.el" "net/tramp-compat.el" +;;;;;; "net/tramp-gvfs.el" "net/tramp-gw.el" "net/tramp-loaddefs.el" +;;;;;; "net/tramp-sh.el" "net/tramp-smb.el" "net/tramp-uu.el" "net/trampver.el" +;;;;;; "net/zeroconf.el" "notifications.el" "nxml/nxml-enc.el" "nxml/nxml-maint.el" ;;;;;; "nxml/nxml-ns.el" "nxml/nxml-outln.el" "nxml/nxml-parse.el" ;;;;;; "nxml/nxml-rap.el" "nxml/nxml-util.el" "nxml/rng-dt.el" "nxml/rng-loc.el" ;;;;;; "nxml/rng-maint.el" "nxml/rng-match.el" "nxml/rng-parse.el" ;;;;;; "nxml/rng-pttrn.el" "nxml/rng-uri.el" "nxml/rng-util.el" -;;;;;; "nxml/xsd-regexp.el" "org/ob-C.el" "org/ob-R.el" "org/ob-asymptote.el" -;;;;;; "org/ob-awk.el" "org/ob-calc.el" "org/ob-clojure.el" "org/ob-comint.el" -;;;;;; "org/ob-core.el" "org/ob-css.el" "org/ob-ditaa.el" "org/ob-dot.el" -;;;;;; "org/ob-emacs-lisp.el" "org/ob-eval.el" "org/ob-exp.el" "org/ob-fortran.el" -;;;;;; "org/ob-gnuplot.el" "org/ob-haskell.el" "org/ob-io.el" "org/ob-java.el" -;;;;;; "org/ob-js.el" "org/ob-keys.el" "org/ob-latex.el" "org/ob-ledger.el" -;;;;;; "org/ob-lilypond.el" "org/ob-lisp.el" "org/ob-lob.el" "org/ob-makefile.el" -;;;;;; "org/ob-matlab.el" "org/ob-maxima.el" "org/ob-mscgen.el" -;;;;;; "org/ob-ocaml.el" "org/ob-octave.el" "org/ob-org.el" "org/ob-perl.el" -;;;;;; "org/ob-picolisp.el" "org/ob-plantuml.el" "org/ob-python.el" -;;;;;; "org/ob-ref.el" "org/ob-ruby.el" "org/ob-sass.el" "org/ob-scala.el" -;;;;;; "org/ob-scheme.el" "org/ob-screen.el" "org/ob-sh.el" "org/ob-shen.el" -;;;;;; "org/ob-sql.el" "org/ob-sqlite.el" "org/ob-table.el" "org/ob-tangle.el" -;;;;;; "org/ob.el" "org/org-archive.el" "org/org-attach.el" "org/org-bbdb.el" -;;;;;; "org/org-bibtex.el" "org/org-clock.el" "org/org-crypt.el" -;;;;;; "org/org-ctags.el" "org/org-datetree.el" "org/org-docview.el" -;;;;;; "org/org-element.el" "org/org-entities.el" "org/org-eshell.el" -;;;;;; "org/org-faces.el" "org/org-feed.el" "org/org-footnote.el" -;;;;;; "org/org-gnus.el" "org/org-habit.el" "org/org-id.el" "org/org-indent.el" -;;;;;; "org/org-info.el" "org/org-inlinetask.el" "org/org-install.el" -;;;;;; "org/org-irc.el" "org/org-list.el" "org/org-macro.el" "org/org-mhe.el" -;;;;;; "org/org-mobile.el" "org/org-mouse.el" "org/org-pcomplete.el" +;;;;;; "nxml/xsd-regexp.el" "obsolete/abbrevlist.el" "obsolete/assoc.el" +;;;;;; "obsolete/awk-mode.el" "obsolete/bruce.el" "obsolete/cl-compat.el" +;;;;;; "obsolete/complete.el" "obsolete/cust-print.el" "obsolete/erc-hecomplete.el" +;;;;;; "obsolete/fast-lock.el" "obsolete/gulp.el" "obsolete/iso-acc.el" +;;;;;; "obsolete/iso-insert.el" "obsolete/iso-swed.el" "obsolete/keyswap.el" +;;;;;; "obsolete/lazy-lock.el" "obsolete/ledit.el" "obsolete/levents.el" +;;;;;; "obsolete/lmenu.el" "obsolete/longlines.el" "obsolete/lucid.el" +;;;;;; "obsolete/mailpost.el" "obsolete/meese.el" "obsolete/mouse-sel.el" +;;;;;; "obsolete/old-emacs-lock.el" "obsolete/old-whitespace.el" +;;;;;; "obsolete/options.el" "obsolete/otodo-mode.el" "obsolete/patcomp.el" +;;;;;; "obsolete/pc-mode.el" "obsolete/pc-select.el" "obsolete/pgg-def.el" +;;;;;; "obsolete/pgg-gpg.el" "obsolete/pgg-parse.el" "obsolete/pgg-pgp.el" +;;;;;; "obsolete/pgg-pgp5.el" "obsolete/pgg.el" "obsolete/rcompile.el" +;;;;;; "obsolete/resume.el" "obsolete/s-region.el" "obsolete/scribe.el" +;;;;;; "obsolete/spell.el" "obsolete/sregex.el" "obsolete/sup-mouse.el" +;;;;;; "obsolete/swedish.el" "obsolete/sym-comp.el" "obsolete/terminal.el" +;;;;;; "obsolete/vc-mcvs.el" "obsolete/xesam.el" "obsolete/yow.el" +;;;;;; "org/ob-C.el" "org/ob-R.el" "org/ob-asymptote.el" "org/ob-awk.el" +;;;;;; "org/ob-calc.el" "org/ob-clojure.el" "org/ob-comint.el" "org/ob-core.el" +;;;;;; "org/ob-css.el" "org/ob-ditaa.el" "org/ob-dot.el" "org/ob-emacs-lisp.el" +;;;;;; "org/ob-eval.el" "org/ob-exp.el" "org/ob-fortran.el" "org/ob-gnuplot.el" +;;;;;; "org/ob-haskell.el" "org/ob-io.el" "org/ob-java.el" "org/ob-js.el" +;;;;;; "org/ob-keys.el" "org/ob-latex.el" "org/ob-ledger.el" "org/ob-lilypond.el" +;;;;;; "org/ob-lisp.el" "org/ob-lob.el" "org/ob-makefile.el" "org/ob-matlab.el" +;;;;;; "org/ob-maxima.el" "org/ob-mscgen.el" "org/ob-ocaml.el" "org/ob-octave.el" +;;;;;; "org/ob-org.el" "org/ob-perl.el" "org/ob-picolisp.el" "org/ob-plantuml.el" +;;;;;; "org/ob-python.el" "org/ob-ref.el" "org/ob-ruby.el" "org/ob-sass.el" +;;;;;; "org/ob-scala.el" "org/ob-scheme.el" "org/ob-screen.el" "org/ob-sh.el" +;;;;;; "org/ob-shen.el" "org/ob-sql.el" "org/ob-sqlite.el" "org/ob-table.el" +;;;;;; "org/ob-tangle.el" "org/ob.el" "org/org-archive.el" "org/org-attach.el" +;;;;;; "org/org-bbdb.el" "org/org-bibtex.el" "org/org-clock.el" +;;;;;; "org/org-crypt.el" "org/org-ctags.el" "org/org-datetree.el" +;;;;;; "org/org-docview.el" "org/org-element.el" "org/org-entities.el" +;;;;;; "org/org-eshell.el" "org/org-faces.el" "org/org-feed.el" +;;;;;; "org/org-footnote.el" "org/org-gnus.el" "org/org-habit.el" +;;;;;; "org/org-id.el" "org/org-indent.el" "org/org-info.el" "org/org-inlinetask.el" +;;;;;; "org/org-install.el" "org/org-irc.el" "org/org-list.el" "org/org-macro.el" +;;;;;; "org/org-mhe.el" "org/org-mobile.el" "org/org-mouse.el" "org/org-pcomplete.el" ;;;;;; "org/org-plot.el" "org/org-protocol.el" "org/org-rmail.el" ;;;;;; "org/org-src.el" "org/org-table.el" "org/org-timer.el" "org/org-w3m.el" ;;;;;; "org/ox-ascii.el" "org/ox-beamer.el" "org/ox-html.el" "org/ox-icalendar.el" @@ -32024,22 +32093,23 @@ Zone out, completely. ;;;;;; "progmodes/ebnf-otz.el" "progmodes/ebnf-yac.el" "progmodes/idlw-complete-structtag.el" ;;;;;; "progmodes/idlw-help.el" "progmodes/idlw-toolbar.el" "progmodes/mantemp.el" ;;;;;; "progmodes/xscheme.el" "ps-def.el" "ps-mule.el" "ps-samp.el" -;;;;;; "saveplace.el" "sb-image.el" "scroll-bar.el" "select.el" -;;;;;; "soundex.el" "subdirs.el" "tempo.el" "textmodes/bib-mode.el" -;;;;;; "textmodes/makeinfo.el" "textmodes/page-ext.el" "textmodes/refbib.el" -;;;;;; "textmodes/refer.el" "textmodes/reftex-auc.el" "textmodes/reftex-dcr.el" -;;;;;; "textmodes/reftex-ref.el" "textmodes/reftex-sel.el" "textmodes/reftex-toc.el" -;;;;;; "textmodes/texnfo-upd.el" "timezone.el" "tooltip.el" "tree-widget.el" -;;;;;; "url/url-about.el" "url/url-cookie.el" "url/url-dired.el" -;;;;;; "url/url-domsuf.el" "url/url-expand.el" "url/url-ftp.el" -;;;;;; "url/url-future.el" "url/url-history.el" "url/url-imap.el" -;;;;;; "url/url-methods.el" "url/url-nfs.el" "url/url-proxy.el" +;;;;;; "saveplace.el" "sb-image.el" "scroll-bar.el" "soundex.el" +;;;;;; "subdirs.el" "tempo.el" "textmodes/bib-mode.el" "textmodes/makeinfo.el" +;;;;;; "textmodes/page-ext.el" "textmodes/refbib.el" "textmodes/refer.el" +;;;;;; "textmodes/reftex-auc.el" "textmodes/reftex-cite.el" "textmodes/reftex-dcr.el" +;;;;;; "textmodes/reftex-global.el" "textmodes/reftex-index.el" +;;;;;; "textmodes/reftex-parse.el" "textmodes/reftex-ref.el" "textmodes/reftex-sel.el" +;;;;;; "textmodes/reftex-toc.el" "textmodes/texnfo-upd.el" "timezone.el" +;;;;;; "tooltip.el" "tree-widget.el" "url/url-about.el" "url/url-cookie.el" +;;;;;; "url/url-dired.el" "url/url-domsuf.el" "url/url-expand.el" +;;;;;; "url/url-ftp.el" "url/url-future.el" "url/url-history.el" +;;;;;; "url/url-imap.el" "url/url-methods.el" "url/url-nfs.el" "url/url-proxy.el" ;;;;;; "url/url-vars.el" "vc/ediff-diff.el" "vc/ediff-init.el" "vc/ediff-merg.el" ;;;;;; "vc/ediff-ptch.el" "vc/ediff-vers.el" "vc/ediff-wind.el" ;;;;;; "vc/pcvs-info.el" "vc/pcvs-parse.el" "vc/pcvs-util.el" "vc/vc-dav.el" ;;;;;; "vcursor.el" "vt-control.el" "vt100-led.el" "w32-common-fns.el" -;;;;;; "w32-fns.el" "w32-vars.el" "x-dnd.el") (21387 3291 190295 -;;;;;; 453000)) +;;;;;; "w32-fns.el" "w32-vars.el" "x-dnd.el") (21386 65266 511227 +;;;;;; 583000)) ;;;*** diff --git a/lisp/leim/quail/sisheng.el b/lisp/leim/quail/sisheng.el index 35a5f41f323..f87204f4db4 100644 --- a/lisp/leim/quail/sisheng.el +++ b/lisp/leim/quail/sisheng.el @@ -249,42 +249,40 @@ Example: nve5 -> nüe ;; Call quail-make-sisheng-rules for all syllables in sisheng-syllable-table. ;; -(let ((case-table-save (current-case-table)) - sisheng-list) - (set-case-table (standard-case-table)) - (dolist (syllable sisheng-syllable-table) - (setq sisheng-list - (append (quail-make-sisheng-rules syllable) - sisheng-list))) - - (dolist (syllable sisheng-syllable-table) - (setq sisheng-list - (append (quail-make-sisheng-rules (upcase-initials syllable)) - sisheng-list))) - - (dolist (syllable sisheng-syllable-table) - (setq sisheng-list - (append (quail-make-sisheng-rules (upcase syllable)) - sisheng-list))) - - (eval `(quail-define-rules - ,@sisheng-list - - ("lv5" ["lü"]) - ("lve5" ["lüe"]) - ("nv5" ["nü"]) - ("nve5" ["nüe"]) - - ("Lv5" ["Lü"]) - ("Lve5" ["Lüe"]) - ("Nv5" ["Nü"]) - ("Nve5" ["Nüe"]) - - ("LV5" ["LÜ"]) - ("LVE5" ["LÜE"]) - ("NV5" ["NÜ"]) - ("NVE5" ["NÜE"]))) - (set-case-table case-table-save)) +(let (sisheng-list) + (with-case-table (standard-case-table) ;FIXME: Why? + (dolist (syllable sisheng-syllable-table) + (setq sisheng-list + (append (quail-make-sisheng-rules syllable) + sisheng-list))) + + (dolist (syllable sisheng-syllable-table) + (setq sisheng-list + (append (quail-make-sisheng-rules (upcase-initials syllable)) + sisheng-list))) + + (dolist (syllable sisheng-syllable-table) + (setq sisheng-list + (append (quail-make-sisheng-rules (upcase syllable)) + sisheng-list))) + + (eval `(quail-define-rules + ,@sisheng-list + + ("lv5" ["lü"]) + ("lve5" ["lüe"]) + ("nv5" ["nü"]) + ("nve5" ["nüe"]) + + ("Lv5" ["Lü"]) + ("Lve5" ["Lüe"]) + ("Nv5" ["Nü"]) + ("Nve5" ["Nüe"]) + + ("LV5" ["LÜ"]) + ("LVE5" ["LÜE"]) + ("NV5" ["NÜ"]) + ("NVE5" ["NÜE"]))))) ;; Local Variables: ;; coding: utf-8 diff --git a/lisp/loadup.el b/lisp/loadup.el index 8d009ed5165..b911e9f1768 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -1,7 +1,7 @@ ;;; loadup.el --- load up standardly loaded Lisp files for Emacs -;; Copyright (C) 1985-1986, 1992, 1994, 2001-2014 Free Software -;; Foundation, Inc. +;; Copyright (C) 1985-1986, 1992, 1994, 2001-2014 +;; Free Software Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org ;; Keywords: internal @@ -46,8 +46,7 @@ ;; Add subdirectories to the load-path for files that might get ;; autoloaded when bootstrapping. ;; This is because PATH_DUMPLOADSEARCH is just "../lisp". -(if (or (equal (nth 3 command-line-args) "bootstrap") - (equal (nth 4 command-line-args) "bootstrap") +(if (or (equal (member "bootstrap" command-line-args) '("bootstrap")) ;; FIXME this is irritatingly fragile. (equal (nth 4 command-line-args) "unidata-gen.el") (equal (nth 7 command-line-args) "unidata-gen-files") @@ -70,11 +69,15 @@ (message "Using load-path %s" load-path) -(if (or (member (nth 3 command-line-args) '("dump" "bootstrap")) - (member (nth 4 command-line-args) '("dump" "bootstrap"))) - ;; To reduce the size of dumped Emacs, we avoid making huge - ;; char-tables. - (setq inhibit-load-charset-map t)) +;; This is a poor man's `last', since we haven't loaded subr.el yet. +(if (or (equal (member "bootstrap" command-line-args) '("bootstrap")) + (equal (member "dump" command-line-args) '("dump"))) + (progn + ;; To reduce the size of dumped Emacs, we avoid making huge char-tables. + (setq inhibit-load-charset-map t) + ;; --eval gets handled too late. + (defvar load--prefer-newer load-prefer-newer) + (setq load-prefer-newer t))) ;; We don't want to have any undo records in the dumped Emacs. (set-buffer "*scratch*") @@ -198,12 +201,10 @@ (load "font-lock") (load "jit-lock") -(if (fboundp 'track-mouse) - (progn - (load "mouse") - (and (boundp 'x-toolkit-scroll-bars) - (load "scroll-bar")) - (load "select"))) +(load "mouse") +(if (boundp 'x-toolkit-scroll-bars) + (load "scroll-bar")) +(load "select") (load "emacs-lisp/timer") (load "isearch") (load "rfn-eshadow") @@ -308,17 +309,13 @@ lost after dumping"))) ;; file primitive. So the only workable solution to support building ;; in non-ASCII directories is to manipulate unibyte strings in the ;; current locale's encoding. -(if (and (or (equal (nth 3 command-line-args) "dump") - (equal (nth 4 command-line-args) "dump") - (equal (nth 3 command-line-args) "bootstrap") - (equal (nth 4 command-line-args) "bootstrap")) +(if (and (member (car (last command-line-args)) '("dump" "bootstrap")) (multibyte-string-p default-directory)) (error "default-directory must be unibyte when dumping Emacs!")) ;; Determine which last version number to use ;; based on the executables that now exist. -(if (and (or (equal (nth 3 command-line-args) "dump") - (equal (nth 4 command-line-args) "dump")) +(if (and (equal (last command-line-args) '("dump")) (not (eq system-type 'ms-dos))) (let* ((base (concat "emacs-" emacs-version ".")) (exelen (if (eq system-type 'windows-nt) -4)) @@ -337,8 +334,7 @@ lost after dumping"))) (message "Finding pointers to doc strings...") -(if (or (equal (nth 3 command-line-args) "dump") - (equal (nth 4 command-line-args) "dump")) +(if (equal (last command-line-args) '("dump")) (Snarf-documentation "DOC") (condition-case nil (Snarf-documentation "DOC") @@ -365,6 +361,12 @@ lost after dumping"))) (remove-hook 'after-load-functions (lambda (f) (garbage-collect))) +(if (boundp 'load--prefer-newer) + (progn + (setq load-prefer-newer load--prefer-newer) + (put 'load-prefer-newer 'standard-value load--prefer-newer) + (makunbound 'load--prefer-newer))) + (setq inhibit-load-charset-map nil) (clear-charset-maps) (garbage-collect) @@ -396,8 +398,7 @@ lost after dumping"))) (if (null (garbage-collect)) (setq pure-space-overflow t)) -(if (or (member (nth 3 command-line-args) '("dump" "bootstrap")) - (member (nth 4 command-line-args) '("dump" "bootstrap"))) +(if (member (car (last command-line-args)) '("dump" "bootstrap")) (progn (message "Dumping under the name emacs") (condition-case () @@ -413,8 +414,7 @@ lost after dumping"))) (if (not (or (eq system-type 'ms-dos) ;; Don't bother adding another name if we're just ;; building bootstrap-emacs. - (equal (nth 3 command-line-args) "bootstrap") - (equal (nth 4 command-line-args) "bootstrap"))) + (equal (last command-line-args) '("bootstrap")))) (let ((name (concat "emacs-" emacs-version)) (exe (if (eq system-type 'windows-nt) ".exe" ""))) (while (string-match "[^-+_.a-zA-Z0-9]+" name) @@ -435,7 +435,7 @@ lost after dumping"))) ;; this file must be loaded each time Emacs is run. ;; So run the startup code now. First, remove `-l loadup' from args. -(if (and (equal (nth 1 command-line-args) "-l") +(if (and (member (nth 1 command-line-args) '("-l" "--load")) (equal (nth 2 command-line-args) "loadup")) (setcdr command-line-args (nthcdr 3 command-line-args))) diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index b994949e94d..91451504cab 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -1,7 +1,7 @@ ;;; emacsbug.el --- command to report Emacs bugs to appropriate mailing list -;; Copyright (C) 1985, 1994, 1997-1998, 2000-2014 Free Software -;; Foundation, Inc. +;; Copyright (C) 1985, 1994, 1997-1998, 2000-2014 +;; Free Software Foundation, Inc. ;; Author: K. Shane Hartman ;; Maintainer: emacs-devel@gnu.org @@ -43,11 +43,6 @@ (define-obsolete-variable-alias 'report-emacs-bug-pretest-address 'report-emacs-bug-address "24.1") -(defcustom report-emacs-bug-address "bug-gnu-emacs@gnu.org" - "Address of mailing list for GNU Emacs bugs." - :group 'emacsbug - :type 'string) - (defcustom report-emacs-bug-no-confirmation nil "If non-nil, suppress the confirmations asked for the sake of novice users." :group 'emacsbug @@ -251,6 +246,8 @@ usually do not have translators for other languages.\n\n"))) (insert "Configured using:\n `configure " system-configuration-options "'\n\n") (fill-region (line-beginning-position -1) (point))) + (insert "Configured features:\n" system-configuration-features "\n\n") + (fill-region (line-beginning-position -1) (point)) (insert "Important settings:\n") (mapc (lambda (var) diff --git a/lisp/mail/hashcash.el b/lisp/mail/hashcash.el index 2224884eede..fb8dfba8554 100644 --- a/lisp/mail/hashcash.el +++ b/lisp/mail/hashcash.el @@ -47,10 +47,6 @@ ;;; Code: -;; For Emacs <22.2 and XEmacs. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - (eval-when-compile (require 'cl)) ; for case (defgroup hashcash nil diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 52f4845eecb..f76920449f2 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -1507,8 +1507,7 @@ If so restore the actual mbox message collection." '(rmail-font-lock-keywords t t nil nil (font-lock-maximum-size . nil) - (font-lock-fontify-buffer-function . rmail-fontify-buffer-function) - (font-lock-unfontify-buffer-function . rmail-unfontify-buffer-function) + (font-lock-dont-widen . t) (font-lock-inhibit-thing-lock . (lazy-lock-mode fast-lock-mode)))) (make-local-variable 'require-final-newline) (setq require-final-newline nil) @@ -3448,47 +3447,66 @@ STATE non-nil means mark as deleted." "Delete this message and stay on it." (interactive) (rmail-set-attribute rmail-deleted-attr-index t) - (run-hooks 'rmail-delete-message-hook)) + (run-hooks 'rmail-delete-message-hook) + (let ((del-msg rmail-current-message)) + (if (rmail-summary-exists) + (rmail-select-summary + (rmail-summary-mark-deleted del-msg))))) -(defun rmail-undelete-previous-message () +(defun rmail-undelete-previous-message (count) "Back up to deleted message, select it, and undelete it." - (interactive) + (interactive "p") (set-buffer rmail-buffer) - (let ((msg rmail-current-message)) - (while (and (> msg 0) - (not (rmail-message-deleted-p msg))) - (setq msg (1- msg))) - (if (= msg 0) - (error "No previous deleted message") - (if (/= msg rmail-current-message) - (rmail-show-message msg)) - (rmail-set-attribute rmail-deleted-attr-index nil) - (if (rmail-summary-exists) - (with-current-buffer rmail-summary-buffer - (rmail-summary-mark-undeleted msg))) - (rmail-maybe-display-summary)))) - -(defun rmail-delete-forward (&optional backward) + (let (value) + (dotimes (i count) + (let ((msg rmail-current-message)) + (while (and (> msg 0) + (not (rmail-message-deleted-p msg))) + (setq msg (1- msg))) + (if (= msg 0) + (error "No previous deleted message") + (if (/= msg rmail-current-message) + (rmail-show-message msg)) + (rmail-set-attribute rmail-deleted-attr-index nil) + (if (rmail-summary-exists) + (with-current-buffer rmail-summary-buffer + (rmail-summary-mark-undeleted msg)))))) + (rmail-maybe-display-summary))) + +(defun rmail-delete-forward (&optional count) "Delete this message and move to next nondeleted one. Deleted messages stay in the file until the \\[rmail-expunge] command is given. -With prefix argument, delete and move backward. +Optional argument COUNT (interactively, prefix argument) is a repeat count; +negative argument means move backwards instead of forwards. Returns t if a new message is displayed after the delete, or nil otherwise." - (interactive "P") - (rmail-set-attribute rmail-deleted-attr-index t) - (run-hooks 'rmail-delete-message-hook) - (let ((del-msg rmail-current-message)) - (if (rmail-summary-exists) - (rmail-select-summary - (rmail-summary-mark-deleted del-msg))) - (prog1 (rmail-next-undeleted-message (if backward -1 1)) - (rmail-maybe-display-summary)))) + (interactive "p") + (if (not count) (setq count 1)) + (let (value backward) + (if (< count 0) + (setq count (- count) backward t)) + (dotimes (i count) + (rmail-set-attribute rmail-deleted-attr-index t) + (run-hooks 'rmail-delete-message-hook) + (let ((del-msg rmail-current-message)) + (if (rmail-summary-exists) + (rmail-select-summary + (rmail-summary-mark-deleted del-msg))) + (setq value (rmail-next-undeleted-message (if backward -1 1))))) + (rmail-maybe-display-summary) + value)) -(defun rmail-delete-backward () +(defun rmail-delete-backward (&optional count) "Delete this message and move to previous nondeleted one. -Deleted messages stay in the file until the \\[rmail-expunge] command is given." - (interactive) - (rmail-delete-forward t)) +Deleted messages stay in the file until the \\[rmail-expunge] command is given. +Optional argument COUNT (interactively, prefix argument) is a repeat count; +negative argument means move forwards instead of backwards. + +Returns t if a new message is displayed after the delete, or nil otherwise." + + (interactive "p") + (if (not count) (setq count 1)) + (rmail-delete-forward (- count))) ;; Expunging. @@ -4297,31 +4315,21 @@ This has an effect only if a summary buffer exists." (defun rmail-unfontify-buffer-function () ;; This function's symbol is bound to font-lock-fontify-unbuffer-function. - (let ((modified (buffer-modified-p)) - (buffer-undo-list t) (inhibit-read-only t) - before-change-functions after-change-functions - buffer-file-name buffer-file-truename) + (with-silent-modifications (save-restriction (widen) (remove-hook 'rmail-show-message-hook 'rmail-fontify-message t) (remove-text-properties (point-min) (point-max) '(rmail-fontified nil)) - (font-lock-default-unfontify-buffer) - (and (not modified) (buffer-modified-p) - (restore-buffer-modified-p nil))))) + (font-lock-default-unfontify-buffer)))) (defun rmail-fontify-message () ;; Fontify the current message if it is not already fontified. (if (text-property-any (point-min) (point-max) 'rmail-fontified nil) - (let ((modified (buffer-modified-p)) - (buffer-undo-list t) (inhibit-read-only t) - before-change-functions after-change-functions - buffer-file-name buffer-file-truename) + (with-silent-modifications (save-excursion (save-match-data (add-text-properties (point-min) (point-max) '(rmail-fontified t)) - (font-lock-fontify-region (point-min) (point-max)) - (and (not modified) (buffer-modified-p) - (restore-buffer-modified-p nil))))))) + (font-lock-fontify-region (point-min) (point-max))))))) ;;; Speedbar support for RMAIL files. (defcustom rmail-speedbar-match-folder-regexp "^[A-Z0-9]+\\(\\.[A-Z0-9]+\\)?$" @@ -4773,7 +4781,7 @@ If prefix argument REVERSE is non-nil, sorts in reverse order. ;;;*** -;;;### (autoloads nil "rmailsum" "rmailsum.el" "1278ff9911aa307f30dd57c20adbcdc6") +;;;### (autoloads nil "rmailsum" "rmailsum.el" "ee1fa556cd65d7ef457a97ab560e15da") ;;; Generated autoloads from rmailsum.el (autoload 'rmail-summary "rmailsum" "\ diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index ca884136a34..af08d0f3d3a 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -914,7 +914,10 @@ a negative argument means to delete and move backward." (unless (numberp count) (setq count 1)) (let (end del-msg (backward (< count 0))) - (while (/= count 0) + (while (and (/= count 0) + ;; Don't waste time if we are at the beginning + ;; and trying to go backward. + (not (and backward (bobp)))) (rmail-summary-goto-msg) (with-current-buffer rmail-buffer (rmail-delete-message) @@ -924,11 +927,13 @@ a negative argument means to delete and move backward." (save-excursion (beginning-of-line) (looking-at " *[0-9]+D"))) (forward-line (if backward -1 1))) + (setq count + (if (> count 0) (1- count) (1+ count))) ;; It looks ugly to move to the empty line at end of buffer. + ;; And don't waste time after hitting the end. (and (eobp) (not backward) - (forward-line -1)) - (setq count - (if (> count 0) (1- count) (1+ count)))))) + (progn (setq count 0) + (forward-line -1)))))) (defun rmail-summary-delete-backward (&optional count) "Delete this message and move to previous nondeleted one. @@ -939,8 +944,9 @@ a negative argument means to delete and move forward." (rmail-summary-delete-forward (- count))) (defun rmail-summary-mark-deleted (&optional n undel) - ;; Since third arg is t, this only alters the summary, not the Rmail buf. - (and n (rmail-summary-goto-msg n t t)) + (and n (not (eq n (rmail-summary-msg-number))) + ;; Since third arg is t, this only alters summary, not the Rmail buf. + (rmail-summary-goto-msg n t t)) (or (eobp) (not (overlay-get rmail-summary-overlay 'face)) (let ((buffer-read-only nil)) @@ -951,9 +957,9 @@ a negative argument means to delete and move forward." (progn (delete-char 1) (insert " "))) (delete-char 1) (insert "D")) - ;; Register a new summary line. + ;; Discard cached new summary line. (with-current-buffer rmail-buffer - (aset rmail-summary-vector (1- n) (rmail-create-summary-line n))))) + (aset rmail-summary-vector (1- n) nil)))) (beginning-of-line)) (defun rmail-summary-update-line (n) @@ -1002,7 +1008,7 @@ Optional prefix ARG means undelete ARG previous messages." (set-buffer rmail-buffer) (rmail-pop-to-buffer rmail-buffer)) (and (rmail-message-deleted-p rmail-current-message) - (rmail-undelete-previous-message)) + (rmail-undelete-previous-message 1)) (if rmail-enable-mime (rmail-pop-to-buffer rmail-buffer)) (rmail-pop-to-buffer rmail-summary-buffer)) @@ -1011,26 +1017,35 @@ Optional prefix ARG means undelete ARG previous messages." (defun rmail-summary-undelete-many (&optional n) "Undelete all deleted msgs, optional prefix arg N means undelete N prev msgs." (interactive "P") - (with-current-buffer rmail-buffer - (let* ((init-msg (if n rmail-current-message rmail-total-messages)) - (rmail-current-message init-msg) - (n (or n rmail-total-messages)) - (msgs-undeled 0)) - (while (and (> rmail-current-message 0) - (< msgs-undeled n)) - (if (rmail-message-deleted-p rmail-current-message) - (progn (rmail-set-attribute rmail-deleted-attr-index nil) - (setq msgs-undeled (1+ msgs-undeled)))) - (setq rmail-current-message (1- rmail-current-message))) - (set-buffer rmail-summary-buffer) - (setq rmail-current-message init-msg msgs-undeled 0) - (while (and (> rmail-current-message 0) - (< msgs-undeled n)) - (if (rmail-summary-deleted-p rmail-current-message) - (progn (rmail-summary-mark-undeleted rmail-current-message) - (setq msgs-undeled (1+ msgs-undeled)))) - (setq rmail-current-message (1- rmail-current-message)))) - (rmail-summary-goto-msg))) + (if n + (while (and (> n 0) (not (eobp))) + (rmail-summary-goto-msg) + (let (del-msg) + (when (rmail-summary-deleted-p) + (with-current-buffer rmail-buffer + (rmail-undelete-previous-message 1) + (setq del-msg rmail-current-message)) + (rmail-summary-mark-undeleted del-msg))) + (while (and (not (eobp)) + (save-excursion (beginning-of-line) + (looking-at " *[0-9]+ "))) + (forward-line 1)) + (setq n (1- n))) + (rmail-summary-goto-msg 1) + (dotimes (i rmail-total-messages) + (rmail-summary-goto-msg) + (let (del-msg) + (when (rmail-summary-deleted-p) + (with-current-buffer rmail-buffer + (rmail-undelete-previous-message 1) + (setq del-msg rmail-current-message)) + (rmail-summary-mark-undeleted del-msg))) + (if (not (eobp)) + (forward-line 1)))) + + ;; It looks ugly to move to the empty line at end of buffer. + (and (eobp) + (forward-line -1))) ;; Rmail Summary mode is suitable only for specially formatted data. (put 'rmail-summary-mode 'mode-class 'special) @@ -1188,6 +1203,13 @@ Search, the `unseen' attribute is restored.") (goto-char (posn-point (event-end event))) (rmail-summary-goto-msg)) +(defun rmail-summary-msg-number () + (save-excursion + (beginning-of-line) + (string-to-number + (buffer-substring (point) + (min (point-max) (+ 6 (point))))))) + (defun rmail-summary-goto-msg (&optional n nowarn skip-rmail) "Go to message N in the summary buffer and the Rmail buffer. If N is nil, use the message corresponding to point in the summary diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index 54f4664e6db..3440741f573 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -733,7 +733,7 @@ Returns an error if the server cannot be contacted." (plist-get (cdr result) :capabilities) "\r\n"))) (let ((name - (with-case-table ascii-case-table + (with-case-table ascii-case-table ;FIXME: Why? (mapcar (lambda (s) (intern (downcase s))) (split-string (substring line 4) "[ ]"))))) (when (= (length name) 1) diff --git a/lisp/man.el b/lisp/man.el index 7a095981ebd..35fab2040a5 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -1,7 +1,6 @@ ;;; man.el --- browse UNIX manual pages -*- coding: utf-8 -*- -;; Copyright (C) 1993-1994, 1996-1997, 2001-2014 Free Software -;; Foundation, Inc. +;; Copyright (C) 1993-1994, 1996-1997, 2001-2014 Free Software Foundation, Inc. ;; Author: Barry A. Warsaw <bwarsaw@cen.com> ;; Maintainer: emacs-devel@gnu.org @@ -695,9 +694,8 @@ a \"/\" as a local filename. The function returns either `man-db' (with-temp-buffer (let ((default-directory ;; Ensure that `default-directory' exists and is readable. - (if (and (file-directory-p default-directory) - (file-readable-p default-directory)) - default-directory + (if (file-accessible-directory-p default-directory) + default-directory (expand-file-name "~/")))) (ignore-errors (call-process manual-program nil t nil "--help"))) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 19c8bdd4e24..c816488c6d1 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -2140,6 +2140,13 @@ See `menu-bar-mode' for more information." (declare-function x-menu-bar-open "term/x-win" (&optional frame)) (declare-function w32-menu-bar-open "term/w32-win" (&optional frame)) +(defun lookup-key-ignore-too-long (map key) + "Call `lookup-key' and convert numeric values to nil." + (let ((binding (lookup-key map key))) + (if (numberp binding) ; `too long' + nil + binding))) + (defun popup-menu (menu &optional position prefix from-menu-bar) "Popup the given menu and call the selected option. MENU can be a keymap, an easymenu-style menu or a list of keymaps as for @@ -2192,11 +2199,9 @@ FROM-MENU-BAR, if non-nil, means we are dropping one of menu-bar's menus." (let ((mouse-click (apply 'vector event)) binding) (while (and map (null binding)) - (setq binding (lookup-key (car map) mouse-click)) - (if (numberp binding) ; `too long' - (setq binding nil)) + (setq binding (lookup-key-ignore-too-long (car map) mouse-click)) (setq map (cdr map))) - binding)) + binding)) (t ;; We were given a single keymap. (lookup-key map (apply 'vector event))))) @@ -2276,8 +2281,10 @@ If FRAME is nil or not given, use the selected frame." (let* ((x tty-menu--initial-menu-x) (menu (menu-bar-menu-at-x-y x 0 frame))) (popup-menu (or - (lookup-key global-map (vector 'menu-bar menu)) - (lookup-key (current-local-map) (vector 'menu-bar menu)) + (lookup-key-ignore-too-long + global-map (vector 'menu-bar menu)) + (lookup-key-ignore-too-long + (current-local-map) (vector 'menu-bar menu)) (cdar (minor-mode-key-binding (vector 'menu-bar menu)))) (posn-at-x-y x 0 nil t) nil t))) (t (with-selected-frame (or frame (selected-frame)) diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog index b3d37ac4b1b..96a9b19ab78 100644 --- a/lisp/mh-e/ChangeLog +++ b/lisp/mh-e/ChangeLog @@ -1,3 +1,7 @@ +2014-05-09 Glenn Morris <rgm@gnu.org> + + * mh-e.el (mh-variants): Use file-accessible-directory-p. + 2014-03-16 Bill Wohler <wohler@newt.com> * mh-folder.el (mh-regenerate-headers): Fix scan: bad message list diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index eaa05720f43..7368c0b9ffb 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -1,7 +1,7 @@ ;;; mh-e.el --- GNU Emacs interface to the MH mail system -;; Copyright (C) 1985-1988, 1990, 1992-1995, 1997, 1999-2014 Free -;; Software Foundation, Inc. +;; Copyright (C) 1985-1988, 1990, 1992-1995, 1997, 1999-2014 +;; Free Software Foundation, Inc. ;; Author: Bill Wohler <wohler@newt.com> ;; Maintainer: Bill Wohler <wohler@newt.com> @@ -739,7 +739,7 @@ is described by the variable `mh-variants'." (setq dir (file-chase-links (directory-file-name dir))) (add-to-list 'list-unique dir)) (loop for dir in (nreverse list-unique) do - (when (and dir (file-directory-p dir) (file-readable-p dir)) + (when (and dir (file-accessible-directory-p dir)) (let ((variant (mh-variant-info dir))) (if variant (add-to-list 'mh-variants variant))))) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 2c0541ac096..7b252b4d46d 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -873,6 +873,7 @@ completing buffer and file names, respectively." ;; part of the string (e.g. substitute-in-file-name). (let ((requote (when (completion-metadata-get metadata 'completion--unquote-requote) + (cl-assert (functionp table)) (let ((new (funcall table string point 'completion--unquote))) (setq string (pop new)) (setq table (pop new)) @@ -1117,9 +1118,10 @@ If no characters can be completed, display a list of possible completions. If you repeat this command after it displayed such a list, scroll the window of possible completions." (interactive) - (completion-in-region (minibuffer-prompt-end) (point-max) - minibuffer-completion-table - minibuffer-completion-predicate)) + (when (<= (minibuffer-prompt-end) (point)) + (completion-in-region (minibuffer-prompt-end) (point-max) + minibuffer-completion-table + minibuffer-completion-predicate))) (defun completion--in-region-1 (beg end) ;; If the previous command was not this, @@ -3065,16 +3067,9 @@ filter out additional entries (because TABLE might not obey PRED)." (nconc (completion-pcm--hilit-commonality pattern all) (length prefix))))) -(defun completion--sreverse (str) - "Like `reverse' but for a string STR rather than a list." - (apply #'string (nreverse (mapcar 'identity str)))) - (defun completion--common-suffix (strs) "Return the common suffix of the strings STRS." - (completion--sreverse - (try-completion - "" - (mapcar #'completion--sreverse strs)))) + (nreverse (try-completion "" (mapcar #'reverse strs)))) (defun completion-pcm--merge-completions (strs pattern) "Extract the commonality in STRS, with the help of PATTERN. diff --git a/lisp/mouse.el b/lisp/mouse.el index 8cb42dfb455..f5a09f45a07 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -502,14 +502,18 @@ must be one of the symbols `header', `mode', or `vertical'." (interactive "e") (mouse-drag-line start-event 'vertical)) -(defun mouse-set-point (event) +(defun mouse-set-point (event &optional promote-to-region) "Move point to the position clicked on with the mouse. -This should be bound to a mouse click event type." - (interactive "e") +This should be bound to a mouse click event type. +If PROMOTE-TO-REGION is non-nil and event is a multiple-click, +select the corresponding element around point." + (interactive "e\np") (mouse-minibuffer-check event) - ;; Use event-end in case called from mouse-drag-region. - ;; If EVENT is a click, event-end and event-start give same value. - (posn-set-point (event-end event))) + (if (and promote-to-region (> (event-click-count event) 1)) + (mouse-set-region event) + ;; Use event-end in case called from mouse-drag-region. + ;; If EVENT is a click, event-end and event-start give same value. + (posn-set-point (event-end event)))) (defvar mouse-last-region-beg nil) (defvar mouse-last-region-end nil) @@ -522,6 +526,8 @@ This should be bound to a mouse click event type." (eq mouse-last-region-end (region-end)) (eq mouse-last-region-tick (buffer-modified-tick)))) +(defvar mouse--drag-start-event nil) + (defun mouse-set-region (click) "Set the region to the text dragged over, and copy to kill ring. This should be bound to a mouse drag event. @@ -531,7 +537,29 @@ command alters the kill ring or not." (mouse-minibuffer-check click) (select-window (posn-window (event-start click))) (let ((beg (posn-point (event-start click))) - (end (posn-point (event-end click)))) + (end (posn-point (event-end click))) + (click-count (event-click-count click))) + (let ((drag-start (terminal-parameter nil 'mouse-drag-start))) + (when drag-start + ;; Drag events don't come with a click count, sadly, so we hack + ;; our way around this problem by remembering the start-event in + ;; `mouse-drag-start' and fetching the click-count from there. + (when (and (<= click-count 1) + (equal beg (posn-point (event-start drag-start)))) + (setq click-count (event-click-count drag-start))) + ;; Occasionally we get spurious drag events where the user hasn't + ;; dragged his mouse, but instead Emacs has dragged the text under the + ;; user's mouse. Try to recover those cases (bug#17562). + (when (and (equal (posn-x-y (event-start click)) + (posn-x-y (event-end click))) + (not (eq (car drag-start) 'mouse-movement))) + (setq end beg)) + (setf (terminal-parameter nil 'mouse-drag-start) nil))) + (when (and (integerp beg) (integerp end)) + (let ((range (mouse-start-end beg end (1- click-count)))) + (if (< end beg) + (setq end (nth 0 range) beg (nth 1 range)) + (setq beg (nth 0 range) end (nth 1 range))))) (and mouse-drag-copy-region (integerp beg) (integerp end) ;; Don't set this-command to `kill-region', so a following ;; C-w won't double the text in the kill ring. Ignore @@ -625,13 +653,11 @@ Upon exit, point is at the far edge of the newly visible text." Highlight the drag area as you move the mouse. This must be bound to a button-down mouse event. In Transient Mark mode, the highlighting remains as long as the mark -remains active. Otherwise, it remains until the next input event. - -If the click is in the echo area, display the `*Messages*' buffer." +remains active. Otherwise, it remains until the next input event." (interactive "e") ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) - (mouse-drag-track start-event t)) + (mouse-drag-track start-event)) (defun mouse-posn-property (pos property) @@ -648,10 +674,11 @@ its value is returned." (str (posn-string pos))) (or (and str (get-text-property (cdr str) property (car str))) - ;; FIXME: mouse clicks on the mode-line come with a position in - ;; (nth 5). Maybe we should change the C code instead so that - ;; mouse-clicks don't include a position there! - (and pt (not (memq (posn-area pos) '(mode-line header-line))) + ;; Mouse clicks in the fringe come with a position in + ;; (nth 5). This is useful but is not exactly where we clicked, so + ;; don't look up that position's properties! + (and pt (not (memq (posn-area pos) '(left-fringe right-fringe + left-margin right-margin))) (get-char-property pt property w)))) (get-char-property pos property))) @@ -738,12 +765,9 @@ at the same position." "mouse-1" (substring msg 7))))))) msg) -(defun mouse-drag-track (start-event &optional - do-mouse-drag-region-post-process) +(defun mouse-drag-track (start-event) "Track mouse drags by highlighting area between point and cursor. -The region will be defined with mark and point. -DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by -`mouse-drag-region'." +The region will be defined with mark and point." (mouse-minibuffer-check start-event) (setq mouse-selection-click-count-buffer (current-buffer)) (deactivate-mark) @@ -756,8 +780,6 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by (start-posn (event-start start-event)) (start-point (posn-point start-posn)) (start-window (posn-window start-posn)) - (start-window-start (window-start start-window)) - (start-hscroll (window-hscroll start-window)) (bounds (window-edges start-window)) (make-cursor-line-fully-visible nil) (top (nth 1 bounds)) @@ -768,9 +790,7 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by (click-count (1- (event-click-count start-event))) ;; Suppress automatic hscrolling, because that is a nuisance ;; when setting point near the right fringe (but see below). - (auto-hscroll-mode-saved auto-hscroll-mode) - (auto-hscroll-mode nil) - moved-off-start event end end-point) + (auto-hscroll-mode-saved auto-hscroll-mode)) (setq mouse-selection-click-count click-count) ;; In case the down click is in the middle of some intangible text, @@ -789,85 +809,43 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by (push-mark (nth 0 range) t t) (goto-char (nth 1 range))) - ;; Track the mouse until we get a non-movement event. - (track-mouse - (while (progn - (setq event (read-event)) - (or (mouse-movement-p event) - (memq (car-safe event) '(switch-frame select-window)))) - (unless (memq (car-safe event) '(switch-frame select-window)) - ;; Automatic hscrolling did not occur during the call to - ;; `read-event'; but if the user subsequently drags the - ;; mouse, go ahead and hscroll. - (let ((auto-hscroll-mode auto-hscroll-mode-saved)) - (redisplay)) - (setq end (event-end event) - end-point (posn-point end)) - ;; Note whether the mouse has left the starting position. - (unless (eq end-point start-point) - (setq moved-off-start t)) - (if (and (eq (posn-window end) start-window) - (integer-or-marker-p 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)) - ((< mouse-row top) - (mouse-scroll-subr start-window (- mouse-row top) - nil start-point)) - ((>= mouse-row bottom) - (mouse-scroll-subr start-window (1+ (- mouse-row bottom)) - nil start-point)))))))) - - ;; Handle the terminating event if possible. - (when (consp event) - ;; Ensure that point is on the end of the last event. - (when (and (setq end-point (posn-point (event-end event))) - (eq (posn-window end) start-window) - (integer-or-marker-p end-point) - (/= start-point end-point)) - (mouse--drag-set-mark-and-point start-point - end-point click-count)) - - ;; Find its binding. - (let* ((fun (key-binding (vector (car event)))) - ;; FIXME This doesn't make sense, because - ;; event-click-count always returns something >= 1. - (do-multi-click (and (> (event-click-count event) 0) - (functionp fun) - (not (memq fun '(mouse-set-point - mouse-set-region)))))) - (if (and (/= (mark) (point)) - (not do-multi-click)) - - ;; If point has moved, finish the drag. - (let* (last-command this-command) - (and mouse-drag-copy-region - do-mouse-drag-region-post-process - (let (deactivate-mark) - (copy-region-as-kill (mark) (point))))) - - ;; Otherwise, run binding of terminating up-event. + (setf (terminal-parameter nil 'mouse-drag-start) start-event) + (setq track-mouse t) + (setq auto-hscroll-mode nil) + + (set-transient-map + (let ((map (make-sparse-keymap))) + (define-key map [switch-frame] #'ignore) + (define-key map [select-window] #'ignore) + (define-key map [mouse-movement] + (lambda (event) (interactive "e") + (let* ((end (event-end event)) + (end-point (posn-point end))) + (unless (eq end-point start-point) + ;; As soon as the user moves, we can re-enable auto-hscroll. + (setq auto-hscroll-mode auto-hscroll-mode-saved) + ;; And remember that we have moved, so mouse-set-region can know + ;; its event is really a drag event. + (setcar start-event 'mouse-movement)) + (if (and (eq (posn-window end) start-window) + (integer-or-marker-p 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)) + ((< mouse-row top) + (mouse-scroll-subr start-window (- mouse-row top) + nil start-point)) + ((>= mouse-row bottom) + (mouse-scroll-subr start-window (1+ (- mouse-row bottom)) + nil start-point)))))))) + map) + t (lambda () + (setq track-mouse nil) + (setq auto-hscroll-mode auto-hscroll-mode-saved) (deactivate-mark) - (if do-multi-click - (goto-char start-point) - (unless moved-off-start - (pop-mark))) - - (when (and (functionp fun) - (= start-hscroll (window-hscroll start-window)) - ;; Don't run the up-event handler if the window - ;; start changed in a redisplay after the - ;; mouse-set-point for the down-mouse event at - ;; the beginning of this function. When the - ;; window start has changed, the up-mouse event - ;; contains a different position due to the new - ;; window contents, and point is set again. - (or end-point - (= (window-start start-window) - start-window-start))) - (push event unread-command-events))))))) + (pop-mark))))) (defun mouse--drag-set-mark-and-point (start click click-count) (let* ((range (mouse-start-end start click click-count)) @@ -1895,14 +1873,10 @@ choose a font." ;;; Bindings for mouse commands. -(define-key global-map [down-mouse-1] 'mouse-drag-region) +(global-set-key [down-mouse-1] 'mouse-drag-region) (global-set-key [mouse-1] 'mouse-set-point) (global-set-key [drag-mouse-1] 'mouse-set-region) -;; These are tested for in mouse-drag-region. -(global-set-key [double-mouse-1] 'mouse-set-point) -(global-set-key [triple-mouse-1] 'mouse-set-point) - (defun mouse--strip-first-event (_prompt) (substring (this-single-command-raw-keys) 1)) diff --git a/lisp/mpc.el b/lisp/mpc.el index d569610a615..d03edf86bba 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -1024,7 +1024,12 @@ If PLAYLIST is t or nil or missing, use the main playlist." (when (and (null val) (eq tag 'Title)) (setq val (cdr (assq 'file info)))) (push `(equal ',val (cdr (assq ',tag info))) pred) - val))))) + (cond + ((not (and (eq tag 'Date) (stringp val))) val) + ;; For "date", only keep the year! + ((string-match "[0-9]\\{4\\}" val) + (match-string 0 val)) + (t val))))))) (space (when size (setq size (string-to-number size)) (propertize " " 'display @@ -1866,7 +1871,7 @@ This is used so that they can be compared with `eq', which is needed for `text-property-any'.") (defun mpc-songs-hashcons (name) (or (gethash name mpc-songs-hashcons) (puthash name name mpc-songs-hashcons))) -(defcustom mpc-songs-format "%2{Disc--}%3{Track} %-5{Time} %25{Title} %20{Album} %20{Artist} %10{Date}" +(defcustom mpc-songs-format "%2{Disc--}%3{Track} %-5{Time} %25{Title} %20{Album} %20{Artist} %5{Date}" "Format used to display each song in the list of songs." :type 'string) diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 9644a509b22..09d84795f4f 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -1343,16 +1343,12 @@ used instead of `browse-url-new-window-flag'." "newwin\n" "goto\n") url "\n") - (let ((umask (default-file-modes))) - (unwind-protect - (progn - (set-default-file-modes ?\700) - (if (file-exists-p - (setq pidfile (format "/tmp/Mosaic.%d" pid))) - (delete-file pidfile)) - ;; http://debbugs.gnu.org/17428. Use O_EXCL. - (write-region nil nil pidfile nil 'silent nil 'excl)) - (set-default-file-modes umask)))) + (with-file-modes ?\700 + (if (file-exists-p + (setq pidfile (format "/tmp/Mosaic.%d" pid))) + (delete-file pidfile)) + ;; http://debbugs.gnu.org/17428. Use O_EXCL. + (write-region nil nil pidfile nil 'silent nil 'excl))) ;; Send signal SIGUSR to Mosaic (message "Signaling Mosaic...") (signal-process pid 'SIGUSR1) diff --git a/lisp/net/dns.el b/lisp/net/dns.el index e52ead1fb72..ea1c805c6b9 100644 --- a/lisp/net/dns.el +++ b/lisp/net/dns.el @@ -31,6 +31,12 @@ "List of DNS servers to query. If nil, /etc/resolv.conf and nslookup will be consulted.") +(defvar dns-servers-valid-for-interfaces nil + "The return value of `network-interface-list' when `dns-servers' was set. +If the set of network interfaces and/or their IP addresses +change, then presumably the list of DNS servers needs to be +updated. Set this variable to t to disable the check.") + ;;; Internal code: (defvar dns-query-types @@ -297,6 +303,17 @@ If TCP-P, the first two bytes of the package with be the length field." (t string))) (goto-char point)))) +(declare-function network-interface-list "process.c") + +(defun dns-servers-up-to-date-p () + "Return false if we need to recheck the list of DNS servers." + (and dns-servers + (or (eq dns-servers-valid-for-interfaces t) + ;; `network-interface-list' was introduced in Emacs 22.1. + (not (fboundp 'network-interface-list)) + (equal dns-servers-valid-for-interfaces + (network-interface-list))))) + (defun dns-set-servers () "Set `dns-servers' to a list of DNS servers or nil if none are found. Parses \"/etc/resolv.conf\" or calls \"nslookup\"." @@ -314,7 +331,9 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"." (goto-char (point-min)) (re-search-forward "^Address:[ \t]*\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t) - (setq dns-servers (list (match-string 1))))))) + (setq dns-servers (list (match-string 1)))))) + (when (fboundp 'network-interface-list) + (setq dns-servers-valid-for-interfaces (network-interface-list)))) (defun dns-read-txt (string) (if (> (length string) 1) @@ -378,7 +397,7 @@ Parses \"/etc/resolv.conf\" or calls \"nslookup\"." If FULLP, return the entire record returned. If REVERSEP, look up an IP address." (setq type (or type 'A)) - (unless dns-servers + (unless (dns-servers-up-to-date-p) (dns-set-servers)) (when reversep diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 2591fc83e84..a0e72d1a6f5 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1,10 +1,10 @@ -;;; rcirc.el --- default, simple IRC client. +;;; rcirc.el --- default, simple IRC client -*- lexical-binding: t; -*- ;; Copyright (C) 2005-2014 Free Software Foundation, Inc. ;; Author: Ryan Yeske <rcyeske@gmail.com> ;; Maintainers: Ryan Yeske <rcyeske@gmail.com>, -;; Deniz Dogan <deniz@dogan.se> +;; Leo Liu <sdl.web@gmail.com> ;; Keywords: comm ;; This file is part of GNU Emacs. @@ -43,9 +43,9 @@ ;;; Code: +(require 'cl-lib) (require 'ring) (require 'time-date) -(eval-when-compile (require 'cl)) (defgroup rcirc nil "Simple IRC client." @@ -489,7 +489,7 @@ If ARG is non-nil, instead prompt for connection parameters." (when (string= server (process-name p)) (setq connected p))) (if (not connected) - (condition-case e + (condition-case nil (rcirc-connect server port nick user-name full-name channels password encryption) (quit (message "Quit connecting to %s" server))) @@ -521,6 +521,7 @@ If ARG is non-nil, instead prompt for connection parameters." (defvar rcirc-user-authenticated nil) (defvar rcirc-user-disconnect nil) (defvar rcirc-connecting nil) +(defvar rcirc-connection-info nil) (defvar rcirc-process nil) ;;;###autoload @@ -549,22 +550,23 @@ If ARG is non-nil, instead prompt for connection parameters." (set-process-sentinel process 'rcirc-sentinel) (set-process-filter process 'rcirc-filter) - (set (make-local-variable 'rcirc-process) process) - (set (make-local-variable 'rcirc-server) server) - (set (make-local-variable 'rcirc-server-name) server) ; Update when we get 001 response. - (set (make-local-variable 'rcirc-buffer-alist) nil) - (set (make-local-variable 'rcirc-nick-table) - (make-hash-table :test 'equal)) - (set (make-local-variable 'rcirc-nick) nick) - (set (make-local-variable 'rcirc-process-output) nil) - (set (make-local-variable 'rcirc-startup-channels) startup-channels) - (set (make-local-variable 'rcirc-last-server-message-time) - (current-time)) - - (set (make-local-variable 'rcirc-timeout-timer) nil) - (set (make-local-variable 'rcirc-user-disconnect) nil) - (set (make-local-variable 'rcirc-user-authenticated) nil) - (set (make-local-variable 'rcirc-connecting) t) + (setq-local rcirc-connection-info + (list server port nick user-name full-name startup-channels + password encryption)) + (setq-local rcirc-process process) + (setq-local rcirc-server server) + (setq-local rcirc-server-name server) ; Update when we get 001 response. + (setq-local rcirc-buffer-alist nil) + (setq-local rcirc-nick-table (make-hash-table :test 'equal)) + (setq-local rcirc-nick nick) + (setq-local rcirc-process-output nil) + (setq-local rcirc-startup-channels startup-channels) + (setq-local rcirc-last-server-message-time (current-time)) + + (setq-local rcirc-timeout-timer nil) + (setq-local rcirc-user-disconnect nil) + (setq-local rcirc-user-authenticated nil) + (setq-local rcirc-connecting t) (add-hook 'auto-save-hook 'rcirc-log-write) @@ -629,7 +631,7 @@ last ping." (cancel-timer rcirc-keepalive-timer)) (setq rcirc-keepalive-timer nil))) -(defun rcirc-handler-ctcp-KEEPALIVE (process target sender message) +(defun rcirc-handler-ctcp-KEEPALIVE (process _target _sender message) (with-rcirc-process-buffer process (setq header-line-format (format "%f" (- (rcirc-float-time) (string-to-number message)))))) @@ -656,6 +658,16 @@ is non-nil." "Hook functions called when the process sentinel is called. Functions are called with PROCESS and SENTINEL arguments.") +(defcustom rcirc-reconnect-delay 0 + "The minimum interval in seconds between reconnect attempts. +When 0, do not auto-reconnect." + :version "24.5" + :type 'integer + :group 'rcirc) + +(defvar rcirc-last-connect-time nil + "The last time the buffer was connected.") + (defun rcirc-sentinel (process sentinel) "Called when PROCESS receives SENTINEL." (let ((sentinel (replace-regexp-in-string "\n" "" sentinel))) @@ -669,6 +681,14 @@ Functions are called with PROCESS and SENTINEL arguments.") sentinel (process-status process)) (not rcirc-target)) (rcirc-disconnect-buffer))) + (when (and (string= sentinel "deleted") + (< 0 rcirc-reconnect-delay)) + (let ((now (current-time))) + (when (or (null rcirc-last-connect-time) + (< rcirc-reconnect-delay + (float-time (time-subtract now rcirc-last-connect-time)))) + (setq rcirc-last-connect-time now) + (rcirc-cmd-reconnect nil)))) (run-hook-with-args 'rcirc-sentinel-functions process sentinel)))) (defun rcirc-disconnect-buffer (&optional buffer) @@ -752,7 +772,7 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") (defvar rcirc-responses-no-activity '("305" "306") "Responses that don't trigger activity in the mode-line indicator.") -(defun rcirc-handler-generic (process response sender args text) +(defun rcirc-handler-generic (process response sender args _text) "Generic server response handler." (rcirc-print process sender response nil (mapconcat 'identity (cdr args) " ") @@ -782,11 +802,11 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") (defun rcirc-buffer-process (&optional buffer) "Return the process associated with channel BUFFER. With no argument or nil as argument, use the current buffer." - (or (get-buffer-process (if buffer - (with-current-buffer buffer - rcirc-server-buffer) - rcirc-server-buffer)) - rcirc-process)) + (let ((buffer (or buffer (if (buffer-live-p rcirc-server-buffer) + rcirc-server-buffer + (error "Server buffer deleted"))))) + (or (with-current-buffer buffer rcirc-process) + rcirc-process))) (defun rcirc-server-name (process) "Return PROCESS server name, given by the 001 response." @@ -928,12 +948,12 @@ IRC command completion is performed only if '/' is the first input char." (defun set-rcirc-decode-coding-system (coding-system) "Set the decode coding system used in this channel." (interactive "zCoding system for incoming messages: ") - (set (make-local-variable 'rcirc-decode-coding-system) coding-system)) + (setq-local rcirc-decode-coding-system coding-system)) (defun set-rcirc-encode-coding-system (coding-system) "Set the encode coding system used in this channel." (interactive "zCoding system for outgoing messages: ") - (set (make-local-variable 'rcirc-encode-coding-system) coding-system)) + (setq-local rcirc-encode-coding-system coding-system)) (defvar rcirc-mode-map (let ((map (make-sparse-keymap))) @@ -990,25 +1010,26 @@ This number is independent of the number of lines in the buffer.") (setq major-mode 'rcirc-mode) (setq mode-line-process nil) - (set (make-local-variable 'rcirc-input-ring) - ;; If rcirc-input-ring is already a ring with desired size do - ;; not re-initialize. - (if (and (ring-p rcirc-input-ring) - (= (ring-size rcirc-input-ring) - rcirc-input-ring-size)) - rcirc-input-ring - (make-ring rcirc-input-ring-size))) - (set (make-local-variable 'rcirc-server-buffer) (process-buffer process)) - (set (make-local-variable 'rcirc-target) target) - (set (make-local-variable 'rcirc-topic) nil) - (set (make-local-variable 'rcirc-last-post-time) (current-time)) - (set (make-local-variable 'fill-paragraph-function) 'rcirc-fill-paragraph) - (set (make-local-variable 'rcirc-recent-quit-alist) nil) - (set (make-local-variable 'rcirc-current-line) 0) + (setq-local rcirc-input-ring + ;; If rcirc-input-ring is already a ring with desired + ;; size do not re-initialize. + (if (and (ring-p rcirc-input-ring) + (= (ring-size rcirc-input-ring) + rcirc-input-ring-size)) + rcirc-input-ring + (make-ring rcirc-input-ring-size))) + (setq-local rcirc-server-buffer (process-buffer process)) + (setq-local rcirc-target target) + (setq-local rcirc-topic nil) + (setq-local rcirc-last-post-time (current-time)) + (setq-local fill-paragraph-function 'rcirc-fill-paragraph) + (setq-local rcirc-recent-quit-alist nil) + (setq-local rcirc-current-line 0) + (setq-local rcirc-last-connect-time (current-time)) (use-hard-newlines t) - (set (make-local-variable 'rcirc-short-buffer-name) nil) - (set (make-local-variable 'rcirc-urls) nil) + (setq-local rcirc-short-buffer-name nil) + (setq-local rcirc-urls nil) ;; setup for omitting responses (setq buffer-invisibility-spec '()) @@ -1023,18 +1044,18 @@ This number is independent of the number of lines in the buffer.") (serv (if (consp (car i)) (cdar i) ""))) (when (and (string-match chan (or target "")) (string-match serv (rcirc-server-name process))) - (set (make-local-variable 'rcirc-decode-coding-system) - (if (consp (cdr i)) (cadr i) (cdr i))) - (set (make-local-variable 'rcirc-encode-coding-system) - (if (consp (cdr i)) (cddr i) (cdr i)))))) + (setq-local rcirc-decode-coding-system + (if (consp (cdr i)) (cadr i) (cdr i))) + (setq-local rcirc-encode-coding-system + (if (consp (cdr i)) (cddr i) (cdr i)))))) ;; setup the prompt and markers - (set (make-local-variable 'rcirc-prompt-start-marker) (point-max-marker)) - (set (make-local-variable 'rcirc-prompt-end-marker) (point-max-marker)) + (setq-local rcirc-prompt-start-marker (point-max-marker)) + (setq-local rcirc-prompt-end-marker (point-max-marker)) (rcirc-update-prompt) (goto-char rcirc-prompt-end-marker) - (set (make-local-variable 'overlay-arrow-position) (make-marker)) + (setq-local overlay-arrow-position (make-marker)) ;; if the user changes the major mode or kills the buffer, there is ;; cleanup work to do @@ -1222,13 +1243,13 @@ Create the buffer if it doesn't exist." (ring-insert rcirc-input-ring input) (setq rcirc-input-ring-index 0)))))) -(defun rcirc-fill-paragraph (&optional arg) - (interactive "p") +(defun rcirc-fill-paragraph (&optional justify) + (interactive "P") (when (> (point) rcirc-prompt-end-marker) (save-restriction (narrow-to-region rcirc-prompt-end-marker (point-max)) (let ((fill-column rcirc-max-message-length)) - (fill-region (point-min) (point-max)))))) + (fill-region (point-min) (point-max) justify))))) (defun rcirc-process-input-line (line) (if (string-match "^/\\([^ ]+\\) ?\\(.*\\)$" line) @@ -1393,9 +1414,9 @@ is found by looking up RESPONSE in `rcirc-response-formats'." (rcirc-add-face start (match-beginning 0) face) (setq start (match-beginning 0)) (replace-match - (case (aref (match-string 1) 0) + (cl-case (aref (match-string 1) 0) (?f (setq face - (case (string-to-char (match-string 3)) + (cl-case (string-to-char (match-string 3)) (?w 'font-lock-warning-face) (?p 'rcirc-server-prefix) (?s 'rcirc-server) @@ -1431,9 +1452,9 @@ is found by looking up RESPONSE in `rcirc-response-formats'." (rcirc-add-face start (match-beginning 0) face)) (buffer-substring (point-min) (point-max)))) -(defun rcirc-target-buffer (process sender response target text) +(defun rcirc-target-buffer (process sender response target _text) "Return a buffer to print the server response." - (assert (not (bufferp target))) + (cl-assert (not (bufferp target))) (with-rcirc-process-buffer process (cond ((not target) (rcirc-any-buffer process)) @@ -1474,11 +1495,10 @@ Returns nil if the information is not recorded." (defun rcirc-last-line (process nick target) "Return the line from the last activity from NICK in TARGET." - (let* ((chanbuf (rcirc-get-buffer process target)) - (line (or (cdr (assoc-string target - (gethash nick (with-rcirc-server-buffer - rcirc-nick-table)) t)) - (rcirc-last-quit-line process nick target)))) + (let ((line (or (cdr (assoc-string target + (gethash nick (with-rcirc-server-buffer + rcirc-nick-table)) t)) + (rcirc-last-quit-line process nick target)))) (if line line ;;(message "line is nil for %s in %s" nick target) @@ -1883,7 +1903,9 @@ Uninteresting lines are those whose responses are listed in (message "Rcirc-Omit mode enabled")) (remove-from-invisibility-spec '(rcirc-omit . nil)) (message "Rcirc-Omit mode disabled")) - (recenter (when (> (point) rcirc-prompt-start-marker) -1))) + (dolist (window (get-buffer-window-list (current-buffer))) + (with-selected-window window + (recenter (when (> (point) rcirc-prompt-start-marker) -1))))) (defun rcirc-switch-to-server-buffer () "Switch to the server buffer associated with current channel buffer." @@ -1956,7 +1978,7 @@ activity. Only run if the buffer is not visible and (let ((t1 (with-current-buffer b1 rcirc-last-post-time)) (t2 (with-current-buffer b2 rcirc-last-post-time))) (time-less-p t2 t1))))) - (pushnew type rcirc-activity-types) + (cl-pushnew type rcirc-activity-types) (unless (and (equal rcirc-activity old-activity) (member type old-types)) (rcirc-update-activity-string))))) @@ -1977,13 +1999,13 @@ activity. Only run if the buffer is not visible and (defun rcirc-split-activity (activity) "Return a cons cell with ACTIVITY split into (lopri . hipri)." (let (lopri hipri) - (dolist (buf rcirc-activity) + (dolist (buf activity) (with-current-buffer buf (if (and rcirc-low-priority-flag (not (member 'nick rcirc-activity-types))) - (add-to-list 'lopri buf t) - (add-to-list 'hipri buf t)))) - (cons lopri hipri))) + (push buf lopri) + (push buf hipri)))) + (cons (nreverse lopri) (nreverse hipri)))) (defvar rcirc-update-activity-string-hook nil "Hook run whenever the activity string is updated.") @@ -2015,7 +2037,7 @@ activity. Only run if the buffer is not visible and (with-current-buffer b (dolist (type rcirc-activity-types) (rcirc-add-face 0 (length s) - (case type + (cl-case type (nick 'rcirc-track-nick) (keyword 'rcirc-track-keyword)) s))) @@ -2123,7 +2145,7 @@ activity. Only run if the buffer is not visible and (when (and (listp x) (listp (cadr x))) (setcdr x (if (> (length (cdr x)) 1) (rcirc-make-trees (cdr x)) - (setcdr x (list (cdadr x))))))) + (setcdr x (list (cl-cdadr x))))))) alist))) ;;; /commands these are called with 3 args: PROCESS, TARGET, which is @@ -2211,6 +2233,19 @@ CHANNELS is a comma- or space-separated string of channel names." reason rcirc-id-string)))) +(defun-rcirc-command reconnect (_) + "Reconnect to current server." + (interactive "i") + (with-rcirc-server-buffer + (cond + (rcirc-connecting (message "Already connecting")) + ((process-live-p process) (message "Server process is alive")) + (t (let ((conn-info rcirc-connection-info)) + (setf (nth 5 conn-info) + (cl-remove-if-not #'rcirc-channel-p + (mapcar #'car rcirc-buffer-alist))) + (apply #'rcirc-connect conn-info)))))) + (defun-rcirc-command nick (nick) "Change nick to NICK." (interactive "i") @@ -2281,7 +2316,7 @@ With a prefix arg, prompt for new topic." (mapconcat 'identity (cdr arglist) " ")))) (rcirc-send-string process (concat "KICK " target " " argstring)))) -(defun rcirc-cmd-ctcp (args &optional process target) +(defun rcirc-cmd-ctcp (args &optional process _target) (if (string-match "^\\([^ ]+\\)\\s-+\\(.+\\)$" args) (let* ((target (match-string 1 args)) (request (upcase (match-string 2 args))) @@ -2292,7 +2327,7 @@ With a prefix arg, prompt for new topic." (rcirc-print process (rcirc-nick process) "ERROR" nil "usage: /ctcp NICK REQUEST"))) -(defun rcirc-ctcp-sender-PING (process target request) +(defun rcirc-ctcp-sender-PING (process target _request) "Send a CTCP PING message to TARGET." (let ((timestamp (format "%.0f" (rcirc-float-time)))) (rcirc-send-ctcp process target "PING" timestamp))) @@ -2412,21 +2447,20 @@ If ARG is given, opens the URL in a new browser window." (lambda (x) (>= point (cdr x))) rcirc-urls)) (completions (mapcar (lambda (x) (car x)) filtered)) - (initial-input (caar filtered)) - (history (mapcar (lambda (x) (car x)) (cdr filtered)))) - (browse-url (completing-read "rcirc browse-url: " - completions nil nil initial-input 'history) + (defaults (mapcar (lambda (x) (car x)) filtered))) + (browse-url (completing-read "Rcirc browse-url: " + completions nil nil (car defaults) nil defaults) arg))) -(defun rcirc-markup-timestamp (sender response) +(defun rcirc-markup-timestamp (_sender _response) (goto-char (point-min)) (insert (rcirc-facify (format-time-string rcirc-time-format) 'rcirc-timestamp))) -(defun rcirc-markup-attributes (sender response) +(defun rcirc-markup-attributes (_sender _response) (while (re-search-forward "\\([\C-b\C-_\C-v]\\).*?\\(\\1\\|\C-o\\)" nil t) (rcirc-add-face (match-beginning 0) (match-end 0) - (case (char-after (match-beginning 1)) + (cl-case (char-after (match-beginning 1)) (?\C-b 'bold) (?\C-v 'italic) (?\C-_ 'underline))) @@ -2440,7 +2474,7 @@ If ARG is given, opens the URL in a new browser window." (while (re-search-forward "\C-o+" nil t) (delete-region (match-beginning 0) (match-end 0)))) -(defun rcirc-markup-my-nick (sender response) +(defun rcirc-markup-my-nick (_sender response) (with-syntax-table rcirc-nick-syntax-table (while (re-search-forward (concat "\\b" (regexp-quote (rcirc-nick @@ -2454,7 +2488,7 @@ If ARG is given, opens the URL in a new browser window." 'rcirc-nick-in-message-full-line) (rcirc-record-activity (current-buffer) 'nick))))) -(defun rcirc-markup-urls (sender response) +(defun rcirc-markup-urls (_sender _response) (while (and rcirc-url-regexp ;; nil means disable URL catching (re-search-forward rcirc-url-regexp nil t)) (let* ((start (match-beginning 0)) @@ -2485,7 +2519,7 @@ If ARG is given, opens the URL in a new browser window." (rcirc-add-face (match-beginning 0) (match-end 0) 'rcirc-keyword) (rcirc-record-activity (current-buffer) 'keyword)))))) -(defun rcirc-markup-bright-nicks (sender response) +(defun rcirc-markup-bright-nicks (_sender response) (when (and rcirc-bright-nicks (string= response "NAMES")) (with-syntax-table rcirc-nick-syntax-table @@ -2493,7 +2527,7 @@ If ARG is given, opens the URL in a new browser window." (rcirc-add-face (match-beginning 0) (match-end 0) 'rcirc-bright-nick))))) -(defun rcirc-markup-fill (sender response) +(defun rcirc-markup-fill (_sender response) (when (not (string= response "372")) ; /motd (let ((fill-prefix (or rcirc-fill-prefix @@ -2574,7 +2608,7 @@ If ARG is given, opens the URL in a new browser window." sender))) message t)))) -(defun rcirc-check-auth-status (process sender args text) +(defun rcirc-check-auth-status (process sender args _text) "Check if the user just authenticated. If authenticated, runs `rcirc-authenticated-hook' with PROCESS as the only argument." @@ -2602,10 +2636,10 @@ the only argument." (run-hook-with-args 'rcirc-authenticated-hook process) (remove-hook 'rcirc-authenticated-hook 'rcirc-join-channels-post-auth t)))))) -(defun rcirc-handler-WALLOPS (process sender args text) +(defun rcirc-handler-WALLOPS (process sender args _text) (rcirc-print process sender "WALLOPS" sender (car args) t)) -(defun rcirc-handler-JOIN (process sender args text) +(defun rcirc-handler-JOIN (process sender args _text) (let ((channel (car args))) (with-current-buffer (rcirc-get-buffer-create process channel) ;; when recently rejoining, restore the linestamp @@ -2626,7 +2660,7 @@ the only argument." (rcirc-print process sender "JOIN" sender channel)))) ;; PART and KICK are handled the same way -(defun rcirc-handler-PART-or-KICK (process response channel sender nick args) +(defun rcirc-handler-PART-or-KICK (process _response channel _sender nick _args) (rcirc-ignore-update-automatic nick) (if (not (string= nick (rcirc-nick process))) ;; this is someone else leaving @@ -2643,7 +2677,7 @@ the only argument." (when buffer (rcirc-disconnect-buffer buffer))))) -(defun rcirc-handler-PART (process sender args text) +(defun rcirc-handler-PART (process sender args _text) (let* ((channel (car args)) (reason (cadr args)) (message (concat channel " " reason))) @@ -2654,10 +2688,10 @@ the only argument." (rcirc-handler-PART-or-KICK process "PART" channel sender sender reason))) -(defun rcirc-handler-KICK (process sender args text) +(defun rcirc-handler-KICK (process sender args _text) (let* ((channel (car args)) (nick (cadr args)) - (reason (caddr args)) + (reason (cl-caddr args)) (message (concat nick " " channel " " reason))) (rcirc-print process sender "KICK" channel message t) ;; print in private chat buffer if it exists @@ -2682,7 +2716,7 @@ the only argument." (cons (cons nick line) rcirc-recent-quit-alist)))))))))) -(defun rcirc-handler-QUIT (process sender args text) +(defun rcirc-handler-QUIT (process sender args _text) (rcirc-ignore-update-automatic sender) (mapc (lambda (channel) ;; broadcast quit message each channel @@ -2692,7 +2726,7 @@ the only argument." (rcirc-nick-channels process sender)) (rcirc-nick-remove process sender)) -(defun rcirc-handler-NICK (process sender args text) +(defun rcirc-handler-NICK (process sender args _text) (let* ((old-nick sender) (new-nick (car args)) (channels (rcirc-nick-channels process old-nick))) @@ -2723,25 +2757,25 @@ the only argument." ;; reauthenticate (when rcirc-auto-authenticate-flag (rcirc-authenticate)))))) -(defun rcirc-handler-PING (process sender args text) +(defun rcirc-handler-PING (process _sender args _text) (rcirc-send-string process (concat "PONG :" (car args)))) -(defun rcirc-handler-PONG (process sender args text) +(defun rcirc-handler-PONG (_process _sender _args _text) ;; do nothing ) -(defun rcirc-handler-TOPIC (process sender args text) +(defun rcirc-handler-TOPIC (process sender args _text) (let ((topic (cadr args))) (rcirc-print process sender "TOPIC" (car args) topic) (with-current-buffer (rcirc-get-buffer process (car args)) (setq rcirc-topic topic)))) (defvar rcirc-nick-away-alist nil) -(defun rcirc-handler-301 (process sender args text) +(defun rcirc-handler-301 (process _sender args text) "RPL_AWAY" (let* ((nick (cadr args)) (rec (assoc-string nick rcirc-nick-away-alist)) - (away-message (caddr args))) + (away-message (cl-caddr args))) (when (or (not rec) (not (string= (cdr rec) away-message))) ;; away message has changed @@ -2751,7 +2785,7 @@ the only argument." (setq rcirc-nick-away-alist (cons (cons nick away-message) rcirc-nick-away-alist)))))) -(defun rcirc-handler-317 (process sender args text) +(defun rcirc-handler-317 (process sender args _text) "RPL_WHOISIDLE" (let* ((nick (nth 1 args)) (idle-secs (string-to-number (nth 2 args))) @@ -2765,31 +2799,31 @@ the only argument." nick idle-string signon-string))) (rcirc-print process sender "317" nil message t))) -(defun rcirc-handler-332 (process sender args text) +(defun rcirc-handler-332 (process _sender args _text) "RPL_TOPIC" (let ((buffer (or (rcirc-get-buffer process (cadr args)) (rcirc-get-temp-buffer-create process (cadr args))))) (with-current-buffer buffer - (setq rcirc-topic (caddr args))))) + (setq rcirc-topic (cl-caddr args))))) -(defun rcirc-handler-333 (process sender args text) +(defun rcirc-handler-333 (process sender args _text) "333 says who set the topic and when. Not in rfc1459.txt" (let ((buffer (or (rcirc-get-buffer process (cadr args)) (rcirc-get-temp-buffer-create process (cadr args))))) (with-current-buffer buffer - (let ((setter (caddr args)) + (let ((setter (cl-caddr args)) (time (current-time-string (seconds-to-time - (string-to-number (cadddr args)))))) + (string-to-number (cl-cadddr args)))))) (rcirc-print process sender "TOPIC" (cadr args) (format "%s (%s on %s)" rcirc-topic setter time)))))) -(defun rcirc-handler-477 (process sender args text) +(defun rcirc-handler-477 (process sender args _text) "ERR_NOCHANMODES" - (rcirc-print process sender "477" (cadr args) (caddr args))) + (rcirc-print process sender "477" (cadr args) (cl-caddr args))) -(defun rcirc-handler-MODE (process sender args text) +(defun rcirc-handler-MODE (process sender args _text) (let ((target (car args)) (msg (mapconcat 'identity (cdr args) " "))) (rcirc-print process sender "MODE" @@ -2809,7 +2843,7 @@ Not in rfc1459.txt" (let ((tmpnam (concat " " (downcase channel) "TMP" (process-name process)))) (get-buffer-create tmpnam))) -(defun rcirc-handler-353 (process sender args text) +(defun rcirc-handler-353 (process _sender args _text) "RPL_NAMREPLY" (let ((channel (nth 2 args)) (names (or (nth 3 args) ""))) @@ -2822,7 +2856,7 @@ Not in rfc1459.txt" (goto-char (point-max)) (insert (car (last args)) " ")))) -(defun rcirc-handler-366 (process sender args text) +(defun rcirc-handler-366 (process sender args _text) "RPL_ENDOFNAMES" (let* ((channel (cadr args)) (buffer (rcirc-get-temp-buffer-create process channel))) @@ -2847,14 +2881,14 @@ Passwords are stored in `rcirc-authinfo' (which see)." (dolist (i rcirc-authinfo) (let ((process (rcirc-buffer-process)) (server (car i)) - (nick (caddr i)) + (nick (cl-caddr i)) (method (cadr i)) - (args (cdddr i))) + (args (cl-cdddr i))) (when (and (string-match server rcirc-server)) (if (and (memq method '(nickserv chanserv bitlbee)) (string-match nick rcirc-nick)) ;; the following methods rely on the user's nickname. - (case method + (cl-case method (nickserv (rcirc-send-privmsg process @@ -2878,10 +2912,10 @@ Passwords are stored in `rcirc-authinfo' (which see)." "Q@CServe.quakenet.org" (format "AUTH %s %s" nick (car args)))))))))) -(defun rcirc-handler-INVITE (process sender args text) +(defun rcirc-handler-INVITE (process sender args _text) (rcirc-print process sender "INVITE" nil (mapconcat 'identity args " ") t)) -(defun rcirc-handler-ERROR (process sender args text) +(defun rcirc-handler-ERROR (process sender args _text) (rcirc-print process sender "ERROR" nil (mapconcat 'identity args " "))) (defun rcirc-handler-CTCP (process target sender text) @@ -2899,7 +2933,7 @@ Passwords are stored in `rcirc-authinfo' (which see)." (rcirc-print process sender "CTCP" target (format "%s" text) t)))))) -(defun rcirc-handler-ctcp-VERSION (process target sender args) +(defun rcirc-handler-ctcp-VERSION (process _target sender _args) (rcirc-send-string process (concat "NOTICE " sender " :\C-aVERSION " rcirc-id-string @@ -2908,12 +2942,12 @@ Passwords are stored in `rcirc-authinfo' (which see)." (defun rcirc-handler-ctcp-ACTION (process target sender args) (rcirc-print process sender "ACTION" target args t)) -(defun rcirc-handler-ctcp-TIME (process target sender args) +(defun rcirc-handler-ctcp-TIME (process _target sender _args) (rcirc-send-string process (concat "NOTICE " sender " :\C-aTIME " (current-time-string) "\C-a"))) -(defun rcirc-handler-CTCP-response (process target sender message) +(defun rcirc-handler-CTCP-response (process _target sender message) (rcirc-print process sender "CTCP" nil message t)) (defgroup rcirc-faces nil diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 53888473217..f38cecb1c62 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -609,10 +609,10 @@ But handle the case, if the \"test\" command is not available." 'write-region (list start end tmpfile append 'no-message lockname confirm)) (with-tramp-progress-reporter - v 3 (format "Moving tmp file %s to %s" tmpfile filename) + v 3 (format "Moving tmp file `%s' to `%s'" tmpfile filename) (unwind-protect (when (tramp-adb-execute-adb-command v "push" tmpfile localname) - (tramp-error v 'file-error "Cannot write: `%s' filename")) + (tramp-error v 'file-error "Cannot write: `%s'" filename)) (delete-file tmpfile))) (when (or (eq visit t) (stringp visit)) @@ -998,7 +998,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (with-temp-buffer (prog1 (unless - (zerop (apply 'tramp-call-process tramp-adb-program nil t nil args)) + (zerop + (apply 'tramp-call-process vec tramp-adb-program nil t nil args)) (buffer-string)) (tramp-message vec 6 "%s" (buffer-string))))) @@ -1107,10 +1108,7 @@ connection if a previous connection has died for some reason." (and p (processp p) (memq (process-status p) '(run open))) (save-match-data (when (and p (processp p)) (delete-process p)) - (setq tramp-current-method (tramp-file-name-method vec) - tramp-current-user (tramp-file-name-user vec) - tramp-current-host (tramp-file-name-host vec) - devices (mapcar 'cadr (tramp-adb-parse-device-names nil))) + (setq devices (mapcar 'cadr (tramp-adb-parse-device-names nil))) (if (not devices) (tramp-error vec 'file-error "No device connected")) (if (and (> (length host) 0) (not (member host devices))) diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index be66f18d9e4..b5ef8c28d2d 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -203,13 +203,15 @@ Remove also properties of all files in subdirectories." ;; not show proper directory contents when a file has been copied or ;; deleted before. (defun tramp-flush-file-function () - "Flush all Tramp cache properties from `buffer-file-name'." - (let ((bfn (if (stringp (buffer-file-name)) - (buffer-file-name) - default-directory))) - (when (tramp-tramp-file-p bfn) - (with-parsed-tramp-file-name bfn nil - (tramp-flush-file-property v localname))))) + "Flush all Tramp cache properties from `buffer-file-name'. +This is suppressed for temporary buffers." + (unless (string-match "^ \\*temp\\*" (or (buffer-name) "")) + (let ((bfn (if (stringp (buffer-file-name)) + (buffer-file-name) + default-directory))) + (when (tramp-tramp-file-p bfn) + (with-parsed-tramp-file-name bfn nil + (tramp-flush-file-property v localname)))))) (add-hook 'before-revert-hook 'tramp-flush-file-function) (add-hook 'eshell-pre-command-hook 'tramp-flush-file-function) diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el index dc84a524ba0..d98f6d74a6a 100644 --- a/lisp/net/tramp-ftp.el +++ b/lisp/net/tramp-ftp.el @@ -120,17 +120,6 @@ present for backward compatibility." tramp-ftp-method '((tramp-parse-netrc "~/.netrc")))) -;; If there is URL syntax, `substitute-in-file-name' needs special -;; handling. -(put 'substitute-in-file-name 'ange-ftp 'tramp-handle-substitute-in-file-name) -(add-hook 'tramp-ftp-unload-hook - (lambda () - (setplist 'substitute-in-file-name - (delete 'ange-ftp - (delete 'tramp-handle-substitute-in-file-name - (symbol-plist - 'substitute-in-file-name)))))) - ;;;###tramp-autoload (defun tramp-ftp-file-name-handler (operation &rest args) "Invoke the Ange-FTP handler for OPERATION. diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 52189e091fb..5d6447609fa 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -49,14 +49,14 @@ ;; The customer option `tramp-gvfs-methods' contains the list of ;; supported connection methods. Per default, these are "dav", -;; "davs", "obex" and "synce". Note that with "obex" it might be -;; necessary to pair with the other bluetooth device, if it hasn't +;; "davs", "obex", "sftp" and "synce". Note that with "obex" it might +;; be necessary to pair with the other bluetooth device, if it hasn't ;; been done already. There might be also some few seconds delay in ;; discovering available bluetooth devices. -;; Other possible connection methods are "ftp", "sftp" and "smb". -;; When one of these methods is added to the list, the remote access -;; for that method is performed via GVFS instead of the native Tramp +;; Other possible connection methods are "ftp" and "smb". When one of +;; these methods is added to the list, the remote access for that +;; method is performed via GVFS instead of the native Tramp ;; implementation. ;; GVFS offers even more connection methods. The complete list of @@ -110,7 +110,7 @@ (require 'custom)) ;;;###tramp-autoload -(defcustom tramp-gvfs-methods '("dav" "davs" "obex" "synce") +(defcustom tramp-gvfs-methods '("dav" "davs" "obex" "sftp" "synce") "List of methods for remote files, accessed with GVFS." :group 'tramp :version "23.2" @@ -661,7 +661,7 @@ is no information where to trace the message.") "Like `delete-file' for Tramp files." (with-parsed-tramp-file-name filename nil (tramp-flush-file-property v (file-name-directory localname)) - (tramp-flush-directory-property v localname) + (tramp-flush-file-property v localname) (unless (tramp-gvfs-send-command v (if (and trash delete-by-moving-to-trash) "gvfs-trash" "gvfs-rm") @@ -794,7 +794,8 @@ is no information where to trace the message.") (goto-char (point-min)) (setq res-filemodes (if (re-search-forward "unix::mode:\\s-+\\([0-9]+\\)" nil t) - (tramp-file-mode-from-int (match-string 1)) + (tramp-file-mode-from-int + (string-to-number (match-string 1))) (if dirp "drwx------" "-rwx------"))) ;; ... inode and device (goto-char (point-min)) @@ -899,7 +900,7 @@ is no information where to trace the message.") entry) ;; Get a list of directories and files. (tramp-gvfs-send-command - v "gvfs-ls" (tramp-gvfs-url-file-name directory)) + v "gvfs-ls" "-h" (tramp-gvfs-url-file-name directory)) ;; Now grab the output. (with-temp-buffer @@ -1118,9 +1119,9 @@ is no information where to trace the message.") (setq user (concat (match-string 2 user) ";" (match-string 1 user)))) (url-parse-make-urlobj - method (url-hexify-string user) nil + method (and user (url-hexify-string user)) nil (tramp-file-name-real-host v) (tramp-file-name-port v) - (url-hexify-string localname) nil nil t)) + (and localname (url-hexify-string localname)) nil nil t)) (url-parse-make-urlobj "file" nil nil nil nil (url-hexify-string (file-truename filename)) nil nil t)))) @@ -1555,14 +1556,10 @@ connection if a previous connection has died for some reason." "Send the COMMAND with its ARGS to connection VEC. COMMAND is usually a command from the gvfs-* utilities. `call-process' is applied, and it returns `t' if the return code is zero." - (let (result) - (with-current-buffer (tramp-get-connection-buffer vec) - (tramp-gvfs-maybe-open-connection vec) - (erase-buffer) - (tramp-message vec 6 "%s %s" command (mapconcat 'identity args " ")) - (setq result (apply 'tramp-call-process command nil t nil args)) - (tramp-message vec 6 "\n%s" (buffer-string)) - (zerop result)))) + (with-current-buffer (tramp-get-connection-buffer vec) + (tramp-gvfs-maybe-open-connection vec) + (erase-buffer) + (zerop (apply 'tramp-call-process vec command nil t nil args)))) ;; D-Bus BLUEZ functions. @@ -1671,7 +1668,7 @@ be used." (list user host))) (zeroconf-list-services "_webdav._tcp"))) -;; Add completion function for DAV and DAVS methods. +;; Add completion function for SFTP, DAV and DAVS methods. (when (and tramp-gvfs-enabled (member zeroconf-service-avahi (dbus-list-known-names :system))) (zeroconf-init tramp-gvfs-zeroconf-domain) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 15aa1329817..a6771cd306f 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -35,6 +35,10 @@ (defvar directory-sep-char) (defvar tramp-gw-tunnel-method) (defvar tramp-gw-socks-method) +(defvar vc-handled-backends) +(defvar vc-bzr-program) +(defvar vc-git-program) +(defvar vc-hg-program) (defcustom tramp-inline-compress-start-size 4096 "The minimum size of compressing where inline transfer. @@ -142,17 +146,6 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-default-port 22))) ;;;###tramp-autoload (add-to-list 'tramp-methods - '("sftp" - (tramp-login-program "ssh") - (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c") - ("-e" "none") ("%h"))) - (tramp-async-args (("-q"))) - (tramp-remote-shell "/bin/sh") - (tramp-remote-shell-args ("-c")) - (tramp-copy-program "sftp") - (tramp-copy-args ("%c")))) - ;;;###tramp-autoload -(add-to-list 'tramp-methods '("rsync" (tramp-login-program "ssh") (tramp-login-args (("-l" "%u") ("-p" "%p") ("%c") @@ -210,12 +203,26 @@ detected as prompt when being sent on echoing hosts, therefore.") (add-to-list 'tramp-methods '("telnet" (tramp-login-program "telnet") - (tramp-login-args (("%h") ("%p"))) + (tramp-login-args (("%h") ("%p") ("2>/dev/null"))) (tramp-remote-shell "/bin/sh") (tramp-remote-shell-args ("-c")) (tramp-default-port 23))) ;;;###tramp-autoload (add-to-list 'tramp-methods + '("nc" + (tramp-login-program "telnet") + (tramp-login-args (("%h") ("%p") ("2>/dev/null"))) + (tramp-remote-shell "/bin/sh") + (tramp-remote-shell-args ("-c")) + (tramp-copy-program "nc") + ;; We use "-v" for better error tracking. + (tramp-copy-args (("-w" "1") ("-v") ("%h") ("%r"))) + (tramp-remote-copy-program "nc") + ;; We use "-p" as required for busyboxes. + (tramp-remote-copy-args (("-l") ("-p" "%r"))) + (tramp-default-port 23))) +;;;###tramp-autoload +(add-to-list 'tramp-methods '("su" (tramp-login-program "su") (tramp-login-args (("-") ("%u"))) @@ -249,9 +256,16 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-remote-shell-args ("-c")))) ;;;###tramp-autoload (add-to-list 'tramp-methods - '("plink" + `("plink" (tramp-login-program "plink") - (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%h"))) + ;; ("%h") must be a single element, see `tramp-compute-multi-hops'. + (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("-t") + ("%h") ("\"") + (,(format + "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=%s'" + tramp-terminal-type + tramp-initial-end-of-output)) + ("/bin/sh") ("\""))) (tramp-remote-shell "/bin/sh") (tramp-remote-shell-args ("-c")) (tramp-default-port 22))) @@ -259,21 +273,25 @@ detected as prompt when being sent on echoing hosts, therefore.") (add-to-list 'tramp-methods `("plinkx" (tramp-login-program "plink") - ;; ("%h") must be a single element, see - ;; `tramp-compute-multi-hops'. - (tramp-login-args (("-load") ("%h") ("-t") + (tramp-login-args (("-load") ("%h") ("-t") ("\"") (,(format "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=%s'" tramp-terminal-type tramp-initial-end-of-output)) - ("/bin/sh"))) + ("/bin/sh") ("\""))) (tramp-remote-shell "/bin/sh") (tramp-remote-shell-args ("-c")))) ;;;###tramp-autoload (add-to-list 'tramp-methods - '("pscp" + `("pscp" (tramp-login-program "plink") - (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%h"))) + (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("-t") + ("%h") ("\"") + (,(format + "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=%s'" + tramp-terminal-type + tramp-initial-end-of-output)) + ("/bin/sh") ("\""))) (tramp-remote-shell "/bin/sh") (tramp-remote-shell-args ("-c")) (tramp-copy-program "pscp") @@ -284,9 +302,15 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-default-port 22))) ;;;###tramp-autoload (add-to-list 'tramp-methods - '("psftp" + `("psftp" (tramp-login-program "plink") - (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("%h"))) + (tramp-login-args (("-l" "%u") ("-P" "%p") ("-ssh") ("-t") + ("%h") ("\"") + (,(format + "env 'TERM=%s' 'PROMPT_COMMAND=' 'PS1=%s'" + tramp-terminal-type + tramp-initial-end-of-output)) + ("/bin/sh") ("\""))) (tramp-remote-shell "/bin/sh") (tramp-remote-shell-args ("-c")) (tramp-copy-program "pscp") @@ -319,7 +343,8 @@ detected as prompt when being sent on echoing hosts, therefore.") (add-to-list 'tramp-default-user-alist `(,(concat "\\`" - (regexp-opt '("rcp" "remcp" "rsh" "telnet" "krlogin" "fcp")) + (regexp-opt + '("rcp" "remcp" "rsh" "telnet" "nc" "krlogin" "fcp")) "\\'") nil ,(user-login-name))) @@ -370,7 +395,6 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-set-completion-function "remcp" tramp-completion-function-alist-rsh) (tramp-set-completion-function "scp" tramp-completion-function-alist-ssh) (tramp-set-completion-function "scpx" tramp-completion-function-alist-ssh) - (tramp-set-completion-function "sftp" tramp-completion-function-alist-ssh) (tramp-set-completion-function "rsync" tramp-completion-function-alist-ssh) (tramp-set-completion-function "rsh" tramp-completion-function-alist-rsh) (tramp-set-completion-function "remsh" tramp-completion-function-alist-rsh) @@ -378,6 +402,7 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-set-completion-function "sshx" tramp-completion-function-alist-ssh) (tramp-set-completion-function "telnet" tramp-completion-function-alist-telnet) + (tramp-set-completion-function "nc" tramp-completion-function-alist-telnet) (tramp-set-completion-function "su" tramp-completion-function-alist-su) (tramp-set-completion-function "sudo" tramp-completion-function-alist-su) (tramp-set-completion-function "ksu" tramp-completion-function-alist-su) @@ -387,6 +412,7 @@ detected as prompt when being sent on echoing hosts, therefore.") (tramp-set-completion-function "plinkx" tramp-completion-function-alist-putty) (tramp-set-completion-function "pscp" tramp-completion-function-alist-ssh) + (tramp-set-completion-function "psftp" tramp-completion-function-alist-ssh) (tramp-set-completion-function "fcp" tramp-completion-function-alist-ssh))) ;; "getconf PATH" yields: @@ -1346,7 +1372,7 @@ of." ;; We are local, so we don't need the UTC settings. (zerop (tramp-call-process - "touch" nil nil nil "-t" + nil "touch" nil nil nil "-t" (format-time-string "%Y%m%d%H%M.%S" time) (tramp-shell-quote-argument filename))))) @@ -1380,7 +1406,7 @@ be non-negative integers." (let ((uid (or (and (natnump uid) uid) (tramp-get-local-uid 'integer))) (gid (or (and (natnump gid) gid) (tramp-get-local-gid 'integer)))) (tramp-call-process - "chown" nil nil nil + nil "chown" nil nil nil (format "%d:%d" uid gid) (tramp-shell-quote-argument filename)))))) (defun tramp-remote-selinux-p (vec) @@ -1542,7 +1568,7 @@ be non-negative integers." (defun tramp-sh-handle-file-directory-p (filename) "Like `file-directory-p' for Tramp files." (with-parsed-tramp-file-name filename nil - ;; `file-directory-p' is used as predicate for filename completion. + ;; `file-directory-p' is used as predicate for file name completion. ;; Sometimes, when a connection is not established yet, it is ;; desirable to return t immediately for "/method:foo:". It can ;; be expected that this is always a directory. @@ -1644,10 +1670,10 @@ be non-negative integers." vec (format (concat - ;; We must care about filenames with spaces, or starting with + ;; We must care about file names with spaces, or starting with ;; "-"; this would confuse xargs. "ls -aQ" might be a solution, ;; but it does not work on all remote systems. Therefore, we - ;; quote the filenames via sed. + ;; quote the file names via sed. "cd %s; echo \"(\"; (%s -a | sed -e s/\\$/\\\"/g -e s/^/\\\"/g | " "xargs %s -c " "'(\"%%n\" (\"%%N\") %%h %s %s %%Xe0 %%Ye0 %%Ze0 %%se0 \"%%A\" t %%ie0 -1)'" @@ -1670,15 +1696,15 @@ be non-negative integers." (mapcar 'list (or - ;; Try cache entries for filename, filename with last - ;; character removed, filename with last two characters + ;; Try cache entries for `filename', `filename' with last + ;; character removed, `filename' with last two characters ;; removed, ..., and finally the empty string - all ;; concatenated to the local directory name. (let ((remote-file-name-inhibit-cache (or remote-file-name-inhibit-cache tramp-completion-reread-directory-timeout))) - ;; This is inefficient for very long filenames, pity + ;; This is inefficient for very long file names, pity ;; `reduce' is not available... (car (apply @@ -1742,7 +1768,7 @@ be non-negative integers." (tramp-shell-quote-argument localname) (tramp-get-ls-command v) ;; When `filename' is empty, just `ls' without - ;; filename argument is more efficient than `ls *' + ;; `filename' argument is more efficient than `ls *' ;; for very large directories and might avoid the ;; `Argument list too long' error. ;; @@ -1981,7 +2007,7 @@ file names." ;; create a new buffer, insert the contents of the ;; source file into it, then write out the buffer to ;; the target file. The advantage is that it doesn't - ;; matter which filename handlers are used for the + ;; matter which file name handlers are used for the ;; source and target file. (t (tramp-do-copy-or-rename-file-via-buffer @@ -2212,19 +2238,19 @@ the uid and gid from FILENAME." (set-file-modes newname file-modes)))))) (defun tramp-do-copy-or-rename-file-out-of-band (op filename newname keep-date) - "Invoke rcp program to copy. + "Invoke `scp' program to copy. The method used must be an out-of-band method." (let* ((t1 (tramp-tramp-file-p filename)) (t2 (tramp-tramp-file-p newname)) (orig-vec (tramp-dissect-file-name (if t1 filename newname))) - copy-program copy-args copy-env copy-keep-date port spec - options source target) + copy-program copy-args copy-env copy-keep-date port listener spec + options source target remote-copy-program remote-copy-args) (with-parsed-tramp-file-name (if t1 filename newname) nil (if (and t1 t2) ;; Both are Tramp files. We shall optimize it when the - ;; methods for filename and newname are the same. + ;; methods for FILENAME and NEWNAME are the same. (let* ((dir-flag (file-directory-p filename)) (tmpfile (tramp-compat-make-temp-file localname dir-flag))) (if dir-flag @@ -2285,6 +2311,13 @@ The method used must be an out-of-band method." (setq user (or (tramp-file-name-user v) (tramp-get-connection-property v "login-as" nil))) + ;; Check for listener port. + (when (tramp-get-method-parameter method 'tramp-remote-copy-args) + (setq listener (number-to-string (+ 50000 (random 10000)))) + (while + (zerop (tramp-call-process v "nc" nil nil nil "-z" host listener)) + (setq listener (number-to-string (+ 50000 (random 10000)))))) + ;; Compose copy command. (setq host (or host "") user (or user "") @@ -2297,7 +2330,7 @@ The method used must be an out-of-band method." tramp-ssh-controlmaster-options "") spec) spec (format-spec-make - ?h host ?u user ?p port ?c options + ?h host ?u user ?p port ?r listener ?c options ?k (if keep-date " " "")) copy-program (tramp-get-method-parameter method 'tramp-copy-program) @@ -2325,12 +2358,57 @@ The method used must be an out-of-band method." (lambda (x) (setq x (mapcar (lambda (y) (format-spec y spec)) x)) (unless (member "" x) (mapconcat 'identity x " "))) - (tramp-get-method-parameter method 'tramp-copy-env)))) + (tramp-get-method-parameter method 'tramp-copy-env))) + remote-copy-program (tramp-get-method-parameter + method 'tramp-remote-copy-program) + remote-copy-args + (delete + ;; " " has either been a replacement of "%k" (when + ;; keep-date argument is non-nil), or a replacement + ;; for the whole keep-date sublist. + " " + (dolist + (x + (tramp-get-method-parameter method 'tramp-remote-copy-args) + remote-copy-args) + (setq remote-copy-args + (append + remote-copy-args + (let ((y (mapcar (lambda (z) (format-spec z spec)) x))) + (if (member "" y) '(" ") y))))))) - ;; Check for program. + ;; Check for local copy program. (unless (executable-find copy-program) (tramp-error - v 'file-error "Cannot find copy program: %s" copy-program)) + v 'file-error "Cannot find local copy program: %s" copy-program)) + + ;; Install listener on the remote side. The prompt must be + ;; consumed later on, when the process does not listen anymore. + (when remote-copy-program + (unless (with-tramp-connection-property + v (concat "remote-copy-program-" remote-copy-program) + (tramp-find-executable + v remote-copy-program (tramp-get-remote-path v))) + (tramp-error + v 'file-error + "Cannot find remote listener: %s" remote-copy-program)) + (setq remote-copy-program + (mapconcat + 'identity + (append + (list remote-copy-program) remote-copy-args + (list (if t1 (concat "<" source) (concat ">" target)) "&")) + " ")) + (tramp-send-command v remote-copy-program) + (with-timeout + (1 (tramp-error + v 'file-error + "Listener process not running on remote host: `%s'" + remote-copy-program)) + (tramp-send-command v (format "netstat -l | grep -q :%s" listener)) + (while (not (tramp-send-command-and-check v nil)) + (tramp-send-command + v (format "netstat -l | grep -q :%s" listener))))) (with-temp-buffer (unwind-protect @@ -2347,24 +2425,26 @@ The method used must be an out-of-band method." (tramp-message orig-vec 6 "%s=\"%s\"" (car copy-env) (cadr copy-env)) (setenv (pop copy-env) (pop copy-env))) + (setq + copy-args + (append + copy-args + (if remote-copy-program + (list (if t1 (concat ">" target) (concat "<" source))) + (list source target)))) ;; Use an asynchronous process. By this, password can - ;; be handled. The default directory must be local, in - ;; order to apply the correct `copy-program'. We don't - ;; set a timeout, because the copying of large files can - ;; last longer than 60 secs. - (let ((p (let ((default-directory - (tramp-compat-temporary-file-directory))) - (apply 'start-process-shell-command - (tramp-get-connection-name v) - (tramp-get-connection-buffer v) - copy-program - (append - copy-args - (list - source target - "&&" "echo" "tramp_exit_status" "0" - "||" "echo" "tramp_exit_status" "1")))))) + ;; be handled. We don't set a timeout, because the + ;; copying of large files can last longer than 60 + ;; secs. + (let ((p (apply 'start-process-shell-command + (tramp-get-connection-name v) + (tramp-get-connection-buffer v) + copy-program + (append + copy-args + (list "&&" "echo" "tramp_exit_status" "0" + "||" "echo" "tramp_exit_status" "1"))))) (tramp-message orig-vec 6 "%s" (mapconcat 'identity (process-command p) " ")) @@ -2391,7 +2471,14 @@ The method used must be an out-of-band method." ;; Reset the transfer process properties. (tramp-set-connection-property v "process-name" nil) - (tramp-set-connection-property v "process-buffer" nil))) + (tramp-set-connection-property v "process-buffer" nil) + ;; Clear the remote prompt. + (when (and remote-copy-program + (not (tramp-send-command-and-check v nil))) + ;; Houston, we have a problem! Likely, the listener is + ;; still running, so let's clear everything (but the + ;; cached password). + (tramp-cleanup-connection v 'keep-debug 'keep-password)))) ;; Handle KEEP-DATE argument. (when (and keep-date (not copy-keep-date)) @@ -2621,7 +2708,8 @@ This is like `dired-recursive-delete-directory' for Tramp files." (delete-region (match-beginning 0) (point))) ;; Some busyboxes are reluctant to discard colors. - (unless (string-match "color" (tramp-get-connection-property v "ls" "")) + (unless + (string-match "color" (tramp-get-connection-property v "ls" "")) (goto-char beg) (while (re-search-forward tramp-color-escape-sequence-regexp nil t) (replace-match ""))) @@ -2651,9 +2739,9 @@ This is like `dired-recursive-delete-directory' for Tramp files." (defun tramp-sh-handle-expand-file-name (name &optional dir) "Like `expand-file-name' for Tramp files. -If the localname part of the given filename starts with \"/../\" then -the result will be a local, non-Tramp, filename." - ;; If DIR is not given, use DEFAULT-DIRECTORY or "/". +If the localname part of the given file name starts with \"/../\" then +the result will be a local, non-Tramp, file name." + ;; If DIR is not given, use `default-directory' or "/". (setq dir (or dir default-directory "/")) ;; Unless NAME is absolute, concat DIR and NAME. (unless (file-name-absolute-p name) @@ -3133,7 +3221,7 @@ the result will be a local, non-Tramp, filename." (symbol-value 'last-coding-system-used)))) ;; The permissions of the temporary file should be set. If - ;; filename does not exist (eq modes nil) it has been + ;; FILENAME does not exist (eq modes nil) it has been ;; renamed to the backup file. This case `save-buffer' ;; handles permissions. ;; Ensure that it is still readable. @@ -3144,7 +3232,7 @@ the result will be a local, non-Tramp, filename." ;; This is a bit lengthy due to the different methods ;; possible for file transfer. First, we check whether the - ;; method uses an rcp program. If so, we call it. + ;; method uses an scp program. If so, we call it. ;; Otherwise, both encoding and decoding command must be ;; specified. However, if the method _also_ specifies an ;; encoding function, then that is used for encoding the @@ -3238,7 +3326,7 @@ the result will be a local, non-Tramp, filename." (erase-buffer) (and ;; cksum runs locally, if possible. - (zerop (tramp-call-process "cksum" tmpfile t)) + (zerop (tramp-call-process v "cksum" tmpfile t)) ;; cksum runs remotely. (tramp-send-command-and-check v @@ -3264,7 +3352,7 @@ the result will be a local, non-Tramp, filename." (tramp-error v 'file-error (concat "Method `%s' should specify both encoding and " - "decoding command or an rcp program") + "decoding command or an scp program") method)))) ;; Make `last-coding-system-used' have the right value. @@ -3281,7 +3369,7 @@ the result will be a local, non-Tramp, filename." (when (or (eq visit t) (stringp visit)) (let ((file-attr (tramp-compat-file-attributes filename 'integer))) (set-visited-file-modtime - ;; We must pass modtime explicitly, because filename can + ;; We must pass modtime explicitly, because FILENAME can ;; be different from (buffer-file-name), f.e. if ;; `file-precious-flag' is set. (nth 5 file-attr)) @@ -3369,7 +3457,28 @@ the result will be a local, non-Tramp, filename." ;; calls shall be answered from the file cache. We unset ;; `process-file-side-effects' and `remote-file-name-inhibit-cache' ;; in order to keep the cache. - (let (remote-file-name-inhibit-cache process-file-side-effects) + (let ((vc-handled-backends vc-handled-backends) + remote-file-name-inhibit-cache process-file-side-effects) + ;; Reduce `vc-handled-backends' in order to minimize process calls. + (when (and (memq 'Bzr vc-handled-backends) + (boundp 'vc-bzr-program) + (not (with-tramp-connection-property v vc-bzr-program + (tramp-find-executable + v vc-bzr-program (tramp-get-remote-path v))))) + (setq vc-handled-backends (delq 'Bzr vc-handled-backends))) + (when (and (memq 'Git vc-handled-backends) + (boundp 'vc-git-program) + (not (with-tramp-connection-property v vc-git-program + (tramp-find-executable + v vc-git-program (tramp-get-remote-path v))))) + (setq vc-handled-backends (delq 'Git vc-handled-backends))) + (when (and (memq 'Hg vc-handled-backends) + (boundp 'vc-hg-program) + (not (with-tramp-connection-property v vc-hg-program + (tramp-find-executable + v vc-hg-program (tramp-get-remote-path v))))) + (setq vc-handled-backends (delq 'Hg vc-handled-backends))) + ;; Run. (ignore-errors (tramp-run-real-handler 'vc-registered (list file)))))))) @@ -4010,7 +4119,7 @@ FORMAT is symbol describing the encoding/decoding format. It can be ENCODING and DECODING can be strings, giving commands, or symbols, giving functions. If they are strings, then they can contain the \"%s\" format specifier. If that specifier is present, the input -filename will be put into the command line at that spot. If the +file name will be put into the command line at that spot. If the specifier is not present, the input should be read from standard input. @@ -4045,7 +4154,7 @@ FORMAT is a symbol describing the encoding/decoding format. It can be ENCODING and DECODING can be strings, giving commands, or symbols, giving variables. If they are strings, then they can contain the \"%s\" format specifier. If that specifier is present, the input -filename will be put into the command line at that spot. If the +file name will be put into the command line at that spot. If the specifier is not present, the input should be read from standard input. @@ -4171,32 +4280,28 @@ Goes through the list `tramp-local-coding-commands' and (setq rem-dec (nth 2 ritem)) (setq found t))))))) - ;; Did we find something? - (unless found - (tramp-error - vec 'file-error "Couldn't find an inline transfer encoding")) - - ;; Set connection properties. Since the commands are risky (due - ;; to output direction), we cache them in the process cache. - (tramp-message vec 5 "Using local encoding `%s'" loc-enc) - (tramp-set-connection-property p "local-encoding" loc-enc) - (tramp-message vec 5 "Using local decoding `%s'" loc-dec) - (tramp-set-connection-property p "local-decoding" loc-dec) - (tramp-message vec 5 "Using remote encoding `%s'" rem-enc) - (tramp-set-connection-property p "remote-encoding" rem-enc) - (tramp-message vec 5 "Using remote decoding `%s'" rem-dec) - (tramp-set-connection-property p "remote-decoding" rem-dec)))) + (when found + ;; Set connection properties. Since the commands are risky + ;; (due to output direction), we cache them in the process cache. + (tramp-message vec 5 "Using local encoding `%s'" loc-enc) + (tramp-set-connection-property p "local-encoding" loc-enc) + (tramp-message vec 5 "Using local decoding `%s'" loc-dec) + (tramp-set-connection-property p "local-decoding" loc-dec) + (tramp-message vec 5 "Using remote encoding `%s'" rem-enc) + (tramp-set-connection-property p "remote-encoding" rem-enc) + (tramp-message vec 5 "Using remote decoding `%s'" rem-dec) + (tramp-set-connection-property p "remote-decoding" rem-dec))))) (defun tramp-call-local-coding-command (cmd input output) "Call the local encoding or decoding command. If CMD contains \"%s\", provide input file INPUT there in command. Otherwise, INPUT is passed via standard input. INPUT can also be nil which means `/dev/null'. -OUTPUT can be a string (which specifies a filename), or t (which +OUTPUT can be a string (which specifies a file name), or t (which means standard output and thus the current buffer), or nil (which means discard it)." (tramp-call-process - tramp-encoding-shell + nil tramp-encoding-shell (when (and input (not (string-match "%s" cmd))) input) (if (eq output t) t nil) nil @@ -4844,15 +4949,18 @@ Return ATTR." "")) (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)) + "Create a file name suitable to be passed to `scp' or `nc' and workalikes." + (let ((method (tramp-file-name-method vec)) + (user (tramp-file-name-user vec)) (host (tramp-file-name-real-host vec)) (localname (tramp-shell-quote-argument (tramp-file-name-localname vec)))) - (shell-quote-argument - (if (not (zerop (length user))) - (format "%s@%s:%s" user host localname) - (format "%s:%s" host localname))))) + (cond + ((tramp-get-method-parameter method 'tramp-remote-copy-program) + localname) + ((not (zerop (length user))) + (shell-quote-argument (format "%s@%s:%s" user host localname))) + (t (shell-quote-argument (format "%s:%s" host localname)))))) (defun tramp-method-out-of-band-p (vec size) "Return t if this is an out-of-band method, nil otherwise." @@ -5371,9 +5479,5 @@ function cell is returned to be applied on a buffer." ;; rsync). ;; * Keep a second connection open for out-of-band methods like scp or ;; rsync. -;; * Try telnet+curl as new method. It might be useful for busybox, -;; without built-in uuencode/uudecode. -;; * Try telnet+nc as new method. It might be useful for busybox, -;; without built-in uuencode/uudecode. ;;; tramp-sh.el ends here diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 43e2c494ece..aa44b8dbf4b 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -447,8 +447,7 @@ pass to the OPERATION." (expand-file-name tramp-temp-name-prefix (tramp-compat-temporary-file-directory)))) - (args (list tramp-smb-program - (concat "//" real-host "/" share) "-E"))) + (args (list (concat "//" real-host "/" share) "-E"))) (if (not (zerop (length real-user))) (setq args (append args (list "-U" real-user))) @@ -495,10 +494,11 @@ pass to the OPERATION." ;; Use an asynchronous processes. By this, ;; password can be handled. (let* ((default-directory tmpdir) - (p (start-process-shell-command + (p (apply + 'start-process (tramp-get-connection-name v) (tramp-get-connection-buffer v) - (mapconcat 'identity args " ")))) + tramp-smb-program args))) (tramp-message v 6 "%s" (mapconcat 'identity (process-command p) " ")) @@ -938,99 +938,100 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setq filename (file-name-as-directory filename)) (setq filename (directory-file-name filename))) (with-parsed-tramp-file-name filename nil - (save-match-data - (let ((base (file-name-nondirectory filename)) - ;; We should not destroy the cache entry. - (entries (copy-sequence - (tramp-smb-get-file-entries - (file-name-directory filename))))) - - (when wildcard - (string-match "\\." base) - (setq base (replace-match "\\\\." nil nil base)) - (string-match "\\*" base) - (setq base (replace-match ".*" nil nil base)) - (string-match "\\?" base) - (setq base (replace-match ".?" nil nil base))) - - ;; Filter entries. - (setq entries - (delq - nil - (if (or wildcard (zerop (length base))) - ;; Check for matching entries. - (mapcar - (lambda (x) - (when (string-match - (format "^%s" base) (nth 0 x)) - x)) - entries) - ;; We just need the only and only entry FILENAME. - (list (assoc base entries))))) - - ;; Sort entries. - (setq entries - (sort - entries - (lambda (x y) - (if (string-match "t" switches) - ;; Sort by date. - (tramp-time-less-p (nth 3 y) (nth 3 x)) - ;; Sort by name. - (string-lessp (nth 0 x) (nth 0 y)))))) - - ;; Handle "-F" switch. - (when (string-match "F" switches) + (with-tramp-progress-reporter v 0 (format "Opening directory %s" filename) + (save-match-data + (let ((base (file-name-nondirectory filename)) + ;; We should not destroy the cache entry. + (entries (copy-sequence + (tramp-smb-get-file-entries + (file-name-directory filename))))) + + (when wildcard + (string-match "\\." base) + (setq base (replace-match "\\\\." nil nil base)) + (string-match "\\*" base) + (setq base (replace-match ".*" nil nil base)) + (string-match "\\?" base) + (setq base (replace-match ".?" nil nil base))) + + ;; Filter entries. + (setq entries + (delq + nil + (if (or wildcard (zerop (length base))) + ;; Check for matching entries. + (mapcar + (lambda (x) + (when (string-match + (format "^%s" base) (nth 0 x)) + x)) + entries) + ;; We just need the only and only entry FILENAME. + (list (assoc base entries))))) + + ;; Sort entries. + (setq entries + (sort + entries + (lambda (x y) + (if (string-match "t" switches) + ;; Sort by date. + (tramp-time-less-p (nth 3 y) (nth 3 x)) + ;; Sort by name. + (string-lessp (nth 0 x) (nth 0 y)))))) + + ;; Handle "-F" switch. + (when (string-match "F" switches) + (mapc + (lambda (x) + (when (not (zerop (length (car x)))) + (cond + ((char-equal ?d (string-to-char (nth 1 x))) + (setcar x (concat (car x) "/"))) + ((char-equal ?x (string-to-char (nth 1 x))) + (setcar x (concat (car x) "*")))))) + entries)) + + ;; Print entries. (mapc (lambda (x) - (when (not (zerop (length (car x)))) - (cond - ((char-equal ?d (string-to-char (nth 1 x))) - (setcar x (concat (car x) "/"))) - ((char-equal ?x (string-to-char (nth 1 x))) - (setcar x (concat (car x) "*")))))) - entries)) - - ;; Print entries. - (mapc - (lambda (x) - (when (not (zerop (length (nth 0 x)))) - (when (string-match "l" switches) - (let ((attr - (when (tramp-smb-get-stat-capability v) - (ignore-errors - (file-attributes filename 'string))))) + (when (not (zerop (length (nth 0 x)))) + (when (string-match "l" switches) + (let ((attr + (when (tramp-smb-get-stat-capability v) + (ignore-errors + (file-attributes filename 'string))))) + (insert + (format + "%10s %3d %-8s %-8s %8s %s " + (or (nth 8 attr) (nth 1 x)) ; mode + (or (nth 1 attr) 1) ; inode + (or (nth 2 attr) "nobody") ; uid + (or (nth 3 attr) "nogroup") ; gid + (or (nth 7 attr) (nth 2 x)) ; size + (format-time-string + (if (tramp-time-less-p + (tramp-time-subtract (current-time) (nth 3 x)) + tramp-half-a-year) + "%b %e %R" + "%b %e %Y") + (nth 3 x)))))) ; date + + ;; We mark the file name. The inserted name could be + ;; from somewhere else, so we use the relative file name + ;; of `default-directory'. + (let ((start (point))) (insert (format - "%10s %3d %-8s %-8s %8s %s " - (or (nth 8 attr) (nth 1 x)) ; mode - (or (nth 1 attr) 1) ; inode - (or (nth 2 attr) "nobody") ; uid - (or (nth 3 attr) "nogroup") ; gid - (or (nth 7 attr) (nth 2 x)) ; size - (format-time-string - (if (tramp-time-less-p - (tramp-time-subtract (current-time) (nth 3 x)) - tramp-half-a-year) - "%b %e %R" - "%b %e %Y") - (nth 3 x)))))) ; date - - ;; We mark the file name. The inserted name could be - ;; from somewhere else, so we use the relative file name - ;; of `default-directory'. - (let ((start (point))) - (insert - (format - "%s\n" - (file-relative-name - (expand-file-name - (nth 0 x) (file-name-directory filename)) - (when full-directory-p (file-name-directory filename))))) - (put-text-property start (1- (point)) 'dired-filename t)) - (forward-line) - (beginning-of-line))) - entries))))) + "%s\n" + (file-relative-name + (expand-file-name + (nth 0 x) (file-name-directory filename)) + (when full-directory-p (file-name-directory filename))))) + (put-text-property start (1- (point)) 'dired-filename t)) + (forward-line) + (beginning-of-line))) + entries)))))) (defun tramp-smb-handle-make-directory (dir &optional parents) "Like `make-directory' for Tramp files." @@ -1277,6 +1278,8 @@ target of the symlink differ." ;; We must also flush the cache of the directory, because ;; `file-attributes' reads the values from there. + (tramp-flush-file-property v1 (file-name-directory v1-localname)) + (tramp-flush-file-property v1 v1-localname) (tramp-flush-file-property v2 (file-name-directory v2-localname)) (tramp-flush-file-property v2 v2-localname) (unless (tramp-smb-get-share v2) @@ -1349,7 +1352,7 @@ target of the symlink differ." ;; Use an asynchronous processes. By this, password can ;; be handled. (let ((p (apply - 'start-process-shell-command + 'start-process (tramp-get-connection-name v) (tramp-get-connection-buffer v) tramp-smb-acl-program args))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 9a97d824528..6be737eb3f0 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -240,7 +240,7 @@ pair of the form (KEY VALUE). The following KEYs are defined: tamper the process output. * `tramp-copy-program' This specifies the name of the program to use for remotely copying - the file; this might be the absolute filename of rcp or the name of + the file; this might be the absolute filename of scp or the name of a workalike program. It is always applied on the local host. * `tramp-copy-args' This specifies the list of parameters to pass to the above mentioned @@ -248,6 +248,13 @@ pair of the form (KEY VALUE). The following KEYs are defined: * `tramp-copy-env' A list of environment variables and their values, which will be set when calling `tramp-copy-program'. + * `tramp-remote-copy-program' + The listener program to be applied on remote side, if needed. + * `tramp-remote-copy-args' + The list of parameters to pass to the listener program, the hints + for `tramp-login-args' also apply here. Additionally, \"%r\" could + be used here and in `tramp-copy-args'. It denotes a randomly + chosen port for the remote listener. * `tramp-copy-keep-date' This specifies whether the copying program when the preserves the timestamp of the original file. @@ -275,7 +282,7 @@ pair of the form (KEY VALUE). The following KEYs are defined: What does all this mean? Well, you should specify `tramp-login-program' for all methods; this program is used to log in to the remote site. Then, there are two ways to actually transfer the files between the local and the -remote side. One way is using an additional rcp-like program. If you want +remote side. One way is using an additional scp-like program. If you want to do this, set `tramp-copy-program' in the method. Another possibility for file transfer is inline transfer, i.e. the @@ -1762,7 +1769,7 @@ Example: (and (memq system-type '(cygwin windows-nt)) (zerop (tramp-call-process - "reg" nil nil nil "query" (nth 1 (car v))))) + v "reg" nil nil nil "query" (nth 1 (car v))))) ;; Configuration file. (file-exists-p (nth 1 (car v))))) (setq r (delete (car v) r))) @@ -2816,7 +2823,7 @@ User is always nil." (if (memq system-type '(windows-nt)) (with-temp-buffer (when (zerop (tramp-call-process - "reg" nil t nil "query" registry-or-dirname)) + nil "reg" nil t nil "query" registry-or-dirname)) (goto-char (point-min)) (loop while (not (eobp)) collect (tramp-parse-putty-group registry-or-dirname)))) @@ -2895,7 +2902,7 @@ User is always nil." (defun tramp-handle-file-accessible-directory-p (filename) "Like `file-accessible-directory-p' for Tramp files." (and (file-directory-p filename) - (file-executable-p filename))) + (file-readable-p filename))) (defun tramp-handle-file-exists-p (filename) "Like `file-exists-p' for Tramp files." @@ -3333,8 +3340,9 @@ User is always nil." (defun tramp-handle-unhandled-file-name-directory (_filename) "Like `unhandled-file-name-directory' for Tramp files." ;; With Emacs 23, we could simply return `nil'. But we must keep it - ;; for backward compatibility. - (expand-file-name "~/")) + ;; for backward compatibility. "~/" cannot be returned, because + ;; there might be machines without a HOME directory (like hydra). + "/") (defun tramp-handle-set-visited-file-modtime (&optional time-list) "Like `set-visited-file-modtime' for Tramp files." @@ -3905,7 +3913,7 @@ be granted." (tramp-get-file-property vec (tramp-file-name-localname vec) (concat "file-attributes-" suffix) nil) - (file-attributes + (tramp-compat-file-attributes (tramp-make-tramp-file-name (tramp-file-name-method vec) (tramp-file-name-user vec) @@ -4117,18 +4125,32 @@ ALIST is of the form ((FROM . TO) ...)." ;;; Compatibility functions section: (defun tramp-call-process - (program &optional infile destination display &rest args) + (vec program &optional infile destination display &rest args) "Calls `call-process' on the local host. This is needed because for some Emacs flavors Tramp has defadvised `call-process' to behave like `process-file'. The Lisp error raised when PROGRAM is nil is trapped also, returning 1. Furthermore, traces are written with verbosity of 6." - (tramp-message - (vector tramp-current-method tramp-current-user tramp-current-host nil nil) - 6 "`%s %s' %s %s" program (mapconcat 'identity args " ") infile destination) - (if (executable-find program) - (apply 'call-process program infile destination display args) - 1)) + (let ((v (or vec + (vector tramp-current-method tramp-current-user + tramp-current-host nil nil))) + (destination (if (eq destination t) (current-buffer) destination)) + result) + (tramp-message + v 6 "`%s %s' %s %s" + program (mapconcat 'identity args " ") infile destination) + (condition-case err + (with-temp-buffer + (setq result + (apply + 'call-process program infile (or destination t) display args)) + (with-current-buffer + (if (bufferp destination) destination (current-buffer)) + (tramp-message v 6 "%d\n%s" result (buffer-string)))) + (error + (setq result 1) + (tramp-message v 6 "%d\n%s" result (error-message-string err)))) + result)) ;;;###tramp-autoload (defun tramp-read-passwd (proc &optional prompt) diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 1ee6e6ad025..9c0beb114bc 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -31,7 +31,7 @@ ;; should be changed only there. ;;;###tramp-autoload -(defconst tramp-version "2.2.9-24.4" +(defconst tramp-version "2.2.10" "This version of Tramp.") ;;;###tramp-autoload @@ -44,7 +44,7 @@ (= emacs-major-version 21) (>= emacs-minor-version 4))) "ok" - (format "Tramp 2.2.9-24.4 is not fit for %s" + (format "Tramp 2.2.10 is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version))))))) (unless (string-match "\\`ok\\'" x) (error "%s" x))) diff --git a/lisp/newcomment.el b/lisp/newcomment.el index 2d798494b8b..b607eb95df2 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el @@ -1390,22 +1390,12 @@ unless optional argument SOFT is non-nil." ;; If we're not inside a comment, just try to indent. ((not compos) (indent-according-to-mode)) (t - (let* ((comment-column - ;; The continuation indentation should be somewhere between - ;; the current line's indentation (plus 2 for good measure) - ;; and the current comment's indentation, with a preference - ;; for comment-column. - (save-excursion - ;; FIXME: use prev line's info rather than first line's. - (goto-char compos) - (min (current-column) (max comment-column - (+ 2 (current-indentation)))))) - (comstart (buffer-substring compos comin)) + (let* ((comstart (buffer-substring compos comin)) (normalp (string-match (regexp-quote (comment-string-strip comment-start t t)) comstart)) - (comment-end + (comend (if normalp comment-end ;; The comment starter is not the normal comment-start ;; so we can't just use comment-end. @@ -1416,19 +1406,42 @@ unless optional argument SOFT is non-nil." (buffer-substring (save-excursion (comment-enter-backward) (point)) (point)) - nil t))))) - (comment-start comstart) - (continuep (or comment-multi-line - (cadr (assoc comment-style comment-styles)))) - ;; Force comment-continue to be recreated from comment-start. - ;; FIXME: wrong if comment-continue was set explicitly! - ;; FIXME: use prev line's continuation if available. - (comment-continue nil)) - (if (and comment-multi-line (> (length comment-end) 0)) + nil t)))))) + (if (and comment-multi-line (> (length comend) 0)) (indent-according-to-mode) (insert-and-inherit ?\n) (forward-char -1) - (comment-indent continuep) + (let* ((comment-column + ;; The continuation indentation should be somewhere + ;; between the current line's indentation (plus 2 for + ;; good measure) and the current comment's indentation, + ;; with a preference for comment-column. + (save-excursion + ;; FIXME: use prev line's info rather than first + ;; line's. + (goto-char compos) + (min (current-column) + (max comment-column + (+ 2 (current-indentation)))))) + (comment-indent-function + ;; If the previous comment is on its own line, then + ;; reuse its indentation unconditionally. + ;; Important for modes like Python/Haskell where + ;; auto-indentation is unreliable. + (if (save-excursion (goto-char compos) + (skip-chars-backward " \t") + (bolp)) + (lambda () comment-column) comment-indent-function)) + (comment-start comstart) + (comment-end comend) + (continuep (or comment-multi-line + (cadr (assoc comment-style + comment-styles)))) + ;; Recreate comment-continue from comment-start. + ;; FIXME: wrong if comment-continue was set explicitly! + ;; FIXME: use prev line's continuation if available. + (comment-continue nil)) + (comment-indent continuep)) (save-excursion (let ((pt (point))) (end-of-line) diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el index b3ce7aaac25..4859bbc7a77 100644 --- a/lisp/nxml/nxml-mode.el +++ b/lisp/nxml/nxml-mode.el @@ -2567,7 +2567,7 @@ With a prefix argument, inserts the character directly." (> (prefix-numeric-value arg) 0)))) (when (not (eq new nxml-char-ref-extra-display)) (setq nxml-char-ref-extra-display new) - (font-lock-fontify-buffer)))) + (font-lock-flush)))) (put 'nxml-char-ref 'evaporate t) diff --git a/lisp/emulation/crisp.el b/lisp/obsolete/crisp.el index ad463412735..47cf898190b 100644 --- a/lisp/emulation/crisp.el +++ b/lisp/obsolete/crisp.el @@ -4,6 +4,7 @@ ;; Author: Gary D. Foster <Gary.Foster@Corp.Sun.COM> ;; Keywords: emulations brief crisp +;; Obsolete-since: 24.5 ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/gulp.el b/lisp/obsolete/gulp.el index d0a89b3075a..d959b73ba69 100644 --- a/lisp/emacs-lisp/gulp.el +++ b/lisp/obsolete/gulp.el @@ -5,6 +5,7 @@ ;; Author: Sam Shteingold <shteingd@math.ucla.edu> ;; Maintainer: emacs-devel@gnu.org ;; Keywords: maint +;; Obsolete-since: 24.5 ;; This file is part of GNU Emacs. diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el index c1313b8a00f..dfe1222d550 100644 --- a/lisp/obsolete/iswitchb.el +++ b/lisp/obsolete/iswitchb.el @@ -1416,10 +1416,7 @@ See the variable `iswitchb-case' for details." (isearch-no-upper-case-p iswitchb-text) (isearch-no-upper-case-p iswitchb-text t)))) -;; NB obsolete/ is not scanned for autoloads. -;; If you change any of the following doc, copy the changes to simple.el. - -;;;###autoload +;;;###obsolete-autoload (define-minor-mode iswitchb-mode "Toggle Iswitchb mode. With a prefix argument ARG, enable Iswitchb mode if ARG is @@ -1433,7 +1430,7 @@ between buffers using substrings. See `iswitchb' for details." (add-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup) (remove-hook 'minibuffer-setup-hook 'iswitchb-minibuffer-setup))) -;;;###autoload +;;;###obsolete-autoload (make-obsolete 'iswitchb-mode "use `icomplete-mode' or `ido-mode' instead." "24.4") diff --git a/lisp/obsolete/mailpost.el b/lisp/obsolete/mailpost.el index 880780c577c..bcd468c2b06 100644 --- a/lisp/obsolete/mailpost.el +++ b/lisp/obsolete/mailpost.el @@ -75,12 +75,7 @@ site-init." (if mail-interactive (with-current-buffer errbuf (erase-buffer)))) - (let ((m (default-file-modes))) - (unwind-protect - (progn - (set-default-file-modes 384) - (setq temfile (make-temp-file ",rpost"))) - (set-default-file-modes m))) + (with-file-modes 384 (setq temfile (make-temp-file ",rpost"))) (apply 'call-process (append (list (if (boundp 'post-mail-program) post-mail-program diff --git a/lisp/obsolete/pgg-pgp.el b/lisp/obsolete/pgg-pgp.el index 5a54cb0caff..5d6ae9cc2e9 100644 --- a/lisp/obsolete/pgg-pgp.el +++ b/lisp/obsolete/pgg-pgp.el @@ -202,15 +202,11 @@ passphrase cache or user." (defun pgg-pgp-verify-region (start end &optional signature) "Verify region between START and END as the detached signature SIGNATURE." (let* ((orig-file (pgg-make-temp-file "pgg")) - (args "+verbose=1 +batchmode +language=us") - (orig-mode (default-file-modes))) - (unwind-protect - (progn - (set-default-file-modes 448) - (let ((coding-system-for-write 'binary) - jka-compr-compression-info-list jam-zcat-filename-list) - (write-region start end orig-file))) - (set-default-file-modes orig-mode)) + (args "+verbose=1 +batchmode +language=us")) + (with-file-modes 448 + (let ((coding-system-for-write 'binary) + jka-compr-compression-info-list jam-zcat-filename-list) + (write-region start end orig-file))) (if (stringp signature) (progn (copy-file signature (setq signature (concat orig-file ".asc"))) diff --git a/lisp/obsolete/pgg-pgp5.el b/lisp/obsolete/pgg-pgp5.el index beece7ea2ea..944800cf0f6 100644 --- a/lisp/obsolete/pgg-pgp5.el +++ b/lisp/obsolete/pgg-pgp5.el @@ -208,15 +208,11 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." (defun pgg-pgp5-verify-region (start end &optional signature) "Verify region between START and END as the detached signature SIGNATURE." (let ((orig-file (pgg-make-temp-file "pgg")) - (args '("+verbose=1" "+batchmode=1" "+language=us")) - (orig-mode (default-file-modes))) - (unwind-protect - (progn - (set-default-file-modes 448) - (let ((coding-system-for-write 'binary) - jka-compr-compression-info-list jam-zcat-filename-list) - (write-region start end orig-file))) - (set-default-file-modes orig-mode)) + (args '("+verbose=1" "+batchmode=1" "+language=us"))) + (with-file-modes 448 + (let ((coding-system-for-write 'binary) + jka-compr-compression-info-list jam-zcat-filename-list) + (write-region start end orig-file))) (when (stringp signature) (copy-file signature (setq signature (concat orig-file ".asc"))) (setq args (append args (list signature)))) diff --git a/lisp/emulation/tpu-edt.el b/lisp/obsolete/tpu-edt.el index d9ed1908c76..43189319a6a 100644 --- a/lisp/emulation/tpu-edt.el +++ b/lisp/obsolete/tpu-edt.el @@ -6,6 +6,7 @@ ;; Maintainer: Rob Riepel <riepel@networking.stanford.edu> ;; Version: 4.5 ;; Keywords: emulations +;; Obsolete-since: 24.5 ;; This file is part of GNU Emacs. diff --git a/lisp/emulation/tpu-extras.el b/lisp/obsolete/tpu-extras.el index 9ebaaf6ffce..32257e840ac 100644 --- a/lisp/emulation/tpu-extras.el +++ b/lisp/obsolete/tpu-extras.el @@ -6,6 +6,7 @@ ;; Maintainer: Rob Riepel <riepel@networking.stanford.edu> ;; Keywords: emulations ;; Package: tpu-edt +;; Obsolete-since: 24.5 ;; This file is part of GNU Emacs. diff --git a/lisp/emulation/tpu-mapper.el b/lisp/obsolete/tpu-mapper.el index 2479389ac3c..d653685218b 100644 --- a/lisp/emulation/tpu-mapper.el +++ b/lisp/obsolete/tpu-mapper.el @@ -6,6 +6,7 @@ ;; Maintainer: Rob Riepel <riepel@networking.stanford.edu> ;; Keywords: emulations ;; Package: tpu-edt +;; Obsolete-since: 24.5 ;; This file is part of GNU Emacs. diff --git a/lisp/emulation/vi.el b/lisp/obsolete/vi.el index 9aae40c0d00..bb57735b0a9 100644 --- a/lisp/emulation/vi.el +++ b/lisp/obsolete/vi.el @@ -8,9 +8,12 @@ ;; Author: Neal Ziring <nz@rsch.wisc.edu> ;; Felix S. T. Wu <wu@crys.wisc.edu> ;; Keywords: emulations +;; Obsolete-since: 24.5 ;;; Commentary: +;; This file is obsolete. Consider using viper instead. + ;; Originally written by : seismo!wucs!nz@rsch.wisc.edu (Neal Ziring) ;; Extensively redesigned and rewritten by wu@crys.wisc.edu (Felix S.T. Wu) ;; Last revision: 01/07/87 Wed (for GNU Emacs 18.33) diff --git a/lisp/emulation/vip.el b/lisp/obsolete/vip.el index 09456e6320b..ea102cb0ac5 100644 --- a/lisp/emulation/vip.el +++ b/lisp/obsolete/vip.el @@ -1,10 +1,11 @@ ;;; vip.el --- a VI Package for GNU Emacs -;; Copyright (C) 1986-1988, 1992-1993, 1998, 2001-2014 Free Software -;; Foundation, Inc. +;; Copyright (C) 1986-1988, 1992-1993, 1998, 2001-2014 +;; Free Software Foundation, Inc. ;; Author: Masahiko Sato <ms@sail.stanford.edu> ;; Keywords: emulations +;; Obsolete-since: 24.5 ;; This file is part of GNU Emacs. @@ -23,6 +24,8 @@ ;;; Commentary: +;; This file is obsolete. Consider using viper instead. + ;; A full-featured vi(1) emulator. ;; ;; In Japan, the author's address is: masahiko@sato.riec.tohoku.junet diff --git a/lisp/emulation/ws-mode.el b/lisp/obsolete/ws-mode.el index fb140e6ebd7..d87cc73252b 100644 --- a/lisp/emulation/ws-mode.el +++ b/lisp/obsolete/ws-mode.el @@ -5,6 +5,7 @@ ;; Author: Juergen Nickelsen <nickel@cs.tu-berlin.de> ;; Version: 0.7 ;; Keywords: emulations +;; Obsolete-since: 24.5 ;; This file is part of GNU Emacs. diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog index a74388b7d71..669ac2d83d3 100644 --- a/lisp/org/ChangeLog +++ b/lisp/org/ChangeLog @@ -1,3 +1,14 @@ +2014-05-29 Stefan Monnier <monnier@iro.umontreal.ca> + + * org-compat.el (org-font-lock-ensure): New function. + * ox-odt.el (org-odt-do-format-code): + * ox-html.el (org-html-fontify-code): + * org.el (org-fontify-like-in-org-mode): + * org-src.el (org-src-font-lock-fontify-block): + * org-clock.el (org-clock-get-clocktable): Use it. + * ox-org.el (org-org-publish-to-org): Use it. Avoid using find-file + from Elisp. + 2014-05-12 Eric Schulte <eric.schulte@gmx.com> * ob-screen.el (org-babel-screen-session-write-temp-file) @@ -15,14 +26,13 @@ `org-babel-gnuplot-table-to-data´ expects a table, so we need to construct one when Babel hands us a vector. - * ob-ref.el (org-babel-ref-parse): If - `org-babel-current-src-block-location' is a marker, it can be from + * ob-ref.el (org-babel-ref-parse): + If `org-babel-current-src-block-location' is a marker, it can be from another buffer, use marker-position instead in this case. 2014-04-22 Arun Persaud <apersaud@lbl.gov> (tiny change) - * org-src.el (org-edit-src-exit): Don't add indentation on empty - lines. + * org-src.el (org-edit-src-exit): Don't add indentation on empty lines. 2014-04-22 Bastien Guerry <bzg@gnu.org> @@ -202,8 +212,8 @@ * org-table.el (org-table-copy-down) (org-table-find-dataline, org-table-move-row) - (org-table-insert-hline, org-table-kill-row): Use - `org-move-to-column' with the IGNORE-INVISIBLE arg set to `t', so + (org-table-insert-hline, org-table-kill-row): + Use `org-move-to-column' with the IGNORE-INVISIBLE arg set to `t', so that abbreviated rows don't interfer with setting the cursor back at the correct position. @@ -226,8 +236,8 @@ * org-table.el (org-table-field-info): Throw a user error when not at a table. - * org-agenda.el (org-agenda-drag-line-forward): Call - `org-agenda-mark-clocking-task' when done. + * org-agenda.el (org-agenda-drag-line-forward): + Call `org-agenda-mark-clocking-task' when done. (org-agenda-mark-clocking-task): Small refactoring. * org-compat.el (org-set-transient-map): Alias pointing at @@ -304,8 +314,8 @@ 2014-04-22 Markus Hauck <markus1189@gmail.com> (tiny change) - * org-agenda.el (org-agenda-get-scheduled): If - `org-agenda-skip-scheduled-if-deadline-is-shown' is set to + * org-agenda.el (org-agenda-get-scheduled): + If `org-agenda-skip-scheduled-if-deadline-is-shown' is set to 'repeated-after-deadline, still show tasks without any deadline 2014-04-22 Michael Brand <michael.ch.brand@gmail.com> @@ -468,8 +478,8 @@ followed by multiple blank lines. * ox.el (org-export-insert-default-template): Only insert - keywords and options relatives to the selected back-end. Ignore - those relatives to its parent in the case of a derived back-end. + keywords and options relatives to the selected back-end. + Ignore those relatives to its parent in the case of a derived back-end. * ox-beamer.el: Remove unnecessary package definitions in default class. @@ -562,8 +572,8 @@ docstring. (org-entry-get): Minor docstring enhancement. (org-set-startup-visibility): Bugfix. - (org-shiftcontrolup, org-shiftcontroldown): When - `org-support-shift-select' is not `nil', let-bind it to nil if + (org-shiftcontrolup, org-shiftcontroldown): + When `org-support-shift-select' is not `nil', let-bind it to nil if point is on a clock log. Otherwise throw an error. * ob-lob.el (org-babel-lob-files): Fix custom type. @@ -613,21 +623,21 @@ * ox-html.el: Clean up "FIXME" comments. - * ox-publish.el (org-publish-resolve-external-fuzzy-link): Fix - docstring. + * ox-publish.el (org-publish-resolve-external-fuzzy-link): + Fix docstring. * ox.el (org-export-smart-quotes-regexps): Fix smart quote detection when it is followed by an open parenthesis syntax class. - * org-element.el (org-element-inline-babel-call-successor): Use - original regexp to stay up-to-date with Babel changes. + * org-element.el (org-element-inline-babel-call-successor): + Use original regexp to stay up-to-date with Babel changes. (org-element--affiliated-re): Fix affiliated keyword regexp. * ox-org.el (org-org-identity): Since back-end specific keywords are stripped from output, also remove attr_backend keywords. (org-babel-exp-process-buffer): Fix duplicate evaluation with :wrap src. - (org-babel-exp-non-block-elements): Removed function. + (org-babel-exp-non-block-elements): Remove function. 2013-01-07 Ted Wiles <thewiles@wharton.upenn.edu> (tiny change) @@ -702,10 +712,10 @@ (org-texinfo-drawer): Always use `org-texinfo-format-drawer-function' as it is now a function by default. - (org-texinfo-headline): Compare - `org-texinfo-format-headline-function' against 'ignore. - (org-texinfo-inlinetask): Compare - `org-texinfo-format-inlinetask-function' against 'ignore. + (org-texinfo-headline): + Compare `org-texinfo-format-headline-function' against 'ignore. + (org-texinfo-inlinetask): + Compare `org-texinfo-format-inlinetask-function' against 'ignore. * ox-odt.el (org-odt-format-drawer-function): Use a function as the default value. Update docstring. @@ -713,8 +723,8 @@ (org-odt-format-inlinetask-function): Fix default value. (org-odt-drawer): Always use `org-odt-format-drawer-function' as it is now a function by default. - (org-odt-format-headline--wrap): Compare - `org-odt-format-headline-function' against 'ignore. + (org-odt-format-headline--wrap): + Compare `org-odt-format-headline-function' against 'ignore. * ox-latex.el (org-latex-format-drawer-function): Use a function as the default value. Update docstring. @@ -722,18 +732,18 @@ (org-latex-drawer): Always use `org-latex-format-drawer-function' as it is now a function by default. - (org-latex-inlinetask): Compare - `org-latex-format-inlinetask-function' against 'ignore. + (org-latex-inlinetask): + Compare `org-latex-format-inlinetask-function' against 'ignore. * ox-html.el (org-html-format-drawer-function): Use a function as the default value. Update docstring. (org-html-format-headline-function) (org-html-format-inlinetask-function): Fix default value. (org-html--format-toc-headline) - (org-html-format-headline--wrap): Compare - `org-html-format-headline-function' against 'ignore. - (org-html-inlinetask): Compare - `org-html-format-inlinetask-function' against 'ignore. + (org-html-format-headline--wrap): + Compare `org-html-format-headline-function' against 'ignore. + (org-html-inlinetask): + Compare `org-html-format-inlinetask-function' against 'ignore. * ox-ascii.el (org-ascii-format-drawer-function): Use a function as the default value. Update docstring. @@ -741,8 +751,8 @@ `org-ascii-format-drawer-function' as it is now a function by default. (org-ascii-format-inlinetask-default): New function. - (org-ascii-format-inlinetask-function): Use - `org-ascii-format-inlinetask-default' as the default. + (org-ascii-format-inlinetask-function): + Use `org-ascii-format-inlinetask-default' as the default. * org.el (org-mouse-1-follows-link): Use :set to set the default value. Update custom type. @@ -750,14 +760,14 @@ type. (orgstruct-heading-prefix-regexp): Use an empty string as the default value. Use 'regexp as the custom type. - (orgstruct-make-binding): Tiny docstring enhancement. Assume - `orgstruct-heading-prefix-regexp' is a string. + (orgstruct-make-binding): Tiny docstring enhancement. + Assume `orgstruct-heading-prefix-regexp' is a string. - * org-agenda.el (org-agenda-search-view-max-outline-level): Set - default value to 0. Update docstring. + * org-agenda.el (org-agenda-search-view-max-outline-level): + Set default value to 0. Update docstring. (org-agenda-deadline-leaders): Fix custom type. - (org-search-view): Assume - `org-agenda-search-view-max-outline-level' is a number. + (org-search-view): + Assume `org-agenda-search-view-max-outline-level' is a number. * ob-ruby.el (org-babel-ruby-nil-to): Fix custom type. @@ -807,8 +817,8 @@ * ox-html.el (org-html-format-latex): Add an argument. Ensure latex header is the same as specified in the original buffer when exporting a LaTeX fragment or environment. - (org-html-latex-environment, org-html-latex-fragment): Apply - signature change. + (org-html-latex-environment, org-html-latex-fragment): + Apply signature change. * ox-publish.el (org-publish-cache-ctime-of-src): Return an error when publishing a non-existent file. @@ -976,8 +986,8 @@ * org.el (org-format-latex): Do not re-generate a LaTeX preview if the image already exists. - * org-agenda.el (org-agenda-search-view-max-outline-level): New - option to define the max level for the entries shown by the search + * org-agenda.el (org-agenda-search-view-max-outline-level): + New option to define the max level for the entries shown by the search view. A value of 1 means to show the top parent of the entries. * org.el (org-create-formula-image-with-dvipng): Fix bug that made @@ -1000,8 +1010,8 @@ (org-babel-get-rownames, org-table.el) (org-table-transpose-table-at-point): Replace the inadvertent use of mapcar* (from cl) by plain mapcar and direct cons manipulation. - (org-babel-params-from-properties): Use - `org-babel-current-src-block-location' for evaluating new-style + (org-babel-params-from-properties): + Use `org-babel-current-src-block-location' for evaluating new-style header-argument properties. Remove superfluous save-match-data clauses. Comment which properties get evaluated where. (org-babel-insert-header-arg, org-babel-parse-src-block-match): @@ -1017,8 +1027,8 @@ `org-re-property'. (org-re-property-keyword): Remove, functionality is subsumed by `org-re-property'. - (org-property-re): Define using `org-re-property'. Improve - definition so that this regex can be + (org-property-re): Define using `org-re-property'. + Improve definition so that this regex can be (org-entry-get, org-property-values): Adjust match number for PROPVAL. (org-entry-put): Use `org-re-property' instead of `org-re-property-keyword'. @@ -1032,13 +1042,13 @@ (define-obsolete-function-alias): Actually remove the third (and any following) argument from the argument list before calling the advised function. Extend eval-and-compile clause and add advices - for functions that have different parameter lists in XEmacs. Add - variable definitions that XEmacs lacks . + for functions that have different parameter lists in XEmacs. + Add variable definitions that XEmacs lacks . * ob-fortran.el (org-every): Declare. - * org-element.el (org-element-node-property-parser): Use - `org-property-re' and adjust match group numbers accordingly. + * org-element.el (org-element-node-property-parser): + Use `org-property-re' and adjust match group numbers accordingly. Move `looking-at' out of the let clause to not rely on the unspecified evaluation order inside the let. @@ -1058,8 +1068,8 @@ argument list that XEmacs complains about by adding parenthesis. * ob-octave.el (org-babel-octave-initiate-session): If octave-inf - can't be loaded, try octave instead before giving up. Emacs - 24.3.50 and upwards replaces octave-inf with just plain octave. + can't be loaded, try octave instead before giving up. + Emacs 24.3.50 and upwards replaces octave-inf with just plain octave. * org-id.el (org-id-update-id-locations): Autoload interactive function. @@ -1079,8 +1089,8 @@ * org-table.el (org-table-colgroup-info): Remove unused defvar for `org-table-colgroup-info'. (org-table-clean-before-export): Let-bind regular expression - strings and remove unused matching group. Use - `org-table-clean-did-remove-column' in cond statement rather than + strings and remove unused matching group. + Use `org-table-clean-did-remove-column' in cond statement rather than branching via if to avoid code duplication. Remove the code associated with the removed `org-table-colgroup-info'. (orgtbl-export): Remove unused internal function. @@ -1132,8 +1142,8 @@ * ob-perl.el (org-babel-execute:perl): Pass `result-params´ through to `org-babel-perl-evaluate´. (org-babel-variable-assignments:perl): Add "my" to variable - declaration so that it becomes compatible with "use strict;". Use - new internal formatting function `org-babel-perl--var-to-perl´. + declaration so that it becomes compatible with "use strict;". + Use new internal formatting function `org-babel-perl--var-to-perl´. (org-babel-perl--var-to-perl): New internal function, uses Perl non-interpolating quoting on the string that defines the variable to suppress spurious interpretation of it as Perl syntax. @@ -1151,8 +1161,8 @@ * ob-eval.el (org-babel-eval): Use simplified version of `org-babel--shell-command-on-region´, we are the only caller of this function. - (org-babel--shell-command-on-region): Replace - `org-babel-shell-command-on-region´ with a much more simplified + (org-babel--shell-command-on-region): + Replace `org-babel-shell-command-on-region´ with a much more simplified internal version, remove superfluous DOCSTRING and interactive clause, strip out all conditionals which were never used. Prevent deletion of temporary input file to aid debugging when the symbol @@ -1183,8 +1193,8 @@ * org-macs.el: New macro to allow the 5-argument form of load to be used where possible without breaking compatibility with XEmacs. - * org.el (org-version, org-reload): Use - `org-load-noerror-mustsuffix´ instead of adding a fifth argument + * org.el (org-version, org-reload): + Use `org-load-noerror-mustsuffix´ instead of adding a fifth argument to load directly. Guard against undefined variable load-suffixes, which doesn't exist in XEmacs. @@ -1208,8 +1218,8 @@ 2013-11-12 Alan Schmitt <alan.schmitt@polytechnique.org> - * ob-ocaml.el (org-babel-prep-session:ocaml): Use - `save-window-excursion' around the code starting the tuareg + * ob-ocaml.el (org-babel-prep-session:ocaml): + Use `save-window-excursion' around the code starting the tuareg process. (org-babel-ocaml-command): New option to specify the name of the toplevel to run. @@ -1266,8 +1276,8 @@ when inserting the new time as a text property. (org-agenda-filter-make-matcher): When filtering tags and hitting space, filter out entries with tags, only keep those without tags. - (org-agenda-drag-line-forward, org-agenda-drag-line-backward): Fix - bugs: don't drag lines without text and don't drag lines + (org-agenda-drag-line-forward, org-agenda-drag-line-backward): + Fix bugs: don't drag lines without text and don't drag lines before/after hidden lines. * ox-odt.el (org-odt-table-style-format): Use %s for inserting the @@ -1362,8 +1372,8 @@ * org-capture.el (org-capture-set-target-location): Don't throw an error when `org-time-was-given' is not bound. - * org-clock.el (org-clock-modify-effort-estimate): Clarify - docstring. + * org-clock.el (org-clock-modify-effort-estimate): + Clarify docstring. * org.el (org-set-regexps-and-options-for-tags): Return a list with tag-related variables. @@ -1385,8 +1395,8 @@ (org-get-outline-path): Remove statistical and checkboxes cookies. * org-agenda.el (org-agenda, org-search-view, org-tags-view) - (org-agenda-get-day-entries, org-agenda-set-restriction-lock): Use - (current-buffer) as the value of `org-agenda-restrict'. Fix a bug + (org-agenda-get-day-entries, org-agenda-set-restriction-lock): + Use (current-buffer) as the value of `org-agenda-restrict'. Fix a bug about narrowing to wrong region boundaries when `org-agenda-restrict' is non-nil. @@ -1395,20 +1405,20 @@ (org-insert-heading): Fix case when there the first heading starts at the beginning of the buffer. - * ob-core.el (org-babel-expand-src-block): Use - `org-called-interactively-p'. + * ob-core.el (org-babel-expand-src-block): + Use `org-called-interactively-p'. * org.el (org-agenda-prepare-buffers): Avoid duplicates in `org-tag-alist-for-agenda' correctly. (org-read-date-minibuffer-local-map): Check if we are at the - beginning of the prompt, not if we are after a whitespace. Bind - C-. to `calendar-goto-today'. + beginning of the prompt, not if we are after a whitespace. + Bind C-. to `calendar-goto-today'. * org-clock.el (org-clock-in): Don't forward by one character when setting the marker in the clock history. - * org.el (org-read-date-minibuffer-local-map): Call - `calendar-goto-today' only if there is a space before point in the + * org.el (org-read-date-minibuffer-local-map): + Call `calendar-goto-today' only if there is a space before point in the minibuffer prompt. (org-insert-heading): Reveal context when called interactively. Fix bug about wrong conversion of lines with :END: or #+end_ into @@ -1497,8 +1507,8 @@ (org-mark-subtree, org-kill-line, org-first-sibling-p) (org-up-element, org-down-element) (org-drag-element-backward, org-drag-element-forward) - (org-unindent-buffer, org-speedbar-set-agenda-restriction): Use - `user-error' instead of `error'. + (org-unindent-buffer, org-speedbar-set-agenda-restriction): + Use `user-error' instead of `error'. * ox-latex.el (latex): Don't force exporting with smart quotes. @@ -1518,8 +1528,8 @@ values. * org.el (org-shifttab): Show the correct number of empty - headlines when called with a numeric prefix argument. Enhance - docstring. + headlines when called with a numeric prefix argument. + Enhance docstring. (org-uniquify): Use `copy-sequence'. (org-adaptive-fill-function, org-fill-paragraph): Throw a useful error message when parse an element fails in the current buffer. @@ -1533,8 +1543,8 @@ (org-cycle-emulate-tab, org-file-apps) (org-set-font-lock-defaults) (org-translate-link-from-planner, org-link-search) - (org-refile-get-targets, org-read-date-get-relative): Minor - code clean-up: fix dangling parentheses. + (org-refile-get-targets, org-read-date-get-relative): + Minor code clean-up: fix dangling parentheses. * org-agenda.el (org-agenda-entry-text-mode): Also check against regexp filters. @@ -1594,8 +1604,8 @@ * org-mouse.el (org-mouse-agenda-context-menu): Fix a function's name. - * ox.el (org-export-options-alist, org-export--skip-p): Use - `:with-planning' instead of `:with-plannings', to keep in sync + * ox.el (org-export-options-alist, org-export--skip-p): + Use `:with-planning' instead of `:with-plannings', to keep in sync with the corresponding option's name. * ob-core.el (org-babel-confirm-evaluate): Fix typo in docstring. @@ -1766,8 +1776,8 @@ (org-re-timestamp): Handle closed time-stamps. (org-closed-in-range): Delete. - * org-capture.el (org-capture-import-remember-templates): Take - care of adding :jump-to-captured option if needed. + * org-capture.el (org-capture-import-remember-templates): + Take care of adding :jump-to-captured option if needed. * org.el (org-toggle-pretty-entities): Enhance messages. (org-raise-scripts): Handle scripts like "a_b^c". @@ -1850,8 +1860,8 @@ information for filtering in the agenda buffer. (org-uniquify-alist): New function. - * org-pcomplete.el (pcomplete/org-mode/file-option/tags): Handle - :grouptags. + * org-pcomplete.el (pcomplete/org-mode/file-option/tags): + Handle :grouptags. * org-faces.el (mode-line): New face for group tags. @@ -1911,8 +1921,8 @@ * ox-ascii.el (ascii): Use `org-export-define-backend' and `org-export-define-derived-backend' as defuns, not macros. - * org.el (org-set-regexps-and-options): Use - `org-table-set-constants'. + * org.el (org-set-regexps-and-options): + Use `org-table-set-constants'. * org-table.el (org-table-set-constants): New function. (orgtbl-ctrl-c-ctrl-c): Use it. @@ -1938,8 +1948,8 @@ * ox-publish.el (org-publish-org-to) (org-publish-org-sitemap, org-publish-find-title) (org-publish-find-date) - (org-publish-cache-file-needs-publishing): Set - `org-inhibit-startup' to t when visiting files for + (org-publish-cache-file-needs-publishing): + Set `org-inhibit-startup' to t when visiting files for publication. * ox-org.el (org-org-publish-to-org): Kill buffers not visited at @@ -1978,8 +1988,8 @@ (org-agenda-filter-remove-all): New command. (org-agenda-filter-show-all-re): Rename from `org-agenda-filter-show-all-regexp'. - (org-agenda-filter-by-regexp): Call - `org-agenda-filter-show-all-re'. + (org-agenda-filter-by-regexp): + Call `org-agenda-filter-show-all-re'. * org-list.el (org-insert-item): Don't ask for a definition term when insert an item in a description list. @@ -2011,11 +2021,11 @@ * ox.el (org-export--copy-to-kill-ring-p): New function. (org-export-copy-to-kill-ring): Use 'if-interactive as the default. - (org-export-to-buffer, org-export-to-file): Use - `org-export--copy-to-kill-ring-p' and fix docstrings. + (org-export-to-buffer, org-export-to-file): + Use `org-export--copy-to-kill-ring-p' and fix docstrings. - * ox-odt.el (org-odt-export-as-odf): Use - `org-export--copy-to-kill-ring-p'. + * ox-odt.el (org-odt-export-as-odf): + Use `org-export--copy-to-kill-ring-p'. * org.el (org-set-font-lock-defaults): Fontify macros. @@ -2053,8 +2063,8 @@ (org-scheduled-time-hour-regexp): New buffer local variables. (org-set-regexps-and-options): Set the new variables. - * org-agenda.el (org-agenda-custom-commands-local-options): Add - :deadline* and :scheduled* to the list of possible agenda entry + * org-agenda.el (org-agenda-custom-commands-local-options): + Add :deadline* and :scheduled* to the list of possible agenda entry types. (org-agenda): Implement a new agenda type agenda* with :scheduled* and :deadline* replacing :scheduled and :deadline respectively in @@ -2065,15 +2075,15 @@ (org-agenda-list): New parameter `with-hour'. Use :scheduled* and :deadline*. (org-agenda-get-day-entries): Handle :scheduled* and :deadline*. - (org-agenda-get-deadlines, org-agenda-get-scheduled): New - parameter `with-hour'. Use `org-deadline-time-hour-regexp' or + (org-agenda-get-deadlines, org-agenda-get-scheduled): + New parameter `with-hour'. Use `org-deadline-time-hour-regexp' or `org-scheduled-time-hour-regexp' as the search string if needed. (org-agenda-to-appt): Use :scheduled* and :deadline* by default, as other scheduled and deadline items don't have a time spec and cannot be turned into appointments. Trim bracket links and use only the description as the appointment text. - (org-agenda-get-restriction-and-command): Add - default description for the agenda* view. + (org-agenda-get-restriction-and-command): + Add default description for the agenda* view. (org-agenda-run-series): Handle agenda* views. * org-faces.el (org-agenda-filter-tags) @@ -2082,13 +2092,13 @@ (org-agenda-filter-category): Docstring fix. (org-agenda-filter-category): New face. - * org-agenda.el (org-agenda-local-vars): Add - `org-agenda-re-filter-overlays' and `org-agenda-regexp-filter'. + * org-agenda.el (org-agenda-local-vars): + Add `org-agenda-re-filter-overlays' and `org-agenda-regexp-filter'. (org-agenda-mode-map): Use "|" for `org-agenda-filtered-by-regexp'. (org-agenda-re-filter-overlays): New variable. - (org-agenda-mark-filtered-text): Use - `org-agenda-re-filter-overlays'. + (org-agenda-mark-filtered-text): + Use `org-agenda-re-filter-overlays'. (org-agenda-finalize, org-agenda-redo): Allow regexp filtering. (org-agenda-filter-by-category): Set `org-agenda-category-filter' here instead of within `org-agenda-apply-filter'. @@ -2098,8 +2108,8 @@ (org-agenda-filter-make-matcher): Make matcher for regexp filters. (org-agenda-filter-apply): Don't set `org-agenda-tag-filter' and `org-agenda-category-filter'. Maybe apply regexp filter. - (org-agenda-filter-hide-line): Add docstring. Hide - regexp-filtered lines. + (org-agenda-filter-hide-line): Add docstring. + Hide regexp-filtered lines. (org-agenda-filter-show-all-tag, org-agenda-filter-show-all-cat): Add docstring. (org-agenda-filter-show-all-regexp): New function. @@ -2108,8 +2118,8 @@ (org-agenda-regexp-filter-preset): New variable. (org-agenda-prepare): Use the new variable. - * ox-odt.el (org-odt-code, org-odt-verbatim): Use - `org-odt--encode-plain-text'. + * ox-odt.el (org-odt-code, org-odt-verbatim): + Use `org-odt--encode-plain-text'. * ox-html.el (org-html-link): Minor code clean-up. @@ -2184,8 +2194,8 @@ a universal prefix arg will only convert the first line. This is more consistent with `org-toggle-item'. (orgstruct-setup): Add `org-ctrl-c-minus' and `org-ctrl-c-star'. - (customize-package-emacs-version-alist): Update - `customize-package-emacs-version-alist'. + (customize-package-emacs-version-alist): + Update `customize-package-emacs-version-alist'. * ox-texinfo.el (org-export-texinfo) (org-texinfo-filename, org-texinfo-classes) @@ -2280,8 +2290,8 @@ docstring. * ox-latex.el: - (org-latex-table-scientific-notation, org-latex-verse-block): Fix - typos in docstrings. + (org-latex-table-scientific-notation, org-latex-verse-block): + Fix typos in docstrings. * ox-html.el (org-html-text-markup-alist) (org-html-pretty-output, org-html-link-org-files-as-html) @@ -2297,8 +2307,8 @@ (org-html-format-list-item, org-html-format-latex) (org-html-encode-plain-text) (org-html-table-first-row-data-cells) - (org-html-table--table.el-table, org-html-final-function): Fix - or add docstring. + (org-html-table--table.el-table, org-html-final-function): + Fix or add docstring. * org.el (org-insert-heading): If the current item has a checkbox, insert the new item with a checkbox. @@ -2337,8 +2347,8 @@ known as HTML_STYLE_EXTRA. (org-html-head): Enhance docstring. (org-html-head-extra): Reintroduce. Was `org-html-style-extra'. - (org-html--build-head): Rename from `org-html--build-head'. Add - information from `org-html-head-extra'. + (org-html--build-head): Rename from `org-html--build-head'. + Add information from `org-html-head-extra'. (org-html-template): Use `org-html--build-head'. * ox-html.el (org-html-display-buffer-mode): Delete. @@ -2361,8 +2371,8 @@ (org-insert-heading-respect-content): New optional argument arg, passed to `org-insert-heading'. - * org.el (org-mode): Remove syntax entries. Use - `org-backward-element' and `org-forward-element' for + * org.el (org-mode): Remove syntax entries. + Use `org-backward-element' and `org-forward-element' for `beginning-of-defun-function' and `end-of-defun-function': this allows using C-M-a and C-M-e before the first headline. @@ -2374,8 +2384,8 @@ publishing projects. * ox-html.el (org-html-style-default): Update docstring. - (org-html-infojs-install-script, org-html--build-style): Update - property names. + (org-html-infojs-install-script, org-html--build-style): + Update property names. (org-html-head-include-scripts) (org-html-head-include-default-style, org-html-head): Respectively rename from `org-html-style-include-scripts', @@ -2391,8 +2401,8 @@ * ob-tangle.el (org-babel-tangle): Remove unused attempt of prompting the user of the tangle file name since :tangle is always set. Don't prompt for a tangle file name when called with two - universal prefix arg outside of a src block. Use - `org-babel-tangle-single-block'. + universal prefix arg outside of a src block. + Use `org-babel-tangle-single-block'. (org-babel-tangle-single-block): New function. (org-babel-tangle-collect-blocks): Use the new function. @@ -2464,8 +2474,8 @@ universal prefix arguments, set the warning time or the delay relatively to the current timestamp, not to today's date. - * org-agenda.el (org-agenda-filter-apply): Deactive - `org-agenda-entry-text-mode' when filtering. + * org-agenda.el (org-agenda-filter-apply): + Deactive `org-agenda-entry-text-mode' when filtering. (org-agenda-entry-text-mode): Don't allow in filtered views. Don't show the maximum number of lines when turning off. @@ -2567,8 +2577,8 @@ * org-macs.el (org-unmodified): Update comment. Don't define `with-silent-modifications' for emacsen that don't have it. - * org-compat.el (org-with-silent-modifications): New - compatibility macro. + * org-compat.el (org-with-silent-modifications): + New compatibility macro. * org.el (org-refresh-category-properties) (org-refresh-properties, org-entry-blocked-p) @@ -2628,8 +2638,8 @@ * ox-publish.el (org-publish-sitemap-date-format): Small docstring enhancement. - * ox-latex.el (org-latex-format-headline-default-function): New - option. + * ox-latex.el (org-latex-format-headline-default-function): + New option. (org-latex-format-headline-function): Use the new option as the default value. (org-latex-toc-command): Don't add vertical space after the table @@ -2686,8 +2696,8 @@ (org-html-htmlized-org-css-url) (org-html-htmlize-region-for-paste): Rename from org-export-htmlize-*. - (org-html-htmlize-generate-css, org-html-fontify-code): Use - the correct names. + (org-html-htmlize-generate-css, org-html-fontify-code): + Use the correct names. * org-compat.el (org-file-equal-p): New compatibility function. @@ -2698,8 +2708,8 @@ (org-clock-in, org-clock-out): Set and delete `org-clock-current-task'. Minor code clean-up. - * org-clock.el (org-clock-in, org-clock-in-last): Tell - `org-current-time' to always return a past time. + * org-clock.el (org-clock-in, org-clock-in-last): + Tell `org-current-time' to always return a past time. * org.el (org-current-time): New argument `past' to force returning a past time when rounding. @@ -2728,8 +2738,8 @@ `org-emphasis-alist' word constituents. (org-mode-transpose-word-syntax-table): Rename from `org-syntax-table'. - (org-transpose-words): Use - `org-mode-transpose-word-syntax-table'. + (org-transpose-words): + Use `org-mode-transpose-word-syntax-table'. * ox.el (org-export--dispatch-ui) (org-export--dispatch-action): Use integers for control chars. @@ -2765,8 +2775,8 @@ (org-edit-src-exit): Inconditionally kill the src/example editing buffer. - * org-pcomplete.el (pcomplete/org-mode/file-option): Require - 'org-element. This fixes a bug about unbound variable + * org-pcomplete.el (pcomplete/org-mode/file-option): + Require 'org-element. This fixes a bug about unbound variable `org-element-affiliated-keywords' when trying to complete a keyword before 'org-element was required. @@ -2791,8 +2801,8 @@ * org.el (org-syntax-table, org-transpose-words): Delete. (org-mode): Syntactically Define {} and <> as parentheses. - (org-drag-line-forward, org-drag-line-backward): New - functions. + (org-drag-line-forward, org-drag-line-backward): + New functions. (org-shiftmetaup, org-shiftmetadown): Fall back on the new functions instead of throwing an error. (org-make-org-heading-search-string): Don't use statistic or [x/y] @@ -2803,8 +2813,8 @@ * org.el (org-emphasis-alist, org-protecting-blocks): * org-src.el (org-edit-src-find-region-and-lang): * org-list.el (org-list-forbidden-blocks): - * org-footnote.el (org-footnote-forbidden-blocks): Remove - references to the deleted DocBook exporter. + * org-footnote.el (org-footnote-forbidden-blocks): + Remove references to the deleted DocBook exporter. * org.el (org-end-of-line): Don't throw an error outside elements. @@ -3056,8 +3066,8 @@ (org-transpose-words): New command, simply wrapping the new syntax table around `transpose-words'. (org-mode-map): Bind `org-transpose-words' to `M-t'. - (org-store-link): Use keyword at point as the search string. Use - `delq nil' instead of `delete nil'. + (org-store-link): Use keyword at point as the search string. + Use `delq nil' instead of `delete nil'. (org-make-org-heading-search-string): Rewrite using org-element.el. Not an interactive function anymore. @@ -3100,8 +3110,8 @@ these list HTML tags: <ul> <dl> and <ol>. * org-clock.el (org-clock-timestamps-up) - (org-clock-timestamps-down, org-clock-timestamps-change): Add - an optional argument N to change timestamps by several units. + (org-clock-timestamps-down, org-clock-timestamps-change): + Add an optional argument N to change timestamps by several units. * org.el (org-shiftcontrolup, org-shiftcontroldown): Ditto. @@ -3112,8 +3122,8 @@ * org.el (org-block-entry-blocking): New variable. (org-todo): Use it. Also use `user-error' when a TODO state change is blocked. - (org-block-todo-from-children-or-siblings-or-parent): Display - `org-block-entry-blocking' in the user-error message. + (org-block-todo-from-children-or-siblings-or-parent): + Display `org-block-entry-blocking' in the user-error message. * org.el (org-get-cursor-date): New optional argument WITH-TIME to add the time of the day. @@ -3180,8 +3190,8 @@ (org-use-last-clock-out-time-as-effective-time): New option. (org-current-effective-time): Use the new option. - * org-clock.el (org-clock-get-last-clock-out-time): New - function. + * org-clock.el (org-clock-get-last-clock-out-time): + New function. * org.el (org-toggle-inline-images): Only send a message when called interactively. @@ -3209,8 +3219,8 @@ (org-agenda-get-blocks, org-agenda-change-all-lines): Add a new text property 'level, a string with as many whitespaces as the level of the item. - (org-agenda-format-item, org-compile-prefix-format): Handle - the new `%l' specifier. + (org-agenda-format-item, org-compile-prefix-format): + Handle the new `%l' specifier. * org-colview.el (org-columns-next-allowed-value): Add the CLOCKSUM property to the list of properties that can be @@ -3268,15 +3278,15 @@ * org-agenda.el (org-agenda-custom-commands-local-options): (org-agenda-span, org-agenda-ndays-to-span) (org-agenda-span-to-ndays, org-agenda-list, org-agenda-later) - (org-agenda-change-time-span, org-agenda-compute-starting-span): Add - support for fortnight view. + (org-agenda-change-time-span, org-agenda-compute-starting-span): + Add support for fortnight view. (org-agenda-menu): Add fortnight view command. (org-agenda-fortnight-view): New command. * org-timer.el (org-clock-sound): Silence compiler. - * org.el (org-beginning-of-line, org-end-of-line): Bind - deactivate-mark to avoid that this command deactivates it. + * org.el (org-beginning-of-line, org-end-of-line): + Bind deactivate-mark to avoid that this command deactivates it. (org-make-tags-matcher): Do not interpret / in property value as starter of TODO match. (org-overview): Preserve point. @@ -3300,11 +3310,11 @@ * org.el (org-unlogged-message): New function. (org-cycle, org-cycle-internal-global, org-cycle-internal-local) - (org-global-cycle, org-display-outline-path): Use - `org-unlogged-message'. + (org-global-cycle, org-display-outline-path): + Use `org-unlogged-message'. - * org-pcomplete.el (org-make-org-heading-search-string): Fix - function declaration. + * org-pcomplete.el (org-make-org-heading-search-string): + Fix function declaration. (pcomplete/org-mode/searchhead): Remove incorrect second arguments to `org-make-org-heading-search-string'. @@ -3323,8 +3333,8 @@ (org-display-outline-path): Do not log outline path in Message buffer. (org-agenda-ignore-drawer-properties): New option. - (org-agenda-prepare-buffers): Honour - `org-agenda-ignore-drawer-properties'. + (org-agenda-prepare-buffers): + Honour `org-agenda-ignore-drawer-properties'. * org-clock.el (org-clock-goto): Recenter to thrd line @@ -3335,8 +3345,8 @@ (org-set-regexps-and-options-for-tags): Use `org-bookmark-names-plist'. (org-refile): Use `org-bookmark-names-plist'. - * org-capture.el (org-capture-bookmark-last-stored-position): Use - `org-bookmark-names-plist'. + * org-capture.el (org-capture-bookmark-last-stored-position): + Use `org-bookmark-names-plist'. * org.el (org-insert-heading): Rewritten from scratch. (org-N-empty-lines-before-current): New function @@ -3356,8 +3366,8 @@ * org-ctags.el (org-ctags-path-to-ctags): Avoid usine `case'. - * org.el (org-beginning-of-line, org-end-of-line): Set - disable-point-adjustment when the command ends next to invisible + * org.el (org-beginning-of-line, org-end-of-line): + Set disable-point-adjustment when the command ends next to invisible text. * ob-lob.el (org-babel-lob-files): Fix custom type. @@ -3430,8 +3440,8 @@ 2013-11-12 Christian Moe <mail@christianmoe.com> - * ox-odt.el (org-odt-line-break, org-odt-plain-text): Remove - newline after line-break tag. + * ox-odt.el (org-odt-line-break, org-odt-plain-text): + Remove newline after line-break tag. 2013-11-12 Christophe Junke <christophe.junke@inria.fr> (tiny change) @@ -3454,16 +3464,16 @@ property. (org-heading-components): Use `org-heading-regexp' in orgstruct-mode. - (orgstruct-heading-prefix-regexp, orgstruct-setup-hook): New - options. + (orgstruct-heading-prefix-regexp, orgstruct-setup-hook): + New options. (orgstruct-initialized): New variable. (org-get-local-variables): Honour state property. (org-run-like-in-org-mode): Use `let' instead of `progv'. Do not override variables with non-default values. (org-forward-heading-same-level): Do not skip to headlines on another level. Handle negative prefix argument correctly. - (org-backward-heading-same-level): Use - `org-forward-heading-same-level'. + (org-backward-heading-same-level): + Use `org-forward-heading-same-level'. 2013-11-12 Craig Tanis <craig-tanis@utc.edu> (tiny change) @@ -3478,8 +3488,8 @@ * ox-html.el (org-html-doctype-alist): New variable holding an alist of (X)HTML doctypes - (org-html-xhtml-p, org-html-html5-p, org-html-close-tag): New - function. + (org-html-xhtml-p, org-html-html5-p, org-html-close-tag): + New function. (org-html-html5-fancy): New export option, determining whether or not to use HTML5-specific elements. (org-html-html5-elements): New variable, new HTML5 elements. @@ -3493,8 +3503,8 @@ (org-html-format-list-item, org-html-line-break, org-html-table) (org-html-verse-block): Changes to allow flavored export. - * ox-latex.el (org-latex--org-table, org-latex-table-row): Allow - use of the "tabu" and "longtabu" table environments. New table + * ox-latex.el (org-latex--org-table, org-latex-table-row): + Allow use of the "tabu" and "longtabu" table environments. New table attribute :spread handles the width specification syntax of "tabu" and "longtabu" table environments. @@ -3540,8 +3550,8 @@ * ob-sh.el (org-babel-sh-evaluate): * ob-shen.el (org-babel-execute:shen): * ob-sql.el (org-babel-execute:sql): - * ob-sqlite.el (org-babel-execute:sqlite): Use - `org-babel-result-cond'. + * ob-sqlite.el (org-babel-execute:sqlite): + Use `org-babel-result-cond'. * ob.el (org-babel-common-header-args-w-values): Add a new "none" header argument. @@ -3577,8 +3587,8 @@ :padnewlines to "yes". Either way lets just remove this which shouldn't have any functional effect. - * ob-haskell.el (org-babel-default-header-args:haskell): Set - :padlines to "no" by default. + * ob-haskell.el (org-babel-default-header-args:haskell): + Set :padlines to "no" by default. * ob-exp.el (org-babel-exp-non-block-elements): Ignore inline source block on #+ prefixed lines. @@ -3595,8 +3605,8 @@ * ob-sh.el (org-babel-sh-var-to-string): Fix bug in ob-sh when dealing with list variables. - * ob-core.el (org-babel-demarcate-block): Include - `org-src-lang-modes' in block demarcation options. + * ob-core.el (org-babel-demarcate-block): + Include `org-src-lang-modes' in block demarcation options. * ob-C.el: Don't modify `org-babel-load-languages' from ob-* files. @@ -3665,7 +3675,7 @@ * ob-gnuplot.el (org-babel-header-args:gnuplot): Term is a gnuplot header argument. - * ob-tangle.el (org-babel-tangle): Fixed bug in tangle-file. + * ob-tangle.el (org-babel-tangle): Fix bug in tangle-file. Collect tangle modes, and only apply them to the file after all tangling has completed, including the post-tangle-hook. @@ -3675,8 +3685,8 @@ * ob-core.el (org-babel-current-src-block-location): (org-babel-execute-src-block): * ob-exp.el (org-babel-exp-results): - * ob-lob.el (org-babel-lob-execute): Rename - `org-babel-current-exec-src-block-head' to + * ob-lob.el (org-babel-lob-execute): + Rename `org-babel-current-exec-src-block-head' to `org-babel-current-src-block-location'. * ob-core.el (org-babel-common-header-args-w-values): Adding the @@ -3700,8 +3710,8 @@ `org-babel-current-exec-src-block-head' variable when executing inline or lob style code. - * ob-core.el (org-babel-execute-src-block): The - `org-babel-current-exec-src-block-head' variable should point to + * ob-core.el (org-babel-execute-src-block): + The `org-babel-current-exec-src-block-head' variable should point to the outermost code block. * org.el (org-some): An org-mode version of the cl some function. @@ -3712,8 +3722,8 @@ * org.el (org-every): An Org-mode version of the cl every function. - * ob-tangle.el (org-babel-tangle-jump-to-org): Use - `org-src-switch-to-buffer' to jump from src to org. Use the + * ob-tangle.el (org-babel-tangle-jump-to-org): + Use `org-src-switch-to-buffer' to jump from src to org. Use the existing `org-edit-src' functionality to jump back to the correct point in the code block in the original Org-mode buffer. @@ -3758,14 +3768,14 @@ * ob-js.el (org-babel-execute:js): Use `org-babel-result-cond' in JavaScript code blocks. - * ob-scheme.el (org-babel-execute:scheme): Use - `org-babel-result-cond' in scheme code blocks. + * ob-scheme.el (org-babel-execute:scheme): + Use `org-babel-result-cond' in scheme code blocks. - * ob-ocaml.el (org-babel-execute:ocaml): Use - `org-babel-result-cond' in OCaml code blocks. + * ob-ocaml.el (org-babel-execute:ocaml): + Use `org-babel-result-cond' in OCaml code blocks. - * ob-haskell.el (org-babel-execute:haskell): Use - `org-babel-result-cond' in Haskell code blocks. + * ob-haskell.el (org-babel-execute:haskell): + Use `org-babel-result-cond' in Haskell code blocks. * ob-core.el (org-babel-result-cond): The "raw", "org" and "drawer" :results header argument values preclude table processing @@ -3791,7 +3801,7 @@ (org-babel-insert-result): Cycle tables for :results org and :results wrap. - * ob-python.el (org-babel-python-initiate-session-by-key): Fixed a + * ob-python.el (org-babel-python-initiate-session-by-key): Fix a bug pointed out by Gary Oberbrunner. (org-babel-python-initiate-session-by-key): Add "-i" to the python command on windows sessions. Actually setting new session names. @@ -3818,7 +3828,7 @@ (org-babel-confirm-evaluate): Fix whitespaces. (org-babel-execute-src-block): A cond makes it more clear that we definitely do not execute without user confirmation. - (org-babel-call-process-region-original): Fixed line over 80 chars + (org-babel-call-process-region-original): Fix line over 80 chars long. * ob-tangle.el (org-babel-tangle-collect-blocks): Update comment @@ -3863,8 +3873,8 @@ * ox-html.el (org-html-latex-environment) (org-html-latex-fragment): Fix imagemagick support. - * org.el (org-create-formula-image-with-imagemagick): Generate - correct size formula image. + * org.el (org-create-formula-image-with-imagemagick): + Generate correct size formula image. (org-format-latex-header): Change pagestyle command position. * ox-latex.el (org-latex--caption/label-string): Allow to build a @@ -3895,8 +3905,8 @@ * org.el (org-reftex-citation): Fix contrib package name in the docstring. - (org-preview-latex-fragment, org-display-inline-images): Detect - whether a graphic display is available before inlining images to + (org-preview-latex-fragment, org-display-inline-images): + Detect whether a graphic display is available before inlining images to prevent an error. (org-startup-with-latex-preview): New option. (org-startup-options): New startup keywords for the new option. @@ -3904,8 +3914,8 @@ (org-reverse-string): Add `org-reverse-string' to reverse a string. - * org-id.el (org-id-new, org-id-decode): Replace - `org-id-reverse-string' by `org-reverse-string'. + * org-id.el (org-id-new, org-id-decode): + Replace `org-id-reverse-string' by `org-reverse-string'. * ob-core.el (org-babel-trim): Replace `org-babel-reverse-string' by `org-reverse-string' and declare it. @@ -4112,13 +4122,13 @@ * ox-md.el: Remove comments at the beginning of the file since the library is documented in Org manual. - * org-element.el (org-element--list-struct): Use - `org-match-string-no-properties'. Fix block parsing in lists. + * org-element.el (org-element--list-struct): + Use `org-match-string-no-properties'. Fix block parsing in lists. * ox-publish.el (org-publish-all): Fix compilation problem. - * org-element.el (org-element-timestamp-interpreter): Correctly - interpret timestamps with delays. + * org-element.el (org-element-timestamp-interpreter): + Correctly interpret timestamps with delays. (org-element-timestamp-parser) (org-element-timestamp-interpreter): Parse warning delays. @@ -4147,19 +4157,19 @@ Fix infloop when called on a blank line at the end of the buffer after a headline. - * org.el (org-forward-paragraph, org-backward-paragraph): New - functions. + * org.el (org-forward-paragraph, org-backward-paragraph): + New functions. * org.el (org-meta-return): Allow M-RET to insert items within drawers. Rewrite function. - * org-element.el (org-element-footnote-definition-parser): Fix - value for :contents-begin when first line of footnote definition + * org-element.el (org-element-footnote-definition-parser): + Fix value for :contents-begin when first line of footnote definition is empty besides the label. (org-element-at-point): Return correct element when point is on a blank line just below a headline. - (org-element-paragraph-parser): Use - `org-match-string-no-properties'. Small fixes to paragraph + (org-element-paragraph-parser): + Use `org-match-string-no-properties'. Small fixes to paragraph parsing. * org.el (org-adaptive-fill-function): Do not handle @@ -4204,8 +4214,8 @@ * ox-publish.el (project-plist): Remove variable. - * ox.el (org-export-to-buffer, org-export-to-file): Fix - docstrings. + * ox.el (org-export-to-buffer, org-export-to-file): + Fix docstrings. * ox-org.el (org-export-as-org): Add missing BODY-ONLY argument, which is always nil in this back-end. @@ -4285,8 +4295,8 @@ (org-export--dispatch-action): Maintain compatibility with Emacs 23. - * org.el (org-adaptive-fill-function, org-fill-paragraph): Add - support for `adaptive-fill-regexp' in paragraphs and comments. + * org.el (org-adaptive-fill-function, org-fill-paragraph): + Add support for `adaptive-fill-regexp' in paragraphs and comments. (org-indent-line): Fix indentation after a list. * ox.el (org-export--get-inbuffer-options): Multiple options can @@ -4314,8 +4324,8 @@ * ox-latex.el (org-latex-template): Fix missing newlines in header. - * ox.el (org-export-insert-default-template): Fix - "wrong-type-argument" error in template insertion. + * ox.el (org-export-insert-default-template): + Fix "wrong-type-argument" error in template insertion. * org.el (org-fill-paragraph): Use empty commented lines as separators when filling comments. This mimics default behavior @@ -4337,8 +4347,8 @@ * ox-latex.el (org-latex-listings): Update docstring. - * org-pcomplete.el (pcomplete/org-mode/file-option/options): Apply - changes to export back-end definiton. + * org-pcomplete.el (pcomplete/org-mode/file-option/options): + Apply changes to export back-end definiton. * org.el (org-get-export-keywords): Apply changes to export back-end definiton. @@ -4352,12 +4362,12 @@ (org-odt-format-headline--wrap): Use `org-export-with-backend' instead of `org-export-with-translations'. - * ox.el (org-export--registered-backends): Renamed from + * ox.el (org-export--registered-backends): Rename from `org-export-registered-backends'. - (org-export-invisible-backends): Removed variable. + (org-export-invisible-backends): Remove variable. (org-export-get-backend, org-export-get-all-transcoders - org-export-get-all-options, org-export-get-all-filters): New - functions. It replaces `org-export-backend-translate-table'. + org-export-get-all-options, org-export-get-all-filters): + New functions. It replaces `org-export-backend-translate-table'. (org-export-barf-if-invalid-backend, org-export-derived-backend-p, org-export-define-backend, org-export-define-derived-backend): Rewrite functions using new representation. @@ -4367,8 +4377,8 @@ org-export--get-inbuffer-options, org-export--get-global-options, org-export-to-buffer org-export-to-file, org-export-string-as org-export-replace-region-by): Update docstring. - (org-export-data-with-translations): Remove function. Use - `org-export-data-with-backend' with a temporary back-end instead. + (org-export-data-with-translations): Remove function. + Use `org-export-data-with-backend' with a temporary back-end instead. (org-export-data-with-backend, org-export-as): Reflect new definition for back-ends. (org-export--dispatch-action, org-export--dispatch-ui): Reflect new @@ -4409,8 +4419,8 @@ * ox-html.el (org-html-link): Small refactoring. - * org-element.el (org-element--current-element): Fix - org-meta-return error at the end of buffer. + * org-element.el (org-element--current-element): + Fix org-meta-return error at the end of buffer. * ox-odt.el (org-odt-category-map-alist): Fix internationalization of "Table" and "Listing". @@ -4491,8 +4501,8 @@ (org-latex-long-listings): Remove variable. * org-element.el (org-element--list-struct): New function. - (org-element-plain-list-parser, org-element--current-element): Use - new function. + (org-element-plain-list-parser, org-element--current-element): + Use new function. * ox-man.el (org-man-compile): * ox-texinfo.el (org-texinfo-compile): Use appropriate argument. @@ -4508,8 +4518,8 @@ * ox-md.el (md): Delegate underscore transcoding to HTML back-end. - * org-element.el (org-element--remove-indentation): Small - optimization. + * org-element.el (org-element--remove-indentation): + Small optimization. (org-element--remove-indentation): New function. (org-element-example-block-parser, org-element-src-block-parser): Use new function. @@ -4598,8 +4608,8 @@ `org-list-allow-alphabetical' when changed after org.el has been loaded. - * org-element.el (org-element-fixed-width-interpreter): Fix - interpretation of fixed-width elements with a nil or empty string + * org-element.el (org-element-fixed-width-interpreter): + Fix interpretation of fixed-width elements with a nil or empty string value. * ox-html.el (org-html-link): Don't skip the link description when @@ -4613,8 +4623,8 @@ * ox-icalendar.el (icalendar): Ignore footnotes. (org-icalendar--combine-files): Small refactoring. - * ox.el (org-export--skip-p, org-export--interpret-p): When - `org-export-with-footnotes' is nil, ignore completely footnotes + * ox.el (org-export--skip-p, org-export--interpret-p): + When `org-export-with-footnotes' is nil, ignore completely footnotes references and definitions instead of exporting them verbatim. * ox-beamer.el (org-beamer--frame-level): Small refactoring. @@ -4676,11 +4686,11 @@ * ox-html.el (html): Rename :html-table-tag property into :org-table-attributes. (org-html-table-default-attributes): New variable. - (org-html-table-tag): Removed variable. + (org-html-table-tag): Remove variable. (org-html--make-attribute-string): New function. (org-html-link--inline-image, org-html-table): Use new function. - (org-html-splice-attributes, org-export-splice-style): Remove - functions. + (org-html-splice-attributes, org-export-splice-style): + Remove functions. (org-html-inline-image-rules): Remove out of context part of the docstring. @@ -4729,8 +4739,8 @@ (org-export-with-sub-superscripts, org-export-with-toc) (org-export-with-tables, org-export-with-tags) (org-export-with-tasks, org-export-time-stamp-file) - (org-export-with-timestamps, org-export-with-todo-keywords): Fix - docstrings. + (org-export-with-timestamps, org-export-with-todo-keywords): + Fix docstrings. * ox-html.el (org-html-postamble-format): Slightly change default value so "Generated by" string doesn't get duplicated. @@ -4751,8 +4761,8 @@ (org-export--dispatch-ui, org-export--dispatch-action): Access to the function through the dispatcher. - * ox-icalendar.el (org-icalendar-convert-timestamp): Update - docstring. + * ox-icalendar.el (org-icalendar-convert-timestamp): + Update docstring. (org-icalendar-dtstamp): New function. (org-icalendar--vevent, org-icalendar--vtodo): Use new function. @@ -4797,7 +4807,7 @@ (org-macro-initialize-templates): Apply signature change from function above. - * ox.el (org-export--list-bound-variables): Renamed from + * ox.el (org-export--list-bound-variables): Rename from `org-export--install-letbind-maybe'. Though, only return list of bound variables instead of installing them as buffer-local variables. @@ -4858,8 +4868,8 @@ * ox-man.el (org-man-table--org-table): Use new attribute syntax. Small refactoring. - * ox-odt.el (org-odt-link--inline-image, org-odt-table-cell): Use - new attribute syntax. + * ox-odt.el (org-odt-link--inline-image, org-odt-table-cell): + Use new attribute syntax. * ox.el (org-export-async-start): Remove code evaluation queries from asynchronous export. @@ -4894,8 +4904,8 @@ * ox-latex.el (org-latex-inline-image-rules) (org-latex-default-table-environment) (org-latex-default-table-mode, org-latex-tables-booktabs) - (org-latex-table-scientific-notation, org-latex-known-errors): Add - :version and :package-version. + (org-latex-table-scientific-notation, org-latex-known-errors): + Add :version and :package-version. * ox-md.el (org-md-headline-style): Add :version and :package-version. @@ -4906,8 +4916,8 @@ * ox.el (org-export-with-drawers, org-export-with-latex) (org-export-with-inlinetasks, org-export-with-planning) (org-export-with-smart-quotes, org-export-with-statistics-cookies) - (org-export-allow-bind-keywords, org-export-async-init-file): Add - :version and :package-version. + (org-export-allow-bind-keywords, org-export-async-init-file): + Add :version and :package-version. * ox-icalendar.el (org-icalendar-export-to-ics): Change back-end name from `e-ascii' to `ascii'. @@ -4936,13 +4946,13 @@ * org.el (org-fill-paragraph): Small refactoring to `org-fill-paragraph'. Do not look for table cells in a paragraph. - * org-element.el (org-element-object-restrictions): Simplify - restrictions within secondary strings and objects. + * org-element.el (org-element-object-restrictions): + Simplify restrictions within secondary strings and objects. * org-list.el (org-list-send-list): Do not rely on `org-list-parse-list'. - (org-list-to-latex, org-list-to-html, org-list-to-texinfo): Use - appropriate export back-end instead of using + (org-list-to-latex, org-list-to-html, org-list-to-texinfo): + Use appropriate export back-end instead of using `org-list-to-generic'. * ox-html.el (org-html-inner-template): Remove contents div and @@ -4984,9 +4994,9 @@ (org-icalendar-export-current-agenda): Integrate previous functions. - * ox-latex.el (org-latex-format-headline-default-function): Use - declarative shape to nest makup for TODO keywords. Previous - syntax generated errors during export. + * ox-latex.el (org-latex-format-headline-default-function): + Use declarative shape to nest makup for TODO keywords. + Previous syntax generated errors during export. * ox.el (org-export-async-start): Ignore `org-mode-hook' and `kill-emacs-hook'. The first one has been run in the original @@ -5000,14 +5010,14 @@ computing minimal headline level. * org.el (org-do-latex-and-related): Fix infloop when user - provides a wrong value for `org-highlight-latex-and-related'. In - this case, `org-latex-and-related-regexp' is the empty string and + provides a wrong value for `org-highlight-latex-and-related'. + In this case, `org-latex-and-related-regexp' is the empty string and generates an infloop since matching it doesn't move point. - * org-element.el (org-element-headline-parser): Rename - :optional-title into :alt-title. + * org-element.el (org-element-headline-parser): + Rename :optional-title into :alt-title. - * ox.el (org-export-get-alt-title): Renamed from + * ox.el (org-export-get-alt-title): Rename from `org-export-get-optional-title'. * ox-ascii.el (org-ascii--build-title): @@ -5027,8 +5037,8 @@ * ox-latex.el (org-latex-compile): Add an optional argument for latex snippet previewing. - * org.el (org-create-formula-image-with-imagemagick): Use - `org-latex-compile' instead of rewriting it. + * org.el (org-create-formula-image-with-imagemagick): + Use `org-latex-compile' instead of rewriting it. * ox-html.el (org-html-fontify-code): Do not use [^\000] in regexps that may match large strings. @@ -5047,8 +5057,8 @@ (org-element-plain-link-successor): New function. * org.el (org-match-substring-regexp) - (org-match-substring-with-braces-regexp): Update regexp. A - sub/superscript cannot start anymore at the beginning of the line + (org-match-substring-with-braces-regexp): Update regexp. + A sub/superscript cannot start anymore at the beginning of the line or after a space. * org-element.el (org-element--get-next-object-candidates): @@ -5076,13 +5086,13 @@ * ox-html.el (org-html--format-toc-headline): Fix function name. (org-html-toc, org-html--toc-text): Change to docstring. - (org-html-list-of-listings, org-html-list-of-tables): New - functions. + (org-html-list-of-listings, org-html-list-of-tables): + New functions. (org-html-keyword): Use new functions. (org-html-src-block): Add an ID attribute when a name is given. - * org-element.el (org-element-footnote-definition-parser): Require - 2 blank lines to separate footnote definition. + * org-element.el (org-element-footnote-definition-parser): + Require 2 blank lines to separate footnote definition. * org-footnote.el (org-footnote-at-definition-p): Require 2 blank lines to separate footnote definition. @@ -5091,8 +5101,8 @@ (org-export-stack-refresh): Refactor. (org-export-stack-remove, org-export-stack-view): Apply renaming. (org-export-stack-mode-map): Use tabulated list map as a basis. - (org-export-stack--generate, org-export-stack--num-predicate): New - function. + (org-export-stack--generate, org-export-stack--num-predicate): + New function. (org-export-get-optional-title): Return regular title when no optional title is found. @@ -5105,17 +5115,17 @@ * ox-latex.el (org-latex-headline): Apply change to `org-export-get-optional-title'. - * ox-ascii.el (org-ascii--build-title): Add an argument. Use - optional title when building a toc line. + * ox-ascii.el (org-ascii--build-title): Add an argument. + Use optional title when building a toc line. (org-ascii--build-toc): Call `org-ascii--build-title' with appropriate arguments. * ox-latex.el (org-latex-headline): Use optional title for table of contents. - * ox-html.el (org-html--toc-text): Renamed from + * ox-html.el (org-html--toc-text): Rename from `org-html-toc-text'. Add docstring. - (org-html--format-toc-headline): Renamed from + (org-html--format-toc-headline): Rename from `org-html-format-toc-headline'. Add docstring. Use optional title if possible. (org-html-toc): Add docstring. @@ -5126,18 +5136,18 @@ * ox.el (org-export-get-optional-title): New function. - * ox-latex.el (org-latex-format-headline-default-function): Make - the variable a function. + * ox-latex.el (org-latex-format-headline-default-function): + Make the variable a function. - * ox-publish.el (org-publish-resolve-external-fuzzy-link): No - error when resolving external fuzzy links outside publishing. + * ox-publish.el (org-publish-resolve-external-fuzzy-link): + No error when resolving external fuzzy links outside publishing. Though search option for these links will not be resolved. * ox-latex.el (org-latex-guess-inputenc): Set inputenc option according to `org-export-coding-system'. - * ox.el (org-export--generate-copy-script): Clone - `buffer-file-coding-system' when creating a buffer copy. + * ox.el (org-export--generate-copy-script): + Clone `buffer-file-coding-system' when creating a buffer copy. * ox-html.el (org-html-link): Resolve external links with search options like [[file.org::#custom-id]] or @@ -5158,8 +5168,8 @@ * ox-latex.el (org-latex-property-drawer): Remove function. - * ox-ascii.el (org-ascii-filter-paragraph-spacing): Remove - reference to now renamed `e-ascii' back-end. + * ox-ascii.el (org-ascii-filter-paragraph-spacing): + Remove reference to now renamed `e-ascii' back-end. * ox-beamer.el (org-beamer-template): Allow to span documentclass options accross multiple lines in template. @@ -5231,13 +5241,13 @@ * org-element.el (org-element-map): Allow to map over any list. Do not restrict mapping to object types. - * org-faces.el (org-latex-and-related): Renamed from + * org-faces.el (org-latex-and-related): Rename from `org-latex-and-export-specials', which wasn't appropriate anymore. * org.el (org-highlight-latex-and-related) (org-latex-and-related-regexp): New variables. - (org-compute-latex-and-related-regexp, org-do-latex-and-related): New - function, revived from a previous commit. + (org-compute-latex-and-related-regexp, org-do-latex-and-related): + New function, revived from a previous commit. (org-set-regexps-and-options, org-set-font-lock-defaults): Use new functions. (org-set-regexps-and-options): Remove reference to LATEX_CLASS and @@ -5277,9 +5287,9 @@ * org-element.el (org-element-link-parser): Do not remove newlines characters in paths anymore, since this is not required. - * ox.el (org-export--dispatch-ui): Renamed from + * ox.el (org-export--dispatch-ui): Rename from `org-export-dispatch-ui'. Handle scrolling. - (org-export--dispatch-action): Renamed from + (org-export--dispatch-action): Rename from `org-export-dispatch-action'. Implement scrolling. (org-export-dispatch): Apply renaming. @@ -5302,16 +5312,16 @@ * ox.el (org-export-stack-mode): Fix docstring. - * org-pcomplete.el (pcomplete/org-mode/file-option): Allow - completion for ATTR_ prefixed keywords. + * org-pcomplete.el (pcomplete/org-mode/file-option): + Allow completion for ATTR_ prefixed keywords. * org.el (org-options-keywords): Add missing colons. - * org-macs.el (org-default-options): Removed function. + * org-macs.el (org-default-options): Remove function. * org-pcomplete.el (org-command-at-point): Fix bug with some file options. - (pcomplete/org-mode/file-option/x): Removed macro. + (pcomplete/org-mode/file-option/x): Remove macro. (pcomplete/org-mode/file-option): Refactor code. (pcomplete/org-mode/file-option/author) (pcomplete/org-mode/file-option/date) @@ -5334,8 +5344,8 @@ * ox-ascii.el (org-ascii-inner-template): New function. (org-ascii-template): Use new function. - (org-ascii-export-as-ascii, org-ascii-export-to-ascii): Update - docstring. + (org-ascii-export-as-ascii, org-ascii-export-to-ascii): + Update docstring. * org-element.el (org-element-link-parser): Take into consideration links filled and indented. @@ -5369,7 +5379,7 @@ * org-element.el (org-element-nested-p): Do not inline function. * ox.el (org-export-copy-buffer, org-export-with-buffer-copy) - (org-export--generate-copy-script): Moved earlier in the file. + (org-export--generate-copy-script): Move earlier in the file. * ox-texinfo.el (org-texinfo-link): Do not transform path part of internal links. @@ -5417,10 +5427,10 @@ required in the external process. * org.el (org-format-latex-header-extra, org-export-have-math): - Removed variables. - (org-latex-default-packages-alist): Renamed from + Remove variables. + (org-latex-default-packages-alist): Rename from `org-export-latex-default-packages-alist'. - (org-latex-packages-alist): Renamed from + (org-latex-packages-alist): Rename from `org-export-latex-packages-alist'. (org-try-cdlatex-tab, org-cdlatex-underscore-caret, org-cdlatex-math-modify): Reorder in file. @@ -5431,10 +5441,10 @@ * org-entities.el (org-entities-user): Update docstring. - * ox-latex.el (org-latex-classes, org-latex-listings): Update - docstring. - (org-latex-guess-inputenc): Renamed from `org-latex--guess-inputenc'. - (org-latex-guess-babel-language): Renamed from + * ox-latex.el (org-latex-classes, org-latex-listings): + Update docstring. + (org-latex-guess-inputenc): Rename from `org-latex--guess-inputenc'. + (org-latex-guess-babel-language): Rename from `org-latex--guess-babel-language'. (org-latex-template): Apply renaming. @@ -5446,8 +5456,8 @@ copying it. * org-macs.el (org-if-unprotected, org-if-unprotected-1) - (org-if-unprotected-at): Removed macros. - (org-re-search-forward-unprotected): Removed function. + (org-if-unprotected-at): Remove macros. + (org-re-search-forward-unprotected): Remove function. * org.el (org-format-latex): * org-list.el (org-list-struct): @@ -5455,7 +5465,7 @@ * org-capture.el (org-capture-fill-template): Remove reference to `org-protected'. - * ob-exp.el (org-babel-exp-process-buffer): Renamed from + * ob-exp.el (org-babel-exp-process-buffer): Rename from `org-export-blocks-preprocess'. * ox.el (org-export-execute-babel-code): Apply previous renaming. @@ -5465,11 +5475,11 @@ framework. (pcomplete/org-mode/file-option/options): Rewrite using new export framework. Only complete up to the colon. - (pcomplete/org-mode/file-option/x): Removed macro. + (pcomplete/org-mode/file-option/x): Remove macro. (pcomplete/org-mode/file-option/title) (pcomplete/org-mode/file-option/author) (pcomplete/org-mode/file-option/email) - (pcomplete/org-mode/file-option/date): Removed functions. + (pcomplete/org-mode/file-option/date): Remove functions. (pcomplete/org-mode/file-option/infojs_opt): New function. * org-clock.el (org-clocktable-defaults) @@ -5481,8 +5491,8 @@ function. * org-inlinetask.el (org-inlinetask-export) - (org-inlinetask-export-templates): Removed variables. - (org-inlinetask-export-handler): Removed function. + (org-inlinetask-export-templates): Remove variables. + (org-inlinetask-export-handler): Remove function. * org-plot.el: Remove dependency on `org-exp' library. @@ -5513,8 +5523,8 @@ * org-agenda.el (org-agenda-menu, org-agenda-write): Use new iCalendar export back-end. - * org-table.el (org-table-export, orgtbl-export): Remove - dependency on `org-exp' library. + * org-table.el (org-table-export, orgtbl-export): + Remove dependency on `org-exp' library. (org-table-clean-before-export): New function. (org-table-colgroup-info): New variable. (orgtbl-to-html): Use to new HTML export back-end. @@ -5568,19 +5578,19 @@ Elements. * org-element.el (org-element-at-point): When point is before any - element, in the first blank lines of the buffer, return nil. When - point is within blank lines just after a headline, return that + element, in the first blank lines of the buffer, return nil. + When point is within blank lines just after a headline, return that headline. (org-element-context): Return nil when point is within the blank at the beginning of the buffer. * org.el (org-edit-special): Fix regression. (org-timestamp-has-time-p, org-timestamp-format) - (org-timestamp-split-range, org-timestamp-translate): New - functions. + (org-timestamp-split-range, org-timestamp-translate): + New functions. - * org-element.el (org-element-timestamp-interpreter): Interpret - timestamps ranges with repeaters. + * org-element.el (org-element-timestamp-interpreter): + Interpret timestamps ranges with repeaters. * org.el (org-edit-special): Rewrite `org-edit-special' using Org Elements tools. Behavior should be unchanged. @@ -5607,12 +5617,12 @@ * org.el (org-all-targets): Fix radio targets detection when object is directly followed by a non-whitespace character. - * ob.el (org-babel-use-quick-and-dirty-noweb-expansion): Renamed - from `org-babel-use-quick-and-dirty-noweb-expansion'. + * ob.el (org-babel-use-quick-and-dirty-noweb-expansion): + Rename from `org-babel-use-quick-and-dirty-noweb-expansion'. (org-babel-expand-noweb-references): Use new variable name. - * org-element.el (org-element-timestamp-interpreter): Fix - timestamp interpreter when raw value isn't available. + * org-element.el (org-element-timestamp-interpreter): + Fix timestamp interpreter when raw value isn't available. * ob-exp.el (org-babel-exp-non-block-elements): Make sure to parse inline babel call or inline src block instead of the following @@ -5678,8 +5688,8 @@ (org-element-horizontal-rule-parser, org-element-keyword-parser) (org-element-latex-environment-parser) (org-element-paragraph-parser, org-element-src-block-parser) - (org-element-table-parser, org-element-verse-block-parser): Add - `:post-affiliated' property to elements. + (org-element-table-parser, org-element-verse-block-parser): + Add `:post-affiliated' property to elements. (org-element-inlinetask-parser): Remove affilated keywords. * org.el (org-adaptive-fill-function): Use new property. @@ -5701,8 +5711,8 @@ (org-element--current-element): Tiny refactoring. * ob.el (org-babel-where-is-src-block-result): Insert new results - keyword in current narrowed part of buffer, if necessary. Small - refactoring. + keyword in current narrowed part of buffer, if necessary. + Small refactoring. (org-babel-insert-result): Do not widen buffer when new results have to be inserted. Therefore, results inserted after the last block of a narrowed buffer still belong to the narrowed part of the buffer. @@ -5716,8 +5726,8 @@ (org-element-diary-sexp-parser) (org-element-diary-sexp-interpreter): New functions. (org-element-horizontal-rule-parser) - (org-element-keyword-parser, org-element--current-element): Small - refactoring. + (org-element-keyword-parser, org-element--current-element): + Small refactoring. (org-element-property): Access to text properties when argument is a string. (org-element-put-property): Correctly set property when target is @@ -5740,8 +5750,8 @@ * org.el (org-all-targets): Make sure the regexp really matched a radio target. - (org-macro-expand, org-macro-replace-all): Change signature. The - function now accepts an alist of templates so it doesn't have to + (org-macro-expand, org-macro-replace-all): Change signature. + The function now accepts an alist of templates so it doesn't have to rely only on `org-macro-templates'. (org-macro-initialize-templates): {{{date}}} is not anymore an alias for {{{time}}}. During export, it will provide the value @@ -5806,15 +5816,15 @@ * org-exp-blocks.el: Delete. * ob-exp.el (org-export-blocks-preprocess): - * ob-ditaa.el (org-ditaa-jar-path): Moved from + * ob-ditaa.el (org-ditaa-jar-path): Move from "org-export-blocks.el". * ob-exp.el (org-babel-exp-src-block): Remove unused argument. (org-babel-exp-non-block-elements): Rewrite function using Org Element. - * org-exp-blocks.el (org-export-blocks-preprocess): Rewrite - function using Org Element. + * org-exp-blocks.el (org-export-blocks-preprocess): + Rewrite function using Org Element. * org-element.el (org-element-recursive-objects) (org-element-object-restrictions): Remove `macro' from recursive @@ -5883,8 +5893,8 @@ same style. Make all anchors font-size %100. Remove margin from the content section. (org-html-container-element): Fix docstring. - (org-html-postamble-format, org-html-preamble-format): Update - docstrings. + (org-html-postamble-format, org-html-preamble-format): + Update docstrings. (org-html-template): Use `org-html--build-pre/postamble'. (org-html--build-pre/postamble): New function, combining the pre/postamble generator. Merge lists of formatters from the @@ -5900,9 +5910,9 @@ (org-html-divs): Change to alist of three entries each containing a key ('preamble, 'content, 'postamble), an HTML element type and an id to allow setting container elements. - (org-html--build-preamble, org-html--build-postamble): Modified to + (org-html--build-preamble, org-html--build-postamble): Modify to use `org-html-divs'. - (org-html-template): Modified to use doctype and container-element + (org-html-template): Modify to use doctype and container-element settings. (org-export-define-backend): Add css url option. (org-export-htmlized-org-css-url): Modify docstring and options. @@ -5922,8 +5932,8 @@ * ob-tangle.el (org-babel-tangle-collect-blocks): Change argument name collid `org-babel-map-src-blocks' variable 'lang'. - * org-protocol.el (org-protocol-convert-query-to-plist): New - function. + * org-protocol.el (org-protocol-convert-query-to-plist): + New function. (org-protocol-do-capture): Use new function. (org-protocol-data-separator): Change default separator. @@ -6039,12 +6049,12 @@ 2013-11-12 Vitalie Spinu <spinuvit@gmail.com> - * ob-tangle.el (org-babel-find-file-noselect-refresh): Call - `find-file-noselect' with 'nowarn argument to surpress + * ob-tangle.el (org-babel-find-file-noselect-refresh): + Call `find-file-noselect' with 'nowarn argument to surpress `yes-or-no-p' reversion message. - * ob-core.el (org-babel-where-is-src-block-head): Return - `point-marker' instead of `point'. + * ob-core.el (org-babel-where-is-src-block-head): + Return `point-marker' instead of `point'. 2013-11-12 Yann Hodique <yann.hodique@gmail.com> @@ -6080,8 +6090,8 @@ if result is not a string and not nil. If the result is nil, treat it as if it was the empty string. - * org-clock.el (org-clock-notify-once-if-expired): Honor - `org-clock-sound'. + * org-clock.el (org-clock-notify-once-if-expired): + Honor `org-clock-sound'. 2013-11-12 Rasmus Pank <rasmus.pank@gmail.com> @@ -6103,23 +6113,23 @@ * ob-C.el: Added C++ to `org-babel-load-languages' automatically after loading C. - * org-src.el (org-src-lang-modes): Added association between + * org-src.el (org-src-lang-modes): Add association between language C++ and `c++-mode'. - * ox.el (org-export-smart-quotes-alist): Added ("da" "no" "nb" + * ox.el (org-export-smart-quotes-alist): Add ("da" "no" "nb" "nn" "sv"). - (org-export-dictionary): Added some entries ("da" "no" "nb" "nn" + (org-export-dictionary): Add some entries ("da" "no" "nb" "nn" "sv"). (org-export-default-language): Mention other variables affected by language. - * ox-latex.el (org-latex-babel-language-alist): Added 'nb', 'nn', + * ox-latex.el (org-latex-babel-language-alist): Add 'nb', 'nn', and 'no' for Norwegian. Removed 'no-no'. (org-latex-pdf-process): let `latexmk' be a preconfigured choice and change the wording of the docstring. (org-latex-guess-babel-language): Replace AUTO with language if AUTO is the option of the LaTeX package Babel. - (org-latex-classes): Updated documentation with respect + (org-latex-classes): Update documentation with respect to `org-latex-guess-babel-language'. 2013-11-12 Дядов Васил Стоянов <vdyadov@elvees.com> (tiny change) @@ -9696,7 +9706,7 @@ * org-clock.el (org-clock-idle-time): Org-mode assumed that x11idle was an available command, and returned an idle time of 0 if it was not - (never idle): Added checks so that org-idle-time will come from + (never idle): Add checks so that org-idle-time will come from emacs' own current-idle-time if x11idle cannot be found or if it cannot retrieve the idle time from X11 @@ -18715,8 +18725,8 @@ 2011-07-28 Bastien Guerry <bzg@gnu.org> - * org-agenda.el (org-agenda-repeating-timestamp-show-all): Allow - to use a list of TODO keywords as the value of this variable. + * org-agenda.el (org-agenda-repeating-timestamp-show-all): + Allow to use a list of TODO keywords as the value of this variable. The agenda will show repeating stamps for entries matching these TODO keywords. (org-agenda-get-timestamps, org-agenda-get-deadlines) diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index f2a37484cc0..e345bf37b6d 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -1927,7 +1927,7 @@ fontified, and then returned." (org-mode) (org-create-dblock props) (org-update-dblock) - (font-lock-fontify-buffer) + (org-font-lock-ensure) (forward-line 2) (buffer-substring (point) (progn (re-search-forward "^[ \t]*#\\+END" nil t) diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index 70c41d53cd9..e5d6a49f318 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -489,6 +489,11 @@ LIMIT." (looking-at (concat "\\(?:" regexp "\\)\\'"))))) (not (null pos))))) +(defalias 'org-font-lock-ensure + (if (fboundp 'org-font-lock-ensure) + #'font-lock-ensure + (lambda (_beg _end) (font-lock-fontify-buffer)))) + (defun org-floor* (x &optional y) "Return a list of the floor of X and the fractional part of X. With two arguments, return floor and remainder of their quotient." diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el index f870b2c714d..d5e70076df0 100644 --- a/lisp/org/org-src.el +++ b/lisp/org/org-src.el @@ -923,7 +923,7 @@ fontification of code blocks see `org-src-fontify-block' and (delete-region (point-min) (point-max)) (insert string " ") ;; so there's a final property change (unless (eq major-mode lang-mode) (funcall lang-mode)) - (font-lock-fontify-buffer) + (org-font-lock-ensure) (setq pos (point-min)) (while (setq next (next-single-property-change pos 'face)) (put-text-property diff --git a/lisp/org/org.el b/lisp/org/org.el index 2a451ed5456..fed3854007f 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -6355,7 +6355,7 @@ needs to be inserted at a specific position in the font-lock sequence.") (insert s) (let ((org-odd-levels-only odd-levels)) (org-mode) - (font-lock-fontify-buffer) + (org-font-lock-ensure) (buffer-string)))) (defvar org-m nil) diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el index 88e572084c8..1fd1da7bbbb 100644 --- a/lisp/org/ox-html.el +++ b/lisp/org/ox-html.el @@ -1856,7 +1856,7 @@ is the language used for CODE, as a string, or nil." (funcall lang-mode) (insert code) ;; Fontify buffer. - (font-lock-fontify-buffer) + (org-font-lock-ensure) ;; Remove formatting on newline characters. (save-excursion (let ((beg (point-min)) diff --git a/lisp/org/ox-odt.el b/lisp/org/ox-odt.el index 772017cdd0c..49be3bcb015 100644 --- a/lisp/org/ox-odt.el +++ b/lisp/org/ox-odt.el @@ -3127,7 +3127,7 @@ and prefix with \"OrgSrc\". For example, (with-temp-buffer (insert code) (funcall lang-mode) - (font-lock-fontify-buffer) + (org-font-lock-ensure) (buffer-string)))) (fontifier (if use-htmlfontify-p 'org-odt-htmlfontify-string 'org-odt--encode-plain-text)) diff --git a/lisp/org/ox-org.el b/lisp/org/ox-org.el index 3b2e55e2d45..d9a8001dcfc 100644 --- a/lisp/org/ox-org.el +++ b/lisp/org/ox-org.el @@ -223,12 +223,13 @@ Return output file name." (html-ext (concat "." (or (plist-get plist :html-extension) org-html-extension "html"))) (visitingp (find-buffer-visiting filename)) - (work-buffer (or visitingp (find-file filename))) + (work-buffer (or visitingp (find-file-noselect filename))) newbuf) - (font-lock-fontify-buffer) - (show-all) - (org-show-block-all) - (setq newbuf (htmlize-buffer)) + (with-current-buffer work-buffer + (org-font-lock-ensure) + (show-all) + (org-show-block-all) + (setq newbuf (htmlize-buffer))) (with-current-buffer newbuf (when org-org-htmlized-css-url (goto-char (point-min)) @@ -237,10 +238,12 @@ Return output file name." (replace-match (format "<link rel=\"stylesheet\" type=\"text/css\" href=\"%s\">" - org-org-htmlized-css-url) t t))) + org-org-htmlized-css-url) + t t))) (write-file (concat pub-dir (file-name-nondirectory filename) html-ext))) (kill-buffer newbuf) (unless visitingp (kill-buffer work-buffer))) + ;; FIXME: Why? Which buffer is this supposed to apply to? (set-buffer-modified-p nil))) diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el index e7f5725a0f0..cae151f0b33 100644 --- a/lisp/play/bubbles.el +++ b/lisp/play/bubbles.el @@ -1005,20 +1005,17 @@ Set `bubbles--col-offset' and `bubbles--row-offset'." (set-buffer-modified-p nil) (erase-buffer) (insert " ") - (add-text-properties - (point-min) (point) (list 'intangible t 'display - (cons 'space - (list :height bubbles--row-offset)))) + (put-text-property (point-min) (point) + 'display + (cons 'space (list :height bubbles--row-offset))) (insert "\n") (let ((max-char (length (bubbles--colors)))) (dotimes (i (bubbles--grid-height)) (let ((p (point))) (insert " ") - (add-text-properties - p (point) (list 'intangible t - 'display (cons 'space - (list :width - bubbles--col-offset))))) + (put-text-property p (point) + 'display + (cons 'space (list :width bubbles--col-offset)))) (dotimes (j (bubbles--grid-width)) (let* ((index (random max-char)) (char (nth index bubbles-chars))) @@ -1026,10 +1023,9 @@ Set `bubbles--col-offset' and `bubbles--row-offset'." (add-text-properties (1- (point)) (point) (list 'index index)))) (insert "\n")) (insert "\n ") - (add-text-properties - (1- (point)) (point) (list 'intangible t 'display - (cons 'space - (list :width bubbles--col-offset))))) + (put-text-property (1- (point)) (point) + 'display + (cons 'space (list :width bubbles--col-offset)))) (put-text-property (point-min) (point-max) 'pointer 'arrow)) (bubbles-mode) (bubbles--reset-score) @@ -1179,10 +1175,9 @@ Use optional parameter POS instead of point if given." (delete-region (point) (point-max)) (insert (format "Selected: %4d\n" bubbles--neighborhood-score)) (insert " ") - (add-text-properties (1- (point)) (point) - (list 'intangible t 'display - (cons 'space - (list :width bubbles--col-offset)))) + (put-text-property (1- (point)) (point) + 'display + (cons 'space (list :width bubbles--col-offset))) (insert (format "Score: %4d" bubbles--score)) (put-text-property pos (point) 'status t)))) @@ -1200,10 +1195,9 @@ Use optional parameter POS instead of point if given." (goto-char (point-max)) (let* ((inhibit-read-only t)) (insert "\n ") - (add-text-properties (1- (point)) (point) - (list 'intangible t 'display - (cons 'space - (list :width bubbles--col-offset)))) + (put-text-property (1- (point)) (point) + 'display + (cons 'space (list :width bubbles--col-offset))) (insert "Game Over!")) ;; save score (gamegrid-add-score (format "bubbles-%s-%d-%d-%d-scores" diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el index 0028b7258ae..3f4b8e8c5b8 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el @@ -100,7 +100,8 @@ (defun dun-describe-room (room) (if (and (not (member (abs room) dun-light-rooms)) - (not (member obj-lamp dun-inventory))) + (not (member obj-lamp dun-inventory)) + (not (member obj-lamp (nth dun-current-room dun-room-objects)))) (dun-mprincl "It is pitch dark. You are likely to be eaten by a grue.") (dun-mprincl (cadr (nth (abs room) dun-rooms))) (if (and (and (or (member room dun-visited) @@ -615,7 +616,8 @@ just try dropping it.") (defun dun-move (dir) (if (and (not (member dun-current-room dun-light-rooms)) - (not (member obj-lamp dun-inventory))) + (not (member obj-lamp dun-inventory)) + (not (member obj-lamp (nth dun-current-room dun-room-objects)))) (progn (dun-mprinc "You trip over a grue and fall into a pit and break every bone in your @@ -896,7 +898,7 @@ to swim.") (defun dun-help (args) (dun-mprincl -"Welcome to dunnet (2.01), by Ron Schnell (ronnie@driver-aces.com). +"Welcome to dunnet (2.02), by Ron Schnell (ronnie@driver-aces.com - @RonnieSchnell). Here is some useful information (read carefully because there are one or more clues in here): - If you have a key that can open a door, you do not need to explicitly @@ -1385,8 +1387,8 @@ for a moment, then straighten yourself up. (setq dungeon-mode 'dungeon) (setq dun-unix-verbs '((ls . dun-ls) (ftp . dun-ftp) (echo . dun-echo) (exit . dun-uexit) (cd . dun-cd) (pwd . dun-pwd) - (rlogin . dun-rlogin) (uncompress . dun-uncompress) - (cat . dun-cat))) + (rlogin . dun-rlogin) (ssh . dun-rlogin) + (uncompress . dun-uncompress) (cat . dun-cat))) (setq dun-dos-verbs '((dir . dun-dos-dir) (type . dun-dos-type) (exit . dun-dos-exit) (command . dun-dos-spawn) @@ -2537,25 +2539,31 @@ treasures for points?" "4" "four") (dun-mprincl "Incorrect."))) (let (varname epoint afterq i value) - (setq varname (substring line 0 esign)) - (if (not (setq epoint (string-match ")" line))) - (if (string= (substring line (1+ esign) (+ esign 2)) - "\"") - (progn - (setq afterq (substring line (+ esign 2))) - (setq epoint (+ - (string-match "\"" afterq) - (+ esign 3)))) - - (if (not (setq epoint (string-match " " line))) - (setq epoint (length line)))) - (setq epoint (1+ epoint)) - (while (and - (not (= epoint (length line))) - (setq i (string-match ")" (substring line epoint)))) - (setq epoint (+ epoint i 1)))) - (setq value (substring line (1+ esign) epoint)) - (dun-eval varname value)))) + (setq varname (replace-regexp-in-string " " "" (substring line 0 esign))) + + (if (or (= (length varname) 0) (< (- (length line) esign) 2)) + (progn + (dun-mprinc line) + (dun-mprincl " : not found.")) + + (if (not (setq epoint (string-match ")" line))) + (if (string= (substring line (1+ esign) (+ esign 2)) + "\"") + (progn + (setq afterq (substring line (+ esign 2))) + (setq epoint (+ + (string-match "\"" afterq) + (+ esign 3)))) + + (if (not (setq epoint (string-match " " line))) + (setq epoint (length line)))) + (setq epoint (1+ epoint)) + (while (and + (not (= epoint (length line))) + (setq i (string-match ")" (substring line epoint)))) + (setq epoint (+ epoint i 1)))) + (setq value (substring line (1+ esign) epoint)) + (dun-eval varname value))))) (defun dun-eval (varname value) (let (eval-error) @@ -2739,16 +2747,20 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..") (if dun-batch-mode (dun-mprincl "Login failed.") (dun-mprincl "\nLogin failed.")) - (if dun-batch-mode - (dun-mprincl - "Guest login okay, user access restrictions apply.") - (dun-mprincl - "\nGuest login okay, user access restrictions apply.")) - (dun-ftp-commands) - (setq newlist + (if (= (length ident) 0) + (if dun-batch-mode + (dun-mprincl "Password is required.") + (dun-mprincl "\nPassword is required.")) + (if dun-batch-mode + (dun-mprincl + "Guest login okay, user access restrictions apply.") + (dun-mprincl + "\nGuest login okay, user access restrictions apply.")) + (dun-ftp-commands) + (setq newlist '("What password did you use during anonymous ftp to gamma?")) - (setq newlist (append newlist (list ident))) - (rplaca (nthcdr 1 dun-endgame-questions) newlist))))))))) + (setq newlist (append newlist (list ident))) + (rplaca (nthcdr 1 dun-endgame-questions) newlist)))))))))) (defun dun-ftp-commands () (setq dun-exitf nil) diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el index a2a93730cf0..b71eb562f08 100644 --- a/lisp/play/gametree.el +++ b/lisp/play/gametree.el @@ -590,31 +590,30 @@ shogi, etc.) players, it is a slightly modified version of Outline mode. (add-hook 'write-contents-hooks 'gametree-save-and-hack-layout)) ;;;; Goodies for mousing users -(and (fboundp 'track-mouse) - (defun gametree-mouse-break-line-here (event) - (interactive "e") - (mouse-set-point event) - (gametree-break-line-here)) - (defun gametree-mouse-show-children-and-entry (event) - (interactive "e") - (mouse-set-point event) - (gametree-show-children-and-entry)) - (defun gametree-mouse-show-subtree (event) - (interactive "e") - (mouse-set-point event) - (show-subtree)) - (defun gametree-mouse-hide-subtree (event) - (interactive "e") - (mouse-set-point event) - (hide-subtree)) - (define-key gametree-mode-map [M-down-mouse-2 M-mouse-2] - 'gametree-mouse-break-line-here) - (define-key gametree-mode-map [S-down-mouse-1 S-mouse-1] - 'gametree-mouse-show-children-and-entry) - (define-key gametree-mode-map [S-down-mouse-2 S-mouse-2] - 'gametree-mouse-show-subtree) - (define-key gametree-mode-map [S-down-mouse-3 S-mouse-3] - 'gametree-mouse-hide-subtree)) +(defun gametree-mouse-break-line-here (event) + (interactive "e") + (mouse-set-point event) + (gametree-break-line-here)) +(defun gametree-mouse-show-children-and-entry (event) + (interactive "e") + (mouse-set-point event) + (gametree-show-children-and-entry)) +(defun gametree-mouse-show-subtree (event) + (interactive "e") + (mouse-set-point event) + (show-subtree)) +(defun gametree-mouse-hide-subtree (event) + (interactive "e") + (mouse-set-point event) + (hide-subtree)) +(define-key gametree-mode-map [M-down-mouse-2 M-mouse-2] + 'gametree-mouse-break-line-here) +(define-key gametree-mode-map [S-down-mouse-1 S-mouse-1] + 'gametree-mouse-show-children-and-entry) +(define-key gametree-mode-map [S-down-mouse-2 S-mouse-2] + 'gametree-mouse-show-subtree) +(define-key gametree-mode-map [S-down-mouse-3 S-mouse-3] + 'gametree-mouse-hide-subtree) (provide 'gametree) diff --git a/lisp/printing.el b/lisp/printing.el index 5b6173ceb35..39da132d64e 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -1038,20 +1038,27 @@ Please send all bug fixes and enhancements to ;; To avoid compilation gripes -(or (fboundp 'subst-char-in-string) ; hacked from subr.el - (defun subst-char-in-string (fromchar tochar string &optional inplace) - "Replace FROMCHAR with TOCHAR in STRING each time it occurs. +;; Emacs has this since at least 21.1. +(when (featurep 'xemacs) + (or (fboundp 'subst-char-in-string) ; hacked from subr.el + (defun subst-char-in-string (fromchar tochar string &optional inplace) + "Replace FROMCHAR with TOCHAR in STRING each time it occurs. Unless optional argument INPLACE is non-nil, return a new string." - (let ((i (length string)) - (newstr (if inplace string (copy-sequence string)))) - (while (> (setq i (1- i)) 0) - (if (eq (aref newstr i) fromchar) - (aset newstr i tochar))) - newstr))) - - -(or (fboundp 'make-temp-file) ; hacked from subr.el - (defun make-temp-file (prefix &optional dir-flag suffix) + (let ((i (length string)) + (newstr (if inplace string (copy-sequence string)))) + (while (> (setq i (1- i)) 0) + (if (eq (aref newstr i) fromchar) + (aset newstr i tochar))) + newstr)))) + + +;; Emacs has this since at least 21.1, but the SUFFIX argument +;; (which this file uses) only since 22.1. So the fboundp test +;; wasn't even correct/adequate. Whatever, no-one is using +;; this file on older Emacs version, so it's irrelevant. +(when (featurep 'xemacs) + (or (fboundp 'make-temp-file) ; hacked from subr.el + (defun make-temp-file (prefix &optional dir-flag suffix) "Create a temporary file. The returned file name (created by appending some random characters at the end of PREFIX, and expanding against `temporary-file-directory' if necessary), @@ -1086,7 +1093,7 @@ If SUFFIX is non-nil, add that at the end of the file name." nil) file) ;; Reset the umask. - (set-default-file-modes umask))))) + (set-default-file-modes umask)))))) (eval-when-compile @@ -3164,12 +3171,9 @@ See `pr-ps-printer-alist'.") (defmacro pr-save-file-modes (&rest body) - "Set temporally file modes to `pr-file-modes'." - `(let ((pr--default-file-modes (default-file-modes))) ; save default - (set-default-file-modes pr-file-modes) - ,@body - (set-default-file-modes pr--default-file-modes))) ; restore default - + "Execute BODY with file permissions temporarily set to `pr-file-modes'." + (declare (obsolete with-file-modes "24.5")) + `(with-file-modes pr-file-modes ,@body)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Keys & Menus @@ -3192,9 +3196,10 @@ See `pr-ps-printer-alist'.") (defalias 'pr-get-symbol - (if (fboundp 'easy-menu-intern) ; hacked from easymenu.el - 'easy-menu-intern - (lambda (s) (if (stringp s) (intern s) s)))) + (if (featurep 'emacs) 'easy-menu-intern ; since 22.1 + (if (fboundp 'easy-menu-intern) ; hacked from easymenu.el + 'easy-menu-intern + (lambda (s) (if (stringp s) (intern s) s))))) (defconst pr-menu-spec @@ -4364,12 +4369,12 @@ Noninteractively, the argument FILENAME is treated as follows: if it is nil, send the image to the printer. If FILENAME is a string, save the PostScript image in a file with that name." (interactive (list (ps-print-preprint current-prefix-arg))) - (pr-save-file-modes - (let ((ps-lpr-command (pr-command pr-ps-command)) - (ps-lpr-switches pr-ps-switches) - (ps-printer-name-option pr-ps-printer-switch) - (ps-printer-name pr-ps-printer)) - (ps-despool filename)))) + (with-file-modes pr-file-modes + (let ((ps-lpr-command (pr-command pr-ps-command)) + (ps-lpr-switches pr-ps-switches) + (ps-printer-name-option pr-ps-printer-switch) + (ps-printer-name pr-ps-printer)) + (ps-despool filename)))) ;;;###autoload @@ -5632,12 +5637,12 @@ If menu binding was not done, calls `pr-menu-bind'." (goto-char (point-max)) (insert (format "%s %S\n" cmd args))) ;; *Printing Command Output* == show any return message from command - (pr-save-file-modes - (setq status - (condition-case data - (apply 'call-process cmd nil buffer nil args) - ((quit error) - (error-message-string data))))) + (with-file-modes pr-file-modes + (setq status + (condition-case data + (apply 'call-process cmd nil buffer nil args) + ((quit error) + (error-message-string data))))) ;; *Printing Command Output* == show exit status (with-current-buffer buffer (goto-char (point-max)) @@ -5882,42 +5887,42 @@ If menu binding was not done, calls `pr-menu-bind'." (defun pr-text2ps (kind n-up filename &optional from to) - (pr-save-file-modes - (let ((ps-n-up-printing n-up) - (ps-spool-config (and (eq ps-spool-config 'setpagedevice) - 'setpagedevice))) - (pr-delete-file-if-exists filename) - (cond (pr-faces-p - (cond (pr-spool-p - ;; pr-faces-p and pr-spool-p - ;; here FILENAME arg is ignored - (cond ((eq kind 'buffer) - (ps-spool-buffer-with-faces)) - ((eq kind 'region) - (ps-spool-region-with-faces (or from (point)) - (or to (mark)))) - )) - ;; pr-faces-p and not pr-spool-p - ((eq kind 'buffer) - (ps-print-buffer-with-faces filename)) - ((eq kind 'region) - (ps-print-region-with-faces (or from (point)) - (or to (mark)) filename)) - )) - (pr-spool-p - ;; not pr-faces-p and pr-spool-p - ;; here FILENAME arg is ignored - (cond ((eq kind 'buffer) - (ps-spool-buffer)) - ((eq kind 'region) - (ps-spool-region (or from (point)) (or to (mark)))) - )) - ;; not pr-faces-p and not pr-spool-p - ((eq kind 'buffer) - (ps-print-buffer filename)) - ((eq kind 'region) - (ps-print-region (or from (point)) (or to (mark)) filename)) - )))) + (with-file-modes pr-file-modes + (let ((ps-n-up-printing n-up) + (ps-spool-config (and (eq ps-spool-config 'setpagedevice) + 'setpagedevice))) + (pr-delete-file-if-exists filename) + (cond (pr-faces-p + (cond (pr-spool-p + ;; pr-faces-p and pr-spool-p + ;; here FILENAME arg is ignored + (cond ((eq kind 'buffer) + (ps-spool-buffer-with-faces)) + ((eq kind 'region) + (ps-spool-region-with-faces (or from (point)) + (or to (mark)))) + )) + ;; pr-faces-p and not pr-spool-p + ((eq kind 'buffer) + (ps-print-buffer-with-faces filename)) + ((eq kind 'region) + (ps-print-region-with-faces (or from (point)) + (or to (mark)) filename)) + )) + (pr-spool-p + ;; not pr-faces-p and pr-spool-p + ;; here FILENAME arg is ignored + (cond ((eq kind 'buffer) + (ps-spool-buffer)) + ((eq kind 'region) + (ps-spool-region (or from (point)) (or to (mark)))) + )) + ;; not pr-faces-p and not pr-spool-p + ((eq kind 'buffer) + (ps-print-buffer filename)) + ((eq kind 'region) + (ps-print-region (or from (point)) (or to (mark)) filename)) + )))) (defun pr-command (command) @@ -6543,8 +6548,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (defun pr-i-directory () - (or (and (file-directory-p pr-i-directory) - (file-readable-p pr-i-directory)) + (or (file-accessible-directory-p pr-i-directory) (error "Please specify be a readable directory"))) @@ -6552,8 +6556,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (and pr-buffer-verbose (message "You can use M-TAB or ESC TAB for file completion")) (let ((dir (widget-value widget))) - (and (file-directory-p dir) - (file-readable-p dir) + (and (file-accessible-directory-p dir) (setq pr-i-directory dir)))) diff --git a/lisp/progmodes/cap-words.el b/lisp/progmodes/cap-words.el deleted file mode 100644 index b03daf4cd5a..00000000000 --- a/lisp/progmodes/cap-words.el +++ /dev/null @@ -1,98 +0,0 @@ -;;; cap-words.el --- minor mode for motion in CapitalizedWordIdentifiers - -;; Copyright (C) 2002-2014 Free Software Foundation, Inc. - -;; Author: Dave Love <fx@gnu.org> -;; Keywords: languages - -;; 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: - -;; Provides Capitalized Words minor mode for word movement in -;; identifiers CapitalizedLikeThis. - -;; Note that the same effect could be obtained by frobbing the -;; category of upper case characters to produce word boundaries, but -;; the necessary processing isn't done for ASCII characters. - -;; Fixme: This doesn't work properly for mouse double clicks. - -;;; Code: - -(defun capitalized-find-word-boundary (pos limit) - "Function for use in `find-word-boundary-function-table'. -Looks for word boundaries before capitals." - (save-excursion - (goto-char pos) - (let (case-fold-search) - (if (<= pos limit) - ;; Fixme: Are these regexps the best? - (or (and (re-search-forward "\\=.\\w*[[:upper:]]" - limit t) - (progn (backward-char) - t)) - (re-search-forward "\\>" limit t)) - (or (re-search-backward "[[:upper:]]\\w*\\=" limit t) - (re-search-backward "\\<" limit t)))) - (point))) - - -(defconst capitalized-find-word-boundary-function-table - (let ((tab (make-char-table nil))) - (set-char-table-range tab t #'capitalized-find-word-boundary) - tab) - "Assigned to `find-word-boundary-function-table' in Capitalized Words mode.") - -;;;###autoload -(define-minor-mode capitalized-words-mode - "Toggle Capitalized Words mode. -With a prefix argument ARG, enable Capitalized Words mode if ARG -is positive, and disable it otherwise. If called from Lisp, -enable the mode if ARG is omitted or nil. - -Capitalized Words mode is a buffer-local minor mode. When -enabled, a word boundary occurs immediately before an uppercase -letter in a symbol. This is in addition to all the normal -boundaries given by the syntax and category tables. There is no -restriction to ASCII. - -E.g. the beginning of words in the following identifier are as marked: - - capitalizedWorDD - ^ ^ ^^ - -Note that these word boundaries only apply for word motion and -marking commands such as \\[forward-word]. This mode does not affect word -boundaries found by regexp matching (`\\>', `\\w' &c). - -This style of identifiers is common in environments like Java ones, -where underscores aren't trendy enough. Capitalization rules are -sometimes part of the language, e.g. Haskell, which may thus encourage -such a style. It is appropriate to add `capitalized-words-mode' to -the mode hook for programming language modes in which you encounter -variables like this, e.g. `java-mode-hook'. It's unlikely to cause -trouble if such identifiers aren't used. - -See also `glasses-mode' and `studlify-word'. -Obsoletes `c-forward-into-nomenclature'." - nil " Caps" nil :group 'programming - (set (make-local-variable 'find-word-boundary-function-table) - capitalized-find-word-boundary-function-table)) - -(provide 'cap-words) - -;;; cap-words.el ends here diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index f86e4b2c48a..6b406b0d89c 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -2219,7 +2219,8 @@ comment at the start of cc-engine.el for more info." ((and (not not-in-delimiter) ; inside a comment starter (not (bobp)) (progn (backward-char) - (and (not (looking-at "\\s!")) + (and (not (and (memq 'category-properties c-emacs-features) + (looking-at "\\s!"))) (looking-at c-comment-start-regexp)))) (setq ty (if (looking-at c-block-comment-start-regexp) 'c 'c++) co-st (point)) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 30f30dfe83f..000d7191ee7 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -134,7 +134,7 @@ and a string describing how the process finished.") ;; emacs -batch -l compile-tests.el -f ert-run-tests-batch-and-exit (defvar compilation-error-regexp-alist-alist - '((absoft + `((absoft "^\\(?:[Ee]rror on \\|[Ww]arning on\\( \\)\\)?[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) @@ -255,16 +255,46 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) ;; 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 -, 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]+\\)\\(?:-\\(?4:[0-9]+\\)\\(?:\\.\\(?5:[0-9]+\\)\\)?\ -\\|[.:]\\(?3:[0-9]+\\)\\(?:-\\(?:\\(?4:[0-9]+\\)\\.\\)?\\(?5:[0-9]+\\)\\)?\\)?:\ -\\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\ - *\\([Ii]nfo\\(?:\\>\\|rmationa?l?\\)\\|I:\\|\\[ skipping .+ \\]\\|\ -\\(?:instantiated\\|required\\) from\\|[Nn]ote\\)\\|\ - *[Ee]rror\\|[0-9]?\\(?:[^0-9\n]\\|$\\)\\|[0-9][0-9][0-9]\\)" + ,(rx + bol + (? (| (regexp "[[:alpha:]][-[:alnum:].]+: ?") + (regexp "[ \t]+\\(?:in \\|from\\)"))) + (group-n 1 (: (regexp "[0-9]*[^0-9\n]") + (*? (| (regexp "[^\n :]") + (regexp " [^-/\n]") + (regexp ":[^ \n]"))))) + (regexp ": ?") + (group-n 2 (regexp "[0-9]+")) + (? (| (: "-" + (group-n 4 (regexp "[0-9]+")) + (? "." (group-n 5 (regexp "[0-9]+")))) + (: (in ".:") + (group-n 3 (regexp "[0-9]+")) + (? "-" + (? (group-n 4 (regexp "[0-9]+")) ".") + (group-n 5 (regexp "[0-9]+")))))) + ":" + (| (: (* " ") + (group-n 6 (| "FutureWarning" + "RuntimeWarning" + "Warning" + "warning" + "W:"))) + (: (* " ") + (group-n 7 (| (regexp "[Ii]nfo\\(?:\\>\\|rmationa?l?\\)") + "I:" + (: "[ skipping " (+ ".") " ]") + "instantiated from" + "required from" + (regexp "[Nn]ote")))) + (: (* " ") + (regexp "[Ee]rror")) + (: (regexp "[0-9]?") + (| (regexp "[^0-9\n]") + eol)) + (regexp "[0-9][0-9][0-9]"))) 1 (2 . 4) (3 . 5) (6 . 7)) (lcc @@ -2039,8 +2069,7 @@ Optional argument MINOR indicates this is called from (if minor (progn (font-lock-add-keywords nil (compilation-mode-font-lock-keywords)) - (if font-lock-mode - (font-lock-fontify-buffer))) + (font-lock-flush)) (setq font-lock-defaults '(compilation-mode-font-lock-keywords t)))) (defun compilation--unsetup () @@ -2049,8 +2078,7 @@ Optional argument MINOR indicates this is called from (remove-hook 'before-change-functions 'compilation--flush-parse t) (kill-local-variable 'compilation--parsed) (compilation--remove-properties) - (if font-lock-mode - (font-lock-fontify-buffer))) + (font-lock-flush)) ;;;###autoload (define-minor-mode compilation-shell-minor-mode diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el index 4e4fc138877..1aa5170591a 100644 --- a/lisp/progmodes/cwarn.el +++ b/lisp/progmodes/cwarn.el @@ -188,7 +188,7 @@ and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil." :group 'cwarn :lighter cwarn-mode-text (cwarn-font-lock-keywords cwarn-mode) - (if font-lock-mode (font-lock-fontify-buffer))) + (font-lock-flush)) ;;;###autoload (define-obsolete-function-alias 'turn-on-cwarn-mode 'cwarn-mode "24.1") diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index 6aee713dd86..6431fa4aaf2 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -830,7 +830,7 @@ Can be overridden by the value of `font-lock-maximum-decoration'.") (font-lock-mode 1) (setq font-lock-keywords (symbol-value (intern-soft (format "f90-font-lock-keywords-%d" n)))) - (font-lock-fontify-buffer)) + (font-lock-flush)) (defun f90-font-lock-1 () "Set `font-lock-keywords' to `f90-font-lock-keywords-1'." diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 99629450c1b..d60534074b9 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -1,7 +1,6 @@ -;;; grep.el --- run `grep' and display the results +;;; grep.el --- run `grep' and display the results -*- lexical-binding:t -*- -;; Copyright (C) 1985-1987, 1993-1999, 2001-2014 Free Software -;; Foundation, Inc. +;; Copyright (C) 1985-1987, 1993-1999, 2001-2014 Free Software Foundation, Inc. ;; Author: Roland McGrath <roland@gnu.org> ;; Maintainer: emacs-devel@gnu.org @@ -805,16 +804,20 @@ substitution string. Note dynamic scoping of variables.") (defun grep-expand-template (template &optional regexp files dir excl) "Patch grep COMMAND string replacing <C>, <D>, <F>, <R>, and <X>." - (let ((command template) - (cf case-fold-search) - (case-fold-search nil)) + (let* ((command template) + (env `((cf . ,case-fold-search) + (excl . ,excl) + (dir . ,dir) + (files . ,files) + (regexp . ,regexp))) + (case-fold-search nil)) (dolist (kw grep-expand-keywords command) (if (string-match (car kw) command) (setq command (replace-match (or (if (symbolp (cdr kw)) - (symbol-value (cdr kw)) - (save-match-data (eval (cdr kw)))) + (eval (cdr kw) env) + (save-match-data (eval (cdr kw) env))) "") t t command)))))) @@ -901,7 +904,7 @@ This command shares argument histories with \\[rgrep] and \\[grep]." (confirm (equal current-prefix-arg '(4)))) (list regexp files dir confirm)))))) (when (and (stringp regexp) (> (length regexp) 0)) - (unless (and dir (file-directory-p dir) (file-readable-p dir)) + (unless (and dir (file-accessible-directory-p dir)) (setq dir default-directory)) (let ((command regexp)) (if (null files) @@ -982,7 +985,7 @@ to specify a command to run." (confirm (equal current-prefix-arg '(4)))) (list regexp files dir confirm)))))) (when (and (stringp regexp) (> (length regexp) 0)) - (unless (and dir (file-directory-p dir) (file-readable-p dir)) + (unless (and dir (file-accessible-directory-p dir)) (setq dir default-directory)) (if (null files) (if (not (string= regexp (if (consp grep-find-command) @@ -1055,7 +1058,7 @@ to specify a command to run." (setq default-directory dir))))))) ;;;###autoload -(defun zrgrep (regexp &optional files dir confirm grep-find-template) +(defun zrgrep (regexp &optional files dir confirm template) "Recursively grep for REGEXP in gzipped FILES in tree rooted at DIR. Like `rgrep' but uses `zgrep' for `grep-program', sets the default file name to `*.gz', and sets `grep-highlight-matches' to `always'." @@ -1090,10 +1093,8 @@ file name to `*.gz', and sets `grep-highlight-matches' to `always'." (list regexp files dir confirm grep-find-template))))))) ;; Set `grep-highlight-matches' to `always' ;; since `zgrep' puts filters in the grep output. - (let ((grep-highlight-matches 'always)) - ;; `rgrep' uses the dynamically bound value `grep-find-template' - ;; from the argument `grep-find-template' whose value is computed - ;; in the `interactive' spec. + (let ((grep-find-template template) + (grep-highlight-matches 'always)) (rgrep regexp files dir confirm))) ;;;###autoload diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index 39ad676f593..ee144df4395 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -407,6 +407,18 @@ that form should be displayed.") (defconst hif-string-literal-regexp "\\(\"\\(?:[^\"\\]\\|\\\\.\\)*\"\\)") +(defun hif-string-to-number (string &optional base) + "Like `string-to-number', but it understands non-decimal floats." + (if (or (not base) (= base 10)) + (string-to-number string base) + (let* ((parts (split-string string "\\." t "[ \t]+")) + (frac (cadr parts)) + (quot (expt (* base 1.0) (length frac))) + (num (/ (string-to-number (concat (car parts) frac) base) + quot))) + (if (= num (truncate num)) + (truncate num) + num)))) (defun hif-tokenize (start end) "Separate string between START and END into a list of tokens." @@ -433,15 +445,12 @@ that form should be displayed.") ;; TODO: ;; 1. postfix 'l', 'll', 'ul' and 'ull' ;; 2. floating number formats - ;; 3. hexadecimal/octal floats - ;; 4. 098 is interpreted as octal conversion error - ;; FIXME: string-to-number does not convert hex floats + ;; 3. 098 is interpreted as octal conversion error (if (string-match "0x\\([0-9a-fA-F]+\\.?[0-9a-fA-F]*\\)" token) - (string-to-number (match-string 1 token) 16)) ;; hex - ;; FIXME: string-to-number does not convert octal floats + (hif-string-to-number (match-string 1 token) 16)) ;; hex (if (string-match "\\`0[0-9]+\\(\\.[0-9]+\\)?\\'" token) - (string-to-number token 8)) ;; octal + (hif-string-to-number token 8)) ;; octal (if (string-match "\\`[1-9][0-9]*\\(\\.[0-9]+\\)?\\'" token) (string-to-number token)) ;; decimal diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index e9349b655b0..45420f2a250 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -789,6 +789,7 @@ If `hs-hide-comments-when-hiding-all' is non-nil, also hide the comments." (unless hs-allow-nesting (hs-discard-overlays (point-min) (point-max))) (goto-char (point-min)) + (syntax-propertize (point-max)) (let ((spew (make-progress-reporter "Hiding all blocks..." (point-min) (point-max))) (re (concat "\\(" diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el index e8a950c1fae..b9c41c9d699 100644 --- a/lisp/progmodes/idlw-help.el +++ b/lisp/progmodes/idlw-help.el @@ -1177,15 +1177,13 @@ Useful when source code is displayed as help. See the option (if (featurep 'font-lock) (let ((major-mode 'idlwave-mode) (font-lock-verbose - (if (called-interactively-p 'interactive) font-lock-verbose nil)) - (syntax-table (syntax-table))) - (unwind-protect - (progn - (set-syntax-table idlwave-mode-syntax-table) - (set (make-local-variable 'font-lock-defaults) - idlwave-font-lock-defaults) - (font-lock-fontify-buffer)) - (set-syntax-table syntax-table))))) + (if (called-interactively-p 'interactive) font-lock-verbose nil))) + (with-syntax-table idlwave-mode-syntax-table + (set (make-local-variable 'font-lock-defaults) + idlwave-font-lock-defaults) + (if (fboundp 'font-lock-ensure) + (font-lock-ensure) + (font-lock-fontify-buffer)))))) (defun idlwave-help-error (name type class keyword) diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index ef372a34fdb..092aa2b2fac 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -66,22 +66,7 @@ ;; a rich language; writing a more suitable parser would be a big job): ;; 2) The globbing syntax <pattern> is not recognized, so special ;; characters in the pattern string must be backslashed. -;; 3) The << quoting operators are not recognized; see below. -;; 5) To make '$' work correctly, $' is not recognized as a variable. -;; Use "$'" or $POSTMATCH instead. ;; -;; If you don't use font-lock, additional problems will appear: -;; 1) Regular expression delimiters do not act as quotes, so special -;; characters such as `'"#:;[](){} may need to be backslashed -;; in regular expressions and in both parts of s/// and tr///. -;; 4) The q and qq quoting operators are not recognized; see below. -;; 5) To make variables such a $' and $#array work, perl-mode treats -;; $ just like backslash, so '$' is not treated correctly. -;; 6) Unfortunately, treating $ like \ makes ${var} be treated as an -;; unmatched }. See below. -;; 7) When ' (quote) is used as a package name separator, perl-mode -;; doesn't understand, and thinks it is seeing a quoted string. - ;; Here are some ugly tricks to bypass some of these problems: the perl ;; expression /`/ (that's a back-tick) usually evaluates harmlessly, ;; but will trick perl-mode into starting a quoted string, which @@ -218,6 +203,13 @@ (defvar perl-quote-like-pairs '((?\( . ?\)) (?\[ . ?\]) (?\{ . ?\}) (?\< . ?\>))) +(eval-and-compile + (defconst perl--syntax-exp-intro-regexp + (concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)" + (regexp-opt '("split" "if" "unless" "until" "while" "print" + "grep" "map" "not" "or" "and" "for" "foreach")) + "\\|[-?:.,;|&+*=!~({[]\\|\\(^\\)\\)[ \t\n]*"))) + ;; FIXME: handle here-docs and regexps. ;; <<EOF <<"EOF" <<'EOF' (no space) ;; see `man perlop' @@ -278,10 +270,7 @@ ;; *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" "for" "foreach")) - "\\|[-?:.,;|&+*=!~({[]\\|\\(^\\)\\)[ \t\n]*\\(/\\)") + ((concat perl--syntax-exp-intro-regexp "\\(/\\)") (2 (ignore (if (and (match-end 1) ; / at BOL. (save-excursion @@ -316,10 +305,15 @@ (string-to-syntax "\""))) (perl-syntax-propertize-special-constructs end))))) ;; Here documents. - ;; TODO: Handle <<WORD. These are trickier because you need to - ;; disambiguate with the shift operator. - ("<<[ \t]*\\('[^'\n]*'\\|\"[^\"\n]*\"\\|\\\\[[:alpha:]][[:alnum:]]*\\).*\\(\n\\)" - (2 (let* ((st (get-text-property (match-beginning 2) 'syntax-table)) + ((concat + "\\(?:" + ;; << "EOF", << 'EOF', or << \EOF + "<<[ \t]*\\('[^'\n]*'\\|\"[^\"\n]*\"\\|\\\\[[:alpha:]][[:alnum:]]*\\)" + ;; The <<EOF case which needs perl--syntax-exp-intro-regexp, to + ;; disambiguate with the left-bitshift operator. + "\\|" perl--syntax-exp-intro-regexp "<<\\(?1:\\sw+\\)\\)" + ".*\\(\n\\)") + (3 (let* ((st (get-text-property (match-beginning 3) 'syntax-table)) (name (match-string 1))) (goto-char (match-end 1)) (if (save-excursion (nth 8 (syntax-ppss (match-beginning 0)))) @@ -329,7 +323,8 @@ ;; Remember the names of heredocs found on this line. (cons (pcase (aref name 0) (`?\\ (substring name 1)) - (_ (substring name 1 -1))) + ((or `?\" `?\' `?\`) (substring name 1 -1)) + (_ name)) (cdr st))))))) ;; We don't call perl-syntax-propertize-special-constructs directly ;; from the << rule, because there might be other elements (between diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el index 407466932d9..d0745d59955 100644 --- a/lisp/progmodes/prog-mode.el +++ b/lisp/progmodes/prog-mode.el @@ -116,7 +116,7 @@ support it." (font-lock-add-keywords nil prettify-symbols--keywords) (setq-local font-lock-extra-managed-props (cons 'composition font-lock-extra-managed-props)) - (font-lock-fontify-buffer)) + (font-lock-flush)) ;; Turn off (when prettify-symbols--keywords (font-lock-remove-keywords nil prettify-symbols--keywords) diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index bcac59a3ade..a082d75b3c4 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -3340,8 +3340,6 @@ PREFIX is the prefix of the search regexp." ["Mark clause" prolog-mark-clause t] ["Mark predicate" prolog-mark-predicate t] ["Mark paragraph" mark-paragraph t] - ;;"---" - ;;["Fontify buffer" font-lock-fontify-buffer t] )) (defun prolog-menu () diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el index f7de331f73b..7cf53cbe45c 100644 --- a/lisp/progmodes/ps-mode.el +++ b/lisp/progmodes/ps-mode.el @@ -41,6 +41,7 @@ (require 'comint) (require 'easymenu) +(require 'smie) ;; Define core `PostScript' group. (defgroup PostScript nil @@ -60,10 +61,7 @@ ;; User variables. -(defcustom ps-mode-auto-indent t - "Should we use autoindent?" - :group 'PostScript-edit - :type 'boolean) +(make-obsolete-variable 'ps-mode-auto-indent 'electric-indent-mode "24.5") (defcustom ps-mode-tab 4 "Number of spaces to use when indenting." @@ -204,7 +202,7 @@ If nil, use `temporary-file-directory'." "bind" "null" "gsave" "grestore" "grestoreall" "showpage"))) - (concat "\\<" (regexp-opt ops t) "\\>")) + (concat "\\_<" (regexp-opt ops t) "\\_>")) "Regexp of PostScript operators that will be fontified.") ;; Level 1 font-lock: @@ -214,13 +212,9 @@ If nil, use `temporary-file-directory'." ;; - 8bit characters (warning face) ;; Multiline strings are not supported. Strings with nested brackets are. (defconst ps-mode-font-lock-keywords-1 - '(("\\`%!PS.*" . font-lock-constant-face) + '(("\\`%!PS.*" (0 font-lock-constant-face t)) ("^%%BoundingBox:[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]+-?[0-9]+[ \t]*$" - . font-lock-constant-face) - (ps-mode-match-string-or-comment - (1 font-lock-comment-face nil t) - (2 font-lock-string-face nil t)) - ("([^()\n%]*\\|[^()\n]*)" . font-lock-warning-face) + (0 font-lock-constant-face t)) ("[\200-\377]+" (0 font-lock-warning-face prepend nil))) "Subdued level highlighting for PostScript mode.") @@ -255,19 +249,17 @@ If nil, use `temporary-file-directory'." ;; Names are fontified before PostScript operators, allowing the use of ;; a more simple (efficient) regexp than the one used in level 2. (defconst ps-mode-font-lock-keywords-3 - (append - ps-mode-font-lock-keywords-1 - (list - '("//\\w+" . font-lock-type-face) - `(,(concat - "^\\(/\\w+\\)\\>" - "\\([[ \t]*\\(%.*\\)?\r?$" ; Nothing but `[' or comment after the name. - "\\|[ \t]*\\({\\|<<\\)" ; `{' or `<<' following the name. - "\\|[ \t]+[0-9]+[ \t]+dict\\>" ; `[0-9]+ dict' following the name. - "\\|.*\\<def\\>\\)") ; `def' somewhere on the same line. - . (1 font-lock-function-name-face)) - '("/\\w+" . font-lock-variable-name-face) - (cons ps-mode-operators 'font-lock-keyword-face))) + `(,@ps-mode-font-lock-keywords-1 + ("//\\(?:\\sw\\|\\s_\\)+" . font-lock-type-face) + (,(concat + "^\\(/\\(?:\\sw\\|\\s_\\)+\\)\\_>" + "\\([[ \t]*\\(%.*\\)?\r?$" ; Nothing but `[' or comment after the name. + "\\|[ \t]*\\({\\|<<\\)" ; `{' or `<<' following the name. + "\\|[ \t]+[0-9]+[ \t]+dict\\_>" ; `[0-9]+ dict' following the name. + "\\|.*\\_<def\\_>\\)") ; `def' somewhere on the same line. + . (1 font-lock-function-name-face)) + ("/\\(?:\\sw\\|\\s_\\)+" . font-lock-variable-name-face) + (,ps-mode-operators . font-lock-keyword-face)) "High level highlighting for PostScript mode.") (defconst ps-mode-font-lock-keywords ps-mode-font-lock-keywords-1 @@ -289,13 +281,68 @@ If nil, use `temporary-file-directory'." ;; Variables. -(defvar ps-mode-map nil +(defvar ps-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c\C-v" 'ps-run-boundingbox) + (define-key map "\C-c\C-u" 'ps-mode-uncomment-region) + (define-key map "\C-c\C-t" 'ps-mode-epsf-rich) + (define-key map "\C-c\C-s" 'ps-run-start) + (define-key map "\C-c\C-r" 'ps-run-region) + (define-key map "\C-c\C-q" 'ps-run-quit) + (define-key map "\C-c\C-p" 'ps-mode-print-buffer) + (define-key map "\C-c\C-o" 'ps-mode-comment-out-region) + (define-key map "\C-c\C-k" 'ps-run-kill) + (define-key map "\C-c\C-j" 'ps-mode-other-newline) + (define-key map "\C-c\C-l" 'ps-run-clear) + (define-key map "\C-c\C-b" 'ps-run-buffer) + ;; FIXME: Add `indent' to backward-delete-char-untabify-method instead? + (define-key map "\177" 'ps-mode-backward-delete-char) + map) "Local keymap to use in PostScript mode.") -(defvar ps-mode-syntax-table nil +(defvar ps-mode-syntax-table + (let ((st (make-syntax-table))) + + (modify-syntax-entry ?\% "< " st) + (modify-syntax-entry ?\n "> " st) + (modify-syntax-entry ?\r "> " st) + (modify-syntax-entry ?\f "> " st) + (modify-syntax-entry ?\< "(>" st) + (modify-syntax-entry ?\> ")<" st) + + (modify-syntax-entry ?\! "_ " st) + (modify-syntax-entry ?\" "_ " st) + (modify-syntax-entry ?\# "_ " st) + (modify-syntax-entry ?\$ "_ " st) + (modify-syntax-entry ?\& "_ " st) + (modify-syntax-entry ?\' "_ " st) + (modify-syntax-entry ?\* "_ " st) + (modify-syntax-entry ?\+ "_ " st) + (modify-syntax-entry ?\, "_ " st) + (modify-syntax-entry ?\- "_ " st) + (modify-syntax-entry ?\. "_ " st) + (modify-syntax-entry ?\: "_ " st) + (modify-syntax-entry ?\; "_ " st) + (modify-syntax-entry ?\= "_ " st) + (modify-syntax-entry ?\? "_ " st) + (modify-syntax-entry ?\@ "_ " st) + (modify-syntax-entry ?\\ "\\" st) + (modify-syntax-entry ?^ "_ " st) ; NOT: ?\^ + (modify-syntax-entry ?\_ "_ " st) + (modify-syntax-entry ?\` "_ " st) + (modify-syntax-entry ?\| "_ " st) + (modify-syntax-entry ?\~ "_ " st) + st) "Syntax table used while in PostScript mode.") -(defvar ps-run-mode-map nil +(defvar ps-run-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map comint-mode-map) + (define-key map "\C-c\C-q" 'ps-run-quit) + (define-key map "\C-c\C-k" 'ps-run-kill) + (define-key map "\C-c\C-e" 'ps-run-goto-error) + (define-key map [mouse-2] 'ps-run-mouse-goto-error) + map) "Local keymap to use in PostScript run mode.") (defvar ps-mode-tmp-file nil @@ -365,9 +412,6 @@ If nil, use `temporary-file-directory'." ["8-bit to Octal Buffer" ps-mode-octal-buffer t] ["8-bit to Octal Region" ps-mode-octal-region (mark t)] "---" - ["Auto Indent" (setq ps-mode-auto-indent (not ps-mode-auto-indent)) - :style toggle :selected ps-mode-auto-indent] - "---" ["Start PostScript" ps-run-start t] @@ -404,79 +448,7 @@ If nil, use `temporary-file-directory'." ps-mode-submit-bug-report t])) - -;; Mode maps for PostScript edit mode and PostScript interaction mode. - -(unless ps-mode-map - (setq ps-mode-map (make-sparse-keymap)) - (define-key ps-mode-map "\C-c\C-v" 'ps-run-boundingbox) - (define-key ps-mode-map "\C-c\C-u" 'ps-mode-uncomment-region) - (define-key ps-mode-map "\C-c\C-t" 'ps-mode-epsf-rich) - (define-key ps-mode-map "\C-c\C-s" 'ps-run-start) - (define-key ps-mode-map "\C-c\C-r" 'ps-run-region) - (define-key ps-mode-map "\C-c\C-q" 'ps-run-quit) - (define-key ps-mode-map "\C-c\C-p" 'ps-mode-print-buffer) - (define-key ps-mode-map "\C-c\C-o" 'ps-mode-comment-out-region) - (define-key ps-mode-map "\C-c\C-k" 'ps-run-kill) - (define-key ps-mode-map "\C-c\C-j" 'ps-mode-other-newline) - (define-key ps-mode-map "\C-c\C-l" 'ps-run-clear) - (define-key ps-mode-map "\C-c\C-b" 'ps-run-buffer) - (define-key ps-mode-map ">" 'ps-mode-r-gt) - (define-key ps-mode-map "]" 'ps-mode-r-angle) - (define-key ps-mode-map "}" 'ps-mode-r-brace) - (define-key ps-mode-map "\177" 'ps-mode-backward-delete-char) - (define-key ps-mode-map "\t" 'ps-mode-tabkey) - (define-key ps-mode-map "\r" 'ps-mode-newline) - (easy-menu-define ps-mode-main ps-mode-map "PostScript" ps-mode-menu-main)) - -(unless ps-run-mode-map - (setq ps-run-mode-map (make-sparse-keymap)) - (set-keymap-parent ps-run-mode-map comint-mode-map) - (define-key ps-run-mode-map "\C-c\C-q" 'ps-run-quit) - (define-key ps-run-mode-map "\C-c\C-k" 'ps-run-kill) - (define-key ps-run-mode-map "\C-c\C-e" 'ps-run-goto-error) - (define-key ps-run-mode-map [mouse-2] 'ps-run-mouse-goto-error)) - - -;; Syntax table. - -(unless ps-mode-syntax-table - (setq ps-mode-syntax-table (make-syntax-table)) - - (modify-syntax-entry ?\% "< " ps-mode-syntax-table) - (modify-syntax-entry ?\n "> " ps-mode-syntax-table) - (modify-syntax-entry ?\r "> " ps-mode-syntax-table) - (modify-syntax-entry ?\f "> " ps-mode-syntax-table) - (modify-syntax-entry ?\< "(>" ps-mode-syntax-table) - (modify-syntax-entry ?\> ")<" ps-mode-syntax-table) - - (modify-syntax-entry ?\! "w " ps-mode-syntax-table) - (modify-syntax-entry ?\" "w " ps-mode-syntax-table) - (modify-syntax-entry ?\# "w " ps-mode-syntax-table) - (modify-syntax-entry ?\$ "w " ps-mode-syntax-table) - (modify-syntax-entry ?\& "w " ps-mode-syntax-table) - (modify-syntax-entry ?\' "w " ps-mode-syntax-table) - (modify-syntax-entry ?\* "w " ps-mode-syntax-table) - (modify-syntax-entry ?\+ "w " ps-mode-syntax-table) - (modify-syntax-entry ?\, "w " ps-mode-syntax-table) - (modify-syntax-entry ?\- "w " ps-mode-syntax-table) - (modify-syntax-entry ?\. "w " ps-mode-syntax-table) - (modify-syntax-entry ?\: "w " ps-mode-syntax-table) - (modify-syntax-entry ?\; "w " ps-mode-syntax-table) - (modify-syntax-entry ?\= "w " ps-mode-syntax-table) - (modify-syntax-entry ?\? "w " ps-mode-syntax-table) - (modify-syntax-entry ?\@ "w " ps-mode-syntax-table) - (modify-syntax-entry ?\\ "w " ps-mode-syntax-table) - (modify-syntax-entry ?^ "w " ps-mode-syntax-table) ; NOT: ?\^ - (modify-syntax-entry ?\_ "w " ps-mode-syntax-table) - (modify-syntax-entry ?\` "w " ps-mode-syntax-table) - (modify-syntax-entry ?\| "w " ps-mode-syntax-table) - (modify-syntax-entry ?\~ "w " ps-mode-syntax-table) - - (let ((i 128)) - (while (< i 256) - (modify-syntax-entry i "w " ps-mode-syntax-table) - (setq i (1+ i))))) +(easy-menu-define ps-mode-main ps-mode-map "PostScript" ps-mode-menu-main) @@ -484,6 +456,13 @@ If nil, use `temporary-file-directory'." ;; PostScript mode. +(defun ps-mode-smie-rules (kind token) + (pcase (cons kind token) + (`(:after . "<") (when (smie-rule-next-p "<") 0)) + (`(:elem . basic) ps-mode-tab) + (`(:close-all . ">") t) + (`(:list-intro . ,_) t))) + ;;;###autoload (define-derived-mode ps-mode prog-mode "PostScript" "Major mode for editing PostScript with GNU Emacs. @@ -493,7 +472,6 @@ Entry to this mode calls `ps-mode-hook'. The following variables hold user options, and can be set through the `customize' command: - `ps-mode-auto-indent' `ps-mode-tab' `ps-mode-paper-size' `ps-mode-print-function' @@ -523,12 +501,16 @@ with a file position. Clicking mouse-2 on this number will bring point to the corresponding spot in the PostScript window, if input to the interpreter was sent from that window. Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number has the same effect." + (setq-local syntax-propertize-function #'ps-mode-syntax-propertize) (set (make-local-variable 'font-lock-defaults) '((ps-mode-font-lock-keywords ps-mode-font-lock-keywords-1 ps-mode-font-lock-keywords-2 ps-mode-font-lock-keywords-3) - t)) + nil)) + (smie-setup nil #'ps-mode-smie-rules) + (setq-local electric-indent-chars + (append '(?> ?\] ?\}) electric-indent-chars)) (set (make-local-variable 'comment-start) "%") ;; NOTE: `\' has a special meaning in strings only (set (make-local-variable 'comment-start-skip) "%+[ \t]*") @@ -555,8 +537,7 @@ Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number (reporter-submit-bug-report ps-mode-maintainer-address (format "ps-mode.el %s [%s]" ps-mode-version system-type) - '(ps-mode-auto-indent - ps-mode-tab + '(ps-mode-tab ps-mode-paper-size ps-mode-print-function ps-run-prompt @@ -570,53 +551,54 @@ Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number ;; Helper functions for font-lock. -;; When this function is called, point is at an opening bracket. -;; This function should test if point is at the start of a string -;; with nested brackets. -;; If true: move point to end of string -;; set string to match data nr 2 -;; return new point -;; If false: return nil -(defun ps-mode-looking-at-nested (limit) - (let ((first (point)) - (level 1) - pos) - ;; Move past opening bracket. - (forward-char 1) - (setq pos (point)) - (while (and (> level 0) (< pos limit)) - ;; Search next bracket, stepping over escaped brackets. - (if (not (looking-at "\\([^()\\\n]\\|\\\\.\\)*\\([()]\\)")) - (setq level -1) - (setq level (+ level (if (string= "(" (match-string 2)) 1 -1))) - (goto-char (setq pos (match-end 0))))) - (if (not (= level 0)) - nil - ;; Found string with nested brackets, now set match data nr 2. - (set-match-data (list first pos nil nil first pos)) - pos))) - -;; This function should search for a string or comment -;; If comment, return as match data nr 1 -;; If string, return as match data nr 2 -(defun ps-mode-match-string-or-comment (limit) - ;; Find the first potential match. - (if (not (re-search-forward "[%(]" limit t)) - ;; Nothing found: return failure. - nil - (let ((end (match-end 0))) - (goto-char (match-beginning 0)) - (cond ((looking-at "\\(%.*\\)\\|\\((\\([^()\\\n]\\|\\\\.\\)*)\\)") - ;; It's a comment or string without nested, unescaped brackets. - (goto-char (match-end 0)) - (point)) - ((ps-mode-looking-at-nested limit) - ;; It's a string with nested brackets. - (point)) - (t - ;; Try next match. - (goto-char end) - (ps-mode-match-string-or-comment limit)))))) +(defconst ps-mode--string-syntax-table + (let ((st (make-syntax-table ps-mode-syntax-table))) + (modify-syntax-entry ?% "." st) + (modify-syntax-entry ?< "." st) + (modify-syntax-entry ?> "." st) + (modify-syntax-entry ?\{ "." st) + (modify-syntax-entry ?\} "." st) + (modify-syntax-entry ?\[ "." st) + (modify-syntax-entry ?\] "." st) + st)) + +(defun ps-mode--syntax-propertize-special (end) + (let ((ppss (syntax-ppss)) + char) + (cond + ((not (nth 3 ppss))) ;Not in (...), <~..base85..~>, or <..hex..>. + ((eq ?\( (setq char (char-after (nth 8 ppss)))) + (save-restriction + (narrow-to-region (point-min) end) + (goto-char (nth 8 ppss)) + (condition-case nil + (with-syntax-table ps-mode--string-syntax-table + (let ((parse-sexp-lookup-properties nil)) + (forward-sexp 1)) + (put-text-property (1- (point)) (point) + 'syntax-table (string-to-syntax "|"))) + (scan-error (goto-char end))))) + ((eq char ?<) + (when (re-search-forward (if (eq ?~ (char-after (1+ (nth 8 ppss)))) + "~>" ">") + end 'move) + (put-text-property (1- (point)) (point) + 'syntax-table (string-to-syntax "|"))))))) + +(defun ps-mode-syntax-propertize (start end) + (goto-char start) + (ps-mode--syntax-propertize-special end) + (funcall + (syntax-propertize-rules + ("\\(<\\)\\(?:~\\|[ \n\t]*[[:xdigit:]]\\)\\|\\(?1:(\\)" + (1 (unless (or (eq (char-after (match-beginning 0)) + (char-before (match-beginning 0))) ;Avoid "<<". + (nth 8 (save-excursion (syntax-ppss (match-beginning 1))))) + (put-text-property (match-beginning 1) (match-end 1) + 'syntax-table (string-to-syntax "|")) + (ps-mode--syntax-propertize-special end) + nil)))) + (point) end)) ;; Key-handlers. @@ -654,34 +636,12 @@ defines the beginning of a group. These tokens are: { [ <<" (setq target (+ target ps-mode-tab))) target))))) -(defun ps-mode-newline () - "Insert newline with proper indentation." - (interactive) - (delete-horizontal-space) - (insert "\n") - (if ps-mode-auto-indent - (indent-to (ps-mode-target-column)))) - -(defun ps-mode-tabkey () - "Indent/reindent current line, or insert tab." - (interactive) - (let ((column (current-column)) - target) - (if (or (not ps-mode-auto-indent) - (< ps-mode-tab 1) - (not (re-search-backward "^[ \t]*\\=" nil t))) - (insert "\t") - (setq target (ps-mode-target-column)) - (while (<= target column) - (setq target (+ target ps-mode-tab))) - (indent-line-to target)))) - (defun ps-mode-backward-delete-char () "Delete backward indentation, or delete backward character." (interactive) (let ((column (current-column)) target) - (if (or (not ps-mode-auto-indent) + (if (or (not electric-indent-mode) (< ps-mode-tab 1) (not (re-search-backward "^[ \t]+\\=" nil t))) (call-interactively 'delete-backward-char) @@ -694,32 +654,6 @@ defines the beginning of a group. These tokens are: { [ <<" (setq target 0)) (indent-line-to target)))) -(defun ps-mode-r-brace () - "Insert `}' and perform balance." - (interactive) - (insert "}") - (ps-mode-r-balance "}")) - -(defun ps-mode-r-angle () - "Insert `]' and perform balance." - (interactive) - (insert "]") - (ps-mode-r-balance "]")) - -(defun ps-mode-r-gt () - "Insert `>' and perform balance." - (interactive) - (insert ">") - (ps-mode-r-balance ">>")) - -(defun ps-mode-r-balance (right) - "Adjust indenting if point after RIGHT." - (if ps-mode-auto-indent - (save-excursion - (when (re-search-backward (concat "^[ \t]*" (regexp-quote right) "\\=") nil t) - (indent-line-to (ps-mode-target-column))))) - (blink-matching-open)) - (defun ps-mode-other-newline () "Perform newline in `*ps-run*' buffer." (interactive) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index f99a580b376..743981b3714 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -155,15 +155,13 @@ ;; the shell completion in background so you should run ;; `python-shell-send-buffer' from time to time to get better results. -;; Skeletons: 6 skeletons are provided for simple inserting of class, -;; def, for, if, try and while. These skeletons are integrated with -;; abbrev. If you have `abbrev-mode' activated and +;; Skeletons: skeletons are provided for simple inserting of things like class, +;; def, for, import, if, try, and while. These skeletons are +;; integrated with abbrev. If you have `abbrev-mode' activated and ;; `python-skeleton-autoinsert' is set to t, then whenever you type ;; the name of any of those defined and hit SPC, they will be ;; automatically expanded. As an alternative you can use the defined -;; skeleton commands: `python-skeleton-class', `python-skeleton-def' -;; `python-skeleton-for', `python-skeleton-if', `python-skeleton-try' -;; and `python-skeleton-while'. +;; skeleton commands: `python-skeleton-<foo>'. ;; FFAP: You can find the filename for a given module when using ffap ;; out of the box. This feature needs an inferior python shell @@ -253,6 +251,7 @@ (define-key map "\C-c\C-td" 'python-skeleton-def) (define-key map "\C-c\C-tf" 'python-skeleton-for) (define-key map "\C-c\C-ti" 'python-skeleton-if) + (define-key map "\C-c\C-tm" 'python-skeleton-import) (define-key map "\C-c\C-tt" 'python-skeleton-try) (define-key map "\C-c\C-tw" 'python-skeleton-while) ;; Shell interaction @@ -2005,7 +2004,7 @@ process buffer for a list of commands.)" (interactive (if current-prefix-arg (list - (read-string "Run Python: " (python-shell-parse-command)) + (read-shell-command "Run Python: " (python-shell-parse-command)) (y-or-n-p "Make dedicated process? ") (= (prefix-numeric-value current-prefix-arg) 4)) (list (python-shell-parse-command) nil t))) @@ -2058,8 +2057,7 @@ startup." (global-proc-name (python-shell-get-process-name nil)) (global-proc-buffer-name (format "*%s*" global-proc-name)) (dedicated-running (comint-check-proc dedicated-proc-buffer-name)) - (global-running (comint-check-proc global-proc-buffer-name)) - (current-prefix-arg 16)) + (global-running (comint-check-proc global-proc-buffer-name))) (when (and (not dedicated-running) (not global-running)) (if (call-interactively 'run-python) (setq dedicated-running t) @@ -2960,6 +2958,12 @@ The skeleton will be bound to python-skeleton-NAME." > _ \n '(python-skeleton--else) | ^) +(python-skeleton-define import nil + "Import from module: " + "from " str & " " | -5 + "import " + ("Identifier: " str ", ") -2 \n _) + (python-skeleton-define try nil nil "try:" \n @@ -2986,7 +2990,7 @@ The skeleton will be bound to python-skeleton-NAME." "class " str "(" ("Inheritance, %s: " (unless (equal ?\( (char-before)) ", ") str) - & ")" | -2 + & ")" | -1 ":" \n "\"\"\"" - "\"\"\"" \n > _ \n) diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index 5ad5633fa85..c47a3bd6fbe 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -1,4 +1,4 @@ -;;; scheme.el --- Scheme (and DSSSL) editing mode +;;; scheme.el --- Scheme (and DSSSL) editing mode -*- lexical-binding: t; -*- ;; Copyright (C) 1986-1988, 1997-1998, 2001-2014 Free Software ;; Foundation, Inc. @@ -280,7 +280,9 @@ See `run-hooks'." "\\|-module" "\\)\\)\\>" ;; Any whitespace and declared object. - "[ \t]*(?" + ;; The "(*" is for curried definitions, e.g., + ;; (define ((sum a) b) (+ a b)) + "[ \t]*(*" "\\(\\sw+\\)?") '(1 font-lock-keyword-face) '(6 (cond ((match-beginning 3) font-lock-function-name-face) @@ -491,20 +493,20 @@ indentation." ;;; Let is different in Scheme -(defun would-be-symbol (string) - (not (string-equal (substring string 0 1) "("))) +;; (defun scheme-would-be-symbol (string) +;; (not (string-equal (substring string 0 1) "("))) -(defun next-sexp-as-string () - ;; Assumes that it is protected by a save-excursion - (forward-sexp 1) - (let ((the-end (point))) - (backward-sexp 1) - (buffer-substring (point) the-end))) +;; (defun scheme-next-sexp-as-string () +;; ;; Assumes that it is protected by a save-excursion +;; (forward-sexp 1) +;; (let ((the-end (point))) +;; (backward-sexp 1) +;; (buffer-substring (point) the-end))) ;; This is correct but too slow. ;; The one below works almost always. ;;(defun scheme-let-indent (state indent-point) -;; (if (would-be-symbol (next-sexp-as-string)) +;; (if (scheme-would-be-symbol (scheme-next-sexp-as-string)) ;; (scheme-indent-specform 2 state indent-point) ;; (scheme-indent-specform 1 state indent-point))) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 4db462594dc..c3032b4f195 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -237,6 +237,7 @@ (ksh88 . jsh) (oash . sh) (pdksh . ksh88) + (mksh . pdksh) (posix . sh) (tcsh . csh) (wksh . ksh88) @@ -262,6 +263,7 @@ sh Bourne Shell ksh Korn Shell '93 dtksh CDE Desktop Korn Shell pdksh Public Domain Korn Shell + mksh MirOS BSD Korn Shell wksh Window Korn Shell zsh Z Shell oash SCO OA (curses) Shell @@ -271,7 +273,6 @@ sh Bourne Shell :version "24.4" ; added dash :group 'sh-script) - (defcustom sh-alias-alist (append (if (eq system-type 'gnu/linux) '((csh . tcsh) @@ -279,11 +280,20 @@ sh Bourne Shell ;; for the time being '((ksh . ksh88) (bash2 . bash) - (sh5 . sh))) + (sh5 . sh) + ;; Android's system shell + ("^/system/bin/sh$" . mksh))) "Alist for transforming shell names to what they really are. -Use this where the name of the executable doesn't correspond to the type of -shell it really is." - :type '(repeat (cons symbol symbol)) +Use this where the name of the executable doesn't correspond to +the type of shell it really is. Keys are regular expressions +matched against the full path of the interpreter. (For backward +compatibility, keys may also be symbols, which are matched +against the interpreter's basename. The values are symbols +naming the shell." + :type '(repeat (cons (radio + (regexp :tag "Regular expression") + (symbol :tag "Basename")) + (symbol :tag "Shell"))) :group 'sh-script) @@ -387,15 +397,20 @@ the car and cdr are the same symbol.") "Non-nil if `sh-shell-variables' is initialized.") (defun sh-canonicalize-shell (shell) - "Convert a shell name SHELL to the one we should handle it as." - (if (string-match "\\.exe\\'" shell) - (setq shell (substring shell 0 (match-beginning 0)))) - (or (symbolp shell) - (setq shell (intern shell))) - (or (cdr (assq shell sh-alias-alist)) - shell)) - -(defvar sh-shell (sh-canonicalize-shell (file-name-nondirectory sh-shell-file)) + "Convert a shell name SHELL to the one we should handle it as. +SHELL is a full path to the shell interpreter; return a shell +name symbol." + (cl-loop + with shell = (cond ((string-match "\\.exe\\'" shell) + (substring shell 0 (match-beginning 0))) + (t shell)) + with shell-base = (intern (file-name-nondirectory shell)) + for (key . value) in sh-alias-alist + if (and (stringp key) (string-match key shell)) return value + if (eq key shell-base) return value + finally return shell-base)) + +(defvar sh-shell (sh-canonicalize-shell sh-shell-file) "The shell being programmed. This is set by \\[sh-set-shell].") ;;;###autoload(put 'sh-shell 'safe-local-variable 'symbolp) @@ -677,7 +692,7 @@ removed when closing the here document." "jobs" "kill" "let" "local" "popd" "printf" "pushd" "shopt" "source" "suspend" "typeset" "unalias" ;; bash4 - "mapfile" "readarray") + "mapfile" "readarray" "coproc") ;; The next entry is only used for defining the others (bourne sh-append shell @@ -1533,6 +1548,12 @@ When the region is active, send the region instead." ;; mode-command and utility functions +(defun sh-after-hack-local-variables () + (when (assq 'sh-shell file-local-variables-alist) + (sh-set-shell (if (symbolp sh-shell) + (symbol-name sh-shell) + sh-shell)))) + ;;;###autoload (define-derived-mode sh-mode prog-mode "Shell-script" "Major mode for editing shell scripts. @@ -1643,7 +1664,9 @@ with your script for an edit-interpret-debug cycle." ((string-match "[.]csh\\>" buffer-file-name) "csh") ((equal (file-name-nondirectory buffer-file-name) ".profile") "sh") (t sh-shell-file)) - nil nil)) + nil nil) + (add-hook 'hack-local-variables-hook + #'sh-after-hack-local-variables nil t)) ;;;###autoload (defalias 'shell-script-mode 'sh-mode) @@ -2257,9 +2280,7 @@ Calls the value of `sh-set-shell-hook' if set." t)) (if (string-match "\\.exe\\'" shell) (setq shell (substring shell 0 (match-beginning 0)))) - (setq sh-shell (intern (file-name-nondirectory shell)) - sh-shell (or (cdr (assq sh-shell sh-alias-alist)) - sh-shell)) + (setq sh-shell (sh-canonicalize-shell shell)) (if insert-flag (setq sh-shell-file (executable-set-magic shell (sh-feature sh-shell-arg) @@ -2311,7 +2332,7 @@ Calls the value of `sh-set-shell-hook' if set." (when font-lock-mode (setq font-lock-set-defaults nil) (font-lock-set-defaults) - (font-lock-fontify-buffer)) + (font-lock-flush)) (setq sh-shell-process nil) (run-hooks 'sh-set-shell-hook)) diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el index f9efa3732c7..a8455c50064 100644 --- a/lisp/progmodes/subword.el +++ b/lisp/progmodes/subword.el @@ -1,4 +1,4 @@ -;;; subword.el --- Handling capitalized subwords in a nomenclature +;;; subword.el --- Handling capitalized subwords in a nomenclature -*- lexical-binding: t -*- ;; Copyright (C) 2004-2014 Free Software Foundation, Inc. @@ -21,13 +21,10 @@ ;;; Commentary: -;; This package was cc-submode.el before it was recognized being -;; useful in general and not tied to C and c-mode at all. - -;; This package provides `subword' oriented commands and a minor mode -;; (`subword-mode') that substitutes the common word handling -;; functions with them. It also provides the `superword-mode' minor -;; mode that treats symbols as words, the opposite of `subword-mode'. +;; This package provides the `subword' minor mode, which merges the +;; old remap-based subword.el (derived from cc-mode code) and +;; cap-words.el, which takes advantage of core Emacs +;; word-motion-customization functionality. ;; In spite of GNU Coding Standards, it is popular to name a symbol by ;; mixing uppercase and lowercase letters, e.g. "GtkWidget", @@ -47,25 +44,6 @@ ;; words. You also get a mode to treat symbols as words instead, ;; called `superword-mode' (the opposite of `subword-mode'). -;; In the minor mode, all common key bindings for word oriented -;; commands are overridden by the subword oriented commands: - -;; Key Word oriented command Subword oriented command (also superword) -;; ============================================================ -;; M-f `forward-word' `subword-forward' -;; M-b `backward-word' `subword-backward' -;; M-@ `mark-word' `subword-mark' -;; M-d `kill-word' `subword-kill' -;; M-DEL `backward-kill-word' `subword-backward-kill' -;; M-t `transpose-words' `subword-transpose' -;; M-c `capitalize-word' `subword-capitalize' -;; M-u `upcase-word' `subword-upcase' -;; M-l `downcase-word' `subword-downcase' -;; -;; Note: If you have changed the key bindings for the word oriented -;; commands in your .emacs or a similar place, the keys you've changed -;; to are also used for the corresponding subword oriented commands. - ;; To make the mode turn on automatically, put the following code in ;; your .emacs: ;; @@ -102,27 +80,25 @@ "Regexp used by `subword-backward-internal'.") (defvar subword-mode-map - (let ((map (make-sparse-keymap))) - (dolist (cmd '(forward-word backward-word mark-word kill-word - backward-kill-word transpose-words - capitalize-word upcase-word downcase-word - left-word right-word)) - (let ((othercmd (let ((name (symbol-name cmd))) - (string-match "\\([[:alpha:]-]+\\)-word[s]?" name) - (intern (concat "subword-" (match-string 1 name)))))) - (define-key map (vector 'remap cmd) othercmd))) - map) + ;; We originally remapped motion keys here, but now use Emacs core + ;; hooks. Leave this keymap around so that user additions to it + ;; keep working. + (make-sparse-keymap) "Keymap used in `subword-mode' minor mode.") ;;;###autoload +(define-obsolete-function-alias + 'capitalized-words-mode 'subword-mode "24.5") + +;;;###autoload (define-minor-mode subword-mode "Toggle subword movement and editing (Subword mode). With a prefix argument ARG, enable Subword mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. -Subword mode is a buffer-local minor mode. Enabling it remaps -word-based editing commands to subword-based commands that handle +Subword mode is a buffer-local minor mode. Enabling it changes +the definition of a word so that word-based commands stop inside symbols with mixed uppercase and lowercase letters, e.g. \"GtkWidget\", \"EmacsFrameClass\", \"NSGraphicsContext\". @@ -136,13 +112,13 @@ called a `subword'. Here are some examples: EmacsFrameClass => \"Emacs\", \"Frame\" and \"Class\" NSGraphicsContext => \"NS\", \"Graphics\" and \"Context\" -The subword oriented commands activated in this minor mode recognize -subwords in a nomenclature to move between subwords and to edit them -as words. +This mode changes the definition of a word so that word commands +treat nomenclature boundaries as word bounaries. \\{subword-mode-map}" :lighter " ," - (when subword-mode (superword-mode -1))) + (when subword-mode (superword-mode -1)) + (subword-setup-buffer)) (define-obsolete-function-alias 'c-subword-mode 'subword-mode "23.2") @@ -151,6 +127,13 @@ as words. (lambda () (subword-mode 1)) :group 'convenience) +;; N.B. These commands aren't used unless explicitly invoked; they're +;; here for compatibility. Today, subword-mode leaves motion commands +;; alone and uses `find-word-boundary-function-table' to change how +;; `forward-word' and other low-level commands detect word bounaries. +;; This way, all word-related activities, not just the images we +;; imagine here, get subword treatment. + (defun subword-forward (&optional arg) "Do the same as `forward-word' but on subwords. See the command `subword-mode' for a description of subwords. @@ -159,10 +142,10 @@ Optional argument ARG is the same as for `forward-word'." (unless arg (setq arg 1)) (cond ((< 0 arg) - (dotimes (i arg (point)) + (dotimes (_i arg (point)) (funcall subword-forward-function))) ((> 0 arg) - (dotimes (i (- arg) (point)) + (dotimes (_i (- arg) (point)) (funcall subword-backward-function))) (t (point)))) @@ -262,7 +245,7 @@ Optional argument ARG is the same as for `capitalize-word'." (start (point)) (advance (>= arg 0))) - (dotimes (i count) + (dotimes (_i count) (if advance (progn (re-search-forward "[[:alpha:]]") @@ -290,17 +273,15 @@ With a prefix argument ARG, enable Superword mode if ARG is positive, and disable it otherwise. If called from Lisp, enable the mode if ARG is omitted or nil. -Superword mode is a buffer-local minor mode. Enabling it remaps -word-based editing commands to superword-based commands that -treat symbols as words, e.g. \"this_is_a_symbol\". - -The superword oriented commands activated in this minor mode -recognize symbols as superwords to move between superwords and to -edit them as words. +Superword mode is a buffer-local minor mode. Enabling it changes +the definition of words such that symbols characters are treated +as parts of words: e.g., in `superword-mode', +\"this_is_a_symbol\" counts as one word. \\{superword-mode-map}" :lighter " ²" - (when superword-mode (subword-mode -1))) + (when superword-mode (subword-mode -1)) + (subword-setup-buffer)) ;;;###autoload (define-global-minor-mode global-superword-mode superword-mode @@ -347,9 +328,45 @@ edit them as words. (1+ (match-beginning 0))))) (backward-word 1)))) +(defconst subword-find-word-boundary-function-table + (let ((tab (make-char-table nil))) + (set-char-table-range tab t #'subword-find-word-boundary) + tab) + "Assigned to `find-word-boundary-function-table' in +`subword-mode' and `superword-mode'; defers to +`subword-find-word-bounary'.") + +(defconst subword-empty-char-table + (make-char-table nil) + "Assigned to `find-word-boundary-function-table' while we're +searching subwords in order to avoid unwanted reentrancy.") + +(defun subword-setup-buffer () + (set (make-local-variable 'find-word-boundary-function-table) + (if (or subword-mode superword-mode) + subword-find-word-boundary-function-table + subword-empty-char-table))) + +(defun subword-find-word-boundary (pos limit) + "Catch-all handler in `subword-find-word-boundary-function-table'." + (let ((find-word-boundary-function-table subword-empty-char-table)) + (save-match-data + (save-excursion + (save-restriction + (if (< pos limit) + (progn + (goto-char pos) + (narrow-to-region (point-min) limit) + (funcall subword-forward-function)) + (goto-char (1+ pos)) + (narrow-to-region limit (point-max)) + (funcall subword-backward-function)) + (point)))))) + (provide 'subword) (provide 'superword) +(provide 'cap-words) ; Obsolete alias ;;; subword.el ends here diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el index 069e7119b90..7cb8f457e3f 100644 --- a/lisp/progmodes/vera-mode.el +++ b/lisp/progmodes/vera-mode.el @@ -138,7 +138,6 @@ If nil, TAB always indents current line." (define-key map "\C-c\t" 'indent-according-to-mode) (define-key map "\M-\C-\\" 'vera-indent-region) (define-key map "\C-c\C-c" 'vera-comment-uncomment-region) - (define-key map "\C-c\C-f" 'vera-fontify-buffer) (define-key map "\C-c\C-v" 'vera-version) (define-key map "\M-\t" 'tab-to-tab-stop) ;; Electric key bindings. @@ -172,8 +171,6 @@ If nil, TAB always indents current line." ["Indent Region" vera-indent-region (mark)] ["Indent Buffer" vera-indent-buffer t] "--" - ["Fontify Buffer" vera-fontify-buffer t] - "--" ["Documentation" describe-mode] ["Version" vera-version t] ["Bug Report..." vera-submit-bug-report t] @@ -686,7 +683,8 @@ Adapted from `font-lock-match-c-style-declaration-item-and-skip-to-next'." "Font lock mode face used to highlight interface names." :group 'font-lock-highlighting-faces) -(defalias 'vera-fontify-buffer 'font-lock-fontify-buffer) +(define-obsolete-function-alias 'vera-fontify-buffer + 'font-lock-fontify-buffer "24.5") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Indentation diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 84d7c15f76c..b649959bae3 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -123,7 +123,7 @@ ;;; Code: ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "2013-11-05-78e66ba-vpo" +(defconst verilog-mode-version "2014-05-31-3cd8144-vpo" "Version of this Verilog mode.") (defconst verilog-mode-release-emacs t "If non-nil, this version of Verilog mode was released with Emacs itself.") @@ -1020,6 +1020,20 @@ SystemVerilog designs." :type 'string) (put 'verilog-assignment-delay 'safe-local-variable 'stringp) +(defcustom verilog-auto-arg-format 'packed + "Formatting to use for AUTOARG signal names. +If 'packed', then as many inputs and outputs that fit within +`fill-column' will be put onto one line. + +If 'single', then a single input or output will be put onto each +line." + :version "24.5" + :type '(radio (const :tag "Line up Assignments and Declarations" packed) + (const :tag "Line up Assignment statements" single)) + :group 'verilog-mode-auto) +(put 'verilog-auto-arg-format 'safe-local-variable + '(lambda (x) (memq x '(packed single)))) + (defcustom verilog-auto-arg-sort nil "Non-nil means AUTOARG signal names will be sorted, not in declaration order. Declaration order is advantageous with order based instantiations @@ -1634,7 +1648,7 @@ will break, as the o's continuously replace. xa -> x works ok though." string)) (defsubst verilog-re-search-forward (REGEXP BOUND NOERROR) - ; checkdoc-params: (REGEXP BOUND NOERROR) + ;; checkdoc-params: (REGEXP BOUND NOERROR) "Like `re-search-forward', but skips over match in comments or strings." (let ((mdata '(nil nil))) ;; So match-end will return nil if no matches found (while (and @@ -1650,7 +1664,7 @@ will break, as the o's continuously replace. xa -> x works ok though." (match-end 0))) (defsubst verilog-re-search-backward (REGEXP BOUND NOERROR) - ; checkdoc-params: (REGEXP BOUND NOERROR) + ;; checkdoc-params: (REGEXP BOUND NOERROR) "Like `re-search-backward', but skips over match in comments or strings." (let ((mdata '(nil nil))) ;; So match-end will return nil if no matches found (while (and @@ -1679,7 +1693,7 @@ so there may be a large up front penalty for the first search." pt)) (defsubst verilog-re-search-backward-quick (regexp bound noerror) - ; checkdoc-params: (REGEXP BOUND NOERROR) + ;; checkdoc-params: (REGEXP BOUND NOERROR) "Like `verilog-re-search-backward', including use of REGEXP BOUND and NOERROR, but trashes match data and is faster for REGEXP that doesn't match often. This uses `verilog-scan' and text properties to ignore comments, @@ -1748,6 +1762,7 @@ To call on \\[verilog-auto], set `verilog-auto-delete-trailing-whitespace'." (unless (bolp) (insert "\n")))) (defvar compile-command) +(defvar create-lockfiles) ;; Emacs 24 ;; compilation program (defun verilog-set-compile-command () @@ -2788,8 +2803,8 @@ find the errors." "sync_reject_on" "unique0" "until" "until_with" "untyped" "weak" ;; 1800-2012 "implements" "interconnect" "nettype" "soft" - ) - "List of Verilog keywords.") + ) + "List of Verilog keywords.") (defconst verilog-comment-start-regexp "//\\|/\\*" "Dual comment value for `comment-start-regexp'.") @@ -2906,7 +2921,7 @@ See also `verilog-font-lock-extra-types'.") '( "and" "bit" "buf" "bufif0" "bufif1" "cmos" "defparam" "event" "genvar" "inout" "input" "integer" "localparam" - "logic" "mailbox" "nand" "nmos" "not" "notif0" "notif1" "or" + "logic" "mailbox" "nand" "nmos" "nor" "not" "notif0" "notif1" "or" "output" "parameter" "pmos" "pull0" "pull1" "pulldown" "pullup" "rcmos" "real" "realtime" "reg" "rnmos" "rpmos" "rtran" "rtranif0" "rtranif1" "semaphore" "signed" "struct" "supply" @@ -3332,9 +3347,9 @@ Use filename, if current buffer being edited shorten to just buffer name." (verilog-re-search-backward reg nil 'move)) (cond ((match-end 1) ; matched verilog-end-block-re - ; try to leap back to matching outward block by striding across - ; indent level changing tokens then immediately - ; previous line governs indentation. + ;; try to leap back to matching outward block by striding across + ;; indent level changing tokens then immediately + ;; previous line governs indentation. (verilog-leap-to-head)) ((match-end 2) ; else, we're in deep (setq elsec (1+ elsec))) @@ -3992,7 +4007,7 @@ This puts the mark at the end, and point at the beginning." (mark-defun))) (defun verilog-comment-region (start end) - ; checkdoc-params: (start end) + ;; checkdoc-params: (start end) "Put the region into a Verilog comment. The comments that are in this area are \"deformed\": `*)' becomes `!(*' and `}' becomes `!{'. @@ -4223,7 +4238,7 @@ Uses `verilog-scan' cache." ((equal (char-after) ?\}) (forward-char)) - ;; Skip to end of statement + ;; Skip to end of statement ((condition-case nil (setq pos (catch 'found @@ -4285,7 +4300,7 @@ More specifically, point @ in the line foo : @ begin" (setq nest (1+ nest))) ((match-end 2) (if (= nest 1) - (throw 'found 1)) + (throw 'found 1)) (setq nest (1- nest))) (t (throw 'found (= nest 0))))))) @@ -4430,6 +4445,7 @@ Limit search to point LIM." "\\(`ifdef\\>\\)\\|" "\\(`ifndef\\>\\)\\|" "\\(`elsif\\>\\)")) + (defun verilog-set-auto-endcomments (indent-str kill-existing-comment) "Add ending comment with given INDENT-STR. With KILL-EXISTING-COMMENT, remove what was there before. @@ -5078,13 +5094,13 @@ FILENAME to find directory to run in, or defaults to `buffer-file-name`." (list (let ((default (verilog-expand-command verilog-preprocessor))) (set (make-local-variable `verilog-preprocessor) - (read-from-minibuffer "Run Preprocessor (like this): " - default nil nil - 'verilog-preprocess-history default))))) + (read-from-minibuffer "Run Preprocessor (like this): " + default nil nil + 'verilog-preprocess-history default))))) (unless command (setq command (verilog-expand-command verilog-preprocessor))) (let* ((fontlocked (and (boundp 'font-lock-mode) font-lock-mode)) - (dir (file-name-directory (or filename buffer-file-name))) - (cmd (concat "cd " dir "; " command))) + (dir (file-name-directory (or filename buffer-file-name))) + (cmd (concat "cd " dir "; " command))) (with-output-to-temp-buffer "*Verilog-Preprocessed*" (with-current-buffer (get-buffer "*Verilog-Preprocessed*") (insert (concat "// " cmd "\n")) @@ -5092,7 +5108,11 @@ FILENAME to find directory to run in, or defaults to `buffer-file-name`." (verilog-mode) ;; Without this force, it takes a few idle seconds ;; to get the color, which is very jarring - (when fontlocked (font-lock-fontify-buffer)))))) + (unless (fboundp 'font-lock-ensure) + ;; We should use font-lock-ensure in preference to + ;; font-lock-fontify-buffer, but IIUC the problem this is supposed to + ;; solve only appears in Emacsen older than font-lock-ensure anyway. + (when fontlocked (font-lock-fontify-buffer))))))) ;; @@ -5138,23 +5158,29 @@ Save the result unless optional NO-SAVE is t." ;; Make sure any sub-files we read get proper mode (setq-default major-mode 'verilog-mode) ;; Ditto files already read in - (mapc (lambda (buf) - (when (buffer-file-name buf) - (with-current-buffer buf - (verilog-mode)))) - (buffer-list)) - ;; Process the files - (mapcar (lambda (buf) + ;; Remember buffer list, so don't later pickup any verilog-getopt files + (let ((orig-buffer-list (buffer-list))) + (mapc (lambda (buf) (when (buffer-file-name buf) - (save-excursion - (if (not (file-exists-p (buffer-file-name buf))) - (error - (concat "File not found: " (buffer-file-name buf)))) - (message (concat "Processing " (buffer-file-name buf))) - (set-buffer buf) - (funcall funref) - (unless no-save (save-buffer))))) - (buffer-list)))) + (with-current-buffer buf + (verilog-mode) + (verilog-auto-reeval-locals) + (verilog-getopt-flags)))) + orig-buffer-list) + ;; Process the files + (mapcar (lambda (buf) + (when (buffer-file-name buf) + (save-excursion + (if (not (file-exists-p (buffer-file-name buf))) + (error + (concat "File not found: " (buffer-file-name buf)))) + (message (concat "Processing " (buffer-file-name buf))) + (set-buffer buf) + (funcall funref) + (when (and (not no-save) + (buffer-modified-p)) ;; Avoid "no changes to be saved" + (save-buffer))))) + orig-buffer-list)))) (defun verilog-batch-auto () "For use with --batch, perform automatic expansions as a stand-alone tool. @@ -5271,7 +5297,7 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." (if (save-excursion (beginning-of-line) (and (looking-at verilog-directive-re-1) (not (or (looking-at "[ \t]*`[ou]vm_") - (looking-at "[ \t]*`vmm_"))))) + (looking-at "[ \t]*`vmm_"))))) (throw 'nesting 'directive)) ;; indent structs as if there were module level (setq structres (verilog-in-struct-nested-p)) @@ -5510,10 +5536,10 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." ; endfunction (verilog-beg-of-statement) (if (looking-at verilog-beg-block-re-ordered) - (throw 'nesting 'block) - (throw 'nesting 'defun))) + (throw 'nesting 'block) + (throw 'nesting 'defun))) - ;; + ;; ((looking-at "\\<property\\>") ; *sigh* ; {assert|assume|cover} property (); are complete @@ -5704,7 +5730,7 @@ Jump from end to matching begin, from endcase to matching case, and so on." (setq sreg reg) (setq reg "\\(\\<fork\\>\\)\\|\\(\\<join\\(_any\\|_none\\)?\\>\\)" )) ))) - ;no nesting + ;; no nesting (if (and (verilog-re-search-backward reg nil 'move) (match-end 1)) ; task -> could be virtual and/or protected @@ -6547,10 +6573,9 @@ Be verbose about progress unless optional QUIET set." endpos (set-marker (make-marker) end) base-ind (progn (goto-char start) - (forward-char 1) - (skip-chars-forward " \t") - (current-column)) - ) + (forward-char 1) + (skip-chars-forward " \t") + (current-column))) ;; in a declaration block (not in argument list) (setq start (progn @@ -8065,7 +8090,7 @@ Optional NUM-PARAM and MAX-PARAM check for a specific number of parameters." Return an array of [outputs inouts inputs wire reg assign const]." (let ((end-mod-point (or (verilog-get-end-of-defun) (point-max))) (functask 0) (paren 0) (sig-paren 0) (v2kargs-ok t) - in-modport in-clocking ptype ign-prop + in-modport in-clocking in-ign-to-semi ptype ign-prop sigs-in sigs-out sigs-inout sigs-var sigs-assign sigs-const sigs-gparam sigs-intf sigs-modports vec expect-signal keywd newsig rvalue enum io signed typedefed multidim @@ -8097,19 +8122,24 @@ Return an array of [outputs inouts inputs wire reg assign const]." (or (re-search-forward "[^\\]\"" nil t) ;; don't forward-char first, since we look for a non backslash first (error "%s: Unmatched quotes, at char %d" (verilog-point-text) (point)))) ((eq ?\; (following-char)) - (when (and in-modport (not (eq in-modport t))) ;; end of a modport declaration - (verilog-modport-decls-set - in-modport - (verilog-decls-new sigs-out sigs-inout sigs-in - nil nil nil nil nil nil)) - ;; Pop from varstack to restore state to pre-clocking - (setq tmp (car varstack) - varstack (cdr varstack) - sigs-out (aref tmp 0) - sigs-inout (aref tmp 1) - sigs-in (aref tmp 2))) - (setq vec nil io nil expect-signal nil newsig nil paren 0 rvalue nil - v2kargs-ok nil in-modport nil ign-prop nil) + (cond (in-ign-to-semi ;; Such as inside a "import ...;" in a module header + (setq in-ign-to-semi nil)) + ((and in-modport (not (eq in-modport t))) ;; end of a modport declaration + (verilog-modport-decls-set + in-modport + (verilog-decls-new sigs-out sigs-inout sigs-in + nil nil nil nil nil nil)) + ;; Pop from varstack to restore state to pre-clocking + (setq tmp (car varstack) + varstack (cdr varstack) + sigs-out (aref tmp 0) + sigs-inout (aref tmp 1) + sigs-in (aref tmp 2)) + (setq vec nil io nil expect-signal nil newsig nil paren 0 rvalue nil + v2kargs-ok nil in-modport nil ign-prop nil)) + (t + (setq vec nil io nil expect-signal nil newsig nil paren 0 rvalue nil + v2kargs-ok nil in-modport nil ign-prop nil))) (forward-char 1)) ((eq ?= (following-char)) (setq rvalue t newsig nil) @@ -8212,8 +8242,12 @@ Return an array of [outputs inouts inputs wire reg assign const]." (setq in-modport t)) ((equal keywd "clocking") (setq in-clocking t)) + ((equal keywd "import") + (if v2kargs-ok ;; import in module header, not a modport import + (setq in-ign-to-semi t rvalue t))) ((equal keywd "type") (setq ptype t)) + ((equal keywd "var")) ;; Ifdef? Ignore name of define ((member keywd '("`ifdef" "`ifndef" "`elsif")) (setq rvalue t)) @@ -8285,6 +8319,7 @@ Return an array of [outputs inouts inputs wire reg assign const]." (eq functask 0) (not (member keywd verilog-keywords))) ;; Add new signal to expect-signal's variable + ;;(if dbg (setq dbg (concat dbg (format "Pt %s New sig %s'\n" (point) keywd)))) (setq newsig (verilog-sig-new keywd vec nil nil enum signed typedefed multidim modport)) (set expect-signal (cons newsig (symbol-value expect-signal)))))) @@ -9138,7 +9173,7 @@ foo.v (an include file): `define _FOO_V ... contents of file `endif // _FOO_V" -;;slow: (verilog-read-defines nil t)) + ;;slow: (verilog-read-defines nil t) (save-excursion (verilog-getopt-flags) (goto-char (point-min)) @@ -9527,7 +9562,7 @@ variables to build the path. With optional CHECK-EXT also check (setq outlist (cons (expand-file-name fn (file-name-directory current)) outlist))) - (setq chkexts (cdr chkexts))) + (setq chkexts (cdr chkexts))) (setq chkdirs (cdr chkdirs))) (setq outlist (nreverse outlist)) (setq verilog-dir-cache-lib-filenames @@ -9624,7 +9659,7 @@ Return modi if successful, else print message unless IGNORE-ERROR is true." allow-cache (setq modi (gethash module verilog-modi-lookup-cache)) (equal verilog-modi-lookup-last-current current) - ;; Iff hit is in current buffer, then tick must match + ;; If hit is in current buffer, then tick must match (or (equal verilog-modi-lookup-last-tick (buffer-chars-modified-tick)) (not (equal current (verilog-modi-file-or-buffer modi))))) ;;(message "verilog-modi-lookup: HIT %S" modi) @@ -10602,7 +10637,7 @@ If FORCE, always reread it." ;; (defun verilog-auto-arg-ports (sigs message indent-pt) - "Print a list of ports for an AUTOINST. + "Print a list of ports for AUTOARG. Takes SIGS list, adds MESSAGE to front and inserts each at INDENT-PT." (when sigs (when verilog-auto-arg-sort @@ -10614,13 +10649,19 @@ Takes SIGS list, adds MESSAGE to front and inserts each at INDENT-PT." (let ((space "")) (indent-to indent-pt) (while sigs - (cond ((> (+ 2 (current-column) (length (verilog-sig-name (car sigs)))) fill-column) + (cond ((equal verilog-auto-arg-format 'single) + (indent-to indent-pt) + (setq space "\n")) + ;; verilog-auto-arg-format 'packed + ((> (+ 2 (current-column) (length (verilog-sig-name (car sigs)))) fill-column) (insert "\n") - (indent-to indent-pt)) - (t (insert space))) + (indent-to indent-pt) + (setq space " ")) + (t + (insert space) + (setq space " "))) (insert (verilog-sig-name (car sigs)) ",") - (setq sigs (cdr sigs) - space " "))))) + (setq sigs (cdr sigs)))))) (defun verilog-auto-arg () "Expand AUTOARG statements. @@ -10655,9 +10696,11 @@ Typing \\[verilog-auto] will make this into: output o; endmodule -The argument declarations may be printed in declaration order to best suit -order based instantiations, or alphabetically, based on the -`verilog-auto-arg-sort' variable. +The argument declarations may be printed in declaration order to +best suit order based instantiations, or alphabetically, based on +the `verilog-auto-arg-sort' variable. + +Formatting is controlled with `verilog-auto-arg-format' variable. Any ports declared between the ( and /*AUTOARG*/ are presumed to be predeclared and are not redeclared by AUTOARG. AUTOARG will make a @@ -12071,7 +12114,7 @@ against the previous example's module: (verilog-signals-matching-regexp sig-list-if regexp) "interface" direction-re)) (when v2k (verilog-repair-open-comma)) - (when (or sig-list-i sig-list-o sig-list-io) + (when (or sig-list-i sig-list-o sig-list-io sig-list-if) (verilog-insert-indent "// Beginning of automatic in/out/inouts (from specific module)\n") ;; Don't sort them so an upper AUTOINST will match the main module (verilog-insert-definition modi sig-list-o "output" indent-pt v2k t) @@ -13538,8 +13581,7 @@ for sensitivity list." () > "begin" '(verilog-sk-prompt-name) \n > _ \n - > (- verilog-indent-level-behavioral) "end" -) + > (- verilog-indent-level-behavioral) "end" ) (define-skeleton verilog-sk-fork "Insert a fork join block." diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index b422cf6c989..3d5a3980a94 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -13,10 +13,10 @@ ;; filed in the Emacs bug reporting system against this file, a copy ;; of the bug report be sent to the maintainer's email address. -(defconst vhdl-version "3.34.2" +(defconst vhdl-version "3.35.2" "VHDL Mode version number.") -(defconst vhdl-time-stamp "2012-11-21" +(defconst vhdl-time-stamp "2014-03-28" "VHDL Mode time stamp for last update.") ;; This file is part of GNU Emacs. @@ -72,12 +72,12 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Emacs Versions -;; this updated version was only tested on: GNU Emacs 20.4 +;; this updated version was only tested on: GNU Emacs 24.1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Installation -;; Prerequisites: GNU Emacs 20.X/21.X/22.X/23.X, XEmacs 20.X/21.X. +;; Prerequisites: GNU Emacs 20/21/22/23/24, XEmacs 20/21. ;; Put `vhdl-mode.el' into the `site-lisp' directory of your Emacs installation ;; or into an arbitrary directory that is added to the load path by the @@ -392,7 +392,8 @@ File message: Unit-to-file name mapping: mapping of library unit names to names of files generated by the compiler (used for Makefile generation) To string : string a name is mapped to (\"\\1\" inserts the unit name, - \"\\2\" inserts the entity name for architectures) + \"\\2\" inserts the entity name for architectures, + \"\\3\" inserts the library name) Case adjustment : adjust case of inserted unit names \(*) The regular expression must match the error message starting from the @@ -1069,7 +1070,7 @@ NOTE: Activate the new setting in a VHDL buffer by using the menu entry "Customizations for sequential processes." :group 'vhdl-template) -(defcustom vhdl-reset-kind 'async +(defcustom vhdl-reset-kind 'async "Specifies which kind of reset to use in sequential processes." :type '(choice (const :tag "None" none) (const :tag "Synchronous" sync) @@ -2125,7 +2126,6 @@ your style, only those that are different from the default.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; mandatory -(require 'assoc) (require 'compile) ; XEmacs (require 'easymenu) (require 'hippie-exp) @@ -2137,6 +2137,73 @@ your style, only those that are different from the default.") (require 'ps-print) (require 'speedbar))) ; for speedbar-with-writable +;; functions from obsolete assoc.el package (obsoleted in GNU Emacs 24.3) +(defun vhdl-asort (alist-symbol key) + "Move a specified key-value pair to the head of an alist. +The alist is referenced by ALIST-SYMBOL. Key-value pair to move to +head is one matching KEY. Returns the sorted list and doesn't affect +the order of any other key-value pair. Side effect sets alist to new +sorted list." + (set alist-symbol + (sort (copy-alist (symbol-value alist-symbol)) + (lambda (a _b) (equal (car a) key))))) + +(defun vhdl-anot-head-p (alist key) + "Find out if a specified key-value pair is not at the head of an alist. +The alist to check is specified by ALIST and the key-value pair is the +one matching the supplied KEY. Returns nil if ALIST is nil, or if +key-value pair is at the head of the alist. Returns t if key-value +pair is not at the head of alist. ALIST is not altered." + (not (equal (car (car alist)) key))) + +(defun vhdl-aput (alist-symbol key &optional value) + "Insert a key-value pair into an alist. +The alist is referenced by ALIST-SYMBOL. The key-value pair is made +from KEY and optionally, VALUE. Returns the altered alist. + +If the key-value pair referenced by KEY can be found in the alist, and +VALUE is supplied non-nil, then the value of KEY will be set to VALUE. +If VALUE is not supplied, or is nil, the key-value pair will not be +modified, but will be moved to the head of the alist. If the key-value +pair cannot be found in the alist, it will be inserted into the head +of the alist (with value nil if VALUE is nil or not supplied)." + (let ((elem (list (cons key value))) + alist) + (vhdl-asort alist-symbol key) + (setq alist (symbol-value alist-symbol)) + (cond ((null alist) (set alist-symbol elem)) + ((vhdl-anot-head-p alist key) (set alist-symbol (nconc elem alist))) + (value (setcar alist (car elem)) alist) + (t alist)))) + +(defun vhdl-adelete (alist-symbol key) + "Delete a key-value pair from the alist. +Alist is referenced by ALIST-SYMBOL and the key-value pair to remove +is pair matching KEY. Returns the altered alist." + (vhdl-asort alist-symbol key) + (let ((alist (symbol-value alist-symbol))) + (cond ((null alist) nil) + ((vhdl-anot-head-p alist key) alist) + (t (set alist-symbol (cdr alist)))))) + +(defun vhdl-aget (alist key &optional keynil-p) + "Return the value in ALIST that is associated with KEY. +Optional KEYNIL-P describes what to do if the value associated with +KEY is nil. If KEYNIL-P is not supplied or is nil, and the value is +nil, then KEY is returned. If KEYNIL-P is non-nil, then nil would be +returned. + +If no key-value pair matching KEY could be found in ALIST, or ALIST is +nil then nil is returned. ALIST is not altered." + (let ((copy (copy-alist alist))) + (cond ((null alist) nil) + ((progn (vhdl-asort 'copy key) + (vhdl-anot-head-p copy key)) nil) + ((cdr (car copy))) + (keynil-p nil) + ((car (car copy))) + (t nil)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Compatibility @@ -2256,7 +2323,6 @@ Ignore byte-compiler warnings you might see." "Wait until idle, then run FUNCTION." (if (fboundp 'start-itimer) (start-itimer "vhdl-mode" function secs repeat t) -; (run-with-idle-timer secs repeat function))) ;; explicitly activate timer (necessary when Emacs is already idle) (aset (run-with-idle-timer secs repeat function) 0 nil))) @@ -2429,7 +2495,7 @@ specified." current buffer if no project is defined." (if (vhdl-project-p) (expand-file-name (vhdl-resolve-env-variable - (nth 1 (aget vhdl-project-alist vhdl-project)))) + (nth 1 (vhdl-aget vhdl-project-alist vhdl-project)))) default-directory)) (defmacro vhdl-prepare-search-1 (&rest body) @@ -2537,11 +2603,11 @@ conversion." (setq file-list (cdr file-list))) dir-list)) -(defun vhdl-aput (alist-symbol key &optional value) +(defun vhdl-aput-delete-if-nil (alist-symbol key &optional value) "As `aput', but delete key-value pair if VALUE is nil." (if value - (aput alist-symbol key value) - (adelete alist-symbol key))) + (vhdl-aput alist-symbol key value) + (vhdl-adelete alist-symbol key))) (defun vhdl-delete (elt list) "Delete by side effect the first occurrence of ELT as a member of LIST." @@ -2596,11 +2662,6 @@ conversion." (set-buffer (marker-buffer marker))) (goto-char marker)) -(defun vhdl-goto-line (line) - "Use this instead of calling user level function `goto-line'." - (goto-char (point-min)) - (forward-line (1- line))) - (defun vhdl-menu-split (list title) "Split menu LIST into several submenus, if number of elements > `vhdl-menu-max-size'." @@ -2975,7 +3036,7 @@ STRING are replaced by `-' and substrings are converted to lower case." (make-variable-buffer-local 'vhdl-syntactic-context) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Abbrev ook bindings +;; Abbrev hook bindings (defvar vhdl-mode-abbrev-table nil "Abbrev table to use in `vhdl-mode' buffers.") @@ -2985,8 +3046,10 @@ STRING are replaced by `-' and substrings are converted to lower case." (define-abbrev-table 'vhdl-mode-abbrev-table (append (when (memq 'vhdl vhdl-electric-keywords) - ;; VHDL'93 keywords - (mapcar (lambda (x) (list (car x) "" (cdr x) 0 'system)) + ;; VHDL'02 keywords + (mapcar (if (featurep 'xemacs) + (lambda (x) (list (car x) "" (cdr x) 0)) + (lambda (x) (list (car x) "" (cdr x) 0 'system))) '( ("--" . vhdl-template-display-comment-hook) ("abs" . vhdl-template-default-hook) @@ -3102,7 +3165,9 @@ STRING are replaced by `-' and substrings are converted to lower case." ))) ;; VHDL-AMS keywords (when (and (memq 'vhdl vhdl-electric-keywords) (vhdl-standard-p 'ams)) - (mapcar (lambda (x) (list (car x) "" (cdr x) 0 'system)) + (mapcar (if (featurep 'xemacs) + (lambda (x) (list (car x) "" (cdr x) 0)) + (lambda (x) (list (car x) "" (cdr x) 0 'system))) '( ("across" . vhdl-template-default-hook) ("break" . vhdl-template-break-hook) @@ -4822,7 +4887,7 @@ Key bindings: ;; set local variables (set (make-local-variable 'paragraph-start) - "\\s-*\\(--+\\s-*$\\|[^ -]\\|$\\)") + "\\s-*\\(--+\\s-*$\\|$\\)") (set (make-local-variable 'paragraph-separate) paragraph-start) (set (make-local-variable 'paragraph-ignore-fill-prefix) t) (set (make-local-variable 'parse-sexp-ignore-comments) t) @@ -4860,9 +4925,7 @@ Key bindings: (set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode) (set (make-local-variable 'lazy-lock-defer-contextually) nil) (set (make-local-variable 'lazy-lock-defer-on-the-fly) t) -; (set (make-local-variable 'lazy-lock-defer-time) 0.1) (set (make-local-variable 'lazy-lock-defer-on-scrolling) t)) -; (turn-on-font-lock) ;; variables for source file compilation (when vhdl-compile-use-local-error-regexp @@ -7566,7 +7629,6 @@ indentation is done before aligning." (setq end (point-marker)) (goto-char begin) (setq bol (setq begin (progn (beginning-of-line) (point)))) -; (untabify bol end) (when indent (indent-region bol end nil)))) (let ((copy (copy-alist alignment-list))) @@ -7962,7 +8024,6 @@ end of line, do nothing in comments and strings." (and (looking-at "\\s-+") (re-search-forward "\\s-+" end t) (progn (replace-match " " nil nil) t)) (and (looking-at "-") (re-search-forward "-" end t)) -; (re-search-forward "[^ \t-]+" end t)))) (re-search-forward "[^ \t\"-]+" end t)))) (unless no-message (message "Fixing up whitespace...done"))) @@ -8080,7 +8141,7 @@ Currently supported keywords: 'begin', 'if'." (while (re-search-forward "\\<\\(for\\|if\\)\\>" end t) (goto-char (match-end 1)) (setq point (point-marker)) - ;; exception: in literal or preceded by `end' or label + ;; exception: in literal or preceded by `end', `wait' or label (when (and (not (save-excursion (goto-char (match-beginning 1)) (vhdl-in-literal))) (save-excursion @@ -8089,7 +8150,7 @@ Currently supported keywords: 'begin', 'if'." (and (re-search-forward "^\\s-*\\([^ \t\n].*\\)" (match-beginning 1) t) (not (string-match - "\\(\\<end\\>\\|\\<wait\\>\\|\\w+\\s-*:\\)\\s-*$" + "\\(\\<end\\>\\|\\<wait .*\\|\\w+\\s-*:\\)\\s-*$" (match-string 1))))))) (goto-char (match-beginning 1)) (insert "\n") @@ -8138,10 +8199,12 @@ case fixing to a region. Calls functions `vhdl-indent-buffer', (when (nth 0 vhdl-beautify-options) (vhdl-fixup-whitespace-region beg end t)) (when (nth 1 vhdl-beautify-options) (vhdl-fix-statement-region beg end)) (when (nth 2 vhdl-beautify-options) (vhdl-indent-region beg end)) - (let ((vhdl-align-groups t)) - (when (nth 3 vhdl-beautify-options) (vhdl-align-region beg end))) + (when (nth 3 vhdl-beautify-options) + (let ((vhdl-align-groups t)) (vhdl-align-region beg end))) (when (nth 4 vhdl-beautify-options) (vhdl-fix-case-region beg end)) - (when (nth 0 vhdl-beautify-options) (vhdl-remove-trailing-spaces-region beg end))) + (when (nth 0 vhdl-beautify-options) + (vhdl-remove-trailing-spaces-region beg end) + (if vhdl-indent-tabs-mode (tabify beg end) (untabify beg end)))) (defun vhdl-beautify-buffer () "Beautify buffer by applying indentation, whitespace fixup, alignment, and @@ -8447,11 +8510,11 @@ buffer." (setq beg (point)))))) ;; search for signals declared in surrounding block declarative parts (save-excursion - (while (and (progn (while (and (setq beg (re-search-backward "^\\s-*\\(\\w+\\s-*:\\s-*block\\|\\(end\\)\\s-+block\\)\\>" nil t)) - (match-string 2)) - (goto-char (match-end 2)) + (while (and (progn (while (and (setq beg (re-search-backward "^\\s-*\\(\\w+\\s-*:\\s-*\\(block\\|\\(for\\|if\\).*\\<generate\\>\\)\\|\\(end\\)\\s-+block\\)\\>" nil t)) + (match-string 4)) + (goto-char (match-end 4)) (vhdl-backward-sexp) - (re-search-backward "^\\s-*\\w+\\s-*:\\s-*block\\>" nil t)) + (re-search-backward "^\\s-*\\w+\\s-*:\\s-*\\(block\\|generate\\)\\>" nil t)) beg) (setq end (re-search-forward "^\\s-*begin\\>" nil t))) ;; scan for all declared signal names @@ -8548,7 +8611,8 @@ Used for undoing after template abortion.") "Return the working library name of the current project or \"work\" if no project is defined." (vhdl-resolve-env-variable - (or (nth 6 (aget vhdl-project-alist vhdl-project)) vhdl-default-library))) + (or (nth 6 (vhdl-aget vhdl-project-alist vhdl-project)) + vhdl-default-library))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Enabling/disabling @@ -8966,8 +9030,6 @@ since these are almost equivalent)." (interactive) (when (vhdl-template-field "target signal") (insert " <= ") -; (if (not (equal (vhdl-template-field "[GUARDED] [TRANSPORT]") "")) -; (insert " ")) (let ((margin (current-column)) (start (point)) position) @@ -9903,7 +9965,7 @@ otherwise." (defun vhdl-template-record (kind &optional name secondary) "Insert a record type declaration." (interactive) - (let ((margin (current-column)) + (let ((margin (current-indentation)) (start (point)) (first t)) (vhdl-insert-keyword "RECORD\n") @@ -9965,7 +10027,6 @@ otherwise." (insert "\n") (indent-to (+ margin vhdl-basic-offset)) (vhdl-template-field "target signal" " <= ") -; (vhdl-template-field "[GUARDED] [TRANSPORT]") (insert "\n") (indent-to (+ margin vhdl-basic-offset)) (vhdl-template-field "waveform") @@ -10466,8 +10527,10 @@ specification, if not already there." (defun vhdl-template-replace-header-keywords (beg end &optional file-title is-model) "Replace keywords in header and footer." - (let ((project-title (or (nth 0 (aget vhdl-project-alist vhdl-project)) "")) - (project-desc (or (nth 9 (aget vhdl-project-alist vhdl-project)) "")) + (let ((project-title (or (nth 0 (vhdl-aget vhdl-project-alist vhdl-project)) + "")) + (project-desc (or (nth 9 (vhdl-aget vhdl-project-alist vhdl-project)) + "")) pos) (vhdl-prepare-search-2 (save-excursion @@ -10525,9 +10588,9 @@ specification, if not already there." (replace-match file-title t t)) (goto-char beg)) (let (string) - (while - (re-search-forward "<\\(\\(\\w\\|\\s_\\)*\\) string>" end t) - (setq string (read-string (concat (match-string 1) ": "))) + (while (re-search-forward "<\\(\\(\\w\\|\\s_\\)*\\) string>" end t) + (save-match-data + (setq string (read-string (concat (match-string 1) ": ")))) (replace-match string t t))) (goto-char beg) (when (and (not is-model) (search-forward "<cursor>" end t)) @@ -10635,14 +10698,7 @@ If starting after end-comment-column, start a new line." (if (not (or (and string (progn (insert string) t)) (vhdl-template-field "[comment]" nil t))) (delete-region position (point)) - (while (= (preceding-char) ?\ ) (delete-char -1)) - ;; (when (> (current-column) end-comment-column) - ;; (setq position (point-marker)) - ;; (re-search-backward "-- ") - ;; (insert "\n") - ;; (indent-to comment-column) - ;; (goto-char position)) - )))) + (while (= (preceding-char) ?\ ) (delete-char -1)))))) (defun vhdl-comment-block () "Insert comment for code block." @@ -10882,8 +10938,6 @@ Point is left between them." (defun vhdl-template-generate-body (margin label) "Insert body for generate template." (vhdl-insert-keyword " GENERATE") -; (if (not (vhdl-standard-p '87)) -; (vhdl-template-begin-end "GENERATE" label margin) (insert "\n\n") (indent-to margin) (vhdl-insert-keyword "END GENERATE ") @@ -11670,7 +11724,6 @@ reflected in a subsequent paste operation." comment group-comment)))) ;; parse group comment and spacing (setq group-comment (vhdl-parse-group-comment)))) -; (vhdl-parse-string "end\\>") ;; parse context clause (setq context-clause (vhdl-scan-context-clause)) ; ;; add surrounding package to context clause @@ -12622,7 +12675,6 @@ reflected in a subsequent paste operation." (while (and he-expand-list (or (not (stringp (car he-expand-list))) (he-string-member (car he-expand-list) he-tried-table t))) -; (equal (car he-expand-list) he-search-string))) (unless (stringp (car he-expand-list)) (setq vhdl-expand-upper-case (car he-expand-list))) (setq he-expand-list (cdr he-expand-list))) @@ -12908,8 +12960,8 @@ File statistics: \"%s\"\n\ ";; project name\n" "(setq vhdl-project \"" vhdl-project "\")\n\n" ";; project setup\n" - "(aput 'vhdl-project-alist vhdl-project\n'") - (pp (aget vhdl-project-alist vhdl-project) (current-buffer)) + "(vhdl-aput 'vhdl-project-alist vhdl-project\n'") + (pp (vhdl-aget vhdl-project-alist vhdl-project) (current-buffer)) (insert ")\n") (save-buffer) (kill-buffer (current-buffer)) @@ -12929,8 +12981,8 @@ File statistics: \"%s\"\n\ (condition-case () (let ((current-project vhdl-project)) (load-file file-name) - (when (/= (length (aget vhdl-project-alist vhdl-project t)) 10) - (adelete 'vhdl-project-alist vhdl-project) + (when (/= (length (vhdl-aget vhdl-project-alist vhdl-project t)) 10) + (vhdl-adelete 'vhdl-project-alist vhdl-project) (error "")) (when not-make-current (setq vhdl-project current-project)) @@ -12946,7 +12998,7 @@ File statistics: \"%s\"\n\ "Duplicate setup of current project." (interactive) (let ((new-name (read-from-minibuffer "New project name: ")) - (project-entry (aget vhdl-project-alist vhdl-project t))) + (project-entry (vhdl-aget vhdl-project-alist vhdl-project t))) (setq vhdl-project-alist (append vhdl-project-alist (list (cons new-name project-entry)))) @@ -13275,7 +13327,6 @@ This does highlighting of keywords and standard identifiers.") (skip-syntax-backward " ") (skip-syntax-backward "w_") (skip-syntax-backward " "))) -; (skip-chars-backward "^-(\n\";") (goto-char (match-end 1)) (1 font-lock-variable-name-face))) ;; highlight formal parameters in component instantiations and subprogram @@ -13676,8 +13727,6 @@ hierarchy otherwise.") non-final) "Scan contents of VHDL files in directory or file pattern NAME." (string-match "\\(.*[/\\]\\)\\(.*\\)" name) -; (unless (file-directory-p (match-string 1 name)) -; (message "No such directory: \"%s\"" (match-string 1 name))) (let* ((dir-name (match-string 1 name)) (file-pattern (match-string 2 name)) (is-directory (= 0 (length file-pattern))) @@ -13690,18 +13739,18 @@ hierarchy otherwise.") dir-name t (wildcard-to-regexp file-pattern))))) (key (or project dir-name)) (file-exclude-regexp - (or (nth 3 (aget vhdl-project-alist project)) "")) + (or (nth 3 (vhdl-aget vhdl-project-alist project)) "")) (limit-design-file-size (nth 0 vhdl-speedbar-scan-limit)) (limit-hier-file-size (nth 0 (nth 1 vhdl-speedbar-scan-limit))) (limit-hier-inst-no (nth 1 (nth 1 vhdl-speedbar-scan-limit))) ent-alist conf-alist pack-alist ent-inst-list file-alist tmp-list tmp-entry no-files files-exist big-files) (when (or project update) - (setq ent-alist (aget vhdl-entity-alist key t) - conf-alist (aget vhdl-config-alist key t) - pack-alist (aget vhdl-package-alist key t) - ent-inst-list (car (aget vhdl-ent-inst-alist key t)) - file-alist (aget vhdl-file-alist key t))) + (setq ent-alist (vhdl-aget vhdl-entity-alist key t) + conf-alist (vhdl-aget vhdl-config-alist key t) + pack-alist (vhdl-aget vhdl-package-alist key t) + ent-inst-list (car (vhdl-aget vhdl-ent-inst-alist key t)) + file-alist (vhdl-aget vhdl-file-alist key t))) (when (and (not is-directory) (null file-list)) (message "No such file: \"%s\"" name)) (setq files-exist file-list) @@ -13743,7 +13792,7 @@ hierarchy otherwise.") (while (re-search-forward "^[ \t]*entity[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t) (let* ((ent-name (match-string-no-properties 1)) (ent-key (downcase ent-name)) - (ent-entry (aget ent-alist ent-key t)) + (ent-entry (vhdl-aget ent-alist ent-key t)) (lib-alist (vhdl-scan-context-clause))) (if (nth 1 ent-entry) (vhdl-warning-when-idle @@ -13751,10 +13800,10 @@ hierarchy otherwise.") ent-name (nth 1 ent-entry) (nth 2 ent-entry) file-name (vhdl-current-line)) (push ent-key ent-list) - (aput 'ent-alist ent-key - (list ent-name file-name (vhdl-current-line) - (nth 3 ent-entry) (nth 4 ent-entry) - lib-alist))))) + (vhdl-aput 'ent-alist ent-key + (list ent-name file-name (vhdl-current-line) + (nth 3 ent-entry) (nth 4 ent-entry) + lib-alist))))) ;; scan for architectures (goto-char (point-min)) (while (re-search-forward "^[ \t]*architecture[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t) @@ -13762,9 +13811,9 @@ hierarchy otherwise.") (arch-key (downcase arch-name)) (ent-name (match-string-no-properties 2)) (ent-key (downcase ent-name)) - (ent-entry (aget ent-alist ent-key t)) + (ent-entry (vhdl-aget ent-alist ent-key t)) (arch-alist (nth 3 ent-entry)) - (arch-entry (aget arch-alist arch-key t)) + (arch-entry (vhdl-aget arch-alist arch-key t)) (lib-arch-alist (vhdl-scan-context-clause))) (if arch-entry (vhdl-warning-when-idle @@ -13773,20 +13822,20 @@ hierarchy otherwise.") (nth 2 arch-entry) file-name (vhdl-current-line)) (setq arch-list (cons arch-key arch-list) arch-ent-list (cons ent-key arch-ent-list)) - (aput 'arch-alist arch-key - (list arch-name file-name (vhdl-current-line) nil - lib-arch-alist)) - (aput 'ent-alist ent-key - (list (or (nth 0 ent-entry) ent-name) - (nth 1 ent-entry) (nth 2 ent-entry) - (vhdl-sort-alist arch-alist) - arch-key (nth 5 ent-entry)))))) + (vhdl-aput 'arch-alist arch-key + (list arch-name file-name (vhdl-current-line) + nil lib-arch-alist)) + (vhdl-aput 'ent-alist ent-key + (list (or (nth 0 ent-entry) ent-name) + (nth 1 ent-entry) (nth 2 ent-entry) + (vhdl-sort-alist arch-alist) + arch-key (nth 5 ent-entry)))))) ;; scan for configurations (goto-char (point-min)) (while (re-search-forward "^[ \t]*configuration[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t) (let* ((conf-name (match-string-no-properties 1)) (conf-key (downcase conf-name)) - (conf-entry (aget conf-alist conf-key t)) + (conf-entry (vhdl-aget conf-alist conf-key t)) (ent-name (match-string-no-properties 2)) (ent-key (downcase ent-name)) (lib-alist (vhdl-scan-context-clause)) @@ -13827,16 +13876,16 @@ hierarchy otherwise.") inst-lib-key) comp-conf-list)) (setq inst-key-list (cdr inst-key-list))))) - (aput 'conf-alist conf-key - (list conf-name file-name conf-line ent-key - arch-key comp-conf-list lib-alist))))) + (vhdl-aput 'conf-alist conf-key + (list conf-name file-name conf-line ent-key + arch-key comp-conf-list lib-alist))))) ;; scan for packages (goto-char (point-min)) (while (re-search-forward "^[ \t]*package[ \t\n\r\f]+\\(body[ \t\n\r\f]+\\)?\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t) (let* ((pack-name (match-string-no-properties 2)) (pack-key (downcase pack-name)) (is-body (match-string-no-properties 1)) - (pack-entry (aget pack-alist pack-key t)) + (pack-entry (vhdl-aget pack-alist pack-key t)) (pack-line (vhdl-current-line)) (end-of-unit (vhdl-get-end-of-unit)) comp-name func-name comp-alist func-alist lib-alist) @@ -13867,7 +13916,7 @@ hierarchy otherwise.") (if is-body (push pack-key pack-body-list) (push pack-key pack-list)) - (aput + (vhdl-aput 'pack-alist pack-key (if is-body (list (or (nth 0 pack-entry) pack-name) @@ -13891,9 +13940,9 @@ hierarchy otherwise.") (ent-key (downcase ent-name)) (arch-name (match-string-no-properties 1)) (arch-key (downcase arch-name)) - (ent-entry (aget ent-alist ent-key t)) + (ent-entry (vhdl-aget ent-alist ent-key t)) (arch-alist (nth 3 ent-entry)) - (arch-entry (aget arch-alist arch-key t)) + (arch-entry (vhdl-aget arch-alist arch-key t)) (beg-of-unit (point)) (end-of-unit (vhdl-get-end-of-unit)) (inst-no 0) @@ -13907,7 +13956,10 @@ hierarchy otherwise.") "\\(\\(for\\|if\\)\\>[^;:]+\\<generate\\>\\|block\\>\\)\\)\\|" "\\(^[ \t]*end[ \t\n\r\f]+\\(generate\\|block\\)\\>\\)") end-of-unit t) (or (not limit-hier-inst-no) - (<= (setq inst-no (1+ inst-no)) + (<= (if (or (match-string 14) + (match-string 16)) + inst-no + (setq inst-no (1+ inst-no))) limit-hier-inst-no))) (cond ;; block/generate beginning found @@ -13988,23 +14040,25 @@ hierarchy otherwise.") (setcar tmp-inst-alist inst-entry)) (setq tmp-inst-alist (cdr tmp-inst-alist))))) ;; save in cache - (aput 'arch-alist arch-key - (list (nth 0 arch-entry) (nth 1 arch-entry) - (nth 2 arch-entry) inst-alist - (nth 4 arch-entry))) - (aput 'ent-alist ent-key - (list (nth 0 ent-entry) (nth 1 ent-entry) - (nth 2 ent-entry) (vhdl-sort-alist arch-alist) - (nth 4 ent-entry) (nth 5 ent-entry))) + (vhdl-aput 'arch-alist arch-key + (list (nth 0 arch-entry) (nth 1 arch-entry) + (nth 2 arch-entry) inst-alist + (nth 4 arch-entry))) + (vhdl-aput 'ent-alist ent-key + (list (nth 0 ent-entry) (nth 1 ent-entry) + (nth 2 ent-entry) + (vhdl-sort-alist arch-alist) + (nth 4 ent-entry) (nth 5 ent-entry))) (when (and limit-hier-inst-no (> inst-no limit-hier-inst-no)) (message "WARNING: Scan limit (hierarchy: instances per architecture) reached in file:\n \"%s\"" file-name) (setq big-files t)) (goto-char end-of-unit)))) ;; remember design units for this file - (aput 'file-alist file-name - (list ent-list arch-list arch-ent-list conf-list - pack-list pack-body-list inst-list inst-ent-list)) + (vhdl-aput 'file-alist file-name + (list ent-list arch-list arch-ent-list conf-list + pack-list pack-body-list + inst-list inst-ent-list)) (setq ent-inst-list (append inst-ent-list ent-inst-list)))))) (setq file-list (cdr file-list)))) (when (or (and (not project) files-exist) @@ -14023,8 +14077,8 @@ hierarchy otherwise.") ;; check whether configuration has a corresponding entity/architecture (setq tmp-list conf-alist) (while tmp-list - (if (setq tmp-entry (aget ent-alist (nth 4 (car tmp-list)) t)) - (unless (aget (nth 3 tmp-entry) (nth 5 (car tmp-list)) t) + (if (setq tmp-entry (vhdl-aget ent-alist (nth 4 (car tmp-list)) t)) + (unless (vhdl-aget (nth 3 tmp-entry) (nth 5 (car tmp-list)) t) (setq tmp-entry (car tmp-list)) (vhdl-warning-when-idle "Configuration of non-existing architecture: \"%s\" of \"%s(%s)\"\n in \"%s\" (line %d)" @@ -14053,17 +14107,17 @@ hierarchy otherwise.") (add-to-list 'vhdl-updated-project-list (or project dir-name))) ;; clear directory alists (unless project - (adelete 'vhdl-entity-alist key) - (adelete 'vhdl-config-alist key) - (adelete 'vhdl-package-alist key) - (adelete 'vhdl-ent-inst-alist key) - (adelete 'vhdl-file-alist key)) + (vhdl-adelete 'vhdl-entity-alist key) + (vhdl-adelete 'vhdl-config-alist key) + (vhdl-adelete 'vhdl-package-alist key) + (vhdl-adelete 'vhdl-ent-inst-alist key) + (vhdl-adelete 'vhdl-file-alist key)) ;; put directory contents into cache - (aput 'vhdl-entity-alist key ent-alist) - (aput 'vhdl-config-alist key conf-alist) - (aput 'vhdl-package-alist key pack-alist) - (aput 'vhdl-ent-inst-alist key (list ent-inst-list)) - (aput 'vhdl-file-alist key file-alist) + (vhdl-aput 'vhdl-entity-alist key ent-alist) + (vhdl-aput 'vhdl-config-alist key conf-alist) + (vhdl-aput 'vhdl-package-alist key pack-alist) + (vhdl-aput 'vhdl-ent-inst-alist key (list ent-inst-list)) + (vhdl-aput 'vhdl-file-alist key file-alist) ;; final messages (message "Scanning %s %s\"%s\"...done" (if is-directory "directory" "files") (or num-string "") name) @@ -14079,18 +14133,18 @@ hierarchy otherwise.") (defun vhdl-scan-project-contents (project) "Scan the contents of all VHDL files found in the directories and files of PROJECT." - (let ((dir-list (or (nth 2 (aget vhdl-project-alist project)) '(""))) + (let ((dir-list (or (nth 2 (vhdl-aget vhdl-project-alist project)) '(""))) (default-dir (vhdl-resolve-env-variable - (nth 1 (aget vhdl-project-alist project)))) + (nth 1 (vhdl-aget vhdl-project-alist project)))) (file-exclude-regexp - (or (nth 3 (aget vhdl-project-alist project)) "")) + (or (nth 3 (vhdl-aget vhdl-project-alist project)) "")) dir-list-tmp dir dir-name num-dir act-dir recursive) ;; clear project alists - (adelete 'vhdl-entity-alist project) - (adelete 'vhdl-config-alist project) - (adelete 'vhdl-package-alist project) - (adelete 'vhdl-ent-inst-alist project) - (adelete 'vhdl-file-alist project) + (vhdl-adelete 'vhdl-entity-alist project) + (vhdl-adelete 'vhdl-config-alist project) + (vhdl-adelete 'vhdl-package-alist project) + (vhdl-adelete 'vhdl-ent-inst-alist project) + (vhdl-adelete 'vhdl-file-alist project) ;; expand directory names by default-directory (message "Collecting source files...") (while dir-list @@ -14137,7 +14191,7 @@ of PROJECT." (add-to-list 'dir-list-tmp (file-name-directory dir-name)) (setq dir-list (cdr dir-list) act-dir (1+ act-dir))) - (aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp))) + (vhdl-aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp))) (message "Scanning project \"%s\"...done" project))) (defun vhdl-update-file-contents (file-name) @@ -14150,13 +14204,16 @@ of PROJECT." (when (member dir-name (nth 1 (car directory-alist))) (let* ((vhdl-project (nth 0 (car directory-alist))) (project (vhdl-project-p)) - (ent-alist (aget vhdl-entity-alist (or project dir-name) t)) - (conf-alist (aget vhdl-config-alist (or project dir-name) t)) - (pack-alist (aget vhdl-package-alist (or project dir-name) t)) - (ent-inst-list (car (aget vhdl-ent-inst-alist + (ent-alist (vhdl-aget vhdl-entity-alist + (or project dir-name) t)) + (conf-alist (vhdl-aget vhdl-config-alist + (or project dir-name) t)) + (pack-alist (vhdl-aget vhdl-package-alist + (or project dir-name) t)) + (ent-inst-list (car (vhdl-aget vhdl-ent-inst-alist (or project dir-name) t))) - (file-alist (aget vhdl-file-alist (or project dir-name) t)) - (file-entry (aget file-alist file-name t)) + (file-alist (vhdl-aget vhdl-file-alist (or project dir-name) t)) + (file-entry (vhdl-aget file-alist file-name t)) (ent-list (nth 0 file-entry)) (arch-list (nth 1 file-entry)) (arch-ent-list (nth 2 file-entry)) @@ -14170,57 +14227,57 @@ of PROJECT." ;; entities (while ent-list (setq key (car ent-list) - entry (aget ent-alist key t)) + entry (vhdl-aget ent-alist key t)) (when (equal file-name (nth 1 entry)) (if (nth 3 entry) - (aput 'ent-alist key - (list (nth 0 entry) nil nil (nth 3 entry) nil)) - (adelete 'ent-alist key))) + (vhdl-aput 'ent-alist key + (list (nth 0 entry) nil nil (nth 3 entry) nil)) + (vhdl-adelete 'ent-alist key))) (setq ent-list (cdr ent-list))) ;; architectures (while arch-list (setq key (car arch-list) ent-key (car arch-ent-list) - entry (aget ent-alist ent-key t) + entry (vhdl-aget ent-alist ent-key t) arch-alist (nth 3 entry)) - (when (equal file-name (nth 1 (aget arch-alist key t))) - (adelete 'arch-alist key) + (when (equal file-name (nth 1 (vhdl-aget arch-alist key t))) + (vhdl-adelete 'arch-alist key) (if (or (nth 1 entry) arch-alist) - (aput 'ent-alist ent-key - (list (nth 0 entry) (nth 1 entry) (nth 2 entry) - arch-alist (nth 4 entry) (nth 5 entry))) - (adelete 'ent-alist ent-key))) + (vhdl-aput 'ent-alist ent-key + (list (nth 0 entry) (nth 1 entry) (nth 2 entry) + arch-alist (nth 4 entry) (nth 5 entry))) + (vhdl-adelete 'ent-alist ent-key))) (setq arch-list (cdr arch-list) arch-ent-list (cdr arch-ent-list))) ;; configurations (while conf-list (setq key (car conf-list)) - (when (equal file-name (nth 1 (aget conf-alist key t))) - (adelete 'conf-alist key)) + (when (equal file-name (nth 1 (vhdl-aget conf-alist key t))) + (vhdl-adelete 'conf-alist key)) (setq conf-list (cdr conf-list))) ;; package declarations (while pack-list (setq key (car pack-list) - entry (aget pack-alist key t)) + entry (vhdl-aget pack-alist key t)) (when (equal file-name (nth 1 entry)) (if (nth 6 entry) - (aput 'pack-alist key - (list (nth 0 entry) nil nil nil nil nil - (nth 6 entry) (nth 7 entry) (nth 8 entry) - (nth 9 entry))) - (adelete 'pack-alist key))) + (vhdl-aput 'pack-alist key + (list (nth 0 entry) nil nil nil nil nil + (nth 6 entry) (nth 7 entry) (nth 8 entry) + (nth 9 entry))) + (vhdl-adelete 'pack-alist key))) (setq pack-list (cdr pack-list))) ;; package bodies (while pack-body-list (setq key (car pack-body-list) - entry (aget pack-alist key t)) + entry (vhdl-aget pack-alist key t)) (when (equal file-name (nth 6 entry)) (if (nth 1 entry) - (aput 'pack-alist key - (list (nth 0 entry) (nth 1 entry) (nth 2 entry) - (nth 3 entry) (nth 4 entry) (nth 5 entry) - nil nil nil nil)) - (adelete 'pack-alist key))) + (vhdl-aput 'pack-alist key + (list (nth 0 entry) (nth 1 entry) (nth 2 entry) + (nth 3 entry) (nth 4 entry) (nth 5 entry) + nil nil nil nil)) + (vhdl-adelete 'pack-alist key))) (setq pack-body-list (cdr pack-body-list))) ;; instantiated entities (while inst-ent-list @@ -14228,10 +14285,10 @@ of PROJECT." (vhdl-delete (car inst-ent-list) ent-inst-list)) (setq inst-ent-list (cdr inst-ent-list))) ;; update caches - (vhdl-aput 'vhdl-entity-alist cache-key ent-alist) - (vhdl-aput 'vhdl-config-alist cache-key conf-alist) - (vhdl-aput 'vhdl-package-alist cache-key pack-alist) - (vhdl-aput 'vhdl-ent-inst-alist cache-key (list ent-inst-list)) + (vhdl-aput-delete-if-nil 'vhdl-entity-alist cache-key ent-alist) + (vhdl-aput-delete-if-nil 'vhdl-config-alist cache-key conf-alist) + (vhdl-aput-delete-if-nil 'vhdl-package-alist cache-key pack-alist) + (vhdl-aput-delete-if-nil 'vhdl-ent-inst-alist cache-key (list ent-inst-list)) ;; scan file (vhdl-scan-directory-contents file-name project t) (when (or (and vhdl-speedbar-show-projects project) @@ -14264,8 +14321,8 @@ of PROJECT." &optional include-top ent-hier) "Get instantiation hierarchy beginning in architecture ARCH-KEY of entity ENT-KEY." - (let* ((ent-entry (aget ent-alist ent-key t)) - (arch-entry (if arch-key (aget (nth 3 ent-entry) arch-key t) + (let* ((ent-entry (vhdl-aget ent-alist ent-key t)) + (arch-entry (if arch-key (vhdl-aget (nth 3 ent-entry) arch-key t) (cdar (last (nth 3 ent-entry))))) (inst-alist (nth 3 arch-entry)) inst-entry inst-ent-entry inst-arch-entry inst-conf-entry comp-entry @@ -14276,9 +14333,6 @@ entity ENT-KEY." (setq level (1+ level))) (when (member ent-key ent-hier) (error "ERROR: Instantiation loop detected, component instantiates itself: \"%s\"" ent-key)) - ;; check configured architecture (already checked during scanning) -; (unless (or (null conf-inst-alist) (assoc arch-key (nth 3 ent-entry))) -; (vhdl-warning-when-idle "Configuration for non-existing architecture used: \"%s\"" conf-key)) ;; process all instances (while inst-alist (setq inst-entry (car inst-alist) @@ -14294,27 +14348,27 @@ entity ENT-KEY." (downcase (or inst-comp-name "")))))) (setq tmp-list (cdr tmp-list))) (setq inst-conf-key (or (nth 4 (car tmp-list)) inst-conf-key)) - (setq inst-conf-entry (aget conf-alist inst-conf-key t)) + (setq inst-conf-entry (vhdl-aget conf-alist inst-conf-key t)) (when (and inst-conf-key (not inst-conf-entry)) (vhdl-warning-when-idle "Configuration not found: \"%s\"" inst-conf-key)) ;; determine entity (setq inst-ent-key (or (nth 2 (car tmp-list)) ; from configuration (nth 3 inst-conf-entry) ; from subconfiguration - (nth 3 (aget conf-alist (nth 7 inst-entry) t)) + (nth 3 (vhdl-aget conf-alist (nth 7 inst-entry) t)) ; from configuration spec. (nth 5 inst-entry))) ; from direct instantiation - (setq inst-ent-entry (aget ent-alist inst-ent-key t)) + (setq inst-ent-entry (vhdl-aget ent-alist inst-ent-key t)) ;; determine architecture (setq inst-arch-key (or (nth 3 (car tmp-list)) ; from configuration (nth 4 inst-conf-entry) ; from subconfiguration (nth 6 inst-entry) ; from direct instantiation - (nth 4 (aget conf-alist (nth 7 inst-entry))) + (nth 4 (vhdl-aget conf-alist (nth 7 inst-entry))) ; from configuration spec. (nth 4 inst-ent-entry) ; MRA (caar (nth 3 inst-ent-entry)))) ; first alphabetically - (setq inst-arch-entry (aget (nth 3 inst-ent-entry) inst-arch-key t)) + (setq inst-arch-entry (vhdl-aget (nth 3 inst-ent-entry) inst-arch-key t)) ;; set library (setq inst-lib-key (or (nth 5 (car tmp-list)) ; from configuration @@ -14353,7 +14407,8 @@ entity ENT-KEY." (defun vhdl-get-instantiations (ent-key indent) "Get all instantiations of entity ENT-KEY." - (let ((ent-alist (aget vhdl-entity-alist (vhdl-speedbar-line-key indent) t)) + (let ((ent-alist (vhdl-aget vhdl-entity-alist + (vhdl-speedbar-line-key indent) t)) arch-alist inst-alist ent-inst-list ent-entry arch-entry inst-entry) (while ent-alist @@ -14439,29 +14494,29 @@ entity ENT-KEY." (insert ")\n") (when (member 'hierarchy vhdl-speedbar-save-cache) (insert "\n;; entity and architecture cache\n" - "(aput 'vhdl-entity-alist " key " '") - (print (aget vhdl-entity-alist cache-key t) (current-buffer)) + "(vhdl-aput 'vhdl-entity-alist " key " '") + (print (vhdl-aget vhdl-entity-alist cache-key t) (current-buffer)) (insert ")\n\n;; configuration cache\n" - "(aput 'vhdl-config-alist " key " '") - (print (aget vhdl-config-alist cache-key t) (current-buffer)) + "(vhdl-aput 'vhdl-config-alist " key " '") + (print (vhdl-aget vhdl-config-alist cache-key t) (current-buffer)) (insert ")\n\n;; package cache\n" - "(aput 'vhdl-package-alist " key " '") - (print (aget vhdl-package-alist cache-key t) (current-buffer)) + "(vhdl-aput 'vhdl-package-alist " key " '") + (print (vhdl-aget vhdl-package-alist cache-key t) (current-buffer)) (insert ")\n\n;; instantiated entities cache\n" - "(aput 'vhdl-ent-inst-alist " key " '") - (print (aget vhdl-ent-inst-alist cache-key t) (current-buffer)) + "(vhdl-aput 'vhdl-ent-inst-alist " key " '") + (print (vhdl-aget vhdl-ent-inst-alist cache-key t) (current-buffer)) (insert ")\n\n;; design units per file cache\n" - "(aput 'vhdl-file-alist " key " '") - (print (aget vhdl-file-alist cache-key t) (current-buffer)) + "(vhdl-aput 'vhdl-file-alist " key " '") + (print (vhdl-aget vhdl-file-alist cache-key t) (current-buffer)) (when project (insert ")\n\n;; source directories in project cache\n" - "(aput 'vhdl-directory-alist " key " '") - (print (aget vhdl-directory-alist cache-key t) (current-buffer))) + "(vhdl-aput 'vhdl-directory-alist " key " '") + (print (vhdl-aget vhdl-directory-alist cache-key t) (current-buffer))) (insert ")\n")) (when (member 'display vhdl-speedbar-save-cache) (insert "\n;; shown design units cache\n" - "(aput 'vhdl-speedbar-shown-unit-alist " key " '") - (print (aget vhdl-speedbar-shown-unit-alist cache-key t) + "(vhdl-aput 'vhdl-speedbar-shown-unit-alist " key " '") + (print (vhdl-aget vhdl-speedbar-shown-unit-alist cache-key t) (current-buffer)) (insert ")\n")) (setq vhdl-updated-project-list @@ -14528,7 +14583,6 @@ if required." (defun vhdl-speedbar-initialize () "Initialize speedbar." ;; general settings -; (set (make-local-variable 'speedbar-tag-hierarchy-method) nil) ;; VHDL file extensions (extracted from `auto-mode-alist') (let ((mode-alist auto-mode-alist)) (while mode-alist @@ -14626,11 +14680,7 @@ if required." (append '(("vhdl directory" vhdl-speedbar-update-current-unit) ("vhdl project" vhdl-speedbar-update-current-project - vhdl-speedbar-update-current-unit) -; ("files" (lambda () (setq speedbar-ignored-path-regexp -; (speedbar-extension-list-to-regex -; speedbar-ignored-path-expressions)))) - ) + vhdl-speedbar-update-current-unit)) speedbar-stealthy-function-list)) (when (eq vhdl-speedbar-display-mode 'directory) (setq speedbar-initial-expansion-list-name "vhdl directory")) @@ -14724,10 +14774,7 @@ if required." (concat "^\\([0-9]+:\\s-*<\\)[+]>\\s-+" (caar project-alist) "$") nil t) (goto-char (match-end 1)) (speedbar-do-function-pointer))) - (setq project-alist (cdr project-alist)))) -; (vhdl-speedbar-update-current-project) -; (vhdl-speedbar-update-current-unit nil t) - ) + (setq project-alist (cdr project-alist))))) (defun vhdl-speedbar-insert-project-hierarchy (project indent &optional rescan) "Insert hierarchy of PROJECT. Rescan directories if RESCAN is non-nil, @@ -14737,10 +14784,10 @@ otherwise use cached data." (vhdl-scan-project-contents project)) ;; insert design hierarchy (vhdl-speedbar-insert-hierarchy - (aget vhdl-entity-alist project t) - (aget vhdl-config-alist project t) - (aget vhdl-package-alist project t) - (car (aget vhdl-ent-inst-alist project t)) indent) + (vhdl-aget vhdl-entity-alist project t) + (vhdl-aget vhdl-config-alist project t) + (vhdl-aget vhdl-package-alist project t) + (car (vhdl-aget vhdl-ent-inst-alist project t)) indent) (insert (int-to-string indent) ":\n") (put-text-property (- (point) 3) (1- (point)) 'invisible t) (put-text-property (1- (point)) (point) 'invisible nil) @@ -14755,13 +14802,13 @@ otherwise use cached data." (vhdl-scan-directory-contents directory)) ;; insert design hierarchy (vhdl-speedbar-insert-hierarchy - (aget vhdl-entity-alist directory t) - (aget vhdl-config-alist directory t) - (aget vhdl-package-alist directory t) - (car (aget vhdl-ent-inst-alist directory t)) depth) + (vhdl-aget vhdl-entity-alist directory t) + (vhdl-aget vhdl-config-alist directory t) + (vhdl-aget vhdl-package-alist directory t) + (car (vhdl-aget vhdl-ent-inst-alist directory t)) depth) ;; expand design units (vhdl-speedbar-expand-units directory) - (aput 'vhdl-directory-alist directory (list (list directory)))) + (vhdl-aput 'vhdl-directory-alist directory (list (list directory)))) (defun vhdl-speedbar-insert-hierarchy (ent-alist conf-alist pack-alist ent-inst-list depth) @@ -14849,10 +14896,10 @@ otherwise use cached data." (defun vhdl-speedbar-expand-units (key) "Expand design units in directory/project KEY according to `vhdl-speedbar-shown-unit-alist'." - (let ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t)) + (let ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key t)) (vhdl-speedbar-update-current-unit nil) vhdl-updated-project-list) - (adelete 'vhdl-speedbar-shown-unit-alist key) + (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key) (vhdl-prepare-search-1 (while unit-alist ; expand units (vhdl-speedbar-goto-this-unit key (caar unit-alist)) @@ -14902,7 +14949,7 @@ otherwise use cached data." (progn (setq vhdl-speedbar-shown-project-list nil) (vhdl-speedbar-refresh)) (let ((key (vhdl-speedbar-line-key))) - (adelete 'vhdl-speedbar-shown-unit-alist key) + (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key) (vhdl-speedbar-refresh (and vhdl-speedbar-show-projects key)) (when (memq 'display vhdl-speedbar-save-cache) (add-to-list 'vhdl-updated-project-list key))))) @@ -14911,9 +14958,9 @@ otherwise use cached data." "Expand all design units in current directory/project." (interactive) (let* ((key (vhdl-speedbar-line-key)) - (ent-alist (aget vhdl-entity-alist key t)) - (conf-alist (aget vhdl-config-alist key t)) - (pack-alist (aget vhdl-package-alist key t)) + (ent-alist (vhdl-aget vhdl-entity-alist key t)) + (conf-alist (vhdl-aget vhdl-config-alist key t)) + (pack-alist (vhdl-aget vhdl-package-alist key t)) arch-alist unit-alist subunit-alist) (add-to-list 'vhdl-speedbar-shown-project-list key) (while ent-alist @@ -14930,7 +14977,7 @@ otherwise use cached data." (while pack-alist (push (list (caar pack-alist)) unit-alist) (setq pack-alist (cdr pack-alist))) - (aput 'vhdl-speedbar-shown-unit-alist key unit-alist) + (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist) (vhdl-speedbar-refresh) (when (memq 'display vhdl-speedbar-save-cache) (add-to-list 'vhdl-updated-project-list key)))) @@ -14965,8 +15012,8 @@ otherwise use cached data." (cond ((string-match "+" text) ; expand entity (let* ((key (vhdl-speedbar-line-key indent)) - (ent-alist (aget vhdl-entity-alist key t)) - (ent-entry (aget ent-alist token t)) + (ent-alist (vhdl-aget vhdl-entity-alist key t)) + (ent-entry (vhdl-aget ent-alist token t)) (arch-alist (nth 3 ent-entry)) (inst-alist (vhdl-get-instantiations token indent)) (subpack-alist (nth 5 ent-entry)) @@ -14976,9 +15023,9 @@ otherwise use cached data." (speedbar-change-expand-button-char ??) (speedbar-change-expand-button-char ?-) ;; add entity to `vhdl-speedbar-shown-unit-alist' - (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t))) - (aput 'unit-alist token nil) - (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) + (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key t))) + (vhdl-aput 'unit-alist token nil) + (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) (speedbar-with-writable (save-excursion (end-of-line) (forward-char 1) @@ -15017,11 +15064,11 @@ otherwise use cached data." (speedbar-change-expand-button-char ?+) ;; remove entity from `vhdl-speedbar-shown-unit-alist' (let* ((key (vhdl-speedbar-line-key indent)) - (unit-alist (aget vhdl-speedbar-shown-unit-alist key t))) - (adelete 'unit-alist token) + (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key t))) + (vhdl-adelete 'unit-alist token) (if unit-alist - (aput 'vhdl-speedbar-shown-unit-alist key unit-alist) - (adelete 'vhdl-speedbar-shown-unit-alist key)) + (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist) + (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key)) (speedbar-delete-subblock indent) (when (memq 'display vhdl-speedbar-save-cache) (add-to-list 'vhdl-updated-project-list key)))) @@ -15034,23 +15081,24 @@ otherwise use cached data." (cond ((string-match "+" text) ; expand architecture (let* ((key (vhdl-speedbar-line-key (1- indent))) - (ent-alist (aget vhdl-entity-alist key t)) - (conf-alist (aget vhdl-config-alist key t)) + (ent-alist (vhdl-aget vhdl-entity-alist key t)) + (conf-alist (vhdl-aget vhdl-config-alist key t)) (hier-alist (vhdl-get-hierarchy ent-alist conf-alist (car token) (cdr token) nil nil 0 (1- indent))) - (ent-entry (aget ent-alist (car token) t)) - (arch-entry (aget (nth 3 ent-entry) (cdr token) t)) + (ent-entry (vhdl-aget ent-alist (car token) t)) + (arch-entry (vhdl-aget (nth 3 ent-entry) (cdr token) t)) (subpack-alist (nth 4 arch-entry)) entry) (if (not (or hier-alist subpack-alist)) (speedbar-change-expand-button-char ??) (speedbar-change-expand-button-char ?-) ;; add architecture to `vhdl-speedbar-shown-unit-alist' - (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t)) - (arch-alist (nth 0 (aget unit-alist (car token) t)))) - (aput 'unit-alist (car token) (list (cons (cdr token) arch-alist))) - (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) + (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key t)) + (arch-alist (nth 0 (vhdl-aget unit-alist (car token) t)))) + (vhdl-aput 'unit-alist (car token) + (list (cons (cdr token) arch-alist))) + (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) (speedbar-with-writable (save-excursion (end-of-line) (forward-char 1) @@ -15077,10 +15125,10 @@ otherwise use cached data." (speedbar-change-expand-button-char ?+) ;; remove architecture from `vhdl-speedbar-shown-unit-alist' (let* ((key (vhdl-speedbar-line-key (1- indent))) - (unit-alist (aget vhdl-speedbar-shown-unit-alist key t)) - (arch-alist (nth 0 (aget unit-alist (car token) t)))) - (aput 'unit-alist (car token) (list (delete (cdr token) arch-alist))) - (aput 'vhdl-speedbar-shown-unit-alist key unit-alist) + (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key t)) + (arch-alist (nth 0 (vhdl-aget unit-alist (car token) t)))) + (vhdl-aput 'unit-alist (car token) (list (delete (cdr token) arch-alist))) + (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist) (speedbar-delete-subblock indent) (when (memq 'display vhdl-speedbar-save-cache) (add-to-list 'vhdl-updated-project-list key)))) @@ -15093,9 +15141,9 @@ otherwise use cached data." (cond ((string-match "+" text) ; expand configuration (let* ((key (vhdl-speedbar-line-key indent)) - (conf-alist (aget vhdl-config-alist key t)) - (conf-entry (aget conf-alist token)) - (ent-alist (aget vhdl-entity-alist key t)) + (conf-alist (vhdl-aget vhdl-config-alist key t)) + (conf-entry (vhdl-aget conf-alist token)) + (ent-alist (vhdl-aget vhdl-entity-alist key t)) (hier-alist (vhdl-get-hierarchy ent-alist conf-alist (nth 3 conf-entry) (nth 4 conf-entry) token (nth 5 conf-entry) @@ -15106,9 +15154,9 @@ otherwise use cached data." (speedbar-change-expand-button-char ??) (speedbar-change-expand-button-char ?-) ;; add configuration to `vhdl-speedbar-shown-unit-alist' - (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t))) - (aput 'unit-alist token nil) - (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) + (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key t))) + (vhdl-aput 'unit-alist token nil) + (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) (speedbar-with-writable (save-excursion (end-of-line) (forward-char 1) @@ -15134,11 +15182,11 @@ otherwise use cached data." (speedbar-change-expand-button-char ?+) ;; remove configuration from `vhdl-speedbar-shown-unit-alist' (let* ((key (vhdl-speedbar-line-key indent)) - (unit-alist (aget vhdl-speedbar-shown-unit-alist key t))) - (adelete 'unit-alist token) + (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key t))) + (vhdl-adelete 'unit-alist token) (if unit-alist - (aput 'vhdl-speedbar-shown-unit-alist key unit-alist) - (adelete 'vhdl-speedbar-shown-unit-alist key)) + (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist) + (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key)) (speedbar-delete-subblock indent) (when (memq 'display vhdl-speedbar-save-cache) (add-to-list 'vhdl-updated-project-list key)))) @@ -15151,8 +15199,8 @@ otherwise use cached data." (cond ((string-match "+" text) ; expand package (let* ((key (vhdl-speedbar-line-key indent)) - (pack-alist (aget vhdl-package-alist key t)) - (pack-entry (aget pack-alist token t)) + (pack-alist (vhdl-aget vhdl-package-alist key t)) + (pack-entry (vhdl-aget pack-alist token t)) (comp-alist (nth 3 pack-entry)) (func-alist (nth 4 pack-entry)) (func-body-alist (nth 8 pack-entry)) @@ -15162,9 +15210,9 @@ otherwise use cached data." (speedbar-change-expand-button-char ??) (speedbar-change-expand-button-char ?-) ;; add package to `vhdl-speedbar-shown-unit-alist' - (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t))) - (aput 'unit-alist token nil) - (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) + (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key t))) + (vhdl-aput 'unit-alist token nil) + (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) (speedbar-with-writable (save-excursion (end-of-line) (forward-char 1) @@ -15185,7 +15233,8 @@ otherwise use cached data." (vhdl-speedbar-make-title-line "Subprograms:" (1+ indent))) (while func-alist (setq func-entry (car func-alist) - func-body-entry (aget func-body-alist (car func-entry) t)) + func-body-entry (vhdl-aget func-body-alist + (car func-entry) t)) (when (nth 2 func-entry) (vhdl-speedbar-make-subprogram-line (nth 1 func-entry) @@ -15203,11 +15252,11 @@ otherwise use cached data." (speedbar-change-expand-button-char ?+) ;; remove package from `vhdl-speedbar-shown-unit-alist' (let* ((key (vhdl-speedbar-line-key indent)) - (unit-alist (aget vhdl-speedbar-shown-unit-alist key t))) - (adelete 'unit-alist token) + (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key t))) + (vhdl-adelete 'unit-alist token) (if unit-alist - (aput 'vhdl-speedbar-shown-unit-alist key unit-alist) - (adelete 'vhdl-speedbar-shown-unit-alist key)) + (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist) + (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key)) (speedbar-delete-subblock indent) (when (memq 'display vhdl-speedbar-save-cache) (add-to-list 'vhdl-updated-project-list key)))) @@ -15217,15 +15266,15 @@ otherwise use cached data." (defun vhdl-speedbar-insert-subpackages (subpack-alist indent dir-indent) "Insert required packages." - (let* ((pack-alist (aget vhdl-package-alist - (vhdl-speedbar-line-key dir-indent) t)) + (let* ((pack-alist (vhdl-aget vhdl-package-alist + (vhdl-speedbar-line-key dir-indent) t)) pack-key lib-name pack-entry) (when subpack-alist (vhdl-speedbar-make-title-line "Packages Used:" indent)) (while subpack-alist (setq pack-key (cdar subpack-alist) lib-name (caar subpack-alist)) - (setq pack-entry (aget pack-alist pack-key t)) + (setq pack-entry (vhdl-aget pack-alist pack-key t)) (vhdl-speedbar-make-subpack-line (or (nth 0 pack-entry) pack-key) lib-name (cons (nth 1 pack-entry) (nth 2 pack-entry)) @@ -15283,18 +15332,21 @@ NO-POSITION non-nil means do not re-position cursor." (or always (not (equal file-name speedbar-last-selected-file)))) (if vhdl-speedbar-show-projects (while project-list - (setq file-alist (append file-alist (aget vhdl-file-alist - (car project-list) t))) + (setq file-alist (append file-alist + (vhdl-aget vhdl-file-alist + (car project-list) t))) (setq project-list (cdr project-list))) - (setq file-alist (aget vhdl-file-alist - (abbreviate-file-name default-directory) t))) + (setq file-alist + (vhdl-aget vhdl-file-alist + (abbreviate-file-name default-directory) t))) (select-frame speedbar-frame) (set-buffer speedbar-buffer) (speedbar-with-writable (vhdl-prepare-search-1 (save-excursion ;; unhighlight last units - (let* ((file-entry (aget file-alist speedbar-last-selected-file t))) + (let* ((file-entry (vhdl-aget file-alist + speedbar-last-selected-file t))) (vhdl-speedbar-update-units "\\[.\\] " (nth 0 file-entry) speedbar-last-selected-file 'vhdl-speedbar-entity-face) @@ -15314,7 +15366,7 @@ NO-POSITION non-nil means do not re-position cursor." "> " (nth 6 file-entry) speedbar-last-selected-file 'vhdl-speedbar-instantiation-face)) ;; highlight current units - (let* ((file-entry (aget file-alist file-name t))) + (let* ((file-entry (vhdl-aget file-alist file-name t))) (setq pos (vhdl-speedbar-update-units "\\[.\\] " (nth 0 file-entry) @@ -15747,7 +15799,8 @@ is already shown in a buffer." (let ((buffer (get-file-buffer (car token)))) (speedbar-find-file-in-frame (car token)) (when (or vhdl-speedbar-jump-to-unit buffer) - (vhdl-goto-line (cdr token)) + (goto-char (point-min)) + (forward-line (1- (cdr token))) (recenter)) (vhdl-speedbar-update-current-unit t t) (speedbar-set-timer dframe-update-speed) @@ -15765,7 +15818,8 @@ is already shown in a buffer." (let ((token (get-text-property (match-beginning 3) 'speedbar-token))) (vhdl-visit-file (car token) t - (progn (vhdl-goto-line (cdr token)) + (progn (goto-char (point-min)) + (forward-line (1- (cdr token))) (end-of-line) (if is-entity (vhdl-port-copy) @@ -15805,9 +15859,11 @@ is already shown in a buffer." (error "ERROR: No architecture under cursor") (let* ((arch-key (downcase (vhdl-speedbar-line-text))) (ent-key (downcase (vhdl-speedbar-higher-text))) - (ent-alist (aget vhdl-entity-alist - (or (vhdl-project-p) default-directory) t)) - (ent-entry (aget ent-alist ent-key t))) + (ent-alist (vhdl-aget + vhdl-entity-alist + (or (vhdl-project-p) + (abbreviate-file-name default-directory)) t)) + (ent-entry (vhdl-aget ent-alist ent-key t))) (setcar (cddr (cddr ent-entry)) arch-key) ; (nth 4 ent-entry) (speedbar-refresh)))) @@ -15946,15 +16002,14 @@ expansion function)." ;; add speedbar (when (fboundp 'speedbar) - (condition-case () - (when (and vhdl-speedbar-auto-open - (not (and (boundp 'speedbar-frame) - (frame-live-p speedbar-frame)))) - (speedbar-frame-mode 1) - (if (fboundp 'speedbar-select-attached-frame) - (speedbar-select-attached-frame) - (select-frame speedbar-attached-frame))) - (error (vhdl-warning-when-idle "ERROR: An error occurred while opening speedbar")))) + (let ((current-frame (selected-frame))) + (condition-case () + (when (and vhdl-speedbar-auto-open + (not (and (boundp 'speedbar-frame) + (frame-live-p speedbar-frame)))) + (speedbar-frame-mode 1)) + (error (vhdl-warning-when-idle "ERROR: An error occurred while opening speedbar"))) + (select-frame current-frame))) ;; initialize speedbar (if (not (boundp 'speedbar-frame)) @@ -16217,7 +16272,7 @@ component instantiation." (setq constant-entry (cons constant-name (if (match-string 1) - (or (aget generic-alist (match-string 2) t) + (or (vhdl-aget generic-alist (match-string 2) t) (error "ERROR: Formal generic \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)) (cdar generic-alist)))) (push constant-entry constant-alist) @@ -16235,11 +16290,12 @@ component instantiation." (vhdl-forward-syntactic-ws) (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n\r\f]*=>[ \t\n\r\f]*\\)?\\(\\w+\\),?" t) (setq signal-name (match-string-no-properties 3)) - (setq signal-entry (cons signal-name - (if (match-string 1) - (or (aget port-alist (match-string 2) t) - (error "ERROR: Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)) - (cdar port-alist)))) + (setq signal-entry + (cons signal-name + (if (match-string 1) + (or (vhdl-aget port-alist (match-string 2) t) + (error "ERROR: Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)) + (cdar port-alist)))) (push signal-entry signal-alist) (setq signal-name (downcase signal-name)) (if (equal (upcase (nth 2 signal-entry)) "IN") @@ -16478,8 +16534,9 @@ current project/directory." (pack-file-name (concat (vhdl-replace-string vhdl-package-file-name pack-name t) "." (file-name-extension (buffer-file-name)))) - (ent-alist (aget vhdl-entity-alist - (or project default-directory) t)) + (ent-alist (vhdl-aget vhdl-entity-alist + (or project + (abbreviate-file-name default-directory)) t)) (lazy-lock-minimum-size 0) clause-pos component-pos) (message "Generating components package \"%s\"..." pack-name) @@ -16519,7 +16576,8 @@ current project/directory." ;; insert component declarations (while ent-alist (vhdl-visit-file (nth 2 (car ent-alist)) nil - (progn (vhdl-goto-line (nth 3 (car ent-alist))) + (progn (goto-char (point-min)) + (forward-line (1- (nth 3 (car ent-alist)))) (end-of-line) (vhdl-port-copy))) (goto-char component-pos) @@ -16581,7 +16639,7 @@ current project/directory." (when (equal (nth 5 inst-entry) (nth 4 (car tmp-alist))) (setq conf-key (nth 0 (car tmp-alist)))) (setq tmp-alist (cdr tmp-alist))) - (setq conf-entry (aget conf-alist conf-key t)) + (setq conf-entry (vhdl-aget conf-alist conf-key t)) ;; insert binding indication ... ;; ... with subconfiguration (if exists) (if (and vhdl-compose-configuration-use-subconfiguration conf-entry) @@ -16591,7 +16649,7 @@ current project/directory." (insert (vhdl-work-library) "." (nth 0 conf-entry)) (insert ";\n")) ;; ... with entity (if exists) - (setq ent-entry (aget ent-alist (nth 5 inst-entry) t)) + (setq ent-entry (vhdl-aget ent-alist (nth 5 inst-entry) t)) (when ent-entry (indent-to (+ margin vhdl-basic-offset)) (vhdl-insert-keyword "USE ENTITY ") @@ -16601,9 +16659,9 @@ current project/directory." (setq arch-name ;; choose architecture name a) from configuration, ;; b) from mra, or c) from first architecture - (or (nth 0 (aget (nth 3 ent-entry) - (or (nth 6 inst-entry) - (nth 4 ent-entry)) t)) + (or (nth 0 (vhdl-aget (nth 3 ent-entry) + (or (nth 6 inst-entry) + (nth 4 ent-entry)) t)) (nth 1 (car (nth 3 ent-entry))))) (insert "(" arch-name ")")) (insert ";\n") @@ -16613,7 +16671,7 @@ current project/directory." (indent-to (+ margin vhdl-basic-offset)) (vhdl-compose-configuration-architecture (nth 0 ent-entry) arch-name ent-alist conf-alist - (nth 3 (aget (nth 3 ent-entry) (downcase arch-name) t)))))) + (nth 3 (vhdl-aget (nth 3 ent-entry) (downcase arch-name) t)))))) ;; insert component configuration end (indent-to margin) (vhdl-insert-keyword "END FOR;\n") @@ -16635,10 +16693,12 @@ current project/directory." "Generate configuration declaration." (interactive) (vhdl-require-hierarchy-info) - (let ((ent-alist (aget vhdl-entity-alist - (or (vhdl-project-p) default-directory) t)) - (conf-alist (aget vhdl-config-alist - (or (vhdl-project-p) default-directory) t)) + (let ((ent-alist (vhdl-aget vhdl-entity-alist + (or (vhdl-project-p) + (abbreviate-file-name default-directory)) t)) + (conf-alist (vhdl-aget vhdl-config-alist + (or (vhdl-project-p) + (abbreviate-file-name default-directory)) t)) (from-speedbar ent-name) inst-alist conf-name conf-file-name pos) (vhdl-prepare-search-2 @@ -16654,8 +16714,8 @@ current project/directory." vhdl-compose-configuration-name (concat ent-name " " arch-name))) (setq inst-alist - (nth 3 (aget (nth 3 (aget ent-alist (downcase ent-name) t)) - (downcase arch-name) t)))) + (nth 3 (vhdl-aget (nth 3 (vhdl-aget ent-alist (downcase ent-name) t)) + (downcase arch-name) t)))) (message "Generating configuration \"%s\"..." conf-name) (if vhdl-compose-configuration-create-file ;; open configuration file @@ -16721,8 +16781,8 @@ current project/directory." (defun vhdl-makefile-name () "Return the Makefile name of the current project or the current compiler if no project is defined." - (let ((project-alist (aget vhdl-project-alist vhdl-project)) - (compiler-alist (aget vhdl-compiler-alist vhdl-compiler))) + (let ((project-alist (vhdl-aget vhdl-project-alist vhdl-project)) + (compiler-alist (vhdl-aget vhdl-compiler-alist vhdl-compiler))) (vhdl-replace-string (cons "\\(.*\\)\n\\(.*\\)" (or (nth 8 project-alist) (nth 8 compiler-alist))) @@ -16730,8 +16790,8 @@ no project is defined." (defun vhdl-compile-directory () "Return the directory where compilation/make should be run." - (let* ((project (aget vhdl-project-alist (vhdl-project-p t))) - (compiler (aget vhdl-compiler-alist vhdl-compiler)) + (let* ((project (vhdl-aget vhdl-project-alist (vhdl-project-p t))) + (compiler (vhdl-aget vhdl-compiler-alist vhdl-compiler)) (directory (vhdl-resolve-env-variable (if project (vhdl-replace-string @@ -16765,9 +16825,10 @@ no project is defined." (defun vhdl-compile-init () "Initialize for compilation." - (when (or (null compilation-error-regexp-alist) - (not (assoc (car (nth 11 (car vhdl-compiler-alist))) - compilation-error-regexp-alist))) + (when (and (not vhdl-emacs-22) + (or (null compilation-error-regexp-alist) + (not (assoc (car (nth 11 (car vhdl-compiler-alist))) + compilation-error-regexp-alist)))) ;; `compilation-error-regexp-alist' (let ((commands-alist vhdl-compiler-alist) regexp-alist sublist) @@ -16810,7 +16871,7 @@ do not print any file names." &optional file-options-only) "Get compiler options. Returning nil means do not compile this file." (let* ((compiler-options (nth 1 compiler)) - (project-entry (aget (nth 4 project) vhdl-compiler)) + (project-entry (vhdl-aget (nth 4 project) vhdl-compiler)) (project-options (nth 0 project-entry)) (exception-list (and file-name (nth 2 project-entry))) (work-library (vhdl-work-library)) @@ -16847,7 +16908,7 @@ do not print any file names." (defun vhdl-get-make-options (project compiler) "Get make options." (let* ((compiler-options (nth 3 compiler)) - (project-entry (aget (nth 4 project) vhdl-compiler)) + (project-entry (vhdl-aget (nth 4 project) vhdl-compiler)) (project-options (nth 1 project-entry)) (makefile-name (vhdl-makefile-name))) ;; insert Makefile name in compiler-specific options @@ -16868,8 +16929,8 @@ do not print any file names." `vhdl-compiler'." (interactive) (vhdl-compile-init) - (let* ((project (aget vhdl-project-alist vhdl-project)) - (compiler (or (aget vhdl-compiler-alist vhdl-compiler nil) + (let* ((project (vhdl-aget vhdl-project-alist vhdl-project)) + (compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler nil) (error "ERROR: No such compiler: \"%s\"" vhdl-compiler))) (command (nth 0 compiler)) (default-directory (vhdl-compile-directory)) @@ -16910,8 +16971,8 @@ specified by a target." (or target (read-from-minibuffer "Target: " vhdl-make-target vhdl-minibuffer-local-map))) (vhdl-compile-init) - (let* ((project (aget vhdl-project-alist vhdl-project)) - (compiler (or (aget vhdl-compiler-alist vhdl-compiler) + (let* ((project (vhdl-aget vhdl-project-alist vhdl-project)) + (compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler) (error "ERROR: No such compiler: \"%s\"" vhdl-compiler))) (command (nth 2 compiler)) (options (vhdl-get-make-options project compiler)) @@ -16928,17 +16989,20 @@ specified by a target." (let ((compiler-alist vhdl-compiler-alist) (error-regexp-alist '((vhdl-directory "^ *Compiling \"\\(.+\\)\"" 1)))) (while compiler-alist - ;; add error message regexps - (setq error-regexp-alist - (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist))))))) - (nth 11 (car compiler-alist))) - error-regexp-alist)) - ;; add filename regexps - (when (/= 0 (nth 1 (nth 12 (car compiler-alist)))) + ;; only add regexps for currently selected compiler + (when (or (not vhdl-compile-use-local-error-regexp) + (equal vhdl-compiler (nth 0 (car compiler-alist)))) + ;; add error message regexps (setq error-regexp-alist - (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist)))) "-file"))) - (nth 12 (car compiler-alist))) - error-regexp-alist))) + (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist))))))) + (nth 11 (car compiler-alist))) + error-regexp-alist)) + ;; add filename regexps + (when (/= 0 (nth 1 (nth 12 (car compiler-alist)))) + (setq error-regexp-alist + (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist)))) "-file"))) + (nth 12 (car compiler-alist))) + error-regexp-alist)))) (setq compiler-alist (cdr compiler-alist))) error-regexp-alist) "List of regexps for VHDL compilers. For Emacs 22+.") @@ -16949,6 +17013,10 @@ specified by a target." (interactive) (when (and (boundp 'compilation-error-regexp-alist-alist) (not (assoc 'vhdl-modelsim compilation-error-regexp-alist-alist))) + ;; remove all other compilers + (when vhdl-compile-use-local-error-regexp + (setq compilation-error-regexp-alist nil)) + ;; add VHDL compilers (mapcar (lambda (item) (push (car item) compilation-error-regexp-alist) @@ -16964,7 +17032,7 @@ specified by a target." (defun vhdl-generate-makefile () "Generate `Makefile'." (interactive) - (let* ((compiler (or (aget vhdl-compiler-alist vhdl-compiler) + (let* ((compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler) (error "ERROR: No such compiler: \"%s\"" vhdl-compiler))) (command (nth 4 compiler))) ;; generate makefile @@ -16997,15 +17065,19 @@ specified by a target." (vhdl-scan-directory-contents directory)))) (let* ((directory (abbreviate-file-name (vhdl-default-directory))) (project (vhdl-project-p)) - (ent-alist (aget vhdl-entity-alist (or project directory) t)) - (conf-alist (aget vhdl-config-alist (or project directory) t)) - (pack-alist (aget vhdl-package-alist (or project directory) t)) - (regexp-list (nth 12 (aget vhdl-compiler-alist vhdl-compiler))) - (ent-regexp (cons "\\(.*\\)" (nth 0 regexp-list))) - (arch-regexp (cons "\\(.*\\) \\(.*\\)" (nth 1 regexp-list))) - (conf-regexp (cons "\\(.*\\)" (nth 2 regexp-list))) - (pack-regexp (cons "\\(.*\\)" (nth 3 regexp-list))) - (pack-body-regexp (cons "\\(.*\\)" (nth 4 regexp-list))) + (ent-alist (vhdl-aget vhdl-entity-alist (or project directory) t)) + (conf-alist (vhdl-aget vhdl-config-alist (or project directory) t)) + (pack-alist (vhdl-aget vhdl-package-alist (or project directory) t)) + (regexp-list (or (nth 12 (vhdl-aget vhdl-compiler-alist vhdl-compiler)) + '("\\1.vhd" "\\2_\\1.vhd" "\\1.vhd" + "\\1.vhd" "\\1_body.vhd" identity))) + (mapping-exist + (if (nth 12 (vhdl-aget vhdl-compiler-alist vhdl-compiler)) t nil)) + (ent-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 0 regexp-list))) + (arch-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 1 regexp-list))) + (conf-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 2 regexp-list))) + (pack-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 3 regexp-list))) + (pack-body-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 4 regexp-list))) (adjust-case (nth 5 regexp-list)) (work-library (downcase (vhdl-work-library))) (compile-directory (expand-file-name (vhdl-compile-directory) @@ -17022,9 +17094,10 @@ specified by a target." ;; check prerequisites (unless (file-exists-p compile-directory) (make-directory compile-directory t)) - (unless regexp-list - (error "Please contact the VHDL Mode maintainer for support of \"%s\"" - vhdl-compiler)) + (unless mapping-exist + (vhdl-warning + (format "No unit-to-file name mapping found for compiler \"%s\".\n Directory of dummy files is created instead (to be used as dependencies).\n Please contact the VHDL Mode maintainer for full support of \"%s\"" + vhdl-compiler vhdl-compiler) t)) (message "Generating makefile \"%s\"..." makefile-name) ;; rules for all entities (setq tmp-list ent-alist) @@ -17038,13 +17111,15 @@ specified by a target." compile-directory)) arch-alist (nth 4 ent-entry) lib-alist (nth 6 ent-entry) - rule (aget rule-alist ent-file-name) + rule (vhdl-aget rule-alist ent-file-name) target-list (nth 0 rule) depend-list (nth 1 rule) second-list nil subcomp-list nil) (setq tmp-key (vhdl-replace-string - ent-regexp (funcall adjust-case ent-key))) + ent-regexp + (funcall adjust-case + (concat ent-key " " work-library)))) (push (cons ent-key tmp-key) unit-list) ;; rule target for this entity (push ent-key target-list) @@ -17053,7 +17128,7 @@ specified by a target." (setq depend-list (append depend-list pack-list)) (setq all-pack-list pack-list) ;; add rule - (aput 'rule-alist ent-file-name (list target-list depend-list)) + (vhdl-aput 'rule-alist ent-file-name (list target-list depend-list)) ;; rules for all corresponding architectures (while arch-alist (setq arch-entry (car arch-alist) @@ -17065,12 +17140,14 @@ specified by a target." compile-directory)) inst-alist (nth 4 arch-entry) lib-alist (nth 5 arch-entry) - rule (aget rule-alist arch-file-name) + rule (vhdl-aget rule-alist arch-file-name) target-list (nth 0 rule) depend-list (nth 1 rule)) (setq tmp-key (vhdl-replace-string arch-regexp - (funcall adjust-case (concat arch-key " " ent-key)))) + (funcall adjust-case + (concat arch-key " " ent-key " " + work-library)))) (setq unit-list (cons (cons ent-arch-key tmp-key) unit-list)) (push ent-arch-key second-list) @@ -17093,7 +17170,7 @@ specified by a target." (setq depend-list (append depend-list pack-list)) (setq all-pack-list (append all-pack-list pack-list)) ;; add rule - (aput 'rule-alist arch-file-name (list target-list depend-list)) + (vhdl-aput 'rule-alist arch-file-name (list target-list depend-list)) (setq arch-alist (cdr arch-alist))) (push (list ent-key second-list (append subcomp-list all-pack-list)) prim-list)) @@ -17112,12 +17189,14 @@ specified by a target." arch-key (nth 5 conf-entry) inst-alist (nth 6 conf-entry) lib-alist (nth 7 conf-entry) - rule (aget rule-alist conf-file-name) + rule (vhdl-aget rule-alist conf-file-name) target-list (nth 0 rule) depend-list (nth 1 rule) subcomp-list (list ent-key)) (setq tmp-key (vhdl-replace-string - conf-regexp (funcall adjust-case conf-key))) + conf-regexp + (funcall adjust-case + (concat conf-key " " work-library)))) (push (cons conf-key tmp-key) unit-list) ;; rule target for this configuration (push conf-key target-list) @@ -17131,20 +17210,17 @@ specified by a target." (while inst-alist (setq inst-entry (car inst-alist)) (setq inst-ent-key (nth 2 inst-entry) -; comp-arch-key (nth 2 inst-entry)) inst-conf-key (nth 4 inst-entry)) (when (equal (downcase (nth 5 inst-entry)) work-library) (when inst-ent-key (setq depend-list (cons inst-ent-key depend-list) subcomp-list (cons inst-ent-key subcomp-list))) -; (when comp-arch-key -; (push (concat comp-ent-key "-" comp-arch-key) depend-list)) (when inst-conf-key (setq depend-list (cons inst-conf-key depend-list) subcomp-list (cons inst-conf-key subcomp-list)))) (setq inst-alist (cdr inst-alist))) ;; add rule - (aput 'rule-alist conf-file-name (list target-list depend-list)) + (vhdl-aput 'rule-alist conf-file-name (list target-list depend-list)) (push (list conf-key nil (append subcomp-list pack-list)) prim-list) (setq conf-alist (cdr conf-alist))) (setq conf-alist tmp-list) @@ -17160,10 +17236,12 @@ specified by a target." (file-relative-name (nth 2 pack-entry) compile-directory)) lib-alist (nth 6 pack-entry) lib-body-alist (nth 10 pack-entry) - rule (aget rule-alist pack-file-name) + rule (vhdl-aget rule-alist pack-file-name) target-list (nth 0 rule) depend-list (nth 1 rule)) (setq tmp-key (vhdl-replace-string - pack-regexp (funcall adjust-case pack-key))) + pack-regexp + (funcall adjust-case + (concat pack-key " " work-library)))) (push (cons pack-key tmp-key) unit-list) ;; rule target for this package (push pack-key target-list) @@ -17172,7 +17250,7 @@ specified by a target." (setq depend-list (append depend-list pack-list)) (setq all-pack-list pack-list) ;; add rule - (aput 'rule-alist pack-file-name (list target-list depend-list)) + (vhdl-aput 'rule-alist pack-file-name (list target-list depend-list)) ;; rules for this package's body (when (nth 7 pack-entry) (setq pack-body-key (concat pack-key "-body") @@ -17180,11 +17258,13 @@ specified by a target." (nth 7 pack-entry) (file-relative-name (nth 7 pack-entry) compile-directory)) - rule (aget rule-alist pack-body-file-name) + rule (vhdl-aget rule-alist pack-body-file-name) target-list (nth 0 rule) depend-list (nth 1 rule)) (setq tmp-key (vhdl-replace-string - pack-body-regexp (funcall adjust-case pack-key))) + pack-body-regexp + (funcall adjust-case + (concat pack-key " " work-library)))) (setq unit-list (cons (cons pack-body-key tmp-key) unit-list)) ;; rule target for this package's body @@ -17196,8 +17276,8 @@ specified by a target." (setq depend-list (append depend-list pack-list)) (setq all-pack-list (append all-pack-list pack-list)) ;; add rule - (aput 'rule-alist pack-body-file-name - (list target-list depend-list))) + (vhdl-aput 'rule-alist pack-body-file-name + (list target-list depend-list))) (setq prim-list (cons (list pack-key (when pack-body-key (list pack-body-key)) all-pack-list) @@ -17205,8 +17285,8 @@ specified by a target." (setq pack-alist (cdr pack-alist))) (setq pack-alist tmp-list) ;; generate Makefile - (let* ((project (aget vhdl-project-alist project)) - (compiler (aget vhdl-compiler-alist vhdl-compiler)) + (let* ((project (vhdl-aget vhdl-project-alist project)) + (compiler (vhdl-aget vhdl-compiler-alist vhdl-compiler)) (compiler-id (nth 9 compiler)) (library-directory (vhdl-resolve-env-variable @@ -17259,12 +17339,16 @@ specified by a target." compile-directory)))) (insert "\n\n# Define library paths\n" "\nLIBRARY-" work-library " = " library-directory "\n") + (unless mapping-exist + (insert "LIBRARY-" work-library "-make = " "$(LIBRARY-" work-library + ")/make" "\n")) ;; insert variable definitions for all library unit files (insert "\n\n# Define library unit files\n") (setq tmp-list unit-list) (while unit-list (insert "\nUNIT-" work-library "-" (caar unit-list) - " = \\\n\t$(LIBRARY-" work-library ")/" (cdar unit-list)) + " = \\\n\t$(LIBRARY-" work-library + (if mapping-exist "" "-make") ")/" (cdar unit-list)) (setq unit-list (cdr unit-list))) ;; insert variable definition for list of all library unit files (insert "\n\n\n# Define list of all library unit files\n" @@ -17287,13 +17371,20 @@ specified by a target." ;; insert `make library' rule (insert "\n\n# Rule for creating library directory\n" "\n" (nth 2 vhdl-makefile-default-targets) " :" - " \\\n\t\t$(LIBRARY-" work-library ")\n" + " \\\n\t\t$(LIBRARY-" work-library ")" + (if mapping-exist "" + (concat " \\\n\t\t$(LIBRARY-" work-library "-make)\n")) + "\n" "\n$(LIBRARY-" work-library ") :" "\n\t" (vhdl-replace-string (cons "\\(.*\\)\n\\(.*\\)" (nth 5 compiler)) (concat "$(LIBRARY-" work-library ")\n" (vhdl-work-library))) "\n") + (unless mapping-exist + (insert "\n$(LIBRARY-" work-library "-make) :" + "\n\t" + "mkdir -p $(LIBRARY-" work-library "-make)\n")) ;; insert '.PHONY' declaration (insert "\n\n.PHONY : " (nth 0 vhdl-makefile-default-targets) " " @@ -17306,9 +17397,9 @@ specified by a target." (setq subcomp-list (sort (vhdl-uniquify (nth 2 (car prim-list))) 'string<)) (setq unit-key (caar prim-list) - unit-name (or (nth 0 (aget ent-alist unit-key t)) - (nth 0 (aget conf-alist unit-key t)) - (nth 0 (aget pack-alist unit-key t)))) + unit-name (or (nth 0 (vhdl-aget ent-alist unit-key t)) + (nth 0 (vhdl-aget conf-alist unit-key t)) + (nth 0 (vhdl-aget pack-alist unit-key t)))) (insert "\n" unit-key) (unless (equal unit-key unit-name) (insert " \\\n" unit-name)) @@ -17358,13 +17449,15 @@ specified by a target." (nth 0 rule) (if (equal vhdl-compile-post-command "") "" " $(POST-COMPILE)") "\n") + (insert "\n")) + (unless (and options mapping-exist) (setq tmp-list target-list) (while target-list - (insert "\n\t@touch $(UNIT-" work-library "-" (car target-list) ")" - (if (cdr target-list) " \\" "\n")) + (insert "\t@touch $(UNIT-" work-library "-" (car target-list) ")\n") (setq target-list (cdr target-list))) (setq target-list tmp-list)) (setq rule-alist (cdr rule-alist))) + (insert "\n\n### " makefile-name " ends here\n") ;; run Makefile generation hook (run-hooks 'vhdl-makefile-generation-hook) @@ -17374,7 +17467,8 @@ specified by a target." (progn (save-buffer) (kill-buffer (current-buffer)) (set-buffer orig-buffer) - (add-to-history 'file-name-history makefile-path-name)) + (when (fboundp 'add-to-history) + (add-to-history 'file-name-history makefile-path-name))) (vhdl-warning-when-idle (format "File not writable: \"%s\"" (abbreviate-file-name makefile-path-name))) diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el index e22581445e5..4ab882b71fb 100644 --- a/lisp/progmodes/xscheme.el +++ b/lisp/progmodes/xscheme.el @@ -1,4 +1,4 @@ -;;; xscheme.el --- run MIT Scheme under Emacs +;;; xscheme.el --- run MIT Scheme under Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1986-1987, 1989-1990, 2001-2014 Free Software ;; Foundation, Inc. @@ -49,13 +49,13 @@ (defvar xscheme-expressions-ring-max 30 "Maximum length of Scheme expressions ring.") -(defvar xscheme-expressions-ring nil +(defvar-local xscheme-expressions-ring nil "List of expressions recently transmitted to the Scheme process.") -(defvar xscheme-expressions-ring-yank-pointer nil +(defvar-local xscheme-expressions-ring-yank-pointer nil "The tail of the Scheme expressions ring whose car is the last thing yanked.") -(defvar xscheme-running-p nil +(defvar-local xscheme-running-p nil "This variable, if nil, indicates that the scheme process is waiting for input. Otherwise, it is busy evaluating something.") @@ -64,7 +64,7 @@ waiting for input. Otherwise, it is busy evaluating something.") control-g interrupts were signaled. Do not allow more control-g's to be signaled until the scheme process acknowledges receipt.") -(defvar xscheme-control-g-disabled-p nil +(defvar-local xscheme-control-g-disabled-p nil "This variable, if non-nil, indicates that a control-g is being processed by the scheme process, so additional control-g's are to be ignored.") @@ -78,37 +78,26 @@ by the scheme process, so additional control-g's are to be ignored.") (defvar xscheme-runlight "") (defvar xscheme-runlight-string nil) -(defvar xscheme-process-filter-state 'idle +(defvar-local xscheme-process-filter-state 'idle "State of scheme process escape reader state machine: idle waiting for an escape sequence reading-type received an altmode but nothing else reading-string reading prompt string") -(defvar xscheme-allow-output-p t +(defvar-local xscheme-allow-output-p t "This variable, if nil, prevents output from the scheme process from being inserted into the process-buffer.") -(defvar xscheme-prompt "" +(defvar-local xscheme-prompt "" "The current scheme prompt string.") -(defvar xscheme-string-accumulator "" +(defvar-local xscheme-string-accumulator "" "Accumulator for the string being received from the scheme process.") -(defvar xscheme-mode-string nil) -(setq-default scheme-mode-line-process - '("" xscheme-runlight)) - -(mapc 'make-variable-buffer-local - '(xscheme-expressions-ring - xscheme-expressions-ring-yank-pointer - xscheme-process-filter-state - xscheme-running-p - xscheme-control-g-disabled-p - xscheme-allow-output-p - xscheme-prompt - xscheme-string-accumulator - xscheme-mode-string - scheme-mode-line-process)) +(defvar-local xscheme-mode-string nil) +(setq-default scheme-mode-line-process '("" xscheme-runlight)) +(make-variable-buffer-local 'scheme-mode-line-process) + (defgroup xscheme nil "Major mode for editing Scheme and interacting with MIT's C-Scheme." diff --git a/lisp/rect.el b/lisp/rect.el index e798b07b556..ac861a0824b 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -31,6 +31,13 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + +(defgroup rectangle nil + "Operations on rectangles." + :version "24.5" + :group 'editing) + ;; FIXME: this function should be replaced by `apply-on-rectangle' (defun operate-on-rectangle (function start end coerce-tabs) "Call FUNCTION for each line of rectangle with corners at START, END. @@ -42,42 +49,95 @@ FUNCTION is called with three arguments: number of columns that belong to rectangle but are before that position, number of columns that belong to rectangle but are after point. Point is at the end of the segment of this line within the rectangle." - (let (startcol startlinepos endcol endlinepos) - (save-excursion - (goto-char start) - (setq startcol (current-column)) - (beginning-of-line) - (setq startlinepos (point))) - (save-excursion - (goto-char end) - (setq endcol (current-column)) - (forward-line 1) - (setq endlinepos (point-marker))) - (if (< endcol startcol) - (setq startcol (prog1 endcol (setq endcol startcol)))) - (save-excursion - (goto-char startlinepos) - (while (< (point) endlinepos) - (let (startpos begextra endextra) - (if coerce-tabs - (move-to-column startcol t) - (move-to-column startcol)) - (setq begextra (- (current-column) startcol)) - (setq startpos (point)) - (if coerce-tabs - (move-to-column endcol t) - (move-to-column endcol)) - ;; If we overshot, move back one character - ;; so that endextra will be positive. - (if (and (not coerce-tabs) (> (current-column) endcol)) - (backward-char 1)) - (setq endextra (- endcol (current-column))) - (if (< begextra 0) - (setq endextra (+ endextra begextra) - begextra 0)) - (funcall function startpos begextra endextra)) - (forward-line 1))) - (- endcol startcol))) + (apply-on-rectangle + (lambda (startcol endcol) + (let (startpos begextra endextra) + (move-to-column startcol coerce-tabs) + (setq begextra (- (current-column) startcol)) + (setq startpos (point)) + (move-to-column endcol coerce-tabs) + ;; If we overshot, move back one character + ;; so that endextra will be positive. + (if (and (not coerce-tabs) (> (current-column) endcol)) + (backward-char 1)) + (setq endextra (- endcol (current-column))) + (if (< begextra 0) + (setq endextra (+ endextra begextra) + begextra 0)) + (funcall function startpos begextra endextra))) + start end)) + +;;; Crutches to let rectangle's corners be where point can't be +;; (e.g. in the middle of a TAB, or past the EOL). + +(defvar-local rectangle--mark-crutches nil + "(POS . COL) to override the column to use for the mark.") + +(defun rectangle--pos-cols (start end &optional window) + ;; At this stage, we don't know which of start/end is point/mark :-( + ;; And in case start=end, it might still be that point and mark have + ;; different crutches! + (let ((cw (window-parameter window 'rectangle--point-crutches))) + (cond + ((eq start (car cw)) + (let ((sc (cdr cw)) + (ec (if (eq end (car rectangle--mark-crutches)) + (cdr rectangle--mark-crutches) + (if rectangle--mark-crutches + (setq rectangle--mark-crutches nil)) + (goto-char end) (current-column)))) + (if (eq start end) (cons (min sc ec) (max sc ec)) (cons sc ec)))) + ((eq end (car cw)) + (if (eq start (car rectangle--mark-crutches)) + (cons (cdr rectangle--mark-crutches) (cdr cw)) + (if rectangle--mark-crutches (setq rectangle--mark-crutches nil)) + (cons (progn (goto-char start) (current-column)) (cdr cw)))) + ((progn + (if cw (setf (window-parameter nil 'rectangle--point-crutches) nil)) + (eq start (car rectangle--mark-crutches))) + (let ((sc (cdr rectangle--mark-crutches)) + (ec (progn (goto-char end) (current-column)))) + (if (eq start end) (cons (min sc ec) (max sc ec)) (cons sc ec)))) + ((eq end (car rectangle--mark-crutches)) + (cons (progn (goto-char start) (current-column)) + (cdr rectangle--mark-crutches))) + (t + (if rectangle--mark-crutches (setq rectangle--mark-crutches nil)) + (cons (progn (goto-char start) (current-column)) + (progn (goto-char end) (current-column))))))) + +(defun rectangle--col-pos (col kind) + (let ((c (move-to-column col))) + (if (= c col) + (if (eq kind 'point) + (if (window-parameter nil 'rectangle--point-crutches) + (setf (window-parameter nil 'rectangle--point-crutches) nil)) + (if rectangle--mark-crutches (setq rectangle--mark-crutches nil))) + ;; If move-to-column over-shooted, move back one char so we're + ;; at the position where rectangle--highlight-for-redisplay + ;; will add the overlay (so that the cursor can be drawn at the + ;; right place). + (when (> c col) (forward-char -1)) + (setf (if (eq kind 'point) + (window-parameter nil 'rectangle--point-crutches) + rectangle--mark-crutches) + (cons (point) col))))) + +(defun rectangle--point-col (pos) + (let ((pc (window-parameter nil 'rectangle--point-crutches))) + (if (eq pos (car pc)) (cdr pc) + (goto-char pos) + (current-column)))) + +(defun rectangle--crutches () + (cons rectangle--mark-crutches + (window-parameter nil 'rectangle--point-crutches))) +(defun rectangle--reset-crutches () + (kill-local-variable 'rectangle--mark-crutches) + (if (window-parameter nil 'rectangle--point-crutches) + (setf (window-parameter nil 'rectangle--point-crutches) nil))) + +;;; Rectangle operations. (defun apply-on-rectangle (function start end &rest args) "Call FUNCTION for each line of rectangle with corners at START, END. @@ -85,27 +145,27 @@ FUNCTION is called with two arguments: the start and end columns of the rectangle, plus ARGS extra arguments. Point is at the beginning of line when the function is called. The final point after the last operation will be returned." - (let (startcol startpt endcol endpt final-point) - (save-excursion - (goto-char start) - (setq startcol (current-column)) - (beginning-of-line) - (setq startpt (point)) - (goto-char end) - (setq endcol (current-column)) - (forward-line 1) - (setq endpt (point-marker)) - ;; ensure the start column is the left one. + (save-excursion + (let* ((cols (rectangle--pos-cols start end)) + (startcol (car cols)) + (endcol (cdr cols)) + (startpt (progn (goto-char start) (line-beginning-position))) + (endpt (progn (goto-char end) + (copy-marker (line-end-position)))) + final-point) + ;; Ensure the start column is the left one. (if (< endcol startcol) (let ((col startcol)) (setq startcol endcol endcol col))) - ;; start looping over lines + ;; Start looping over lines. (goto-char startpt) - (while (< (point) endpt) - (apply function startcol endcol args) - (setq final-point (point)) - (forward-line 1))) - final-point)) + (while + (progn + (apply function startcol endcol args) + (setq final-point (point)) + (and (zerop (forward-line 1)) + (<= (point) endpt)))) + final-point))) (defun delete-rectangle-line (startcol endcol fill) (when (= (move-to-column startcol (if fill t 'coerce)) startcol) @@ -310,6 +370,67 @@ With a prefix (or a FILL) argument, also fill too short lines." (delete-rectangle-line startcol endcol nil)) (insert string)) +(defvar-local rectangle--string-preview-state nil) +(defvar-local rectangle--string-preview-window nil) + +(defun rectangle--string-flush-preview () + (mapc #'delete-overlay (nthcdr 3 rectangle--string-preview-state)) + (setf (nthcdr 3 rectangle--string-preview-state) nil)) + +(defun rectangle--string-erase-preview () + (with-selected-window rectangle--string-preview-window + (rectangle--string-flush-preview))) + +(defun rectangle--space-to (col) + (propertize " " 'display `(space :align-to ,col))) + +(defface rectangle-preview-face '((t :inherit region)) + "The face to use for the `string-rectangle' preview.") + +(defcustom rectangle-preview t + "If non-nil, `string-rectangle' will show an-the-fly preview." + :type 'boolean) + +(defun rectangle--string-preview () + (let ((str (minibuffer-contents))) + (when (equal str "") + (setq str (or (car-safe minibuffer-default) + (if (stringp minibuffer-default) minibuffer-default)))) + (setq str (propertize str 'face 'region)) + (with-selected-window rectangle--string-preview-window + (unless (or (null rectangle--string-preview-state) + (equal str (car rectangle--string-preview-state))) + (rectangle--string-flush-preview) + (apply-on-rectangle + (lambda (startcol endcol) + (let* ((sc (move-to-column startcol)) + (start (if (<= sc startcol) (point) + (forward-char -1) + (setq sc (current-column)) + (point))) + (ec (move-to-column endcol)) + (end (point)) + (ol (make-overlay start end))) + (push ol (nthcdr 3 rectangle--string-preview-state)) + ;; FIXME: The extra spacing doesn't interact correctly with + ;; the extra spacing added by the rectangular-region-highlight. + (when (< sc startcol) + (overlay-put ol 'before-string (rectangle--space-to startcol))) + (let ((as (when (< endcol ec) + ;; (rectangle--space-to ec) + (spaces-string (- ec endcol)) + ))) + (if (= start end) + (overlay-put ol 'after-string (if as (concat str as) str)) + (overlay-put ol 'display str) + (if as (overlay-put ol 'after-string as)))))) + (nth 1 rectangle--string-preview-state) + (nth 2 rectangle--string-preview-state)))))) + +;; FIXME: Should this be turned into inhibit-region-highlight and made to apply +;; to non-rectangular regions as well? +(defvar rectangle--inhibit-region-highlight nil) + ;;;###autoload (defun string-rectangle (start end string) "Replace rectangle contents with STRING on each line. @@ -317,14 +438,31 @@ The length of STRING need not be the same as the rectangle width. Called from a program, takes three args; START, END and STRING." (interactive - (progn (barf-if-buffer-read-only) - (list - (region-beginning) - (region-end) + (progn + (make-local-variable 'rectangle--string-preview-state) + (make-local-variable 'rectangle--inhibit-region-highlight) + (let* ((buf (current-buffer)) + (win (if (eq (window-buffer) buf) (selected-window))) + (start (region-beginning)) + (end (region-end)) + (rectangle--string-preview-state `(nil ,start ,end)) + ;; Rectangle-region-highlighting doesn't work well in the presence + ;; of the preview overlays. We could work harder to try and make + ;; it work better, but it's easier to just disable it temporarily. + (rectangle--inhibit-region-highlight t)) + (barf-if-buffer-read-only) + (list start end + (minibuffer-with-setup-hook + (lambda () + (setq rectangle--string-preview-window win) + (add-hook 'minibuffer-exit-hook + #'rectangle--string-erase-preview nil t) + (add-hook 'post-command-hook + #'rectangle--string-preview nil t)) (read-string (format "String rectangle (default %s): " (or (car string-rectangle-history) "")) nil 'string-rectangle-history - (car string-rectangle-history))))) + (car string-rectangle-history))))))) (goto-char (apply-on-rectangle 'string-rectangle-line start end string t))) @@ -429,8 +567,12 @@ with a prefix argument, prompt for START-AT and FORMAT." (let ((map (make-sparse-keymap))) (define-key map [?\C-o] 'open-rectangle) (define-key map [?\C-t] 'string-rectangle) - ;; (define-key map [remap open-line] 'open-rectangle) - ;; (define-key map [remap transpose-chars] 'string-rectangle) + (define-key map [remap exchange-point-and-mark] + 'rectangle-exchange-point-and-mark) + (dolist (cmd '(right-char left-char forward-char backward-char + next-line previous-line)) + (define-key map (vector 'remap cmd) + (intern (format "rectangle-%s" cmd)))) map) "Keymap used while marking a rectangular region.") @@ -439,6 +581,7 @@ with a prefix argument, prompt for START-AT and FORMAT." "Toggle the region as rectangular. Activates the region if needed. Only lasts until the region is deactivated." nil nil nil + (rectangle--reset-crutches) (when rectangle-mark-mode (add-hook 'deactivate-mark-hook (lambda () (rectangle-mark-mode -1))) @@ -447,6 +590,96 @@ Activates the region if needed. Only lasts until the region is deactivated." (activate-mark) (message "Mark set (rectangle mode)")))) +(defun rectangle-exchange-point-and-mark (&optional arg) + "Like `exchange-point-and-mark' but cycles through the rectangle's corners." + (interactive "P") + (if arg + (progn + (setq this-command 'exchange-point-and-mark) + (exchange-point-and-mark arg)) + (let* ((p (point)) + (repeat (eq this-command last-command)) + (m (mark)) + (p<m (< p m)) + (cols (if p<m (rectangle--pos-cols p m) (rectangle--pos-cols m p))) + (cp (if p<m (car cols) (cdr cols))) + (cm (if p<m (cdr cols) (car cols)))) + (if repeat (setq this-command 'exchange-point-and-mark)) + (rectangle--reset-crutches) + (goto-char p) + (rectangle--col-pos (if repeat cm cp) 'mark) + (set-mark (point)) + (goto-char m) + (rectangle--col-pos (if repeat cp cm) 'point)))) + +(defun rectangle--*-char (cmd n &optional other-cmd) + ;; Part of the complexity here is that I'm trying to avoid making assumptions + ;; about the L2R/R2L direction of text around point, but this is largely + ;; useless since the rectangles implemented in this file are "logical + ;; rectangles" and not "visual rectangles", so in the presence of + ;; bidirectional text things won't work well anyway. + (if (< n 0) (rectangle--*-char other-cmd (- n)) + (let ((col (rectangle--point-col (point)))) + (while (> n 0) + (let* ((bol (line-beginning-position)) + (eol (line-end-position)) + (curcol (current-column)) + (nextcol + (condition-case nil + (save-excursion + (funcall cmd 1) + (cond + ((> bol (point)) (- curcol 1)) + ((< eol (point)) (+ col (1+ n))) + (t (current-column)))) + (end-of-buffer (+ col (1+ n))) + (beginning-of-buffer (- curcol 1)))) + (diff (abs (- nextcol col)))) + (cond + ((and (< nextcol curcol) (< curcol col)) + (let ((curdiff (- col curcol))) + (if (<= curdiff n) + (progn (cl-decf n curdiff) (setq col curcol)) + (setq col (- col n) n 0)))) + ((< nextcol 0) (ding) (setq n 0 col 0)) ;Bumping into BOL! + ((= nextcol curcol) (funcall cmd 1)) + (t ;; (> nextcol curcol) + (if (<= diff n) + (progn (cl-decf n diff) (setq col nextcol)) + (setq col (if (< col nextcol) (+ col n) (- col n)) n 0)))))) + ;; FIXME: This rectangle--col-pos's move-to-column is wasted! + (rectangle--col-pos col 'point)))) + +(defun rectangle-right-char (&optional n) + "Like `right-char' but steps into wide chars and moves past EOL." + (interactive "p") (rectangle--*-char #'right-char n #'left-char)) +(defun rectangle-left-char (&optional n) + "Like `left-char' but steps into wide chars and moves past EOL." + (interactive "p") (rectangle--*-char #'left-char n #'right-char)) + +(defun rectangle-forward-char (&optional n) + "Like `forward-char' but steps into wide chars and moves past EOL." + (interactive "p") (rectangle--*-char #'forward-char n #'backward-char)) +(defun rectangle-backward-char (&optional n) + "Like `backward-char' but steps into wide chars and moves past EOL." + (interactive "p") (rectangle--*-char #'backward-char n #'forward-char)) + +(defun rectangle-next-line (&optional n) + "Like `next-line' but steps into wide chars and moves past EOL. +Ignores `line-move-visual'." + (interactive "p") + (let ((col (rectangle--point-col (point)))) + (forward-line n) + (rectangle--col-pos col 'point))) +(defun rectangle-previous-line (&optional n) + "Like `previous-line' but steps into wide chars and moves past EOL. +Ignores `line-move-visual'." + (interactive "p") + (let ((col (rectangle--point-col (point)))) + (forward-line (- n)) + (rectangle--col-pos col 'point))) + + (defun rectangle--extract-region (orig &optional delete) (if (not rectangle-mark-mode) (funcall orig delete) @@ -476,100 +709,118 @@ Activates the region if needed. Only lasts until the region is deactivated." (while (not (eq pending-undo-list (cdr undo-at-start))) (undo-more 1)))))) +(defun rectangle--place-cursor (leftcol left str) + (let ((pc (window-parameter nil 'rectangle--point-crutches))) + (if (and (eq left (car pc)) (eq leftcol (cdr pc))) + (put-text-property 0 1 'cursor 1 str)))) + (defun rectangle--highlight-for-redisplay (orig start end window rol) (cond ((not rectangle-mark-mode) (funcall orig start end window rol)) + (rectangle--inhibit-region-highlight + (rectangle--unhighlight-for-redisplay orig rol) + nil) ((and (eq 'rectangle (car-safe rol)) (eq (nth 1 rol) (buffer-chars-modified-tick)) (eq start (nth 2 rol)) - (eq end (nth 3 rol))) + (eq end (nth 3 rol)) + (equal (rectangle--crutches) (nth 4 rol))) rol) (t (save-excursion (let* ((nrol nil) (old (if (eq 'rectangle (car-safe rol)) - (nthcdr 4 rol) + (nthcdr 5 rol) (funcall redisplay-unhighlight-region-function rol) - nil)) - (ptcol (progn (goto-char start) (current-column))) - (markcol (progn (goto-char end) (current-column))) - (leftcol (min ptcol markcol)) - (rightcol (max ptcol markcol))) - (goto-char start) - (while - (let* ((mleft (move-to-column leftcol)) - (left (point)) - (mright (move-to-column rightcol)) - (right (point)) - (ol - (if (not old) - (let ((ol (make-overlay left right))) - (overlay-put ol 'window window) - (overlay-put ol 'face 'region) - ol) - (let ((ol (pop old))) - (move-overlay ol left right (current-buffer)) - ol)))) - ;; `move-to-column' may stop before the column (if bumping into - ;; EOL) or overshoot it a little, when column is in the middle - ;; of a char. - (cond - ((< mleft leftcol) ;`leftcol' is past EOL. - (overlay-put ol 'before-string - (spaces-string (- leftcol mleft))) - (setq mright (max mright leftcol))) - ((and (> mleft leftcol) ;`leftcol' is in the middle of a char. - (eq (char-before left) ?\t)) - (setq left (1- left)) - (move-overlay ol left right) - (goto-char left) - (overlay-put ol 'before-string - (spaces-string (- leftcol (current-column))))) - ((overlay-get ol 'before-string) - (overlay-put ol 'before-string nil))) - (cond - ((< mright rightcol) ;`rightcol' is past EOL. - (let ((str (make-string (- rightcol mright) ?\s))) - (put-text-property 0 (length str) 'face 'region str) - ;; If cursor happens to be here, draw it *before* rather than - ;; after this highlighted pseudo-text. - (put-text-property 0 1 'cursor t str) - (overlay-put ol 'after-string str))) - ((and (> mright rightcol) ;`rightcol's in the middle of a char. - (eq (char-before right) ?\t)) - (setq right (1- right)) - (move-overlay ol left right) - (if (= rightcol leftcol) - (overlay-put ol 'after-string nil) - (goto-char right) - (let ((str (make-string - (- rightcol (max leftcol (current-column))) - ?\s))) - (put-text-property 0 (length str) 'face 'region str) - (when (= left right) - ;; If cursor happens to be here, draw it *before* rather - ;; than after this highlighted pseudo-text. - (put-text-property 0 1 'cursor 1 str)) - (overlay-put ol 'after-string str)))) - ((overlay-get ol 'after-string) - (overlay-put ol 'after-string nil))) - (when (and (= leftcol rightcol) (display-graphic-p)) - ;; Make zero-width rectangles visible! - (overlay-put ol 'after-string - (concat (propertize " " - 'face '(region (:height 0.2))) - (overlay-get ol 'after-string)))) - (push ol nrol) - (and (zerop (forward-line 1)) - (<= (point) end)))) + nil))) + (cl-assert (eq (window-buffer window) (current-buffer))) + ;; `rectangle--pos-cols' looks up the `selected-window's parameter! + (with-selected-window window + (apply-on-rectangle + (lambda (leftcol rightcol) + (let* ((mleft (move-to-column leftcol)) + (left (point)) + ;; BEWARE: In the presence of other overlays with + ;; before/after/display-strings, this happens to move to + ;; the column "as if the overlays were not applied", which + ;; is sometimes what we want, tho it can be + ;; considered a bug in move-to-column (it should arguably + ;; pay attention to the before/after-string/display + ;; properties when computing the column). + (mright (move-to-column rightcol)) + (right (point)) + (ol + (if (not old) + (let ((ol (make-overlay left right))) + (overlay-put ol 'window window) + (overlay-put ol 'face 'region) + ol) + (let ((ol (pop old))) + (move-overlay ol left right (current-buffer)) + ol)))) + ;; `move-to-column' may stop before the column (if bumping into + ;; EOL) or overshoot it a little, when column is in the middle + ;; of a char. + (cond + ((< mleft leftcol) ;`leftcol' is past EOL. + (overlay-put ol 'before-string (rectangle--space-to leftcol)) + (setq mright (max mright leftcol))) + ((and (> mleft leftcol) ;`leftcol' is in the middle of a char. + (eq (char-before left) ?\t)) + (setq left (1- left)) + (move-overlay ol left right) + (goto-char left) + (overlay-put ol 'before-string (rectangle--space-to leftcol))) + ((overlay-get ol 'before-string) + (overlay-put ol 'before-string nil))) + (cond + ;; While doing rectangle--string-preview, the two sets of + ;; overlays steps on the other's toes. I fixed some of the + ;; problems, but others remain. The main one is the two + ;; (rectangle--space-to rightcol) below which try to virtually + ;; insert missing text, but during "preview", the text is not + ;; missing (it's provided by preview's own overlay). + (rectangle--string-preview-state + (if (overlay-get ol 'after-string) + (overlay-put ol 'after-string nil))) + ((< mright rightcol) ;`rightcol' is past EOL. + (let ((str (rectangle--space-to rightcol))) + (put-text-property 0 (length str) 'face 'region str) + ;; If cursor happens to be here, draw it at the right place. + (rectangle--place-cursor leftcol left str) + (overlay-put ol 'after-string str))) + ((and (> mright rightcol) ;`rightcol's in the middle of a char. + (eq (char-before right) ?\t)) + (setq right (1- right)) + (move-overlay ol left right) + (if (= rightcol leftcol) + (overlay-put ol 'after-string nil) + (goto-char right) + (let ((str (rectangle--space-to rightcol))) + (put-text-property 0 (length str) 'face 'region str) + (when (= left right) + (rectangle--place-cursor leftcol left str)) + (overlay-put ol 'after-string str)))) + ((overlay-get ol 'after-string) + (overlay-put ol 'after-string nil))) + (when (and (= leftcol rightcol) (display-graphic-p)) + ;; Make zero-width rectangles visible! + (overlay-put ol 'after-string + (concat (propertize " " + 'face '(region (:height 0.2))) + (overlay-get ol 'after-string)))) + (push ol nrol))) + start end)) (mapc #'delete-overlay old) - `(rectangle ,(buffer-chars-modified-tick) ,start ,end ,@nrol)))))) + `(rectangle ,(buffer-chars-modified-tick) + ,start ,end ,(rectangle--crutches) + ,@nrol)))))) (defun rectangle--unhighlight-for-redisplay (orig rol) (if (not (eq 'rectangle (car-safe rol))) (funcall orig rol) - (mapc #'delete-overlay (nthcdr 4 rol)) + (mapc #'delete-overlay (nthcdr 5 rol)) (setcar (cdr rol) nil))) (provide 'rect) diff --git a/lisp/register.el b/lisp/register.el index 1c64a9a8e64..eb3c71afece 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -27,7 +27,7 @@ ;; This package of functions emulates and somewhat extends the venerable ;; TECO's `register' feature, which permits you to save various useful ;; pieces of buffer state to named variables. The entry points are -;; documented in the Emacs user's manual. +;; documented in the Emacs user's manual: (info "(emacs) Registers"). (eval-when-compile (require 'cl-lib)) @@ -161,7 +161,7 @@ display such a window regardless." collect c))) (unwind-protect (progn - (while (memq (read-event (propertize prompt 'face 'minibuffer-prompt)) + (while (memq (read-key (propertize prompt 'face 'minibuffer-prompt)) help-chars) (unless (get-buffer-window buffer) (register-preview buffer 'show-empty))) diff --git a/lisp/replace.el b/lisp/replace.el index fda2213236b..cf88cb57b89 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -523,6 +523,8 @@ What you probably want is a loop like this: which will run faster and will not set the mark or print anything. \(You may need a more complex loop if FROM-STRING can match the null string and TO-STRING is also null.)" + (declare (interactive-only + "use `search-forward' and `replace-match' instead.")) (interactive (let ((common (query-replace-read-args @@ -540,8 +542,6 @@ and TO-STRING is also null.)" (region-end)) (nth 3 common)))) (perform-replace from-string to-string nil nil delimited nil nil start end backward)) -(put 'replace-string 'interactive-only - "use `search-forward' and `replace-match' instead.") (defun replace-regexp (regexp to-string &optional delimited start end backward) "Replace things after point matching REGEXP with TO-STRING. @@ -597,6 +597,8 @@ What you probably want is a loop like this: (while (re-search-forward REGEXP nil t) (replace-match TO-STRING nil nil)) which will run faster and will not set the mark or print anything." + (declare (interactive-only + "use `re-search-forward' and `replace-match' instead.")) (interactive (let ((common (query-replace-read-args @@ -614,8 +616,6 @@ which will run faster and will not set the mark or print anything." (region-end)) (nth 3 common)))) (perform-replace regexp to-string nil t delimited nil nil start end backward)) -(put 'replace-regexp 'interactive-only - "use `re-search-forward' and `replace-match' instead.") (defvar regexp-history nil diff --git a/lisp/reveal.el b/lisp/reveal.el index f251c05f5eb..8d611ea04df 100644 --- a/lisp/reveal.el +++ b/lisp/reveal.el @@ -83,7 +83,8 @@ Each element has the form (WINDOW . OVERLAY).") (cond ((eq (car x) (selected-window)) (cdr x)) ((not (and (window-live-p (car x)) - (eq (window-buffer (car x)) (current-buffer)))) + (eq (window-buffer (car x)) + (current-buffer)))) ;; Adopt this since it's owned by a window that's ;; either not live or at least not showing this ;; buffer any more. @@ -135,8 +136,9 @@ Each element has the form (WINDOW . OVERLAY).") old-ols) (defun reveal-close-old-overlays (old-ols) - (if (not (eq reveal-last-tick - (setq reveal-last-tick (buffer-modified-tick)))) + (if (or track-mouse ;Don't close in the middle of a click. + (not (eq reveal-last-tick + (setq reveal-last-tick (buffer-modified-tick))))) ;; The buffer was modified since last command: let's refrain from ;; closing any overlay because it tends to behave poorly when ;; inserting text at the end of an overlay (basically the overlay diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el index 9e32a2f5c64..238754e8584 100644 --- a/lisp/ruler-mode.el +++ b/lisp/ruler-mode.el @@ -306,7 +306,6 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or "Return a column number relative to the selected window. N is a column number relative to selected frame." (- n - (car (window-edges)) (or (car (window-margins)) 0) (fringe-columns 'left) (scroll-bar-columns 'left))) @@ -321,7 +320,7 @@ START-EVENT is the mouse click event." (when (eq start end) ;; mouse click (save-selected-window (select-window (posn-window start)) - (setq col (- (car (posn-col-row start)) (car (window-edges)) + (setq col (- (car (posn-col-row start)) (scroll-bar-columns 'left)) w (- (ruler-mode-full-window-width) (scroll-bar-columns 'left) @@ -343,7 +342,7 @@ START-EVENT is the mouse click event." (when (eq start end) ;; mouse click (save-selected-window (select-window (posn-window start)) - (setq col (- (car (posn-col-row start)) (car (window-edges)) + (setq col (- (car (posn-col-row start)) (scroll-bar-columns 'left)) w (- (ruler-mode-full-window-width) (scroll-bar-columns 'left) diff --git a/lisp/savehist.el b/lisp/savehist.el index 6abc29cccc2..26e9d0b881d 100644 --- a/lisp/savehist.el +++ b/lisp/savehist.el @@ -278,13 +278,6 @@ If AUTO-SAVE is non-nil, compare the saved contents to the one last saved, (print-level nil) (print-readably t) (print-quoted t)) - ;; During the 24.3 development, read-passwd had a bug which resulted in - ;; the passwords being saved by savehist. Trim them, retroactively. - ;; This code can be removed after the 24.3 release. - (dolist (sym savehist-minibuffer-history-variables) - (if (and (symbolp sym) (equal (symbol-name sym) "forget-history")) - (setq savehist-minibuffer-history-variables - (delq sym savehist-minibuffer-history-variables)))) ;; Save the minibuffer histories, along with the value of ;; savehist-minibuffer-history-variables itself. (when savehist-save-minibuffer-history diff --git a/lisp/scroll-all.el b/lisp/scroll-all.el index b56a020c795..1aa2fc7d2bb 100644 --- a/lisp/scroll-all.el +++ b/lisp/scroll-all.el @@ -3,7 +3,7 @@ ;; Copyright (C) 1997, 2001-2014 Free Software Foundation, Inc. ;; Author: Gary D. Foster <Gary.Foster@corp.sun.com> -;; Keywords: scroll crisp brief lock +;; Keywords: convenience scroll lock ;; This file is part of GNU Emacs. diff --git a/lisp/server.el b/lisp/server.el index 0c645889d75..681d93d6f5d 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -642,8 +642,6 @@ server or call `M-x server-force-delete' to forcibly disconnect it.") (cl-letf (((default-file-modes) ?\700)) (add-hook 'suspend-tty-functions 'server-handle-suspend-tty) (add-hook 'delete-frame-functions 'server-handle-delete-frame) - (add-hook 'kill-buffer-query-functions - 'server-kill-buffer-query-function) (add-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function) (add-hook 'kill-emacs-hook 'server-force-stop) ;Cleanup upon exit. @@ -1472,22 +1470,6 @@ specifically for the clients and did not exist before their request for it." (save-buffer))) (server-buffer-done (current-buffer)))) -;; Ask before killing a server buffer. -;; It was suggested to release its client instead, -;; but I think that is dangerous--the client would proceed -;; using whatever is on disk in that file. -- rms. -(defun server-kill-buffer-query-function () - "Ask before killing a server buffer." - (or (not server-buffer-clients) - (let ((res t)) - (dolist (proc server-buffer-clients) - (when (and (memq proc server-clients) - (eq (process-status proc) 'open)) - (setq res nil))) - res) - (yes-or-no-p (format "Buffer `%s' still has clients; kill it? " - (buffer-name (current-buffer)))))) - (defun server-kill-emacs-query-function () "Ask before exiting Emacs if it has live clients." (or (not server-clients) diff --git a/lisp/ses.el b/lisp/ses.el index 1626147dab4..a4f5609575d 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -1,4 +1,4 @@ -;;; ses.el -- Simple Emacs Spreadsheet -*- coding: utf-8 -*- +;;; ses.el -- Simple Emacs Spreadsheet -*- lexical-binding:t -*- ;; Copyright (C) 2002-2014 Free Software Foundation, Inc. @@ -239,6 +239,10 @@ Each function is called with ARG=1." "\n( ;Global parameters (these are read first)\n 2 ;SES file-format\n 1 ;numrows\n 1 ;numcols\n)\n\n" "Initial contents for the three-element list at the bottom of the data area.") +(defconst ses-initial-global-parameters-re + "\n( ;Global parameters (these are read first)\n [23] ;SES file-format\n [0-9]+ ;numrows\n [0-9]+ ;numcols\n\\( [0-9]+ ;numlocprn\n\\)?)\n\n" + "Match Global parameters for .") + (defconst ses-initial-file-trailer ";; Local Variables:\n;; mode: ses\n;; End:\n" "Initial contents for the file-trailer area at the bottom of the file.") @@ -277,6 +281,8 @@ default printer and then modify its output.") '(ses--blank-line ses--cells ses--col-printers ses--col-widths ses--curcell ses--curcell-overlay ses--default-printer + (ses--local-printer-hashmap . :hashmap) + (ses--numlocprn . 0); count of local printers ses--deferred-narrow ses--deferred-recalc ses--deferred-write ses--file-format ses--named-cell-hashmap @@ -290,8 +296,12 @@ default printer and then modify its output.") ses--renamed-cell-symb-list ;; Global variables that we override mode-line-process next-line-add-newlines transient-mark-mode) - "Buffer-local variables used by SES.") + "Buffer-local variables used by SES.")) +(defmacro ses--metaprogramming (exp) (declare (debug t)) (eval exp t)) +(ses--metaprogramming + `(progn ,@(mapcar (lambda (x) `(defvar ,(or (car-safe x) x))) ses-localvars))) + (defun ses-set-localvars () "Set buffer-local and initialize some SES variables." (dolist (x ses-localvars) @@ -299,11 +309,14 @@ default printer and then modify its output.") ((symbolp x) (set (make-local-variable x) nil)) ((consp x) - (set (make-local-variable (car x)) (cdr x))) - (t (error "Unexpected elements `%S' in list `ses-localvars'" x)))))) - -(eval-when-compile ; silence compiler - (ses-set-localvars)) + (cond + ((integerp (cdr x)) + (set (make-local-variable (car x)) (cdr x))) + ((eq (cdr x) :hashmap) + (set (make-local-variable (car x)) (make-hash-table :test 'eq))) + (t (error "Unexpected initializer `%S' in list `ses-localvars' for entry %S" + (cdr x) (car x)) ) )) + (t (error "Unexpected elements `%S' in list `ses-localvars'" x))))) ;;; This variable is documented as being permitted in file-locals: (put 'ses--symbolic-formulas 'safe-local-variable 'consp) @@ -311,10 +324,21 @@ default printer and then modify its output.") (defconst ses-paramlines-plist '(ses--col-widths -5 ses--col-printers -4 ses--default-printer -3 ses--header-row -2 ses--file-format 1 ses--numrows 2 - ses--numcols 3) + ses--numcols 3 ses--numlocprn 4) "Offsets from 'Global parameters' line to various parameter lines in the data area of a spreadsheet.") +(defconst ses-paramfmt-plist + '(ses--col-widths "(ses-column-widths %S)" + ses--col-printers "(ses-column-printers %S)" + ses--default-printer "(ses-default-printer %S)" + ses--header-row "(ses-header-row %S)" + ses--file-format " %S ;SES file-format" + ses--numrows " %S ;numrows" + ses--numcols " %S ;numcols" + ses--numlocprn " %S ;numlocprn") + "Formats of 'Global parameters' various parameters in the data +area of a spreadsheet.") ;; ;; "Side-effect variables". They are set in one function, altered in @@ -347,158 +371,115 @@ when to emit a progress message.") (defmacro ses-get-cell (row col) "Return the cell structure that stores information about cell (ROW,COL)." + (declare (debug t)) `(aref (aref ses--cells ,row) ,col)) -;; We might want to use defstruct here, but cells are explicitly used as -;; arrays in ses-set-cell, so we'd need to fix this first. --Stef -(defsubst ses-make-cell (&optional symbol formula printer references - property-list) - (vector symbol formula printer references property-list)) +(cl-defstruct (ses-cell + (:constructor nil) + (:constructor ses-make-cell + (&optional symbol formula printer references)) + (:copier nil) + ;; This is treated as an 4-elem array in various places. + ;; Mostly in ses-set-cell. + (:type vector) ;Not named. + (:conc-name ses-cell--)) + symbol formula printer references properties) + +(cl-defstruct (ses--locprn + (:constructor) + (:constructor ses-make-local-printer-info + (def &optional (compiled (ses-local-printer-compile def)) + (number ses--numlocprn)))) + def + compiled + number + local-printer-list) (defmacro ses-cell-symbol (row &optional col) "From a CELL or a pair (ROW,COL), get the symbol that names the local-variable holding its value. (0,0) => A1." - `(aref ,(if col `(ses-get-cell ,row ,col) row) 0)) + (declare (debug t)) + `(ses-cell--symbol ,(if col `(ses-get-cell ,row ,col) row))) (put 'ses-cell-symbol 'safe-function t) (defmacro ses-cell-formula (row &optional col) "From a CELL or a pair (ROW,COL), get the function that computes its value." - `(aref ,(if col `(ses-get-cell ,row ,col) row) 1)) - -(defmacro ses-cell-formula-aset (cell formula) - "From a CELL set the function that computes its value." - `(aset ,cell 1 ,formula)) + (declare (debug t)) + `(ses-cell--formula ,(if col `(ses-get-cell ,row ,col) row))) (defmacro ses-cell-printer (row &optional col) "From a CELL or a pair (ROW,COL), get the function that prints its value." - `(aref ,(if col `(ses-get-cell ,row ,col) row) 2)) + (declare (debug t)) + `(ses-cell--printer ,(if col `(ses-get-cell ,row ,col) row))) (defmacro ses-cell-references (row &optional col) "From a CELL or a pair (ROW,COL), get the list of symbols for cells whose functions refer to its value." - `(aref ,(if col `(ses-get-cell ,row ,col) row) 3)) - -(defmacro ses-cell-references-aset (cell references) - "From a CELL set the list REFERENCES of symbols for cells the -function of which refer to its value." - `(aset ,cell 3 ,references)) + (declare (debug t)) + `(ses-cell--references ,(if col `(ses-get-cell ,row ,col) row))) (defun ses-cell-p (cell) - "Return non `nil' is CELL is a cell of current buffer." + "Return non-nil if CELL is a cell of current buffer." (and (vectorp cell) (= (length cell) 5) (eq cell (let ((rowcol (ses-sym-rowcol (ses-cell-symbol cell)))) (and (consp rowcol) (ses-get-cell (car rowcol) (cdr rowcol))))))) -(defun ses-cell-property-get-fun (property-name cell) - ;; To speed up property fetching, each time a property is found it is placed - ;; in the first position. This way, after the first get, the full property - ;; list needs to be scanned only when the property does not exist for that - ;; cell. - (let* ((plist (aref cell 4)) - (ret (plist-member plist property-name))) - (if ret - ;; Property was found. - (let ((val (cadr ret))) - (if (eq ret plist) - ;; Property found is already in the first position, so just return - ;; its value. - val - ;; Property is not in the first position, the following will move it - ;; there before returning its value. - (let ((next (cddr ret))) - (if next - (progn - (setcdr ret (cdr next)) - (setcar ret (car next))) - (setcdr (last plist 1) nil))) - (aset cell 4 - `(,property-name ,val ,@plist)) - val))))) - -(defmacro ses-cell-property-get (property-name row &optional col) - "Get property named PROPERTY-NAME from a CELL or a pair (ROW,COL). + +(defun ses--alist-get (key alist &optional remove) + "Get the value associated to KEY in ALIST." + (declare + (gv-expander + (lambda (do) + (macroexp-let2 macroexp-copyable-p k key + (gv-letplace (getter setter) alist + (macroexp-let2 nil p `(assq ,k ,getter) + (funcall do `(cdr ,p) + (lambda (v) + (let ((set-exp + `(if ,p (setcdr ,p ,v) + ,(funcall setter + `(cons (setq ,p (cons ,k ,v)) + ,getter))))) + (cond + ((null remove) set-exp) + ((null v) + `(if ,p ,(funcall setter `(delq ,p ,getter)))) + (t + `(cond + (,v ,set-exp) + (,p ,(funcall setter + `(delq ,p ,getter))))))))))))))) + (ignore remove) ;;Silence byte-compiler. + (cdr (assoc key alist))) + +(defmacro ses--letref (vars place &rest body) + (declare (indent 2) (debug (sexp form &rest body))) + (gv-letplace (getter setter) place + `(cl-macrolet ((,(nth 0 vars) () ',getter) + (,(nth 1 vars) (v) (funcall ,setter v))) + ,@body))) + +(defmacro ses-cell-property (property-name row &optional col) + "Get property named PROPERTY-NAME from a CELL or a pair (ROW,COL). When COL is omitted, CELL=ROW is a cell object. When COL is present ROW and COL are the integer coordinates of the cell of interest." - (declare (debug t)) - `(ses-cell-property-get-fun - ,property-name - ,(if col `(ses-get-cell ,row ,col) row))) - -(defun ses-cell-property-delq-fun (property-name cell) - (let ((ret (plist-get (aref cell 4) property-name))) - (if ret - (setcdr ret (cddr ret))))) - -(defun ses-cell-property-set-fun (property-name property-val cell) - (let* ((plist (aref cell 4)) - (ret (plist-member plist property-name))) - (if ret - (setcar (cdr ret) property-val) - (aset cell 4 `(,property-name ,property-val ,@plist))))) - -(defmacro ses-cell-property-set (property-name property-value row &optional col) - "From a CELL or a pair (ROW,COL), set the property value of -the corresponding cell with name PROPERTY-NAME to PROPERTY-VALUE." - (if property-value - `(ses-cell-property-set-fun ,property-name ,property-value - ,(if col `(ses-get-cell ,row ,col) row)) - `(ses-cell-property-delq-fun ,property-name - ,(if col `(ses-get-cell ,row ,col) row)))) - -(defun ses-cell-property-pop-fun (property-name cell) - (let* ((plist (aref cell 4)) - (ret (plist-member plist property-name))) - (if ret - (prog1 (cadr ret) - (let ((next (cddr ret))) - (if next - (progn - (setcdr ret (cdr next)) - (setcar ret (car next))) - (if (eq plist ret) - (aset cell 4 nil) - (setcdr (last plist 2) nil)))))))) - + (declare (debug t)) + `(ses--alist-get ,property-name + (ses-cell--properties + ,(if col `(ses-get-cell ,row ,col) row)))) (defmacro ses-cell-property-pop (property-name row &optional col) - "From a CELL or a pair (ROW,COL), get and remove the property value of + "From a CELL or a pair (ROW,COL), get and remove the property value of the corresponding cell with name PROPERTY-NAME." - `(ses-cell-property-pop-fun ,property-name - ,(if col `(ses-get-cell ,row ,col) row))) - -(defun ses-cell-property-get-handle-fun (property-name cell) - (let* ((plist (aref cell 4)) - (ret (plist-member plist property-name))) - (if ret - (if (eq ret plist) - (cdr ret) - (let ((val (cadr ret)) - (next (cddr ret))) - (if next - (progn - (setcdr ret (cdr next)) - (setcar ret (car next))) - (setcdr (last plist 2) nil)) - (setq ret (cons val plist)) - (aset cell 4 (cons property-name ret)) - ret)) - (setq ret (cons nil plist)) - (aset cell 4 (cons property-name ret)) - ret))) - -(defmacro ses-cell-property-get-handle (property-name row &optional col) - "From a CELL or a pair (ROW,COL), get a cons cell whose car is -the property value of the corresponding cell property with name -PROPERTY-NAME." - `(ses-cell-property-get-handle-fun ,property-name - ,(if col `(ses-get-cell ,row ,col) row))) - - -(defalias 'ses-cell-property-handle-car 'car) -(defalias 'ses-cell-property-handle-setcar 'setcar) + `(ses--letref (pget pset) + (ses--alist-get ,property-name + (ses-cell--properties + ,(if col `(ses-get-cell ,row ,col) row)) + t) + (prog1 (pget) (pset nil)))) (defmacro ses-cell-value (row &optional col) "From a CELL or a pair (ROW,COL), get the current value for that cell." @@ -530,14 +511,14 @@ is nil if SYM is not a symbol that names a cell." (< (cdr rowcol) ses--numcols) (eq (ses-cell-symbol (car rowcol) (cdr rowcol)) sym)))))) -(defmacro ses-cell (sym value formula printer references) +(defun ses--cell (sym value formula printer references) "Load a cell SYM from the spreadsheet file. Does not recompute VALUE from -FORMULA, does not reprint using PRINTER, does not check REFERENCES. This is a -macro to prevent propagate-on-load viruses. Safety-checking for FORMULA and -PRINTER are deferred until first use." +FORMULA, does not reprint using PRINTER, does not check REFERENCES. +Safety-checking for FORMULA and PRINTER are deferred until first use." (let ((rowcol (ses-sym-rowcol sym))) (ses-formula-record formula) (ses-printer-record printer) + (unless formula (setq formula value)) (or (atom formula) (eq safe-functions t) (setq formula `(ses-safe-formula ,formula))) @@ -545,11 +526,32 @@ PRINTER are deferred until first use." (stringp printer) (eq safe-functions t) (setq printer `(ses-safe-printer ,printer))) - (aset (aref ses--cells (car rowcol)) - (cdr rowcol) + (setf (ses-get-cell (car rowcol) (cdr rowcol)) (ses-make-cell sym formula printer references))) - (set sym value) - sym) + (set sym value)) + +(defun ses-local-printer-compile (printer) + "Convert local printer function into faster printer +definition." + (cond + ((functionp printer) printer) + ((stringp printer) + `(lambda (x) (format ,printer x))) + (t (error "Invalid printer %S" printer)))) + +(defun ses--local-printer (name def) + "Define a local printer with name NAME and definition DEF. +Return the printer info." + (or + (and (symbolp name) + (ses-printer-validate def)) + (error "Invalid local printer definition")) + (and (gethash name ses--local-printer-hashmap) + (error "Duplicate printer definition %S" name)) + (add-to-list 'ses-read-printer-history (symbol-name name)) + (puthash name + (ses-make-local-printer-info (ses-safe-printer def)) + ses--local-printer-hashmap)) (defmacro ses-column-widths (widths) "Load the vector of column widths from the spreadsheet file. This is a @@ -619,9 +621,11 @@ variables `minrow', `maxrow', `mincol', and `maxcol'." (defmacro 1value (form) "For code-coverage testing, indicate that FORM is expected to always have the same value." + (declare (debug t)) form) (defmacro noreturn (form) "For code-coverage testing, indicate that FORM will always signal an error." + (declare (debug t)) form) @@ -664,9 +668,11 @@ is a vector--if a symbol, the new vector is assigned as the symbol's value." "Signal an error if PRINTER is not a valid SES cell printer." (or (not printer) (stringp printer) + ;; printer is a local printer + (and (symbolp printer) (gethash printer ses--local-printer-hashmap)) (functionp printer) (and (stringp (car-safe printer)) (not (cdr printer))) - (error "Invalid printer function")) + (error "Invalid printer function %S" printer)) printer) (defun ses-printer-record (printer) @@ -698,20 +704,22 @@ for this spreadsheet." (intern (concat (ses-column-letter col) (number-to-string (1+ row))))) (defun ses-decode-cell-symbol (str) - "Decode a symbol \"A1\" => (0,0). Returns `nil' if STR is not a - canonical cell name. Does not save match data." + "Decode a symbol \"A1\" => (0,0). Return nil if STR is not a +canonical cell name." (let (case-fold-search) (and (string-match "\\`\\([A-Z]+\\)\\([0-9]+\\)\\'" str) (let* ((col-str (match-string-no-properties 1 str)) - (col 0) - (col-base 1) - (col-idx (1- (length col-str))) - (row (1- (string-to-number (match-string-no-properties 2 str))))) + (col 0) + (col-base 1) + (col-idx (1- (length col-str))) + (row (1- (string-to-number + (match-string-no-properties 2 str))))) (and (>= row 0) (progn (while (progn - (setq col (+ col (* (- (aref col-str col-idx) ?A) col-base)) + (setq col (+ col (* (- (aref col-str col-idx) ?A) + col-base)) col-base (* col-base 26) col-idx (1- col-idx)) (and (>= col-idx 0) @@ -785,21 +793,34 @@ and (eval ARG) and reset `ses-start-time' to the current time." ;; The cells ;;---------------------------------------------------------------------------- -(defun ses-set-cell (row col field val) +(defmacro ses-set-cell (row col field val) "Install VAL as the contents for field FIELD (named by a quoted symbol) of cell (ROW,COL). This is undoable. The cell's data will be updated through `post-command-hook'." - (let ((cell (ses-get-cell row col)) - (elt (plist-get '(value t symbol 0 formula 1 printer 2 references 3) - field)) - change) - (or elt (signal 'args-out-of-range nil)) - (setq change (if (eq elt t) - (ses-set-with-undo (ses-cell-symbol cell) val) - (ses-aset-with-undo cell elt val))) - (if change - (add-to-list 'ses--deferred-write (cons row col)))) - nil) ; Make coverage-tester happy. + `(let ((row ,row) + (col ,col) + (val ,val)) + (let* ((cell (ses-get-cell row col)) + (change + ,(let ((field (eval field t))) + (if (eq field 'value) + `(ses-set-with-undo (ses-cell-symbol cell) val) + ;; (let* ((slots (get 'ses-cell 'cl-struct-slots)) + ;; (slot (or (assq field slots) + ;; (error "Unknown field %S" field))) + ;; (idx (- (length slots) + ;; (length (memq slot slots))))) + ;; `(ses-aset-with-undo cell ,idx val)) + (let ((getter (intern-soft (format "ses-cell--%s" field)))) + `(ses-setter-with-undo + (eval-when-compile + (cons #',getter + (lambda (newval cell) + (setf (,getter cell) newval)))) + val cell)))))) + (if change + (add-to-list 'ses--deferred-write (cons row col)))) + nil)) ; Make coverage-tester happy. (defun ses-cell-set-formula (row col formula) "Store a new formula for (ROW . COL) and enqueue the cell for @@ -814,7 +835,7 @@ means Emacs will crash if FORMULA contains a circular list." (newref (ses-formula-references formula)) (inhibit-quit t) x xrow xcol) - (add-to-list 'ses--deferred-recalc sym) + (cl-pushnew sym ses--deferred-recalc) ;;Delete old references from this cell. Skip the ones that are also ;;in the new list. (dolist (ref oldref) @@ -845,11 +866,11 @@ means Emacs will crash if FORMULA contains a circular list." (dotimes (col ses--numcols) (let ((references (ses-cell-property-pop :ses-repair-reference row col))) - (when references - (push (list - (ses-cell-symbol row col) - :corrupt-property - references) errors))))) + (when references + (push (list (ses-cell-symbol row col) + :corrupt-property + references) + errors))))) ;; Step 2, build new. (dotimes (row ses--numrows) @@ -859,21 +880,17 @@ means Emacs will crash if FORMULA contains a circular list." (formula (ses-cell-formula cell)) (new-ref (ses-formula-references formula))) (dolist (ref new-ref) - (let* ((rowcol (ses-sym-rowcol ref)) - (h (ses-cell-property-get-handle :ses-repair-reference - (car rowcol) (cdr rowcol)))) - (unless (memq ref (ses-cell-property-handle-car h)) - (ses-cell-property-handle-setcar - h - (cons sym - (ses-cell-property-handle-car h))))))))) + (let ((rowcol (ses-sym-rowcol ref))) + (cl-pushnew sym (ses-cell-property :ses-repair-reference + (car rowcol) + (cdr rowcol)))))))) ;; Step 3, overwrite with check. (dotimes (row ses--numrows) (dotimes (col ses--numcols) (let* ((cell (ses-get-cell row col)) (irrelevant (ses-cell-references cell)) - (new-ref (ses-cell-property-pop :ses-repair-reference cell)) + (new-ref (ses-cell-property-pop :ses-repair-reference cell)) missing) (dolist (ref new-ref) (if (memq ref irrelevant) @@ -886,7 +903,7 @@ means Emacs will crash if FORMULA contains a circular list." ,@(and irrelevant (list :irrelevant irrelevant))) errors))))) (if errors - (warn "---------------------------------------------------------------- + (warn "---------------------------------------------------------------- Some references were corrupted. The following is a list where each element ELT is such @@ -917,12 +934,7 @@ the old and FORCE is nil." (let ((oldval (ses-cell-value cell)) (formula (ses-cell-formula cell)) newval - this-cell-Dijkstra-attempt-h - this-cell-Dijkstra-attempt - this-cell-Dijkstra-attempt+1 - ref-cell-Dijkstra-attempt-h - ref-cell-Dijkstra-attempt - ref-rowcol) + this-cell-Dijkstra-attempt+1) (when (eq (car-safe formula) 'ses-safe-formula) (setq formula (ses-safe-formula (cadr formula))) (ses-set-cell row col 'formula formula)) @@ -938,46 +950,42 @@ the old and FORCE is nil." (setq newval '*skip*)) (catch 'cycle (when (or force (not (eq newval oldval))) - (add-to-list 'ses--deferred-write (cons row col)) ; In case force=t. - (setq this-cell-Dijkstra-attempt-h - (ses-cell-property-get-handle :ses-Dijkstra-attempt cell); - this-cell-Dijkstra-attempt - (ses-cell-property-handle-car this-cell-Dijkstra-attempt-h)) - (if (null this-cell-Dijkstra-attempt) - (ses-cell-property-handle-setcar - this-cell-Dijkstra-attempt-h - (setq this-cell-Dijkstra-attempt - (cons ses--Dijkstra-attempt-nb 0))) - (unless (= ses--Dijkstra-attempt-nb - (car this-cell-Dijkstra-attempt)) - (setcar this-cell-Dijkstra-attempt ses--Dijkstra-attempt-nb) - (setcdr this-cell-Dijkstra-attempt 0))) - (setq this-cell-Dijkstra-attempt+1 - (1+ (cdr this-cell-Dijkstra-attempt))) + (cl-pushnew (cons row col) ses--deferred-write :test #'equal) ; In case force=t. + (ses--letref (pget pset) + (ses-cell-property :ses-Dijkstra-attempt cell) + (let ((this-cell-Dijkstra-attempt (pget))) + (if (null this-cell-Dijkstra-attempt) + (pset + (setq this-cell-Dijkstra-attempt + (cons ses--Dijkstra-attempt-nb 0))) + (unless (= ses--Dijkstra-attempt-nb + (car this-cell-Dijkstra-attempt)) + (setcar this-cell-Dijkstra-attempt ses--Dijkstra-attempt-nb) + (setcdr this-cell-Dijkstra-attempt 0))) + (setq this-cell-Dijkstra-attempt+1 + (1+ (cdr this-cell-Dijkstra-attempt))))) (ses-set-cell row col 'value newval) (dolist (ref (ses-cell-references cell)) - (add-to-list 'ses--deferred-recalc ref) - (setq ref-rowcol (ses-sym-rowcol ref) - ref-cell-Dijkstra-attempt-h - (ses-cell-property-get-handle - :ses-Dijkstra-attempt - (car ref-rowcol) (cdr ref-rowcol)) - ref-cell-Dijkstra-attempt - (ses-cell-property-handle-car ref-cell-Dijkstra-attempt-h)) - - (if (null ref-cell-Dijkstra-attempt) - (ses-cell-property-handle-setcar - ref-cell-Dijkstra-attempt-h - (setq ref-cell-Dijkstra-attempt - (cons ses--Dijkstra-attempt-nb - this-cell-Dijkstra-attempt+1))) - (if (= (car ref-cell-Dijkstra-attempt) ses--Dijkstra-attempt-nb) - (setcdr ref-cell-Dijkstra-attempt - (max (cdr ref-cell-Dijkstra-attempt) - this-cell-Dijkstra-attempt+1)) - (setcar ref-cell-Dijkstra-attempt ses--Dijkstra-attempt-nb) - (setcdr ref-cell-Dijkstra-attempt - this-cell-Dijkstra-attempt+1))) + (cl-pushnew ref ses--deferred-recalc) + (ses--letref (pget pset) + (let ((ref-rowcol (ses-sym-rowcol ref))) + (ses-cell-property + :ses-Dijkstra-attempt + (car ref-rowcol) (cdr ref-rowcol))) + (let ((ref-cell-Dijkstra-attempt (pget))) + + (if (null ref-cell-Dijkstra-attempt) + (pset + (setq ref-cell-Dijkstra-attempt + (cons ses--Dijkstra-attempt-nb + this-cell-Dijkstra-attempt+1))) + (if (= (car ref-cell-Dijkstra-attempt) ses--Dijkstra-attempt-nb) + (setcdr ref-cell-Dijkstra-attempt + (max (cdr ref-cell-Dijkstra-attempt) + this-cell-Dijkstra-attempt+1)) + (setcar ref-cell-Dijkstra-attempt ses--Dijkstra-attempt-nb) + (setcdr ref-cell-Dijkstra-attempt + this-cell-Dijkstra-attempt+1))))) (when (> this-cell-Dijkstra-attempt+1 ses--Dijkstra-weight-bound) ;; Update print of this cell. @@ -1036,7 +1044,7 @@ if the cell's value is unchanged and FORCE is nil." (when (or (memq ref curlist) (memq ref ses--deferred-recalc)) ;; This cell refers to another that isn't done yet - (add-to-list 'ses--deferred-recalc this-sym) + (cl-pushnew this-sym ses--deferred-recalc :test #'equal) (throw 'ref t))))) ;; ses-update-cells is called from post-command-hook, so ;; inhibit-quit is implicitly bound to t. @@ -1045,7 +1053,7 @@ if the cell's value is unchanged and FORCE is nil." (error "Quit")) (ses-calculate-cell (car this-rowcol) (cdr this-rowcol) force))) (dolist (ref ses--deferred-recalc) - (add-to-list 'nextlist ref))) + (cl-pushnew ref nextlist :test #'equal))) (when ses--deferred-recalc ;; Just couldn't finish these. (dolist (x ses--deferred-recalc) @@ -1164,7 +1172,8 @@ preceding cell has spilled over." ((< len width) ;; Fill field to length with spaces. (setq len (make-string (- width len) ?\s) - text (if (eq ses-call-printer-return t) + text (if (or (stringp value) + (eq ses-call-printer-return t)) (concat text len) (concat len text)))) ((> len width) @@ -1261,7 +1270,13 @@ printer signaled one (and \"%s\" is used as the default printer), else nil." (format (car printer) value) "")) (t - (setq value (funcall printer (or value ""))) + (setq value (funcall + (or (and (symbolp printer) + (let ((locprn (gethash printer ses--local-printer-hashmap))) + (and locprn + (ses--locprn-compiled locprn)))) + printer) + (or value ""))) (if (stringp value) value (or (stringp (car-safe value)) @@ -1334,6 +1349,24 @@ ses--default-printer, ses--numrows, or ses--numcols." (goto-char ses--params-marker) (forward-line def)))) +(defun ses-file-format-extend-paramter-list (new-file-format) + "Extend the global parameters list when file format is updated +from 2 to 3. This happens when local printer function are added +to a sheet that was created with SES version 2. This is not +undoable. Return nil when there was no change, and non nil otherwise." + (save-excursion + (cond + ((and (= ses--file-format 2) (= 3 new-file-format)) + (ses-set-parameter 'ses--file-format 3) + (message "Upgrading from SES-2 to SES-3 file format") + (ses-widen) + (goto-char ses--params-marker) + (forward-line (plist-get ses-paramlines-plist 'ses--numlocprn )) + (insert (format (plist-get ses-paramfmt-plist 'ses--numlocprn) + ses--numlocprn) + ?\n) + t) ))) + (defun ses-set-parameter (def value &optional elem) "Set parameter DEF to VALUE (with undo) and write the value to the data area. See `ses-goto-data' for meaning of DEF. Newlines in the data are escaped. @@ -1343,13 +1376,7 @@ If ELEM is specified, it is the array subscript within DEF to be set to VALUE." ;; in case one of them is being changed. (ses-goto-data def) (let ((inhibit-read-only t) - (fmt (plist-get '(ses--col-widths "(ses-column-widths %S)" - ses--col-printers "(ses-column-printers %S)" - ses--default-printer "(ses-default-printer %S)" - ses--header-row "(ses-header-row %S)" - ses--file-format " %S ;SES file-format" - ses--numrows " %S ;numrows" - ses--numcols " %S ;numcols") + (fmt (plist-get ses-paramfmt-plist def)) oldval) (if elem @@ -1388,24 +1415,17 @@ Newlines in the data are escaped." (setq formula (cadr formula))) (if (eq (car-safe printer) 'ses-safe-printer) (setq printer (cadr printer))) - ;; This is noticeably faster than (format "%S %S %S %S %S") - (setq text (concat "(ses-cell " - (symbol-name sym) - " " - (prin1-to-string (symbol-value sym)) - " " - (prin1-to-string formula) - " " - (prin1-to-string printer) - " " - (if (atom (ses-cell-references cell)) - "nil" - (concat "(" - (mapconcat 'symbol-name - (ses-cell-references cell) - " ") - ")")) - ")")) + (setq text (prin1-to-string + ;; We could shorten it to (ses-cell SYM VAL) when + ;; the other parameters are nil, but in practice most + ;; cells have non-nil `references', so it's + ;; rather pointless. + `(ses-cell ,sym + ,(symbol-value sym) + ,(unless (equal formula (symbol-value sym)) + formula) + ,printer + ,(ses-cell-references cell)))) (ses-goto-data row col) (delete-region (point) (line-end-position)) (insert text))) @@ -1422,8 +1442,8 @@ refers to. For recursive calls, RESULT-SO-FAR is the list being constructed, or t to get a wrong-type-argument error when the first reference is found." (if (ses-sym-rowcol formula) - ;;Entire formula is one symbol - (add-to-list 'result-so-far formula) + ;; Entire formula is one symbol. + (cl-pushnew formula result-so-far :test #'equal) (if (consp formula) (cond ((eq (car formula) 'ses-range) @@ -1431,7 +1451,7 @@ first reference is found." (cdr (funcall 'macroexpand (list 'ses-range (nth 1 formula) (nth 2 formula))))) - (add-to-list 'result-so-far cur))) + (cl-pushnew cur result-so-far :test #'equal))) ((null (eq (car formula) 'quote)) ;;Recursive call for subformulas (dolist (cur formula) @@ -1600,8 +1620,8 @@ to each symbol." ;; This cell referred to a cell that's been deleted or is no ;; longer part of the range. We can't fix that now because ;; reference lists cells have been partially updated. - (add-to-list 'ses--deferred-recalc - (ses-create-cell-symbol row col))) + (cl-pushnew (ses-create-cell-symbol row col) + ses--deferred-recalc :test #'equal)) (setq newval (ses-relocate-formula (ses-cell-references mycell) minrow mincol rowincr colincr)) (ses-set-cell row col 'references newval) @@ -1691,36 +1711,30 @@ to each symbol." (insert-and-inherit "X") (delete-region (1- (point)) (point)))) -(defun ses-set-with-undo (sym newval) - "Like set, but undoable. Result is t if value has changed." - ;; We try to avoid adding redundant entries to the undo list, but this is - ;; unavoidable for strings because equal ignores text properties and there's - ;; no easy way to get the whole property list to see if it's different! - (unless (and (boundp sym) - (equal (symbol-value sym) newval) - (not (stringp newval))) - (push (if (boundp sym) - `(apply ses-set-with-undo ,sym ,(symbol-value sym)) - `(apply ses-unset-with-undo ,sym)) - buffer-undo-list) - (set sym newval) - t)) - -(defun ses-unset-with-undo (sym) - "Set SYM to be unbound. This is undoable." - (when (1value (boundp sym)) ; Always bound, except after a programming error. - (push `(apply ses-set-with-undo ,sym ,(symbol-value sym)) buffer-undo-list) - (makunbound sym))) +(defun ses-setter-with-undo (accessors newval &rest args) + "Set a field/variable and record it so it can be undone. +Result is non-nil if field/variable has changed." + (let ((oldval (apply (car accessors) args))) + (unless (equal-including-properties oldval newval) + (push `(apply ses-setter-with-undo ,accessors ,oldval ,@args) + buffer-undo-list) + (apply (cdr accessors) newval args) + t))) (defun ses-aset-with-undo (array idx newval) - "Like `aset', but undoable. -Result is t if element has changed." - (unless (equal (aref array idx) newval) - (push `(apply ses-aset-with-undo ,array ,idx - ,(aref array idx)) buffer-undo-list) - (aset array idx newval) - t)) + (ses-setter-with-undo (eval-when-compile + (cons #'aref + (lambda (newval array idx) (aset array idx newval)))) + newval array idx)) +(defun ses-set-with-undo (sym newval) + (ses-setter-with-undo + (eval-when-compile + (cons (lambda (sym) (if (boundp sym) (symbol-value sym) :ses--unbound)) + (lambda (newval sym) (if (eq newval :ses--unbound) + (makunbound sym) + (set sym newval))))) + newval sym)) ;;---------------------------------------------------------------------------- ;; Startup for major mode @@ -1735,29 +1749,38 @@ Does not execute cell formulas or print functions." (search-backward ";; Local Variables:\n" nil t) (backward-list 1) (setq ses--params-marker (point-marker)) - (let ((params (ignore-errors (read (current-buffer))))) - (or (and (= (safe-length params) 3) + (let* ((params (ignore-errors (read (current-buffer)))) + (params-len (safe-length params))) + (or (and (>= params-len 3) + (<= params-len 4) (numberp (car params)) (numberp (cadr params)) (>= (cadr params) 0) (numberp (nth 2 params)) - (> (nth 2 params) 0)) + (> (nth 2 params) 0) + (or (<= params-len 3) + (let ((numlocprn (nth 3 params))) + (and (integerp numlocprn) (>= numlocprn 0))))) (error "Invalid SES file")) (setq ses--file-format (car params) ses--numrows (cadr params) - ses--numcols (nth 2 params)) + ses--numcols (nth 2 params) + ses--numlocprn (or (nth 3 params) 0)) (when (= ses--file-format 1) (let (buffer-undo-list) ; This is not undoable. (ses-goto-data 'ses--header-row) (insert "(ses-header-row 0)\n") - (ses-set-parameter 'ses--file-format 2) - (message "Upgrading from SES-1 file format"))) - (or (= ses--file-format 2) + (ses-set-parameter 'ses--file-format 3) + (message "Upgrading from SES-1 to SES-2 file format"))) + (or (<= ses--file-format 3) (error "This file needs a newer version of the SES library code")) ;; Initialize cell array. (setq ses--cells (make-vector ses--numrows nil)) (dotimes (row ses--numrows) - (aset ses--cells row (make-vector ses--numcols nil)))) + (aset ses--cells row (make-vector ses--numcols nil))) + ;; initialize local printer map. + (clrhash ses--local-printer-hashmap)) + ;; Skip over print area, which we assume is correct. (goto-char (point-min)) (forward-line ses--numrows) @@ -1768,7 +1791,22 @@ Does not execute cell formulas or print functions." (forward-char (1- (length ses-print-data-boundary))) ;; Initialize printer and symbol lists. (mapc 'ses-printer-record ses-standard-printer-functions) - (setq ses--symbolic-formulas nil) + (setq ses--symbolic-formulas nil) + + ;; Load local printer definitions. + ;; This must be loaded *BEFORE* cells and column printers because the latters + ;; may call them. + (save-excursion + (forward-line (* ses--numrows (1+ ses--numcols))) + (let ((numlocprn ses--numlocprn)) + (setq ses--numlocprn 0) + (dotimes (_ numlocprn) + (let ((x (read (current-buffer)))) + (or (and (looking-at-p "\n") + (eq (car-safe x) 'ses-local-printer) + (apply #'ses--local-printer (cdr x))) + (error "local printer-def error")) + (setq ses--numlocprn (1+ ses--numlocprn)))))) ;; Load cell definitions. (dotimes (row ses--numrows) (dotimes (col ses--numcols) @@ -1778,9 +1816,11 @@ Does not execute cell formulas or print functions." (eq (car-safe x) 'ses-cell) (ses-create-cell-variable sym row col)) (error "Cell-def error")) - (eval x))) + (apply #'ses--cell (cdr x)))) (or (looking-at-p "\n\n") (error "Missing blank line between rows"))) + ;; Skip local printer function declaration --- that were already loaded. + (forward-line (+ 2 ses--numlocprn)) ;; Load global parameters. (let ((widths (read (current-buffer))) (n1 (char-after (point))) @@ -1805,8 +1845,7 @@ Does not execute cell formulas or print functions." (1value (eval head-row))) ;; Should be back at global-params. (forward-char 1) - (or (looking-at-p (replace-regexp-in-string "1" "[0-9]+" - ses-initial-global-parameters)) + (or (looking-at-p ses-initial-global-parameters-re) (error "Problem with column-defs or global-params")) ;; Check for overall newline count in definitions area. (forward-line 3) @@ -1938,7 +1977,8 @@ formula: ;; calculation). indent-tabs-mode nil) (1value (add-hook 'change-major-mode-hook 'ses-cleanup nil t)) - (1value (add-hook 'before-revert-hook 'ses-cleanup nil t)) + ;; This makes revert impossible if the buffer is read-only. + ;; (1value (add-hook 'before-revert-hook 'ses-cleanup nil t)) (setq header-line-format '(:eval (progn (when (/= (window-hscroll) ses--header-hscroll) @@ -2122,7 +2162,7 @@ print area if NONARROW is nil." (delete-region (point-min) (point)) ;; Insert all blank lines before printing anything, so ses-print-cell can ;; find the data area when inserting or deleting *skip* values for cells. - (dotimes (row ses--numrows) + (dotimes (_ ses--numrows) (insert-and-inherit ses--blank-line)) (dotimes-with-progress-reporter (row ses--numrows) "Reprinting..." (if (eq (ses-cell-value row 0) '*skip*) @@ -2154,9 +2194,10 @@ to are recalculated first." (when (setq cur-rowcol (ses-sym-rowcol ses--curcell) sig (progn - (ses-cell-property-set :ses-Dijkstra-attempt - (cons ses--Dijkstra-attempt-nb 0) - (car cur-rowcol) (cdr cur-rowcol) ) + (setf (ses-cell-property :ses-Dijkstra-attempt + (car cur-rowcol) + (cdr cur-rowcol)) + (cons ses--Dijkstra-attempt-nb 0)) (ses-calculate-cell (car cur-rowcol) (cdr cur-rowcol) t))) (nconc sig (list (ses-cell-symbol (car cur-rowcol) (cdr cur-rowcol))))) @@ -2169,14 +2210,14 @@ to are recalculated first." ;; The t causes an error if the cell has references. If no ;; references, the t will be the result value. (1value (ses-formula-references (ses-cell-formula row col) t)) - (ses-cell-property-set :ses-Dijkstra-attempt - (cons ses--Dijkstra-attempt-nb 0) - row col) + (setf (ses-cell-property :ses-Dijkstra-attempt row col) + (cons ses--Dijkstra-attempt-nb 0)) (when (setq sig (ses-calculate-cell row col t)) (nconc sig (list (ses-cell-symbol row col))))) (wrong-type-argument ;; The formula contains a reference. - (add-to-list 'ses--deferred-recalc (ses-cell-symbol row col)))))) + (cl-pushnew (ses-cell-symbol row col) ses--deferred-recalc + :test #'equal))))) ;; Do the update now, so we can force recalculation. (let ((x ses--deferred-recalc)) (setq ses--deferred-recalc nil) @@ -2251,7 +2292,7 @@ to are recalculated first." (insert ses-initial-file-trailer) (goto-char (point-min))) ;; Create a blank display area. - (dotimes (row ses--numrows) + (dotimes (_ ses--numrows) (insert ses--blank-line)) (insert ses-print-data-boundary) (backward-char (1- (length ses-print-data-boundary))) @@ -2321,16 +2362,23 @@ cell formula was unsafe and user declined confirmation." (barf-if-buffer-read-only) (list (car rowcol) (cdr rowcol) - (read-from-minibuffer - (format "Cell %s: " ses--curcell) - (cons (if (equal initial "\"") "\"\"" - (if (equal initial "(") "()" initial)) 2) - ses-mode-edit-map - t ; Convert to Lisp object. - 'ses-read-cell-history - (prin1-to-string (if (eq (car-safe curval) 'ses-safe-formula) - (cadr curval) - curval)))))) + (if (equal initial "\"") + (progn + (if (not (stringp curval)) (setq curval nil)) + (read-string (if curval + (format "String Cell %s (default %s): " + ses--curcell curval) + (format "String Cell %s: " ses--curcell)) + nil 'ses-read-string-history curval)) + (read-from-minibuffer + (format "Cell %s: " ses--curcell) + (cons (if (equal initial "(") "()" initial) 2) + ses-mode-edit-map + t ; Convert to Lisp object. + 'ses-read-cell-history + (prin1-to-string (if (eq (car-safe curval) 'ses-safe-formula) + (cadr curval) + curval))))))) (when (ses-edit-cell row col newval) (ses-command-hook) ; Update cell widths before movement. (dolist (x ses-after-entry-functions) @@ -2363,7 +2411,7 @@ With prefix, deletes several cells." (1value (ses-clear-cell-backward (- count))) (ses-check-curcell) (ses-begin-change) - (dotimes (x count) + (dotimes (_ count) (ses-set-curcell) (let ((rowcol (ses-sym-rowcol ses--curcell))) (or rowcol (signal 'end-of-buffer nil)) @@ -2378,7 +2426,7 @@ cells." (1value (ses-clear-cell-forward (- count))) (ses-check-curcell 'end) (ses-begin-change) - (dotimes (x count) + (dotimes (_ count) (backward-char 1) ; Will signal 'beginning-of-buffer if appropriate. (ses-set-curcell) (let ((rowcol (ses-sym-rowcol ses--curcell))) @@ -2390,12 +2438,14 @@ cells." ;;---------------------------------------------------------------------------- (defun ses-read-printer (prompt default) - "Common code for `ses-read-cell-printer', `ses-read-column-printer', and `ses-read-default-printer'. -PROMPT should end with \": \". Result is t if operation was canceled." + "Common code for functions `ses-read-cell-printer', `ses-read-column-printer', +`ses-read-default-printer' and `ses-define-local-printer'. +PROMPT should end with \": \". Result is t if operation was +canceled." (barf-if-buffer-read-only) (if (eq default t) (setq default "") - (setq prompt (format "%s [currently %S]: " + (setq prompt (format "%s (default %S): " (substring prompt 0 -2) default))) (let ((new (read-from-minibuffer prompt @@ -2411,6 +2461,7 @@ PROMPT should end with \": \". Result is t if operation was canceled." (or (not new) (stringp new) (stringp (car-safe new)) + (and (symbolp new) (gethash new ses--local-printer-hashmap)) (ses-warn-unsafe new 'unsafep-function) (setq new t))) new)) @@ -2425,21 +2476,20 @@ one argument, or a symbol that names a function of one argument. In the latter two cases, the function's result should be either a string (will be right-justified) or a list of one string (will be left-justified)." (interactive - (let ((default t) - x) + (let ((default t)) (ses-check-curcell 'range) ;;Default is none if not all cells in range have same printer (catch 'ses-read-cell-printer (ses-dorange ses--curcell - (setq x (ses-cell-printer row col)) - (if (eq (car-safe x) 'ses-safe-printer) - (setq x (cadr x))) - (if (eq default t) - (setq default x) - (unless (equal default x) - ;;Range contains differing printer functions - (setq default t) - (throw 'ses-read-cell-printer t))))) + (let ((x (ses-cell-printer row col))) + (if (eq (car-safe x) 'ses-safe-printer) + (setq x (cadr x))) + (if (eq default t) + (setq default x) + (unless (equal default x) + ;;Range contains differing printer functions + (setq default t) + (throw 'ses-read-cell-printer t)))))) (list (ses-read-printer (format "Cell %S printer: " ses--curcell) default)))) (unless (eq newval t) @@ -2718,7 +2768,7 @@ inserts a new row if at bottom of print area. Repeat COUNT times." (list col (if current-prefix-arg (prefix-numeric-value current-prefix-arg) - (read-from-minibuffer (format "Column %s width [currently %d]: " + (read-from-minibuffer (format "Column %s width (default %d): " (ses-column-letter col) (ses-col-width col)) nil ; No initial contents. @@ -2957,9 +3007,9 @@ cons of ROW and COL). Treat plain symbols as strings unless ARG is a list." ;; Invalid sexp --- leave it as a string. (setq val (substring text from to))) ((and (car val) (symbolp (car val))) - (if (consp arg) - (setq val (list 'quote (car val))) ; Keep symbol. - (setq val (substring text from to)))) ; Treat symbol as text. + (setq val (if (consp arg) + (list 'quote (car val)) ; Keep symbol. + (substring text from to)))) ; Treat symbol as text. (t (setq val (car val)))) (let ((row (car rowcol)) @@ -3305,29 +3355,31 @@ highlighted range in the spreadsheet." (if (equal new-rowcol rowcol) (put new-name 'ses-cell rowcol) (error "Not a valid name for this cell location")) - (setq ses--named-cell-hashmap (or ses--named-cell-hashmap (make-hash-table :test 'eq))) + (setq ses--named-cell-hashmap + (or ses--named-cell-hashmap (make-hash-table :test 'eq))) (put new-name 'ses-cell :ses-named) (puthash new-name rowcol ses--named-cell-hashmap)) (push `(ses-rename-cell ,old-name ,cell) buffer-undo-list) - ;; replace name by new name in formula of cells refering to renamed cell + ;; Replace name by new name in formula of cells refering to renamed cell. (dolist (ref (ses-cell-references cell)) (let* ((x (ses-sym-rowcol ref)) (xcell (ses-get-cell (car x) (cdr x)))) - (ses-cell-formula-aset xcell - (ses-replace-name-in-formula - (ses-cell-formula xcell) - sym - new-name)))) - ;; replace name by new name in reference list of cells to which renamed cell refers to + (setf (ses-cell-formula xcell) + (ses-replace-name-in-formula + (ses-cell-formula xcell) + sym + new-name)))) + ;; Replace name by new name in reference list of cells to which renamed + ;; cell refers to. (dolist (ref (ses-formula-references (ses-cell-formula cell))) (let* ((x (ses-sym-rowcol ref)) (xcell (ses-get-cell (car x) (cdr x)))) - (ses-cell-references-aset xcell - (cons new-name (delq sym - (ses-cell-references xcell)))))) + (setf (ses-cell-references xcell) + (cons new-name (delq sym + (ses-cell-references xcell)))))) (push new-name ses--renamed-cell-symb-list) (set new-name (symbol-value sym)) - (aset cell 0 new-name) + (setf (ses-cell--symbol cell) new-name) (makunbound sym) (and curcell (setq ses--curcell new-name)) (let* ((pos (point)) @@ -3344,6 +3396,75 @@ highlighted range in the spreadsheet." (symbol-name new-name))) (force-mode-line-update))) +(defun ses-refresh-local-printer (name compiled-value) + "Refresh printout for all cells which use printer NAME. +NAME should be the name of a locally defined printer. +Uses the value COMPILED-VALUE for this printer." + (message "Refreshing cells using printer %S" name) + (let (new-print) + (dotimes (row ses--numrows) + (dotimes (col ses--numcols) + (let ((cell-printer (ses-cell-printer row col))) + (when (eq cell-printer name) + (unless new-print + (setq new-print t) + (ses-begin-change)) + (ses-print-cell row col))))))) + +(defun ses-define-local-printer (name) + "Define a local printer with name NAME." + (interactive "*SEnter printer name: ") + (let* ((cur-printer (gethash name ses--local-printer-hashmap)) + (default (and (vectorp cur-printer) (ses--locprn-def cur-printer))) + create-printer + (new-def + (ses-read-printer (format "Enter definition of printer %S: " name) + default))) + (cond + ;; cancelled operation => do nothing + ((eq new-def t)) + ;; no change => do nothing + ((and (vectorp cur-printer) (equal new-def default))) + ;; re-defined printer + ((vectorp cur-printer) + (setq create-printer 0) + (setf (ses--locprn-def cur-printer) new-def) + (ses-refresh-local-printer + name + (setf (ses--locprn-compiled cur-printer) + (ses-local-printer-compile new-def)))) + ;; new definition + (t + (setq create-printer 1) + (puthash name + (setq cur-printer + (ses-make-local-printer-info new-def)) + ses--local-printer-hashmap))) + (when create-printer + (let ((printer-def-text + (concat + "(ses-local-printer " + (symbol-name name) + " " + (prin1-to-string (ses--locprn-def cur-printer)) + ")"))) + (save-excursion + (ses-goto-data ses--numrows + (ses--locprn-number cur-printer)) + (let ((inhibit-read-only t)) + ;; Special undo since it's outside the narrowed buffer. + (let (buffer-undo-list) + (if (= create-printer 0) + (delete-region (point) (line-end-position)) + (insert ?\n) + (backward-char)) + (insert printer-def-text) + (when (= create-printer 1) + (ses-file-format-extend-paramter-list 3) + (ses-set-parameter 'ses--numlocprn + (+ ses--numlocprn create-printer)))))))))) + + ;;---------------------------------------------------------------------------- ;; Checking formulas for safety ;;---------------------------------------------------------------------------- @@ -3353,6 +3474,7 @@ highlighted range in the spreadsheet." (if (or (stringp printer) (stringp (car-safe printer)) (not printer) + (and (symbolp printer) (gethash printer ses--local-printer-hashmap)) (ses-warn-unsafe printer 'unsafep-function)) printer 'ses-unsafe)) diff --git a/lisp/shell.el b/lisp/shell.el index 9dc9a013f8b..506f944094b 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -1,7 +1,6 @@ ;;; shell.el --- specialized comint.el for running the shell -*- lexical-binding: t -*- -;; Copyright (C) 1988, 1993-1997, 2000-2014 Free Software Foundation, -;; Inc. +;; Copyright (C) 1988, 1993-1997, 2000-2014 Free Software Foundation, Inc. ;; Author: Olin Shivers <shivers@cs.cmu.edu> ;; Simon Marshall <simon@gnu.org> @@ -584,6 +583,8 @@ buffer." (setq shell-dirstack-query (cond ((string-equal shell "sh") "pwd") ((string-equal shell "ksh") "echo $PWD ~-") + ;; Bypass any aliases. TODO all shells could use this. + ((string-equal shell "bash") "command dirs") (t "dirs"))) ;; Bypass a bug in certain versions of bash. (when (string-equal shell "bash") diff --git a/lisp/simple.el b/lisp/simple.el index d7f5b418302..63bfbb51419 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -806,15 +806,15 @@ If BACKWARD-ONLY is non-nil, only delete them before point." If N is negative, delete newlines as well, leaving -N spaces. See also `cycle-spacing'." (interactive "*p") - (cycle-spacing n nil t)) + (cycle-spacing n nil 'single-shot)) (defvar cycle-spacing--context nil "Store context used in consecutive calls to `cycle-spacing' command. -The first time this function is run, it saves the original point -position and original spacing around the point in this -variable.") +The first time `cycle-spacing' runs, it saves in this variable: +its N argument, the original point position, and the original spacing +around point.") -(defun cycle-spacing (&optional n preserve-nl-back single-shot) +(defun cycle-spacing (&optional n preserve-nl-back mode) "Manipulate whitespace around point in a smart way. In interactive use, this function behaves differently in successive consecutive calls. @@ -825,25 +825,31 @@ It deletes all spaces and tabs around point, leaving one space it deletes newlines as well, leaving -N spaces. \(If PRESERVE-NL-BACK is non-nil, it does not delete newlines before point.) -The second call in a sequence (or the first call if the above does -not result in any changes) deletes all spaces. +The second call in a sequence deletes all spaces. The third call in a sequence restores the original whitespace (and point). -If SINGLE-SHOT is non-nil, it only performs the first step in the sequence." +If MODE is `single-shot', it only performs the first step in the sequence. +If MODE is `fast' and the first step would not result in any change +\(i.e., there are exactly (abs N) spaces around point), +the function goes straight to the second step. + +Repeatedly calling the function with different values of N starts a +new sequence each time." (interactive "*p") (let ((orig-pos (point)) (skip-characters (if (and n (< n 0)) " \t\n\r" " \t")) - (n (abs (or n 1)))) + (num (abs (or n 1)))) (skip-chars-backward (if preserve-nl-back " \t" skip-characters)) (constrain-to-field nil orig-pos) (cond - ;; Command run for the first time or single-shot is non-nil. - ((or single-shot + ;; Command run for the first time, single-shot mode or different argument + ((or (eq 'single-shot mode) (not (equal last-command this-command)) - (not cycle-spacing--context)) + (not cycle-spacing--context) + (not (eq (car cycle-spacing--context) n))) (let* ((start (point)) - (n (- n (skip-chars-forward " " (+ n (point))))) + (num (- num (skip-chars-forward " " (+ num (point))))) (mid (point)) (end (progn (skip-chars-forward skip-characters) @@ -851,12 +857,12 @@ If SINGLE-SHOT is non-nil, it only performs the first step in the sequence." (setq cycle-spacing--context ;; Save for later. ;; Special handling for case where there was no space at all. (unless (= start end) - (cons orig-pos (buffer-substring start (point))))) + (cons n (cons orig-pos (buffer-substring start (point)))))) ;; If this run causes no change in buffer content, delete all spaces, ;; otherwise delete all excess spaces. - (delete-region (if (and (not single-shot) (zerop n) (= mid end)) + (delete-region (if (and (eq mode 'fast) (zerop num) (= mid end)) start mid) end) - (insert (make-string n ?\s)))) + (insert (make-string num ?\s)))) ;; Command run for the second time. ((not (equal orig-pos (point))) @@ -864,8 +870,8 @@ If SINGLE-SHOT is non-nil, it only performs the first step in the sequence." ;; Command run for the third time. (t - (insert (cdr cycle-spacing--context)) - (goto-char (car cycle-spacing--context)) + (insert (cddr cycle-spacing--context)) + (goto-char (cadr cycle-spacing--context)) (setq cycle-spacing--context nil))))) (defun beginning-of-buffer (&optional arg) @@ -875,10 +881,8 @@ If the buffer is narrowed, this command uses the beginning 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." +position, unless a \\[universal-argument] prefix is supplied." + (declare (interactive-only "use `(goto-char (point-min))' instead.")) (interactive "^P") (or (consp arg) (region-active-p) @@ -893,8 +897,6 @@ Don't use this command in Lisp programs! (/ (+ 10 (* size (prefix-numeric-value arg))) 10))) (point-min)))) (if (and arg (not (consp arg))) (forward-line 1))) -(put 'beginning-of-buffer 'interactive-only - "use `(goto-char (point-min))' instead.") (defun end-of-buffer (&optional arg) "Move point to the end of the buffer. @@ -903,10 +905,8 @@ If the buffer is narrowed, this command uses the end 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." +position, unless a \\[universal-argument] prefix is supplied." + (declare (interactive-only "use `(goto-char (point-max))' instead.")) (interactive "^P") (or (consp arg) (region-active-p) (push-mark)) (let ((size (- (point-max) (point-min)))) @@ -927,7 +927,6 @@ Don't use this command in Lisp programs! ;; then scroll specially to put it near, but not at, the bottom. (overlay-recenter (point)) (recenter -3)))) -(put 'end-of-buffer 'interactive-only "use `(goto-char (point-max))' instead.") (defcustom delete-active-region t "Whether single-char deletion commands delete an active region. @@ -968,6 +967,7 @@ arg, and KILLFLAG is set if N is explicitly specified. In Overwrite mode, single character backward deletion may replace tabs with spaces so as to back over columns, unless point is at the end of the line." + (declare (interactive-only delete-char)) (interactive "p\nP") (unless (integerp n) (signal 'wrong-type-argument (list 'integerp n))) @@ -990,7 +990,6 @@ the end of the line." (insert-char ?\s (- ocol (current-column)) nil)))) ;; Otherwise, do simple deletion. (t (delete-char (- n) killflag)))) -(put 'delete-backward-char 'interactive-only 'delete-char) (defun delete-forward-char (n &optional killflag) "Delete the following N characters (previous if N is negative). @@ -1001,6 +1000,7 @@ To disable this, set variable `delete-active-region' to nil. Optional second arg KILLFLAG non-nil means to kill (save in kill ring) instead of delete. Interactively, N is the prefix arg, and KILLFLAG is set if N was explicitly specified." + (declare (interactive-only delete-char)) (interactive "p\nP") (unless (integerp n) (signal 'wrong-type-argument (list 'integerp n))) @@ -1014,7 +1014,6 @@ KILLFLAG is set if N was explicitly specified." ;; Otherwise, do simple deletion. (t (delete-char n killflag)))) -(put 'delete-forward-char 'interactive-only 'delete-char) (defun mark-whole-buffer () "Put point at beginning and mark at end of buffer. @@ -1022,6 +1021,7 @@ If narrowing is in effect, only uses the accessible part of the buffer. You probably should not use this function in Lisp programs; it is usually a mistake for a Lisp function to use any subroutine that uses or sets the mark." + (declare (interactive-only t)) (interactive) (push-mark (point)) (push-mark (point-max) nil t) @@ -1050,6 +1050,7 @@ What you probably want instead is something like: (forward-line (1- N)) If at all possible, an even better solution is to use char counts rather than line counts." + (declare (interactive-only forward-line)) (interactive (if (and current-prefix-arg (not (consp current-prefix-arg))) (list (prefix-numeric-value current-prefix-arg)) @@ -1089,7 +1090,6 @@ rather than line counts." (if (eq selective-display t) (re-search-forward "[\n\C-m]" nil 'end (1- line)) (forward-line (1- line))))) -(put 'goto-line 'interactive-only 'forward-line) (defun count-words-region (start end &optional arg) "Count the number of words in the region. @@ -1508,24 +1508,13 @@ to get different commands to edit and resubmit." ;; add it to the history. (or (equal newcmd (car command-history)) (setq command-history (cons newcmd command-history))) - (unwind-protect - (progn - ;; Trick called-interactively-p into thinking that `newcmd' is - ;; an interactive call (bug#14136). - (add-hook 'called-interactively-p-functions - #'repeat-complex-command--called-interactively-skip) - (eval newcmd)) - (remove-hook 'called-interactively-p-functions - #'repeat-complex-command--called-interactively-skip))) + (apply #'funcall-interactively + (car newcmd) + (mapcar (lambda (e) (eval e t)) (cdr newcmd)))) (if command-history (error "Argument %d is beyond length of command history" arg) (error "There are no previous complex commands to repeat"))))) -(defun repeat-complex-command--called-interactively-skip (i _frame1 frame2) - (and (eq 'eval (cadr frame2)) - (eq 'repeat-complex-command - (cadr (backtrace-frame i #'called-interactively-p))) - 1)) (defvar extended-command-history nil) @@ -2370,91 +2359,115 @@ are ignored. If BEG and END are nil, all undo elements are used." (undo-make-selective-list (min beg end) (max beg end)) buffer-undo-list))) +;; The positions given in elements of the undo list are the positions +;; as of the time that element was recorded to undo history. In +;; general, subsequent buffer edits render those positions invalid in +;; the current buffer, unless adjusted according to the intervening +;; undo elements. +;; +;; Undo in region is a use case that requires adjustments to undo +;; elements. It must adjust positions of elements in the region based +;; on newer elements not in the region so as they may be correctly +;; applied in the current buffer. undo-make-selective-list +;; accomplishes this with its undo-deltas list of adjustments. An +;; example undo history from oldest to newest: +;; +;; buf pos: +;; 123456789 buffer-undo-list undo-deltas +;; --------- ---------------- ----------- +;; aaa (1 . 4) (1 . -3) +;; aaba (3 . 4) N/A (in region) +;; ccaaba (1 . 3) (1 . -2) +;; ccaabaddd (7 . 10) (7 . -3) +;; ccaabdd ("ad" . 6) (6 . 2) +;; ccaabaddd (6 . 8) (6 . -2) +;; | |<-- region: "caab", from 2 to 6 +;; +;; When the user starts a run of undos in region, +;; undo-make-selective-list is called to create the full list of in +;; region elements. Each element is adjusted forward chronologically +;; through undo-deltas to determine if it is in the region. +;; +;; In the above example, the insertion of "b" is (3 . 4) in the +;; buffer-undo-list. The undo-delta (1 . -2) causes (3 . 4) to become +;; (5 . 6). The next three undo-deltas cause no adjustment, so (5 +;; . 6) is assessed as in the region and placed in the selective list. +;; Notably, the end of region itself adjusts from "2 to 6" to "2 to 5" +;; due to the selected element. The "b" insertion is the only element +;; fully in the region, so in this example undo-make-selective-list +;; returns (nil (5 . 6)). +;; +;; The adjustment of the (7 . 10) insertion of "ddd" shows an edge +;; case. It is adjusted through the undo-deltas: ((6 . 2) (6 . -2)). +;; Normally an undo-delta of (6 . 2) would cause positions after 6 to +;; adjust by 2. However, they shouldn't adjust to less than 6, so (7 +;; . 10) adjusts to (6 . 8) due to the first undo delta. +;; +;; More interesting is how to adjust the "ddd" insertion due to the +;; next undo-delta: (6 . -2), corresponding to reinsertion of "ad". +;; If the reinsertion was a manual retyping of "ad", then the total +;; adjustment should be (7 . 10) -> (6 . 8) -> (8 . 10). However, if +;; the reinsertion was due to undo, one might expect the first "d" +;; character would again be a part of the "ddd" text, meaning its +;; total adjustment would be (7 . 10) -> (6 . 8) -> (7 . 10). +;; +;; undo-make-selective-list assumes in this situation that "ad" was a +;; new edit, even if it was inserted because of an undo. +;; Consequently, if the user undos in region "8 to 10" of the +;; "ccaabaddd" buffer, they could be surprised that it becomes +;; "ccaabad", as though the first "d" became detached from the +;; original "ddd" insertion. This quirk is a FIXME. + (defun undo-make-selective-list (start end) "Return a list of undo elements for the region START to END. -The elements come from `buffer-undo-list', but we keep only -the elements inside this region, and discard those outside this region. -If we find an element that crosses an edge of this region, -we stop and ignore all further elements." - (let ((undo-list-copy (undo-copy-list buffer-undo-list)) - (undo-list (list nil)) - some-rejected - undo-elt temp-undo-list delta) - (while undo-list-copy - (setq undo-elt (car undo-list-copy)) - (let ((keep-this - (cond ((and (consp undo-elt) (eq (car undo-elt) t)) - ;; This is a "was unmodified" element. - ;; Keep it if we have kept everything thus far. - (not some-rejected)) - ;; Skip over marker adjustments, instead relying on - ;; finding them after (TEXT . POS) elements - ((markerp (car-safe undo-elt)) - nil) - (t - (undo-elt-in-region undo-elt start end))))) - (if keep-this - (progn - (setq end (+ end (cdr (undo-delta undo-elt)))) - ;; Don't put two nils together in the list - (when (not (and (eq (car undo-list) nil) - (eq undo-elt nil))) - (setq undo-list (cons undo-elt undo-list)) - ;; If (TEXT . POS), "keep" its subsequent (MARKER - ;; . ADJUSTMENT) whose markers haven't moved. - (when (and (stringp (car-safe undo-elt)) - (integerp (cdr-safe undo-elt))) - (let ((list-i (cdr undo-list-copy))) +The elements come from `buffer-undo-list', but we keep only the +elements inside this region, and discard those outside this +region. The elements' positions are adjusted so as the returned +list can be applied to the current buffer." + (let ((ulist buffer-undo-list) + ;; A list of position adjusted undo elements in the region. + (selective-list (list nil)) + ;; A list of undo-deltas for out of region undo elements. + undo-deltas + undo-elt) + (while ulist + (when undo-no-redo + (while (gethash ulist undo-equiv-table) + (setq ulist (gethash ulist undo-equiv-table)))) + (setq undo-elt (car ulist)) + (cond + ((null undo-elt) + ;; Don't put two nils together in the list + (when (car selective-list) + (push nil selective-list))) + ((and (consp undo-elt) (eq (car undo-elt) t)) + ;; This is a "was unmodified" element. Keep it + ;; if we have kept everything thus far. + (when (not undo-deltas) + (push undo-elt selective-list))) + ;; Skip over marker adjustments, instead relying + ;; on finding them after (TEXT . POS) elements + ((markerp (car-safe undo-elt)) + nil) + (t + (let ((adjusted-undo-elt (undo-adjust-elt undo-elt + undo-deltas))) + (if (undo-elt-in-region adjusted-undo-elt start end) + (progn + (setq end (+ end (cdr (undo-delta adjusted-undo-elt)))) + (push adjusted-undo-elt selective-list) + ;; Keep (MARKER . ADJUSTMENT) if their (TEXT . POS) was + ;; kept. primitive-undo may discard them later. + (when (and (stringp (car-safe adjusted-undo-elt)) + (integerp (cdr-safe adjusted-undo-elt))) + (let ((list-i (cdr ulist))) (while (markerp (car-safe (car list-i))) - (let* ((adj-elt (pop list-i)) - (m (car adj-elt))) - (and (eq (marker-buffer m) (current-buffer)) - (= (cdr undo-elt) m) - (push adj-elt undo-list)))))))) - (if (undo-elt-crosses-region undo-elt start end) - (setq undo-list-copy nil) - (setq some-rejected t) - (setq temp-undo-list (cdr undo-list-copy)) - (setq delta (undo-delta undo-elt)) - - (when (/= (cdr delta) 0) - (let ((position (car delta)) - (offset (cdr delta))) - - ;; Loop down the earlier events adjusting their buffer - ;; positions to reflect the fact that a change to the buffer - ;; isn't being undone. We only need to process those element - ;; types which undo-elt-in-region will return as being in - ;; the region since only those types can ever get into the - ;; output - - (while temp-undo-list - (setq undo-elt (car temp-undo-list)) - (cond ((integerp undo-elt) - (if (>= undo-elt position) - (setcar temp-undo-list (- undo-elt offset)))) - ((atom undo-elt) nil) - ((stringp (car undo-elt)) - ;; (TEXT . POSITION) - (let ((text-pos (abs (cdr undo-elt))) - (point-at-end (< (cdr undo-elt) 0 ))) - (if (>= text-pos position) - (setcdr undo-elt (* (if point-at-end -1 1) - (- text-pos offset)))))) - ((integerp (car undo-elt)) - ;; (BEGIN . END) - (when (>= (car undo-elt) position) - (setcar undo-elt (- (car undo-elt) offset)) - (setcdr undo-elt (- (cdr undo-elt) offset)))) - ((null (car undo-elt)) - ;; (nil PROPERTY VALUE BEG . END) - (let ((tail (nthcdr 3 undo-elt))) - (when (>= (car tail) position) - (setcar tail (- (car tail) offset)) - (setcdr tail (- (cdr tail) offset)))))) - (setq temp-undo-list (cdr temp-undo-list)))))))) - (setq undo-list-copy (cdr undo-list-copy))) - (nreverse undo-list))) + (push (pop list-i) selective-list))))) + (let ((delta (undo-delta undo-elt))) + (when (/= 0 (cdr delta)) + (push delta undo-deltas))))))) + (pop ulist)) + (nreverse selective-list))) (defun undo-elt-in-region (undo-elt start end) "Determine whether UNDO-ELT falls inside the region START ... END. @@ -2502,6 +2515,73 @@ is not *inside* the region START...END." ;; (BEGIN . END) (and (< (car undo-elt) end) (> (cdr undo-elt) start))))) +(make-obsolete 'undo-elt-crosses-region nil "24.5") + +(defun undo-adjust-elt (elt deltas) + "Return adjustment of undo element ELT by the undo DELTAS +list." + (pcase elt + ;; POSITION + ((pred integerp) + (undo-adjust-pos elt deltas)) + ;; (BEG . END) + (`(,(and beg (pred integerp)) . ,(and end (pred integerp))) + (undo-adjust-beg-end beg end deltas)) + ;; (TEXT . POSITION) + (`(,(and text (pred stringp)) . ,(and pos (pred integerp))) + (cons text (* (if (< pos 0) -1 1) + (undo-adjust-pos (abs pos) deltas)))) + ;; (nil PROPERTY VALUE BEG . END) + (`(nil . ,(or `(,prop ,val ,beg . ,end) pcase--dontcare)) + `(nil ,prop ,val . ,(undo-adjust-beg-end beg end deltas))) + ;; (apply DELTA START END FUN . ARGS) + ;; FIXME + ;; All others return same elt + (_ elt))) + +;; (BEG . END) can adjust to the same positions, commonly when an +;; insertion was undone and they are out of region, for example: +;; +;; buf pos: +;; 123456789 buffer-undo-list undo-deltas +;; --------- ---------------- ----------- +;; [...] +;; abbaa (2 . 4) (2 . -2) +;; aaa ("bb" . 2) (2 . 2) +;; [...] +;; +;; "bb" insertion (2 . 4) adjusts to (2 . 2) because of the subsequent +;; undo. Further adjustments to such an element should be the same as +;; for (TEXT . POSITION) elements. The options are: +;; +;; 1: POSITION adjusts using <= (use-< nil), resulting in behavior +;; analogous to marker insertion-type t. +;; +;; 2: POSITION adjusts using <, resulting in behavior analogous to +;; marker insertion-type nil. +;; +;; There was no strong reason to prefer one or the other, except that +;; the first is more consistent with prior undo in region behavior. +(defun undo-adjust-beg-end (beg end deltas) + "Return cons of adjustments to BEG and END by the undo DELTAS +list." + (let ((adj-beg (undo-adjust-pos beg deltas))) + ;; Note: option 2 above would be like (cons (min ...) adj-end) + (cons adj-beg + (max adj-beg (undo-adjust-pos end deltas t))))) + +(defun undo-adjust-pos (pos deltas &optional use-<) + "Return adjustment of POS by the undo DELTAS list, comparing +with < or <= based on USE-<." + (dolist (d deltas pos) + (when (if use-< + (< (car d) pos) + (<= (car d) pos)) + (setq pos + ;; Don't allow pos to become less than the undo-delta + ;; position. This edge case is described in the overview + ;; comments. + (max (car d) (- pos (cdr d))))))) ;; Return the first affected buffer position and the delta for an undo element ;; delta is defined as the change in subsequent buffer positions if we *did* @@ -3286,6 +3366,11 @@ support pty association, if PROGRAM is nil." (defvar process-menu-query-only nil) +(defvar process-menu-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [?d] 'process-menu-delete-process) + map)) + (define-derived-mode process-menu-mode tabulated-list-mode "Process Menu" "Major mode for listing the processes called by Emacs." (setq tabulated-list-format [("Process" 15 t) @@ -3298,6 +3383,12 @@ support pty association, if PROGRAM is nil." (add-hook 'tabulated-list-revert-hook 'list-processes--refresh nil t) (tabulated-list-init-header)) +(defun process-menu-delete-process () + "Kill process at point in a `list-processes' buffer." + (interactive) + (delete-process (tabulated-list-get-id)) + (revert-buffer)) + (defun list-processes--refresh () "Recompute the list of processes for the Process List buffer. Also, delete any process that is exited or signaled." @@ -3756,7 +3847,7 @@ some text between BEG and END, but we're killing the region." ;; Add that string to the kill ring, one way or another. (if (eq last-command 'kill-region) (kill-append string (< end beg)) - (kill-new string nil))) + (kill-new string))) (when (or string (eq last-command 'kill-region)) (setq this-command 'kill-region)) (setq deactivate-mark t) @@ -4282,10 +4373,8 @@ If ARG is zero, move to the beginning of the current line." (defun insert-buffer (buffer) "Insert after point the contents of BUFFER. Puts mark after the inserted text. -BUFFER may be a buffer or a buffer name. - -This function is meant for the user to run interactively. -Don't call it from programs: use `insert-buffer-substring' instead!" +BUFFER may be a buffer or a buffer name." + (declare (interactive-only insert-buffer-substring)) (interactive (list (progn @@ -4300,7 +4389,6 @@ Don't call it from programs: use `insert-buffer-substring' instead!" (insert-buffer-substring (get-buffer buffer)) (point))) nil) -(put 'insert-buffer 'interactive-only 'insert-buffer-substring) (defun append-to-buffer (buffer start end) "Append to specified buffer the text of the region. @@ -4659,15 +4747,13 @@ purposes. See the documentation of `set-mark' for more information." (pop-to-mark-command) (push-mark-command t))) ((and set-mark-command-repeat-pop - (eq last-command 'pop-to-mark-command)) - (setq this-command 'pop-to-mark-command) - (pop-to-mark-command)) - ((and set-mark-command-repeat-pop (eq last-command 'pop-global-mark) (not arg)) (setq this-command 'pop-global-mark) (pop-global-mark)) - (arg + ((or (and set-mark-command-repeat-pop + (eq last-command 'pop-to-mark-command)) + arg) (setq this-command 'pop-to-mark-command) (pop-to-mark-command)) ((eq last-command 'set-mark-command) @@ -4889,11 +4975,8 @@ this command moves to the specified goal column (or as close as possible). The goal column is stored in the variable `goal-column', which is nil when there is no goal column. Note that setting `goal-column' overrides `line-move-visual' and causes this command to move by buffer -lines rather than by display lines. - -If you are thinking of using this in a Lisp program, consider -using `forward-line' instead. It is usually easier to use -and more reliable (no dependence on goal column, etc.)." +lines rather than by display lines." + (declare (interactive-only forward-line)) (interactive "^p\np") (or arg (setq arg 1)) (if (and next-line-add-newlines (= arg 1)) @@ -4910,7 +4993,6 @@ and more reliable (no dependence on goal column, etc.)." (signal (car err) (cdr err)))) (line-move arg nil nil try-vscroll))) nil) -(put 'next-line 'interactive-only 'forward-line) (defun previous-line (&optional arg try-vscroll) "Move cursor vertically up ARG lines. @@ -4936,11 +5018,9 @@ this command moves to the specified goal column (or as close as possible). The goal column is stored in the variable `goal-column', which is nil when there is no goal column. Note that setting `goal-column' overrides `line-move-visual' and causes this command to move by buffer -lines rather than by display lines. - -If you are thinking of using this in a Lisp program, consider using -`forward-line' with a negative argument instead. It is usually easier -to use and more reliable (no dependence on goal column, etc.)." +lines rather than by display lines." + (declare (interactive-only + "use `forward-line' with negative argument instead.")) (interactive "^p\np") (or arg (setq arg 1)) (if (called-interactively-p 'interactive) @@ -4950,8 +5030,6 @@ to use and more reliable (no dependence on goal column, etc.)." (signal (car err) (cdr err)))) (line-move (- arg) nil nil try-vscroll)) nil) -(put 'previous-line 'interactive-only - "use `forward-line' with negative argument instead.") (defcustom track-eol nil "Non-nil means vertical motion starting at end of line keeps to ends of lines. @@ -6489,6 +6567,7 @@ The function should return non-nil if the two tokens do not match.") (not blink-matching-paren-dont-ignore-comments)))) (condition-case () (progn + (syntax-propertize (point)) (forward-sexp -1) ;; backward-sexp skips backward over prefix chars, ;; so move back to the matching paren. @@ -6603,6 +6682,8 @@ At top-level, as an editor command, this simply beeps." (deactivate-mark)) (if (fboundp 'kmacro-keyboard-quit) (kmacro-keyboard-quit)) + (when completion-in-region-mode + (completion-in-region-mode -1)) ;; Force the next redisplay cycle to remove the "Def" indicator from ;; all the mode lines. (if defining-kbd-macro @@ -6899,6 +6980,8 @@ With a prefix argument, set VARIABLE to VALUE buffer-locally." (define-key map "\e\e\e" 'delete-completion-window) (define-key map [left] 'previous-completion) (define-key map [right] 'next-completion) + (define-key map [?\t] 'next-completion) + (define-key map [backtab] 'previous-completion) (define-key map "q" 'quit-window) (define-key map "z" 'kill-this-buffer) map) @@ -7847,31 +7930,6 @@ contains the list of implementations currently supported for this command." command-name))))))) -;; This is here because files in obsolete/ are not scanned for autoloads. - -(defvar iswitchb-mode nil "\ -Non-nil if Iswitchb mode is enabled. -See the command `iswitchb-mode' for a description of this minor mode. -Setting this variable directly does not take effect; -either customize it (see the info node `Easy Customization') -or call the function `iswitchb-mode'.") - -(custom-autoload 'iswitchb-mode "iswitchb" nil) - -(autoload 'iswitchb-mode "iswitchb" "\ -Toggle Iswitchb mode. -With a prefix argument ARG, enable Iswitchb mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. - -Iswitchb mode is a global minor mode that enables switching -between buffers using substrings. See `iswitchb' for details. - -\(fn &optional ARG)" t nil) - -(make-obsolete 'iswitchb-mode - "use `icomplete-mode' or `ido-mode' instead." "24.4") - (provide 'simple) diff --git a/lisp/skeleton.el b/lisp/skeleton.el index 86c8ed49c74..28792ac558e 100644 --- a/lisp/skeleton.el +++ b/lisp/skeleton.el @@ -55,11 +55,8 @@ Typical examples might be `upcase' or `capitalize'.") When the region is visible (due to `transient-mark-mode' or marking a region with the mouse) and this is non-nil and the function was called without an explicit ARG, then the ARG defaults to -1, i.e. wrapping around the visible -region. - -We will probably delete this variable in a future Emacs version -unless we get a substantial number of complaints about the auto-wrap -feature.") +region.") +(make-obsolete-variable 'skeleton-autowrap nil "24.5") (defvar skeleton-end-newline t "If non-nil, make sure that the skeleton inserted ends with a newline. diff --git a/lisp/speedbar.el b/lisp/speedbar.el index 084767893e4..55e86e7fef3 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -39,21 +39,9 @@ this version is not backward compatible to 0.14 or earlier.") ;; ;;; Notes: ;; -;; Users of really old emacsen without the need timer functions -;; will not have speedbar updating automatically. Use "g" to refresh -;; the display after changing directories. Remember, do not interrupt -;; the stealthy updates or your display may not be completely -;; refreshed. -;; ;; AUC-TEX users: The imenu tags for AUC-TEX mode don't work very ;; well. Use the imenu keywords from tex-mode.el for better results. ;; -;; This file requires the library package assoc (association lists) -;; assoc should be available in all modern versions of Emacs. -;; The custom package is optional (for easy configuration of speedbar) -;; http://www.dina.kvl.dk/~abraham/custom/ -;; custom is available in all versions of Emacs version 20 or better. -;; ;;; Developing for speedbar ;; ;; Adding a speedbar specialized display mode: diff --git a/lisp/startup.el b/lisp/startup.el index 2f1d9af1cf1..aa448848cea 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -293,8 +293,9 @@ see `tty-setup-hook'.") `tty-setup-hook' instead." "24.4") (defvar inhibit-startup-hooks nil - "Non-nil means don't run `term-setup-hook' and `emacs-startup-hook'. -This is because we already did so.") + "Non-nil means don't run some startup hooks, because we already did. +Currently this applies to: `emacs-startup-hook', `term-setup-hook', +and `window-setup-hook'.") (defvar keyboard-type nil "The brand of keyboard you are using. @@ -648,9 +649,7 @@ It is the default value of the variable `top-level'." (emacs-pid) (system-name)))))))) (unless inhibit-startup-hooks - (run-hooks 'emacs-startup-hook) - (and term-setup-hook - (run-hooks 'term-setup-hook))) + (run-hooks 'emacs-startup-hook 'term-setup-hook)) ;; Don't do this if we failed to create the initial frame, ;; for instance due to a dense colormap. @@ -686,8 +685,8 @@ It is the default value of the variable `top-level'." ;; Now we know the user's default font, so add it to the menu. (if (fboundp 'font-menu-add-default) (font-menu-add-default)) - (and window-setup-hook - (run-hooks 'window-setup-hook)))) + (unless inhibit-startup-hooks + (run-hooks 'window-setup-hook)))) ;; Subprocesses of Emacs do not have direct access to the terminal, so ;; unless told otherwise they should only assume a dumb terminal. ;; We are careful to do it late (after term-setup-hook), although the @@ -1404,8 +1403,9 @@ If this is nil, no message will be displayed." `("GNU/Linux" ,(lambda (_button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html")) "Browse http://www.gnu.org/gnu/linux-and-gnu.html") - `("GNU" ,(lambda (_button) (describe-gnu-project)) - "Display info on the GNU project"))) + `("GNU" ,(lambda (_button) + (browse-url "http://www.gnu.org/gnu/thegnuproject.html")) + "Browse http://www.gnu.org/gnu/thegnuproject.html"))) " operating system.\n\n" :face variable-pitch :link ("Emacs Tutorial" ,(lambda (_button) (help-with-tutorial))) @@ -2434,10 +2434,7 @@ A fancy display is used on graphic displays, normal otherwise." ;; If there are no switches to process, we might as well ;; run this hook now, and there may be some need to do it ;; before doing any output. - (run-hooks 'emacs-startup-hook) - (and term-setup-hook - (run-hooks 'term-setup-hook)) - (setq inhibit-startup-hooks t) + (run-hooks 'emacs-startup-hook 'term-setup-hook) ;; It's important to notice the user settings before we ;; display the startup message; otherwise, the settings @@ -2449,10 +2446,9 @@ A fancy display is used on graphic displays, normal otherwise." ;; If there are no switches to process, we might as well ;; run this hook now, and there may be some need to do it ;; before doing any output. - (when window-setup-hook - (run-hooks 'window-setup-hook) - ;; Don't let the hook be run twice. - (setq window-setup-hook nil)) + (run-hooks 'window-setup-hook) + + (setq inhibit-startup-hooks t) ;; ;; Do this now to avoid an annoying delay if the user ;; ;; clicks the menu bar during the sit-for. diff --git a/lisp/subr.el b/lisp/subr.el index 700c072a81b..524b7954b7e 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -265,7 +265,9 @@ information about the function or macro; these go into effect during the evaluation of the `defun' or `defmacro' form. The possible values of SPECS are specified by -`defun-declarations-alist' and `macro-declarations-alist'." +`defun-declarations-alist' and `macro-declarations-alist'. + +For more information, see info node `(elisp)Declare Form'." ;; FIXME: edebug spec should pay attention to defun-declarations-alist. nil) @@ -332,6 +334,7 @@ Any list whose car is `frame-configuration' is assumed to be a frame configuration." (and (consp object) (eq (car object) 'frame-configuration))) + ;;;; List functions. @@ -380,6 +383,13 @@ If N is omitted or nil, remove the last element." (if (> n 0) (setcdr (nthcdr (- (1- m) n) list) nil)) list)))) +(defun zerop (number) + "Return t if NUMBER is zero." + ;; Used to be in C, but it's pointless since (= 0 n) is faster anyway because + ;; = has a byte-code. + (declare (compiler-macro (lambda (_) `(= 0 ,number)))) + (= 0 number)) + (defun delete-dups (list) "Destructively remove `equal' duplicates from LIST. Store the result in LIST and return it. LIST must be a proper list. @@ -2180,12 +2190,16 @@ floating point support." (read-event nil t seconds)))) (or (null read) (progn - ;; If last command was a prefix arg, e.g. C-u, push this event onto - ;; unread-command-events as (t . EVENT) so it will be added to - ;; this-command-keys by read-key-sequence. - (if (eq overriding-terminal-local-map universal-argument-map) - (setq read (cons t read))) - (push read unread-command-events) + ;; https://lists.gnu.org/archive/html/emacs-devel/2006-10/msg00394.html + ;; We want `read' appear in the next command's this-command-event + ;; but not in the current one. + ;; By pushing (cons t read), we indicate that `read' has not + ;; yet been recorded in this-command-keys, so it will be recorded + ;; next time it's read. + ;; And indeed the `seconds' argument to read-event correctly + ;; prevented recording this event in the current command's + ;; this-command-keys. + (push (cons t read) unread-command-events) nil)))))) ;; Behind display-popup-menus-p test. @@ -2692,14 +2706,6 @@ computing the hash. If BINARY is non-nil, return a string in binary form." (secure-hash 'sha1 object start end binary)) -(defalias 'function-put #'put - ;; This is only really used in Emacs>24.4, but we add it to 24.4 already, so - ;; as to ease the pain when people use future autoload files that contain - ;; function-put. - "Set function F's property PROP to VALUE. -The namespace for PROP is shared with symbols. -So far, F can only be a symbol, not a lambda expression.") - (defun function-get (f prop &optional autoload) "Return the value of property PROP of function F. If AUTOLOAD is non-nil and F is autoloaded, try to autoload it @@ -3189,12 +3195,7 @@ not really affect the buffer's content." `(let* ((,modified (buffer-modified-p)) (buffer-undo-list t) (inhibit-read-only t) - (inhibit-modification-hooks t) - deactivate-mark - ;; Avoid setting and removing file locks and checking - ;; buffer's uptodate-ness w.r.t the underlying file. - buffer-file-name - buffer-file-truename) + (inhibit-modification-hooks t)) (unwind-protect (progn ,@body) @@ -3312,6 +3313,19 @@ The value returned is the value of the last form in BODY." ,@body) (with-current-buffer ,old-buffer (set-case-table ,old-case-table)))))) + +(defmacro with-file-modes (modes &rest body) + "Execute BODY with default file permissions temporarily set to MODES. +MODES is as for `set-default-file-modes'." + (declare (indent 1) (debug t)) + (let ((umask (make-symbol "umask"))) + `(let ((,umask (default-file-modes))) + (unwind-protect + (progn + (set-default-file-modes ,modes) + ,@body) + (set-default-file-modes ,umask))))) + ;;; Matching and match data. @@ -3852,7 +3866,8 @@ This function is called directly from the C code." (byte-compile-log-warning msg)) (run-with-timer 0 nil (lambda (msg) - (message "%s" msg)) msg)))) + (message "%s" msg)) + msg)))) ;; Finally, run any other hook. (run-hook-with-args 'after-load-functions abs-file)) @@ -4169,7 +4184,8 @@ I is the index of the frame after FRAME2. It should return nil if those frames don't seem special and otherwise, it should return the number of frames to skip (minus 1).") -(defconst internal--call-interactively (symbol-function 'call-interactively)) +(defconst internal--funcall-interactively + (symbol-function 'funcall-interactively)) (defun called-interactively-p (&optional kind) "Return t if the containing function was called by `call-interactively'. @@ -4243,10 +4259,13 @@ command is called from a keyboard macro?" (pcase (cons frame nextframe) ;; No subr calls `interactive-p', so we can rule that out. (`((,_ ,(pred (lambda (f) (subrp (indirect-function f)))) . ,_) . ,_) nil) - ;; In case #<subr call-interactively> without going through the - ;; `call-interactively' symbol (bug#3984). - (`(,_ . (t ,(pred (eq internal--call-interactively)) . ,_)) t) - (`(,_ . (t call-interactively . ,_)) t))))) + ;; In case #<subr funcall-interactively> without going through the + ;; `funcall-interactively' symbol (bug#3984). + (`(,_ . (t ,(pred (lambda (f) + (eq internal--funcall-interactively + (indirect-function f)))) + . ,_)) + t))))) (defun interactive-p () "Return t if the containing function was run directly by user input. @@ -4307,6 +4326,7 @@ lookup sequence then continues." ;; Don't use letrec, because equal (in add/remove-hook) would get trapped ;; in a cycle. (fset clearfun + (suspicious-object (lambda () (with-demoted-errors "set-transient-map PCH: %S" (unless (cond @@ -4329,7 +4349,11 @@ lookup sequence then continues." (t (funcall keep-pred))) (internal-pop-keymap map 'overriding-terminal-local-map) (remove-hook 'pre-command-hook clearfun) - (when on-exit (funcall on-exit)))))) + (when on-exit (funcall on-exit)) + ;; Comment out the fset if you want to debug the GC bug. +;;; (fset clearfun nil) +;;; (set clearfun nil) + ))))) (add-hook 'pre-command-hook clearfun) (internal-push-keymap map 'overriding-terminal-local-map))) diff --git a/lisp/term/AT386.el b/lisp/term/AT386.el index 9750da15c72..dc6899e3835 100644 --- a/lisp/term/AT386.el +++ b/lisp/term/AT386.el @@ -22,8 +22,6 @@ ;;; Commentary: -;; Uses the Emacs 19 terminal initialization features --- won't work with 18. - ;;; Code: (defun terminal-init-AT386 () diff --git a/lisp/term/README b/lisp/term/README index b8756c3873d..b523063c0fd 100644 --- a/lisp/term/README +++ b/lisp/term/README @@ -5,9 +5,11 @@ See the end of the file for license conditions. This directory contains files of elisp that customize Emacs for certain terminal types. - When Emacs opens a new terminal, it checks the TERM environment variable to -see what type of terminal the user is running on, searches for an elisp file -named "term/${TERM}.el", and if one exists, loads it. If Emacs finds no + When Emacs opens a new terminal, it checks the TERM environment variable +to see what type of terminal the user is running on. (If there is an entry +for TERM in the `term-file-aliases' variable, Emacs uses the associated value +in place of TERM in the following.) Emacs searches for an elisp file named +"term/${TERM}.el", and if one exists, loads it. If Emacs finds no suitable file, then it strips the last hyphen and what follows it from TERM, and tries again. If that still doesn't yield a file, then the previous hyphen is stripped, and so on until all hyphens are gone. For example, if the diff --git a/lisp/term/apollo.el b/lisp/term/apollo.el deleted file mode 100644 index e4cabac3bf1..00000000000 --- a/lisp/term/apollo.el +++ /dev/null @@ -1,5 +0,0 @@ -(defun terminal-init-apollo () - "Terminal initialization function for apollo." - (tty-run-terminal-initialization (selected-frame) "vt100")) - -;;; apollo.el ends here diff --git a/lisp/term/news.el b/lisp/term/news.el index a58ff76aefe..a1e459a1261 100644 --- a/lisp/term/news.el +++ b/lisp/term/news.el @@ -22,8 +22,6 @@ ;;; Commentary: -;; Uses the Emacs 19 terminal initialization features --- won't work with 18. - ;;; Code: (defun terminal-init-news () diff --git a/lisp/term/screen.el b/lisp/term/screen.el index d37a695086a..69ddda80983 100644 --- a/lisp/term/screen.el +++ b/lisp/term/screen.el @@ -1,12 +1,9 @@ -;; Treat a screen terminal similar to an xterm. -(load "term/xterm") - -(declare-function xterm-register-default-colors "xterm" ()) +;;; screen.el --- terminal initialization for screen and tmux -*- lexical-binding: t -*- +;; Copyright (C) 1995, 2001-2014 Free Software Foundation, Inc. (defun terminal-init-screen () "Terminal initialization function for screen." - ;; Use the xterm color initialization code. - (xterm-register-default-colors) - (tty-set-up-initial-frame-faces)) + ;; Treat a screen terminal similar to an xterm. + (tty-run-terminal-initialization (selected-frame) "xterm")) ;; screen.el ends here diff --git a/lisp/term/tvi970.el b/lisp/term/tvi970.el index 841d88d4e19..3b77ab46400 100644 --- a/lisp/term/tvi970.el +++ b/lisp/term/tvi970.el @@ -23,8 +23,6 @@ ;;; Commentary: -;; Uses the Emacs 19 terminal initialization features --- won't work with 18. - ;;; Code: (defvar tvi970-terminal-map diff --git a/lisp/term/vt100.el b/lisp/term/vt100.el index 19e64d2bd90..6761e83891e 100644 --- a/lisp/term/vt100.el +++ b/lisp/term/vt100.el @@ -22,8 +22,6 @@ ;;; Commentary: -;; Uses the Emacs 19 terminal initialization features --- won't work with 18. - ;; Handles all VT100 clones, including the Apollo terminal. Also handles ;; the VT200 --- its PF- and arrow- keys are different, but all those ;; are really set up by the terminal initialization code, which mines them diff --git a/lisp/term/vt102.el b/lisp/term/vt102.el deleted file mode 100644 index 261b0bb5fd6..00000000000 --- a/lisp/term/vt102.el +++ /dev/null @@ -1,6 +0,0 @@ - -(defun terminal-init-vt102 () - "Terminal initialization function for vt102." - (tty-run-terminal-initialization (selected-frame) "vt100")) - -;;; vt102.el ends here diff --git a/lisp/term/vt125.el b/lisp/term/vt125.el deleted file mode 100644 index 2b2098d483d..00000000000 --- a/lisp/term/vt125.el +++ /dev/null @@ -1,6 +0,0 @@ - -(defun terminal-init-vt125 () - "Terminal initialization function for vt125." - (tty-run-terminal-initialization (selected-frame) "vt100")) - -;;; vt125.el ends here diff --git a/lisp/term/vt201.el b/lisp/term/vt201.el deleted file mode 100644 index a65b4737731..00000000000 --- a/lisp/term/vt201.el +++ /dev/null @@ -1,10 +0,0 @@ -;; For our purposes we can treat the vt200 and vt100 almost alike. -;; Most differences are handled by the termcap entry. -(defun terminal-init-vt201 () - "Terminal initialization function for vt201." - (tty-run-terminal-initialization (selected-frame) "vt100") - ;; Make F11 an escape key. - (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant. - (define-key local-function-key-map [f11] [?\e])) - -;;; vt201.el ends here diff --git a/lisp/term/vt220.el b/lisp/term/vt220.el deleted file mode 100644 index 0dd43353c55..00000000000 --- a/lisp/term/vt220.el +++ /dev/null @@ -1,10 +0,0 @@ -;; For our purposes we can treat the vt200 and vt100 almost alike. -;; Most differences are handled by the termcap entry. -(defun terminal-init-vt220 () - "Terminal initialization function for vt220." - (tty-run-terminal-initialization (selected-frame) "vt100") - ;; Make F11 an escape key. - (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant. - (define-key local-function-key-map [f11] [?\e])) - -;;; vt220.el ends here diff --git a/lisp/term/vt240.el b/lisp/term/vt240.el deleted file mode 100644 index b58d4211ce7..00000000000 --- a/lisp/term/vt240.el +++ /dev/null @@ -1,10 +0,0 @@ -;; For our purposes we can treat the vt200 and vt100 almost alike. -;; Most differences are handled by the termcap entry. -(defun terminal-init-vt240 () - "Terminal initialization function for vt240." - (tty-run-terminal-initialization (selected-frame) "vt100") - ;; Make F11 an escape key. - (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant. - (define-key local-function-key-map [f11] [?\e])) - -;;; vt240.el ends here diff --git a/lisp/term/vt300.el b/lisp/term/vt300.el deleted file mode 100644 index a2664552a64..00000000000 --- a/lisp/term/vt300.el +++ /dev/null @@ -1,8 +0,0 @@ -(defun terminal-init-vt300 () - "Terminal initialization function for vt300." - (tty-run-terminal-initialization (selected-frame) "vt100") - ;; Make F11 an escape key. - (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant. - (define-key local-function-key-map [f11] [?\e])) - -;;; vt300.el ends here diff --git a/lisp/term/vt320.el b/lisp/term/vt320.el deleted file mode 100644 index 08ed9a8ffb9..00000000000 --- a/lisp/term/vt320.el +++ /dev/null @@ -1,8 +0,0 @@ -(defun terminal-init-vt320 () - "Terminal initialization function for vt320." - (tty-run-terminal-initialization (selected-frame) "vt100") - ;; Make F11 an escape key. - (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant. - (define-key local-function-key-map [f11] [?\e])) - -;;; vt320.el ends here diff --git a/lisp/term/vt400.el b/lisp/term/vt400.el deleted file mode 100644 index ad4a5fdbb4f..00000000000 --- a/lisp/term/vt400.el +++ /dev/null @@ -1,8 +0,0 @@ -(defun terminal-init-vt400 () - "Terminal initialization function for vt400." - (tty-run-terminal-initialization (selected-frame) "vt100") - ;; Make F11 an escape key. - (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant. - (define-key local-function-key-map [f11] [?\e])) - -;;; vt400.el ends here diff --git a/lisp/term/vt420.el b/lisp/term/vt420.el deleted file mode 100644 index f6745a3953a..00000000000 --- a/lisp/term/vt420.el +++ /dev/null @@ -1,8 +0,0 @@ -(defun terminal-init-vt420 () - "Terminal initialization function for vt420." - (tty-run-terminal-initialization (selected-frame) "vt100") - ;; Make F11 an escape key. - (define-key input-decode-map "\e[23~" [f11]) ;Probably redundant. - (define-key local-function-key-map [f11] [?\e])) - -;;; vt420.el ends here diff --git a/lisp/term/wyse50.el b/lisp/term/wyse50.el index aa9ba43d3d7..77c1655dfd1 100644 --- a/lisp/term/wyse50.el +++ b/lisp/term/wyse50.el @@ -23,7 +23,6 @@ ;;; Commentary: -;; Uses the Emacs 19 terminal initialization features --- won't work with 18. ;; Rewritten for Emacs 19 by jimb, January 1992 ;; Cleaned up for new terminal package conventions by esr, March 1993 ;; Should work well for Televideo TVI 925 although it's overkill. diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index ba017e9938f..1d085017214 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -43,10 +43,40 @@ The relevant features are: :type '(choice (const :tag "No" nil) (const :tag "Check" check) ;; NOTE: If you add entries here, make sure to update - ;; `tocheck-capabilities' in `terminal-init-xterm' as well. + ;; `terminal-init-xterm' as well. (set (const :tag "modifyOtherKeys support" modifyOtherKeys) (const :tag "report background" reportBackground)))) +(defconst xterm-paste-ending-sequence "\e[201~" + "Characters send by the terminal to end a bracketed paste.") + +(defun xterm-paste () + "Handle the start of a terminal paste operation." + (interactive) + (let* ((end-marker-length (length xterm-paste-ending-sequence)) + (pasted-text (with-temp-buffer + (set-buffer-multibyte nil) + (while (not (search-backward + xterm-paste-ending-sequence + (- (point) end-marker-length) t)) + (let ((event (read-event + nil nil + ;; Use finite timeout to avoid + ;; glomming the event onto + ;; this-command-keys. + most-positive-fixnum))) + (when (eql event ?\r) + (setf event ?\n)) + (insert event))) + (let ((last-coding-system-used)) + (decode-coding-region + (point-min) (point) + (keyboard-coding-system) t)))) + (interprogram-paste-function (lambda () pasted-text))) + (yank))) + +(define-key global-map [xterm-paste] #'xterm-paste) + (defvar xterm-function-map (let ((map (make-sparse-keymap))) @@ -248,6 +278,70 @@ The relevant features are: (define-key map "\eOx" [kp-8]) (define-key map "\eOy" [kp-9]) + (define-key map "\eO2j" [S-kp-multiply]) + (define-key map "\eO2k" [S-kp-add]) + (define-key map "\eO2l" [S-kp-separator]) + (define-key map "\eO2m" [S-kp-subtract]) + (define-key map "\eO2o" [S-kp-divide]) + (define-key map "\eO2p" [S-kp-0]) + (define-key map "\eO2q" [S-kp-1]) + (define-key map "\eO2r" [S-kp-2]) + (define-key map "\eO2s" [S-kp-3]) + (define-key map "\eO2t" [S-kp-4]) + (define-key map "\eO2u" [S-kp-5]) + (define-key map "\eO2v" [S-kp-6]) + (define-key map "\eO2w" [S-kp-7]) + (define-key map "\eO2x" [S-kp-8]) + (define-key map "\eO2y" [S-kp-9]) + + (define-key map "\eO4j" [M-S-kp-multiply]) + (define-key map "\eO4k" [M-S-kp-add]) + (define-key map "\eO4l" [M-S-kp-separator]) + (define-key map "\eO4m" [M-S-kp-subtract]) + (define-key map "\eO4o" [M-S-kp-divide]) + (define-key map "\eO4p" [M-S-kp-0]) + (define-key map "\eO4q" [M-S-kp-1]) + (define-key map "\eO4r" [M-S-kp-2]) + (define-key map "\eO4s" [M-S-kp-3]) + (define-key map "\eO4t" [M-S-kp-4]) + (define-key map "\eO4u" [M-S-kp-5]) + (define-key map "\eO4v" [M-S-kp-6]) + (define-key map "\eO4w" [M-S-kp-7]) + (define-key map "\eO4x" [M-S-kp-8]) + (define-key map "\eO4y" [M-S-kp-9]) + + (define-key map "\eO6j" [C-S-kp-multiply]) + (define-key map "\eO6k" [C-S-kp-add]) + (define-key map "\eO6l" [C-S-kp-separator]) + (define-key map "\eO6m" [C-S-kp-subtract]) + (define-key map "\eO6o" [C-S-kp-divide]) + (define-key map "\eO6p" [C-S-kp-0]) + (define-key map "\eO6q" [C-S-kp-1]) + (define-key map "\eO6r" [C-S-kp-2]) + (define-key map "\eO6s" [C-S-kp-3]) + (define-key map "\eO6t" [C-S-kp-4]) + (define-key map "\eO6u" [C-S-kp-5]) + (define-key map "\eO6v" [C-S-kp-6]) + (define-key map "\eO6w" [C-S-kp-7]) + (define-key map "\eO6x" [C-S-kp-8]) + (define-key map "\eO6y" [C-S-kp-9]) + + (define-key map "\eO8j" [C-M-S-kp-multiply]) + (define-key map "\eO8k" [C-M-S-kp-add]) + (define-key map "\eO8l" [C-M-S-kp-separator]) + (define-key map "\eO8m" [C-M-S-kp-subtract]) + (define-key map "\eO8o" [C-M-S-kp-divide]) + (define-key map "\eO8p" [C-M-S-kp-0]) + (define-key map "\eO8q" [C-M-S-kp-1]) + (define-key map "\eO8r" [C-M-S-kp-2]) + (define-key map "\eO8s" [C-M-S-kp-3]) + (define-key map "\eO8t" [C-M-S-kp-4]) + (define-key map "\eO8u" [C-M-S-kp-5]) + (define-key map "\eO8v" [C-M-S-kp-6]) + (define-key map "\eO8w" [C-M-S-kp-7]) + (define-key map "\eO8x" [C-M-S-kp-8]) + (define-key map "\eO8y" [C-M-S-kp-9]) + ;; These keys are available in xterm starting from version 216 ;; if the modifyOtherKeys resource is set to 1. (dolist (bind '((5 9 [C-tab]) @@ -394,6 +488,11 @@ The relevant features are: (define-key map "\e[12~" [f2]) (define-key map "\e[13~" [f3]) (define-key map "\e[14~" [f4]) + + ;; Recognize the start of a bracketed paste sequence. The handler + ;; internally recognizes the end. + (define-key map "\e[200~" [xterm-paste]) + map) "Function key map overrides for xterm.") @@ -463,9 +562,6 @@ The relevant features are: map) "Keymap of possible alternative meanings for some keys.") -;; List of terminals for which modify-other-keys has been turned on. -(defvar xterm-modify-other-keys-terminal-list nil) - (defun xterm--report-background-handler () (let ((str "") chr) @@ -605,21 +701,23 @@ We run the first FUNCTION whose STRING matches the input events." (when (memq 'modifyOtherKeys xterm-extra-capabilities) (terminal-init-xterm-modify-other-keys))) + ;; Unconditionally enable bracketed paste mode: terminals that don't + ;; support it just ignore the sequence. + (terminal-init-xterm-bracketed-paste-mode) + (run-hooks 'terminal-init-xterm-hook)) (defun terminal-init-xterm-modify-other-keys () "Terminal initialization for xterm's modifyOtherKeys support." - ;; Make sure that the modifyOtherKeys state is restored when - ;; suspending, resuming and exiting. - (add-hook 'suspend-hook 'xterm-turn-off-modify-other-keys) - (add-hook 'suspend-resume-hook 'xterm-turn-on-modify-other-keys) - (add-hook 'kill-emacs-hook 'xterm-remove-modify-other-keys) - (add-hook 'delete-terminal-functions 'xterm-remove-modify-other-keys) - ;; Add the selected frame to the list of frames that - ;; need to deal with modify-other-keys. - (push (frame-terminal) - xterm-modify-other-keys-terminal-list) - (xterm-turn-on-modify-other-keys)) + (send-string-to-terminal "\e[>4;1m") + (push "\e[>4m" (terminal-parameter nil 'tty-mode-reset-strings)) + (push "\e[>4;1m" (terminal-parameter nil 'tty-mode-set-strings))) + +(defun terminal-init-xterm-bracketed-paste-mode () + "Terminal initialization for bracketed paste mode." + (send-string-to-terminal "\e[?2004h") + (push "\e[?2004l" (terminal-parameter nil 'tty-mode-reset-strings)) + (push "\e[?2004h" (terminal-parameter nil 'tty-mode-set-strings))) ;; Set up colors, for those versions of xterm that support it. (defvar xterm-standard-colors @@ -737,29 +835,6 @@ versions of xterm." ;; right colors, so clear them. (clear-face-cache))) -(defun xterm-turn-on-modify-other-keys () - "Turn the modifyOtherKeys feature of xterm back on." - (let ((terminal (frame-terminal))) - (when (and (terminal-live-p terminal) - (memq terminal xterm-modify-other-keys-terminal-list)) - (send-string-to-terminal "\e[>4;1m" terminal)))) - -(defun xterm-turn-off-modify-other-keys (&optional frame) - "Temporarily turn off the modifyOtherKeys feature of xterm." - (let ((terminal (when frame (frame-terminal frame)))) - (when (and (terminal-live-p terminal) - (memq terminal xterm-modify-other-keys-terminal-list)) - (send-string-to-terminal "\e[>4m" terminal)))) - -(defun xterm-remove-modify-other-keys (&optional terminal) - "Turn off the modifyOtherKeys feature of xterm for good." - (setq terminal (or terminal (frame-terminal))) - (when (and (terminal-live-p terminal) - (memq terminal xterm-modify-other-keys-terminal-list)) - (setq xterm-modify-other-keys-terminal-list - (delq terminal xterm-modify-other-keys-terminal-list)) - (send-string-to-terminal "\e[>4m" terminal))) - (defun xterm-maybe-set-dark-background-mode (redc greenc bluec) ;; Use the heuristic in `frame-set-background-mode' to decide if a ;; frame is dark. diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el index 7a5bc8afeea..05e593ea70f 100644 --- a/lisp/textmodes/conf-mode.el +++ b/lisp/textmodes/conf-mode.el @@ -311,8 +311,7 @@ unbalanced, but hey...)" (when (or (not arg) (= (prefix-numeric-value arg) 2)) (modify-syntax-entry ?\" "." table)) (set-syntax-table table) - (when font-lock-mode - (font-lock-fontify-buffer)))) + (font-lock-flush))) (defun conf-outline-level () diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 5cdae22cc0f..0fc6b4a9995 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -931,16 +931,14 @@ Otherwise returns the library directory name, if that is defined." (defun ispell-call-process (&rest args) "Like `call-process' but defend against bad `default-directory'." (let ((default-directory default-directory)) - (unless (and (file-directory-p default-directory) - (file-readable-p default-directory)) + (unless (file-accessible-directory-p default-directory) (setq default-directory (expand-file-name "~/"))) (apply 'call-process args))) (defun ispell-call-process-region (&rest args) "Like `call-process-region' but defend against bad `default-directory'." (let ((default-directory default-directory)) - (unless (and (file-directory-p default-directory) - (file-readable-p default-directory)) + (unless (file-accessible-directory-p default-directory) (setq default-directory (expand-file-name "~/"))) (apply 'call-process-region args))) @@ -2939,8 +2937,7 @@ Keeps argument list for future Ispell invocations for no async support." (ispell-hunspell-fill-dictionary-entry ispell-current-dictionary))) (let* ((default-directory - (if (and (file-directory-p default-directory) - (file-readable-p default-directory)) + (if (file-accessible-directory-p default-directory) default-directory ;; Defend against bad `default-directory'. (expand-file-name "~/"))) @@ -2998,8 +2995,7 @@ Keeps argument list for future Ispell invocations for no async support." (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))) + (not (file-accessible-directory-p default-directory)) ;; Ispell and per-dir personal dicts available (not (or (file-readable-p (concat default-directory ".ispell_words")) diff --git a/lisp/textmodes/reftex-auc.el b/lisp/textmodes/reftex-auc.el index ce69a64f4c0..2d7093ce81d 100644 --- a/lisp/textmodes/reftex-auc.el +++ b/lisp/textmodes/reftex-auc.el @@ -47,6 +47,7 @@ (and (listp reftex-plug-into-AUCTeX) (nth which reftex-plug-into-AUCTeX)))) +;;;###autoload (defun reftex-arg-label (optional &optional prompt definition) "Use `reftex-label', `reftex-reference' or AUCTeX's code to insert label arg. What is being used depends upon `reftex-plug-into-AUCTeX'." @@ -68,6 +69,7 @@ What is being used depends upon `reftex-plug-into-AUCTeX'." (LaTeX-add-labels label)) (TeX-argument-insert label optional))) +;;;###autoload (defun reftex-arg-cite (optional &optional prompt definition) "Use `reftex-citation' or AUCTeX's code to insert a cite-key macro argument. What is being used depends upon `reftex-plug-into-AUCTeX'." @@ -85,6 +87,7 @@ What is being used depends upon `reftex-plug-into-AUCTeX'." optional))) +;;;###autoload (defun reftex-arg-index-tag (optional &optional prompt &rest args) "Prompt for an index tag with completion. This is the name of an index, not the entry." @@ -104,6 +107,7 @@ This is the name of an index, not the entry." (setq tag (read-string prompt))) (TeX-argument-insert tag optional))) +;;;###autoload (defun reftex-arg-index (optional &optional prompt &rest args) "Prompt for an index entry completing with known entries. Completion is specific for just one index, if the macro or a tag @@ -138,6 +142,7 @@ argument identify one of multiple indices." (t "idx"))))) (defvar LaTeX-label-function) +;;;###autoload (defun reftex-plug-into-AUCTeX () ;; Replace AUCTeX functions with RefTeX functions. ;; Which functions are replaced is controlled by the variable @@ -162,6 +167,7 @@ argument identify one of multiple indices." (fboundp 'TeX-arg-index) (fset 'TeX-arg-index 'reftex-arg-index))) +;;;###autoload (defun reftex-toggle-plug-into-AUCTeX () "Toggle Interface between AUCTeX and RefTeX on and off." (interactive) @@ -173,6 +179,7 @@ argument identify one of multiple indices." (message "RefTeX has been plugged into AUCTeX.") (message "RefTeX no longer interacts with AUCTeX."))) +;;;###autoload (defun reftex-add-label-environments (entry-list) "Add label environment descriptions to `reftex-label-alist-style'. The format of ENTRY-LIST is exactly like `reftex-label-alist'. See there @@ -197,8 +204,10 @@ the label information is recompiled on next use." (push entry list))) (when changed (put reftex-docstruct-symbol 'reftex-label-alist-style list))))) +;;;###autoload (defalias 'reftex-add-to-label-alist 'reftex-add-label-environments) +;;;###autoload (defun reftex-add-section-levels (entry-list) "Add entries to the value of `reftex-section-levels'. The added values are kept local to the current document. The format @@ -219,9 +228,14 @@ of ENTRY-LIST is a list of cons cells (\"MACRONAME\" . LEVEL). See (when changed (put reftex-docstruct-symbol 'reftex-section-levels list))))) +;;;###autoload (defun reftex-notice-new-section () (reftex-notice-new 1 'force)) (provide 'reftex-auc) ;;; reftex-auc.el ends here + +;; Local Variables: +;; generated-autoload-file: "reftex.el" +;; End: diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el index a36fa17fca5..8ac0b0b3606 100644 --- a/lisp/textmodes/reftex-cite.el +++ b/lisp/textmodes/reftex-cite.el @@ -58,6 +58,7 @@ ,@body) (set-syntax-table saved-syntax)))) +;;;###autoload (defun reftex-default-bibliography () "Return the expanded value of variable `reftex-default-bibliography'. The expanded value is cached." @@ -70,6 +71,7 @@ The expanded value is cached." reftex-default-bibliography)) (get 'reftex-default-bibliography :reftex-expanded)) +;;;###autoload (defun reftex-bib-or-thebib () "Test if BibTeX or \begin{thebibliography} should be used for the citation. Find the bof of the current file" @@ -89,6 +91,7 @@ Find the bof of the current file" (if bib 'bib nil) (if thebib 'thebib nil)))) +;;;###autoload (defun reftex-get-bibfile-list () "Return list of bibfiles for current document. When using the chapterbib or bibunits package you should either @@ -112,6 +115,7 @@ Then this function will return the applicable database files." (error "\\bibliography statement missing or .bib files not found"))) ;;; Find a certain reference in any of the BibTeX files. +;;;###autoload (defun reftex-pop-to-bibtex-entry (key file-list &optional mark-to-kill highlight item return) "Find BibTeX KEY in any file in FILE-LIST in another window. @@ -161,6 +165,7 @@ If RETURN is non-nil, just return the entry and restore point." (error "No \\bibitem with citation key %s" key) (error "No BibTeX entry with citation key %s" key))))) +;;;###autoload (defun reftex-end-of-bib-entry (item) (save-excursion (condition-case nil @@ -452,6 +457,7 @@ If FIELD is empty try \"editor\" field." (setq names (replace-match " " nil t names))) (split-string names "\n"))) +;;;###autoload (defun reftex-parse-bibtex-entry (entry &optional from to raw) "Parse BibTeX ENTRY. If ENTRY is nil then parse the entry in current buffer between FROM and TO. @@ -604,6 +610,7 @@ If FORMAT is non-nil `format' entry accordingly." ;;; Make a citation +;; NB this is a global autoload - see reftex.el. ;;;###autoload (defun reftex-citation (&optional no-insert format-key) "Make a citation using BibTeX database files. @@ -787,11 +794,13 @@ in order to only add another reference in the same cite command." (error "No citation format associated with key `%c'" key))))) format)) +;;;###autoload (defun reftex-citep () "Call `reftex-citation' with a format selector `?p'." (interactive) (reftex-citation nil ?p)) +;;;###autoload (defun reftex-citet () "Call `reftex-citation' with a format selector `?t'." (interactive) @@ -1058,6 +1067,7 @@ in order to only add another reference in the same cite command." (setq format (replace-match "" t t format))) format) +;;;###autoload (defun reftex-make-cite-echo-string (entry docstruct-symbol) "Format a bibtex ENTRY for the echo area and cache the result." (let* ((key (reftex-get-bib-field "&key" entry)) @@ -1151,6 +1161,7 @@ recommended for follow mode. It works OK for individual lookups." (string-match "^&" (car pair))) alist)))) +;;;###autoload (defun reftex-create-bibtex-file (bibfile) "Create a new BibTeX database BIBFILE with all entries referenced in document. The command prompts for a filename and writes the collected @@ -1244,3 +1255,7 @@ created files in the variables `reftex-create-bibtex-header' or (provide 'reftex-cite) ;;; reftex-cite.el ends here + +;; Local Variables: +;; generated-autoload-file: "reftex.el" +;; End: diff --git a/lisp/textmodes/reftex-dcr.el b/lisp/textmodes/reftex-dcr.el index dc7448cc993..a06492e4759 100644 --- a/lisp/textmodes/reftex-dcr.el +++ b/lisp/textmodes/reftex-dcr.el @@ -30,6 +30,7 @@ (require 'reftex) +;;;###autoload (defun reftex-view-crossref (&optional arg auto-how fail-quietly) "View cross reference of macro at point. Point must be on the KEY argument. When at a `\\ref' macro, show corresponding `\\label' @@ -220,6 +221,7 @@ to the functions `reftex-view-cr-cite' and `reftex-view-cr-ref'." (when (equal arg 2) (select-window pop-win))))) +;;;###autoload (defun reftex-mouse-view-crossref (ev) "View cross reference of \\ref or \\cite macro where you click. If the macro at point is a \\ref, show the corresponding label definition. @@ -318,6 +320,7 @@ With argument, actually select the window showing the cross reference." "Non-nil means use the idle timers in XEmacs for crossref display. Currently, idle timer restart is broken and we use the post-command-hook.") +;;;###autoload (defun reftex-toggle-auto-view-crossref () "Toggle the automatic display of crossref information in the echo area. When active, leaving point idle in the argument of a \\ref or \\cite macro @@ -355,6 +358,7 @@ will display info in the echo area." 'reftex-view-crossref-when-idle reftex-idle-time nil t)))) +;;;###autoload (defun reftex-view-crossref-from-bibtex (&optional arg) "View location in a LaTeX document which cites the BibTeX entry at point. Since BibTeX files can be used by many LaTeX documents, this function @@ -482,3 +486,7 @@ Calling this function several times find successive citation locations." (provide 'reftex-dcr) ;;; reftex-dcr.el ends here + +;; Local Variables: +;; generated-autoload-file: "reftex.el" +;; End: diff --git a/lisp/textmodes/reftex-global.el b/lisp/textmodes/reftex-global.el index 4311c99923e..e16792ee703 100644 --- a/lisp/textmodes/reftex-global.el +++ b/lisp/textmodes/reftex-global.el @@ -29,6 +29,7 @@ (require 'reftex) ;;; +;;;###autoload (defun reftex-create-tags-file () "Create TAGS file by running `etags' on the current document. The TAGS file is also immediately visited with `visit-tags-table'." @@ -48,6 +49,7 @@ The TAGS file is also immediately visited with `visit-tags-table'." (defvar reftex-grep-command "grep -n " "Last grep command used in \\[reftex-grep-document]; default for next grep.") +;;;###autoload (defun reftex-grep-document (grep-cmd) "Run grep query through all files related to this document. With prefix arg, force to rescan document. @@ -64,6 +66,7 @@ No active TAGS table is required." (mapconcat 'identity files " ")))) (grep cmd))) +;;;###autoload (defun reftex-search-document (&optional regexp) "Regexp search through all files of the current document. Starts always in the master file. Stops when a match is found. @@ -79,6 +82,7 @@ No active TAGS table is required." (reftex-access-scan-info current-prefix-arg) (tags-search regexp (list 'reftex-all-document-files)))) +;;;###autoload (defun reftex-query-replace-document (&optional from to delimited) "Do `query-replace-regexp' of FROM with TO over the entire document. Third arg DELIMITED (prefix arg) means replace only word-delimited matches. @@ -100,6 +104,7 @@ No active TAGS table is required." (defvar TeX-master) (defvar isearch-next-buffer-function) +;;;###autoload (defun reftex-find-duplicate-labels () "Produce a list of all duplicate labels in the document." @@ -158,6 +163,7 @@ No active TAGS table is required." (delete-window) (message "Document does not contain duplicate labels.")))) +;;;###autoload (defun reftex-change-label (&optional from to) "Run `query-replace-regexp' of FROM with TO in all macro arguments. Works on the entire multifile document. @@ -177,6 +183,7 @@ No active TAGS table is required." (concat "{" (regexp-quote from) "}") (format "{%s}" to)))) +;;;###autoload (defun reftex-renumber-simple-labels () "Renumber all simple labels in the document to make them sequentially. Simple labels are the ones created by RefTeX, consisting only of the @@ -304,6 +311,7 @@ one with the `xr' package." (t nil)))))))) n)) +;;;###autoload (defun reftex-save-all-document-buffers () "Save all documents associated with the current document. The function is useful after a global action like replacing or renumbering @@ -414,6 +422,7 @@ Also checks if buffers visiting the files are in read-only mode." (when flist (find-file-noselect (car flist)))))) +;; NB this is a global autoload - see reftex.el. ;;;###autoload (defun reftex-isearch-minor-mode (&optional arg) "When on, isearch searches the whole document, not only the current file. @@ -466,3 +475,7 @@ With no argument, this command toggles 'reftex-isearch-minor-mode) ;;; reftex-global.el ends here + +;; Local Variables: +;; generated-autoload-file: "reftex.el" +;; End: diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el index 4a329b9999e..f6aa5239dea 100644 --- a/lisp/textmodes/reftex-index.el +++ b/lisp/textmodes/reftex-index.el @@ -35,6 +35,7 @@ (defvar TeX-master) ;; END remove for XEmacs release +;;;###autoload (defun reftex-index-selection-or-word (&optional arg phrase) "Put selection or the word near point into the default index macro. This uses the information in `reftex-index-default-macro' to make an index @@ -87,6 +88,7 @@ which is part of AUCTeX, the string is first processed with the (delete-region beg end) (reftex-index def-char full-entry def-tag sel))))) +;;;###autoload (defun reftex-index (&optional char key tag sel no-insert) "Query for an index macro and insert it along with its arguments. The index macros available are those defined in `reftex-index-macro' or @@ -156,6 +158,7 @@ will prompt for other arguments." (member tag tag-list))) (put reftex-docstruct-symbol 'default-index-tag tag))) +;;;###autoload (defun reftex-index-complete-tag (&optional itag opt-args) ;; Ask the user for a tag, completing on known tags. ;; ITAG is the argument number which contains the tag. @@ -180,6 +183,7 @@ will prompt for other arguments." (reftex-update-default-index tag) tag)) +;;;###autoload (defun reftex-index-select-tag () ;; Have the user select an index tag. ;; FIXME: should we cache tag-alist, prompt and help? @@ -249,6 +253,7 @@ will prompt for other arguments." (error "No index tag associated with %c" rpl))))) (t (error "This should not happen (reftex-index-select-tag)"))))) +;;;###autoload (defun reftex-index-complete-key (&optional tag optional initial) ;; Read an index key, with completion. ;; Restrict completion table on index tag TAG. @@ -434,6 +439,7 @@ _ ^ Add/Remove parent key (to make this item a subitem). } / { Restrict Index to a single document section / Widen. < / > When restricted, move restriction to previous/next section.") +;;;###autoload (defun reftex-index-show-entry (data &optional no-revisit) ;; Find an index entry associated with DATA and display it highlighted ;; in another window. NO-REVISIT means we are not allowed to visit @@ -462,6 +468,7 @@ _ ^ Add/Remove parent key (to make this item a subitem). (reftex-highlight 0 (match-beginning 0) (match-end 0) (current-buffer))) match)) +;;;###autoload (defun reftex-display-index (&optional tag overriding-restriction redo &rest locations) "Display a buffer with an index compiled from the current document. @@ -1244,6 +1251,7 @@ This gets refreshed in every phrases command.") table) "Syntax table for RefTeX Index Phrases mode.") +;;;###autoload (defun reftex-index-phrase-selection-or-word (arg) "Add current selection or word at point to the phrases buffer. When you are in transient-mark-mode and the region is active, the @@ -1258,6 +1266,7 @@ You get a chance to edit the entry in the phrases buffer - finish with (substitute-command-keys "Return to LaTeX with \\[reftex-index-phrases-save-and-return]")))) +;;;###autoload (defun reftex-index-visit-phrases-buffer () "Switch to the phrases buffer, initialize if empty." (interactive) @@ -1345,6 +1354,7 @@ If the buffer is non-empty, delete the old header first." (defvar reftex-index-phrases-menu) (defvar reftex-index-phrases-marker) (defvar reftex-index-phrases-restrict-file nil) +;; NB this is a global autoload - see reftex.el. ;;;###autoload (define-derived-mode reftex-index-phrases-mode fundamental-mode "Phrases" "Major mode for managing the Index phrases of a LaTeX document. @@ -2096,3 +2106,7 @@ Does not do a save-excursion." (provide 'reftex-index) ;;; reftex-index.el ends here + +;; Local Variables: +;; generated-autoload-file: "reftex.el" +;; End: diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el index 71bec89a51d..5b0433475b6 100644 --- a/lisp/textmodes/reftex-parse.el +++ b/lisp/textmodes/reftex-parse.el @@ -37,17 +37,22 @@ ,@body)) (set-syntax-table saved-syntax)))) +;;;###autoload (defun reftex-parse-one () "Re-parse this file." (interactive) (let ((reftex-enable-partial-scans t)) (reftex-access-scan-info '(4)))) +;;;###autoload (defun reftex-parse-all () "Re-parse entire document." (interactive) (reftex-access-scan-info '(16))) +(defvar reftex--index-tags) + +;;;###autoload (defun reftex-do-parse (rescan &optional file) "Do a document rescan. When allowed, do only a partial scan from FILE." @@ -72,7 +77,7 @@ When allowed, do only a partial scan from FILE." (file (or file (buffer-file-name))) (true-file (file-truename file)) (bibview-cache (assq 'bibview-cache old-list)) - (index-tags (cdr (assq 'index-tags old-list))) + (reftex--index-tags (cdr (assq 'index-tags old-list))) from-file appendix docstruct tmp) ;; Make sure replacement is really an option here @@ -92,7 +97,7 @@ When allowed, do only a partial scan from FILE." (t (error "This should not happen (reftex-do-parse)")))) ;; Reset index-tags if we scan everything - (if (equal rescan 1) (setq index-tags nil)) + (if (equal rescan 1) (setq reftex--index-tags nil)) ;; Find active toc entry and initialize section-numbers (setq reftex-active-toc (reftex-last-assoc-before-elt @@ -137,11 +142,12 @@ When allowed, do only a partial scan from FILE." (entry (or (assq 'is-multi docstruct) (car (push (list 'is-multi is-multi) docstruct))))) (setcdr entry (cons is-multi nil))) - (and index-tags (setq index-tags (sort index-tags 'string<))) + (and reftex--index-tags + (setq reftex--index-tags (sort reftex--index-tags 'string<))) (let ((index-tag-cell (assq 'index-tags docstruct))) (if index-tag-cell - (setcdr index-tag-cell index-tags) - (push (cons 'index-tags index-tags) docstruct))) + (setcdr index-tag-cell reftex--index-tags) + (push (cons 'index-tags reftex--index-tags) docstruct))) (unless (assq 'xr docstruct) (let* ((allxr (reftex-all-assq 'xr-doc docstruct)) (alist (mapcar @@ -165,11 +171,13 @@ When allowed, do only a partial scan from FILE." (set reftex-docstruct-symbol docstruct) (put reftex-docstruct-symbol 'modified t))) +;;;###autoload (defun reftex-everything-regexp () (if reftex-support-index reftex-everything-regexp reftex-everything-regexp-no-index)) +;; NB this is a global autoload - see reftex.el. ;;;###autoload (defun reftex-all-document-files (&optional relative) "Return a list of all files belonging to the current document. @@ -189,8 +197,6 @@ of master file." (nreverse file-list))) ;; Bound in the caller, reftex-do-parse. -(defvar index-tags) - (defun reftex-parse-from-file (file docstruct master-dir) "Scan the buffer for labels and save them in a list." (let ((regexp (reftex-everything-regexp)) @@ -300,7 +306,7 @@ of master file." (when reftex-support-index (setq index-entry (reftex-index-info file)) (when index-entry - (add-to-list 'index-tags (nth 1 index-entry)) + (add-to-list 'reftex--index-tags (nth 1 index-entry)) (push index-entry docstruct)))) ((match-end 11) @@ -359,6 +365,7 @@ of master file." (save-excursion (re-search-forward "^[^%]*\\\\usepackage.*{biblatex}" nil t)))) +;;;###autoload (defun reftex-locate-bibliography-files (master-dir &optional files) "Scan buffer for bibliography macros and return file list." (unless files @@ -421,6 +428,7 @@ This function also makes sure the old toc markers do not point anywhere." (setcdr (nthcdr (1- (length new)) new) (cdr eof-list))) new)))) +;;;###autoload (defun reftex-section-info (file) "Return a section entry for the current match. Careful: This function expects the match-data to be still in place!" @@ -457,6 +465,7 @@ Careful: This function expects the match-data to be still in place!" (list 'toc "toc" text file marker level section-number literal (marker-position marker)))) +;;;###autoload (defun reftex-ensure-index-support (&optional abort) "When index support is turned off, ask to turn it on and set the current prefix argument so that `reftex-access-scan-info' @@ -472,11 +481,13 @@ will rescan the entire document." (ding) (sit-for 1))))) +;;;###autoload (defun reftex-index-info-safe (file) (reftex-with-special-syntax (reftex-index-info file))) (defvar test-dummy) +;;;###autoload (defun reftex-index-info (file) "Return an index entry for the current match. Careful: This function expects the match-data to be still in place!" @@ -525,6 +536,7 @@ Careful: This function expects the match-data to be still in place!" ;; 0 1 2 3 4 5 6 7 8 9 (list 'index index-tag context file bom arg key showkey sortkey key-end)))) +;;;###autoload (defun reftex-short-context (env parse &optional bound derive) "Get about one line of useful context for the label definition at point." @@ -585,6 +597,7 @@ Careful: This function expects the match-data to be still in place!" (t "INVALID VALUE OF PARSE")))) +;;;###autoload (defun reftex-where-am-I () "Return the docstruct entry above point. Actually returns a cons cell in which the cdr is a flag indicating @@ -683,6 +696,7 @@ if the information is exact (t) or approximate (nil)." cnt 2)) (cons rtn (eq cnt 1)))) +;;;###autoload (defun reftex-notice-new (&optional n force) "Hook to handshake with RefTeX after something new has been inserted." ;; Add a new entry to the docstruct list. If it is a section, renumber @@ -759,7 +773,7 @@ if the information is exact (t) or approximate (nil)." ;; Index entry (and reftex-support-index (setq entry (reftex-index-info-safe buffer-file-name)) - ;; FIXME: (add-to-list 'index-tags (nth 1 index-entry)) + ;; FIXME: (add-to-list 'reftex--index-tags (nth 1 index-entry)) (push entry (cdr tail)))))))))) (error nil)) @@ -781,11 +795,13 @@ in TeX." t) (t nil))) +;;;###autoload (defun reftex-what-macro-safe (which &optional bound) "Call `reftex-what-macro' with special syntax table." (reftex-with-special-syntax (reftex-what-macro which bound))) +;;;###autoload (defun reftex-what-macro (which &optional bound) "Find out if point is within the arguments of any TeX-macro. The return value is either (\"\\macro\" . (point)) or a list of them. @@ -848,6 +864,7 @@ considered an argument of macro \\macro." (goto-char pos))) (nreverse cmd-list))))) +;;;###autoload (defun reftex-what-environment (which &optional bound) "Find out if point is inside a LaTeX environment. The return value is (e.g.) either (\"equation\" . (point)) or a list of @@ -885,6 +902,7 @@ this point. If it is nil, limit to nearest \\section - like statement." (throw 'exit (cons env (point)))))) (nreverse env-list))))) +;;;###autoload (defun reftex-what-special-env (which &optional bound) "Run the special environment parsers and return the matches. @@ -925,7 +943,7 @@ If WHICH is a list of environments, look only for those environments and specials (car specials)))))) -(defsubst reftex-move-to-next-arg (&optional ignore) +(defsubst reftex-move-to-next-arg (&optional _ignore) "Assuming that we are at the end of a macro name or a macro argument, move forward to the opening parenthesis of the next argument. This function understands the splitting of macros over several lines @@ -944,6 +962,7 @@ in TeX." (let ((entry (assoc key reftex-env-or-mac-alist))) (reftex-nth-arg (nth 5 entry) (nth 6 entry)))) +;;;###autoload (defun reftex-nth-arg (n &optional opt-args) "Return the Nth following {} or [] parentheses content. OPT-ARGS is a list of argument numbers which are optional." @@ -982,6 +1001,7 @@ OPT-ARGS is a list of argument numbers which are optional." (reftex-context-substring) nil)))) +;;;###autoload (defun reftex-move-over-touching-args () (condition-case nil (while (memq (following-char) '(?\[ ?\{)) @@ -1021,6 +1041,7 @@ When point is just after a { or [, limit string to matching parenthesis" ;; Variable holding the vector with section numbers (defvar reftex-section-numbers (make-vector reftex-max-section-depth 0)) +;;;###autoload (defun reftex-init-section-numbers (&optional toc-entry appendix) "Initialize the section numbers with zeros or with what is found in the TOC-ENTRY." (let* ((level (or (nth 5 toc-entry) -1)) @@ -1039,6 +1060,7 @@ When point is just after a { or [, limit string to matching parenthesis" (decf i))) (put 'reftex-section-numbers 'appendix appendix)) +;;;###autoload (defun reftex-section-number (&optional level star) "Return a string with the current section number. When LEVEL is non-nil, increase section numbers on that level." @@ -1107,3 +1129,7 @@ When LEVEL is non-nil, increase section numbers on that level." (provide 'reftex-parse) ;;; reftex-parse.el ends here + +;; Local Variables: +;; generated-autoload-file: "reftex.el" +;; End: diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el index f2fa815f479..ac01b6852ec 100644 --- a/lisp/textmodes/reftex-ref.el +++ b/lisp/textmodes/reftex-ref.el @@ -29,6 +29,7 @@ (require 'reftex) (require 'reftex-parse) +;;;###autoload (defun reftex-label-location (&optional bound) "Return the environment or macro which determines the label type at point. If optional BOUND is an integer, limit backward searches to that point." @@ -62,6 +63,7 @@ If optional BOUND is an integer, limit backward searches to that point." (t ;; This should not happen, I think? "section")))) +;;;###autoload (defun reftex-label-info-update (cell) ;; Update information about just one label in a different file. ;; CELL contains the old info list @@ -92,6 +94,7 @@ If optional BOUND is an integer, limit backward searches to that point." (append (reftex-label-info label file) (list note))) (list label typekey "" file "LOST LABEL. RESCAN TO FIX."))))))) +;;;###autoload (defun reftex-label-info (label &optional file bound derive env-or-mac) ;; Return info list on LABEL at point. (let* ((prefix (if (string-match "^[a-zA-Z0-9]+:" label) @@ -118,6 +121,7 @@ If optional BOUND is an integer, limit backward searches to that point." ;;; Creating labels --------------------------------------------------------- +;;;###autoload (defun reftex-label (&optional environment no-insert) "Insert a unique label. Return the label. If ENVIRONMENT is given, don't bother to find out yourself. @@ -398,6 +402,7 @@ also applies `reftex-translate-to-ascii-function' to the string." a / A Put all marked entries into one/many \\ref commands. q / RET Quit without referencing / Accept current label (also on mouse-2).") +;;;###autoload (defun reftex-reference (&optional type no-insert cut) "Make a LaTeX reference. Look only for labels of a certain TYPE. With prefix arg, force to rescan buffer for labels. This should only be @@ -705,6 +710,7 @@ When called with 2 C-u prefix args, disable magic word recognition." (file (nth 3 data))) (reftex-access-scan-info arg file))))) +;;;###autoload (defun reftex-query-label-type () ;; Ask for label type (let ((key (reftex-select-with-char @@ -713,6 +719,7 @@ When called with 2 C-u prefix args, disable magic word recognition." (error "No such label type: %s" (char-to-string key))) (char-to-string key))) +;;;###autoload (defun reftex-show-label-location (data forward no-revisit &optional stay error) ;; View the definition site of a label in another window. @@ -833,10 +840,14 @@ package.\n\nThis is a generated function." Replace any occurrences of \"\\ref\" with REFSTYLE." ;; Replace instances of \ref in `fmt' with the special reference ;; style selected by the user. - (while (string-match "\\(\\\\ref\\)[ \t]*{" fmt) - (setq fmt (replace-match refstyle t t fmt 1))) + (cond + ((while (string-match "\\(\\\\ref\\)[ \t]*{" fmt) + (setq fmt (replace-match refstyle t t fmt 1)))) + ((string-match "\\(\\\\[[:alpha:]]+\\)[ \t]*{" fmt) + (setq fmt (replace-match refstyle t t fmt 1)))) (format fmt label)) +;;;###autoload (defun reftex-goto-label (&optional other-window) "Prompt for a label (with completion) and jump to the location of this label. Optional prefix argument OTHER-WINDOW goes to the label in another window." @@ -867,3 +878,7 @@ Optional prefix argument OTHER-WINDOW goes to the label in another window." (provide 'reftex-ref) ;;; reftex-ref.el ends here + +;; Local Variables: +;; generated-autoload-file: "reftex.el" +;; End: diff --git a/lisp/textmodes/reftex-sel.el b/lisp/textmodes/reftex-sel.el index f589abbc778..a993a883b0f 100644 --- a/lisp/textmodes/reftex-sel.el +++ b/lisp/textmodes/reftex-sel.el @@ -102,6 +102,7 @@ This keymap can be used to configure the label selection process which is started with the command \\[reftex-reference].") +;;;###autoload (define-derived-mode reftex-select-label-mode fundamental-mode "LSelect" "Major mode for selecting a label in a LaTeX document. This buffer was created with RefTeX. @@ -147,6 +148,7 @@ During a selection process, these are the local bindings. This keymap can be used to configure the BibTeX selection process which is started with the command \\[reftex-citation].") +;;;###autoload (define-derived-mode reftex-select-bib-mode fundamental-mode "BSelect" "Major mode for selecting a citation key in a LaTeX document. This buffer was created with RefTeX. @@ -188,6 +190,7 @@ During a selection process, these are the local bindings. ;; (throw 'exit entry))) ;; nil)))) +;;;###autoload (defun reftex-get-offset (buf here-am-I &optional typekey toc index file) ;; Find the correct offset data, like insert-docstruct would, but faster. ;; Buffer BUF knows the correct docstruct to use. @@ -212,6 +215,7 @@ During a selection process, these are the local bindings. (throw 'exit (or lastentry entry)))) nil)))) +;;;###autoload (defun reftex-insert-docstruct (buf toc labels index-entries files context counter show-commented here-I-am xr-prefix toc-buffer) @@ -412,6 +416,7 @@ During a selection process, these are the local bindings. (run-hooks 'reftex-display-copied-context-hook) offset)) +;;;###autoload (defun reftex-find-start-point (fallback &rest locations) ;; Set point to the first available LOCATION. When a LOCATION is a list, ;; search for such a :data text property. When it is an integer, @@ -440,6 +445,7 @@ During a selection process, these are the local bindings. (defvar reftex-last-line nil) (defvar reftex-select-marked nil) +;;;###autoload (defun reftex-select-item (reftex-select-prompt help-string keymap &optional offset call-back cb-flag) @@ -737,3 +743,7 @@ Cycle in reverse order if optional argument REVERSE is non-nil." (provide 'reftex-sel) ;;; reftex-sel.el ends here + +;; Local Variables: +;; generated-autoload-file: "reftex.el" +;; End: diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el index 59f9de88111..e164770fa0c 100644 --- a/lisp/textmodes/reftex-toc.el +++ b/lisp/textmodes/reftex-toc.el @@ -190,6 +190,7 @@ M-% Global search and replace to rename label at point. x Switch to TOC of external document (with LaTeX package `xr'). z Jump to a specific section (e.g. '3 z' goes to section 3).") +;;;###autoload (defun reftex-toc (&optional rebuild reuse) "Show the table of contents for the current document. When called with a raw C-u prefix, rescan the document first." @@ -240,13 +241,13 @@ When called with a raw C-u prefix, rescan the document first." (< (window-height) (* 2 window-min-height))) (delete-other-windows)) - (setq reftex-last-window-width (window-width) + (setq reftex-last-window-width (window-total-width) reftex-last-window-height (window-height)) ; remember (unless unsplittable (if reftex-toc-split-windows-horizontally (split-window-right - (floor (* (window-width) + (floor (* (window-total-width) reftex-toc-split-windows-fraction))) (split-window-below (floor (* (window-height) @@ -319,6 +320,7 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help (reftex-find-start-point (point) offset (get 'reftex-toc :reftex-line)) (setq reftex-last-follow-point (point)))) +;;;###autoload (defun reftex-toc-recenter (&optional arg) "Display the TOC window and highlight line corresponding to current position." (interactive "P") @@ -372,8 +374,8 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help (defun reftex-re-enlarge () "Enlarge window to a remembered size." (let ((count (if reftex-toc-split-windows-horizontally - (- (or reftex-last-window-width (window-width)) - (window-width)) + (- (or reftex-last-window-width (window-total-width)) + (window-total-width)) (- (or reftex-last-window-height (window-height)) (window-height))))) (when (> count 0) @@ -1009,6 +1011,7 @@ label prefix determines the wording of a reference." (let (current-prefix-arg) (reftex-toc-recenter)))) +;;;###autoload (defun reftex-toggle-auto-toc-recenter () "Toggle the automatic recentering of the TOC window. When active, leaving point idle will make the TOC window jump to the correct @@ -1088,3 +1091,7 @@ always show the current section in connection with the option (reftex-toggle-auto-toc-recenter)))) ;;; reftex-toc.el ends here + +;; Local Variables: +;; generated-autoload-file: "reftex.el" +;; End: diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el index ec3ab712ce4..590de2472f2 100644 --- a/lisp/textmodes/reftex.el +++ b/lisp/textmodes/reftex.el @@ -70,141 +70,26 @@ (require 'reftex-vars) -;;; Autoloads - -;; Parser functions -(autoload 'reftex-parse-one "reftex-parse" - "Re-parse this file." t) -(autoload 'reftex-parse-all "reftex-parse" - "Re-parse entire document." t) -(autoload 'reftex-do-parse "reftex-parse") -(autoload 'reftex-where-am-I "reftex-parse") -(autoload 'reftex-init-section-numbers "reftex-parse") -(autoload 'reftex-section-info "reftex-parse") -(autoload 'reftex-section-number "reftex-parse") -(autoload 'reftex-what-macro "reftex-parse") -(autoload 'reftex-what-macro-safe "reftex-parse") -(autoload 'reftex-index-info "reftex-parse") -(autoload 'reftex-index-info-safe "reftex-parse") -(autoload 'reftex-short-context "reftex-parse") -(autoload 'reftex-what-environment "reftex-parse") -(autoload 'reftex-what-special-env "reftex-parse") -(autoload 'reftex-move-over-touching-args "reftex-parse") -(autoload 'reftex-notice-new "reftex-parse") -(autoload 'reftex-nth-arg "reftex-parse") -(autoload 'reftex-locate-bibliography-files "reftex-parse") -(autoload 'reftex-ensure-index-support "reftex-parse") -(autoload 'reftex-everything-regexp "reftex-parse") - -;; Labels and References -(autoload 'reftex-label-location "reftex-ref") -(autoload 'reftex-label-info-update "reftex-ref") -(autoload 'reftex-label-info "reftex-ref") -(autoload 'reftex-label "reftex-ref" - "Insert a unique label." t) -(autoload 'reftex-reference "reftex-ref" - "Make a LaTeX reference." t) +;;; Autoloads - see end for automatic autoloads + +;; We autoload tons of functions from these files, but some have +;; a single function that needs to be globally autoloaded. +;; The alternative is to use a Makefile rule + distinct autoload +;; cookie (eg ;;;###reftex-autoload) for internal autoloads, +;; as eg calendar/ does. But that seemed like overkill for 4 functions. + +;;;###autoload(autoload 'reftex-citation "reftex-cite" nil t) +;;;###autoload(autoload 'reftex-all-document-files "reftex-parse") +;;;###autoload(autoload 'reftex-isearch-minor-mode "reftex-global" nil t) +;;;###autoload(autoload 'reftex-index-phrases-mode "reftex-index" nil t) + +;; Generated functions. (autoload 'reftex-varioref-vref "reftex-ref" "Make a varioref reference." t) (autoload 'reftex-fancyref-fref "reftex-ref" "Make a fancyref \\fref reference." t) (autoload 'reftex-fancyref-Fref "reftex-ref" "Make a fancyref \\Fref reference." t) -(autoload 'reftex-show-label-location "reftex-ref") -(autoload 'reftex-query-label-type "reftex-ref") -(autoload 'reftex-goto-label "reftex-ref" - "Prompt for label name and go to that location." t) - -;; Table of contents -(autoload 'reftex-toc "reftex-toc" - "Show the table of contents for the current document." t) -(autoload 'reftex-toc-recenter "reftex-toc" - "Display the TOC window and highlight line corresponding to current position." t) -(autoload 'reftex-toggle-auto-toc-recenter "reftex-toc" - "Toggle automatic recentering of TOC window." t) - -;; BibTeX citations. -(autoload 'reftex-citep "reftex-cite") -(autoload 'reftex-citet "reftex-cite") -(autoload 'reftex-make-cite-echo-string "reftex-cite") -(autoload 'reftex-get-bibfile-list "reftex-cite") -(autoload 'reftex-pop-to-bibtex-entry "reftex-cite") -(autoload 'reftex-end-of-bib-entry "reftex-cite") -(autoload 'reftex-parse-bibtex-entry "reftex-cite") -(autoload 'reftex-citation "reftex-cite" - "Make a citation using BibTeX database files." t) -(autoload 'reftex-default-bibliography "reftex-cite") -(autoload 'reftex-bib-or-thebib "reftex-cite") -(autoload 'reftex-create-bibtex-file "reftex-cite" - "Create a new BibTeX database BIBFILE with all entries referenced in document." - t) - -;; Selection -(autoload 'reftex-select-label-mode "reftex-sel") -(autoload 'reftex-select-bib-mode "reftex-sel") -(autoload 'reftex-find-start-point "reftex-sel") -(autoload 'reftex-insert-docstruct "reftex-sel") -(autoload 'reftex-get-offset "reftex-sel") -(autoload 'reftex-select-item "reftex-sel") - -;; Index support -(autoload 'reftex-index "reftex-index" - "Query for an index macro and insert it along with its arguments." t) -(autoload 'reftex-index-selection-or-word "reftex-index" - "Put selection or the word near point into the default index macro." t) -(autoload 'reftex-index-phrase-selection-or-word "reftex-index" - "Put selection or the word near point into Index Phrases File." t) -(autoload 'reftex-display-index "reftex-index" - "Display a buffer with an index compiled from the current document." t) -(autoload 'reftex-index-visit-phrases-buffer "reftex-index" - "Visit the Index Phrases File." t) -(autoload 'reftex-index-phrases-mode "reftex-index" - "Major mode for managing the Index phrases of a LaTeX document." t) -(autoload 'reftex-index-complete-tag "reftex-index") -(autoload 'reftex-index-complete-key "reftex-index") -(autoload 'reftex-index-show-entry "reftex-index") -(autoload 'reftex-index-select-tag "reftex-index") - -;; View cross references -(autoload 'reftex-view-crossref "reftex-dcr" - "View cross reference of \\ref or \\cite macro at point." t) -(autoload 'reftex-mouse-view-crossref "reftex-dcr" - "View cross reference of \\ref or \\cite macro where you click." t) -(autoload 'reftex-toggle-auto-view-crossref "reftex-dcr") -(autoload 'reftex-view-crossref-from-bibtex "reftex-dcr" - "View location in a LaTeX document which cites the BibTeX entry at point." t) - -;; Operations on entire Multifile documents -(autoload 'reftex-create-tags-file "reftex-global" - "Create TAGS file by running `etags' on the current document." t) -(autoload 'reftex-grep-document "reftex-global" - "Run grep query through all files related to this document." t) -(autoload 'reftex-search-document "reftex-global" - "Regexp search through all files of the current TeX document." t) -(autoload 'reftex-query-replace-document "reftex-global" - "Run a query-replace-regexp of FROM with TO over the entire TeX document." t) -(autoload 'reftex-find-duplicate-labels "reftex-global" - "Produce a list of all duplicate labels in the document." t) -(autoload 'reftex-change-label "reftex-global" - "Query replace FROM with TO in all \\label and \\ref commands." t) -(autoload 'reftex-renumber-simple-labels "reftex-global" - "Renumber all simple labels in the document to make them sequentially." t) -(autoload 'reftex-save-all-document-buffers "reftex-global" - "Save all documents associated with the current document." t) - -;; AUCTeX Interface -(autoload 'reftex-arg-label "reftex-auc") -(autoload 'reftex-arg-cite "reftex-auc") -(autoload 'reftex-arg-index-tag "reftex-auc") -(autoload 'reftex-arg-index "reftex-auc") -(autoload 'reftex-plug-into-AUCTeX "reftex-auc") -(autoload 'reftex-toggle-plug-into-AUCTeX "reftex-auc" - "Toggle Interface between AUCTeX and RefTeX on and off." t) -(autoload 'reftex-add-label-environments "reftex-auc") -(autoload 'reftex-add-to-label-alist "reftex-auc") -(autoload 'reftex-add-section-levels "reftex-auc") -(autoload 'reftex-notice-new-section "reftex-auc") - ;;; ========================================================================= ;;; @@ -2493,6 +2378,703 @@ Your bug report will be posted to the AUCTeX bug reporting list. ;;; That's it! ---------------------------------------------------------------- (setq reftex-tables-dirty t) ; in case this file is evaluated by hand + + +;;; Start of automatically extracted autoloads. + +;;;### (autoloads nil "reftex-auc" "reftex-auc.el" "16f7e4bde671b5faee975a9ff10838e7") +;;; Generated autoloads from reftex-auc.el + +(autoload 'reftex-arg-label "reftex-auc" "\ +Use `reftex-label', `reftex-reference' or AUCTeX's code to insert label arg. +What is being used depends upon `reftex-plug-into-AUCTeX'. + +\(fn OPTIONAL &optional PROMPT DEFINITION)" nil nil) + +(autoload 'reftex-arg-cite "reftex-auc" "\ +Use `reftex-citation' or AUCTeX's code to insert a cite-key macro argument. +What is being used depends upon `reftex-plug-into-AUCTeX'. + +\(fn OPTIONAL &optional PROMPT DEFINITION)" nil nil) + +(autoload 'reftex-arg-index-tag "reftex-auc" "\ +Prompt for an index tag with completion. +This is the name of an index, not the entry. + +\(fn OPTIONAL &optional PROMPT &rest ARGS)" nil nil) + +(autoload 'reftex-arg-index "reftex-auc" "\ +Prompt for an index entry completing with known entries. +Completion is specific for just one index, if the macro or a tag +argument identify one of multiple indices. + +\(fn OPTIONAL &optional PROMPT &rest ARGS)" nil nil) + +(autoload 'reftex-plug-into-AUCTeX "reftex-auc" "\ + + +\(fn)" nil nil) + +(autoload 'reftex-toggle-plug-into-AUCTeX "reftex-auc" "\ +Toggle Interface between AUCTeX and RefTeX on and off. + +\(fn)" t nil) + +(autoload 'reftex-add-label-environments "reftex-auc" "\ +Add label environment descriptions to `reftex-label-alist-style'. +The format of ENTRY-LIST is exactly like `reftex-label-alist'. See there +for details. +This function makes it possible to support RefTeX from AUCTeX style files. +The entries in ENTRY-LIST will be processed after the user settings in +`reftex-label-alist', and before the defaults (specified in +`reftex-default-label-alist-entries'). Any changes made to +`reftex-label-alist-style' will raise a flag to the effect that +the label information is recompiled on next use. + +\(fn ENTRY-LIST)" nil nil) + +(defalias 'reftex-add-to-label-alist 'reftex-add-label-environments) + +(autoload 'reftex-add-section-levels "reftex-auc" "\ +Add entries to the value of `reftex-section-levels'. +The added values are kept local to the current document. The format +of ENTRY-LIST is a list of cons cells (\"MACRONAME\" . LEVEL). See +`reftex-section-levels' for an example. + +\(fn ENTRY-LIST)" nil nil) + +(autoload 'reftex-notice-new-section "reftex-auc" "\ + + +\(fn)" nil nil) + +;;;*** + +;;;### (autoloads nil "reftex-cite" "reftex-cite.el" "43a70b713b3cd8a225f03431400e54e6") +;;; Generated autoloads from reftex-cite.el + +(autoload 'reftex-default-bibliography "reftex-cite" "\ +Return the expanded value of variable `reftex-default-bibliography'. +The expanded value is cached. + +\(fn)" nil nil) + +(autoload 'reftex-bib-or-thebib "reftex-cite" "\ +Test if BibTeX or egin{thebibliography} should be used for the citation. +Find the bof of the current file + +\(fn)" nil nil) + +(autoload 'reftex-get-bibfile-list "reftex-cite" "\ +Return list of bibfiles for current document. +When using the chapterbib or bibunits package you should either +use the same database files everywhere, or separate parts using +different databases into different files (included into the mater file). +Then this function will return the applicable database files. + +\(fn)" nil nil) + +(autoload 'reftex-pop-to-bibtex-entry "reftex-cite" "\ +Find BibTeX KEY in any file in FILE-LIST in another window. +If MARK-TO-KILL is non-nil, mark new buffer to kill. +If HIGHLIGHT is non-nil, highlight the match. +If ITEM in non-nil, search for bibitem instead of database entry. +If RETURN is non-nil, just return the entry and restore point. + +\(fn KEY FILE-LIST &optional MARK-TO-KILL HIGHLIGHT ITEM RETURN)" nil nil) + +(autoload 'reftex-end-of-bib-entry "reftex-cite" "\ + + +\(fn ITEM)" nil nil) + +(autoload 'reftex-parse-bibtex-entry "reftex-cite" "\ +Parse BibTeX ENTRY. +If ENTRY is nil then parse the entry in current buffer between FROM and TO. +If RAW is non-nil, keep double quotes/curly braces delimiting fields. + +\(fn ENTRY &optional FROM TO RAW)" nil nil) + +(autoload 'reftex-citation "reftex-cite" "\ +Make a citation using BibTeX database files. +After prompting for a regular expression, scans the buffers with +bibtex entries (taken from the \\bibliography command) and offers the +matching entries for selection. The selected entry is formatted according +to `reftex-cite-format' and inserted into the buffer. + +If NO-INSERT is non-nil, nothing is inserted, only the selected key returned. + +FORMAT-KEY can be used to pre-select a citation format. + +When called with a `C-u' prefix, prompt for optional arguments in +cite macros. When called with a numeric prefix, make that many +citations. When called with point inside the braces of a `\\cite' +command, it will add another key, ignoring the value of +`reftex-cite-format'. + +The regular expression uses an expanded syntax: && is interpreted as `and'. +Thus, `aaaa&&bbb' matches entries which contain both `aaaa' and `bbb'. +While entering the regexp, completion on knows citation keys is possible. +`=' is a good regular expression to match all entries in all files. + +\(fn &optional NO-INSERT FORMAT-KEY)" t nil) + +(autoload 'reftex-citep "reftex-cite" "\ +Call `reftex-citation' with a format selector `?p'. + +\(fn)" t nil) + +(autoload 'reftex-citet "reftex-cite" "\ +Call `reftex-citation' with a format selector `?t'. + +\(fn)" t nil) + +(autoload 'reftex-make-cite-echo-string "reftex-cite" "\ +Format a bibtex ENTRY for the echo area and cache the result. + +\(fn ENTRY DOCSTRUCT-SYMBOL)" nil nil) + +(autoload 'reftex-create-bibtex-file "reftex-cite" "\ +Create a new BibTeX database BIBFILE with all entries referenced in document. +The command prompts for a filename and writes the collected +entries to that file. Only entries referenced in the current +document with any \\cite-like macros are used. The sequence in +the new file is the same as it was in the old database. + +Entries referenced from other entries must appear after all +referencing entries. + +You can define strings to be used as header or footer for the +created files in the variables `reftex-create-bibtex-header' or +`reftex-create-bibtex-footer' respectively. + +\(fn BIBFILE)" t nil) + +;;;*** + +;;;### (autoloads nil "reftex-dcr" "reftex-dcr.el" "e90640fdd78f4404b29729bf7a5fce30") +;;; Generated autoloads from reftex-dcr.el + +(autoload 'reftex-view-crossref "reftex-dcr" "\ +View cross reference of macro at point. Point must be on the KEY +argument. When at a `\\ref' macro, show corresponding `\\label' +definition, also in external documents (`xr'). When on a label, show +a locations where KEY is referenced. Subsequent calls find additional +locations. When on a `\\cite', show the associated `\\bibitem' macro or +the BibTeX database entry. When on a `\\bibitem', show a `\\cite' macro +which uses this KEY. When on an `\\index', show other locations marked +by the same index entry. +To define additional cross referencing items, use the option +`reftex-view-crossref-extra'. See also `reftex-view-crossref-from-bibtex'. +With one or two C-u prefixes, enforce rescanning of the document. +With argument 2, select the window showing the cross reference. +AUTO-HOW is only for the automatic crossref display and is handed through +to the functions `reftex-view-cr-cite' and `reftex-view-cr-ref'. + +\(fn &optional ARG AUTO-HOW FAIL-QUIETLY)" t nil) + +(autoload 'reftex-mouse-view-crossref "reftex-dcr" "\ +View cross reference of \\ref or \\cite macro where you click. +If the macro at point is a \\ref, show the corresponding label definition. +If it is a \\cite, show the BibTeX database entry. +If there is no such macro at point, search forward to find one. +With argument, actually select the window showing the cross reference. + +\(fn EV)" t nil) + +(autoload 'reftex-toggle-auto-view-crossref "reftex-dcr" "\ +Toggle the automatic display of crossref information in the echo area. +When active, leaving point idle in the argument of a \\ref or \\cite macro +will display info in the echo area. + +\(fn)" t nil) + +(autoload 'reftex-view-crossref-from-bibtex "reftex-dcr" "\ +View location in a LaTeX document which cites the BibTeX entry at point. +Since BibTeX files can be used by many LaTeX documents, this function +prompts upon first use for a buffer in RefTeX mode. To reset this +link to a document, call the function with a prefix arg. +Calling this function several times find successive citation locations. + +\(fn &optional ARG)" t nil) + +;;;*** + +;;;### (autoloads nil "reftex-global" "reftex-global.el" "a773b46e8b751bca3a82c991f81b5fdd") +;;; Generated autoloads from reftex-global.el + +(autoload 'reftex-create-tags-file "reftex-global" "\ +Create TAGS file by running `etags' on the current document. +The TAGS file is also immediately visited with `visit-tags-table'. + +\(fn)" t nil) + +(autoload 'reftex-grep-document "reftex-global" "\ +Run grep query through all files related to this document. +With prefix arg, force to rescan document. +No active TAGS table is required. + +\(fn GREP-CMD)" t nil) + +(autoload 'reftex-search-document "reftex-global" "\ +Regexp search through all files of the current document. +Starts always in the master file. Stops when a match is found. +To continue searching for next match, use command \\[tags-loop-continue]. +No active TAGS table is required. + +\(fn &optional REGEXP)" t nil) + +(autoload 'reftex-query-replace-document "reftex-global" "\ +Do `query-replace-regexp' of FROM with TO over the entire document. +Third arg DELIMITED (prefix arg) means replace only word-delimited matches. +If you exit (\\[keyboard-quit], RET or q), you can resume the query replace +with the command \\[tags-loop-continue]. +No active TAGS table is required. + +\(fn &optional FROM TO DELIMITED)" t nil) + +(autoload 'reftex-find-duplicate-labels "reftex-global" "\ +Produce a list of all duplicate labels in the document. + +\(fn)" t nil) + +(autoload 'reftex-change-label "reftex-global" "\ +Run `query-replace-regexp' of FROM with TO in all macro arguments. +Works on the entire multifile document. +If you exit (\\[keyboard-quit], RET or q), you can resume the query replace +with the command \\[tags-loop-continue]. +No active TAGS table is required. + +\(fn &optional FROM TO)" t nil) + +(autoload 'reftex-renumber-simple-labels "reftex-global" "\ +Renumber all simple labels in the document to make them sequentially. +Simple labels are the ones created by RefTeX, consisting only of the +prefix and a number. After the command completes, all these labels will +have sequential numbers throughout the document. Any references to +the labels will be changed as well. For this, RefTeX looks at the +arguments of any macros which either start or end in the string `ref'. +This command should be used with care, in particular in multifile +documents. You should not use it if another document refers to this +one with the `xr' package. + +\(fn)" t nil) + +(autoload 'reftex-save-all-document-buffers "reftex-global" "\ +Save all documents associated with the current document. +The function is useful after a global action like replacing or renumbering +labels. + +\(fn)" t nil) + +(autoload 'reftex-isearch-minor-mode "reftex-global" "\ +When on, isearch searches the whole document, not only the current file. +This minor mode allows isearch to search through all the files of +the current TeX document. + +With no argument, this command toggles +`reftex-isearch-minor-mode'. With a prefix argument ARG, turn +`reftex-isearch-minor-mode' on if ARG is positive, otherwise turn it off. + +\(fn &optional ARG)" t nil) + +;;;*** + +;;;### (autoloads nil "reftex-index" "reftex-index.el" "ccf53e4cdf1d7280e4cdb54d23e81854") +;;; Generated autoloads from reftex-index.el + +(autoload 'reftex-index-selection-or-word "reftex-index" "\ +Put selection or the word near point into the default index macro. +This uses the information in `reftex-index-default-macro' to make an index +entry. The phrase indexed is the current selection or the word near point. +When called with one `C-u' prefix, let the user have a chance to edit the +index entry. When called with 2 `C-u' as prefix, also ask for the index +macro and other stuff. +When called inside TeX math mode as determined by the `texmathp.el' library +which is part of AUCTeX, the string is first processed with the +`reftex-index-math-format', which see. + +\(fn &optional ARG PHRASE)" t nil) + +(autoload 'reftex-index "reftex-index" "\ +Query for an index macro and insert it along with its arguments. +The index macros available are those defined in `reftex-index-macro' or +by a call to `reftex-add-index-macros', typically from an AUCTeX style file. +RefteX provides completion for the index tag and the index key, and +will prompt for other arguments. + +\(fn &optional CHAR KEY TAG SEL NO-INSERT)" t nil) + +(autoload 'reftex-index-complete-tag "reftex-index" "\ + + +\(fn &optional ITAG OPT-ARGS)" nil nil) + +(autoload 'reftex-index-select-tag "reftex-index" "\ + + +\(fn)" nil nil) + +(autoload 'reftex-index-complete-key "reftex-index" "\ + + +\(fn &optional TAG OPTIONAL INITIAL)" nil nil) + +(autoload 'reftex-index-show-entry "reftex-index" "\ + + +\(fn DATA &optional NO-REVISIT)" nil nil) + +(autoload 'reftex-display-index "reftex-index" "\ +Display a buffer with an index compiled from the current document. +When the document has multiple indices, first prompts for the correct one. +When index support is turned off, offer to turn it on. +With one or two `C-u' prefixes, rescan document first. +With prefix 2, restrict index to current document section. +With prefix 3, restrict index to region. + +\(fn &optional TAG OVERRIDING-RESTRICTION REDO &rest LOCATIONS)" t nil) + +(autoload 'reftex-index-phrase-selection-or-word "reftex-index" "\ +Add current selection or word at point to the phrases buffer. +When you are in transient-mark-mode and the region is active, the +selection will be used - otherwise the word at point. +You get a chance to edit the entry in the phrases buffer - finish with +`C-c C-c'. + +\(fn ARG)" t nil) + +(autoload 'reftex-index-visit-phrases-buffer "reftex-index" "\ +Switch to the phrases buffer, initialize if empty. + +\(fn)" t nil) + +(autoload 'reftex-index-phrases-mode "reftex-index" "\ +Major mode for managing the Index phrases of a LaTeX document. +This buffer was created with RefTeX. + +To insert new phrases, use + - `C-c \\' in the LaTeX document to copy selection or word + - `\\[reftex-index-new-phrase]' in the phrases buffer. + +To index phrases use one of: + +\\[reftex-index-this-phrase] index current phrase +\\[reftex-index-next-phrase] index next phrase (or N with prefix arg) +\\[reftex-index-all-phrases] index all phrases +\\[reftex-index-remaining-phrases] index current and following phrases +\\[reftex-index-region-phrases] index the phrases in the region + +You can sort the phrases in this buffer with \\[reftex-index-sort-phrases]. +To display information about the phrase at point, use \\[reftex-index-phrases-info]. + +For more information see the RefTeX User Manual. + +Here are all local bindings. + +\\{reftex-index-phrases-mode-map} + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "reftex-parse" "reftex-parse.el" "73f6bbd6c6d423835a7a0428204eb3f5") +;;; Generated autoloads from reftex-parse.el + +(autoload 'reftex-parse-one "reftex-parse" "\ +Re-parse this file. + +\(fn)" t nil) + +(autoload 'reftex-parse-all "reftex-parse" "\ +Re-parse entire document. + +\(fn)" t nil) + +(autoload 'reftex-do-parse "reftex-parse" "\ +Do a document rescan. +When allowed, do only a partial scan from FILE. + +\(fn RESCAN &optional FILE)" nil nil) + +(autoload 'reftex-everything-regexp "reftex-parse" "\ + + +\(fn)" nil nil) + +(autoload 'reftex-all-document-files "reftex-parse" "\ +Return a list of all files belonging to the current document. +When RELATIVE is non-nil, give file names relative to directory +of master file. + +\(fn &optional RELATIVE)" nil nil) + +(autoload 'reftex-locate-bibliography-files "reftex-parse" "\ +Scan buffer for bibliography macros and return file list. + +\(fn MASTER-DIR &optional FILES)" nil nil) + +(autoload 'reftex-section-info "reftex-parse" "\ +Return a section entry for the current match. +Careful: This function expects the match-data to be still in place! + +\(fn FILE)" nil nil) + +(autoload 'reftex-ensure-index-support "reftex-parse" "\ +When index support is turned off, ask to turn it on and +set the current prefix argument so that `reftex-access-scan-info' +will rescan the entire document. + +\(fn &optional ABORT)" nil nil) + +(autoload 'reftex-index-info-safe "reftex-parse" "\ + + +\(fn FILE)" nil nil) + +(autoload 'reftex-index-info "reftex-parse" "\ +Return an index entry for the current match. +Careful: This function expects the match-data to be still in place! + +\(fn FILE)" nil nil) + +(autoload 'reftex-short-context "reftex-parse" "\ +Get about one line of useful context for the label definition at point. + +\(fn ENV PARSE &optional BOUND DERIVE)" nil nil) + +(autoload 'reftex-where-am-I "reftex-parse" "\ +Return the docstruct entry above point. +Actually returns a cons cell in which the cdr is a flag indicating +if the information is exact (t) or approximate (nil). + +\(fn)" nil nil) + +(autoload 'reftex-notice-new "reftex-parse" "\ +Hook to handshake with RefTeX after something new has been inserted. + +\(fn &optional N FORCE)" nil nil) + +(autoload 'reftex-what-macro-safe "reftex-parse" "\ +Call `reftex-what-macro' with special syntax table. + +\(fn WHICH &optional BOUND)" nil nil) + +(autoload 'reftex-what-macro "reftex-parse" "\ +Find out if point is within the arguments of any TeX-macro. +The return value is either (\"\\macro\" . (point)) or a list of them. + +If WHICH is nil, immediately return nil. +If WHICH is 1, return innermost enclosing macro. +If WHICH is t, return list of all macros enclosing point. +If WHICH is a list of macros, look only for those macros and return the + name of the first macro in this list found to enclose point. +If the optional BOUND is an integer, bound backwards directed + searches to this point. If it is nil, limit to nearest \\section - + like statement. + +This function is pretty stable, but can be fooled if the text contains +things like \\macro{aa}{bb} where \\macro is defined to take only one +argument. As RefTeX cannot know this, the string \"bb\" would still be +considered an argument of macro \\macro. + +\(fn WHICH &optional BOUND)" nil nil) + +(autoload 'reftex-what-environment "reftex-parse" "\ +Find out if point is inside a LaTeX environment. +The return value is (e.g.) either (\"equation\" . (point)) or a list of +them. + +If WHICH is nil, immediately return nil. +If WHICH is 1, return innermost enclosing environment. +If WHICH is t, return list of all environments enclosing point. +If WHICH is a list of environments, look only for those environments and + return the name of the first environment in this list found to enclose + point. + +If the optional BOUND is an integer, bound backwards directed searches to +this point. If it is nil, limit to nearest \\section - like statement. + +\(fn WHICH &optional BOUND)" nil nil) + +(autoload 'reftex-what-special-env "reftex-parse" "\ +Run the special environment parsers and return the matches. + +The return value is (e.g.) either (\"my-parser-function\" . (point)) +or a list of them. + +If WHICH is nil, immediately return nil. +If WHICH is 1, return innermost enclosing environment. +If WHICH is t, return list of all environments enclosing point. +If WHICH is a list of environments, look only for those environments and + return the name of the first environment in this list found to enclose + point. + +\(fn WHICH &optional BOUND)" nil nil) + +(autoload 'reftex-nth-arg "reftex-parse" "\ +Return the Nth following {} or [] parentheses content. +OPT-ARGS is a list of argument numbers which are optional. + +\(fn N &optional OPT-ARGS)" nil nil) + +(autoload 'reftex-move-over-touching-args "reftex-parse" "\ + + +\(fn)" nil nil) + +(autoload 'reftex-init-section-numbers "reftex-parse" "\ +Initialize the section numbers with zeros or with what is found in the TOC-ENTRY. + +\(fn &optional TOC-ENTRY APPENDIX)" nil nil) + +(autoload 'reftex-section-number "reftex-parse" "\ +Return a string with the current section number. +When LEVEL is non-nil, increase section numbers on that level. + +\(fn &optional LEVEL STAR)" nil nil) + +;;;*** + +;;;### (autoloads nil "reftex-ref" "reftex-ref.el" "3ad5bfbb747c7f8c5cd5b30e3b6fc342") +;;; Generated autoloads from reftex-ref.el + +(autoload 'reftex-label-location "reftex-ref" "\ +Return the environment or macro which determines the label type at point. +If optional BOUND is an integer, limit backward searches to that point. + +\(fn &optional BOUND)" nil nil) + +(autoload 'reftex-label-info-update "reftex-ref" "\ + + +\(fn CELL)" nil nil) + +(autoload 'reftex-label-info "reftex-ref" "\ + + +\(fn LABEL &optional FILE BOUND DERIVE ENV-OR-MAC)" nil nil) + +(autoload 'reftex-label "reftex-ref" "\ +Insert a unique label. Return the label. +If ENVIRONMENT is given, don't bother to find out yourself. +If NO-INSERT is non-nil, do not insert label into buffer. +With prefix arg, force to rescan document first. +When you are prompted to enter or confirm a label, and you reply with +just the prefix or an empty string, no label at all will be inserted. +A new label is also recorded into the label list. +This function is controlled by the settings of reftex-insert-label-flags. + +\(fn &optional ENVIRONMENT NO-INSERT)" t nil) + +(autoload 'reftex-reference "reftex-ref" "\ +Make a LaTeX reference. Look only for labels of a certain TYPE. +With prefix arg, force to rescan buffer for labels. This should only be +necessary if you have recently entered labels yourself without using +reftex-label. Rescanning of the buffer can also be requested from the +label selection menu. +The function returns the selected label or nil. +If NO-INSERT is non-nil, do not insert \\ref command, just return label. +When called with 2 C-u prefix args, disable magic word recognition. + +\(fn &optional TYPE NO-INSERT CUT)" t nil) + +(autoload 'reftex-query-label-type "reftex-ref" "\ + + +\(fn)" nil nil) + +(autoload 'reftex-show-label-location "reftex-ref" "\ + + +\(fn DATA FORWARD NO-REVISIT &optional STAY ERROR)" nil nil) + +(autoload 'reftex-goto-label "reftex-ref" "\ +Prompt for a label (with completion) and jump to the location of this label. +Optional prefix argument OTHER-WINDOW goes to the label in another window. + +\(fn &optional OTHER-WINDOW)" t nil) + +;;;*** + +;;;### (autoloads nil "reftex-sel" "reftex-sel.el" "086c2dd94aedc95620c5e972ad4c741a") +;;; Generated autoloads from reftex-sel.el + +(autoload 'reftex-select-label-mode "reftex-sel" "\ +Major mode for selecting a label in a LaTeX document. +This buffer was created with RefTeX. +It only has a meaningful keymap when you are in the middle of a +selection process. +To select a label, move the cursor to it and press RET. +Press `?' for a summary of important key bindings. + +During a selection process, these are the local bindings. + +\\{reftex-select-label-mode-map} + +\(fn)" t nil) + +(autoload 'reftex-select-bib-mode "reftex-sel" "\ +Major mode for selecting a citation key in a LaTeX document. +This buffer was created with RefTeX. +It only has a meaningful keymap when you are in the middle of a +selection process. +In order to select a citation, move the cursor to it and press RET. +Press `?' for a summary of important key bindings. + +During a selection process, these are the local bindings. + +\\{reftex-select-label-mode-map} + +\(fn)" t nil) + +(autoload 'reftex-get-offset "reftex-sel" "\ + + +\(fn BUF HERE-AM-I &optional TYPEKEY TOC INDEX FILE)" nil nil) + +(autoload 'reftex-insert-docstruct "reftex-sel" "\ + + +\(fn BUF TOC LABELS INDEX-ENTRIES FILES CONTEXT COUNTER SHOW-COMMENTED HERE-I-AM XR-PREFIX TOC-BUFFER)" nil nil) + +(autoload 'reftex-find-start-point "reftex-sel" "\ + + +\(fn FALLBACK &rest LOCATIONS)" nil nil) + +(autoload 'reftex-select-item "reftex-sel" "\ + + +\(fn REFTEX-SELECT-PROMPT HELP-STRING KEYMAP &optional OFFSET CALL-BACK CB-FLAG)" nil nil) + +;;;*** + +;;;### (autoloads nil "reftex-toc" "reftex-toc.el" "0364fac43b02eee087ee4cbe37f7f76c") +;;; Generated autoloads from reftex-toc.el + +(autoload 'reftex-toc "reftex-toc" "\ +Show the table of contents for the current document. +When called with a raw C-u prefix, rescan the document first. + +\(fn &optional REBUILD REUSE)" t nil) + +(autoload 'reftex-toc-recenter "reftex-toc" "\ +Display the TOC window and highlight line corresponding to current position. + +\(fn &optional ARG)" t nil) + +(autoload 'reftex-toggle-auto-toc-recenter "reftex-toc" "\ +Toggle the automatic recentering of the TOC window. +When active, leaving point idle will make the TOC window jump to the correct +section. + +\(fn)" t nil) + +;;;*** + +;;; End of automatically extracted autoloads. + (provide 'reftex) ;;; reftex.el ends here diff --git a/lisp/textmodes/tildify.el b/lisp/textmodes/tildify.el index 9732e7fa649..50fee2f4b84 100644 --- a/lisp/textmodes/tildify.el +++ b/lisp/textmodes/tildify.el @@ -3,7 +3,8 @@ ;; Copyright (C) 1997-2014 Free Software Foundation, Inc. ;; Author: Milan Zamazal <pdm@zamazal.org> -;; Version: 4.5 +;; Michal Nazarewicz <mina86@mina86.com> +;; Version: 4.5.3 ;; Keywords: text, TeX, SGML, wp ;; This file is part of GNU Emacs. @@ -77,15 +78,22 @@ by the hard space character. The form (MAJOR-MODE . SYMBOL) defines alias item for MAJOR-MODE. For this mode, the item for the mode SYMBOL is looked up in the alist instead." :group 'tildify - :type '(repeat (choice (list symbol regexp integer) (cons symbol symbol)))) + :type '(repeat (cons :tag "Entry for major mode" + (choice (const :tag "Default" t) + (symbol :tag "Major mode")) + (choice (list :tag "Regexp" + regexp + (integer :tag "Group ")) + (symbol :tag "Like other"))))) (defcustom tildify-string-alist '((latex-mode . "~") (tex-mode . latex-mode) (plain-tex-mode . latex-mode) (sgml-mode . " ") - (xml-mode . sgml-mode) (html-mode . sgml-mode) + (xml-mode . " ") ; XML does not define use numeric reference + (nxml-mode . xml-mode) (t . " ")) "Alist specifying what is a hard space in the current major mode. @@ -104,41 +112,43 @@ for SGML. The form (MAJOR-MODE . SYMBOL) defines alias item for MAJOR-MODE. For this mode, the item for the mode SYMBOL is looked up in the alist instead." :group 'tildify - :type '(repeat (cons symbol (choice string symbol)))) + :type '(repeat (cons :tag "Entry for major mode" + (choice (const :tag "Default" t) + (symbol :tag "Major mode")) + (choice (const :tag "No-break space (U+00A0)" "\u00A0") + (string :tag "String ") + (symbol :tag "Like other"))))) (defcustom tildify-ignored-environments-alist - '((latex-mode + `((latex-mode ("\\\\\\\\" . "") ; do not remove this - ("\\\\begin{verbatim}" . "\\\\end{verbatim}") + (,(eval-when-compile (concat + "\\\\begin{\\(" + (regexp-opt '("verbatim" "math" "displaymath" + "equation" "eqnarray" "eqnarray*")) + "\\)}")) + . ("\\\\end{" 1 "}")) ("\\\\verb\\*?\\(.\\)" . (1)) - ("\\$\\$" . "\\$\\$") - ("\\$" . "\\$") + ("\\$\\$?" . (0)) ("\\\\(" . "\\\\)") ("\\\\[[]" . "\\\\[]]") - ("\\\\begin{math}" . "\\\\end{math}") - ("\\\\begin{displaymath}" . "\\\\end{displaymath}") - ("\\\\begin{equation}" . "\\\\end{equation}") - ("\\\\begin{eqnarray\\*?}" . "\\\\end{eqnarray\\*?}") ("\\\\[a-zA-Z]+\\( +\\|{}\\)[a-zA-Z]*" . "") ("%" . "$")) (plain-tex-mode . latex-mode) (html-mode - ("<pre[^>]*>" . "</pre>") - ("<dfn>" . "</dfn>") - ("<code>" . "</code>") - ("<samp>" . "</samp>") - ("<kbd>" . "</kbd>") - ("<var>" . "</var>") - ("<PRE[^>]*>" . "</PRE>") - ("<DFN>" . "</DFN>") - ("<CODE>" . "</CODE>") - ("<SAMP>" . "</SAMP>") - ("<KBD>" . "</KBD>") - ("<VAR>" . "</VAR>") + (,(eval-when-compile (concat + "<\\(" + (regexp-opt '("pre" "dfn" "code" "samp" "kbd" "var" + "PRE" "DFN" "CODE" "SAMP" "KBD" "VAR")) + "\\)\\>[^>]*>")) + . ("</" 1 ">")) ("<! *--" . "-- *>") ("<" . ">")) (sgml-mode . html-mode) - (t nil)) + (xml-mode + ("<! *--" . "-- *>") + ("<" . ">")) + (nxml-mode . xml-mode)) "Alist specifying ignored structured text environments. Parts of text defined in this alist are skipped without performing hard space insertion on them. These setting allow skipping text parts like verbatim or @@ -160,133 +170,123 @@ END-REGEX defines end of the corresponding text part and can be either: subexpressions of BEG-REGEX (this is used to solve cases like \\\\verb<character> in TeX)." :group 'tildify - :type '(repeat (cons symbol (choice symbol (repeat sexp))))) - - -;;; *** Internal variables *** - -(defvar tildify-count nil - "Counter for replacements.") + :type '(repeat + (cons :tag "Entry for major mode" + (choice (const :tag "Default" t) + (symbol :tag "Major mode")) + (choice + (const :tag "None") + (repeat + :tag "Environments" + (cons :tag "Regexp pair" + (regexp :tag "Open ") + (choice :tag "Close" + (regexp :tag "Regexp") + (list :tag "Regexp and groups (concatenated)" + (choice (regexp :tag "Regexp") + (integer :tag "Group ")))))) + (symbol :tag "Like other"))))) ;;; *** Interactive functions *** ;;;###autoload -(defun tildify-region (beg end) +(defun tildify-region (beg end &optional dont-ask) "Add hard spaces in the region between BEG and END. See variables `tildify-pattern-alist', `tildify-string-alist', and `tildify-ignored-environments-alist' for information about configuration parameters. -This function performs no refilling of the changed text." - (interactive "*r") - (setq tildify-count 0) - (let (a - z - (marker-end (copy-marker end)) - end-env - finish - (ask t) - (case-fold-search nil) - (regexp (tildify-build-regexp)) ; beginnings of environments - aux) - (if regexp - ;; Yes, ignored environments exist for the current major mode, - ;; tildify just texts outside them - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (not finish) - (setq a (point)) - (setq end-env (tildify-find-env regexp)) - (setq z (copy-marker (if end-env (1- (point)) (point-max)))) - (if (>= (marker-position z) beg) - (progn - (or (>= a beg) (setq a beg)) - (or (<= (marker-position z) (marker-position marker-end)) - (setq z marker-end)) - (setq aux (tildify-tildify a (marker-position z) ask)) - (if (eq aux 'force) - (setq ask nil) - (if (eq aux nil) - (setq finish t))))) - (if (>= (marker-position z) (marker-position marker-end)) - (setq finish t)) - (or (>= (point) (marker-position z)) - (goto-char (marker-position z))) - (if (not finish) - (if (re-search-forward end-env nil t) - (if (> (point) (marker-position marker-end)) - (setq finish t)) - (message - "End of environment not found: %s" end-env) - (setq finish t)))))) - ;; No ignored environments, tildify directly - (tildify-tildify beg end ask))) - (message "%d spaces replaced." tildify-count)) +This function performs no refilling of the changed text. +If DONT-ASK is set, or called interactively with prefix argument, user +won't be prompted for confirmation of each substitution." + (interactive "*rP") + (let (case-fold-search (count 0) (ask (not dont-ask))) + (tildify-foreach-region-outside-env beg end + (lambda (beg end) + (let ((aux (tildify-tildify beg end ask))) + (setq count (+ count (car aux))) + (if (not (eq (cdr aux) 'force)) + (cdr aux) + (setq ask nil) + t)))) + (message "%d spaces replaced." count))) ;;;###autoload -(defun tildify-buffer () +(defun tildify-buffer (&optional dont-ask) "Add hard spaces in the current buffer. See variables `tildify-pattern-alist', `tildify-string-alist', and `tildify-ignored-environments-alist' for information about configuration parameters. -This function performs no refilling of the changed text." - (interactive "*") - (tildify-region (point-min) (point-max))) +This function performs no refilling of the changed text. +If DONT-ASK is set, or called interactively with prefix argument, user +won't be prompted for confirmation of each substitution." + (interactive "*P") + (tildify-region (point-min) (point-max) dont-ask)) ;;; *** Auxiliary functions *** -(defun tildify-build-regexp () - "Build start of environment regexp." - (let ((alist (tildify-mode-alist tildify-ignored-environments-alist)) - regexp) - (when alist - (setq regexp (caar alist)) - (setq alist (cdr alist)) - (while alist - (setq regexp (concat regexp "\\|" (caar alist))) - (setq alist (cdr alist))) - regexp))) - (defun tildify-mode-alist (mode-alist &optional mode) "Return alist item for the MODE-ALIST in the current major MODE." - (if (null mode) - (setq mode major-mode)) - (let ((alist (cdr (or (assoc mode mode-alist) + (let ((alist (cdr (or (assoc (or mode major-mode) mode-alist) (assoc t mode-alist))))) (if (and alist (symbolp alist)) (tildify-mode-alist mode-alist alist) alist))) -(defun tildify-find-env (regexp) +(defun tildify-foreach-region-outside-env (beg end callback) + "Scan region from BEG to END calling CALLBACK on portions out of environments. +Call CALLBACK on each region outside of environment to ignore. +CALLBACK will only be called for regions which have intersection +with [BEG END]. It must be a function that takes two point +arguments specifying the region to operate on. Stop scanning the +region as soon as CALLBACK returns nil. Environments to ignore +are determined from `tildify-ignored-environments-alist'." + (declare (indent 2)) + (let ((pairs (tildify-mode-alist tildify-ignored-environments-alist))) + (if (not pairs) + (funcall callback beg end) + (let ((func (lambda (b e) + (let ((b (max b beg)) (e (min e end))) + (if (< b e) (funcall callback b e) t)))) + (beg-re (concat "\\(?:" + (mapconcat 'car pairs "\\)\\|\\(?:") + "\\)")) + p end-re) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (and (< (setq p (point)) end) + (if (not (setq end-re + (tildify-find-env beg-re pairs))) + (progn (funcall func p end) nil) + (funcall func p (match-beginning 0)) + (when (< (point) end) + (setq p (point)) + (re-search-forward end-re nil t))))))))))) + +(defun tildify-find-env (regexp pairs) "Find environment using REGEXP. -Return regexp for the end of the environment or nil if no environment was -found." +Return regexp for the end of the environment found in PAIRS or nil if +no environment was found." ;; Find environment - (if (re-search-forward regexp nil t) - ;; Build end-env regexp - (let ((match (match-string 0)) - (alist (tildify-mode-alist tildify-ignored-environments-alist)) - expression) - (save-match-data - (while (not (eq (string-match (caar alist) match) 0)) - (setq alist (cdr alist)))) - (if (stringp (setq expression (cdar alist))) - expression - (let ((result "") - aux) - (while expression - (setq result (concat result - (if (stringp (setq aux (car expression))) - expression - (regexp-quote (match-string aux))))) - (setq expression (cdr expression))) - result))) - ;; Return nil if not found - nil)) + (when (re-search-forward regexp nil t) + (save-match-data + (let ((match (match-string 0))) + (while (not (eq (string-match (caar pairs) match) 0)) + (setq pairs (cdr pairs))) + (let ((expression (cdar pairs))) + (if (stringp expression) + expression + (mapconcat + (lambda (expr) + (if (stringp expr) + expr + (regexp-quote (match-string expr match)))) + expression + ""))))))) (defun tildify-tildify (beg end ask) "Add tilde characters in the region between BEG and END. @@ -295,8 +295,9 @@ macros. If ASK is nil, perform replace without asking user for confirmation. -Returns one of symbols: t (all right), nil (quit), force (replace without -further questions)." +Returns (count . response) cons where count is number of string +replacements done and response is one of symbols: t (all right), nil +(quit), force (replace without further questions)." (save-excursion (goto-char beg) (let* ((alist (tildify-mode-alist tildify-pattern-alist)) @@ -308,7 +309,8 @@ further questions)." bad-answer replace quit - (message-log-max nil)) + (message-log-max nil) + (count 0)) (while (and (not quit) (re-search-forward regexp (marker-position end-marker) t)) (when (or (not ask) @@ -335,12 +337,11 @@ further questions)." (setq bad-answer t))) replace)) (replace-match tilde t t nil match-number) - (setq tildify-count (1+ tildify-count)))) + (setq count (1+ count)))) ;; Return value - (cond - (quit nil) - ((not ask) 'force) - (t t))))) + (cons count (cond (quit nil) + ((not ask) 'force) + (t t)))))) ;;; *** Announce *** diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index 408f659681f..b445ff6d1f1 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,12 +1,31 @@ -2014-05-09 Michael Albinus <michael.albinus@gmx.de> +2014-05-14 Glenn Morris <rgm@gnu.org> + + * url-util.el (url-make-private-file): Use with-file-modes. + +2014-05-12 Michael Albinus <michael.albinus@gmx.de> * url-handlers.el (url-file-handler-load-in-progress): New defvar. (url-file-handler): Use it, in order to avoid recursive load. -2014-05-01 Glenn Morris <rgm@gnu.org> +2014-05-04 Glenn Morris <rgm@gnu.org> * url-parse.el (url-generic-parse-url): Doc fix (replace `iff'). +2014-04-01 Michael Albinus <michael.albinus@gmx.de> + + * url-tramp.el: New file. + + * url-handlers.el (url-handler-regexp): Add ssh, scp, rsync and telnet. + Add :version. + (url-file-handler): Call `url-tramp-file-handler' if appropriate. + +2014-03-28 Glenn Morris <rgm@gnu.org> + + * url-vars.el (url-bug-address): Make into an obsolete alias. + * url-http.el (url-http-handle-authentication): + * url-news.el (url-news-fetch-message-id): + Use M-x report-emacs-bug in help messages. + 2014-03-26 Juanma Barranquero <lekktu@gmail.com> * url-handlers.el (url-http-parse-response): Add autoload. diff --git a/lisp/url/url-dav.el b/lisp/url/url-dav.el index fcb6e70f4d7..6adb2d978af 100644 --- a/lisp/url/url-dav.el +++ b/lisp/url/url-dav.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2001, 2004-2014 Free Software Foundation, Inc. ;; Author: Bill Perry <wmperry@gnu.org> -;; Maintainer: Bill Perry <wmperry@gnu.org> +;; Maintainer: emacs-devel@gnu.org ;; Keywords: url, vc ;; This file is part of GNU Emacs. diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el index 2a9c6ead029..b1cc8a29e3b 100644 --- a/lisp/url/url-gw.el +++ b/lisp/url/url-gw.el @@ -3,6 +3,7 @@ ;; Copyright (C) 1997-1998, 2004-2014 Free Software Foundation, Inc. ;; Author: Bill Perry <wmperry@gnu.org> +;; Maintainer: emacs-devel@gnu.org ;; Keywords: comm, data, processes ;; This file is part of GNU Emacs. diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index b0f01123bbb..c86acb680d0 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -112,7 +112,7 @@ the mode if ARG is omitted or nil." (push (cons url-handler-regexp 'url-file-handler) file-name-handler-alist))) -(defcustom url-handler-regexp "\\`\\(https?\\|ftp\\|file\\|nfs\\)://" +(defcustom url-handler-regexp "\\`\\(https?\\|ftp\\|file\\|nfs\\|ssh\\|scp\\|rsync\\|telnet\\)://" "Regular expression for URLs handled by `url-handler-mode'. When URL Handler mode is enabled, this regular expression is added to `file-name-handler-alist'. @@ -123,6 +123,7 @@ regular expression avoids conflicts with local files that look like URLs \(Gnus is particularly bad at this\)." :group 'url :type 'regexp + :version "24.5" :set (lambda (symbol value) (let ((enable url-handler-mode)) (url-handler-mode 0) @@ -148,21 +149,30 @@ the arguments that would have been passed to OPERATION." ;; Avoid recursive load. (if (and load-in-progress url-file-handler-load-in-progress) (url-run-real-handler operation args) - (let ((url-file-handler-load-in-progress load-in-progress) - (fn (get operation 'url-file-handlers)) - (val nil) - (hooked nil)) - (if (and (not fn) (intern-soft (format "url-%s" operation)) - (fboundp (intern-soft (format "url-%s" operation)))) - (error "Missing URL handler mapping for %s" operation)) - (if fn - (setq hooked t - val (save-match-data (apply fn args))) - (setq hooked nil - val (url-run-real-handler operation args))) - (url-debug 'handlers "%s %S%S => %S" (if hooked "Hooked" "Real") - operation args val) - val))) + (let ((url-file-handler-load-in-progress load-in-progress)) + ;; Check, whether there are arguments we want pass to Tramp. + (if (catch :do + (dolist (url (cons default-directory args)) + (and (member + (url-type (url-generic-parse-url (and (stringp url) url))) + url-tramp-protocols) + (throw :do t)))) + (apply 'url-tramp-file-handler operation args) + ;; Otherwise, let's do the job. + (let ((fn (get operation 'url-file-handlers)) + (val nil) + (hooked nil)) + (if (and (not fn) (intern-soft (format "url-%s" operation)) + (fboundp (intern-soft (format "url-%s" operation)))) + (error "Missing URL handler mapping for %s" operation)) + (if fn + (setq hooked t + val (save-match-data (apply fn args))) + (setq hooked nil + val (url-run-real-handler operation args))) + (url-debug 'handlers "%s %S%S => %S" (if hooked "Hooked" "Real") + operation args val) + val))))) (defun url-file-handler-identity (&rest args) ;; Identity function diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index ac2e1403d03..23e7d4b6074 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -3,6 +3,7 @@ ;; Copyright (C) 1999, 2001, 2004-2014 Free Software Foundation, Inc. ;; Author: Bill Perry <wmperry@gnu.org> +;; Maintainer: emacs-devel@gnu.org ;; Keywords: comm, data, processes ;; This file is part of GNU Emacs. @@ -414,7 +415,7 @@ Return the number of characters removed." (goto-char (point-max)) (insert "<hr>Sorry, but I do not know how to handle " type " authentication. If you'd like to write it," - " send it to " url-bug-address ".<hr>") + " please use M-x report-emacs-bug RET.<hr>") ;; We used to set a `status' var (declared "special") but I can't ;; find the corresponding let-binding, so it's probably an error. ;; FIXME: Maybe it was supposed to set `success', i.e. to return t? diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el index 105fb677374..0ce6d2e6cd1 100644 --- a/lisp/url/url-news.el +++ b/lisp/url/url-news.el @@ -70,8 +70,7 @@ " </xmp>\n" " </p>\n" " <p>\n" - " If you If you feel this is an error, <a href=\"" - "mailto:" url-bug-address "\">send mail</a>\n" + " If you feel this is an error, M-x report-emacs-bug RET.\n" " </p>\n" " </div>\n" " </body>\n" diff --git a/lisp/url/url-tramp.el b/lisp/url/url-tramp.el new file mode 100644 index 00000000000..83cedd1d62c --- /dev/null +++ b/lisp/url/url-tramp.el @@ -0,0 +1,79 @@ +;;; url-tramp.el --- file-name-handler magic invoking Tramp for some protocols + +;; Copyright (C) 2014 Free Software Foundation, Inc. + +;; Author: Michael Albinus <michael.albinus@gmx.de> +;; Keywords: comm, data, processes, hypermedia + +;; 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 'url-parse) +(require 'tramp) +(require 'password-cache) + +;;;###autoload +(defcustom url-tramp-protocols '("ftp" "ssh" "scp" "rsync" "telnet") + "List of URL protocols the work is handled by Tramp. +They must also be covered by `url-handler-regexp'." + :group 'url + :version "24.5" + :type '(list string)) + +(defun url-tramp-convert-url-to-tramp (url) + "Convert URL to a Tramp file name." + (let ((obj (url-generic-parse-url (and (stringp url) url)))) + (if (member (url-type obj) url-tramp-protocols) + (progn + (if (url-password obj) + (password-cache-add + (tramp-make-tramp-file-name + (url-type obj) (url-user obj) (url-host obj) "") + (url-password obj)) + (tramp-make-tramp-file-name + (url-type obj) (url-user obj) (url-host obj) (url-filename obj)))) + url))) + +(defun url-tramp-convert-tramp-to-url (file) + "Convert FILE, a Tramp file name, to a URL." + (let ((obj (ignore-errors (tramp-dissect-file-name file)))) + (if (member (tramp-file-name-method obj) url-tramp-protocols) + (url-recreate-url + (url-parse-make-urlobj + (tramp-file-name-method obj) + (tramp-file-name-user obj) + nil ; password. + (tramp-file-name-host obj) + nil ; port. + (tramp-file-name-localname obj) + nil nil t)) ; target attributes fullness. + file))) + +;;;###autoload +(defun url-tramp-file-handler (operation &rest args) + "Function called from the `file-name-handler-alist' routines. +OPERATION is what needs to be done. ARGS are the arguments that +would have been passed to OPERATION." + (let ((default-directory (url-tramp-convert-url-to-tramp default-directory)) + (args (mapcar 'url-tramp-convert-url-to-tramp args))) + (url-tramp-convert-tramp-to-url (apply operation args)))) + +(provide 'url-tramp) + +;;; url-tramp.el ends here diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el index a7d7e3e0fed..b796e769c60 100644 --- a/lisp/url/url-util.el +++ b/lisp/url/url-util.el @@ -1,9 +1,9 @@ ;;; url-util.el --- Miscellaneous helper routines for URL library -;; Copyright (C) 1996-1999, 2001, 2004-2014 Free Software Foundation, -;; Inc. +;; Copyright (C) 1996-1999, 2001, 2004-2014 Free Software Foundation, Inc. ;; Author: Bill Perry <wmperry@gnu.org> +;; Maintainer: emacs-devel@gnu.org ;; Keywords: comm, data, processes ;; This file is part of GNU Emacs. @@ -628,14 +628,9 @@ Creates FILE and its parent directories if they do not exist." (make-directory dir t))) ;; Based on doc-view-make-safe-dir. (condition-case nil - (let ((umask (default-file-modes))) - (unwind-protect - (progn - (set-default-file-modes #o0600) - (with-temp-buffer - (write-region (point-min) (point-max) - file nil 'silent nil 'excl))) - (set-default-file-modes umask))) + (with-file-modes #o0600 + (with-temp-buffer + (write-region (point-min) (point-max) file nil 'silent nil 'excl))) (file-already-exists (if (file-symlink-p file) (error "Danger: `%s' is a symbolic link" file)) diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el index 4cdb59deb27..62b7b855533 100644 --- a/lisp/url/url-vars.el +++ b/lisp/url/url-vars.el @@ -1,7 +1,6 @@ ;;; url-vars.el --- Variables for Uniform Resource Locator tool -;; Copyright (C) 1996-1999, 2001, 2004-2014 Free Software Foundation, -;; Inc. +;; Copyright (C) 1996-1999, 2001, 2004-2014 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia @@ -82,8 +81,8 @@ If non-nil and not t, the user will be asked for each refresh request." :type 'boolean :group 'url-cache) -(defconst url-bug-address "bug-gnu-emacs@gnu.org" - "Where to send bug reports.") +(define-obsolete-variable-alias 'url-bug-address + 'report-emacs-bug-address "24.5") (defcustom url-personal-mail-address nil "Your full email address. diff --git a/lisp/url/url.el b/lisp/url/url.el index cbbcfd4f18b..620593a9a81 100644 --- a/lisp/url/url.el +++ b/lisp/url/url.el @@ -1,9 +1,9 @@ ;;; url.el --- Uniform Resource Locator retrieval tool -*- lexical-binding: t -*- -;; Copyright (C) 1996-1999, 2001, 2004-2014 Free Software Foundation, -;; Inc. +;; Copyright (C) 1996-1999, 2001, 2004-2014 Free Software Foundation, Inc. ;; Author: Bill Perry <wmperry@gnu.org> +;; Maintainer: emacs-devel@gnu.org ;; Keywords: comm, data, processes, hypermedia ;; This file is part of GNU Emacs. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 923de9a0ca6..4908c5f4961 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -302,14 +302,9 @@ well." (defvar diff-added-face 'diff-added) (defface diff-changed - ;; We normally apply a `shadow'-based face on the `diff-context' - ;; face, and keep `diff-changed' the default. - '((((class color grayscale) (min-colors 88))) - ;; If the terminal lacks sufficient colors for shadowing, - ;; highlight changed lines explicitly. - (((class color)) - :foreground "yellow")) + '((t nil)) "`diff-mode' face used to highlight changed lines." + :version "24.5" :group 'diff-mode) (define-obsolete-face-alias 'diff-changed-face 'diff-changed "22.1") (defvar diff-changed-face 'diff-changed) @@ -343,8 +338,12 @@ well." (defvar diff-function-face 'diff-function) (defface diff-context - '((((class color grayscale) (min-colors 88)) :inherit shadow)) + '((((class color grayscale) (min-colors 88) (background light)) + :foreground "#333333") + (((class color grayscale) (min-colors 88) (background dark)) + :foreground "#dddddd")) "`diff-mode' face used to highlight context and other side-information." + :version "24.5" :group 'diff-mode) (define-obsolete-face-alias 'diff-context-face 'diff-context "22.1") (defvar diff-context-face 'diff-context) @@ -1916,7 +1915,7 @@ For use in `add-log-current-defun-function'." ;;; Fine change highlighting. -(defface diff-refine-change +(defface diff-refine-changed '((((class color) (min-colors 88) (background light)) :background "#ffff55") (((class color) (min-colors 88) (background dark)) @@ -1924,6 +1923,7 @@ For use in `add-log-current-defun-function'." (t :inverse-video t)) "Face used for char-based changes shown by `diff-refine-hunk'." :group 'diff-mode) +(define-obsolete-face-alias 'diff-refine-change 'diff-refine-changed "24.5") (defface diff-refine-removed '((default diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el index dd0d76485bf..af45acd3c37 100644 --- a/lisp/vc/ediff-init.el +++ b/lisp/vc/ediff-init.el @@ -949,7 +949,9 @@ this variable represents.") (defface ediff-current-diff-Ancestor (if (featurep 'emacs) - '((((class color) (min-colors 16)) + '((((class color) (min-colors 88)) + (:background "VioletRed")) + (((class color) (min-colors 16)) (:foreground "Black" :background "VioletRed")) (((class color)) (:foreground "black" :background "magenta3")) @@ -1057,7 +1059,9 @@ this variable represents.") (defface ediff-fine-diff-Ancestor (if (featurep 'emacs) - '((((class color) (min-colors 16)) + '((((class color) (min-colors 88)) + (:background "Green")) + (((class color) (min-colors 16)) (:foreground "Black" :background "Green")) (((class color)) (:foreground "red3" :background "green")) @@ -1091,6 +1095,8 @@ this variable represents.") (if (featurep 'emacs) `((((type pc)) (:foreground "green3" :background "light grey")) + (((class color) (min-colors 88)) + (:background "light grey")) (((class color) (min-colors 16)) (:foreground "Black" :background "light grey")) (((class color)) @@ -1115,7 +1121,9 @@ this variable represents.") (defface ediff-even-diff-B (if (featurep 'emacs) - `((((class color) (min-colors 16)) + `((((class color) (min-colors 88)) + (:background "Grey")) + (((class color) (min-colors 16)) (:foreground "White" :background "Grey")) (((class color)) (:foreground "blue3" :background "Grey" :weight bold)) @@ -1138,6 +1146,8 @@ this variable represents.") (if (featurep 'emacs) `((((type pc)) (:foreground "yellow3" :background "light grey")) + (((class color) (min-colors 88)) + (:background "light grey")) (((class color) (min-colors 16)) (:foreground "Black" :background "light grey")) (((class color)) @@ -1164,6 +1174,8 @@ this variable represents.") (if (featurep 'emacs) `((((type pc)) (:foreground "cyan3" :background "light grey")) + (((class color) (min-colors 88)) + (:background "Grey")) (((class color) (min-colors 16)) (:foreground "White" :background "Grey")) (((class color)) @@ -1197,6 +1209,8 @@ this variable represents.") (if (featurep 'emacs) '((((type pc)) (:foreground "green3" :background "gray40")) + (((class color) (min-colors 88)) + (:background "Grey")) (((class color) (min-colors 16)) (:foreground "White" :background "Grey")) (((class color)) @@ -1222,6 +1236,8 @@ this variable represents.") (if (featurep 'emacs) '((((type pc)) (:foreground "White" :background "gray40")) + (((class color) (min-colors 88)) + (:background "light grey")) (((class color) (min-colors 16)) (:foreground "Black" :background "light grey")) (((class color)) @@ -1246,6 +1262,8 @@ this variable represents.") (if (featurep 'emacs) '((((type pc)) (:foreground "yellow3" :background "gray40")) + (((class color) (min-colors 88)) + (:background "Grey")) (((class color) (min-colors 16)) (:foreground "White" :background "Grey")) (((class color)) @@ -1268,7 +1286,9 @@ this variable represents.") (defface ediff-odd-diff-Ancestor (if (featurep 'emacs) - '((((class color) (min-colors 16)) + '((((class color) (min-colors 88)) + (:background "gray40")) + (((class color) (min-colors 16)) (:foreground "cyan3" :background "gray40")) (((class color)) (:foreground "green3" :background "black" :weight bold)) diff --git a/lisp/vc/emerge.el b/lisp/vc/emerge.el index d4638616dd7..b17d11d34a4 100644 --- a/lisp/vc/emerge.el +++ b/lisp/vc/emerge.el @@ -2883,17 +2883,11 @@ keymap. Leaves merge in fast mode." (setq vars (cdr vars)) (setq values (cdr values)))) -;; Make a temporary file that only we have access to. -;; PREFIX is appended to emerge-temp-file-prefix to make the filename prefix. +;; When the pointless option emerge-temp-file-prefix goes, +;; make this function obsolete too, and just use make-temp-file. (defun emerge-make-temp-file (prefix) - (let (f (old-modes (default-file-modes))) - (unwind-protect - (progn - ;; This has no effect, since make-temp-file sets umask = 700. - (set-default-file-modes emerge-temp-file-mode) - (setq f (make-temp-file (concat emerge-temp-file-prefix prefix)))) - (set-default-file-modes old-modes)) - f)) + "Make a private temporary file based on `emerge-temp-file-prefix'." + (make-temp-file (concat emerge-temp-file-prefix prefix))) ;;; Functions that query the user before he can write out the current buffer. diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index cc9c4673345..771281555ab 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -116,9 +116,10 @@ Used in `smerge-diff-base-mine' and related functions." (define-obsolete-face-alias 'smerge-markers-face 'smerge-markers "22.1") (defvar smerge-markers-face 'smerge-markers) -(defface smerge-refined-change +(defface smerge-refined-changed '((t nil)) "Face used for char-based changes shown by `smerge-refine'.") +(define-obsolete-face-alias 'smerge-refined-change 'smerge-refined-changed "24.5") (defface smerge-refined-removed '((default diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index b800c64c869..df61006ad51 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -82,8 +82,8 @@ ;; - annotate-current-time () NOT NEEDED ;; - annotate-extract-revision-at-line () OK ;; TAG SYSTEM -;; - create-tag (dir name branchp) NEEDED -;; - retrieve-tag (dir name update) NEEDED +;; - create-tag (dir name branchp) OK +;; - retrieve-tag (dir name update) OK FIXME UPDATE BUFFERS ;; MISCELLANEOUS ;; - make-version-backups-p (file) ?? ;; - repository-hostname (dirname) ?? @@ -146,12 +146,19 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." :group 'vc-hg) (defcustom vc-hg-root-log-format - '("{rev}:{tags}: {author|person} {date|shortdate} {desc|firstline}\\n" - "^\\([0-9]+\\):\\([^:]*\\): \\(.*?\\)[ \t]+\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)" + `(,(concat "{rev}:{ifeq(branch, 'default','', '{branch}')}" + ":{bookmarks}:{tags}:{author|person}" + " {date|shortdate} {desc|firstline}\\n") + ,(concat "^\\(?:[+@o x|-]*\\)" ;Graph data. + "\\([0-9]+\\):\\([^:]*\\)" + ":\\([^:]*\\):\\([^:]*\\):\\(.*?\\)" + "[ \t]+\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)") ((1 'log-view-message-face) - (2 'change-log-list) - (3 'change-log-name) - (4 'change-log-date))) + (2 'change-log-file) + (3 'change-log-list) + (4 'change-log-conditionals) + (5 'change-log-name) + (6 'change-log-date))) "Mercurial log template for `vc-hg-print-log' short format. This should be a list (TEMPLATE REGEXP KEYWORDS), where TEMPLATE is the \"--template\" argument string to pass to Mercurial, @@ -160,7 +167,7 @@ output, and KEYWORDS is a list of `font-lock-keywords' for highlighting the Log View buffer." :type '(list string string (repeat sexp)) :group 'vc-hg - :version "24.1") + :version "24.5") ;;; Properties of the backend @@ -244,6 +251,9 @@ highlighting the Log View buffer." (autoload 'vc-setup-buffer "vc-dispatcher") +(defvar vc-hg-log-graph nil + "If non-nil, use `--graph' in the short log output.") + (defun vc-hg-print-log (files buffer &optional shortlog start-revision limit) "Print commit log associated with FILES into specified BUFFER. If SHORTLOG is non-nil, use a short format based on `vc-hg-root-log-format'. @@ -261,7 +271,9 @@ If LIMIT is non-nil, show no more than this many entries." (nconc (when start-revision (list (format "-r%s:0" start-revision))) (when limit (list "-l" (format "%s" limit))) - (when shortlog (list "--template" (car vc-hg-root-log-format))) + (when shortlog `(,@(if vc-hg-log-graph '("--graph")) + "--template" + ,(car vc-hg-root-log-format))) vc-hg-log-switches))))) (defvar log-view-message-re) @@ -376,8 +388,26 @@ Optional arg REVISION is a revision to annotate from." (if (match-beginning 3) (match-string-no-properties 1) (cons (match-string-no-properties 1) - (expand-file-name (match-string-no-properties 4) - (vc-hg-root default-directory))))))) + (expand-file-name (match-string-no-properties 4) + (vc-hg-root default-directory))))))) + +;;; Tag system + +(defun vc-hg-create-tag (dir name branchp) + "Attach the tag NAME to the state of the working copy." + (let ((default-directory dir)) + (and (vc-hg-command nil 0 nil "status") + (vc-hg-command nil 0 nil (if branchp "bookmark" "tag") name)))) + +(defun vc-hg-retrieve-tag (dir name update) + "Retrieve the version tagged by NAME of all registered files at or below DIR." + (let ((default-directory dir)) + (vc-hg-command nil 0 nil "update" name) + ;; FIXME: update buffers if `update' is true + ;; TODO: update *vc-change-log* buffer so can see @ if --graph + )) + +;;; Miscellaneous (defun vc-hg-previous-revision (_file rev) (let ((newrev (1- (string-to-number rev)))) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 1cd297ae43a..ce7f2c8f4ed 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -190,6 +190,11 @@ individually should stay local." (make-variable-buffer-local 'vc-mode) (put 'vc-mode 'permanent-local t) +;;; We signal this error when we try to do something a VC backend +;;; doesn't support. Two arguments: the method that's not supported +;;; and the backend +(define-error 'vc-not-supported "VC method not implemented for backend") + (defun vc-mode (&optional _arg) ;; Dummy function for C-h m "Version Control minor mode. @@ -268,10 +273,10 @@ It is usually called via the `vc-call' macro." (setq f (vc-find-backend-function backend function-name)) (push (cons function-name f) (get backend 'vc-functions))) (cond - ((null f) - (error "Sorry, %s is not implemented for %s" function-name backend)) - ((consp f) (apply (car f) (cdr f) args)) - (t (apply f args))))) + ((null f) + (signal 'vc-not-supported (list function-name backend))) + ((consp f) (apply (car f) (cdr f) args)) + (t (apply f args))))) (defmacro vc-call (fun file &rest args) "A convenience macro for calling VC backend functions. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 4a536900eb3..5491d67e700 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1879,6 +1879,19 @@ saving the buffer." (called-interactively-p 'interactive)))))) ;;;###autoload +(defun vc-root-dir () + "Return the root directory for the current VC tree. +Return nil if the root directory cannot be identified." + (let ((backend (vc-deduce-backend))) + (if backend + (condition-case err + (vc-call-backend backend 'root default-directory) + (vc-not-supported + (unless (eq (cadr err) 'root) + (signal (car err) (cdr err))) + nil))))) + +;;;###autoload (defun vc-revision-other-window (rev) "Visit revision REV of the current file in another window. If the current file is named `F', the revision is named `F.~REV~'. @@ -2450,7 +2463,7 @@ depending on the underlying version-control system." (error "Please revert all modified workfiles before rollback"))) ;; Accumulate changes associated with the fileset (vc-setup-buffer "*vc-diff*") - (not-modified) + (set-buffer-modified-p nil) (message "Finding changes...") (let* ((tip (vc-working-revision (car files))) ;; FIXME: `previous-revision' should take the fileset. diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 83bd4e06074..917f0432ef2 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -1204,6 +1204,8 @@ SYMBOL is a valid symbol associated with CHAR. (defvar whitespace-point (point) "Used to save locally current point value. Used by function `whitespace-trailing-regexp' (which see).") +(defvar-local whitespace-point--used nil + "Region whose highlighting depends on `whitespace-point'.") (defvar whitespace-font-lock-refontify nil "Used to save locally the font-lock refontify state. @@ -1717,43 +1719,7 @@ It is a cons of strings, where the car part is used when (defun whitespace-report (&optional force report-if-bogus) "Report some whitespace problems in buffer. -Return nil if there is no whitespace problem; otherwise, return -non-nil. - -If FORCE is non-nil or \\[universal-argument] was pressed just -before calling `whitespace-report' interactively, it forces -`whitespace-style' to have: - - empty - trailing - indentation - space-before-tab - space-after-tab - -If REPORT-IF-BOGUS is non-nil, it reports only when there are any -whitespace problems in buffer. - -Report if some of the following whitespace problems exist: - -* If `indent-tabs-mode' is non-nil: - empty 1. empty lines at beginning of buffer. - empty 2. empty lines at end of buffer. - trailing 3. SPACEs or TABs at end of line. - indentation 4. 8 or more SPACEs at beginning of line. - space-before-tab 5. SPACEs before TAB. - space-after-tab 6. 8 or more SPACEs after TAB. - -* If `indent-tabs-mode' is nil: - empty 1. empty lines at beginning of buffer. - empty 2. empty lines at end of buffer. - trailing 3. SPACEs or TABs at end of line. - indentation 4. TABS at beginning of line. - space-before-tab 5. SPACEs before TAB. - space-after-tab 6. 8 or more SPACEs after TAB. - -See `whitespace-style' for documentation. -See also `whitespace-cleanup' and `whitespace-cleanup-region' for -cleaning up these problems." +Perform `whitespace-report-region' on the current buffer." (interactive (list current-prefix-arg)) (whitespace-report-region (point-min) (point-max) force report-if-bogus)) @@ -1771,13 +1737,14 @@ before calling `whitespace-report-region' interactively, it forces `whitespace-style' to have: empty + trailing indentation space-before-tab - trailing space-after-tab -If REPORT-IF-BOGUS is non-nil, it reports only when there are any -whitespace problems in buffer. +If REPORT-IF-BOGUS is t, it reports only when there are any +whitespace problems in buffer; if it is `never', it does not +report problems. Report if some of the following whitespace problems exist: @@ -1832,7 +1799,7 @@ cleaning up these problems." (and (re-search-forward regexp rend t) (setq has-bogus t)))) whitespace-report-list))) - (when (if report-if-bogus has-bogus t) + (when (pcase report-if-bogus (`nil t) (`never nil) (_ has-bogus)) (whitespace-kill-buffer whitespace-report-buffer-name) ;; `whitespace-indent-tabs-mode' is local to current buffer ;; `whitespace-tab-width' is local to current buffer @@ -2155,7 +2122,10 @@ resultant list will be returned." (when (whitespace-style-face-p) ;; save current point and refontify when necessary (set (make-local-variable 'whitespace-point) - (point)) + (point)) + (setq whitespace-point--used + (let ((ol (make-overlay (point) (point) nil nil t))) + (delete-overlay ol) ol)) (set (make-local-variable 'whitespace-font-lock-refontify) 0) (set (make-local-variable 'whitespace-bob-marker) @@ -2170,6 +2140,7 @@ resultant list will be returned." (setq whitespace-font-lock-keywords `( + (whitespace-point--flush-used) ,@(when (memq 'spaces whitespace-active-style) ;; Show SPACEs. `((,whitespace-space-regexp 1 whitespace-space t) @@ -2247,26 +2218,47 @@ resultant list will be returned." (whitespace-space-after-tab-regexp 'space))) 1 whitespace-space-after-tab t))))) (font-lock-add-keywords nil whitespace-font-lock-keywords t) - (when font-lock-mode - (font-lock-fontify-buffer)))) + (font-lock-flush))) (defun whitespace-color-off () "Turn off color visualization." ;; turn off font lock + (kill-local-variable 'whitespace-point--used) (when (whitespace-style-face-p) (remove-hook 'post-command-hook #'whitespace-post-command-hook t) (remove-hook 'before-change-functions #'whitespace-buffer-changed t) (font-lock-remove-keywords nil whitespace-font-lock-keywords) - (when font-lock-mode - (font-lock-fontify-buffer)))) - + (font-lock-flush))) + +(defun whitespace-point--used (start end) + (let ((ostart (overlay-start whitespace-point--used))) + (if ostart + (move-overlay whitespace-point--used + (min start ostart) + (max end (overlay-end whitespace-point--used))) + (move-overlay whitespace-point--used start end)))) + +(defun whitespace-point--flush-used (limit) + (let ((ostart (overlay-start whitespace-point--used))) + ;; Strip parts of whitespace-point--used we're about to refresh. + (when ostart + (let ((oend (overlay-end whitespace-point--used))) + (if (<= (point) ostart) + (if (<= oend limit) + (delete-overlay whitespace-point--used) + (move-overlay whitespace-point--used limit oend))) + (if (<= oend limit) + (move-overlay whitespace-point--used ostart (point)))))) + nil) (defun whitespace-trailing-regexp (limit) "Match trailing spaces which do not contain the point at end of line." (let ((status t)) (while (if (re-search-forward whitespace-trailing-regexp limit t) - (= whitespace-point (match-end 1)) ;; loop if point at eol + (when (= whitespace-point (match-end 1)) ; Loop if point at eol. + (whitespace-point--used (match-beginning 0) (match-end 0)) + t) (setq status nil))) ;; end of buffer status)) @@ -2279,8 +2271,11 @@ beginning of buffer." (cond ;; at bob ((= b 1) - (setq r (and (/= whitespace-point 1) - (looking-at whitespace-empty-at-bob-regexp))) + (setq r (and (looking-at whitespace-empty-at-bob-regexp) + (or (/= whitespace-point 1) + (progn (whitespace-point--used (match-beginning 0) + (match-end 0)) + nil)))) (set-marker whitespace-bob-marker (if r (match-end 1) b))) ;; inside bob empty region ((<= limit whitespace-bob-marker) @@ -2318,9 +2313,11 @@ buffer." (cond ;; at eob ((= limit e) - (when (/= whitespace-point e) - (goto-char limit) - (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b))) + (goto-char limit) + (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b)) + (when (and r (= whitespace-point e)) + (setq r nil) + (whitespace-point--used (match-beginning 0) (match-end 0))) (if r (set-marker whitespace-eob-marker (match-beginning 1)) (set-marker whitespace-eob-marker limit) @@ -2356,43 +2353,57 @@ buffer." (defun whitespace-post-command-hook () "Save current point into `whitespace-point' variable. Also refontify when necessary." - (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)))) + (unless (and (eq whitespace-point (point)) + (not whitespace-buffer-changed)) + (setq whitespace-point (point)) ; current point position + (let ((refontify + (cond + ;; It is at end of buffer (eob). + ((= whitespace-point (1+ (buffer-size))) + (when (whitespace-looking-back whitespace-empty-at-eob-regexp + nil) + (match-beginning 0))) + ;; It is at end of line ... + ((and (eolp) + ;; ... with trailing SPACE or TAB + (or (memq (preceding-char) '(?\s ?\t)))) + (line-beginning-position)) + ;; It is at beginning of buffer (bob). + ((and (= whitespace-point 1) + (looking-at whitespace-empty-at-bob-regexp)) + (match-end 0)))) + (ostart (overlay-start whitespace-point--used))) + (cond + ((not refontify) + ;; New point does not affect highlighting: just refresh the + ;; highlighting of old point, if needed. + (when ostart + (font-lock-flush ostart + (overlay-end whitespace-point--used)) + (delete-overlay whitespace-point--used))) + ((not ostart) + ;; Old point did not affect highlighting, but new one does: refresh the + ;; highlighting of new point. + (font-lock-flush (min refontify (point)) (max refontify (point)))) + ((save-excursion + (goto-char ostart) + (setq ostart (line-beginning-position)) + (and (<= ostart (max refontify (point))) + (progn + (goto-char (overlay-end whitespace-point--used)) + (let ((oend (line-beginning-position 2))) + (<= (min refontify (point)) oend))))) + ;; The old point highlighting and the new point highlighting + ;; cover a contiguous region: do a single refresh. + (font-lock-flush (min refontify (point) ostart) + (max refontify (point) + (overlay-end whitespace-point--used))) + (delete-overlay whitespace-point--used)) + (t + (font-lock-flush (min refontify (point)) + (max refontify (point))) + (font-lock-flush ostart (overlay-end whitespace-point--used)) + (delete-overlay whitespace-point--used)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/lisp/woman.el b/lisp/woman.el index 88510517b25..2dda211200d 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -414,18 +414,12 @@ (substring arg 0 (match-end 1)) arg)))) +(require 'cl-lib) + (eval-when-compile ; to avoid compiler warnings (require 'dired) - (require 'cl-lib) (require 'apropos)) -(defun woman-mapcan (fn x) - "Return concatenated list of FN applied to successive `car' elements of X. -FN must return a list, cons or nil. Useful for splicing into a list." - ;; Based on the Standard Lisp function MAPCAN but with args swapped! - ;; More concise implementation than the recursive one. -- dak - (apply #'nconc (mapcar fn x))) - (defun woman-parse-colon-path (paths) "Explode search path string PATHS into a list of directory names. Allow Cygwin colon-separated search paths on Microsoft platforms. @@ -440,7 +434,7 @@ As a special case, if PATHS is nil then replace it by calling (mapcar 'woman-Cyg-to-Win (woman-parse-man.conf))) ((string-match-p ";" paths) ;; Assume DOS-style path-list... - (woman-mapcan ; splice list into list + (cl-mapcan ; splice list into list (lambda (x) (if x (list x) @@ -451,14 +445,14 @@ As a special case, if PATHS is nil then replace it by calling (list paths)) (t ;; Assume UNIX/Cygwin-style path-list... - (woman-mapcan ; splice list into list + (cl-mapcan ; splice list into list (lambda (x) (mapcar 'woman-Cyg-to-Win (if x (list x) (woman-parse-man.conf)))) (let ((path-separator ":")) (parse-colon-path paths))))) ;; Assume host-default-style path-list... - (woman-mapcan ; splice list into list + (cl-mapcan ; splice list into list (lambda (x) (if x (list x) (woman-parse-man.conf))) (parse-colon-path (or paths ""))))) diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index 59ed68a60c7..f9e89880dae 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -42,13 +42,12 @@ (defvar xterm-mouse-debug-buffer nil) -(defvar xterm-mouse-last) - ;; Mouse events symbols must have an 'event-kind property with ;; the value 'mouse-click. -(dolist (event-type '(mouse-1 mouse-2 mouse-3 - M-down-mouse-1 M-down-mouse-2 M-down-mouse-3)) - (put event-type 'event-kind 'mouse-click)) +(dolist (event '(mouse-1 mouse-2 mouse-3 mouse-4 mouse-5)) + (let ((M-event (intern (concat "M-" (symbol-name event))))) + (put event 'event-kind 'mouse-click) + (put M-event 'event-kind 'mouse-click))) (defun xterm-mouse-translate (_event) "Read a click and release event from XTerm." @@ -65,59 +64,47 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)." (save-excursion (save-window-excursion ;FIXME: Why? (deactivate-mark) ;FIXME: Why? - (let* ((xterm-mouse-last nil) - (down (xterm-mouse-event extension)) - (down-command (nth 0 down)) - (down-data (nth 1 down)) - (down-where (nth 1 down-data)) - (down-binding (key-binding (if (symbolp down-where) - (vector down-where down-command) - (vector down-command)))) - (is-down (string-match "down" (symbol-name (car down))))) - - ;; Retrieve the expected preface for the up-event. - (when is-down - (unless (cond ((null extension) - (and (eq (read-event) ?\e) - (eq (read-event) ?\[) - (eq (read-event) ?M))) - ((eq extension 1006) - (and (eq (read-event) ?\e) - (eq (read-event) ?\[) - (eq (read-event) ?<)))) - (error "Unexpected escape sequence from XTerm"))) - - ;; Process the up-event. - (let* ((click (if is-down (xterm-mouse-event extension) down)) - (click-data (nth 1 click)) - (click-where (nth 1 click-data))) + (let* ((event (xterm-mouse-event extension)) + (ev-command (nth 0 event)) + (ev-data (nth 1 event)) + (ev-where (nth 1 ev-data)) + (vec (if (and (symbolp ev-where) (consp ev-where)) + ;; FIXME: This condition can *never* be non-nil!?! + (vector (list ev-where ev-data) event) + (vector event))) + (is-down (string-match "down-" (symbol-name ev-command)))) + (cond - ((null down) nil) - ((memq down-binding '(nil ignore)) - (if (and (symbolp click-where) - (consp click-where)) - (vector (list click-where click-data) click) - (vector click))) + ((null event) nil) ;Unknown/bogus byte sequence! + (is-down + (setf (terminal-parameter nil 'xterm-mouse-last-down) event) + vec) + (t + (let* ((down (terminal-parameter nil 'xterm-mouse-last-down)) + (down-data (nth 1 down)) + (down-where (nth 1 down-data))) + (setf (terminal-parameter nil 'xterm-mouse-last-down) nil) + (cond + ((null down) + ;; This is an "up-only" event. Pretend there was an up-event + ;; right before and keep the up-event for later. + (push event unread-command-events) + (vector (cons (intern (replace-regexp-in-string + "\\`\\([ACMHSs]-\\)*" "\\&down-" + (symbol-name ev-command) t)) + (cdr event)))) + ((equal ev-where down-where) vec) (t - (setq unread-command-events - (append (if (eq down-where click-where) - (list click) - (list - ;; Cheat `mouse-drag-region' with move event. - (list 'mouse-movement click-data) - ;; Generate a drag event. - (if (symbolp down-where) - 0 - (list (intern (format "drag-mouse-%d" - (1+ xterm-mouse-last))) - down-data click-data)))) - unread-command-events)) - (if xterm-mouse-debug-buffer - (print unread-command-events xterm-mouse-debug-buffer)) - (if (and (symbolp down-where) - (consp down-where)) - (vector (list down-where down-data) down) - (vector down))))))))) + (let ((drag (if (symbolp ev-where) + 0 ;FIXME: Why?!? + (list (replace-regexp-in-string + "\\`\\([ACMHSs]-\\)*" "\\&drag-" + (symbol-name ev-command) t) + down-data ev-data)))) + (if (null track-mouse) + (vector drag) + (push drag unread-command-events) + (vector (list 'mouse-movement ev-data))))))))))))) ;; These two variables have been converted to terminal parameters. ;; @@ -158,23 +145,21 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)." (defun xterm-mouse--read-event-sequence-1000 () (let* ((code (- (read-event) 32)) (type - ;; For buttons > 3, the release-event looks differently - ;; (see xc/programs/xterm/button.c, function EditorButton), - ;; and come in a release-event only, no down-event. - (cond ((>= code 64) - (format "mouse-%d" (- code 60))) - ((memq code '(8 9 10)) - (setq xterm-mouse-last (- code 8)) - (format "M-down-mouse-%d" (- code 7))) - ((and (= code 11) xterm-mouse-last) - (format "M-mouse-%d" (1+ xterm-mouse-last))) - ((and (= code 3) xterm-mouse-last) - ;; For buttons > 5 xterm only reports a button-release event. - ;; Drop them since they're not usable and can be spurious. - (format "mouse-%d" (1+ xterm-mouse-last))) - ((memq code '(0 1 2)) - (setq xterm-mouse-last code) - (format "down-mouse-%d" (+ 1 code))))) + ;; For buttons > 3, the release-event looks differently + ;; (see xc/programs/xterm/button.c, function EditorButton), + ;; and come in a release-event only, no down-event. + (cond ((>= code 64) + (format "mouse-%d" (- code 60))) + ((memq code '(8 9 10)) + (format "M-down-mouse-%d" (- code 7))) + ((memq code '(3 11)) + (let ((down (car (terminal-parameter + nil 'xterm-mouse-last-down)))) + (when (and down (string-match "[0-9]" (symbol-name down))) + (format (if (eq code 3) "mouse-%s" "M-mouse-%s") + (match-string 0 (symbol-name down)))))) + ((memq code '(0 1 2)) + (format "down-mouse-%d" (+ 1 code))))) (x (- (read-event) 33)) (y (- (read-event) 33))) (and type (wholenump x) (wholenump y) @@ -211,10 +196,20 @@ http://invisible-island.net/xterm/ctlseqs/ctlseqs.html)." (if down "down-" "") (if wheel (- code 60) - (1+ (setq xterm-mouse-last (mod code 4))))))) + (1+ (mod code 4)))))) (1- (string-to-number (apply 'string (nreverse x-bytes)))) (1- (string-to-number (apply 'string (nreverse y-bytes))))))) +(defun xterm-mouse--set-click-count (event click-count) + (setcdr (cdr event) (list click-count)) + (let ((name (symbol-name (car event)))) + (when (string-match "\\(.*?\\)\\(\\(?:down-\\)?mouse-.*\\)" name) + (setcar event + (intern (concat (match-string 1 name) + (if (= click-count 2) + "double-" "triple-") + (match-string 2 name))))))) + (defun xterm-mouse-event (&optional extension) "Convert XTerm mouse event to Emacs mouse event. EXTENSION, if non-nil, means to use an extension to the usual @@ -240,18 +235,42 @@ which is the \"1006\" extension implemented in Xterm >= 277." (w (window-at x y)) (ltrb (window-edges w)) (left (nth 0 ltrb)) - (top (nth 1 ltrb))) - (set-terminal-parameter nil 'xterm-mouse-x x) - (set-terminal-parameter nil 'xterm-mouse-y y) - (setq - last-input-event - (list type - (let ((event (if w + (top (nth 1 ltrb)) + (posn (if w (posn-at-x-y (- x left) (- y top) w t) (append (list nil 'menu-bar) - (nthcdr 2 (posn-at-x-y x y)))))) - (setcar (nthcdr 3 event) timestamp) - event))))))) + (nthcdr 2 (posn-at-x-y x y))))) + (event (list type posn))) + (setcar (nthcdr 3 posn) timestamp) + + ;; Try to handle double/triple clicks. + (let* ((last-click (terminal-parameter nil 'xterm-mouse-last-click)) + (last-type (nth 0 last-click)) + (last-name (symbol-name last-type)) + (last-time (nth 1 last-click)) + (click-count (nth 2 last-click)) + (this-time (float-time)) + (name (symbol-name type))) + (cond + ((not (string-match "down-" name)) + ;; For up events, make the up side match the down side. + (setq this-time last-time) + (when (and (> click-count 1) + (string-match "down-" last-name) + (equal name (replace-match "" t t last-name))) + (xterm-mouse--set-click-count event click-count))) + ((not last-time) nil) + ((and (> double-click-time (* 1000 (- this-time last-time))) + (equal last-name (replace-match "" t t name))) + (setq click-count (1+ click-count)) + (xterm-mouse--set-click-count event click-count)) + (t (setq click-count 1))) + (set-terminal-parameter nil 'xterm-mouse-last-click + (list type this-time click-count))) + + (set-terminal-parameter nil 'xterm-mouse-x x) + (set-terminal-parameter nil 'xterm-mouse-y y) + (setq last-input-event event))))) ;;;###autoload (define-minor-mode xterm-mouse-mode @@ -267,36 +286,27 @@ single clicks are supported. When turned on, the normal xterm mouse functionality for such clicks is still available by holding down the SHIFT key while pressing the mouse button." :global t :group 'mouse - (let ((do-hook (if xterm-mouse-mode 'add-hook 'remove-hook))) - (funcall do-hook 'terminal-init-xterm-hook - 'turn-on-xterm-mouse-tracking-on-terminal) - (funcall do-hook 'delete-terminal-functions - 'turn-off-xterm-mouse-tracking-on-terminal) - (funcall do-hook 'suspend-tty-functions - 'turn-off-xterm-mouse-tracking-on-terminal) - (funcall do-hook 'resume-tty-functions - 'turn-on-xterm-mouse-tracking-on-terminal) - (funcall do-hook 'suspend-hook 'turn-off-xterm-mouse-tracking) - (funcall do-hook 'suspend-resume-hook 'turn-on-xterm-mouse-tracking) - (funcall do-hook 'kill-emacs-hook 'turn-off-xterm-mouse-tracking)) + (funcall (if xterm-mouse-mode 'add-hook 'remove-hook) + 'terminal-init-xterm-hook + 'turn-on-xterm-mouse-tracking-on-terminal) (if xterm-mouse-mode ;; Turn it on (progn (setq mouse-position-function #'xterm-mouse-position-function) - (turn-on-xterm-mouse-tracking)) + (mapc #'turn-on-xterm-mouse-tracking-on-terminal (terminal-list))) ;; Turn it off - (turn-off-xterm-mouse-tracking 'force) + (mapc #'turn-off-xterm-mouse-tracking-on-terminal (terminal-list)) (setq mouse-position-function nil))) -(defun turn-on-xterm-mouse-tracking () - "Enable Emacs mouse tracking in xterm." - (dolist (terminal (terminal-list)) - (turn-on-xterm-mouse-tracking-on-terminal terminal))) +(defconst xterm-mouse-tracking-enable-sequence + "\e[?1000h\e[?1006h" + "Control sequence to enable xterm mouse tracking. +Enables basic tracking, then extended tracking on +terminals that support it.") -(defun turn-off-xterm-mouse-tracking (&optional _force) - "Disable Emacs mouse tracking in xterm." - (dolist (terminal (terminal-list)) - (turn-off-xterm-mouse-tracking-on-terminal terminal))) +(defconst xterm-mouse-tracking-disable-sequence + "\e[?1006l\e[?1000l" + "Reset the modes set by `xterm-mouse-tracking-enable-sequence'.") (defun turn-on-xterm-mouse-tracking-on-terminal (&optional terminal) "Enable xterm mouse tracking on TERMINAL." @@ -306,30 +316,36 @@ down the SHIFT key while pressing the mouse button." (not (string= (terminal-name terminal) "initial_terminal"))) (unless (terminal-parameter terminal 'xterm-mouse-mode) ;; Simulate selecting a terminal by selecting one of its frames + ;; so that we can set the terminal-local `input-decode-map'. (with-selected-frame (car (frames-on-display-list terminal)) (define-key input-decode-map "\e[M" 'xterm-mouse-translate) (define-key input-decode-map "\e[<" 'xterm-mouse-translate-extended)) - (set-terminal-parameter terminal 'xterm-mouse-mode t)) - (send-string-to-terminal "\e[?1000h" terminal) - ;; Request extended mouse support, if available (xterm >= 277). - (send-string-to-terminal "\e[?1006h" terminal))) + (send-string-to-terminal xterm-mouse-tracking-enable-sequence terminal) + (push xterm-mouse-tracking-enable-sequence + (terminal-parameter nil 'tty-mode-set-strings)) + (push xterm-mouse-tracking-disable-sequence + (terminal-parameter nil 'tty-mode-reset-strings)) + (set-terminal-parameter terminal 'xterm-mouse-mode t)))) (defun turn-off-xterm-mouse-tracking-on-terminal (terminal) "Disable xterm mouse tracking on TERMINAL." ;; Only send the disable command to those terminals to which we've already ;; sent the enable command. (when (and (terminal-parameter terminal 'xterm-mouse-mode) - (eq t (terminal-live-p terminal)) - ;; Avoid the initial terminal which is not a termcap device. - ;; FIXME: is there more elegant way to detect the initial terminal? - (not (string= (terminal-name terminal) "initial_terminal"))) + (eq t (terminal-live-p terminal))) ;; We could remove the key-binding and unset the `xterm-mouse-mode' ;; terminal parameter, but it seems less harmful to send this escape ;; command too many times (or to catch an unintended key sequence), than ;; to send it too few times (or to fail to let xterm-mouse events ;; pass by untranslated). - (send-string-to-terminal "\e[?1000l" terminal) - (send-string-to-terminal "\e[?1006l" terminal))) + (send-string-to-terminal xterm-mouse-tracking-disable-sequence terminal) + (setf (terminal-parameter nil 'tty-mode-set-strings) + (remq xterm-mouse-tracking-enable-sequence + (terminal-parameter nil 'tty-mode-set-strings))) + (setf (terminal-parameter nil 'tty-mode-reset-strings) + (remq xterm-mouse-tracking-disable-sequence + (terminal-parameter nil 'tty-mode-reset-strings))) + (set-terminal-parameter terminal 'xterm-mouse-mode nil))) (provide 'xt-mouse) |