diff options
Diffstat (limited to 'lisp')
265 files changed, 15262 insertions, 7469 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 41c5c7d1671..d4a0fe6782e 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -3,26 +3,123 @@ * imenu.el (imenu-default-create-index-function): Put back a version of the infinite loop test removed 2013-01-23. -2013-01-28 Fabián Ezequiel Gallina <fgallina@cuca> +2013-01-30 Fabián Ezequiel Gallina <fgallina@cuca> * progmodes/python.el (python-shell-parse-command): Find python-shell-interpreter with modified environment. -2013-01-26 Stefan Monnier <monnier@iro.umontreal.ca> +2013-01-30 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/cl.el (cl-set-getf): Add compatibility alias. -2013-01-24 Fabián Ezequiel Gallina <fgallina@cuca> +2013-01-29 Alan Mackenzie <acm@muc.de> + + Amend to fontify /regexp/s in actions correctly. + * cc-awk.el (c-awk-harmless-char-re, c-awk-harmless-string*-re): + (c-awk-harmless-string*-here-re): braces, parens and semicolons + are no longer included. + (c-awk-harmless-line-char-re, c-awk-harmless-line-string*-re): + What used to be these variables without "-line" in the name. + (c-awk-neutral-re): { is no longer neutral. Escaped newlines now + are. + (c-awk-non-arith-op-bra-re): Now also matches {. + (c-awk-pre-exp-alphanum-kwd-re): New regexp to match "print", + "return", and "case". + (c-awk-kwd-regexp-sign-re): New, to match "print", etc., followed + by /. + (c-awk-syntax-tablify-/): Check special cases "print /re/", etc. + (c-awk-set-syntax-table-properties): Extend FSM to handle + {,},(,),;. + +2013-01-29 Michael Albinus <michael.albinus@gmx.de> + + * autorevert.el (auto-revert-use-notify): Use + `custom-initialize-default' for initialization. (Bug#13583) + + * net/ange-ftp.el (ange-ftp-skip-msgs): Add another message. + + * net/tramp-sh.el (tramp-sh-handle-start-file-process): Catch + `suppress'. Otherwise, `tramp-run-real-handler' might be called + in `tramp-file-name-handler'. + (tramp-gw-tunnel-method, tramp-gw-socks-method): Declare for + compatibility. + (tramp-compute-multi-hops): Check, whether + `tramp-gw-tunnel-method' and `tramp-gw-socks-method' are non-nil. + +2013-01-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * hi-lock.el (hi-lock-unface-buffer): Don't assume `face' is a symbol + (bug#13297). + +2013-01-27 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/ruby-mode.el (ruby-font-lock-keywords): Remove some + checks made superfluous by the \_< operator. + * progmodes/ruby-mode.el (ruby-move-to-block): Work with (maybe + temporarily) broken indentation. + * progmodes/ruby-mode.el (ruby-font-lock-keywords): + Highlight nested constants, too. \_< broke that. + +2013-01-27 Nobuyoshi Nakada <nobu@ruby-lang.org> + + * progmodes/ruby-mode.el (ruby-font-lock-keywords): Use "\\_<" + instead of "\\b". + +2013-01-27 Michael Albinus <michael.albinus@gmx.de> + + * autorevert.el (auto-revert-handler): Notifications which result + from a saved file shall not be taken into account. (Bug#13557) + +2013-01-26 Andreas Schwab <schwab@linux-m68k.org> + + * emacs-lisp/lisp-mode.el (lisp-mode-variables): Add optional + parameter BAR-NOT-SYMBOL to control syntax of | for font-lock. + (lisp-mode): Pass t for it. (Bug#13556) + +2013-01-25 Alan Mackenzie <acm@muc.de> + + AWK Mode: Fix indentation bug at top level. Bug #12274. + + * progmodes/cc-engine.el (c-guess-basic-syntax): Move CASE 5P to + just before CASE 5D. + +2013-01-25 Dmitry Antipov <dmantipov@yandex.ru> + + * net/socks.el (socks-nslookup-host): Use string-to-number. + +2013-01-25 Michael Albinus <michael.albinus@gmx.de> + + * autorevert.el (auto-revert-remote-files) + (auto-revert-notify-exclude-dir-regexp): New defcustoms. + (auto-revert-notify-enabled, auto-revert-use-notify) + (auto-revert-notify-watch-descriptor-hash-list) + (auto-revert-notify-modified-p, auto-revert-notify-event-p) + (auto-revert-notify-event-descriptor) + (auto-revert-notify-event-action) + (auto-revert-notify-event-file-name): Doc fix. + (global-auto-revert-mode): Reorder checks. + (auto-revert-notify-rm-watch): Respect changed values of + `auto-revert-notify-watch-descriptor-hash-list'. + (auto-revert-notify-add-watch): Check for + `auto-revert-notify-exclude-dir-regexp'. Adapt filters for + `inotify-add-watch'. Watch `default-directory' instead of + `buffer-file-name'. `auto-revert-notify-watch-descriptor-hash-list' + has a changed meaning now. (Bug#13540) + (auto-revert-notify-handler): Change implementation wrt events + returning from a directory. + (auto-revert-handler): Reorder implementation for checks of remote + files. + (auto-revert-buffers): Fix parentheses error. + +2013-01-25 Fabián Ezequiel Gallina <fgallina@cuca> * progmodes/python.el: Enhancements to header documentation about skeletons. (Bug#5716) -2013-01-23 Fabián Ezequiel Gallina <fgallina@cuca> - * imenu.el (imenu-default-create-index-function): Remove useless infinite loop check. (Bug#13438) -2013-01-23 Alan Mackenzie <acm@muc.de> +2013-01-25 Alan Mackenzie <acm@muc.de> Fix a bug in the state cache mechanism. Refactor this a bit. @@ -39,32 +136,399 @@ (c-parse-state-1): Change the calling conventions to the two defuns involving `cache-pos'. -2013-01-23 Chong Yidong <cyd@gnu.org> +2013-01-25 Chong Yidong <cyd@gnu.org> * xml.el (xml-entity-or-char-ref-re): Fix regexp. -2013-01-18 Leo Liu <sdl.web@gmail.com> +2013-01-24 Aaron Ecay <aaronecay@gmail.com> (tiny change) + + * paren.el (show-paren-function): Make sure to set 'priority and + 'face only if the overlay does exist. + +2013-01-24 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-tramp-file-p): Check, whether NAME is unibyte. + + * net/tramp-sh.el (tramp-sh-handle-set-file-acl): Do not suppress + basic attributes. + (tramp-sh-handle-set-file-acl): Improve error checking. + +2013-01-24 Dmitry Antipov <dmantipov@yandex.ru> + + * doc-view.el (doc-view-display): Force mode line update until all + document is converted. Suggested by Stefan Monnier (Bug#13164). + +2013-01-23 Bastien Guerry <bzg@gnu.org> + + * paren.el (show-paren-function): Make sure an overlay exists + before trying to delete it. Also use `pos' as a position only + when it is an integer. + +2013-01-23 Dmitry Antipov <dmantipov@yandex.ru> + + * play/gametree.el (gametree-break-line-here): Use point-marker. + +2013-01-22 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-cmds.el (tramp-bug, tramp-append-tramp-buffers): + Mark descriptive parts with `display' property. + +2013-01-21 AgustÃn MartÃn Domingo <agustin.martin@hispalinux.es> + + * textmodes/ispell.el (ispell-hunspell-dictionary-equivs-alist): + New variable to map standard dict names to hunspell ones. + (ispell-set-spellchecker-params): Make sure specific dict names + are used for standard dicts with hunspell. + +2013-01-21 Tassilo Horn <tsdh@gnu.org> + + * textmodes/reftex-cite.el (reftex-format-citation): Add format + chars for note (%N) and url (%U). + * textmodes/reftex-vars.el (reftex-cite-format): Document them. + +2013-01-21 Juri Linkov <juri@jurta.org> + + * frame.el: Bind `f10' in `esc-map' to `toggle-frame-maximized' + in addition to existing separate binding `meta f10' in `global-map'. + (Bug#13484) + +2013-01-21 Michael Albinus <michael.albinus@gmx.de> + + Improve XEmacs compatibility. + + * net/tramp.el (tramp-replace-environment-variables): Make it a defun. + + * net/tramp-adb.el (top): Require `time-date'. + (tramp-adb-ls-output-time-less-p): Use `tramp-time-less-p'. + (tramp-adb-handle-copy-file, tramp-adb-handle-rename-file): + Use `tramp-file-name-handler'. + (tramp-adb-maybe-open-connection): + Use `tramp-compat-set-process-query-on-exit-flag'. + + * net/tramp-sh.el (tramp-sh-handle-file-acl): + Use `tramp-compat-funcall'. + + * net/tramp-smb.el (tramp-smb-handle-file-acl): Use `looking-at' and + `tramp-compat-funcall'. + +2013-01-21 Jürgen Hötzel <juergen@archlinux.org> + + * net/tramp-adb.el (tramp-adb-handle-start-file-process): Complete + reimplementation using "adb shell command ..." instead of running + remote shell interactively. + +2013-01-20 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/lisp-mode.el (emacs-lisp-mode-map): + Add native profiler menu entries. + + * profiler.el (profiler-running-p): New function. + (profiler-cpu-profile): Use profiler-running-p. + (profiler-report-mode-map): Add some more menu entries. + +2013-01-19 Glenn Morris <rgm@gnu.org> + + * mail/unrmail.el (unrmail): Do not mangle the mbox From line; + fixes 2012-12-07 change. (Bug#13499) + +2013-01-19 Leo Liu <sdl.web@gmail.com> * dired.el (dired-get-marked-files): Prune erroneous values due to last change. (Bug#13152) -2013-01-17 Glenn Morris <rgm@gnu.org> +2013-01-19 Glenn Morris <rgm@gnu.org> * progmodes/etags.el (tags-table-check-computed-list): Preserve point in tags buffer. (Bug#13412) -2013-01-16 Glenn Morris <rgm@gnu.org> - * emacs-lisp/lisp-mode.el (lisp-indent-function): Doc fix. +2013-01-19 Christian Wittern <cwittern@gmail.com> (tiny change) + Chong Yidong <cyd@gnu.org> + + * image-mode.el (image-next-file, image-previous-file): + New commands (Bug#8453). + (image-mode-map): Bind them to n and p. + (image-mode--images-in-directory): New helper function. + +2013-01-19 Chong Yidong <cyd@gnu.org> + + * image-mode.el (image-mode-fit-frame): Add a frame argument. + Suggested by Drew Adams (Bug#7730). Handle window decorations; + save and restore the old window configuration. + +2013-01-18 Leo Liu <sdl.web@gmail.com> + + * progmodes/js.el: Tweak autoload cookie for alias. + +2013-01-17 Michael Albinus <michael.albinus@gmx.de> + + * autorevert.el (auto-revert-notify-watch-descriptor): Make it + buffer local, again. This was lost with the fix on 2013-01-12. + +2013-01-17 Jürgen Hötzel <juergen@archlinux.org> + + * eshell/esh-util.el (eshell-path-env): Make it buffer local, in + order to support several eshell buffers in parallel. + +2013-01-17 Michael Albinus <michael.albinus@gmx.de> + + * autorevert.el (auto-revert-use-notify): In the :set function, do + not modify `kill-buffer-hook'. + (auto-revert-notify-rm-watch): + Remove `auto-revert-notify-rm-watch' from `kill-buffer-hook'. + (auto-revert-notify-add-watch): Do not call + `auto-revert-notify-rm-watch', but add it to a buffer local + `kill-buffer-hook'. + +2013-01-16 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/trace.el (trace--read-args): Use a closure and an honest + call to `eval' rather than a backquoted lambda. + +2013-01-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/nadvice.el (advice--tweak): Make it possible for `tweak' + to return an explicit nil. + (advice--remove-function): Change accordingly. + + * emacs-lisp/advice.el (ad-preactivate-advice): Adjust the cleanup to + the use of nadvice.el. + + * progmodes/which-func.el (which-function): Silence imenu errors + (bug#13433). + +2013-01-15 Michael R. Mauger <mmaug@yahoo.com> + + * progmodes/sql.el: (sql-imenu-generic-expression): + (sql-mode-font-lock-object-name): Match schema qualified names. + (sql-connect): Use string keys. + (sql-product-interactive): Wait for interpreter prompt. + (sql-comint-oracle): Set process coding based on NLS_LANG. + +2013-01-15 Michael R. Mauger <mmaug@yahoo.com> + + * progmodes/sql.el (sql-output-to-send): Remove, unused. + (sql-interactive-remove-continuation-prompt): + (sql-send-magic-terminator, sql-interactive-mode): Remove references. + +2013-01-14 Leo Liu <sdl.web@gmail.com> + + * calendar/calendar.el (calendar-redraw): Sync window-point and point. + (Bug#13420) + +2013-01-14 Glenn Morris <rgm@gnu.org> + + * progmodes/compile.el (compilation-error-regexp-alist-alist): + Fix interpretation of gnu line.col1-col2 format. (Bug#13335) + +2013-01-13 Fabián Ezequiel Gallina <fgallina@cuca> + + * progmodes/python.el (python-nav-end-of-statement): + Fix cornercase when handling multiline strings. + +2013-01-13 Richard Stallman <rms@gnu.org> + + * mail/sendmail.el (mail-position-on-field): Add doc string. + * mail/rmailmm.el (rmail-insert-mime-forwarded-message): - Revert 2012-12-29 change. Ref: - <http://lists.gnu.org/archive/html/emacs-devel/2013-01/msg00360.html> + Get current message boundaries and pass them to + message-forward-make-body-mime. Minor style changes. + +2013-01-13 Eli Zaretskii <eliz@gnu.org> + + * cus-start.el (all): Avoid warnings about + scroll-bar-adjust-thumb-portion on platforms where it is not defined. + +2013-01-11 Jan Djärv <jan.h.d@swipnet.se> + + * cus-start.el (all): Add scroll-bar-adjust-thumb-portion. + +2013-01-13 Stefan Monnier <monnier@iro.umontreal.ca> + + * jit-lock.el (jit-lock-debug-mode): New minor mode. + (jit-lock--debug-fontifying): New var. + (jit-lock--debug-fontify): New function. + * subr.el (condition-case-unless-debug): Don't prevent catching the + error, just let the debbugger run. + * emacs-lisp/timer.el (timer-event-handler): Don't prevent debugging + timer code and don't drop errors silently. + +2013-01-12 Michael Albinus <michael.albinus@gmx.de> + + * autorevert.el (auto-revert-notify-watch-descriptor): Give it + `permanent-local' property. + (auto-revert-notify-handler): Use `file-equal-p'. + +2013-01-12 Eli Zaretskii <eliz@gnu.org> + + * autorevert.el (auto-revert-notify-handler): Fix filtering of + file notification by ACTION. For filtering by file name, compare + only the non-directory part of the file name. -2013-01-10 Fabián Ezequiel Gallina <fgallina@cuca> +2013-01-12 Stefan Monnier <monnier@iro.umontreal.ca> - * progmodes/python.el (python-nav-end-of-statement): Fix - cornercase when handling multiline strings. + * autorevert.el: Use cl-lib instead of cl. + + * vc/vc-bzr.el (vc-bzr--sanitize-header): New function (bug#13307). + (vc-bzr-checkin): Use it. + * vc/log-edit.el (log-edit-extract-headers): Don't presume FUNCTION + will preserve match-data. + +2013-01-11 Felix H. Dahlke <fhd@ubercode.de> + + * progmodes/js.el: Fix multiline declarations's indentation (bug#8576). + (js--declaration-keyword-re): New var. + (js--multi-line-declaration-indentation): New function. + (js--proper-indentation): Use it. + +2013-01-11 Aaron S. Hawley <Aaron.Hawley@vtinfo.com> + + * calc/calc.el (calc-highlight-selections-with-faces) + (calc-dispatch): + * comint.el (comint-history-isearch-message): + * emacs-lisp/edebug.el (edebug-read, edebug-eval-defun): + * ffap.el (ffap-string-at-point-region, ffap-next) + (ffap-string-at-point, ffap-string-around) + (ffap-copy-string-as-kill, ffap-highlight-overlay) + (ffap-literally): + * font-lock.el (font-lock-keywords-alist) + (font-lock-removed-keywords-alist): + * help-mode.el (help-xref-symbol-regexp): + * info.el (Info-find-emacs-command-nodes): + * international/mule.el (add-to-coding-system-list): + * isearch.el (isearch-message-function, isearch-fail-pos): + * misearch.el (multi-isearch-next-buffer-function): + * newcomment.el (comment-box): + * printing.el (pr-txt-printer-alist, pr-ps-printer-alist) + (pr-setting-database): + * progmodes/cc-fonts.el (c-font-lock-keywords-3) + (c++-font-lock-keywords-3, objc-font-lock-keywords-3) + (java-font-lock-keywords-3, idl-font-lock-keywords-3) + (pike-font-lock-keywords-3): + * progmodes/compile.el (compile): + * progmodes/etags.el (tags-table-files) + (tags-table-files-function, tags-included-tables-function): + * progmodes/gdb-mi.el (gdb, gdb-setup-windows) + (gdb-restore-windows): + * ps-print.el (ps-even-or-odd-pages, ps-spool-buffer-with-faces) + (ps-n-up-filling-database): + * server.el (server-buffer, server-log): + * simple.el (newline, delete-backward-char, delete-forward-char) + (minibuffer-history-isearch-message, kill-line, track-eol) + (temporary-goal-column): + * textmodes/flyspell.el (flyspell-mark-duplications-flag) + (flyspell-default-deplacement-commands): + * textmodes/ispell.el (ispell-accept-output): + * textmodes/sgml-mode.el (html-tag-help): + * vc/compare-w.el (compare-ignore-whitespace) + (compare-ignore-case, compare-windows-dehighlight): + * vc/diff.el (diff): + * whitespace.el (whitespace-point) + (whitespace-font-lock-refontify, whitespace-bob-marker) + (whitespace-eob-marker): Fix ambiguous doc string cross-reference(s). + +2013-01-11 Michael Albinus <michael.albinus@gmx.de> + + * autorevert.el (top): Require 'cl in order to pacify byte compiler. + (auto-revert-notify-rm-watch): Ignore errors. + (auto-revert-notify-add-watch): Ignore errors. Use '(modify) for + inotify, and '(size last-write-time) for w32notify. + Set buffer-local `auto-revert-use-notify' to nil when adding a file + watch fails - this is a fallback to the file modification check. + (auto-revert-notify-event-p, auto-revert-notify-event-descriptor) + (auto-revert-notify-event-action) + (auto-revert-notify-event-file-name): New defuns. + (auto-revert-notify-handler): Use them. Implement first + plausibility checks. + (auto-revert-handler): Handle also `auto-revert-tail-mode'. + +2013-01-11 Julien Danjou <julien@danjou.info> + + * color.el (color-rgb-to-hsv): Fix conversion computing in case min and + max are almost equal. Also return the correct value for V which is + already between 0 and 1. + +2013-01-11 Dmitry Antipov <dmantipov@yandex.ru> + + * emacs-lisp/ert.el (ert-run-test): Use point-max-marker. + +2013-01-11 Eli Zaretskii <eliz@gnu.org> + + * autorevert.el (auto-revert-notify-rm-watch) + (auto-revert-notify-add-watch): Fix typos in w32notify function + names. + +2013-01-10 Michael Albinus <michael.albinus@gmx.de> + + * autorevert.el (auto-revert-notify-enabled): Move up. + (auto-revert-use-notify): New defcustom. + (auto-revert-mode, global-auto-revert-mode) + (auto-revert-notify-add-watch, auto-revert-handler) + (auto-revert-buffers): Use `auto-revert-use-notify' instead of + `auto-revert-notify-enabled'. + +2013-01-10 Elias Pipping <pipping@exherbo.org> + + * files.el (auto-mode-alist): Use doc-view for djvu files (bug#13164). + * doc-view.el (doc-view-document->bitmap): + Use doc-view-single-page-converter-function instead of + single-page-converter arg; adjust callers. + +2013-01-10 Feng Li <fengli@gmail.com> (tiny change) + + * progmodes/which-func.el (which-function): Understand Semantic's use + of overlays in imenu--index-alist. + +2013-01-10 Wolfgang Jenkner <wjenkner@inode.at> + + * man.el: Handle different "man -k" behaviors (bug#13160). Use utf-8. + (Man-man-k-use-anchor): New var. + (Man-parse-man-k): New function. + (Man-completion-table): Use it. + (man): Flush the completion cache between uses. + +2013-01-10 Michael Albinus <michael.albinus@gmx.de> + + * autorevert.el: Add file watch support. + (auto-revert-notify-enabled): New defconst. + (auto-revert-notify-watch-descriptor-hash-list) + (auto-revert-notify-watch-descriptor) + (auto-revert-notify-modified-p): New defvars. + (auto-revert-notify-rm-watch, auto-revert-notify-add-watch) + (auto-revert-notify-handler): New defuns. + (auto-revert-mode, global-auto-revert-mode): Remove file watches + when mode is disabled. + (auto-revert-handler): Check for `auto-revert-notify-modified-p'. + (auto-revert-buffers): Add file watches for active buffers. + +2013-01-10 Dmitry Antipov <dmantipov@yandex.ru> + + * cus-start.el (toplevel): Only allow float values for + scroll-up-aggressively and scroll-down-aggressively. + Allow any number for line-spacing. + +2013-01-10 Stefan Monnier <monnier@iro.umontreal.ca> + + * doc-view.el (doc-view-pdfdraw-program): Allow "pdfdraw" name. + (doc-view-pdf->png-converter-function): Use mupdf if available. + (doc-view-djvu->png-converter-function) + (doc-view-ps->png-converter-function): Remove. + (doc-view--image-file-pattern): Replace doc-view--image-file-extension. + (doc-view-goto-page, doc-view-convert-current-doc, doc-view-display) + (doc-view-already-converted-p): Adjust accordingly. + (doc-view-mode-p): Simplify. + (doc-view-enlarge): Use setq-local. + (doc-view-pdf->png-converter-ghostscript) + (doc-view-djvu->png-converter-ddjvu) + (doc-view-pdf->png-converter-mupdf): Rework to call + doc-view-start-process directly. + (doc-view-pdf/ps->png): Simplify accordingly. + (doc-view-pdf->png-1, doc-view-djvu->png-1): Remove. + (doc-view-document->bitmap): Rename from doc-view-document->png. + (doc-view-convert-current-doc): Merge pdf and djvu cases. + (doc-view-set-slice-from-bounding-box): Fix completion table. + (doc-view-mode): Use add-hook for after-revert-hook. 2013-01-10 Glenn Morris <rgm@gnu.org> @@ -72,12 +536,12 @@ (authors-valid-file-names, authors-renamed-files-alist): Add some more entries. -2013-01-09 Stefan Monnier <monnier@iro.umontreal.ca> +2013-01-10 Stefan Monnier <monnier@iro.umontreal.ca> * image-mode.el (image-mode-winprops): Don't throw away the fallback `t' pseudo-window entry. -2013-01-09 Alan Mackenzie <acm@muc.de> +2013-01-10 Alan Mackenzie <acm@muc.de> Fix bugs in the c-parse-state mechanism. Reuse some markers instead of continually generating new ones. @@ -91,19 +555,62 @@ (c-state-maybe-marker): New macro. (c-parse-state): Reuse markers when appropriate. -2013-01-09 Glenn Morris <rgm@gnu.org> +2013-01-10 Glenn Morris <rgm@gnu.org> * simple.el (execute-extended-command): Doc fix. Bind prefix-arg around read-extended-command, for prompt. (Bug#13395) -2013-01-09 Chong Yidong <cyd@gnu.org> +2013-01-10 Chong Yidong <cyd@gnu.org> * faces.el (read-face-name): Doc fix. +2013-01-10 Roland Winkler <winkler@gnu.org> + + * emacs-lisp/crm.el: Allow any regexp for separators. + (crm-default-separator): All spaces around the default comma separator. + (crm--completion-command): New macro. + (crm-completion-help, crm-complete, crm-complete-word): Use it. + (crm-complete-and-exit): Handle non-single-char separators. + +2013-01-09 Elias Pipping <pipping@lavabit.com> + + * doc-view.el: Add support for DjVu (bug#13164). + (doc-view-djvu->png-converter-function): New config var. + (doc-view-single-page-converter-function, doc-view--image-type) + (doc-view--image-file-extension): New vars. + (doc-view-mode): Initialize them. + (doc-view-goto-page): Use them. + (doc-view-mode-p): Add support for ddjvu. + (doc-view-djvu->png-converter-ddjvu, doc-view-djvu->png-1) + (doc-view-set-up-single-converter): New funs. + (doc-view-pdf/ps->png): Extend for djvu. + (doc-view-document->png): Rename from doc-view-pdf->png. + (doc-view-convert-current-doc): Handle djvu. + (doc-view-insert-image, doc-view-display) + (doc-view-already-converted-p): Don't hardcode png. + (doc-view-set-doc-type): Recognize djvu docs. + +2013-01-09 Elias Pipping <pipping@lavabit.com> + + * doc-view.el: Add support for mupdf converter (bug#13164). + (doc-view-pdfdraw-program, doc-view-pdf->png-converter-function) + (doc-view-ps->png-converter-function): New config vars. + (doc-view-pdf->png-converter-ghostscript) + (doc-view-ps->png-converter-ghostscript) + (doc-view-pdf->png-converter-mupdf): New functions. + (doc-view-pdf/ps->png, doc-view-pdf->png-1): Use them. + +2013-01-09 Jürgen Hötzel <juergen@archlinux.org> + + * net/tramp.el (tramp-eshell-directory-change): Check remote-path + first in session cache: When `tramp-own-remote-path' is in + `tramp-remote-path', the remote path is only set in the session + cache. + 2013-01-09 Glenn Morris <rgm@gnu.org> - * emacs-lisp/trace.el (trace-function, trace-function-background): - Doc fix. + * emacs-lisp/trace.el (trace-function-foreground) + (trace-function-background): Doc fix. 2013-01-09 Juri Linkov <juri@jurta.org> @@ -114,23 +621,179 @@ `completion-ignore-case' in `completion-pcm--all-completions'. (Bug#12615). -2013-01-07 Glenn Morris <rgm@gnu.org> +2013-01-09 Glenn Morris <rgm@gnu.org> * progmodes/compile.el (compilation-parse-errors): Fix typo. (Bug#13369) -2013-01-07 Vitalie Spinu <spinuvit@gmail.com> (tiny change) +2013-01-09 Vitalie Spinu <spinuvit@gmail.com> (tiny change) * comint.el (comint-send-input): Check size of buffer before waiting for process output, in case already accepted. (Bug#13290) +2013-01-09 Paul Eggert <eggert@cs.ucla.edu> + + Spelling fixes. + * net/tramp-adb.el (tramp-adb-get-toolbox): + Fix misspelling of 'unknown'. + +2013-01-08 Juri Linkov <juri@jurta.org> + + * textmodes/flyspell.el (flyspell-incorrect, flyspell-duplicate): + * progmodes/flymake.el (flymake-errline, flymake-warnline): + Use underline style wave on terminals that support it. (Bug#13000) + +2013-01-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/pcase.el (pcase--split-equal): Also take advantage if + the predicate returns nil. + + * simple.el: Use lexical-binding. + (primitive-undo): Use pcase. + (minibuffer-history-isearch-push-state): Use a closure. + +2013-01-08 Aaron S. Hawley <aaron.s.hawley@gmail.com> + + * simple.el (primitive-undo): Move from undo.c. + +2013-01-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc/pcvs.el (cvs-cleanup-collection): Extend meaning of `rm-handled'. + (cvs-mode-remove-handled): Use it (bug#13380). + + * emacs-lisp/nadvice.el (advice--tweak): New function. + (advice--remove-function, advice--subst-main): Use it. + + * emacs-lisp/advice.el: Update commentary. + +2013-01-08 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-adb.el (tramp-adb-file-name-handler-alist): + Remove spurious entry. + +2013-01-08 Glenn Morris <rgm@gnu.org> + + * net/tramp.el (tramp-default-host-alist): Add :version. + +2013-01-08 Juri Linkov <juri@jurta.org> + + * info.el (Info-read-node-name-2): Don't duplicate suffixes for + single completion. (Bug#12456) + (info--manual-names): Expand node completions into an explicit list + before appending it to another list. Filter out internal buffers + with the leading space in the buffer name. (Bug#10771) + +2013-01-08 Juri Linkov <juri@jurta.org> + + * info.el (Info-read-node-name-1): Allow empty node name in (FILENAME) + that defaults to the Top node. + (Info-goto-node, Info-read-node-name): Doc fix to mention that + the short format (FILENAME) goes to the Top node. + (Info-build-node-completions): Rename arg `file' to `filename'. + (Bug#13365) + +2013-01-07 Bastien Guerry <bzg@gnu.org> + + * menu-bar.el (menu-bar-search-documentation-menu): + Use `apropos-user-option' and fix the help message. + +2013-01-07 Bastien Guerry <bzg@gnu.org> + + * apropos.el (apropos-do-all): Update docstring. + (apropos-user-option-button): New face. + (apropos-user-option): Rename from `apropos-variable' and update + docstring. + (apropos-variable): Rewrite, now show all variables by default. + (apropos-print): Mention "User option" instead of "Variable" when + printing doc for user options. (Bug#13276) + +2013-01-07 Jürgen Hötzel <juergen@archlinux.org> + + * net/tramp-adb.el (tramp-do-parse-file-attributes-with-ls): + Handle filename correctly, when parsing "source -> target" symlink + output. + (tramp-adb-handle-set-file-times): New defun. + +2013-01-07 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/advice.el (ad-activate-advised-definition): Refresh the + advice list when the interactive-spec of ad-Advice-* changes. + +2013-01-07 Katsumi Yamaoka <yamaoka@jpl.org> + + * wid-edit.el (widget-default-get): Work for inlined elements. + (Bug#12670) + +2013-01-07 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-default-host-alist): New defcustom. + (tramp-find-host): Use it. + (tramp-eshell-directory-change): Move from tramp-sh.el. Add to + `eshell-directory-change-hook'. + + * net/tramp-adb.el (top): Add adb specific entry in + `tramp-default-host-alist'. + (tramp-adb-file-name-host): Remove function. + (tramp-adb-execute-adb-command, tramp-adb-maybe-open-connection): + Use `tramp-file-name-host' instead of `tramp-adb-file-name-host'. + + * net/tramp-sh.el: Move eshell integration code to tramp.el. + +2013-01-06 Jürgen Hötzel <juergen@archlinux.org> + + * net/tramp-adb.el (tramp-methods): Add `tramp-tmpdir' entry. + +2013-01-06 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-adb.el (tramp-adb-ls-toolbox-regexp): The file size can + consist of more than one digit. + (tramp-adb-file-name-handler-alist): + Use `tramp-handle-file-exists-p' consistently. + (tramp-adb-file-name-handler): Don't tweak `tramp-default-host'. + (tramp-adb-handle-file-exists-p): Remove function. + (tramp-adb-file-name-host): New defun. + (tramp-adb-execute-adb-command, tramp-adb-maybe-open-connection): + Use it. + (tramp-adb-maybe-open-connection): Set "remote-path" property. + +2013-01-06 Chong Yidong <cyd@gnu.org> + + * vc/vc.el (vc-next-action): Detect buffer modifications + conflicting with locking VCS operation (Bug#11490). + + * vc/vc-hooks.el (vc-after-save): DTRT for locking VCSes. + +2013-01-05 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-adb.el (tramp-do-parse-file-attributes-with-ls): + (tramp-adb-handle-directory-files-and-attributes): Fix typos. + +2013-01-05 Jürgen Hötzel <juergen@archlinux.org> + + * net/tramp-adb.el (tramp-adb-handle-file-attributes): More robust + parsing of ls output using regular expression (handle filenames + with spaces). Use virtual device number. + (tramp-do-parse-file-attributes-with-ls): New defun (Code + cleanup). + +2013-01-04 Daiki Ueno <ueno@gnu.org> + + * epg.el: Silence byte-compiler warnings. + (epg--start): Use delete-char instead of delete-backward-char. + (epg-wait-for-completion): Pass FRAME arg to redraw-frame. + +2013-01-04 Daiki Ueno <ueno@gnu.org> + + * epg.el (epg--start): Don't call "tty" program on W32 platforms. + Suggested by Eli Zaretskii <eliz@gnu.org>. + 2013-01-04 Michael Albinus <michael.albinus@gmx.de> * net/tramp-sh.el (tramp-set-file-uid-gid): UID and GID must be non-negative integers. Otherwise, the default values are used. (tramp-convert-file-attributes): Convert uid and gid to integers. -2013-01-03 Glenn Morris <rgm@gnu.org> +2013-01-04 Glenn Morris <rgm@gnu.org> * term.el (term-handle-colors-array): Ensure face attributes are fully specified, not nil. (Bug#13337) @@ -142,19 +805,54 @@ (tag-find-file-of-tag-noselect): Check auto-compression-mode rather than 'jka-compr being loaded. (Bug#13338) +2013-01-04 Wesley Dawson <whd@lavabit.com> (tiny change) + + * icomplete.el (icomplete-completions): + Honor icomplete-prospects-height once more following + 2012-11-29 changes. (Bug#13224) + +2013-01-04 Stefan Monnier <monnier@iro.umontreal.ca> + + * subr.el (internal--called-interactively-p--get-frame): Find aliases + of called-interactively-p as well (bug#13237). + + * view.el (view--enable, view--disable): Rename from view-mode-enable + and view-mode-disable and assume it's called from view-mode. + (view-mode-enable, view-mode-disable): Redefine as obsolete + compatibility layer above view-mode. + (view-mode-enter): Call `view-mode'. + + * files.el (after-find-file): Call `view-mode'. + + * doc-view.el (doc-view-scale-internally): New var. + (doc-view-enlarge, doc-view-insert-image): Obey it. + +2013-01-03 Daiki Ueno <ueno@gnu.org> + + * epg.el (epg--start): Ignore errors when /dev/fd/0 does not + exist. (Bug#13344) + +2013-01-03 Glenn Morris <rgm@gnu.org> + + * mail/rmail.el (rmail-set-header-1): Ignore case. + Handle multi-line headers. (Bug#13330) + + * progmodes/make-mode.el (makefile-fill-paragraph): Add doc. + Handle paragraph starting at beginning of buffer. + * subr.el (eval-after-load): Don't purecopy the form, so that it can be nconc'd later on; reverts 2009-11-11 change. (Bug#13331) * emacs-lisp/byte-run.el (defun): Place cl declarations after any interactive spec. (Bug#13265) -2012-12-31 Andreas Schwab <schwab@linux-m68k.org> +2013-01-02 Andreas Schwab <schwab@linux-m68k.org> * emacs-lisp/byte-run.el (defmacro): Use same argument parsing as defun. Don't check for DECL if DOCSTRING isn't a string. (defun): Likewise. -2012-12-31 Glenn Morris <rgm@gnu.org> +2013-01-02 Glenn Morris <rgm@gnu.org> * eshell/em-cmpl.el (eshell-pcomplete): More thoroughly imitate pcomplete. (Bug#13293) @@ -162,32 +860,67 @@ * files.el (parse-colon-path): Doc fix. (Bug#12351) Return nil for empty path elements. (Bug#13296) -2012-12-31 Fabián Ezequiel Gallina <fgallina@cuca> +2013-01-02 Fabián Ezequiel Gallina <fgallina@cuca> * progmodes/python.el (python-nav-end-of-statement): Rewrite in order to improve efficiency (Based on Daniel Colascione's <dancol@dancol.org> patch). (Bug#13182) -2012-12-31 Glenn Morris <rgm@gnu.org> +2013-01-02 Glenn Morris <rgm@gnu.org> * vc/log-edit.el (log-edit-header-contents-regexp): Add doc string. -2012-12-31 Fabián Ezequiel Gallina <fgallina@cuca> +2013-01-02 Andreas Schwab <schwab@linux-m68k.org> - * progmodes/python.el: Support other commands triggering - python-indent-line so indentation cycling continues to work. - (python-indent-trigger-commands): New defcustom. - (python-indent-line): Use it. + * emacs-lisp/byte-run.el (defmacro): Don't lose final nil if + neither DOCSTRING nor DECL was given. (Bug#13316) -2012-12-31 Fabián Ezequiel Gallina <fgallina@cuca> +2013-01-02 Michael Albinus <michael.albinus@gmx.de> - * progmodes/python.el (python-shell-send-region): Add blank lines - for non sent code so backtraces remain correct. + * net/tramp-sh.el (tramp-sh-handle-set-file-acl): Add argument to + `error' call. + (tramp-do-copy-or-rename-file): Ignore errors when calling + `set-file-extended-attributes'. -2012-12-31 Andreas Schwab <schwab@linux-m68k.org> + * net/tramp-smb.el (tramp-smb-file-name-handler-alist): + Add handler for `file-acl'. + (tramp-smb-handle-file-acl): New defun. - * emacs-lisp/byte-run.el (defmacro): Don't lose final nil if - neither DOCSTRING nor DECL was given. (Bug#13316) +2013-01-02 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/README: Mention ISO 8601 week-numbering dates. + +2013-01-01 Martin Rudalics <rudalics@gmx.at> + + * view.el (view-mode-enable): New argument run-view-mode-hook. + Run view-mode-hook only when it's non-nil (Bug#13315). + (view-mode-enter): Call view-mode-enable with run-view-mode-hook + argument t. + +2012-12-31 Jürgen Hötzel <juergen@archlinux.org> + + * net/tramp-adb.el (tramp-adb-maybe-open-connection): Handle errors + (No device connected, invalid device name). (Bug #13299) + +2012-12-31 Martin Rudalics <rudalics@gmx.at> + + * window.el (window-resizable--p): Rename to window-resizable-p. + (window-resize-no-error): New function. + + * mail/rmail.el (rmail-maybe-display-summary): Restore behavior + broken in fix from 2012-12-28. + +2012-12-31 Stefan Monnier <monnier@iro.umontreal.ca> + + * subr.el (special-form-p): Don't signal errors on undef aliases. + +2012-12-31 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc-forms.el (math-parse-date): Try using + `math-parse-iso-date' when it looks like it might be needed. + Allow times of 24:00. + (math-parse-date-validate, math-parse-iso-date-validate): Allow times + of 24:00. 2012-12-30 Glenn Morris <rgm@gnu.org> @@ -196,157 +929,1062 @@ (rmail-summary-displayed, rmail-summary): Declare. (mairix-rmail-display): Just require rmail. -2012-12-29 Chong Yidong <cyd@gnu.org> +2012-12-30 Chong Yidong <cyd@gnu.org> * emacs-lisp/package.el (package-untar-buffer): Improve integrity check for the tarball contents. -2012-12-29 Matt Fidler <matt.fidler@alcon.com> (tiny change) +2012-12-30 Matt Fidler <matt.fidler@alcon.com> (tiny change) * emacs-lisp/package.el (package-untar-buffer): Handle problematic tarfile content listings (Bug#13136). -2012-12-29 Mark Lillibridge <mark.lillibridge@hp.com> +2012-12-30 Mark Lillibridge <mark.lillibridge@hp.com> - * mail/rmailmm.el (rmail-insert-mime-forwarded-message): Insert - the undecoded text of the message being forwarded. (Bug#9521) + * mail/rmailmm.el (rmail-insert-mime-forwarded-message): + Insert the undecoded text of the message being forwarded. (Bug#9521) -2012-12-28 Michael Albinus <michael.albinus@gmx.de> +2012-12-30 Michael Albinus <michael.albinus@gmx.de> * net/tramp-sh.el (tramp-set-file-uid-gid): Convert UID and GID to integers, if they are real numbers. (Bug#13282) -2012-12-26 Dmitry Gutov <dgutov@yandex.ru> + * net/tramp-sh.el (tramp-sh-handle-set-file-selinux-context): + Return `t' on success. - * progmodes/ruby-mode.el (ruby-indent-beg-re): Only allow "class", - "module" and "def" to have indentation before them. Regression - from 109911 (see the new test). + * net/tramp-smb.el (tramp-smb-file-name-handler-alist): + Add handler for `set-file-selinux-context'. + +2012-12-29 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-sh.el (tramp-sh-handle-file-acl): Suppress basic attributes. + (tramp-sh-handle-set-file-acl): Return `t' on success. -2012-12-24 Dmitry Gutov <dgutov@yandex.ru> +2012-12-29 Eli Zaretskii <eliz@gnu.org> + + * files.el (backup-buffer-copy, basic-save-buffer-2): + If set-file-extended-attributes fails, fall back on set-file-modes + instead of signaling an error. (Bug#13298) + (basic-save-buffer): Likewise. + +2012-12-29 Fabián Ezequiel Gallina <fgallina@cuca> + + * progmodes/python.el: Support other commands triggering + python-indent-line so indentation cycling continues to work. + (python-indent-trigger-commands): New defcustom. + (python-indent-line): Use it. + +2012-12-29 Fabián Ezequiel Gallina <fgallina@cuca> + + * progmodes/python.el (python-shell-send-region): Add blank lines + for non sent code so backtraces remain correct. + +2012-12-29 Fabián Ezequiel Gallina <fgallina@cuca> + + * progmodes/python.el: Remove cl dependency. + (python-syntax-count-quotes): Replace incf call. + (python-fill-string): Replace setf call. + +2012-12-29 Damien Cassou <damien.cassou@gmail.com> + + * info.el (info-other-window): New arg, for consistency with info. + +2012-12-28 Martin Rudalics <rudalics@gmx.at> + + * mail/rmail.el (rmail-maybe-display-summary): + Rewrite (Bug#13066). + +2012-12-28 Andreas Schwab <schwab@linux-m68k.org> + + * epg.el (epg--start): Modify process-environment locally. + +2012-12-28 Daiki Ueno <ueno@gnu.org> + + * epg.el: Support pinentry-curses. + Suggested by Werner Koch in + <http://lists.gnu.org/archive/html/emacs-devel/2007-02/msg00755.html>. + (epg-agent-file, epg-agent-mtime): New variable. + (epg--start): Record the modified time of gpg-agent socket file, + to restore Emacs frame after pinentry-curses termination. + (epg-wait-for-completion): Restore Emacs frame here. + +2012-12-27 Juri Linkov <juri@jurta.org> + + * info.el (Info-file-completions): New variable. + (Info-read-node-name-1): Complete node names in the Info file + when a file name is given. Call `Info-build-node-completions' + with a file name. + (Info-build-node-completions): Add new arg `file'. When it is + non-nil, visit it in a temporary buffer and cache its completions in + `Info-current-file-completions'. Move most of the function body to + `Info-build-node-completions-1'. + (Info-build-node-completions-1): New function with the body from + `Info-build-node-completions'. (Bug#12456) + +2012-12-27 Juri Linkov <juri@jurta.org> + + * frame.el (frame-maximization-style): Remove user option. + (cycle-frame-maximized): Remove function. + (toggle-frame-maximized): Rewrite and bind to M-<f10>. + (toggle-frame-fullscreen): New command bound to <f11> instead of + `toggle-frame-maximized'. + http://lists.gnu.org/archive/html/emacs-devel/2012-12/msg00703.html + +2012-12-27 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-handle-file-accessible-directory-p): New defun. + + * net/tramp-adb.el (tramp-adb-file-name-handler-alist): + * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): + * net/tramp-sh.el (tramp-sh-file-name-handler-alist): Add handler + for `file-accessible-directory-p'. (Bug#13275) + +2012-12-27 Sam Steingold <sds@gnu.org> + + * progmodes/cperl-mode.el (cperl-calculate-indent): Do not stagger + continuations, see <http://stackoverflow.com/questions/3582436>. + +2012-12-27 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/ruby-mode.el (ruby-indent-beg-re): Only allow "class", + "module" and "def" to have indentation before them. + Regression from 2012-09-07T04:15:56Z!dgutov@yandex.ru (see the new test). * progmodes/ruby-mode.el: Bump the version to 1.2 (Bug#13200). -2012-12-23 Alan Mackenzie <acm@muc.de> +2012-12-27 Alan Mackenzie <acm@muc.de> Speed up fontification where there's large brace blocks. * progmodes/cc-fonts.el (c-font-lock-enclosing-decls): Add a limit to a call of c-beginning-of-decl-1. +2012-12-27 Vitalie Spinu <spinuvit@gmail.com> (tiny change) + + * comint.el (comint-adjust-window-point): New function. + (comint-postoutput-scroll-to-bottom): + Call comint-adjust-window-point (Bug#13248). + +2012-12-26 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/ruby-mode.el (auto-mode-alist): `purecopy' the + Rakefile regexp. + (auto-mode-alist): Associate .gemspec files with ruby-mode + (https://bugs.ruby-lang.org/issues/5453). + +2012-12-26 Jürgen Hötzel <juergen@archlinux.org> + + * net/tramp-adb.el (tramp-adb-get-ls-command): New defun. + Suppress coloring, if possible (required for BusyBox based systems like + CyanogenMod). + (tramp-adb-handle-file-attributes) + (tramp-adb-handle-insert-directory) + (tramp-adb-handle-file-name-all-completions): Use it. + (tramp-adb-get-toolbox): New defun. Check for remote shell + implementation (BusyBox or Toolbox). + +2012-12-24 Constantin Kulikov <zxnotdead@gmail.com> (tiny change) + + * startup.el (initial-buffer-choice): Allow function as value + (Bug#13251). + (command-line-1): Handle case where initial-buffer-choice + specifies a function. + * server.el (server-execute): Handle case where + initial-buffer-choice specifies a function. + +2012-12-24 Lars Ingebrigtsen <larsi@gnus.org> + + * mail/smtpmail.el (smtpmail-try-auth-method): Refactored out into + its own function. + (smtpmail-try-auth-methods): Forget the user name/password if the + login is unsuccessful (bug#12424). + +2012-12-22 Michael Albinus <michael.albinus@gmx.de> + + * notifications.el (notifications-notify): Protect body with + `with-demoted-errors'. + + * net/tramp-adb.el (tramp-adb-maybe-open-connection): + Check properties of remote device. Restart connection, if there is a + change. + 2012-12-21 Chong Yidong <cyd@gnu.org> * sort.el (sort-subr): Doc fix (Bug#13056). -2012-12-20 Bastien Guerry <bzg@gnu.org> +2012-12-21 Bastien Guerry <bzg@gnu.org> * progmodes/etags.el (tags-search): Fix typo. Bug #13232. -2012-12-11 Alan Mackenzie <acm@muc.de> +2012-12-21 Michael Albinus <michael.albinus@gmx.de> + + * simple.el (process-file): Overwrite stderr file, if exists. + +2012-12-21 Daiki Ueno <ueno@gnu.org> + + * epg.el (epg--start): Print GPG_AGENT_INFO in the debug buffer. + (epg-error): Set `error-message' property. + +2012-12-21 Chong Yidong <cyd@gnu.org> + + * international/mule-cmds.el (read-char-by-name): Signal an error + if the user does not supply a valid character (Bug#13177). + + * simple.el (transpose-subr-1): Preserve marker positions by + changing the insertion sequence (Bug#13122). + +2012-12-21 Kelly Dean <kellydeanch@yahoo.com> (tiny change) + + * simple.el (kill-region): Deactivate mark even for empty regions + (Bug#13169). + +2012-12-21 Chong Yidong <cyd@gnu.org> + + * help-fns.el (describe-variable): Make sure we get the right + buffer name (Bug#13105). Suggested by Kelly Dean. + +2012-12-20 Michael R. Mauger <mmaug@yahoo.com> + + * comint.el (comint-redirect-previous-input-string): New variable. + (comint-redirect-setup, comint-redirect-cleanup) + (comint-redirect-preoutput-filter): Use it. Fixes redirection bug. + (comint-redirect-preoutput-filter): Fix verbose message. + +2012-12-20 Michael Albinus <michael.albinus@gmx.de> + + * progmodes/grep.el (rgrep): Escape command line. Sometimes, it + is too long for Tramp. See discussion in + <http://thread.gmane.org/gmane.emacs.tramp/8233/focus=8244>. + + * progmodes/compile.el (compilation-start): Remove line escape + template. + +2012-12-20 Dmitry Antipov <dmantipov@yandex.ru> + + * vc/ediff-ptch.el (ediff-map-patch-buffer): Use `point-min-marker'. + Adjust comment. + +2012-12-19 Jonas Bernoulli <jonas@bernoul.li> + + * emacs-lisp/lisp-mnt.el (lm-section-end): Always end before the + following non-comment text (bug#13207). + (lm-header-multiline): Continuation lines need to be indented more than + the first line. + (lm-homepage): New function. + (lm-with-file): Don't be confused if narrowing is in effect. + +2012-12-19 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc/diff-mode.el (diff-post-command-hook): Don't ignore changes at the + very beginning of a hunk (e.g. killing the first line). + +2012-12-19 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-sh.el (tramp-sh-handle-file-acl): Delete empty lines + and text properties from returned ACL string. + (tramp-sh-handle-set-file-acl): Do not use additional parentheses + for "setfacl" command. + +2012-12-18 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-error-with-buffer): Give a hint to use + `tramp-cleanup-this-connection', when the process has died. + (Bug#13151) + +2012-12-17 Stefan Monnier <monnier@iro.umontreal.ca> + + * icomplete.el (icomplete-completions): Also use … to truncate prefix. + +2012-12-17 Kevin Ryde <user42@zip.com.au> + + * files.el (auto-save-file-name-p): Use \` and \' (bug#13186). + +2012-12-17 Michael Albinus <michael.albinus@gmx.de> + + Add support for preserving ACL entries of files. + + * net/tramp.el (tramp-file-name-for-operation): Add `file-acl' and + `set-file-acl' handlers. + + * net/tramp-adb.el (tramp-adb-handle-copy-file): + Handle PRESERVE-EXTENDED-ATTRIBUTES. + + * net/tramp-compat.el (tramp-compat-copy-file): + Handle PRESERVE-EXTENDED-ATTRIBUTES. + + * net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): + Add `file-acl' and `set-file-acl' handlers. + (tramp-gvfs-handle-copy-file): + Handle PRESERVE-EXTENDED-ATTRIBUTES. + (tramp-gvfs-handle-file-acl, tramp-gvfs-handle-set-file-acl): + New defuns. + + * net/tramp-sh.el (tramp-sh-file-name-handler-alist): + Add `file-acl' and `set-file-acl' handlers. + (tramp-remote-acl-p, tramp-sh-handle-file-acl) + (tramp-sh-handle-set-file-acl): New defuns. + (tramp-sh-handle-copy-file, tramp-do-copy-or-rename-file): + Handle PRESERVE-EXTENDED-ATTRIBUTES. + + * net/tramp-smb.el (tramp-smb-file-name-handler-alist): + Add `file-acl' and `set-file-acl' handlers. + (tramp-smb-handle-copy-file): Handle PRESERVE-EXTENDED-ATTRIBUTES. + +2012-12-17 Kelly Dean <kellydeanch@yahoo.com> (tiny change) + + * help-macro.el (make-help-screen): Instead of switch-to-buffer + use pop-to-buffer with NORECORD argument t. As buffer name, use + *Metahelp* with a leading space (Bug#13190). + +2012-12-16 Romain Francoise <romain@orebokech.com> + + * files.el (file-extended-attributes) + (set-file-extended-attributes): New functions. + (backup-buffer): Use them to handle both SELinux context and ACL + entries. + (backup-buffer-copy): Work with an alist of extended attributes, + rather than an SELinux context. + (basic-save-buffer-2): Ditto. + +2012-12-16 Timo Myyrä <timo.myyra@gmail.com> + + * battery.el (battery-bsd-apm): New function. + +2012-12-16 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc.el (calc-standard-date-formats): Adjust one of the + standard date formats. + +2012-12-15 Juri Linkov <juri@jurta.org> + + * isearch.el (isearch-mode-map): Bind `C-x 8 RET' to + `isearch-insert-char-by-name'. + (with-isearch-suspended): New defmacro with body mostly from + `isearch-edit-string' except the part that sets + `isearch-new-string' and `isearch-new-message'. + (isearch-edit-string): Use new macro `with-isearch-suspended' with + body that sets `isearch-new-string' and `isearch-new-message'. + (isearch-insert-char-by-name): New command. + * international/mule-cmds.el (read-char-by-name): Let-bind + `enable-recursive-minibuffers' to t. + http://lists.gnu.org/archive/html/emacs-devel/2012-12/msg00234.html + +2012-12-15 Juri Linkov <juri@jurta.org> + + * isearch.el (isearch-delete-char, isearch-del-char): Doc fix. + (Bug#13175) + +2012-12-15 Christopher Schmidt <christopher@ch.ristopher.com> + + * dired-x.el (dired-guess-shell-command): Put colon at the end of + the prompt. (Bug#13045) + +2012-12-14 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/macroexp.el (macroexp--warn-and-return): + Try to include filename in non-bytecomp warning. (Bug#13132) + +2012-12-14 Paul Eggert <eggert@cs.ucla.edu> + + Fix permissions bugs with setgid directories etc. (Bug#13125) + * files.el (backup-buffer): Don't rely on 9th output of + file-attributes, as it's now a placeholder. Instead, use the new + optional arg of file-ownership-preserved-p. + (file-ownership-preserved-p): New optional arg GROUP. + Fix mishandling of setuid directories that would cause this + function to return t when it should have returned nil. + Document what happens if the file does not exist, and when + it's not known whether the ownership will be preserved. + * net/tramp-sh.el (tramp-sh-handle-file-ownership-preserved-p): + Likewise. + (tramp-get-local-gid): Use group-gid for integer, as that's + faster and more reliable. + +2012-12-14 Julien Danjou <julien@danjou.info> + + * progmodes/sql.el (sql-mode-postgres-font-lock-keywords): + Update keywords list, data type and PL/pgSQL. + +2012-12-14 Dave Abrahams <dave@boostpro.com> + + * vc/ediff-util.el (ediff-buffer-type): New function. + (ediff-clone-buffer-for-current-diff-comparison): Compute the buf-type + rather than taking it as as argument. + (ediff-inferior-compare-regions): Adjust calls accordingly (bug#11319). + +2012-12-14 Ryan Crum <ryan.crum@eleostech.com> + + * json.el: Add pretty-print option (bug#12634). + (json-encoding-separator, json-encoding-default-indentation) + (json--encoding-current-indentation, json-encoding-pretty-print) + (json-encoding-lisp-style-closings): New vars. + (json--with-indentation): New macro. + (json-encode-hash-table, json-encode-alist, json-encode-plist) + (json-encode-array): Use it to obey json-encoding-pretty-print. + (json-pretty-print-buffer, json-pretty-print): New commands. + +2012-12-14 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/ruby-mode.el (ruby-syntax-propertize-function): + Extract `ruby-syntax-propertize-expansions'. + (ruby-syntax-propertize-expansions): Only change syntax on + certain string delimiters, to punctuation. This way the common + functions like forward-word and thing-at-point still work. + (ruby-match-expression-expansion): Improve readability. + (ruby-block-contains-point): New function. + (ruby-add-log-current-method): Handle several edge cases. + +2012-12-13 Juanma Barranquero <lekktu@gmail.com> + + * emacs-lisp/edebug.el (edebug-unload-function): Make sure that + unload-feature finishes even when aborting an ongoing edebug session. + Also, do not worry about edebug-mode, unload-feature takes care of it. + +2012-12-13 Andreas Schwab <schwab@suse.de> + + * net/tls.el (tls-program): Update customize type. + +2012-12-13 Juanma Barranquero <lekktu@gmail.com> + + * emacs-lisp/edebug.el (edebug--require-cl-read): New function. + (edebug-setup-hook, cl-read-load-hooks): Use it. + (edebug-unload-function): New function. (Bug#13163) + +2012-12-13 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-adb.el (tramp-adb-file-name-p): Make it a defsubst. + Otherwise, there could be errors in autoloading. (Bug#13151) + +2012-12-13 Jürgen Hötzel <juergen@archlinux.org> + + * net/tramp-adb.el (tramp-adb-wait-for-output): Remove spurious " ^H" + sequences. + +2012-12-13 Alan Mackenzie <acm@muc.de> Make CC Mode not hang when _some_ lines end in CRLF. Bug #11841. * progmodes/cc-engine.el (c-backward-comments): Add code to work around `forward-comment' not recognizing ^M as whitespace. -2012-12-11 Fabián Ezequiel Gallina <fgallina@cuca> +2012-12-13 Fabián Ezequiel Gallina <fgallina@cuca> * progmodes/python.el (python-skeleton-class) (python-skeleton-def): Do not add space after defun name. -2012-12-09 Chong Yidong <cyd@gnu.org> +2012-12-13 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/cl.el (letf): Make it an alias of cl-letf. + (cl--symbol-function): Remove (now that funbound is like nil). + +2012-12-12 Glenn Morris <rgm@gnu.org> + + * button.el (button--area-button-p): Fix typo. + +2012-12-12 Sam Steingold <sds@gnu.org> + + * frame.el (frame-maximization-style): New user option. + (toggle-frame-maximized): Toggle frame maximization according to + `frame-maximization-style', bound to <f11>. + (cycle-frame-maximized): Cycle between all maximization styles and + non-maximized frame, bound to shift-<f11>. + +2012-12-12 David Cadé <codename68@gmail.com> + + * mpc.el (mpc-format): Use truncate-string-to-width (bug#13143). + +2012-12-12 Jonas Bernoulli <jonas@bernoul.li> + + * lisp/emacs-lisp/eieio.el: Prettier object pretty-printing (bug#13115). + (eieio-override-prin1): Don't quote kewords and booleans. + (object-write) <eieio-default-superclass>: Don't put closing parens + on new line, avoid needless empty lines, align values that are objects + with the slot keyword (instead of beginning on the same line). + (eieio-list-prin1): Align value with slot keyword; increase + eieio-print-depth before printing members of the list. + +2012-12-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * mail/emacsbug.el (report-emacs-bug): Move the intangible text to + a display text-property. + (report-emacs-bug-hook): Don't bother deleting it any more. + + * hilit-chg.el (highlight-save-buffer-state): Delete. + Use with-silent-modifications instead. + (hilit-chg-set-face-on-change): Only fixup the text that's modified. + + * button.el: Handle buttons in display text-properties. + (button--area-button-p, button--area-button-string): + Use (STRING . STRING-POS) representation instead of just STRING. + +2012-12-11 Eli Zaretskii <eliz@gnu.org> + + * makefile.w32-in (compile4-SH): Fix a typo that caused term + subdirectory be skipped. + +2012-12-11 Glenn Morris <rgm@gnu.org> + + * net/rcirc.el (rcirc-urls, rcirc-condition-filter): Doc fixes. + + * progmodes/f90.el (f90-line-continued, f90-indent-region): + Treat preprocessor lines embedded in continuations like comments. + (f90-indent-line): Special-case preprocessor lines. (Bug#13138) - * simple.el (set-mark-default-inactive): Mark as obsolete, for - removal after 24.3. +2012-12-11 Jay Belanger <jay.p.belanger@gmail.com> -2012-12-08 Dani Moncayo <dmoncayo@gmail.com> + * calc/calc.el (calc-standard-date-formats): Add more date + formats. + * calc/calc-forms.el (math-parse-iso-date): New function. + (math-parse-date): Use `math-parse-iso-date' when appropriate. + (math-parse-iso-date-validate): Add extra error checking. + (calc-date-notation): Add ability to access new date formats. + +2012-12-10 Stefan Monnier <monnier@iro.umontreal.ca> + + * hi-lock.el (hi-lock--regexps-at-point): Fix boundary case for + font-lock as well as when there's no text-property. + +2012-12-10 Jambunathan K <kjambunathan@gmail.com> + + * hi-lock.el: Refine the choice of default face. + (hi-lock-keyword->face): New function. Use it wherever we used + cadadadr instead. + (hi-lock--regexps-at-point): Ignore faces that can't come from hi-lock. + (hi-lock--last-face): Remove var. + (hi-lock--unused-faces): New var to replace it. + (hi-lock-read-face-name): Use/maintain it. + (hi-lock-unface-buffer): Maintain it. Fix error for the C-u case. + (hi-lock-set-pattern): Ignore new rule if it has the same regexp even + if it has another face. + +2012-12-10 Eli Zaretskii <eliz@gnu.org> + + * subr.el (w32notify-handle-event): New function. + (inotify-handle-event): Doc fix. + +2012-12-10 Rüdiger Sonderfeld <ruediger@c-plusplus.de> + + * subr.el (inotify-event-p, inotify-handle-event): New functions. + +2012-12-10 Dani Moncayo <dmoncayo@gmail.com> * simple.el (just-one-space): Doc fix. -2012-12-07 Eli Zaretskii <eliz@gnu.org> +2012-12-10 Eli Zaretskii <eliz@gnu.org> - * textmodes/texinfo.el (texinfo-enable-quote-envs): Add - "smallexample". + * textmodes/texinfo.el (texinfo-enable-quote-envs): Add "smallexample". -2012-12-07 Le Wang <l26wang@gmail.com> +2012-12-10 Le Wang <l26wang@gmail.com> * hilit-chg.el (hilit-chg-set-face-on-change): Don't burp in narrowed buffer (bug#12361). -2012-12-07 Michael Heerdegen <michael_heerdegen@web.de> - - * emacs-lisp/debug.el (debug): Fix hard-coded frame counts (bug#10025). - Virtually backported from trunk. - -2012-12-07 Juanma Barranquero <lekktu@gmail.com> +2012-12-10 Juanma Barranquero <lekktu@gmail.com> * vc/vc-hooks.el (vc-state): Doc fix. -2012-12-06 Glenn Morris <rgm@gnu.org> +2012-12-10 Glenn Morris <rgm@gnu.org> * mail/rmail.el (rmail-maybe-display-summary): Preserve buffer, in case select-window changes it. (Bug#13066) -2012-12-06 Stefan Monnier <monnier@iro.umontreal.ca> +2012-12-10 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/cl.el, emacs-lisp/cl-lib.el: Move cl-unload-function and cl-load-hook where they belong. +2012-12-10 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/cl-lib.el (cl-declaim): Paren typo. + +2012-12-09 Eli Zaretskii <eliz@gnu.org> + + Parallelize byte compilation on MS-Windows. + * makefile.w32-in (WINS_BASIC1, WINS_BASIC2, WINS_BASIC3) + (WINS_BASIC4): New variables, subdivide subdirectories into 4 parts. + (WINS_BASIC): Define as concatenation of the above. + (compile): Subdivide into 4 separate and independent jobs that can + be run in parallel. + (compile0-CMD, compile0-SH): New targets for compiling + COMPILE_FIRST files, which are prerequisites for the rest of the + byte-compilation. + (compile1-CMD, compile2-CMD, compile3-CMD, compile4-CMD): + New targets for parallel compilation with cmd.exe. + (compile1-SH, compile2-SH, compile3-SH, compile4-SH): Ditto for + compiling under a Unixy shell. + +2012-12-09 Chong Yidong <cyd@gnu.org> + + * simple.el (set-mark-default-inactive): Delete this + accidentally-introduced option. + (set-mark-command, exchange-point-and-mark): Remove calls. + +2012-12-09 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/lisp-mode.el (eval-defun-1): Doc fix. + Respect a defcustom's :set function, if appropriate. (Bug#109) + (eval-defun): Doc fix. + +2012-12-08 Juri Linkov <juri@jurta.org> + + * info.el (Info-copy-current-node-name, Info-breadcrumbs) + (Info-fontify-node, Info-bookmark-make-record): Remove the + file extension from Info-current-file (Bug#13016). + +2012-12-07 Stefan Monnier <monnier@iro.umontreal.ca> + + * hi-lock.el (hi-lock-unface-buffer): If there's no matching regexp at + point, still provide some default. + (hi-lock--regexps-at-point): Don't enforce a "hi-lock-" prefix on face + names, since we don't use it right now. Actually return the list. + (hi-lock-file-patterns, hi-lock-interactive-patterns): Use defvar-local. + +2012-12-07 Chong Yidong <cyd@gnu.org> + + * novice.el (disabled-command-function): Remove a spurious help + xref (Bug#13043). Suggested by Kelly Dean. + + * subr.el (text-clone-maintain): Fix clone overlay deletion when a + syntax is specified (Bug#13025). + + * info.el (Info-set-mode-line): Remove the file extension from + Info-current-file if there is one (Bug#13016). + +2012-12-07 Glenn Morris <rgm@gnu.org> + + * mail/rmail.el (rmail-mime-decoded): New permanent local. + (rmail-show-message-1): Set rmail-mime-decoded when appropriate. + * mail/rmailedit.el (rmail-cease-edit): Respect rmail-mbox-format + and rmail-mime-decoded. (Bug#9841) + + * mail/unrmail.el (unrmail-mbox-format): New option. (Bug#6574) + (batch-unrmail, unrmail): Doc fixes. + (unrmail): Respect unrmail-mbox-format. + * mail/rmail.el (rmail-mbox-format): New option. + (rmail-show-message-1): Respect rmail-mbox-format. + +2012-12-07 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/cl-macs.el (cl-tagbody): New macro. + +2012-12-06 Stefan Monnier <monnier@iro.umontreal.ca> + + Further cleanup of the "cl-" namespace. Fit CL in 80 columns. + * emacs-lisp/cl-macs.el (cl--pop2, cl--optimize-safety) + (cl--optimize-speed, cl--not-toplevel, cl--parse-loop-clause) + (cl--expand-do-loop, cl--proclaim-history, cl--declare-stack) + (cl--do-proclaim, cl--proclaims-deferred): Rename from the "cl-" prefix. + (cl-progv): Don't rely on dynamic scoping to find the body. + * emacs-lisp/cl-lib.el (cl--optimize-speed, cl--optimize-safety) + (cl--proclaims-deferred): Rename from the "cl-" prefix. + (cl-declaim): Use backquotes. + * emacs-lisp/cl-extra.el (cl-make-random-state, cl-random-state-p): + Use "cl--" prefix for the object's tag. + + * ses.el: Use advice-add/remove. + (ses--advice-copy-region-as-kill, ses--advice-yank): New functions. + (copy-region-as-kill, yank): Use advice-add. + (ses-unload-function): Use advice-remove. + +2012-12-06 Jonas Bernoulli <jonas@bernoul.li> + + * button.el: Make them work in header-lines (bug#12817). + (button-map): Add bindings for header-line and mode-line use. + (button-get, button-put, button-label): `button' may now be a string. + (button-activate): Don't make it a defsubst. + (button--area-button-p, button--area-button-string): New functions. + (make-text-button): Fix the return value when `beg' was a string. + (push-button): Handle the mode-line case. + +2012-12-06 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/sql.el: Use cl-lib and lexical-binding; various cleanup. + (sql-signum): Remove. Use `cl-signum' instead. + (sql-read-passwd): Remove; use read-passwd instread. + (sql-get-login-ext): Use read-string. + (sql-get-login): Use dolist and pcase. + (sql--completion-table): Rename from sql-try-completion. + Use complete-with-action. + (sql-mode): Don't change abbrev-all-caps globally. + (sql-connect): Don't rely on dynamic scoping for `new-name'. + (sql-postgres-completion-object): Initialize vars in their `let'. + (sql-comint-sybase, sql-comint-sqlite, sql-comint-mysql) + (sql-comint-solid, sql-comint-ms, sql-comint-postgres) + (sql-comint-interbase): Use a single append, without setq. + (sql-comint-linter): Same, and unwind-protect the LINTER_MBX var. + + * hi-lock.el: Rework the default face and the serialize regexp code. + (hi-lock--auto-select-face-defaults): Remove. + (hi-lock-string-serialize-serial): Remove. + (hi-lock--hashcons-hash): Rename from hi-lock-string-serialize-hash; + make weak. + (hi-lock--hashcons): Rename from hi-lock-string-serialize, return an + equal string. + (hi-lock-set-pattern): Adjust accordingly. + (hi-lock--regexps-at-point): Simplify accordingly. + (hi-lock--auto-select-face-defaults): Remove. + (hi-lock--last-face): New var to replace it. + (hi-lock-read-face-name): Rewrite (bug#11095). + (hi-lock-unface-buffer): Arrange for the face to be the next default. + +2012-12-06 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-replace-environment-variables): + Hide compiler warning. + (tramp-file-name-for-operation): Remove `executable-find', + `start-process', `call-process' and `call-process-region'. + + * net/tramp-compat.el (top): Don't require 'tramp-util and 'tramp-vc. + + * net/tramp-gvfs.el (tramp-gvfs-dbus-event-error): Ensure backward + compatibility. + + * net/tramp-sh.el (top): Remove `tramp-sh-handle-call-process-region'. + 2012-12-06 Chong Yidong <cyd@gnu.org> * ffap.el (ffap-replace-file-component): Fix typo. -2012-12-05 Stefan Monnier <monnier@iro.umontreal.ca> +2012-12-06 Stefan Monnier <monnier@iro.umontreal.ca> * progmodes/octave-mod.el (octave-mark-block): Move out of tokens and fix open-paren-like token test (bug#12785). -2012-12-04 Glenn Morris <rgm@gnu.org> +2012-12-06 Glenn Morris <rgm@gnu.org> * mail/rmailsum.el (rmail-new-summary): Tweak for rmail-maybe-display-summary changing buffer. (Bug#13066) -2012-12-03 Juri Linkov <juri@jurta.org> +2012-12-06 Juri Linkov <juri@jurta.org> * info.el (Info-fontify-node): Don't hide the last newline. (Bug#12272) -2012-12-01 Leo Liu <sdl.web@gmail.com> +2012-12-06 Katsumi Yamaoka <yamaoka@jpl.org> + + * mail/mailabbrev.el (mail-abbrev-expand-wrapper): Work in minibuffer + so as to enable message-read-from-minibuffer to expand mail aliases. + +2012-12-06 Stefan Monnier <monnier@iro.umontreal.ca> + + * minibuf-eldef.el (minibuf-eldef-update-minibuffer): Don't mess with + the `intangible' property. + Suggested by Christopher Schmidt <christopher@ch.ristopher.com> + +2012-12-05 Deniz Dogan <deniz@dogan.se> + + * net/rcirc.el (rcirc-urls): Update documentation. + (rcirc-condition-filter): New function. + (rcirc-browse-url, rcirc-markup-urls): Use only URLs before point + and exclude consecutive duplicate URLs (Bug#6082). + +2012-12-05 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band): + Check return code of copy command. + + * net/tramp-adb.el (tramp-adb-sdk-dir, tramp-adb-prompt): + Use group `tramp'. Add version. + +2012-12-05 Chong Yidong <cyd@gnu.org> + + * ffap.el (ffap-url-regexp): Don't require matching at front of + string (Bug#4952). + (ffap-url-p): If only a substring matches, return that. + (ffap-url-at-point): Use the return value of ffap-url-p. + (ffap-read-file-or-url, ffap-read-file-or-url-internal) + (find-file-at-point, dired-at-point, dired-at-point-prompter) + (ffap-guess-file-name-at-point): Likewise. + (ffap-replace-file-component): Fix typo. + + * info.el (info-display-manual): Add existing Info buffers, whose + files may not be in Info-directory-list, to the completion. + (info--manual-names): New helper function. + +2012-12-05 Glenn Morris <rgm@gnu.org> + + * vc/vc-hg.el (vc-hg-resolve-when-done, vc-hg-find-file-hook): + New functions, for detecting and resolving conflicts. (Bug#10709) + +2012-12-04 Jambunathan K <kjambunathan@gmail.com> + + * hi-lock.el (hi-lock-auto-select-face): New user variable. + (hi-lock-auto-select-face-defaults): New buffer local variable. + (hi-lock-read-face-name): Honor `hi-lock-auto-select-face'. + (hi-lock-unface-buffer): Prompt user with useful defaults. + With prefix arg, unhighlight all hi-lock patterns in buffer. + +2012-12-04 Stefan Monnier <monnier@iro.umontreal.ca> + + * obsolete/terminal.el, obsolete/longlines.el: Add obsolecence info. + +2012-12-04 Michael Albinus <michael.albinus@gmx.de> + + * Makefile.in (TRAMP_SRC): + * makefile.w32-in (TRAMP_SRC): Add tramp-adb.el. + +2012-12-04 Juergen Hoetzel <juergen@archlinux.org> + + * net/tramp-adb.el: New package. + +2012-12-04 Chong Yidong <cyd@gnu.org> + + * terminal.el: Move to obsolete/. + + * longlines.el: Move to obsolete/. + + * vc/ediff-diff.el (ediff-extract-diffs, ediff-extract-diffs3): + Remove code referring to longlines mode. + +2012-12-03 Juri Linkov <juri@jurta.org> + + * sort.el (delete-duplicate-lines): New command. (Bug#13032) + +2012-12-03 AgustÃn MartÃn Domingo <agustin.martin@hispalinux.es> + + * textmodes/ispell.el (ispell-init-process) + (ispell-start-process, ispell-internal-change-dictionary): + Make sure personal dictionary name is expanded after initial + `default-directory' value. Use expanded strings for + keep/restart checks and for value (Bug#13019). + +2012-12-03 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc-forms.el (math-date-to-iso-dt): Fix weekday number. + +2012-12-03 Leo Liu <sdl.web@gmail.com> * files.el (dir-locals-read-from-file): Check file non-empty before reading. (Bug#13038) -2012-11-28 Glenn Morris <rgm@gnu.org> +2012-12-03 Glenn Morris <rgm@gnu.org> * jka-cmpr-hook.el (jka-compr-get-compression-info): Remove any version extension before checking filename. (Bug#13006) (jka-compr-compression-info-list): Belated :version bump. -2012-11-28 Chong Yidong <cyd@gnu.org> +2012-12-03 Chong Yidong <cyd@gnu.org> * simple.el (transient-mark-mode): Doc fix (Bug#11523). * buff-menu.el (Buffer-menu-delete-backwards, Buffer-menu-mode) (buffer-menu): Doc fix (Bug#12294). -2012-11-27 Roland Winkler <winkler@gnu.org> +2012-12-03 Roland Winkler <winkler@gnu.org> * calendar/diary-lib.el (diary-header-line-format): Use keybinding of diary-show-all-entries in the diary buffer (Bug#12994). -2012-11-27 Michael Albinus <michael.albinus@gmx.de> +2012-12-03 Michael Albinus <michael.albinus@gmx.de> * net/tramp-sh.el (tramp-perl-encode): Use "read STDIN" instead of "<STDIN>". This is binary safe. +2012-12-03 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc-forms.el (math-absolute-from-iso-dt) + (math-date-to-iso-dt, math-parse-iso-date-validate) + (math-iso-dt-to-date): New functions. + (math-fd-iso-dt, math-fd-isoyear, math-fd-isoweek) + (math-fd-isoweekday): New variables. + (calc-date-notation, math-parse-standard-date, math-format-date) + (math-format-date-part): Add support for more formatting codes. + +2012-12-02 Dmitry Gutov <dgutov@yandex.ru> + + * vc/vc.el (vc-delete-file, vc-rename-file): Default to the + current buffer's file name when called interactively (Bug#12488). + +2012-12-02 Juri Linkov <juri@jurta.org> + + * info.el (info-display-manual): Don't clobber an existing Info + buffer (Bug#10770). Add completion (Bug#10771). + +2012-12-01 Yuya Nishihara <yuya@tcha.org> (tiny change) + + * vc/vc-hooks.el (vc-find-file-hook): Expand buffer-file-truename + before using it for comparison (Bug#5297). + +2012-12-01 Jari Aalto <jari.aalto@cante.net> + + * textmodes/css-mode.el (css-current-defun-name): New function. + (css-mode): Use it. + + * textmodes/sgml-mode.el (html-current-defun-name): New function. + (html-mode): Use it. + +2012-12-01 Chong Yidong <cyd@gnu.org> + + Modularize add-log-current-defun (Bug#2224). + Suggested by Jari Aalto. + + * vc/add-log.el (add-log-current-defun-function): Doc fix. + (add-log-current-defun): Move mode-specific code to other files. + (add-log-lisp-like-modes, add-log-c-like-modes) + (add-log-tex-like-modes): Variables deleted. + + * emacs-lisp/lisp-mode.el (lisp-current-defun-name): New. + (lisp-mode-variables): Use it. + + * progmodes/cc-mode.el (c-common-init): + * progmodes/cperl-mode.el (cperl-mode): Set a value for + add-log-current-defun-function. + + * progmodes/m4-mode.el (m4-current-defun-name): New function. + (m4-mode): Use it. + + * progmodes/perl-mode.el (perl-current-defun-name): New. + (perl-mode): Use it. + + * progmodes/scheme.el (scheme-mode-variables, dsssl-mode): + Use lisp-current-defun-name. + + * textmodes/tex-mode.el (tex-current-defun-name): New. + (tex-common-initialization): Use it. + + * textmodes/texinfo.el (texinfo-current-defun-name): New. + (texinfo-mode): Use it. + +2012-12-01 Chong Yidong <cyd@gnu.org> + + * emacs-lisp/lisp-mode.el (lisp-mode-variables, lisp-mode): + * progmodes/autoconf.el (autoconf-mode): + * progmodes/js.el (js-mode): + * progmodes/make-mode.el (makefile-mode, makefile-makepp-mode) + (makefile-bsdmake-mode, makefile-imake-mode, makefile-browse): + * progmodes/perl-mode.el (perl-mode): + * progmodes/sh-script.el (sh-mode, sh-set-shell): + * textmodes/css-mode.el (css-mode): + * textmodes/sgml-mode.el (html-mode, sgml-mode) + (sgml-tags-invisible, sgml-guess-indent): + * textmodes/tex-mode.el (tex-common-initialization) + (latex-complete-bibtex-keys, tex-shell, tex-main-file) + (doctex-mode, plain-tex-mode, latex-mode): + * textmodes/texinfo.el (texinfo-mode): Use setq-local. + +2012-12-01 Kirk Kelsey <kirk.kelsey@0x4b.net> + + * vc/vc-hg.el (vc-hg-next-revision): + Ensure use of default "tip" output format. (Bug#6968) + +2012-12-01 Kim F. Storm <storm@cua.dk> + + * startup.el (fancy-startup-tail): Add a clickable link + (Bug#2176). + +2012-12-01 Chong Yidong <cyd@gnu.org> + + * startup.el (fancy-startup-tail): Improve the message about + auto-save files (Bug#2176). + + * files.el (recover-session): Improve the descriptive message, and + use substitute-command-keys. + +2012-12-01 Glenn Morris <rgm@gnu.org> + + * ido.el (ido-file-internal): + Handle other-window, other-frame for dired. (Bug#13036) + +2012-11-30 Glenn Morris <rgm@gnu.org> + + * icomplete.el (icomplete-separator): Fix :version. + +2012-11-30 Chong Yidong <cyd@gnu.org> + + * shell.el (shell): For C-u M-x shell, use an inactive shell + buffer as the default (Bug#1975). + (shell-apply-ansi-color, shell-reapply-ansi-color): New functions. + (shell-mode): Use them to reapply ansi colorization if Shell mode + is re-enabled. + +2012-11-30 Yuriy Vostrikov <delamonpansie@gmail.com> (tiny change) + + * vc/vc-git.el (vc-git-command): Disable the pager (Bug#6137). + +2012-11-30 Samuel Bronson <naesten@gmail.com> + + * progmodes/grep.el (grep-compute-defaults): Do not pass the -e + flag to xargs, for compatibility with BSD xargs (Bug#11703). + +2012-11-30 Toru TSUNEYOSHI <t_tuneyosi@hotmail.com> + + * textmodes/fill.el (fill-region-as-paragraph): Handle overshoot + by move-to-column (Bug#3234). + +2012-11-30 Chong Yidong <cyd@gnu.org> + + * longlines.el (longlines-wrap-line, longlines-encode-region): + Preserve text properties (Bug#1425). + +2012-11-30 OKAZAKI Tetsurou <okazaki.tetsurou@gmail.com> (tiny change) + + * vc/vc.el (vc-register): Allow registering a file which is + already registered with a different backend (Bug#10589). + +2012-11-29 Jambunathan K <kjambunathan@gmail.com> + Stefan Monnier <monnier@iro.umontreal.ca> + + * icomplete.el: Change separator; add ido-style commands. + (icomplete-show-key-bindings): Remove custom var. + (icomplete-get-keys): Remove function. + (icomplete-forward-completions, icomplete-backward-completions): + New commands. + (icomplete-minibuffer-map): New var. + (icomplete-minibuffer-setup): Use it. + (icomplete-exhibit): Don't delay if the list of completions is known. + (icomplete-separator): New custom. + (icomplete-completions): Use it. + * minibuffer.el (completion-all-sorted-completions): Delete duplicates. + (minibuffer-force-complete-and-exit): New command. + (minibuffer--complete-and-exit): New function extracted from + minibuffer-complete-and-exit. + (minibuffer-complete-and-exit): Use it. + + * progmodes/etags.el (visit-tags-table-buffer): Give a more precise + error message when the file doesn't exist (bug#12974). + +2012-11-29 Kelly Dean <kellydeanch@yahoo.com> (tiny change) + + * simple.el (activate-mark): Run activate-mark-hook (bug#13027). + +2012-11-29 Glenn Morris <rgm@gnu.org> + + * files.el (hack-dir-local-variables): Warn if try to set + coding via dir-locals, since it doesn't work. (Bug#7169) + + Add desktop support for restoring vc-dir buffers. (Bug#10606) + * vc/vc-dir.el (vc-dir-mode): Autoload it (for desktop restore). + Set buffer-local value of desktop-save-buffer. + (vc-dir-desktop-buffer-misc-data, vc-dir-restore-desktop-buffer): + New functions. + (desktop-buffer-mode-handlers): Add vc-dir-mode entry. + * desktop.el (desktop-save-buffer-p): Treat vc-dir like dired. + + * files.el (inhibit-local-variables-ignore-case): New. (Bug#10610) + (inhibit-local-variables-p): Use inhibit-local-variables-ignore-case. + Doc fix. + (inhibit-local-variables-regexps, inhibit-local-variables-suffixes): + Doc fixes. + +2012-11-28 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc-forms.el (calc-date-notation): Fix regexp + used to find time codes. Fix symbol for seconds. + +2012-11-27 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/derived.el (derived-mode-make-docstring): + Don't mention "abbrev" or "syntax" if nil. (Bug#11277) + 2012-11-27 Stefan Monnier <monnier@iro.umontreal.ca> * textmodes/table.el (table-insert): Don't use `symbol-name' on lexically scoped variables (bug#13005). -2012-11-26 Glenn Morris <rgm@gnu.org> +2012-11-27 Glenn Morris <rgm@gnu.org> * vc/vc-hooks.el (vc-mistrust-permissions): Default to t, to avoid data-loss. (Bug#11490) -2012-11-26 Fabián Ezequiel Gallina <fgallina@cuca> +2012-11-27 Fabián Ezequiel Gallina <fgallina@cuca> * progmodes/python.el (python-indent-guess-indent-offset): If indentation is guessed make python-indent-offset buffer-local. @@ -356,45 +1994,115 @@ Fix forward movement when statement(s) separates point from defun. (python-imenu-prev-index-position): New function. -2012-11-26 Eli Zaretskii <eliz@gnu.org> +2012-11-27 Eli Zaretskii <eliz@gnu.org> * subr.el (buffer-file-type): Declare with defvar-local. Doc fix. * dos-w32.el (find-file-not-found-set-buffer-file-coding-system): Don't set buffer-file-type. Return nil. (Bug#12989) -2012-11-26 Glenn Morris <rgm@gnu.org> +2012-11-27 Glenn Morris <rgm@gnu.org> * hippie-exp.el (hippie-expand-try-functions-list): Re-autoload it. (Bug#12982) -2012-11-25 Eli Zaretskii <eliz@gnu.org> +2012-11-27 Eli Zaretskii <eliz@gnu.org> * descr-text.el (describe-char-padded-string): Call internal-char-font only on GUI frames. (Bug#11964) -2012-11-24 Andreas Schwab <schwab@linux-m68k.org> +2012-11-27 Andreas Schwab <schwab@linux-m68k.org> * buff-menu.el (Buffer-menu-buffer+size-width): Fix customize type and obsoletion message. -2012-11-24 Stefan Monnier <monnier@iro.umontreal.ca> +2012-11-27 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/cl-macs.el (cl--transform-lambda): Add back `declare' in the constructs to keep outside of the `cl-block' (bug#12977). -2012-11-24 Chong Yidong <cyd@gnu.org> +2012-11-27 Chong Yidong <cyd@gnu.org> * mouse.el (mouse-drag-line): Even if the line is not draggable, keep reading until we get the up-event anyway, in order to process the up-event for mouse-1-click-follows-link (Bug#12971). -2012-11-23 Stefan Monnier <monnier@iro.umontreal.ca> +2012-11-26 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/advice.el (ad-should-compile): Don't compile advice if the + base function is not yet defined (bug#12965). + (ad-activate-advised-definition): Use ad-compile-function. + (ad-activate): Use cond. + +2012-11-25 Leo Liu <sdl.web@gmail.com> + + * textmodes/sgml-mode.el (sgml-tag): Fix indentation for closing tag. + (Bug#12979) + +2012-11-24 Vincent Belaïche <vincentb1@users.sourceforge.net> + + * textmodes/reftex-parse.el (reftex-parse-from-file): Use variable + reftex-section-info-function in order to be compatible with + Texinfo integration. + + * textmodes/reftex.el (reftex-section-pre-regexp) + (reftex-section-post-regexp, reftex-section-info-function): + New variable. + (reftex-compile-variables): Use variables reftex-section-pre-regexp, + reftex-section-post-regexp, and reftex-section-info-function in order + to be compatible with Texinfo integration. + + * textmodes/reftex-toc.el (reftex-toc-promote-action): + use reftex-section-pre-regexp variable in order to be compatible with + Texinfo integration. + +2012-11-25 Chong Yidong <cyd@gnu.org> + + * faces.el: Make face-spec-set more analogous to setq. + (face-spec-set): Change the third arg to specify whether this + function is being called via defface, customize, or a third party. + Set the appropriate symbol properties. Clear the override spec if + setting via Custom. Initialize face if necessary. (Bug#4988) + (face-spec-recalc): Allow theme faces to completely replace the + defface spec, in the same way as custom faces (Bug#8454). + + * cus-face.el (custom-declare-face): Move face initialization to + face-spec-set. + (custom-theme-set-faces): Don't initialize the face name here, as + that is now done in face-spec-set. + + * cus-edit.el (custom-face-set, custom-face-mark-to-save) + (custom-face-reset-saved, custom-face-mark-to-reset-standard): + Simplify by using the new arg to face-spec-set. + + * emacs-lisp/lisp-mode.el (eval-defun-1): When evaluating defface, + reset face-override-spec too, and use custom-declare-face. + +2012-11-24 Jan Djärv <jan.h.d@swipnet.se> + + * term/ns-win.el (ns-initialize-window-system): Move creation of + fontsets here (Bug#11964). + +2012-11-24 Vincent Belaïche <vincentb1@users.sourceforge.net> + + * ses.el (ses-rename-cell): Correct bug on mode-line update after + cell renaming. + +2012-11-24 Chong Yidong <cyd@gnu.org> + + * woman.el (woman-default-faces, woman-monochrome-faces): Mark as + obsolete. + + * custom.el (custom-theme-set-variables): Use a topological sort + for ordering by custom dependencies (Bug#12952). + (custom--sort-vars, custom--sort-vars-1): New functions. + +2012-11-24 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/bytecomp.el (byte-compile-file): Setup default value for lexical-binding (bug#12938). -2012-11-23 Wolfgang Jenkner <wjenkner@inode.at> +2012-11-24 Wolfgang Jenkner <wjenkner@inode.at> * image-mode.el (image-transform-check-size): Use assertions only for images of type imagemagick. @@ -402,11 +2110,11 @@ Otherwise no error, image-transform-fit-to-{width,height} is silently ignored, as before. Doc fix. -2012-11-23 Chong Yidong <cyd@gnu.org> +2012-11-24 Chong Yidong <cyd@gnu.org> * faces.el (color-defined-p): Doc fix (Bug#12853). -2012-11-23 Juri Linkov <juri@jurta.org> +2012-11-24 Juri Linkov <juri@jurta.org> * dired.el (dired-mark): Add optional arg `interactive'. Check for `use-region-p' if `interactive' is non-nil. @@ -414,8 +2122,6 @@ `interactive'. Call `dired-mark' with the arg `interactive'. (Bug#10624) -2012-11-23 Juri Linkov <juri@jurta.org> - * wdired.el: Revert 2012-10-17 change partly and replace it with Patch by Christopher Schmidt <christopher@ch.ristopher.com>. (wdired-finish-edit): Add marks for new file names to @@ -424,7 +2130,7 @@ (wdired-do-renames): Remove calls to `dired-remove-file', `dired-add-file', `dired-add-entry'. (Bug#11795) -2012-11-21 Alan Mackenzie <acm@muc.de> +2012-11-24 Alan Mackenzie <acm@muc.de> * progmodes/cc-defs.el (c-version): Bump to 5.32.4. @@ -443,26 +2149,59 @@ Call c-invalidate-state-cache from `c-before-change' instead of `c-after-change'. -2012-11-20 Daniel Colascione <dancol@dancol.org> +2012-11-23 Chong Yidong <cyd@gnu.org> - * term/w32-win.el (cygwin-convert-path-from-windows): - Accomodate rename of cygwin_convert_path* to cygwin_convert_file_name*. - This change is a backport from trunk. + * find-cmd.el (find-constituents): Add executable, ipath, + readable, samefile, writable, daystart, regextype (Bug#12856). -2012-11-20 Eli Zaretskii <eliz@gnu.org> +2012-11-23 Stefan Monnier <monnier@iro.umontreal.ca> - * simple.el (line-move): Don't call line-move-partial if - scroll-conservatively is in effect. (Bug#12927) + * emacs-lisp/ert.el, emacs-lisp/ert-x.el: Use cl-lib and lexical-binding. -2012-11-20 Michael Albinus <michael.albinus@gmx.de> +2012-11-22 Paul Eggert <eggert@cs.ucla.edu> - * net/trampver.el (tramp-version): Downgrade to 2.2.6-24.3, in - order to distinguish from trunk. + * calc/calc.el (calc-gregorian-switch): Move to after calc-refresh + definition. This fixes a bootstrap failure. + (calc-gregorian-switch): In menu, put dates before regions. + This is easier to follow, lines up better in the menu, and lets us + coalesce regions that switch at the same time. Give country + names, not "Vatican", as that's better for non-expert users. + Use names that are stable between the date of switch and now, e.g., + Bohemia and Moravia (which existed then and now) and not + Czechoslovakia (which didn't exist then and doesn't exist now). + What is now the U.S. mostly did not switch at the same time as + Britain, so omit the U.S. Correct spelling of "Britain". + Catholic Switzerland was too much of a mess, so omit it. -2012-11-19 Stefan Monnier <monnier@iro.umontreal.ca> +2012-11-22 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc.el (calc-gregorian-switch): Refresh the Calc buffer + after the variable is changed. + +2012-11-21 Daniel Colascione <dancol@dancol.org> + + * progmodes/sql.el (sql-mode-font-lock-object-name): Support IF NOT EXISTS + in SQL declarations for font-lock. + (sql-imenu-generic-expression): Teach imenu about IF NOT EXISTS. + +2012-11-21 Glenn Morris <rgm@gnu.org> + + * faces.el (face-underline-p, face-inverse-video-p, face-bold-p) + (face-italic-p): Add optional argument "inherit". + + * faces.el (set-face-inverse-video, set-face-bold, set-face-italic): + Remove -p suffix from names, for consistency with other set-face-*. + (set-face-inverse-video): Fix interactive spec. + * play/gamegrid.el (gamegrid-make-mono-tty-face): + * textmodes/table.el (table--update-cell-face): + Use set-face-inverse-video rather than now obsolete alias. + +2012-11-21 Eli Zaretskii <eliz@gnu.org> + + * simple.el (line-move): Don't call line-move-partial if + scroll-conservatively is in effect. (Bug#12927) - * emacs-lisp/byte-run.el (defun-declarations-alist): Don't accept - non-symbols for compiler macros (yet). +2012-11-21 Stefan Monnier <monnier@iro.umontreal.ca> * eshell/em-cmpl.el (eshell-pcomplete): Refine fix for bug#12838: Fallback on completion-at-point rather than @@ -473,17 +2212,17 @@ * emacs-lisp/ert.el (ert--expand-should-1): Adapt to cl-lib. -2012-11-19 Michael Albinus <michael.albinus@gmx.de> +2012-11-21 Michael Albinus <michael.albinus@gmx.de> * net/tramp-sh.el (tramp-do-copy-or-rename-file): If both files are remote, check out-of-band property for both. -2012-11-19 Stefan Monnier <monnier@iro.umontreal.ca> +2012-11-21 Stefan Monnier <monnier@iro.umontreal.ca> * window.el (switch-to-buffer): Re-add the warning that was lost in the code rewrite. -2012-11-18 Paul Eggert <eggert@cs.ucla.edu> +2012-11-21 Paul Eggert <eggert@cs.ucla.edu> More minor time fixes. * calendar/time-date.el: Commentary fix. @@ -500,27 +2239,114 @@ * ps-bdf.el (bdf-file-newer-than-time): Process four-integers time stamps, not two. Doc fixes. +2012-11-20 Stefan Monnier <monnier@iro.umontreal.ca> + + * uniquify.el (uniquify-managed): Use defvar-local. + (rename-buffer, create-file-buffer): Advise with advice-add. + (uniquify-unload-function): Unadvise accordingly. + + * emacs-lisp/trace.el: Rewrite, use nadvice and lexical-binding. + (trace-buffer): Don't purecopy. + (trace-entry-message, trace-exit-message): Add `context' arg. + (trace--timer): New var. + (trace-make-advice): Adjust for use in nadvice. + Add `context' argument. Delay `display-buffer' via a timer. + (trace-function-internal): Use advice-add. + (trace--read-args): New function. + (trace-function-foreground, trace-function-background): Use it. + (trace-function): Rename to trace-function-foreground and redefine as + an alias to that new name. + (untrace-function, untrace-all): Adjust to the use of nadvice. + + * emacs-lisp/bytecomp.el (byte-compile): Fix handling of closures. + + * emacs-lisp/byte-run.el (defun-declarations-alist): Fix last change. + + * subr.el (called-interactively-p-functions): New var. + (internal--called-interactively-p--get-frame): New macro. + (called-interactively-p, interactive-p): Rewrite in Lisp. + * emacs-lisp/nadvice.el (advice--called-interactively-skip): New fun. + (called-interactively-p-functions): Use it. + * emacs-lisp/edebug.el (edebug--called-interactively-skip): New fun. + (called-interactively-p-functions): Use it. + * allout.el (allout-called-interactively-p): Don't assume + called-interactively-p is a subr. + +2012-11-20 Glenn Morris <rgm@gnu.org> + + * profiler.el (profiler-report-mode-map): Add a menu. + No need to bind `q' because we derive from special-mode. + (profiler-report-find-entry): Handle calls from the menu-bar. + +2012-11-19 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/byte-run.el (defun-declarations-alist): + Allow a compiler-macro to be a lambda expression. + + * progmodes/python.el: Use cl-lib. Move var declarations outside of + eval-when-compile. + (python-syntax-context): Add compiler-macro. + (python-font-lock-keywords): Simplify with De Morgan. + + * vc/diff-mode.el (diff-hunk): Don't make useless timers. + + * files.el (load-file): Require match in minibuffer selection, as was + the case in Emacs-20 before we changed the spec to allow .elc files + (bug#12935). + + * json.el: Don't require cl since we don't use it. + * color.el: Don't require cl. + (color-complement): `caddr' -> `nth 2'. + + * calendar/time-date.el (time-to-seconds): De-obsolete. + +2012-11-19 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc-forms.el (math-leap-year-p): Fix formula for negative + year numbers. + (math-date-to-julian-dt): Adjust the initial approximation for the + year to deal with the new definition of the DATE. + +2012-11-19 Daniel Colascione <dancol@dancol.org> + + * term/w32-win.el (cygwin-convert-path-from-windows): + Accomodate rename of cygwin_convert_path* to cygwin_convert_file_name*. + +2012-11-18 Chong Yidong <cyd@gnu.org> + + * filecache.el (file-cache--read-list): New function. + (file-cache-add-directory-list, file-cache-add-file-list) + (file-cache-delete-file-list, file-cache-delete-directory-list): + Use it to read a list of files or directories (Bug#12846). + (file-cache-add-file, file-cache-add-directory) + (file-cache-delete-file-list, file-cache-delete-file-regexp) + (file-cache-delete-directory): Print an message. + +2012-11-18 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc-forms.el (math-date-to-dt): Use integer date when + calling `math-date-to-julian-dt' and 'math-date-to-gregorian-dt'. + 2012-11-18 Glenn Morris <rgm@gnu.org> * image.el (insert-image, insert-sliced-image): Doc fix. -2012-11-17 Chong Yidong <cyd@gnu.org> +2012-11-18 Chong Yidong <cyd@gnu.org> * emacs-lisp/syntax.el (syntax-propertize-function): Doc fix (Bug#12810). -2012-11-17 OKAZAKI Tetsurou <okazaki.tetsurou@gmail.com> (tiny change) +2012-11-18 OKAZAKI Tetsurou <okazaki.tetsurou@gmail.com> (tiny change) * vc/vc-svn.el (vc-svn-merge-news): Properly parse the merge response when the target file is in a subdirectory (Bug#12757). -2012-11-17 Chong Yidong <cyd@gnu.org> +2012-11-18 Chong Yidong <cyd@gnu.org> * filecache.el (file-cache-add-file-list): Doc fix (Bug#12694). -2012-11-17 Glenn Morris <rgm@gnu.org> +2012-11-18 Glenn Morris <rgm@gnu.org> - * woman.el (woman-non-underline-faces): * emacs-lisp/cl-lib.el (face-underline-p): Use set-face-underline rather than the alias set-face-underline-p. @@ -528,8 +2354,94 @@ * subr.el (with-output-to-temp-buffer): Add doc xref to with-temp-buffer-window. +2012-11-18 Juanma Barranquero <lekktu@gmail.com> + + * woman.el (woman-non-underline-faces): Use `set-face-underline'. + * calc/calc.el (math-format-date-cache): Declare. + +2012-11-17 Paul Eggert <eggert@cs.ucla.edu> + + Calc by default uses the Gregorian calendar for all dates (Bug#12633). + It also uses January 1, 1 AD as its day number 1. + * calc/calc-forms.el (math-julian-date-beginning) + (math-julian-date-beginning-int): Implement this. + +2012-11-17 Juanma Barranquero <lekktu@gmail.com> + + * descr-text.el (quail-find-key): + * dired.el (desktop-file-name): + * dirtrack.el (shell-prefixed-directory-name, shell-process-cd): + * generic-x.el (comint-mode, comint-exec): + * image-dired.el (widget-forward): + * info.el (speedbar-add-expansion-list, speedbar-center-buffer-smartly) + (speedbar-change-expand-button-char) + (speedbar-change-initial-expansion-list, speedbar-delete-subblock) + (speedbar-make-specialized-keymap, speedbar-make-tag-line): + * printing.el (easy-menu-add-item, easy-menu-remove-item) + (widget-field-action, widget-value-set): + * speedbar.el (imenu--make-index-alist): + * term.el (ring-empty-p, ring-ref, ring-insert-at-beginning) + (ring-length, ring-insert): + * vcursor.el (compare-windows-skip-whitespace): + * woman.el (dired-get-filename): + Declare functions. + + * term/w32-win.el (cygwin-convert-path-from-windows): Fix declaration. + +2012-11-17 Jay Belanger <jay.p.belanger@gmail.com> + + * calc/calc.el (calc-gregorian-switch): New variable. + + * calc/calc-forms.el (math-day-in-year, math-dt-before-p) + (math-absolute-from-gregorian-dt, math-absolute-from-julian-dt) + (math-date-to-julian-dt, math-date-to-gregorian-dt): New functions. + (math-leap-year-p): Add option to distinguish between Julian + and Gregorian calendars. + (math-day-number): Use `math-day-in-year' to do the computations. + (math-absolute-from-dt): Rename from `math-absolute-from-date'. + Use `math-absolute-from-gregorian' and `math-absolute-from-julian' + to do the computations. + (math-date-to-dt): Use `math-date-to-julian-dt' and + `math-date-to-gregorian-dt' to do the computations. + (calcFunc-weekday, math-format-date-part): Use the new version of + the DATE to determine the weekday. + (calcFunc-newmonth, calcFunc-newyear): Use `calc-gregorian-switch' + when necessary. + +2012-11-17 Eli Zaretskii <eliz@gnu.org> + + * term/w32-win.el (w32-handle-dropped-file): Use 'file://' only on + Cygwin; otherwise use 'file:'. (Bug#12914) + (cygwin-convert-path-from-windows): Declare, to avoid + byte-compiler warnings. + +2012-11-17 Andreas Politz <politza@fh-trier.de> + + * ibuffer.el (ibuffer-mark-forward, ibuffer-unmark-forward) + (ibuffer-unmark-backward, ibuffer-mark-interactive): Support plain + prefix and negative numeric prefix args (Bug#12795). + +2012-11-17 Stephen Berman <stephen.berman@gmx.net> + + * play/gamegrid.el (gamegrid-add-score-with-update-game-score-1): + Don't signal an error with a score that is too low to add to the + list of top scores. (Bug#12779) + +2012-11-17 Chong Yidong <cyd@gnu.org> + + * help-mode.el (help-xref-interned): End on point-min (Bug#12737). + + * filecache.el (file-cache-add-file): Handle relative file name in + the argument (Bug#12694). + +2012-11-16 Jürgen Hötzel <juergen@archlinux.org> (tiny change) + + * eshell/em-unix.el (eshell/mkdir): Handle "--parents" (bug#12897). + 2012-11-16 Stefan Monnier <monnier@iro.umontreal.ca> + * emacs-lisp/advice.el (ad-make-advised-definition): Improve last fix. + * emacs-lisp/cl-lib.el: Set more meaningful version number. 2012-11-16 Martin Rudalics <rudalics@gmx.at> @@ -552,15 +2464,15 @@ * faces.el (face-underline-p): Use face-attribute-specified-or. -2012-11-15 Juanma Barranquero <lekktu@gmail.com> +2012-11-16 Juanma Barranquero <lekktu@gmail.com> * emacs-lisp/cl-macs.el (cl-loop, cl-do, cl-do*): Doc fixes. -2012-11-15 Stefan Monnier <monnier@iro.umontreal.ca> +2012-11-16 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/cl-macs.el (cl-flet, cl-flet*): Fix docstring (bug#12895). -2012-11-15 Glenn Morris <rgm@gnu.org> +2012-11-16 Glenn Morris <rgm@gnu.org> * eshell/em-cmpl.el (eshell-pcomplete): New command. (Bug#12838) (eshell-cmpl-initialize): Bind eshell-pcomplete to TAB, C-i. @@ -576,39 +2488,162 @@ * term.el (ansi-term): Don't let C-x escape-char binding clobber the more standard C-c binding. (Bug#12842) -2012-11-15 Stefan Monnier <monnier@iro.umontreal.ca> - - * emacs-lisp/gv.el (setf): Fix debug spec for multiple assignments - (bug#12879). - -2012-11-14 Glenn Morris <rgm@gnu.org> - * subr.el (set-temporary-overlay-map): Doc fix. -2012-11-13 Martin Rudalics <rudalics@gmx.at> +2012-11-16 Martin Rudalics <rudalics@gmx.at> * window.el (record-window-buffer) (display-buffer-record-window): When copying the markers to window-point preserve window-point-insertion-type. (Bug#12588) -2012-11-13 Glenn Morris <rgm@gnu.org> +2012-11-16 Glenn Morris <rgm@gnu.org> * emacs-lisp/eieio-datadebug.el (eieio-debug-methodinvoke): * net/tramp-gvfs.el (tramp-gvfs-dbus-event-error): Use new names for hooks rather than obsolete aliases. -2012-11-12 Stefan Monnier <monnier@iro.umontreal.ca> +2012-11-15 Daniel Colascione <dancol@dancol.org> + + * term/w32-win.el (w32-handle-dropped-file): Use a "file://" + prefix instead of "file:" so that when FILE-NAME begins with "//", + as it does when the target file is on a network share, url-handler + isn't confused. + +2012-11-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/advice.el (ad-definition-type): Make sure we don't use + a preactivated advice from an old advice.el; they're not compatible! + +2012-11-15 Katsumi Yamaoka <yamaoka@jpl.org> + + * emacs-lisp/nadvice.el (advice--make-interactive-form): + Fix string-spec case. + + * emacs-lisp/advice.el (ad-make-advised-definition): Fix undefined case. + +2012-11-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/nadvice.el: Add buffer-local support to add-function. + (advice--buffer-local-function-sample): New var. + (advice--set-buffer-local, advice--buffer-local): New functions. + (add-function, remove-function): Use them. + +2012-11-15 Drew Adams <drew.adams@oracle.com> + + * imenu.el (imenu--split-submenus): Use imenu--subalist-p (bug#12717). + +2012-11-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/cl-macs.el (cl--transform-lambda): Defend against + potential binding of print-gensym to t, and prettify (back)quotes in + case they appear in args's default values (bug#12884). + +2012-11-14 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/nadvice.el: Add around advice for interactive specs. + (advice-eval-interactive-spec): New function. + (advice--make-interactive-form): Support around advice (bug#12844). + +2012-11-14 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/ruby-mode.el (ruby-expr-beg): Make heredoc detection + more strict. Add docstring. + (ruby-expression-expansion-re): Extract from + `ruby-match-expression-expansion'. + (ruby-syntax-propertize-function): After everything else, search + for expansions in string literals, mark their insides as + whitespace syntax and save match data for font-lock. + (ruby-font-lock-keywords): Use the 2nd group from expression + expansion matches. + (ruby-match-expression-expansion): Use the match data saved to the + text property in ruby-syntax-propertize-function. + +2012-11-14 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/gv.el (setf): Fix debug spec for multiple assignments + (bug#12879). + +2012-11-13 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/ruby-mode.el (ruby-move-to-block): Looks for a block + start/end keyword a bit harder. Works with different values of N. + Add more comments. + (ruby-end-of-block): Update accordingly. + +2012-11-13 Stefan Monnier <monnier@iro.umontreal.ca> + + * woman.el (woman-file-name): Don't mess with unread-command-events + (bug#12861). + + * emacs-lisp/advice.el: Layer on top of nadvice.el. + Remove out of date self-require hack. + (ad-do-advised-functions): Use simple `dolist'. + (ad-advice-name, ad-advice-protected, ad-advice-enabled) + (ad-advice-definition): Redefine as functions. + (ad-advice-classes): Move before first use. + (ad-make-origname, ad-set-orig-definition, ad-clear-orig-definition) + (ad-make-mapped-call, ad-make-advised-docstring,ad-make-plain-docstring) + (ad--defalias-fset): Remove functions. + (ad-make-advicefunname, ad-clear-advicefunname-definition): New funs. + (ad-get-orig-definition): Rewrite. + (ad-make-advised-definition-docstring): Change base docstring. + (ad-real-orig-definition): Rewrite. + (ad-map-arglists): Change name of called function. + (ad--make-advised-docstring): Redirect `function' from ad-Advice-... + (ad-make-advised-definition): Simplify. + (ad-assemble-advised-definition): Tweak for new calling context. + (ad-activate-advised-definition): Setup ad-Advice-* i.s.o ad-Orig-*. + (ad--defalias-fset): Rename from ad-handle-definition. Make it set the + function and call ad-activate if needed. + (ad-activate, ad-deactivate): Don't call ad-handle-definition any more. + (ad-recover): Clear ad-Advice-* instead of ad-Orig-*. + (ad-compile-function): Compile ad-Advice-*. + (ad-activate-on-top-level, ad-with-auto-activation-disabled): Remove. + (ad-start-advice, ad-stop-advice): Remove. + +2012-11-13 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/ruby-mode.el (ruby-add-log-current-method): Print the + period before class method names, not after. Remove handling of + one impossible case. Add comments. + +2012-11-13 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/advice.el: Remove support for freezing. + (ad-make-freeze-docstring, ad-make-freeze-definition): Remove functions. + (ad-make-single-advice-docstring, ad-defadvice-flags, defadvice): + Remove support for `freeze'. + + * emacs-lisp/cl.el (dolist, dotimes, declare): Use advice-add to + override the default. + * emacs-lisp/cl-macs.el (cl-dolist, cl-dotimes): Rewrite without using + cl--dotimes/dolist. + * subr.el (dolist, dotimes, declare): Redefine them normally, even when + `cl' is loaded. + + * emacs-lisp/nadvice.el (advice--normalize): New function, extracted + from add-advice. + (advice--strip-macro): New function. + (advice--defalias-fset): Use them to handle macros. + (advice-add): Use them. + (advice-member-p): Correctly handle macros. + +2012-11-13 Dmitry Gutov <dgutov@yandex.ru> + + * progmodes/ruby-mode.el (ruby-font-lock-keywords): + Never font-lock the beginning of singleton class as heredoc. + +2012-11-13 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/gv.el (gv-define-simple-setter): One more fix (bug#12871). -2012-11-12 Wolfgang Jenkner <wjenkner@inode.at> +2012-11-13 Wolfgang Jenkner <wjenkner@inode.at> * ansi-color.el (ansi-color-apply-sequence): Implement SGR codes - 39 and 49. This fixes bug#12792. Also, treat unimplemented - parameters as 0, thereby restoring the behavior of revisions prior - to 2012-08-15T03:33:55Z!monnier@iro.umontreal.ca. + 39 and 49 (bug#12792). Also, treat unimplemented parameters as 0, + thereby restoring the behavior of revisions prior to 2012-08-15T03:33:55Z!monnier@iro.umontreal.ca. -2012-11-12 Fabián Ezequiel Gallina <fgallina@cuca> +2012-11-13 Fabián Ezequiel Gallina <fgallina@cuca> Fix end-of-defun misbehavior. * progmodes/python.el (python-nav-beginning-of-defun): Rename from @@ -620,19 +2655,19 @@ with new fixed python-nav-{end,beginning}-of-defun. Stop scanning parent defuns as soon as possible. -2012-11-12 Glenn Morris <rgm@gnu.org> +2012-11-13 Glenn Morris <rgm@gnu.org> * progmodes/flymake.el (flymake-error-bitmap) (flymake-warning-bitmap, flymake-fringe-indicator-position): Doc fixes. (flymake-error-bitmap, flymake-warning-bitmap): Fix :types. -2012-11-12 Dmitry Gutov <dgutov@yandex.ru> +2012-11-13 Dmitry Gutov <dgutov@yandex.ru> * progmodes/ruby-mode.el (ruby-move-to-block): When moving backward, always stop at indentation. Reverts the change from 2012-08-12T22:06:56Z!monnier@iro.umontreal.ca (Bug#12851). -2012-11-11 Glenn Morris <rgm@gnu.org> +2012-11-13 Glenn Morris <rgm@gnu.org> * ibuffer.el (ibuffer-mode-map, ibuffer-mode): Add ibuffer-filter-by-derived-mode. @@ -648,13 +2683,51 @@ * window.el (fit-frame-to-buffer, fit-frame-to-buffer-bottom-margin): * emacs-lisp/debug.el (debugger-bury-or-kill): Fix :version. -2012-11-10 Leo Liu <sdl.web@gmail.com> +2012-11-12 Stefan Monnier <monnier@iro.umontreal.ca> - * ido.el (ido-set-matches-1): Fix split-string args to avoid - performance issue. (Bug#12796) + * emacs-lisp/nadvice.el: New package. + * subr.el (special-form-p): New function. + * emacs-lisp/elp.el: Use lexical-binding and advice-add. + (elp-all-instrumented-list): Remove var. + (elp-not-profilable): Remove elp-wrapper. + (elp-profilable-p): Use autoloadp and special-form-p. + (elp--advice-name): New const. + (elp-instrument-function): Use advice-add. + (elp--instrumented-p): New predicate. + (elp-restore-function): Use advice-remove. + (elp-restore-all, elp-reset-all): Use mapatoms. + (elp-set-master): Use elp--instrumented-p. + (elp--make-wrapper): Rename from elp-wrapper, return a function + suitable for advice-add. Use cl-inf. + (elp-results): Use mapatoms+elp--instrumented-p. + * emacs-lisp/debug.el: Use lexical-binding and advice-add. + (debug-function-list): Remove var. + (debug): Rename arg, and then let-bind it explicitly inside. + (debugger-setup-buffer): Rename arg. + (debugger-setup-buffer): Adjust counts to new debug-on-entry setup. + (debugger-frame-number): Adjust to new debug-on-entry setup. + (debug--implement-debug-on-entry): Rename from + implement-debug-on-entry, add argument. + (debugger-special-form-p): Remove, use special-form-p instead. + (debug-on-entry): Use advice-add. + (debug--function-list): New function. + (cancel-debug-on-entry): Use it, along with advice-remove. + (debug-arglist, debug-convert-byte-code, debug-on-entry-1): Remove. + (debugger-list-functions): Use debug--function-list instead of + debug-function-list. + * emacs-lisp/advice.el (ad-save-real-definition): Remove, unused. + (ad-special-form-p): Remove, use special-form-p instead. + (ad-set-advice-info): Use add-function and remove-function. + (ad--defalias-fset): Adjust accordingly. 2012-11-10 Glenn Morris <rgm@gnu.org> + * mail/emacsbug.el (report-emacs-bug-tracker-url) + (report-emacs-bug-bug-alist, report-emacs-bug-choice-widget) + (report-emacs-bug-create-existing-bugs-buffer) + (report-emacs-bug-parse-query-results) + (report-emacs-bug-query-existing-bugs): Remove. (Bug#7449) + * term.el (term-default-fg-color, term-default-bg-color): Make obsolete, rather than just saying "deprecated" in the doc. @@ -663,46 +2736,42 @@ (term-default-fg-color, term-default-bg-color, term-ansi-reset): Update all users. -2012-11-09 Jan Djärv <jan.h.d@swipnet.se> - - * server.el (server-create-window-system-frame): Improve comment. - -2012-11-08 Jan Djärv <jan.h.d@swipnet.se> +2012-11-10 Jan Djärv <jan.h.d@swipnet.se> * server.el (server-create-window-system-frame): Handle Nextstep specially (Bug#12780). -2012-11-08 Glenn Morris <rgm@gnu.org> +2012-11-10 Glenn Morris <rgm@gnu.org> * mail/emacsbug.el (report-emacs-bug-query-existing-bugs): Unautoload, and make obsolete. (Bug#7449) -2012-11-08 Chong Yidong <cyd@gnu.org> +2012-11-10 Chong Yidong <cyd@gnu.org> * vc/diff-mode.el (diff-delete-trailing-whitespace): Rewrite, and rename from diff-remove-trailing-whitespace (Bug#12831). -2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca> +2012-11-10 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/advice.el: Require `cl-lib' at run-time to fix miscompilation of trace.el. -2012-11-08 Glenn Morris <rgm@gnu.org> +2012-11-10 Glenn Morris <rgm@gnu.org> * vc/diff-mode.el (diff-remove-trailing-whitespace): Doc fix. -2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca> +2012-11-10 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/gv.el (gv-define-simple-setter): Fix last change (bug#12812). -2012-11-07 Chong Yidong <cyd@gnu.org> +2012-11-10 Chong Yidong <cyd@gnu.org> * minibuf-eldef.el (minibuffer-eldef-shorten-default): Convert to a defcustom with an appropriate :set function. (minibuffer-default--in-prompt-regexps): New function. -2012-11-07 Glenn Morris <rgm@gnu.org> +2012-11-10 Glenn Morris <rgm@gnu.org> * emacs-lisp/cl.el (define-setf-expander, defsetf) (define-modify-macro): Doc fixes. @@ -710,7 +2779,7 @@ * emacs-lisp/gv.el (gv-letplace): Fix doc typo. (gv-define-simple-setter): Update doc of `fix-return'. -2012-11-07 Stefan Monnier <monnier@iro.umontreal.ca> +2012-11-10 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/gv.el (gv-define-simple-setter): Don't evaluate `val' twice when `fix-return' is set (bug#12813). @@ -718,17 +2787,13 @@ * emacs-lisp/cl.el (defsetf): Pass the third arg to gv-define-simple-setter (bug#12812). -2012-11-06 Stefan Monnier <monnier@iro.umontreal.ca> - * woman.el (woman-decode-region): Disable adaptive-fill when rendering (bug#12756). -2012-11-06 Glenn Morris <rgm@gnu.org> +2012-11-10 Glenn Morris <rgm@gnu.org> * emacs-lisp/gv.el (gv-define-setter): Fix doc typo. -2012-11-05 Glenn Morris <rgm@gnu.org> - * emacs-lisp/cl-extra.el (cl-prettyexpand): * emacs-lisp/cl-lib.el (cl-proclaim, cl-declaim): * emacs-lisp/cl-macs.el (cl-destructuring-bind, cl-locally) @@ -736,6 +2801,178 @@ * emacs-lisp/cl-extra.el (cl-maplist, cl-mapcan): Doc fix. +2012-11-10 Leo Liu <sdl.web@gmail.com> + + * ido.el (ido-set-matches-1): Improve flex matching performance by + removing backtracking in the regexp (suggested by Stefan). (Bug#12796) + +2012-11-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/advice.el (ad-set-advice-info): Set defalias-fset-function. + (ad--defalias-fset): New function. + (ad-safe-fset): Remove. + (ad-make-freeze-definition): Use cl-letf*. + +2012-11-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * subr.el (dolist): Don't bind VAR in RESULT. + + * emacs-lisp/advice.el: Miscellaneous cleanup. Use lexical-binding. + (fset, documentation): Don't save real def since we don't advise. + (ad-do-advised-functions): Remove problematic `result-form'. + (ad-safe-fset): `ad-real-fset' => `fset'. + (ad-read-advised-function): Don't assume that ad-do-advised-functions + uses CL's dolist internally. + (ad-arglist): Remove unused arg `name'. + (ad-docstring, ad-make-advised-docstring): + `ad-real-documentation' => `documentation'. + (warning-suppress-types): Declare. + (ad-set-arguments): Simple CSE. + (ad-recover-normality): Sanity check. + + * emacs-lisp/bytecomp.el (byte-compile-out-toplevel): Don't turn + (funcall '(lambda ..) ..) into ((lambda ..) ..). + +2012-11-09 Vincent Belaïche <vincentb1@users.sourceforge.net> + + * ses.el: symbol to coordinate mapping is made by symbol property + `ses-cell'. This means that the same mapping is done for all SES + sheets. That is good enough for cells with standard A1 names, but + not for named cell. So a hash map is added for the latter. + (defconst ses-localvars): Add local variable ses--named-cell-hashmap + (ses-sym-rowcol): Use hashmap for named cell. + (ses-is-cell-sym-p): New defun. + (ses-decode-cell-symbol): New defun. + (ses-create-cell-variable): Add cell to hashmap when name is not + A1-like. + (ses-rename-cell): Check that cell new name is not already in + spreadsheet with the use of ses-is-cell-sym-p + (ses-rename-cell): Use hash map for named cells, but accept also + renaming back to A1-like. + +2012-11-09 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/advice.el: Use new dynamic docstrings. + (ad-make-advised-definition-docstring, ad-advised-definition-p): + Use dynamic-docstring-function instead of ad-advice-info. + (ad--make-advised-docstring): New function extracted from + ad-make-advised-docstring. + (ad-make-advised-docstring): Use it. + * progmodes/sql.el (sql--make-help-docstring): New function, extracted + from sql-help. + (sql-help): Use it with dynamic-docstring-function. + + * env.el (env--substitute-vars-regexp): Don't use rx (for bootstrap). + +2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * files.el (hack-one-local-variable--obsolete): New function. + (hack-one-local-variable): Use it for obsolete settings. + + * subr.el (locate-user-emacs-file): If both old and new name exist, use + the new name. + + * progmodes/js.el (js--filling-paragraph): New var. + (c-forward-sws, c-backward-sws, c-beginning-of-macro): Advise. + (js-c-fill-paragraph): Prefer advice to cl-letf so the rebinding is + less sneaky. + +2012-11-08 Julien Danjou <julien@danjou.info> + + * progmodes/ruby-mode.el (auto-mode-alist): Add Rakefile in + `auto-mode-alist' (Bug#12835). + +2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/perl-mode.el (perl-prettify-symbols): New defcustom. + (perl--prettify-symbols-alist): New const. + (perl--font-lock-compose-symbol, perl--font-lock-symbols-keywords): + New functions. + (perl-font-lock-keywords-2): Use them. + (perl-electric-noindent-p): New function. + (perl-mode): Use it to set up electric-indent-mode. + (perl-electric-terminator, perl-indent-command): Mark obsolete. + (perl-mode-map): Remove bindings for them. + (perl-imenu-generic-expression, perl-outline-level): + Match functions&packages in column>0. + + * env.el (env--substitute-vars-regexp): New const. + (substitute-env-vars): Use it. Add `only-defined' arg. + * net/tramp.el (tramp-replace-environment-variables): Use it. + + * emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment): + Byte-compile *before* eval in eval-and-compile. + (byte-compile-log-warning): Remove redundant inhibit-read-only. + (byte-compile-file-form-autoload): Don't hide actual definition. + (byte-compile-maybe-guarded): Accept `functionp' as well. + + * emacs-lisp/gv.el (gv-ref, gv-deref): New function and macro. + +2012-11-07 Michael Albinus <michael.albinus@gmx.de> + + * notifications.el (notifications-get-server-information-method): + New defconst. + (notifications-get-capabilities): Fix docstring. + (notifications-get-server-information): New defun. + +2012-11-06 AgustÃn MartÃn Domingo <agustin.martin@hispalinux.es> + + * textmodes/ispell.el (ispell-region): Standard re-indent for better + readability. + + * textmodes/ispell.el: Experimental support for support debugging. + (ispell-create-debug-buffer): Create a `ispell-debug-buffer' debug + buffer for ispell. + (ispell-print-if-debug): New function to print stuff to + `ispell-debug-buffer' if debugging is enabled. + (ispell-region, ispell-process-line): Use `ispell-print-if-debug' to + show some debugging info. + (ispell-buffer-with-debug): New function that creates a debugging + buffer and calls `ispell-buffer' with debugging enabled. + + * textmodes/ispell.el (ispell-region): Do not prefix sent string by + comment in autoconf mode. (Bug#12768) + +2012-11-06 Dmitry Antipov <dmantipov@yandex.ru> + + * emacs-lisp/byte-opt.el (toplevel): Add compare-window-configurations, + frame-first-window, frame-root-window, frame-selected-window, + minibuffer-selected-window, minibuffer-window, + window-absolute-pixel-edges, window-at, window-body-height, + window-body-width, window-display-table, window-combination-limit, + window-frame, window-fringes, window-inside-absolute-pixel-edges, + window-inside-edges, window-inside-pixel-edges, window-left-child, + window-left-column, window-margins, window-next-buffers, + window-next-sibling, window-new-normal, window-new-total, + window-normal-size, window-parameter, window-parameters, window-parent, + window-pixel-edges, window-point, window-prev-buffers, + window-prev-sibling, window-redisplay-end-trigger, window-scroll-bars, + window-start, window-text-height, window-top-child, window-top-line, + window-total-height, window-total-width and window-use-time to the list + of functions without side-effects. + (toplevel): Add window-valid-p to the list of error-free functions + without side-effects. + +2012-11-05 AgustÃn MartÃn Domingo <agustin.martin@hispalinux.es> + + * textmodes/ispell.el (ispell-program-name): + Update spellchecker parameters when customized. + +2012-11-04 Glenn Morris <rgm@gnu.org> + + * vc/vc-svn.el (vc-svn-state-heuristic): Avoid calling svn. (Bug#7850) + +2012-11-04 Chong Yidong <cyd@gnu.org> + + * bookmark.el (bookmark-bmenu-switch-other-window): Avoid binding + same-window-* variables. + +2012-11-04 Juri Linkov <juri@jurta.org> + + * isearch.el (isearch-help-for-help, isearch-describe-bindings) + (isearch-describe-key, isearch-describe-mode): Use a display + action instead of binding same-window-* variables (Bug#10040). + 2012-11-03 Glenn Morris <rgm@gnu.org> * emacs-lisp/cl-macs.el (cl-parse-loop-clause): @@ -759,6 +2996,28 @@ * window.el (switch-to-visible-buffer) (switch-to-buffer-preserve-window-point): Fix doc-strings. +2012-11-03 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/cl-lib.el (cl--random-time): + Rename from cl-random-time. (Bug#12773) + (cl--gensym-counter, cl--random-state): Update callers. + * emacs-lisp/cl-extra.el (cl-make-random-state): Update callers. + +2012-11-03 Chong Yidong <cyd@gnu.org> + + * cus-start.el: Make cursor-type customizable (Bug#11633). + +2012-11-02 Glenn Morris <rgm@gnu.org> + + * filecache.el: No need to load find-lisp when compiling. + (find-lisp-find-files): Autoload it. + (file-cache-add-directory-recursively): Don't require find-lisp. + + * image.el (image-type-from-file-name): Trivial simplification. + + * emacs-lisp/bytecomp.el (byte-compile-eval): + Decouple "noruntime" and "cl-functions" warnings. + 2012-11-01 Stephen Berman <stephen.berman@gmx.net> * play/gomoku.el (gomoku-display-statistics): Update mode line @@ -1091,7 +3350,7 @@ 2012-10-19 Stefan Monnier <monnier@iro.umontreal.ca> * minibuffer.el (minibuffer-force-complete): Make the next completion use - the same completion-field (bug@12221). + the same completion-field (bug#12221). 2012-10-19 Martin Rudalics <rudalics@gmx.at> @@ -9989,7 +12248,7 @@ 2012-03-16 Alan Mackenzie <acm@muc.de> - Further optimise the handling of large macros. + Further optimize the handling of large macros. * progmodes/cc-engine.el (c-crosses-statement-barrier-p): Use a limit to a call of `c-literal-limits'. @@ -11257,7 +13516,7 @@ * dynamic-setting.el (font-setting-change-default-font): Don't change the default face if SET-FONT argument is non-nil (Bug#9982). -2012-01-29 Samuel Bronson <naesten@gmail.com> (tiny change) +2012-01-29 Samuel Bronson <naesten@gmail.com> * custom.el (defcustom): Add doc link to Lisp manual (Bug#10635). @@ -11641,7 +13900,7 @@ 2012-01-08 Alan Mackenzie <acm@muc.de> - Optimise font locking in long enum definitions. + Optimize font locking in long enum definitions. * progmodes/cc-fonts.el (c-font-lock-declarations): Add an extra arm to a cond form to handle enums. diff --git a/lisp/ChangeLog.15 b/lisp/ChangeLog.15 index 43ab3f8617d..4d0ff9a40e2 100644 --- a/lisp/ChangeLog.15 +++ b/lisp/ChangeLog.15 @@ -324,7 +324,7 @@ (ert-run-tests-batch, ert--print-test-for-ewoc): Handle `ert-test-quit'. -2011-03-03 David Abrahams <dave@boostpro.com> (tiny change) +2011-03-03 David Abrahams <dave@boostpro.com> * vc/ediff-init.el (ediff-use-faces, ediff-highlight-all-diffs): Move ediff-defvar-local calls after defcustoms. (Bug#1821) @@ -7979,7 +7979,7 @@ Remember the buffers at head, rather than their name. * iswitchb.el (iswitchb-kill-buffer): Re-make the list. -2010-08-22 Kirk Kelsey <kirk.kelsey@0x4b.net> (tiny change) +2010-08-22 Kirk Kelsey <kirk.kelsey@0x4b.net> Stefan Monnier <monnier@iro.umontreal.ca> * progmodes/make-mode.el (makefile-fill-paragraph): Account for the @@ -13597,7 +13597,7 @@ * textmodes/artist.el (artist-compute-popup-menu-table): Remove duplicated words in doc-strings. -2010-01-15 David Abrahams <dave@boostpro.com> (tiny change) +2010-01-15 David Abrahams <dave@boostpro.com> * net/mairix.el (mairix-widget-send-query): Send -1 instead of nil to mairix-search to suppress threading (Bug#5342). diff --git a/lisp/Makefile.in b/lisp/Makefile.in index d8a91461bfe..1e701df348f 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -377,12 +377,12 @@ $(MH_E_DIR)/mh-loaddefs.el: $(MH_E_SRC) # an own subdirectory. OTOH, it does not hurt to keep them in # lisp/net. TRAMP_DIR = $(lisp)/net -TRAMP_SRC = $(TRAMP_DIR)/tramp.el $(TRAMP_DIR)/tramp-cache.el \ - $(TRAMP_DIR)/tramp-cmds.el $(TRAMP_DIR)/tramp-compat.el \ - $(TRAMP_DIR)/tramp-ftp.el $(TRAMP_DIR)/tramp-gvfs.el \ - $(TRAMP_DIR)/tramp-gw.el $(TRAMP_DIR)/tramp-sh.el \ - $(TRAMP_DIR)/tramp-smb.el $(TRAMP_DIR)/tramp-uu.el \ - $(TRAMP_DIR)/trampver.el +TRAMP_SRC = $(TRAMP_DIR)/tramp.el $(TRAMP_DIR)/tramp-adb.el \ + $(TRAMP_DIR)/tramp-cache.el $(TRAMP_DIR)/tramp-cmds.el \ + $(TRAMP_DIR)/tramp-compat.el $(TRAMP_DIR)/tramp-ftp.el \ + $(TRAMP_DIR)/tramp-gvfs.el $(TRAMP_DIR)/tramp-gw.el \ + $(TRAMP_DIR)/tramp-sh.el $(TRAMP_DIR)/tramp-smb.el \ + $(TRAMP_DIR)/tramp-uu.el $(TRAMP_DIR)/trampver.el $(TRAMP_DIR)/tramp-loaddefs.el: $(TRAMP_SRC) $(emacs) -l autoload \ diff --git a/lisp/allout.el b/lisp/allout.el index 22e4d0bc59c..9ca72514fd2 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -1657,10 +1657,9 @@ and the place for the cursor after the decryption is done." (defmacro allout-called-interactively-p () "A version of `called-interactively-p' independent of Emacs version." ;; ... to ease maintenance of allout without betraying deprecation. - (if (equal (subr-arity (symbol-function 'called-interactively-p)) - '(0 . 0)) - '(called-interactively-p) - '(called-interactively-p 'interactive))) + (if (ignore-errors (called-interactively-p 'interactive) t) + '(called-interactively-p 'interactive) + '(called-interactively-p))) ;;;_ = allout-inhibit-aberrance-doublecheck nil ;; In some exceptional moments, disparate topic depths need to be allowed ;; momentarily, eg when one topic is being yanked into another and they're diff --git a/lisp/apropos.el b/lisp/apropos.el index 5f481f54e57..000d2d87d05 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -69,7 +69,7 @@ "Non nil means apropos commands will search more extensively. This may be slower. This option affects the following commands: -`apropos-variable' will search all variables, not just user variables. +`apropos-user-option' will search all variables, not just user options. `apropos-command' will also search non-interactive functions. `apropos' will search all symbols, not just functions, variables, faces, and those with property lists. @@ -115,6 +115,12 @@ include key-binding information in its output." :group 'apropos :version "24.3") +(defface apropos-user-option-button + '((t (:inherit (font-lock-variable-name-face button)))) + "Button face indicating a user option in Apropos." + :group 'apropos + :version "24.4") + (defface apropos-misc-button '((t (:inherit (font-lock-constant-face button)))) "Button face indicating a miscellaneous object type in Apropos." @@ -261,6 +267,15 @@ term, and the rest of the words are alternative terms.") 'action (lambda (button) (describe-variable (button-get button 'apropos-symbol)))) +(define-button-type 'apropos-user-option + 'apropos-label "User option" + 'apropos-short-label "o" + 'face 'apropos-user-option-button + 'help-echo "mouse-2, RET: Display more help on this user option" + 'follow-link t + 'action (lambda (button) + (describe-variable (button-get button 'apropos-symbol)))) + (define-button-type 'apropos-face 'apropos-label "Face" 'apropos-short-label "F" @@ -461,15 +476,15 @@ This requires that at least 2 keywords (unless only one was given)." This is used to decide whether to print the result's type or not.") ;;;###autoload -(defun apropos-variable (pattern &optional do-all) - "Show user variables that match PATTERN. +(defun apropos-user-option (pattern &optional do-all) + "Show user options that match PATTERN. PATTERN can be a word, a list of words (separated by spaces), or a regexp (using some regexp special characters). If it is a word, search for matches for that word as a substring. If it is a list of words, search for matches for any two (or more) of those words. With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, also show -normal variables." +variables, not just user options." (interactive (list (apropos-read-pattern (if (or current-prefix-arg apropos-do-all) "variable" "user option")) @@ -481,6 +496,17 @@ normal variables." (get symbol 'variable-documentation))) 'custom-variable-p))) +;;;###autoload +(defun apropos-variable (pattern &optional do-not-all) + "Show variables that match PATTERN. +When DO-NOT-ALL is not-nil, show user options only, i.e. behave +like `apropos-user-option'." + (interactive (list (apropos-read-pattern + (if current-prefix-arg "user option" "variable")) + current-prefix-arg)) + (let ((apropos-do-all (if do-not-all nil t))) + (apropos-user-option pattern))) + ;; For auld lang syne: ;;;###autoload (defalias 'command-apropos 'apropos-command) @@ -1099,7 +1125,11 @@ If non-nil TEXT is a string that will be printed as a heading." 'apropos-macro 'apropos-function)) (not nosubst)) - (apropos-print-doc 3 'apropos-variable (not nosubst)) + (apropos-print-doc 3 + (if (custom-variable-p symbol) + 'apropos-user-option + 'apropos-variable) + (not nosubst)) (apropos-print-doc 7 'apropos-group t) (apropos-print-doc 6 'apropos-face t) (apropos-print-doc 5 'apropos-widget t) diff --git a/lisp/autorevert.el b/lisp/autorevert.el index f491f2427be..e44d4a88eda 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -39,8 +39,11 @@ ;; Auto-Revert Mode applies to all file buffers. (If the user option ;; `global-auto-revert-non-file-buffers' is non-nil, it also applies ;; to some non-file buffers. This option is disabled by default.) -;; Since checking a remote file is too slow, these modes do not check -;; or revert remote files. +;; +;; Since checking a remote file is slow, these modes check or revert +;; remote files only if the user option `auto-revert-remote-files' is +;; non-nil. It is recommended to disable version control for remote +;; files. ;; ;; Both modes operate by checking the time stamp of all files at ;; intervals of `auto-revert-interval'. The default is every five @@ -48,6 +51,13 @@ ;; Emacs. You should never even notice that this package is active ;; (except that your buffers will be reverted, of course). ;; +;; If Emacs is compiled with file notification support, notifications +;; are used instead of checking the time stamp of the files. You can +;; disable this by setting the user option `auto-revert-use-notify' to +;; nil. Alternatively, a regular expression of directories to be +;; excluded from file notifications can be specified by +;; `auto-revert-notify-exclude-dir-regexp'. +;; ;; After reverting a file buffer, Auto Revert Mode normally puts point ;; at the same position that a regular manual revert would. However, ;; there is one exception to this rule. If point is at the end of the @@ -65,7 +75,6 @@ ;; change by growing at the end. It only appends the new output, ;; instead of reverting the entire buffer. It does so even if the ;; buffer contains unsaved changes. (Because they will not be lost.) -;; Auto Revert Tail Mode works also for remote files. ;; Usage: ;; @@ -92,6 +101,7 @@ ;; Dependencies: +(eval-when-compile (require 'cl-lib)) (require 'timer) ;; Custom Group: @@ -254,6 +264,45 @@ buffers. CPU usage depends on the version control system." This variable becomes buffer local when set in any fashion.") (make-variable-buffer-local 'global-auto-revert-ignore-buffer) +(defcustom auto-revert-remote-files nil + "If non-nil remote files are also reverted." + :group 'auto-revert + :type 'boolean + :version "24.4") + +(defconst auto-revert-notify-enabled + (or (featurep 'inotify) (featurep 'w32notify)) + "Non-nil when Emacs has been compiled with file notification support.") + +(defcustom auto-revert-use-notify auto-revert-notify-enabled + "If non-nil Auto Revert Mode uses file notification functions. +This requires Emacs being compiled with file notification +support (see `auto-revert-notify-enabled'). You should set this +variable through Custom only." + :group 'auto-revert + :type 'boolean + :set (lambda (variable value) + (set-default variable (and auto-revert-notify-enabled value)) + (unless (symbol-value variable) + (when auto-revert-notify-enabled + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when (symbol-value 'auto-revert-notify-watch-descriptor) + (auto-revert-notify-rm-watch))))))) + :initialize 'custom-initialize-default + :version "24.4") + +(defcustom auto-revert-notify-exclude-dir-regexp + (concat + ;; No mounted file systems. + "^" (regexp-opt '("/afs/" "/media/" "/mnt" "/net/" "/tmp_mnt/")) + ;; No remote files. + (unless auto-revert-remote-files "\\|^/[^/|:][^/|]+:")) + "Regular expression of directories to be excluded from file notifications." + :group 'auto-revert + :type 'regexp + :version "24.4") + ;; Internal variables: (defvar auto-revert-buffer-list () @@ -276,6 +325,23 @@ the list of old buffers.") (set (make-local-variable 'auto-revert-tail-pos) (nth 7 (file-attributes buffer-file-name))))) +(defvar auto-revert-notify-watch-descriptor-hash-list + (make-hash-table :test 'equal) + "A hash table collecting all file watch descriptors. +Hash key is a watch descriptor, hash value is a list of buffers +which are related to files being watched and carrying the same +default directory.") + +(defvar auto-revert-notify-watch-descriptor nil + "The file watch descriptor active for the current buffer.") +(make-variable-buffer-local 'auto-revert-notify-watch-descriptor) +(put 'auto-revert-notify-watch-descriptor 'permanent-local t) + +(defvar auto-revert-notify-modified-p nil + "Non-nil when file has been modified on the file system. +This has been reported by a file notification event.") +(make-variable-buffer-local 'auto-revert-notify-modified-p) + ;; Functions: ;;;###autoload @@ -296,6 +362,7 @@ without being changed in the part that is already in the buffer." (if auto-revert-mode (if (not (memq (current-buffer) auto-revert-buffer-list)) (push (current-buffer) auto-revert-buffer-list)) + (when auto-revert-use-notify (auto-revert-notify-rm-watch)) (setq auto-revert-buffer-list (delq (current-buffer) auto-revert-buffer-list))) (auto-revert-set-timer) @@ -399,9 +466,12 @@ It displays the text that `global-auto-revert-mode-text' specifies in the mode line." :global t :group 'auto-revert :lighter global-auto-revert-mode-text (auto-revert-set-timer) - (when global-auto-revert-mode - (auto-revert-buffers))) - + (if global-auto-revert-mode + (auto-revert-buffers) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when auto-revert-use-notify + (auto-revert-notify-rm-watch)))))) (defun auto-revert-set-timer () "Restart or cancel the timer used by Auto-Revert Mode. @@ -418,6 +488,108 @@ will use an up-to-date value of `auto-revert-interval'" auto-revert-interval 'auto-revert-buffers)))) +(defun auto-revert-notify-rm-watch () + "Disable file notification for current buffer's associated file." + (when auto-revert-notify-watch-descriptor + (maphash + (lambda (key value) + (when (equal key auto-revert-notify-watch-descriptor) + (setq value (delete (current-buffer) value)) + (if value + (puthash key value auto-revert-notify-watch-descriptor-hash-list) + (remhash key auto-revert-notify-watch-descriptor-hash-list) + (ignore-errors + (funcall (if (fboundp 'inotify-rm-watch) + 'inotify-rm-watch 'w32notify-rm-watch) + auto-revert-notify-watch-descriptor))))) + auto-revert-notify-watch-descriptor-hash-list) + (remove-hook 'kill-buffer-hook 'auto-revert-notify-rm-watch)) + (setq auto-revert-notify-watch-descriptor nil + auto-revert-notify-modified-p nil)) + +(defun auto-revert-notify-add-watch () + "Enable file notification for current buffer's associated file." + (when (string-match auto-revert-notify-exclude-dir-regexp + (expand-file-name default-directory)) + ;; Fallback to file checks. + (set (make-local-variable 'auto-revert-use-notify) nil)) + + (when (and buffer-file-name auto-revert-use-notify + (not auto-revert-notify-watch-descriptor)) + (let ((func (if (fboundp 'inotify-add-watch) + 'inotify-add-watch 'w32notify-add-watch)) + (aspect (if (fboundp 'inotify-add-watch) + '(create modify moved-to) '(size last-write-time)))) + (setq auto-revert-notify-watch-descriptor + (ignore-errors + (funcall + func (directory-file-name (expand-file-name default-directory)) + aspect 'auto-revert-notify-handler))) + (if auto-revert-notify-watch-descriptor + (progn + (puthash + auto-revert-notify-watch-descriptor + (cons (current-buffer) + (gethash auto-revert-notify-watch-descriptor + auto-revert-notify-watch-descriptor-hash-list)) + auto-revert-notify-watch-descriptor-hash-list) + (add-hook (make-local-variable 'kill-buffer-hook) + 'auto-revert-notify-rm-watch)) + ;; Fallback to file checks. + (set (make-local-variable 'auto-revert-use-notify) nil))))) + +(defun auto-revert-notify-event-p (event) + "Check that event is a file notification event." + (cond ((featurep 'inotify) + (and (listp event) (= (length event) 4))) + ((featurep 'w32notify) + (and (listp event) (= (length event) 3) (stringp (nth 2 event)))))) + +(defun auto-revert-notify-event-descriptor (event) + "Return watch descriptor of file notification event, or nil." + (and (auto-revert-notify-event-p event) (car event))) + +(defun auto-revert-notify-event-action (event) + "Return action of file notification event, or nil." + (and (auto-revert-notify-event-p event) (nth 1 event))) + +(defun auto-revert-notify-event-file-name (event) + "Return file name of file notification event, or nil." + (and (auto-revert-notify-event-p event) + (cond ((featurep 'inotify) (nth 3 event)) + ((featurep 'w32notify) (nth 2 event))))) + +(defun auto-revert-notify-handler (event) + "Handle an event returned from file notification." + (when (auto-revert-notify-event-p event) + (let* ((descriptor (auto-revert-notify-event-descriptor event)) + (action (auto-revert-notify-event-action event)) + (file (auto-revert-notify-event-file-name event)) + (buffers (gethash descriptor + auto-revert-notify-watch-descriptor-hash-list))) + (ignore-errors + ;; Check, that event is meant for us. + ;; TODO: Filter events which stop watching, like `move' or `removed'. + (cl-assert descriptor) + (when (featurep 'inotify) + (cl-assert (or (memq 'create action) + (memq 'modify action) + (memq 'moved-to action)))) + (when (featurep 'w32notify) (cl-assert (eq 'modified action))) + ;; Since we watch a directory, a file name must be returned. + (cl-assert (stringp file)) + (dolist (buffer buffers) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (when (and (stringp buffer-file-name) + (string-equal + (file-name-nondirectory file) + (file-name-nondirectory buffer-file-name))) + ;; Mark buffer modified. + (setq auto-revert-notify-modified-p t) + ;; No need to check other buffers. + (cl-return))))))))) + (defun auto-revert-active-p () "Check if auto-revert is active (in current buffer or globally)." (or auto-revert-mode @@ -433,20 +605,23 @@ will use an up-to-date value of `auto-revert-interval'" This is an internal function used by Auto-Revert Mode." (when (or auto-revert-tail-mode (not (buffer-modified-p))) (let* ((buffer (current-buffer)) size + ;; Tramp caches the file attributes. Setting + ;; `remote-file-name-inhibit-cache' forces Tramp to reread + ;; the values. + (remote-file-name-inhibit-cache t) (revert (or (and buffer-file-name + (or auto-revert-remote-files + (not (file-remote-p buffer-file-name))) + (or (not auto-revert-use-notify) + auto-revert-notify-modified-p) (if auto-revert-tail-mode - ;; Tramp caches the file attributes. Setting - ;; `remote-file-name-inhibit-cache' forces Tramp - ;; to reread the values. - (let ((remote-file-name-inhibit-cache t)) - (and (file-readable-p buffer-file-name) - (/= auto-revert-tail-pos - (setq size - (nth 7 (file-attributes - buffer-file-name)))))) - (and (not (file-remote-p buffer-file-name)) - (file-readable-p buffer-file-name) + (and (file-readable-p buffer-file-name) + (/= auto-revert-tail-pos + (setq size + (nth 7 (file-attributes + buffer-file-name))))) + (and (file-readable-p buffer-file-name) (not (verify-visited-file-modtime buffer))))) (and (or auto-revert-mode global-auto-revert-non-file-buffers) @@ -455,6 +630,7 @@ This is an internal function used by Auto-Revert Mode." (functionp buffer-stale-function) (funcall buffer-stale-function t)))) eob eoblist) + (setq auto-revert-notify-modified-p nil) (when revert (when (and auto-revert-verbose (not (eq revert 'fast))) @@ -561,7 +737,12 @@ the timer when no buffers need to be checked." (memq buf auto-revert-buffer-list)) (setq auto-revert-buffer-list (delq buf auto-revert-buffer-list))) - (when (auto-revert-active-p) (auto-revert-handler))) + (when (auto-revert-active-p) + ;; Enable file notification. + (when (and auto-revert-use-notify buffer-file-name + (not auto-revert-notify-watch-descriptor)) + (auto-revert-notify-add-watch)) + (auto-revert-handler))) ;; Remove dead buffer from `auto-revert-buffer-list'. (setq auto-revert-buffer-list (delq buf auto-revert-buffer-list)))) diff --git a/lisp/battery.el b/lisp/battery.el index 696b1214652..98ba7d1b631 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -53,6 +53,9 @@ (directory-files "/sys/class/power_supply/" nil battery--linux-sysfs-regexp)) 'battery-linux-sysfs) + ((and (eq system-type 'berkeley-unix) + (file-executable-p "/usr/sbin/apm")) + 'battery-bsd-apm) ((and (eq system-type 'darwin) (condition-case nil (with-temp-buffer @@ -523,6 +526,75 @@ The following %-sequences are provided: "AC" "BAT") "N/A"))))) + + +;;; `apm' interface for BSD. +(defun battery-bsd-apm () + "Get APM status information from BSD apm binary. +The following %-sequences are provided: +%L AC line status (verbose) +%B Battery status (verbose) +%b Battery status, empty means high, `-' means low, + `!' means critical, and `+' means charging +%P Advanced power saving mode state (verbose) +%p Battery charge percentage +%s Remaining battery charge time in seconds +%m Remaining battery charge time in minutes +%h Remaining battery charge time in hours +%t Remaining battery charge time in the form `h:min'" + (let* ((os-name (car (split-string + (shell-command-to-string "/usr/bin/uname")))) + (apm-flag (if (equal os-name "OpenBSD") "P" "s")) + (apm-cmd (concat "/usr/sbin/apm -ablm" apm-flag)) + (apm-output (split-string (shell-command-to-string apm-cmd))) + ;; Battery status + (battery-status + (let ((stat (string-to-number (nth 0 apm-output)))) + (cond ((eq stat 0) '("high" . "")) + ((eq stat 1) '("low" . "-")) + ((eq stat 2) '("critical" . "!")) + ((eq stat 3) '("charging" . "+")) + ((eq stat 4) '("absent" . nil))))) + ;; Battery percentage + (battery-percentage (nth 1 apm-output)) + ;; Battery life + (battery-life (nth 2 apm-output)) + ;; AC status + (line-status + (let ((ac (string-to-number (nth 3 apm-output)))) + (cond ((eq ac 0) "disconnected") + ((eq ac 1) "connected") + ((eq ac 2) "backup power")))) + ;; Advanced power savings mode + (apm-mode + (let ((apm (string-to-number (nth 4 apm-output)))) + (if (string= os-name "OpenBSD") + (cond ((eq apm 0) "manual") + ((eq apm 1) "automatic") + ((eq apm 2) "cool running")) + (if (eq apm 1) "on" "off")))) + seconds minutes hours remaining-time) + (unless (member battery-life '("unknown" "-1")) + (if (member os-name '("OpenBSD" "NetBSD")) + (setq minutes (string-to-number battery-life) + seconds (* 60 minutes)) + (setq seconds (string-to-number battery-life) + minutes (truncate (/ seconds 60)))) + (setq hours (truncate (/ minutes 60)) + remaining-time (format "%d:%02d" hours + (- minutes (* 60 hours))))) + (list (cons ?L (or line-status "N/A")) + (cons ?B (or (car battery-status) "N/A")) + (cons ?b (or (cdr battery-status) "N/A")) + (cons ?p (if (string= battery-percentage "255") + "N/A" + battery-percentage)) + (cons ?P (or apm-mode "N/A")) + (cons ?s (or (and seconds (number-to-string seconds)) "N/A")) + (cons ?m (or (and minutes (number-to-string minutes)) "N/A")) + (cons ?h (or (and hours (number-to-string hours)) "N/A")) + (cons ?t (or remaining-time "N/A"))))) + ;;; `pmset' interface for Darwin (OS X). diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 9ee3ff65b57..da6ffb38452 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -1873,10 +1873,8 @@ With a prefix arg, prompts for a file to save them in." The current window remains selected." (interactive) (let ((bookmark (bookmark-bmenu-bookmark)) - (pop-up-windows t) - same-window-buffer-names - same-window-regexps) - (bookmark--jump-via bookmark 'display-buffer))) + (fun (lambda (b) (display-buffer b t)))) + (bookmark--jump-via bookmark fun))) (defun bookmark-bmenu-other-window-with-mouse (event) "Select bookmark at the mouse pointer in other window, leaving bookmark menu visible." diff --git a/lisp/button.el b/lisp/button.el index 0676ba86957..433c3990d59 100644 --- a/lisp/button.el +++ b/lisp/button.el @@ -64,6 +64,11 @@ ;; might get converted to ^M when building loaddefs.el (define-key map [(control ?m)] 'push-button) (define-key map [mouse-2] 'push-button) + ;; FIXME: You'd think that for keymaps coming from text-properties on the + ;; mode-line or header-line, the `mode-line' or `header-line' prefix + ;; shouldn't be necessary! + (define-key map [mode-line mouse-2] 'push-button) + (define-key map [header-line mouse-2] 'push-button) map) "Keymap used by buttons.") @@ -184,10 +189,13 @@ changes to a supertype are not reflected in its subtypes)." (defun button-get (button prop) "Get the property of button BUTTON named PROP." - (if (overlayp button) - (overlay-get button prop) - ;; Must be a text-property button. - (get-text-property button prop))) + (cond ((overlayp button) + (overlay-get button prop)) + ((button--area-button-p button) + (get-text-property (cdr button) + prop (button--area-button-string button))) + (t ; Must be a text-property button. + (get-text-property button prop)))) (defun button-put (button prop val) "Set BUTTON's PROP property to VAL." @@ -202,21 +210,30 @@ changes to a supertype are not reflected in its subtypes)." ;; Disallow updating the `category' property directly. (error "Button `category' property may not be set directly"))) ;; Add the property. - (if (overlayp button) - (overlay-put button prop val) - ;; Must be a text-property button. - (put-text-property - (or (previous-single-property-change (1+ button) 'button) - (point-min)) - (or (next-single-property-change button 'button) - (point-max)) - prop val))) - -(defsubst button-activate (button &optional use-mouse-action) + (cond ((overlayp button) + (overlay-put button prop val)) + ((button--area-button-p button) + (setq button (button--area-button-string button)) + (put-text-property 0 (length button) prop val button)) + (t ; Must be a text-property button. + (put-text-property + (or (previous-single-property-change (1+ button) 'button) + (point-min)) + (or (next-single-property-change button 'button) + (point-max)) + prop val)))) + +(defun button-activate (button &optional use-mouse-action) "Call BUTTON's action property. If USE-MOUSE-ACTION is non-nil, invoke the button's mouse-action instead of its normal action; if the button has no mouse-action, -the normal action is used instead." +the normal action is used instead. + +The action can either be a marker or a function. If it's a +marker then goto it. Otherwise it it is a function then it is +called with BUTTON as only argument. BUTTON is either an +overlay, a buffer position, or (for buttons in the mode-line or +header-line) a string." (let ((action (or (and use-mouse-action (button-get button 'mouse-action)) (button-get button 'action)))) (if (markerp action) @@ -228,7 +245,10 @@ the normal action is used instead." (defun button-label (button) "Return BUTTON's text label." - (buffer-substring-no-properties (button-start button) (button-end button))) + (if (button--area-button-p button) + (substring-no-properties (button--area-button-string button)) + (buffer-substring-no-properties (button-start button) + (button-end button)))) (defsubst button-type (button) "Return BUTTON's button-type." @@ -238,6 +258,13 @@ the normal action is used instead." "Return t if BUTTON has button-type TYPE, or one of TYPE's subtypes." (button-type-subtype-p (button-get button 'type) type)) +(defun button--area-button-p (b) + "Return non-nil if BUTTON is an area button. +Such area buttons are used for buttons in the mode-line and header-line." + (stringp (car-safe b))) + +(defalias 'button--area-button-string #'car + "Return area button BUTTON's button-string.") ;; Creating overlay buttons @@ -324,7 +351,7 @@ Also see `insert-text-button'." (cons 'button (cons (list t) properties)) object) ;; Return something that can be used to get at the button. - beg)) + (or object beg))) (defun insert-text-button (label &rest properties) "Insert a button with the label LABEL. @@ -405,7 +432,9 @@ POS may be either a buffer position or a mouse-event. If USE-MOUSE-ACTION is non-nil, invoke the button's mouse-action instead of its normal action; if the button has no mouse-action, the normal action is used instead. The action may be either a -function to call or a marker to display. +function to call or a marker to display and is invoked using +`button-activate' (which see). + POS defaults to point, except when `push-button' is invoked interactively as the result of a mouse-event, in which case, the mouse event is used. @@ -417,11 +446,13 @@ return t." ;; POS is a mouse event; switch to the proper window/buffer (let ((posn (event-start pos))) (with-current-buffer (window-buffer (posn-window posn)) - (push-button (posn-point posn) t))) + (if (posn-string posn) + ;; mode-line, header-line, or display string event. + (button-activate (posn-string posn) t) + (push-button (posn-point posn)) t))) ;; POS is just normal position (let ((button (button-at (or pos (point))))) - (if (not button) - nil + (when button (button-activate button use-mouse-action) t)))) diff --git a/lisp/calc/README b/lisp/calc/README index 85181899f2a..c44ffe5aef0 100644 --- a/lisp/calc/README +++ b/lisp/calc/README @@ -70,11 +70,19 @@ opinions. Summary of changes to "Calc" ------- -- ------- -- ---- +Emacs 24.4 + +* The date forms use the Gregorian calendar for all dates. + (Previously they were a combination of Julian and Gregorian + dates.) This can be configured with the customizable variable + `calc-gregorian-switch'. + +* Support for ISO 8601 dates added. Emacs 24.3 -Algebraic simplification mode is now the default. -To restrict to the limited simplifications given by the former -default simplification mode, use `m I'. +* Algebraic simplification mode is now the default. + To restrict to the limited simplifications given by the former + default simplification mode, use `m I'. Emacs 24.1 diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el index e14d2c8d215..77efb1efc84 100644 --- a/lisp/calc/calc-forms.el +++ b/lisp/calc/calc-forms.el @@ -82,19 +82,20 @@ (calc-wrapper (if (string-match-p "\\`\\s-*\\'" fmt) (setq fmt "1")) - (if (string-match "\\` *[0-9] *\\'" fmt) + (if (string-match "\\` *\\([0-9]\\|10\\|11\\) *\\'" fmt) (setq fmt (nth (string-to-number fmt) calc-standard-date-formats))) (or (string-match "[a-zA-Z]" fmt) (error "Bad date format specifier")) (and arg (>= (setq arg (prefix-numeric-value arg)) 0) - (<= arg 9) + (<= arg 11) (setq calc-standard-date-formats (copy-sequence calc-standard-date-formats)) (setcar (nthcdr arg calc-standard-date-formats) fmt)) (let ((case-fold-search nil)) (and (not (string-match "<.*>" fmt)) - (string-match "\\`[^hHspP]*\\([^ac-gi-lnoqrt-zAC-GI-OQRT-Z]*[bBhHmpPsS]+[^ac-gi-lnoqrt-zAC-GI-OQRT-Z]*\\)[^hHspP]*\\'" fmt) + ;; Find time part to put in <...> + (string-match "\\`[^hHspPT]*\\([^ac-gi-lnoqrt-zAC-GI-OQRU-Z]*\\(bs\\|bm\\|bh\\|BS\\|BH\\|[hHmpPsST]\\)+[^ac-gi-lnoqrt-zAC-GI-OQRU-Z]*\\)[^hHspPT]*\\'" fmt) (string-match (concat "[^ac-gi-lnoqrt-zAC-GI-OQRT-Z]*" (regexp-quote (math-match-substring fmt 1)) "[^ac-gi-lnoqrt-zAC-GI-OQRT-Z]*") fmt) @@ -125,7 +126,7 @@ lfmt nil)) (setq time nil)) (t - (if (string-match "\\`[^a-zA-Z]*[bB][a-zA-Z]" fmt) + (if (string-match "\\`[^a-zA-Z]*[bBZI][a-zA-Z]" fmt) (setq pos2 (1+ pos2))) (while (and (< pos2 (length fmt)) (= (upcase (aref fmt pos2)) @@ -133,6 +134,7 @@ (setq pos2 (1+ pos2))) (setq sym (intern (substring fmt pos pos2))) (or (memq sym '(Y YY BY YYY YYYY + ZYYY IYYY Iww w aa AA aaa AAA aaaa AAAA bb BB bbb BBB bbbb BBBB M MM BM mmm Mmm Mmmm MMM MMMM @@ -140,8 +142,8 @@ W www Www Wwww WWW WWWW h hh bh H HH BH p P pp PP pppp PPPP - m mm bm s ss bss SS BS C - N n J j U b)) + m mm bm s ss bs SS BS C + N n J j U b T)) (and (eq sym 'X) (not lfmt) (not fullfmt)) (error "Bad format code: %s" sym)) (and (memq sym '(bb BB bbb BBB bbbb BBBB)) @@ -369,17 +371,68 @@ ;;; Some of these functions are adapted from Edward Reingold's "calendar.el". ;;; These versions are rewritten to use arbitrary-size integers. -;;; The Julian calendar is used up to 9/2/1752, after which the Gregorian -;;; calendar is used; the first day after 9/2/1752 is 9/14/1752. ;;; A numerical date is the number of days since midnight on -;;; the morning of January 1, 1 A.D. If the date is a non-integer, -;;; it represents a specific date and time. +;;; the morning of December 31, 1 B.C. (Gregorian) or January 2, 1 A.D. (Julian). +;;; Emacs's calendar refers to such a date as an absolute date, some Calc function +;;; names also use that terminology. If the date is a non-integer, it represents +;;; a specific date and time. ;;; A "dt" is a list of the form, (year month day), corresponding to ;;; an integer code, or (year month day hour minute second), corresponding ;;; to a non-integer code. +(defun math-date-to-gregorian-dt (date) + "Return the day (YEAR MONTH DAY) in the Gregorian calendar. +DATE is the number of days since December 31, -1 in the Gregorian calendar." + (let* ((month 1) + day + (year (math-quotient (math-add date (if (Math-lessp date 711859) + 365 ; for speed, we take + -108)) ; >1950 as a special case + (if (math-negp date) 366 365))) + ; this result may be an overestimate + temp) + (while (Math-lessp date (setq temp (math-absolute-from-gregorian-dt year 1 1))) + (setq year (math-add year -1))) + (if (eq year 0) (setq year -1)) + (setq date (1+ (math-sub date temp))) + (setq temp + (if (math-leap-year-p year) + [1 32 61 92 122 153 183 214 245 275 306 336 999] + [1 32 60 91 121 152 182 213 244 274 305 335 999])) + (while (>= date (aref temp month)) + (setq month (1+ month))) + (setq day (1+ (- date (aref temp (1- month))))) + (list year month day))) + +(defun math-date-to-julian-dt (date) + "Return the day (YEAR MONTH DAY) in the Julian calendar. +DATE is the number of days since December 31, -1 in the Gregorian calendar." + (let* ((month 1) + day + (year (math-quotient (math-add date (if (Math-lessp date 711859) + 367 ; for speed, we take + -106)) ; >1950 as a special case + (if (math-negp date) 366 365))) + ; this result may be an overestimate + temp) + (while (Math-lessp date (setq temp (math-absolute-from-julian-dt year 1 1))) + (setq year (math-add year -1))) + (if (eq year 0) (setq year -1)) + (setq date (1+ (math-sub date temp))) + (setq temp + (if (math-leap-year-p year t) + [1 32 61 92 122 153 183 214 245 275 306 336 999] + [1 32 60 91 121 152 182 213 244 274 305 335 999])) + (while (>= date (aref temp month)) + (setq month (1+ month))) + (setq day (1+ (- date (aref temp (1- month))))) + (list year month day))) + (defun math-date-to-dt (value) + "Return the day and time of VALUE. +The integer part of VALUE is the number of days since Dec 31, -1 +in the Gregorian calendar and the remaining part determines the time." (if (eq (car-safe value) 'date) (setq value (nth 1 value))) (or (math-realp value) @@ -387,32 +440,42 @@ (let* ((parts (math-date-parts value)) (date (car parts)) (time (nth 1 parts)) - (month 1) - day - (year (math-quotient (math-add date (if (Math-lessp date 711859) - 365 ; for speed, we take - -108)) ; >1950 as a special case - (if (math-negp value) 366 365))) - ; this result may be an overestimate - temp) - (while (Math-lessp date (setq temp (math-absolute-from-date year 1 1))) - (setq year (math-add year -1))) - (if (eq year 0) (setq year -1)) - (setq date (1+ (math-sub date temp))) - (and (eq year 1752) (>= date 247) - (setq date (+ date 11))) - (setq temp (if (math-leap-year-p year) - [1 32 61 92 122 153 183 214 245 275 306 336 999] - [1 32 60 91 121 152 182 213 244 274 305 335 999])) - (while (>= date (aref temp month)) - (setq month (1+ month))) - (setq day (1+ (- date (aref temp (1- month))))) + (dt (if (and calc-gregorian-switch + (Math-lessp value + (or + (nth 3 calc-gregorian-switch) + (apply 'math-absolute-from-gregorian-dt calc-gregorian-switch)) +)) + (math-date-to-julian-dt date) + (math-date-to-gregorian-dt date)))) (if (math-integerp value) - (list year month day) - (list year month day - (/ time 3600) - (% (/ time 60) 60) - (math-add (% time 60) (nth 2 parts)))))) + dt + (append dt + (list + (/ time 3600) + (% (/ time 60) 60) + (math-add (% time 60) (nth 2 parts))))))) + +(defun math-date-to-iso-dt (date) + "Return the ISO8601 date (year week day) of DATE." + (unless (Math-integerp date) + (setq date (math-floor date))) + (let* ((approx (nth 0 (math-date-to-gregorian-dt (math-sub date 3)))) + (year (math-add approx + (let ((y approx) + (sum 0)) + (while (>= (math-compare date + (math-absolute-from-iso-dt (setq y (math-add y 1)) 1 1)) 0) + (setq sum (+ sum 1))) + sum)))) + (list + year + (math-add (car (math-idivmod + (math-sub date (math-absolute-from-iso-dt year 1 1)) + 7)) + 1) + (let ((day (calcFunc-mod date 7))) + (if (= day 0) 7 day))))) (defun math-dt-to-date (dt) (or (integerp (nth 1 dt)) @@ -423,7 +486,17 @@ (math-reject-arg (nth 2 dt) 'fixnump)) (if (or (< (nth 2 dt) 1) (> (nth 2 dt) 31)) (math-reject-arg (nth 2 dt) "Day value is out of range")) - (let ((date (math-absolute-from-date (car dt) (nth 1 dt) (nth 2 dt)))) + (let ((date (math-absolute-from-dt (car dt) (nth 1 dt) (nth 2 dt)))) + (if (nth 3 dt) + (math-add (math-float date) + (math-div (math-add (+ (* (nth 3 dt) 3600) + (* (nth 4 dt) 60)) + (nth 5 dt)) + '(float 864 2))) + date))) + +(defun math-iso-dt-to-date (dt) + (let ((date (math-absolute-from-iso-dt (car dt) (nth 1 dt) (nth 2 dt)))) (if (nth 3 dt) (math-add (math-float date) (math-div (math-add (+ (* (nth 3 dt) 3600) @@ -446,11 +519,17 @@ (defun math-this-year () (nth 5 (decode-time))) -(defun math-leap-year-p (year) - (if (Math-lessp year 1752) +(defun math-leap-year-p (year &optional julian) + "Non-nil if YEAR is a leap year. +If JULIAN is non-nil, then use the criterion for leap years +in the Julian calendar, otherwise use the criterion in the +Gregorian calendar." + (if julian (if (math-negp year) (= (math-imod (math-neg year) 4) 1) (= (math-imod year 4) 0)) + (if (math-negp year) + (setq year (math-sub -1 year))) (setq year (math-imod year 400)) (or (and (= (% year 4) 0) (/= (% year 100) 0)) (= year 0)))) @@ -460,39 +539,112 @@ 29 (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month)))) -(defun math-day-number (year month day) +(defun math-day-in-year (year month day &optional julian) + "Return the number of days of the year up to YEAR MONTH DAY. +The count includes the given date. +If JULIAN is non-nil, use the Julian calendar, otherwise +use the Gregorian calendar." (let ((day-of-year (+ day (* 31 (1- month))))) (if (> month 2) (progn (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10))) - (if (math-leap-year-p year) + (if (math-leap-year-p year julian) (setq day-of-year (1+ day-of-year))))) - (and (eq year 1752) - (or (> month 9) - (and (= month 9) (>= day 14))) - (setq day-of-year (- day-of-year 11))) day-of-year)) -(defun math-absolute-from-date (year month day) +(defun math-day-number (year month day) + "Return the number of days of the year up to YEAR MONTH DAY. +The count includes the given date." + (if calc-gregorian-switch + (cond ((eq year (nth 0 calc-gregorian-switch)) + (1+ + (- (math-absolute-from-dt year month day) + (math-absolute-from-dt year 1 1)))) + ((Math-lessp year (nth 0 calc-gregorian-switch)) + (math-day-in-year year month day t)) + (t + (math-day-in-year year month day))) + (math-day-in-year year month day))) + +(defun math-dt-before-p (dt1 dt2) + "Non-nil if DT1 occurs before DT2. +A DT is a list of the form (YEAR MONTH DAY)." + (or (Math-lessp (nth 0 dt1) (nth 0 dt2)) + (and (equal (nth 0 dt1) (nth 0 dt2)) + (or (< (nth 1 dt1) (nth 1 dt2)) + (and (= (nth 1 dt1) (nth 1 dt2)) + (< (nth 2 dt1) (nth 2 dt2))))))) + +(defun math-absolute-from-gregorian-dt (year month day) + "Return the DATE of the day given by the Gregorian day YEAR MONTH DAY. +Recall that DATE is the number of days since December 31, -1 +in the Gregorian calendar." (if (eq year 0) (setq year -1)) (let ((yearm1 (math-sub year 1))) - (math-sub (math-add (math-day-number year month day) - (math-add (math-mul 365 yearm1) - (if (math-posp year) - (math-quotient yearm1 4) - (math-sub 365 - (math-quotient (math-sub 3 year) - 4))))) - (if (or (Math-lessp year 1753) - (and (eq year 1752) (<= month 9))) - 1 - (let ((correction (math-mul (math-quotient yearm1 100) 3))) - (let ((res (math-idivmod correction 4))) - (math-add (if (= (cdr res) 0) - -1 - 0) - (car res)))))))) - + (math-sub + ;; Add the number of days of the year and the numbers of days + ;; in the previous years (leap year days to be added separately) + (math-add (math-day-in-year year month day) + (math-add (math-mul 365 yearm1) + ;; Add the number of Julian leap years + (if (math-posp year) + (math-quotient yearm1 4) + (math-sub 365 + (math-quotient (math-sub 3 year) + 4))))) + ;; Subtract the number of Julian leap years which are not + ;; Gregorian leap years. In C=4N+r centuries, there will + ;; be 3N+r of these days. The following will compute + ;; 3N+r. + (let* ((correction (math-mul (math-quotient yearm1 100) 3)) + (res (math-idivmod correction 4))) + (math-add (if (= (cdr res) 0) + 0 + 1) + (car res)))))) + +(defun math-absolute-from-julian-dt (year month day) + "Return the DATE of the day given by the Julian day YEAR MONTH DAY. +Recall that DATE is the number of days since December 31, -1 +in the Gregorian calendar." + (if (eq year 0) (setq year -1)) + (let ((yearm1 (math-sub year 1))) + (math-sub + ;; Add the number of days of the year and the numbers of days + ;; in the previous years (leap year days to be added separately) + (math-add (math-day-in-year year month day) + (math-add (math-mul 365 yearm1) + ;; Add the number of Julian leap years + (if (math-posp year) + (math-quotient yearm1 4) + (math-sub 365 + (math-quotient (math-sub 3 year) + 4))))) + ;; Adjustment, since January 1, 1 (Julian) is absolute day -1 + 2))) + +;; calc-gregorian-switch is a customizable variable defined in calc.el +(defvar calc-gregorian-switch) + +(defun math-absolute-from-iso-dt (year week day) + "Return the DATE of the day given by the iso8601 day YEAR WEEK DAY." + (let* ((janfour (math-absolute-from-gregorian-dt year 1 4)) + (prevmon (math-sub janfour + (cdr (math-idivmod (math-sub janfour 1) 7))))) + (math-add + (math-add prevmon (* (1- week) 7)) + (if (zerop day) 6 (1- day))))) + +(defun math-absolute-from-dt (year month day) + "Return the DATE of the day given by the day YEAR MONTH DAY. +Recall that DATE is the number of days since December 31, -1 +in the Gregorian calendar." + (if (and calc-gregorian-switch + ;; The next few lines determine if the given date + ;; occurs before the switch to the Gregorian calendar. + (math-dt-before-p (list year month day) calc-gregorian-switch)) + (math-absolute-from-julian-dt year month day) + (math-absolute-from-gregorian-dt year month day))) ;;; It is safe to redefine these in your init file to use a different ;;; language. @@ -526,6 +678,10 @@ (defvar math-fd-minute) (defvar math-fd-second) (defvar math-fd-bc-flag) +(defvar math-fd-iso-dt) +(defvar math-fd-isoyear) +(defvar math-fd-isoweek) +(defvar math-fd-isoweekday) (defun math-format-date (math-fd-date) (if (eq (car-safe math-fd-date) 'date) @@ -533,12 +689,14 @@ (let ((entry (list math-fd-date calc-internal-prec calc-date-format))) (or (cdr (assoc entry math-format-date-cache)) (let* ((math-fd-dt nil) + (math-fd-iso-dt nil) (calc-group-digits nil) (calc-leading-zeros nil) (calc-number-radix 10) (calc-twos-complement-mode nil) math-fd-year math-fd-month math-fd-day math-fd-weekday math-fd-hour math-fd-minute math-fd-second + math-fd-isoyear math-fd-isoweek math-fd-isoweekday (math-fd-bc-flag nil) (fmt (apply 'concat (mapcar 'math-format-date-part calc-date-format)))) @@ -548,13 +706,13 @@ (setcdr math-fd-dt nil)) fmt)))) -(defconst math-julian-date-beginning '(float 17214235 -1) - "The beginning of the Julian calendar, -as measured in the number of days before January 1 of the year 1AD.") +(defconst math-julian-date-beginning '(float 17214225 -1) + "The beginning of the Julian date calendar, +as measured in the number of days before December 31, 1 BC (Gregorian).") -(defconst math-julian-date-beginning-int 1721424 - "The beginning of the Julian calendar, -as measured in the integer number of days before January 1 of the year 1AD.") +(defconst math-julian-date-beginning-int 1721423 + "The beginning of the Julian date calendar, +as measured in the integer number of days before December 31, 1 BC (Gregorian).") (defun math-format-date-part (x) (cond ((stringp x) @@ -578,6 +736,23 @@ as measured in the integer number of days before January 1 of the year 1AD.") math-julian-date-beginning-int))) ((eq x 'U) (math-format-number (nth 1 (math-date-parts math-fd-date 719164)))) + ((memq x '(IYYY Iww w)) + (progn + (or math-fd-iso-dt + (setq math-fd-iso-dt (math-date-to-iso-dt math-fd-date) + math-fd-isoyear (car math-fd-iso-dt) + math-fd-isoweek (nth 1 math-fd-iso-dt) + math-fd-isoweekday (nth 2 math-fd-iso-dt))) + (cond ((eq x 'IYYY) + (let* ((neg (Math-negp math-fd-isoyear)) + (pyear (calcFunc-abs math-fd-isoyear))) + (if (and (natnump pyear) (< pyear 10000)) + (concat (if neg "-" "") (format "%04d" pyear)) + (concat (if neg "-" "+") (math-format-number pyear))))) + ((eq x 'Iww) + (concat "W" (format "%02d" math-fd-isoweek))) + ((eq x 'w) + (format "%d" math-fd-isoweekday))))) ((progn (or math-fd-dt (progn @@ -585,8 +760,7 @@ as measured in the integer number of days before January 1 of the year 1AD.") math-fd-year (car math-fd-dt) math-fd-month (nth 1 math-fd-dt) math-fd-day (nth 2 math-fd-dt) - math-fd-weekday (math-mod - (math-add (math-floor math-fd-date) 6) 7) + math-fd-weekday (math-mod (math-floor math-fd-date) 7) math-fd-hour (nth 3 math-fd-dt) math-fd-minute (nth 4 math-fd-dt) math-fd-second (nth 5 math-fd-dt)) @@ -609,6 +783,15 @@ as measured in the integer number of days before January 1 of the year 1AD.") (if (and (natnump math-fd-year) (< math-fd-year 100)) (format "+%d" math-fd-year) (math-format-number math-fd-year))) + ((eq x 'ZYYY) + (let* ((year (if (Math-negp math-fd-year) + (math-add math-fd-year 1) + math-fd-year)) + (neg (Math-negp year)) + (pyear (calcFunc-abs year))) + (if (and (natnump pyear) (< pyear 10000)) + (concat (if neg "-" "") (format "%04d" pyear)) + (concat (if neg "-" "+") (math-format-number pyear))))) ((eq x 'b) "") ((eq x 'aa) (and (not math-fd-bc-flag) "ad")) @@ -634,6 +817,7 @@ as measured in the integer number of days before January 1 of the year 1AD.") (and math-fd-bc-flag "b.c.")) ((eq x 'BBBB) (and math-fd-bc-flag "B.C.")) + ((eq x 'T) "T") ((eq x 'M) (format "%d" math-fd-month)) ((eq x 'MM) @@ -734,6 +918,8 @@ as measured in the integer number of days before January 1 of the year 1AD.") (catch 'syntax (or (math-parse-standard-date math-pd-str t) (math-parse-standard-date math-pd-str nil) + (and (string-match "W[0-9][0-9]" math-pd-str) + (math-parse-iso-date math-pd-str)) (and (string-match "\\`[^-+/0-9a-zA-Z]*\\([-+]?[0-9]+\\.?[0-9]*\\([eE][-+]?[0-9]+\\)?\\)[^-+/0-9a-zA-Z]*\\'" math-pd-str) (list 'date (math-read-number (math-match-substring math-pd-str 1)))) (let ((case-fold-search t) @@ -757,8 +943,12 @@ as measured in the integer number of days before January 1 of the year 1AD.") (setq second 0) (setq second (math-read-number second))) (if (equal ampm "") - (if (> hour 23) - (throw 'syntax "Hour value out of range")) + (if (or + (> hour 24) + (and (= hour 24) + (not (= minute 0)) + (not (eq second 0)))) + (throw 'syntax "Hour value is out of range")) (setq ampm (upcase (aref ampm 0))) (if (memq ampm '(?N ?M)) (if (and (= hour 12) (= minute 0) (eq second 0)) @@ -766,7 +956,7 @@ as measured in the integer number of days before January 1 of the year 1AD.") (throw 'syntax "Time must be 12:00:00 in this context")) (if (or (= hour 0) (> hour 12)) - (throw 'syntax "Hour value out of range")) + (throw 'syntax "Hour value is out of range")) (if (eq (= ampm ?A) (= hour 12)) (setq hour (% (+ hour 12) 24))))))) @@ -889,7 +1079,11 @@ as measured in the integer number of days before January 1 of the year 1AD.") (throw 'syntax "Day value is out of range")) (and hour (progn - (if (or (< hour 0) (> hour 23)) + (if (or (< hour 0) + (> hour 24) + (and (= hour 24) + (not (= minute 0)) + (not (eq second 0)))) (throw 'syntax "Hour value is out of range")) (if (or (< minute 0) (> minute 59)) (throw 'syntax "Minute value is out of range")) @@ -898,6 +1092,26 @@ as measured in the integer number of days before January 1 of the year 1AD.") (list 'date (math-dt-to-date (append (list year month day) (and hour (list hour minute second)))))) +(defun math-parse-iso-date-validate (isoyear isoweek isoweekday hour minute second) + (if (or (< isoweek 1) (> isoweek 53)) + (throw 'syntax "Week value is out of range")) + (if (or (< isoweekday 1) (> isoweekday 7)) + (throw 'syntax "Weekday value is out of range")) + (and hour + (progn + (if (or (< hour 0) + (> hour 24) + (and (= hour 24) + (not (= minute 0)) + (not (eq second 0)))) + (throw 'syntax "Hour value is out of range")) + (if (or (< minute 0) (> minute 59)) + (throw 'syntax "Minute value is out of range")) + (if (or (math-negp second) (not (Math-lessp second 60))) + (throw 'syntax "Seconds value is out of range")))) + (list 'date (math-iso-dt-to-date (append (list isoyear isoweek isoweekday) + (and hour (list hour minute second)))))) + (defun math-parse-date-word (names &optional front) (let ((n 1)) (while (and names (not (string-match (if (equal (car names) "Sep") @@ -918,6 +1132,7 @@ as measured in the integer number of days before January 1 of the year 1AD.") (let ((case-fold-search t) (okay t) num (fmt calc-date-format) this next (gnext nil) + (isoyear nil) (isoweek nil) (isoweekday nil) (year nil) (month nil) (day nil) (bigyear nil) (yearday nil) (hour nil) (minute nil) (second nil) (bc-flag nil)) (while (and fmt okay) @@ -994,19 +1209,35 @@ as measured in the integer number of days before January 1 of the year 1AD.") (if (string-match "\\`pm\\|p\\.m\\." math-pd-str) (setq hour (if (= hour 12) 12 (% (+ hour 12) 24)) math-pd-str (substring math-pd-str (match-end 0)))))) - ((memq this '(Y YY BY YYY YYYY)) + ((memq this '(Y YY BY YYY YYYY ZYYY)) (and (if (memq next '(MM DD ddd hh HH mm ss SS)) (if (memq this '(Y YY BYY)) (string-match "\\` *[0-9][0-9]" math-pd-str) (string-match "\\`[0-9][0-9][0-9][0-9]" math-pd-str)) (string-match "\\`[-+]?[0-9]+" math-pd-str)) (setq year (math-match-substring math-pd-str 0) - bigyear (or (eq this 'YYY) + bigyear (or (eq this 'YYY) (memq (aref math-pd-str 0) '(?\+ ?\-))) math-pd-str (substring math-pd-str (match-end 0)) - year (math-read-number year)))) + year (math-read-number year)) + (if (and (eq this 'ZYYY) (eq year 0)) + (setq year (math-sub year 1) + bigyear t) + t))) + ((eq this 'IYYY) + (if (string-match "\\`[-+]?[0-9]+" math-pd-str) + (setq isoyear (string-to-number (math-match-substring math-pd-str 0)) + math-pd-str (substring math-pd-str (match-end 0))))) + ((eq this 'Iww) + (if (string-match "W\\([0-9][0-9]\\)" math-pd-str) + (setq isoweek (string-to-number (math-match-substring math-pd-str 1)) + math-pd-str (substring math-pd-str 3)))) ((eq this 'b) t) + ((eq this 'T) + (if (eq (aref math-pd-str 0) ?T) + (setq math-pd-str (substring math-pd-str 1)) + t)) ((memq this '(aa AA aaaa AAAA)) (if (string-match "\\` *\\(ad\\|a\\.d\\.\\)" math-pd-str) (setq math-pd-str (substring math-pd-str (match-end 0))))) @@ -1041,7 +1272,9 @@ as measured in the integer number of days before January 1 of the year 1AD.") nil)) nil) ((eq this 'W) - (and (>= num 0) (< num 7))) + (and (>= num 0) (< num 7))) + ((eq this 'w) + (setq isoweekday num)) ((memq this '(d ddd bdd)) (setq yearday num)) ((memq this '(M MM BM)) @@ -1058,19 +1291,46 @@ as measured in the integer number of days before January 1 of the year 1AD.") (setq yearday nil) (setq month 1 day 1))) (if (and okay (equal math-pd-str "")) - (and month day (or (not (or hour minute second)) - (and hour minute)) - (progn - (or year (setq year (math-this-year))) - (or second (setq second 0)) - (if bc-flag - (setq year (math-neg (math-abs year)))) - (setq day (math-parse-date-validate year bigyear month day - hour minute second)) - (if yearday - (setq day (math-add day (1- yearday)))) - day))))) - + (if isoyear + (math-parse-iso-date-validate isoyear isoweek isoweekday hour minute second) + (and month day (or (not (or hour minute second)) + (and hour minute)) + (progn + (or year (setq year (math-this-year))) + (or second (setq second 0)) + (if bc-flag + (setq year (math-neg (math-abs year)))) + (setq day (math-parse-date-validate year bigyear month day + hour minute second)) + (if yearday + (setq day (math-add day (1- yearday)))) + day)))))) + +(defun math-parse-iso-date (math-pd-str) + "Parse MATH-PD-STR as an ISO week date, or return nil." + (let ((case-fold-search t) + (isoyear nil) (isoweek nil) (isoweekday nil) + (hour nil) (minute nil) (second nil)) + ;; Extract the time, if any. + (if (string-match "T[^0-9]*\\([0-9][0-9]\\)[^0-9]*\\([0-9][0-9]\\)?[^0-9]*\\([0-9][0-9]\\(\\.[0-9]+\\)?\\)?" math-pd-str) + (progn + (setq hour (string-to-number (math-match-substring math-pd-str 1)) + minute (math-match-substring math-pd-str 2) + second (math-match-substring math-pd-str 3) + math-pd-str (substring math-pd-str 0 (match-beginning 0))) + (if (equal minute "") + (setq minute 0) + (setq minute (string-to-number minute))) + (if (equal second "") + (setq second 0) + (setq second (math-read-number second))))) + ;; Next, the year, week and weekday + (if (string-match "\\(-?[0-9]*\\)[^0-9]*W\\([0-9][0-9]\\)[^0-9]*\\([0-9]\\)[^0-9]*\\'" math-pd-str) + (progn + (setq isoyear (string-to-number (math-match-substring math-pd-str 1)) + isoweek (string-to-number (math-match-substring math-pd-str 2)) + isoweekday (string-to-number (math-match-substring math-pd-str 3))) + (math-parse-iso-date-validate isoyear isoweek isoweekday hour minute second))))) (defun calcFunc-now (&optional zone) (let ((date (let ((calc-date-format nil)) @@ -1098,7 +1358,7 @@ as measured in the integer number of days before January 1 of the year 1AD.") (setq date (nth 1 date))) (or (math-realp date) (math-reject-arg date 'datep)) - (math-mod (math-add (math-floor date) 6) 7)) + (math-mod (math-floor date) 7)) (defun calcFunc-yearday (date) (let ((dt (math-date-to-dt date))) @@ -1298,7 +1558,7 @@ second, the number of seconds offset for daylight savings." 0))) (rounded-abs-date (+ - (calendar-absolute-from-gregorian + (calendar-absolute-from-gregorian (list (nth 1 dt) (nth 2 dt) (nth 0 dt))) (/ (round (* 60 time)) 60.0 24.0)))) (if (dst-in-effect rounded-abs-date) @@ -1434,28 +1694,100 @@ and ends on the last Sunday of October at 2 a.m." (and (math-messy-integerp day) (setq day (math-trunc day))) (or (integerp day) (math-reject-arg day 'fixnump)) (and (or (< day 0) (> day 31)) (math-reject-arg day 'range)) - (let ((dt (math-date-to-dt date))) - (if (or (= day 0) (> day (math-days-in-month (car dt) (nth 1 dt)))) - (setq day (math-days-in-month (car dt) (nth 1 dt)))) - (and (eq (car dt) 1752) (= (nth 1 dt) 9) - (if (>= day 14) (setq day (- day 11)))) - (list 'date (math-add (math-dt-to-date (list (car dt) (nth 1 dt) 1)) - (1- day))))) + (let* ((dt (math-date-to-dt date)) + (dim (math-days-in-month (car dt) (nth 1 dt))) + (julian (if calc-gregorian-switch + (math-date-to-dt (math-sub + (or (nth 3 calc-gregorian-switch) + (apply 'math-absolute-from-gregorian-dt calc-gregorian-switch)) + 1))))) + (if (or (= day 0) (> day dim)) + (setq day (1- dim)) + (setq day (1- day))) + ;; Adjust if this occurs near the switch to the Gregorian calendar + (if calc-gregorian-switch + (cond + ((and (math-dt-before-p (list (car dt) (nth 1 dt) 1) calc-gregorian-switch) + (math-dt-before-p julian (list (car dt) (nth 1 dt) 1))) + ;; In this case, CALC-GREGORIAN-SWITCH is the first day of the month + (list 'date + (math-dt-to-date (list (car calc-gregorian-switch) + (nth 1 calc-gregorian-switch) + (if (> (+ (nth 2 calc-gregorian-switch) day) dim) + dim + (+ (nth 2 calc-gregorian-switch) day)))))) + ((and (eq (car dt) (car calc-gregorian-switch)) + (= (nth 1 dt) (nth 1 calc-gregorian-switch))) + ;; In this case, the switch to the Gregorian calendar occurs in the given month + (if (< (+ (nth 2 julian) day) (nth 2 calc-gregorian-switch)) + ;; If the DAYth day occurs before the switch, use it + (list 'date (math-dt-to-date (list (car dt) (nth 1 dt) (1+ day)))) + ;; Otherwise do some computations + (let ((tm (+ day (- (nth 2 calc-gregorian-switch) (nth 2 julian))))) + (list 'date (math-dt-to-date + (list (car dt) + (nth 1 dt) + ;; + (if (> tm dim) dim tm))))))) + ((and (eq (car dt) (car julian)) + (= (nth 1 dt) (nth 1 julian))) + ;; In this case, the current month is truncated because of the switch + ;; to the Gregorian calendar + (list 'date (math-dt-to-date + (list (car dt) + (nth 1 dt) + (if (>= day (nth 2 julian)) + (nth 2 julian) + (1+ day)))))) + (t + ;; The default + (list 'date (math-add (math-dt-to-date (list (car dt) (nth 1 dt) 1)) day)))) + (list 'date (math-add (math-dt-to-date (list (car dt) (nth 1 dt) 1)) day))))) (defun calcFunc-newyear (date &optional day) + (if (eq (car-safe date) 'date) (setq date (nth 1 date))) (or day (setq day 1)) (and (math-messy-integerp day) (setq day (math-trunc day))) (or (integerp day) (math-reject-arg day 'fixnump)) - (let ((dt (math-date-to-dt date))) + (let* ((dt (math-date-to-dt date)) + (gregbeg (if calc-gregorian-switch + (or (nth 3 calc-gregorian-switch) + (apply 'math-absolute-from-gregorian-dt calc-gregorian-switch)))) + (julianend (if calc-gregorian-switch (math-sub gregbeg 1))) + (julian (if calc-gregorian-switch + (math-date-to-dt julianend)))) (if (and (>= day 0) (<= day 366)) - (let ((max (if (eq (car dt) 1752) 355 - (if (math-leap-year-p (car dt)) 366 365)))) + (let ((max (if (math-leap-year-p (car dt)) 366 365))) (if (or (= day 0) (> day max)) (setq day max)) - (list 'date (math-add (math-dt-to-date (list (car dt) 1 1)) - (1- day)))) + (if calc-gregorian-switch + ;; Now to break this down into cases + (cond + ((and (math-dt-before-p (list (car dt) 1 1) calc-gregorian-switch) + (math-dt-before-p julian (list (car dt) 1 1))) + ;; In this case, CALC-GREGORIAN-SWITCH is the first day of the year + (list 'date (math-min (math-add gregbeg (1- day)) + (math-dt-to-date (list (car calc-gregorian-switch) 12 31))))) + ((eq (car dt) (car julian)) + ;; In this case, the switch to the Gregorian calendar occurs in the given year + (if (Math-lessp (car julian) (car calc-gregorian-switch)) + ;; Here, the last Julian day is the last day of the year. + (list 'date (math-min (math-add (math-dt-to-date (list (car dt) 1 1)) (1- day)) + julianend)) + ;; Otherwise, just make sure the date doesn't go past the end of the year + (list 'date (math-min (math-add (math-dt-to-date (list (car dt) 1 1)) (1- day)) + (math-dt-to-date (list (car dt) 12 31)))))) + (t + (list 'date (math-add (math-dt-to-date (list (car dt) 1 1)) + (1- day))))) + (list 'date (math-add (math-dt-to-date (list (car dt) 1 1)) + (1- day))))) (if (and (>= day -12) (<= day -1)) - (list 'date (math-dt-to-date (list (car dt) (- day) 1))) - (math-reject-arg day 'range))))) + (if (and calc-gregorian-switch + (math-dt-before-p (list (car dt) (- day) 1) calc-gregorian-switch) + (math-dt-before-p julian (list (car dt) (- day) 1))) + (list 'date gregbeg) + (list 'date (math-dt-to-date (list (car dt) (- day) 1)))) + (math-reject-arg day 'range))))) (defun calcFunc-incmonth (date &optional step) (or step (setq step 1)) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index ddba0fecfea..c35e7650254 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -435,9 +435,9 @@ when converting units." (defcustom calc-highlight-selections-with-faces nil "If non-nil, use a separate face to indicate selected sub-formulas. -If `calc-show-selections' is non-nil, then selected sub-formulas are shown -by displaying the rest of the formula in `calc-nonselected-face'. -If `calc-show-selections' is nil, then selected sub-formulas are shown +If option `calc-show-selections' is non-nil, then selected sub-formulas are +shown by displaying the rest of the formula in `calc-nonselected-face'. +If option `calc-show-selections' is nil, then selected sub-formulas are shown by displaying the sub-formula in `calc-selected-face'." :version "24.1" :group 'calc @@ -464,6 +464,8 @@ to be identified as that note." :type 'string :group 'calc) +(defvar math-format-date-cache) ; calc-forms.el + (defface calc-nonselected-face '((t :inherit shadow :slant italic)) @@ -785,7 +787,9 @@ If nil, selections displayed but ignored.") "M-D-Y< H:mm:SSpp>" "D-M-Y< h:mm:SS>" "j<, h:mm:SS>" - "YYddd< hh:mm:ss>")) + "YYddd< hh:mm:ss>" + "ZYYY-MM-DD Www< hh:mm>" + "IYYY-Iww-w<Thh:mm:ss>")) (defcalcmodevar calc-autorange-units nil "If non-nil, automatically set unit prefixes to keep units in a reasonable range.") @@ -1179,7 +1183,7 @@ Used by `calc-user-invocation'.") ;;;###autoload (defun calc-dispatch (&optional arg) - "Invoke the GNU Emacs Calculator. See `calc-dispatch-help' for details." + "Invoke the GNU Emacs Calculator. See \\[calc-dispatch-help] for details." (interactive "P") ; (sit-for echo-keystrokes) (condition-case err ; look for other keys bound to calc-dispatch @@ -2020,6 +2024,50 @@ See calc-keypad for details." (calc-refresh align))) (setq calc-refresh-count (1+ calc-refresh-count))) +;; Dates that are built-in options for `calc-gregorian-switch' should be +;; (YEAR MONTH DAY math-date-from-gregorian-dt(YEAR MONTH DAY)) for speed. +(defcustom calc-gregorian-switch nil + "The first day the Gregorian calendar is used by Calc's date forms. +This is `nil' (the default) if the Gregorian calendar is the only one used. +Otherwise, it should be a list `(YEAR MONTH DAY)' when Calc begins to use +the Gregorian calendar; Calc will use the Julian calendar for earlier dates. +The dates in which different regions of the world began to use the +Gregorian calendar vary quite a bit, even within a single country. +If you want Calc's date forms to switch between the Julian and +Gregorian calendar, you can specify the date or choose from several +common choices. Some of these choices should be taken with a grain +of salt; for example different parts of France changed calendars at +different times, and Sweden's change to the Gregorian calendar was +complicated. Also, the boundaries of the countries were different at +the times of the calendar changes than they are now. +The Vatican decided that the Gregorian calendar should take effect +on 15 October 1582 (Gregorian), and many Catholic countries made +the change then. Great Britain and its colonies had the Gregorian +calendar take effect on 14 September 1752 (Gregorian); this includes +the United States." + :group 'calc + :version "24.4" + :type '(choice (const :tag "Always use the Gregorian calendar" nil) + (const :tag "1582-10-15 - Italy, Poland, Portugal, Spain" (1582 10 15 577736)) + (const :tag "1582-12-20 - France" (1582 12 20 577802)) + (const :tag "1582-12-25 - Luxemburg" (1582 12 25 577807)) + (const :tag "1584-01-17 - Bohemia and Moravia" (1584 1 17 578195)) + (const :tag "1587-11-01 - Hungary" (1587 11 1 579579)) + (const :tag "1700-03-01 - Denmark" (1700 3 1 620607)) + (const :tag "1701-01-12 - Protestant Switzerland" (1701 1 12 620924)) + (const :tag "1752-09-14 - Great Britain and dominions" (1752 9 14 639797)) + (const :tag "1753-03-01 - Sweden" (1753 3 1 639965)) + (const :tag "1918-02-14 - Russia" (1918 2 14 700214)) + (const :tag "1919-04-14 - Romania" (1919 4 14 700638)) + (list :tag "(YEAR MONTH DAY)" + (integer :tag "Year") + (integer :tag "Month (integer)") + (integer :tag "Day"))) + :set (lambda (symbol value) + (set-default symbol value) + (setq math-format-date-cache nil) + (calc-refresh))) + ;;;; The Calc Trail buffer. (defun calc-check-trail-aligned () diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 9b0eb3e9bff..74d3ce80338 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -1562,11 +1562,13 @@ line." (defun calendar-redraw () "Redraw the calendar display, if `calendar-buffer' is live." (interactive) - (if (get-buffer calendar-buffer) - (with-current-buffer calendar-buffer - (let ((cursor-date (calendar-cursor-to-nearest-date))) - (calendar-generate-window displayed-month displayed-year) - (calendar-cursor-to-visible-date cursor-date))))) + (when (get-buffer calendar-buffer) + (with-current-buffer calendar-buffer + (let ((cursor-date (calendar-cursor-to-nearest-date))) + (calendar-generate-window displayed-month displayed-year) + (calendar-cursor-to-visible-date cursor-date)) + (when (window-live-p (get-buffer-window)) + (set-window-point (get-buffer-window) (point)))))) (defvar calendar-mode-map (let ((map (make-keymap))) diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index af84f30dd46..71c8117364a 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -133,9 +133,7 @@ If DATE lacks timezone information, GMT is assumed." ;;;###autoload(if (or (featurep 'emacs) ;;;###autoload (and (fboundp 'float-time) ;;;###autoload (subrp (symbol-function 'float-time)))) -;;;###autoload (progn -;;;###autoload (defalias 'time-to-seconds 'float-time) -;;;###autoload (make-obsolete 'time-to-seconds 'float-time "21.1")) +;;;###autoload (defalias 'time-to-seconds 'float-time) ;;;###autoload (autoload 'time-to-seconds "time-date")) (eval-when-compile diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog index 07de8c79938..60c15e17184 100644 --- a/lisp/cedet/ChangeLog +++ b/lisp/cedet/ChangeLog @@ -1,17 +1,22 @@ -2012-11-14 David Engster <deng@randomsample.de> +2012-11-19 Stefan Monnier <monnier@iro.umontreal.ca> - * semantic/symref/list.el (semantic-symref-symbol): Use - `semantic-complete-read-tag-project' instead of + * semantic/fw.el (semantic-make-local-hook, semantic-mode-line-update): + Simplify via CSE. + +2012-11-16 David Engster <deng@randomsample.de> + + * semantic/symref/list.el (semantic-symref-symbol): + Use `semantic-complete-read-tag-project' instead of `semantic-complete-read-tag-buffer-deep', since the latter is not working correctly. - * semantic/symref.el (semantic-symref-result-get-tags): Use - `find-buffer-visiting' to follow symbolic links. + * semantic/symref.el (semantic-symref-result-get-tags): + Use `find-buffer-visiting' to follow symbolic links. * semantic/fw.el (semantic-find-file-noselect): Always set `enable-local-variables' to `:safe' when loading files. -2012-11-13 Glenn Morris <rgm@gnu.org> +2012-11-16 Glenn Morris <rgm@gnu.org> * semantic/lex-spp.el (semantic-lex-spp-lex-text-string): * semantic/util.el (semantic-describe-buffer): @@ -19,7 +24,7 @@ (semantic-default-c-setup): Use new names for hooks rather than obsolete aliases. -2012-11-12 Stefan Monnier <monnier@iro.umontreal.ca> +2012-11-13 Stefan Monnier <monnier@iro.umontreal.ca> * semantic/mru-bookmark.el (semantic-mru-bookmark-mode): * semantic/grammar.el (semantic-grammar-mode): @@ -27,7 +32,7 @@ (semantic-show-parser-state-mode): Avoid obsolete name semantic-edits-new-change-hooks (bug#12869). -2012-11-10 Glenn Morris <rgm@gnu.org> +2012-11-13 Glenn Morris <rgm@gnu.org> * srecode/srt-mode.el (srecode-template-mode): Don't change global values of comment-start, comment-end. (Bug#12781) diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el index 5e050112a54..dadf181ce21 100644 --- a/lisp/cedet/semantic/fw.el +++ b/lisp/cedet/semantic/fw.el @@ -122,15 +122,13 @@ ) - (if (and (not (featurep 'xemacs)) - (>= emacs-major-version 21)) - (defalias 'semantic-make-local-hook 'identity) - (defalias 'semantic-make-local-hook 'make-local-hook) - ) + (defalias 'semantic-make-local-hook + (if (and (not (featurep 'xemacs)) + (>= emacs-major-version 21)) + #'identity #'make-local-hook)) - (if (featurep 'xemacs) - (defalias 'semantic-mode-line-update 'redraw-modeline) - (defalias 'semantic-mode-line-update 'force-mode-line-update)) + (defalias 'semantic-mode-line-update + (if (featurep 'xemacs) #'redraw-modeline #'force-mode-line-update)) ;; Since Emacs 22 major mode functions should use `run-mode-hooks' to ;; run major mode hooks. diff --git a/lisp/color.el b/lisp/color.el index 70379611c4f..50f6675bf4b 100644 --- a/lisp/color.el +++ b/lisp/color.el @@ -33,9 +33,6 @@ ;;; Code: -(eval-when-compile - (require 'cl)) - ;; Emacs < 23.3 (eval-and-compile (unless (boundp 'float-pi) @@ -69,9 +66,9 @@ RED, GREEN, and BLUE should be numbers between 0.0 and 1.0, inclusive." COLOR-NAME should be a string naming a color (e.g. \"white\"), or a string specifying a color's RGB components (e.g. \"#ff12ec\")." (let ((color (color-name-to-rgb color-name))) - (list (- 1.0 (car color)) - (- 1.0 (cadr color)) - (- 1.0 (caddr color))))) + (list (- 1.0 (nth 0 color)) + (- 1.0 (nth 1 color)) + (- 1.0 (nth 2 color))))) (defun color-gradient (start stop step-number) "Return a list with STEP-NUMBER colors from START to STOP. @@ -133,7 +130,7 @@ inclusive." (max (max r g b)) (min (min r g b))) (if (< (- max min) 1e-8) - (list 0.0 0.0 0.0) + (list 0.0 0.0 min) (list (/ (* 2 float-pi (cond ((and (= r g) (= g b)) 0) @@ -149,7 +146,7 @@ inclusive." (+ 240 (* 60 (/ (- r g) (- max min))))))) 360) (if (= max 0) 0 (- 1 (/ min max))) - (/ max 255.0))))) + max)))) (defun color-rgb-to-hsl (red green blue) "Convert RGB colors to their HSL representation. diff --git a/lisp/comint.el b/lisp/comint.el index eda73af3501..21bd732b43c 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -1521,7 +1521,7 @@ Intended to be added to `isearch-mode-hook' in `comint-mode'." If there are no search errors, this function displays an overlay with the Isearch prompt which replaces the original comint prompt. Otherwise, it displays the standard Isearch message returned from -`isearch-message'." +the function `isearch-message'." (if (not (and isearch-success (not isearch-error))) ;; Use standard function `isearch-message' when not in comint prompt, ;; or search fails, or has an error (like incomplete regexp). @@ -2120,19 +2120,31 @@ This function should be in the list `comint-output-filter-functions'." ((bound-and-true-p follow-mode) (follow-comint-scroll-to-bottom)) (t - (let ((selected (selected-window))) - (dolist (w (get-buffer-window-list current nil t)) - (select-window w) - (unwind-protect - (progn - (comint-adjust-point selected) - ;; Optionally scroll to the bottom of the window. - (and comint-scroll-show-maximum-output - (eobp) - (recenter (- -1 scroll-margin)))) - (select-window selected)))))) + (dolist (w (get-buffer-window-list current nil t)) + (comint-adjust-window-point w process) + ;; Optionally scroll to the bottom of the window. + (and comint-scroll-show-maximum-output + (eq (window-point w) (point-max)) + (with-selected-window w + (recenter (- -1 scroll-margin))))))) (set-buffer current)))) + +(defun comint-adjust-window-point (window process) + "Move point in WINDOW based on Comint settings. +For point adjustment use the process-mark of PROCESS." + (and (< (window-point window) (process-mark process)) + (or (memq comint-move-point-for-output '(t all)) + ;; Maybe user wants point to jump to end. + (eq comint-move-point-for-output + (if (eq (selected-window) window) 'this 'others)) + ;; If point was at the end, keep it at end. + (and (marker-position comint-last-output-start) + (>= (window-point window) comint-last-output-start))) + (set-window-point window (process-mark process)))) + + +;; this function is nowhere used (defun comint-adjust-point (selected) "Move point in the selected window based on Comint settings. SELECTED is the window that was originally selected." @@ -3490,6 +3502,11 @@ This works by binding `inhibit-read-only' around the insertion. This is useful, for instance, for insertion into Help mode buffers. You probably want to set it locally to the output buffer.") +(defvar comint-redirect-previous-input-string nil + "Last redirected line of text. +Allows detection of the end of the redirection in case the +completion string is split between two output segments.") + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -3527,6 +3544,9 @@ and does not normally need to be invoked by the end user or programmer." (make-local-variable 'comint-redirect-completed) (setq comint-redirect-completed nil) + (make-local-variable 'comint-redirect-previous-input-string) + (setq comint-redirect-previous-input-string "") + (setq mode-line-process (if mode-line-process (list (concat (elt mode-line-process 0) " Redirection")) @@ -3535,6 +3555,8 @@ and does not normally need to be invoked by the end user or programmer." (defun comint-redirect-cleanup () "End a Comint redirection. See `comint-redirect-send-command'." (interactive) + ;; Release the last redirected string + (setq comint-redirect-previous-input-string nil) ;; Restore the process filter (set-process-filter (get-buffer-process (current-buffer)) comint-redirect-original-filter-function) @@ -3616,18 +3638,21 @@ This function does not need to be invoked by the end user." ;; Message (and comint-redirect-verbose - (message "Redirected output to buffer(s) %s" - (mapconcat 'identity output-buffer-list " "))) + (message "Redirected output to buffer(s) %s" output-buffer-list)) ;; If we see the prompt, tidy up ;; We'll look for the prompt in the original string, so nobody can ;; clobber it - (and (string-match comint-redirect-finished-regexp input-string) + (and (string-match comint-redirect-finished-regexp + (concat comint-redirect-previous-input-string + input-string)) (progn (and comint-redirect-verbose (message "Redirection completed")) (comint-redirect-cleanup) (run-hooks 'comint-redirect-hook))) + (setq comint-redirect-previous-input-string input-string) + ;; Echo input? (if comint-redirect-echo-input filtered-input-string diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 55c824cfe27..6d1ebe5a962 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -3679,15 +3679,10 @@ Optional EVENT is the location for the menu." (setq comment nil) ;; Make the comment invisible by hand if it's empty (custom-comment-hide comment-widget)) - (put symbol 'customized-face value) (custom-push-theme 'theme-face symbol 'user 'set value) - (if (face-spec-choose value) - (face-spec-set symbol value t) - ;; face-set-spec ignores empty attribute lists, so just give it - ;; something harmless instead. - (face-spec-set symbol '((t :foreground unspecified)) t)) - (put symbol 'customized-face-comment comment) + (face-spec-set symbol value 'customized-face) (put symbol 'face-comment comment) + (put symbol 'customized-face-comment comment) (custom-face-state-set widget) (custom-redraw-magic widget))) @@ -3696,20 +3691,14 @@ Optional EVENT is the location for the menu." (let* ((symbol (widget-value widget)) (value (custom-face-widget-to-spec widget)) (comment-widget (widget-get widget :comment-widget)) - (comment (widget-value comment-widget))) + (comment (widget-value comment-widget)) + (standard (eq (widget-get widget :custom-state) 'standard))) (when (equal comment "") (setq comment nil) ;; Make the comment invisible by hand if it's empty (custom-comment-hide comment-widget)) (custom-push-theme 'theme-face symbol 'user 'set value) - (if (face-spec-choose value) - (face-spec-set symbol value t) - ;; face-set-spec ignores empty attribute lists, so just give it - ;; something harmless instead. - (face-spec-set symbol '((t :foreground unspecified)) t)) - (unless (eq (widget-get widget :custom-state) 'standard) - (put symbol 'saved-face value)) - (put symbol 'customized-face nil) + (face-spec-set symbol value (if standard 'reset 'saved-face)) (put symbol 'face-comment comment) (put symbol 'customized-face-comment nil) (put symbol 'saved-face-comment comment))) @@ -3738,13 +3727,12 @@ uncustomized (themed or standard) face." (saved-face (get face 'saved-face)) (comment (get face 'saved-face-comment)) (comment-widget (widget-get widget :comment-widget))) - (put face 'customized-face nil) - (put face 'customized-face-comment nil) (custom-push-theme 'theme-face face 'user (if saved-face 'set 'reset) saved-face) - (face-spec-set face saved-face t) + (face-spec-set face saved-face 'saved-face) (put face 'face-comment comment) + (put face 'customized-face-comment nil) (widget-value-set child saved-face) ;; This call manages the comment visibility (widget-value-set comment-widget (or comment "")) @@ -3764,11 +3752,10 @@ redraw the widget immediately." (comment-widget (widget-get widget :comment-widget))) (unless value (user-error "No standard setting for this face")) - (put symbol 'customized-face nil) - (put symbol 'customized-face-comment nil) (custom-push-theme 'theme-face symbol 'user 'reset) - (face-spec-set symbol value t) - (custom-theme-recalc-face symbol) + (face-spec-set symbol value 'reset) + (put symbol 'face-comment nil) + (put symbol 'customized-face-comment nil) (if (and custom-reset-standard-faces-list (or (get symbol 'saved-face) (get symbol 'saved-face-comment))) ;; Do this later. @@ -3784,7 +3771,6 @@ redraw the widget immediately." (put symbol 'saved-face nil) (put symbol 'saved-face-comment nil) (custom-save-all)) - (put symbol 'face-comment nil) (widget-value-set child (custom-pre-filter-face-spec (list (list t (custom-face-attributes-get diff --git a/lisp/cus-face.el b/lisp/cus-face.el index 772a57e54fd..e1f1668d1ad 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el @@ -32,35 +32,14 @@ ;;; Declaring a face. (defun custom-declare-face (face spec doc &rest args) - "Like `defface', but FACE is evaluated as a normal argument." + "Like `defface', but with FACE evaluated as a normal argument." (unless (get face 'face-defface-spec) - (let ((facep (facep face))) - (unless facep - ;; If the user has already created the face, respect that. - (let ((value (or (get face 'saved-face) spec)) - (have-window-system (memq initial-window-system '(x w32)))) - ;; Create global face. - (make-empty-face face) - ;; Create frame-local faces - (dolist (frame (frame-list)) - (face-spec-set-2 face frame value) - (when (memq (window-system frame) '(x w32 ns)) - (setq have-window-system t))) - ;; When making a face after frames already exist - (if have-window-system - (make-face-x-resource-internal face)))) - ;; Don't record SPEC until we see it causes no errors. - (put face 'face-defface-spec (purecopy spec)) - (push (cons 'defface face) current-load-list) - (when (and doc (null (face-documentation face))) - (set-face-documentation face (purecopy doc))) - (custom-handle-all-keywords face args 'custom-face) - (run-hooks 'custom-define-hook) - ;; If the face had existing settings, recalculate it. For - ;; example, the user might load a theme with a face setting, and - ;; later load a library defining that face. - (if facep - (custom-theme-recalc-face face)))) + (face-spec-set face (purecopy spec) 'face-defface-spec) + (push (cons 'defface face) current-load-list) + (when doc + (set-face-documentation face (purecopy doc))) + (custom-handle-all-keywords face args 'custom-face) + (run-hooks 'custom-define-hook)) face) ;;; Face attributes. @@ -343,10 +322,7 @@ Several properties of THEME and FACE are used in the process: If THEME property `theme-immediate' is non-nil, this is equivalent of providing the NOW argument to all faces in the argument list: FACE is -created now. The only difference is FACE property `force-face': if NOW -is non-nil, FACE property `force-face' is set to the symbol `rogue', else -if THEME property `theme-immediate' is non-nil, FACE property `force-face' -is set to the symbol `immediate'. +created now. SPEC itself is saved in FACE property `saved-face' and it is stored in FACE's list property `theme-face' \(using `custom-push-theme')." @@ -371,15 +347,11 @@ FACE's list property `theme-face' \(using `custom-push-theme')." (when (not (and oldspec (eq 'user (caar oldspec)))) (put face 'saved-face spec) (put face 'saved-face-comment comment)) - ;; Do this AFTER checking the `theme-face' property. (custom-push-theme 'theme-face face theme 'set spec) (when (or now immediate) (put face 'force-face (if now 'rogue 'immediate))) (when (or now immediate (facep face)) - (unless (facep face) - (make-empty-face face)) (put face 'face-comment comment) - (put face 'face-override-spec nil) (face-spec-set face spec t)))))))) ;; XEmacs compatibility function. In XEmacs, when you reset a Custom diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 964c1185971..62e91fafcbf 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -51,6 +51,19 @@ (gc-cons-percentage alloc float) (garbage-collection-messages alloc boolean) ;; buffer.c + (cursor-type + display + (choice + (const :tag "Frame default" t) + (const :tag "Filled box" box) + (const :tag "Hollow cursor" hollow) + (const :tag "Vertical bar" bar) + (cons :tag "Vertical bar with specified width" + (const bar) integer) + (const :tag "Horizontal bar" hbar) + (cons :tag "Horizontal bar with specified width" + (const hbar) integer) + (const :tag "None "nil))) (mode-line-format mode-line sexp) ;Hard to do right. (major-mode internal function) (case-fold-search matching boolean) @@ -102,12 +115,12 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (const :tag "On the right" (down . right)))) (other :tag "On left, no arrows" t))) (scroll-up-aggressively windows - (choice (const :tag "off" nil) number) + (choice (const :tag "off" nil) float) "21.1") (scroll-down-aggressively windows - (choice (const :tag "off" nil) number) + (choice (const :tag "off" nil) float) "21.1") - (line-spacing display (choice (const :tag "none" nil) integer) + (line-spacing display (choice (const :tag "none" nil) number) "22.1") (cursor-in-non-selected-windows cursor boolean nil @@ -500,6 +513,7 @@ since it could result in memory overflow and make Emacs crash." (x-use-underline-position-properties display boolean "22.1") (x-underline-at-descent-line display boolean "22.1") (x-stretch-cursor display boolean "21.1") + (scroll-bar-adjust-thumb-portion windows boolean "24.4") ;; xselect.c (x-select-enable-clipboard-manager killing boolean "24.1") ;; xsettings.c @@ -562,6 +576,9 @@ since it could result in memory overflow and make Emacs crash." (symbol-name symbol)) ;; Any function from fontset.c will do. (fboundp 'new-fontset)) + ((equal "scroll-bar-adjust-thumb-portion" + (symbol-name symbol)) + (featurep 'x)) (t t)))) (if (not (boundp symbol)) ;; If variables are removed from C code, give an error here! diff --git a/lisp/custom.el b/lisp/custom.el index 9c18c827d41..4cf9609123a 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -949,7 +949,6 @@ prior to evaluating EXP). COMMENT is a comment string about SYMBOL." (custom-check-theme theme) - ;; Process all the needed autoloads before anything else, so that the ;; subsequent code has all the info it needs (e.g. which var corresponds ;; to a minor mode), regardless of the ordering of the variables. @@ -959,29 +958,7 @@ COMMENT is a comment string about SYMBOL." (memq (get symbol 'custom-autoload) '(nil noset))) ;; This symbol needs to be autoloaded, even just for a `set'. (custom-load-symbol symbol)))) - - ;; Move minor modes and variables with explicit requires to the end. - (setq args - (sort args - (lambda (a1 a2) - (let* ((sym1 (car a1)) - (sym2 (car a2)) - (1-then-2 (memq sym1 (get sym2 'custom-dependencies))) - (2-then-1 (memq sym2 (get sym1 'custom-dependencies)))) - (cond ((and 1-then-2 2-then-1) - (error "Circular custom dependency between `%s' and `%s'" - sym1 sym2)) - (2-then-1 nil) - ;; 1 is a dependency of 2, so needs to be set first. - (1-then-2) - ;; Put minor modes and symbols with :require last. - ;; Putting minor modes last ensures that the mode - ;; function will see other customized values rather - ;; than default values. - (t (or (nth 3 a2) - (eq (get sym2 'custom-set) - 'custom-set-minor-mode)))))))) - + (setq args (custom--sort-vars args)) (dolist (entry args) (unless (listp entry) (error "Incompatible Custom theme spec")) @@ -1015,6 +992,60 @@ COMMENT is a comment string about SYMBOL." (and (or now (default-boundp symbol)) (put symbol 'variable-comment comment))))))) +(defvar custom--sort-vars-table) +(defvar custom--sort-vars-result) + +(defun custom--sort-vars (vars) + "Sort VARS based on custom dependencies. +VARS is a list whose elements have the same form as the ARGS +arguments to `custom-theme-set-variables'. Return the sorted +list, in which A occurs before B if B was defined with a +`:set-after' keyword specifying A (see `defcustom')." + (let ((custom--sort-vars-table (make-hash-table)) + (dependants (make-hash-table)) + (custom--sort-vars-result nil) + last) + ;; Construct a pair of tables keyed with the symbols of VARS. + (dolist (var vars) + (puthash (car var) (cons t var) custom--sort-vars-table) + (puthash (car var) var dependants)) + ;; From the second table, remove symbols that are depended-on. + (dolist (var vars) + (dolist (dep (get (car var) 'custom-dependencies)) + (remhash dep dependants))) + ;; If a variable is "stand-alone", put it last if it's a minor + ;; mode or has a :require flag. This is not really necessary, but + ;; putting minor modes last helps ensure that the mode function + ;; sees other customized values rather than default values. + (maphash (lambda (sym var) + (when (and (null (get sym 'custom-dependencies)) + (or (nth 3 var) + (eq (get sym 'custom-set) + 'custom-set-minor-mode))) + (remhash sym dependants) + (push var last))) + dependants) + ;; The remaining symbols depend on others but are not + ;; depended-upon. Do a depth-first topological sort. + (maphash #'custom--sort-vars-1 dependants) + (nreverse (append last custom--sort-vars-result)))) + +(defun custom--sort-vars-1 (sym &optional _ignored) + (let ((elt (gethash sym custom--sort-vars-table))) + ;; The car of the hash table value is nil if the variable has + ;; already been processed, `dependant' if it is a dependant in the + ;; current graph descent, and t otherwise. + (when elt + (cond + ((eq (car elt) 'dependant) + (error "Circular custom dependency on `%s'" sym)) + ((car elt) + (setcar elt 'dependant) + (dolist (dep (get sym 'custom-dependencies)) + (custom--sort-vars-1 dep)) + (setcar elt nil) + (push (cdr elt) custom--sort-vars-result)))))) + ;;; Defining themes. diff --git a/lisp/descr-text.el b/lisp/descr-text.el index 005f5d8cb72..b3f78780bd3 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -375,6 +375,8 @@ This function is semi-obsolete. Use `get-char-code-property'." (format "%c:%s" x doc))) mnemonics ", "))))) +(declare-function quail-find-key "quail" (char)) + ;;;###autoload (defun describe-char (pos &optional buffer) "Describe position POS (interactively, point) and the char after POS. diff --git a/lisp/desktop.el b/lisp/desktop.el index 9a55bcc4283..1151bd434bc 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -826,7 +826,7 @@ MODE is the major mode. (or (and filename (stringp desktop-files-not-to-save) (not (string-match desktop-files-not-to-save filename))) - (and (eq mode 'dired-mode) + (and (memq mode '(dired-mode vc-dir-mode)) (with-current-buffer bufname (not (setq dired-skip (string-match desktop-files-not-to-save diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 7c0def7f809..a2c13033cd1 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -1115,6 +1115,7 @@ See `dired-guess-shell-alist-user'." (if (null default) ;; Nothing to guess (read-shell-command prompt nil 'dired-shell-command-history) + (setq prompt (replace-regexp-in-string ": $" " " prompt)) (if (listp default) ;; More than one guess (setq default-list default @@ -1125,7 +1126,7 @@ See `dired-guess-shell-alist-user'." ;; Just one guess (setq default-list (list default))) ;; Put the first guess in the prompt but not in the initial value. - (setq prompt (concat prompt (format "[%s] " default))) + (setq prompt (concat prompt (format "[%s]: " default))) ;; All guesses can be retrieved with M-n (setq val (read-shell-command prompt nil 'dired-shell-command-history diff --git a/lisp/dired.el b/lisp/dired.el index 76809f992cc..30069488586 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -3734,6 +3734,7 @@ Ask means pop up a menu for the user to select one of copy, move or link." ;;;; Desktop support (eval-when-compile (require 'desktop)) +(declare-function desktop-file-name "desktop" (filename dirname)) (defun dired-desktop-buffer-misc-data (dirname) "Auxiliary information to be saved in desktop file." @@ -4296,7 +4297,7 @@ instead. ;;;*** ;;;### (autoloads (dired-do-relsymlink dired-jump-other-window dired-jump) -;;;;;; "dired-x" "dired-x.el" "ce753ade80ea9f4e64ab3569e3a5421e") +;;;;;; "dired-x" "dired-x.el" "cdaacce7c861256289ba48493dd6d0ec") ;;; Generated autoloads from dired-x.el (autoload 'dired-jump "dired-x" "\ diff --git a/lisp/dirtrack.el b/lisp/dirtrack.el index 4cc1cebd3b8..e73cf279e51 100644 --- a/lisp/dirtrack.el +++ b/lisp/dirtrack.el @@ -220,6 +220,9 @@ the mode if ARG is omitted or nil." (goto-char (point-max)) (insert msg1 msg2 "\n")))) +(declare-function shell-prefixed-directory-name "shell" (dir)) +(declare-function shell-process-cd "shell" (arg)) + ;;;###autoload (defun dirtrack (input) "Determine the current directory from the process output for a prompt. diff --git a/lisp/doc-view.el b/lisp/doc-view.el index ad1ff848112..30aa3a09bf2 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -145,7 +145,7 @@ ;;;; Customization Options (defgroup doc-view nil - "In-buffer viewer for PDF, PostScript and DVI files." + "In-buffer viewer for PDF, PostScript, DVI, and DJVU files." :link '(function-link doc-view) :version "22.2" :group 'applications @@ -158,6 +158,27 @@ :type 'file :group 'doc-view) +(defcustom doc-view-pdfdraw-program + (cond + ((executable-find "pdfdraw") "pdfdraw") + (t "mudraw")) + "Name of MuPDF's program to convert PDF files to PNG." + :type 'file + :version "24.4") + +(defcustom doc-view-pdf->png-converter-function + (if (executable-find doc-view-pdfdraw-program) + #'doc-view-pdf->png-converter-mupdf + #'doc-view-pdf->png-converter-ghostscript) + "Function to call to convert a PDF file into a PNG file." + :type '(radio + (function-item doc-view-pdf->png-converter-ghostscript + :doc "Use ghostscript") + (function-item doc-view-pdf->png-converter-mupdf + :doc "Use mupdf") + function) + :version "24.4") + (defcustom doc-view-ghostscript-options '("-dSAFER" ;; Avoid security problems when rendering files from untrusted ;; sources. @@ -173,9 +194,17 @@ Higher values result in larger images." :type 'number :group 'doc-view) +(defcustom doc-view-scale-internally t + "Whether we should try to rescale images ourselves. +If nil, the document is re-rendered every time the scaling factor is modified. +This only has an effect if the image libraries linked with Emacs support +scaling." + :type 'boolean) + (defcustom doc-view-image-width 850 "Default image width. -Has only an effect if imagemagick support is compiled into emacs." +Has only an effect if `doc-view-scale-internally' is non-nil and support for +scaling is compiled into emacs." :version "24.1" :type 'number :group 'doc-view) @@ -312,6 +341,19 @@ the (uncompressed, extracted) file residing in "The type of document in the current buffer. Can be `dvi', `pdf', or `ps'.") +(defvar doc-view-single-page-converter-function nil + "Function to call to convert a single page of the document to a bitmap file. +May operate on the source document or on some intermediate (typically PDF) +conversion of it.") + +(defvar-local doc-view--image-type nil + "The type of image in the current buffer. +Can be `png' or `tiff'.") + +(defvar-local doc-view--image-file-pattern nil + "The `format' pattern of image file names. +Typically \"page-%s.png\".") + ;;;; DocView Keymaps (defvar doc-view-mode-map @@ -450,24 +492,26 @@ Can be `dvi', `pdf', or `ps'.") ;; We used to find the file name from doc-view-current-files but ;; that's not right if the pages are not generated sequentially ;; or if the page isn't in doc-view-current-files yet. - (let ((file (expand-file-name (format "page-%d.png" page) - (doc-view-current-cache-dir)))) + (let ((file (expand-file-name + (format doc-view--image-file-pattern page) + (doc-view-current-cache-dir)))) (doc-view-insert-image file :pointer 'arrow) (set-window-hscroll (selected-window) hscroll) (when (and (not (file-exists-p file)) doc-view-current-converter-processes) ;; The PNG file hasn't been generated yet. - (doc-view-pdf->png-1 doc-view-buffer-file-name file page - (let ((win (selected-window))) - (lambda () - (and (eq (current-buffer) (window-buffer win)) - ;; If we changed page in the mean - ;; time, don't mess things up. - (eq (doc-view-current-page win) page) - ;; Make sure we don't infloop. - (file-readable-p file) - (with-selected-window win - (doc-view-goto-page page)))))))) + (funcall doc-view-single-page-converter-function + doc-view-buffer-file-name file page + (let ((win (selected-window))) + (lambda () + (and (eq (current-buffer) (window-buffer win)) + ;; If we changed page in the mean + ;; time, don't mess things up. + (eq (doc-view-current-page win) page) + ;; Make sure we don't infloop. + (file-readable-p file) + (with-selected-window win + (doc-view-goto-page page)))))))) (overlay-put (doc-view-current-overlay) 'help-echo (doc-view-current-info)))) @@ -651,14 +695,16 @@ OpenDocument format)." (executable-find doc-view-dvipdf-program)) (and doc-view-dvipdfm-program (executable-find doc-view-dvipdfm-program))))) - ((or (eq type 'postscript) (eq type 'ps) (eq type 'eps) - (eq type 'pdf)) + ((memq type '(postscript ps eps pdf)) + ;; FIXME: allow mupdf here (and doc-view-ghostscript-program (executable-find doc-view-ghostscript-program))) ((eq type 'odf) (and doc-view-unoconv-program (executable-find doc-view-unoconv-program) (doc-view-mode-p 'pdf))) + ((eq type 'djvu) + (executable-find "ddjvu")) (t ;; unknown image type nil)))) @@ -669,18 +715,19 @@ OpenDocument format)." (defun doc-view-enlarge (factor) "Enlarge the document by FACTOR." (interactive (list doc-view-shrink-factor)) - (if (eq (plist-get (cdr (doc-view-current-image)) :type) - 'imagemagick) + (if (and doc-view-scale-internally + (eq (plist-get (cdr (doc-view-current-image)) :type) + 'imagemagick)) ;; ImageMagick supports on-the-fly-rescaling. (let ((new (ceiling (* factor doc-view-image-width)))) (unless (equal new doc-view-image-width) - (set (make-local-variable 'doc-view-image-width) new) + (setq-local doc-view-image-width new) (doc-view-insert-image (plist-get (cdr (doc-view-current-image)) :file) :width doc-view-image-width))) (let ((new (ceiling (* factor doc-view-resolution)))) (unless (equal new doc-view-resolution) - (set (make-local-variable 'doc-view-resolution) new) + (setq-local doc-view-resolution new) (doc-view-reconvert-doc))))) (defun doc-view-shrink (factor) @@ -817,6 +864,45 @@ Should be invoked when the cached images aren't up-to-date." (list "-o" pdf dvi) callback))) +(defun doc-view-pdf->png-converter-ghostscript (pdf png page callback) + (doc-view-start-process + "pdf/ps->png" doc-view-ghostscript-program + `(,@doc-view-ghostscript-options + ,(format "-r%d" (round doc-view-resolution)) + ,@(if page `(,(format "-dFirstPage=%d" page))) + ,@(if page `(,(format "-dLastPage=%d" page))) + ,(concat "-sOutputFile=" png) + ,pdf) + callback)) + +(defalias 'doc-view-ps->png-converter-ghostscript + 'doc-view-pdf->png-converter-ghostscript) + +(defun doc-view-djvu->tiff-converter-ddjvu (djvu tiff page callback) + "Convert PAGE of a DJVU file to bitmap(s) asynchronously. +Call CALLBACK with no arguments when done. +If PAGE is nil, convert the whole document." + (doc-view-start-process + "djvu->tiff" "ddjvu" + `("-format=tiff" + ;; ddjvu only accepts the range 1-999. + ,(format "-scale=%d" (round doc-view-resolution)) + ;; -eachpage was only added after djvulibre-3.5.25.3! + ,@(unless page '("-eachpage")) + ,@(if page `(,(format "-page=%d" page))) + ,djvu + ,tiff) + callback)) + +(defun doc-view-pdf->png-converter-mupdf (pdf png page callback) + (doc-view-start-process + "pdf->png" doc-view-pdfdraw-program + `(,(concat "-o" png) + ,(format "-r%d" (round doc-view-resolution)) + ,pdf + ,@(if page `(,(format "%d" page)))) + callback)) + (defun doc-view-odf->pdf (odf callback) "Convert ODF to PDF asynchronously and call CALLBACK when finished. The converted PDF is put into the current cache directory, and it @@ -826,13 +912,14 @@ is named like ODF with the extension turned to pdf." callback)) (defun doc-view-pdf/ps->png (pdf-ps png) + ;; FIXME: Fix name and docstring to account for djvu&tiff. "Convert PDF-PS to PNG asynchronously." - (doc-view-start-process - "pdf/ps->png" doc-view-ghostscript-program - (append doc-view-ghostscript-options - (list (format "-r%d" (round doc-view-resolution)) - (concat "-sOutputFile=" png) - pdf-ps)) + (funcall + (pcase doc-view-doc-type + (`pdf doc-view-pdf->png-converter-function) + (`djvu #'doc-view-djvu->tiff-converter-ddjvu) + (_ #'doc-view-ps->png-converter-ghostscript)) + pdf-ps png nil (let ((resolution doc-view-resolution)) (lambda () ;; Only create the resolution file when it's all done, so it also @@ -845,6 +932,7 @@ is named like ODF with the extension turned to pdf." (cancel-timer doc-view-current-timer) (setq doc-view-current-timer nil)) (doc-view-display (current-buffer) 'force)))) + ;; Update the displayed pages as soon as they're done generating. (when doc-view-conversion-refresh-interval (setq doc-view-current-timer @@ -852,25 +940,10 @@ is named like ODF with the extension turned to pdf." 'doc-view-display (current-buffer))))) -(defun doc-view-pdf->png-1 (pdf png page callback) - "Convert a PAGE of a PDF file to PNG asynchronously. -Call CALLBACK with no arguments when done." - (doc-view-start-process - "pdf->png-1" doc-view-ghostscript-program - (append doc-view-ghostscript-options - (list (format "-r%d" (round doc-view-resolution)) - ;; Sadly, `gs' only supports the page-range - ;; for PDF files. - (format "-dFirstPage=%d" page) - (format "-dLastPage=%d" page) - (concat "-sOutputFile=" png) - pdf)) - callback)) - (declare-function clear-image-cache "image.c" (&optional filter)) -(defun doc-view-pdf->png (pdf png pages) - "Convert a PDF file to PNG asynchronously. +(defun doc-view-document->bitmap (pdf png pages) + "Convert a document file to bitmap images asynchronously. Start by converting PAGES, and then the rest." (if (null pages) (doc-view-pdf/ps->png pdf png) @@ -879,11 +952,11 @@ Start by converting PAGES, and then the rest." ;; a single page anyway, and of the remaining 1%, few cases will have ;; consecutive pages, it's not worth the trouble. (let ((rest (cdr pages))) - (doc-view-pdf->png-1 - pdf (format png (car pages)) (car pages) + (funcall doc-view-single-page-converter-function + pdf (format png (car pages)) (car pages) (lambda () (if rest - (doc-view-pdf->png pdf png rest) + (doc-view-document->bitmap pdf png rest) ;; Yippie, the important pages are done, update the display. (clear-image-cache) ;; For the windows that have a message (like "Welcome to @@ -891,8 +964,8 @@ Start by converting PAGES, and then the rest." ;; not sufficient. (dolist (win (get-buffer-window-list (current-buffer) nil 'visible)) (with-selected-window win - (when (stringp (get-char-property (point-min) 'display)) - (doc-view-goto-page (doc-view-current-page))))) + (when (stringp (get-char-property (point-min) 'display)) + (doc-view-goto-page (doc-view-current-page))))) ;; Convert the rest of the pages. (doc-view-pdf/ps->png pdf png))))))) @@ -962,8 +1035,9 @@ Those files are saved in the directory given by the function ;; preserves the horizontal/vertical scroll settings (which are otherwise ;; resets during the redisplay). (setq doc-view-pending-cache-flush t) - (let ((png-file (expand-file-name "page-%d.png" - (doc-view-current-cache-dir)))) + (let ((png-file (expand-file-name + (format doc-view--image-file-pattern "%d") + (doc-view-current-cache-dir)))) (make-directory (doc-view-current-cache-dir) t) (pcase doc-view-doc-type (`dvi @@ -976,11 +1050,12 @@ Those files are saved in the directory given by the function ;; ODF files have to be converted to PDF before Ghostscript can ;; process it. (let ((pdf (doc-view-current-cache-doc-pdf)) - (opdf (expand-file-name (concat (file-name-base doc-view-buffer-file-name) - ".pdf") - doc-view-current-cache-dir)) + (opdf (expand-file-name + (concat (file-name-base doc-view-buffer-file-name) + ".pdf") + doc-view-current-cache-dir)) (png-file png-file)) - ;; The unoconv tool only supports a output directory, but no + ;; The unoconv tool only supports an output directory, but no ;; file name. It's named like the input file with the ;; extension replaced by pdf. (doc-view-odf->pdf doc-view-buffer-file-name @@ -988,10 +1063,10 @@ Those files are saved in the directory given by the function ;; Rename to doc.pdf (rename-file opdf pdf) (doc-view-pdf/ps->png pdf png-file))))) - (`pdf + ((or `pdf `djvu) (let ((pages (doc-view-active-pages))) - ;; Convert PDF to PNG images starting with the active pages. - (doc-view-pdf->png doc-view-buffer-file-name png-file pages))) + ;; Convert doc to bitmap images starting with the active pages. + (doc-view-document->bitmap doc-view-buffer-file-name png-file pages))) (_ ;; Convert to PNG images. (doc-view-pdf/ps->png doc-view-buffer-file-name png-file))))) @@ -1102,9 +1177,10 @@ much more accurate than could be done manually using (let* ((is (image-size (doc-view-current-image) t)) (iw (car is)) (ih (cdr is)) - (ps (or (and (null force-paper-size) (doc-view-guess-paper-size iw ih)) + (ps (or (and (null force-paper-size) + (doc-view-guess-paper-size iw ih)) (intern (completing-read "Paper size: " - (mapcar #'car doc-view-paper-sizes) + doc-view-paper-sizes nil t)))) (bb (doc-view-scale-bounding-box ps iw ih bb)) (x1 (nth 0 bb)) @@ -1133,10 +1209,11 @@ ARGS is a list of image descriptors." (setq doc-view-pending-cache-flush nil)) (let ((ol (doc-view-current-overlay)) (image (if (and file (file-readable-p file)) - (if (not (fboundp 'imagemagick-types)) - (apply 'create-image file 'png nil args) + (if (not (and doc-view-scale-internally + (fboundp 'imagemagick-types))) + (apply 'create-image file doc-view--image-type nil args) (unless (member :width args) - (setq args (append args (list :width doc-view-image-width)))) + (setq args `(,@args :width ,doc-view-image-width))) (apply 'create-image file 'imagemagick nil args)))) (slice (doc-view-current-slice))) (setf (doc-view-current-image) image) @@ -1184,13 +1261,18 @@ have the page we want to view." (let ((prev-pages doc-view-current-files)) (setq doc-view-current-files (sort (directory-files (doc-view-current-cache-dir) t - "page-[0-9]+\\.png" t) + (format doc-view--image-file-pattern + "[0-9]+") + t) 'doc-view-sort)) + (unless (eq (length prev-pages) (length doc-view-current-files)) + (force-mode-line-update)) (dolist (win (or (get-buffer-window-list buffer nil t) (list t))) (let* ((page (doc-view-current-page win)) - (pagefile (expand-file-name (format "page-%d.png" page) - (doc-view-current-cache-dir)))) + (pagefile (expand-file-name + (format doc-view--image-file-pattern page) + (doc-view-current-cache-dir)))) (when (or force (and (not (member pagefile prev-pages)) (member pagefile doc-view-current-files))) @@ -1255,7 +1337,7 @@ For now these keys are useful: (doc-view-kill-proc) (setq buffer-read-only nil) (remove-overlays (point-min) (point-max) 'doc-view t) - (set (make-local-variable 'image-mode-winprops-alist) t) + (setq-local image-mode-winprops-alist t) ;; Switch to the previously used major mode or fall back to ;; normal mode. (doc-view-fallback-mode) @@ -1383,12 +1465,13 @@ If BACKWARD is non-nil, jump to the previous match." ;; the conversion is incomplete. (file-readable-p (expand-file-name "resolution.el" (doc-view-current-cache-dir))) - (> (length (directory-files (doc-view-current-cache-dir) - nil "\\.png\\'")) + (> (length (directory-files + (doc-view-current-cache-dir) + nil (format doc-view--image-file-pattern "[0-9]+"))) 0))) (defun doc-view-initiate-display () - ;; Switch to image display if possible + ;; Switch to image display if possible. (if (doc-view-mode-p doc-view-doc-type) (progn (doc-view-buffer-message) @@ -1396,7 +1479,7 @@ If BACKWARD is non-nil, jump to the previous match." (if (doc-view-already-converted-p) (progn (message "DocView: using cached files!") - ;; Load the saved resolution + ;; Load the saved resolution. (let* ((res-file (expand-file-name "resolution.el" (doc-view-current-cache-dir))) (res @@ -1405,7 +1488,7 @@ If BACKWARD is non-nil, jump to the previous match." (insert-file-contents res-file) (read (current-buffer)))))) (when (numberp res) - (set (make-local-variable 'doc-view-resolution) res))) + (setq-local doc-view-resolution res))) (doc-view-display (current-buffer) 'force)) (doc-view-convert-current-doc)) (message @@ -1457,6 +1540,8 @@ If BACKWARD is non-nil, jump to the previous match." ("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) @@ -1471,14 +1556,25 @@ If BACKWARD is non-nil, jump to the previous match." (cond ((looking-at "%!") '(ps)) ((looking-at "%PDF") '(pdf)) - ((looking-at "\367\002") '(dvi)))))) - (set (make-local-variable 'doc-view-doc-type) - (car (or (doc-view-intersection name-types content-types) - (when (and name-types content-types) - (error "Conflicting types: name says %s but content says %s" - name-types content-types)) - name-types content-types - (error "Cannot determine the document type")))))) + ((looking-at "\367\002") '(dvi)) + ((looking-at "AT&TFORM") '(djvu)))))) + (setq-local doc-view-doc-type + (car (or (doc-view-intersection name-types content-types) + (when (and name-types content-types) + (error "Conflicting types: name says %s but content says %s" + name-types content-types)) + name-types content-types + (error "Cannot determine the document type")))))) + +(defun doc-view-set-up-single-converter () + "Find the right single-page converter for the current document type" + (pcase-let ((`(,conv-function ,type ,extension) + (pcase doc-view-doc-type + (`djvu (list #'doc-view-djvu->tiff-converter-ddjvu 'tiff "tif")) + (_ (list doc-view-pdf->png-converter-function 'png "png"))))) + (setq-local doc-view-single-page-converter-function conv-function) + (setq-local doc-view--image-type type) + (setq-local doc-view--image-file-pattern (concat "page-%s." extension)))) ;;;###autoload (defun doc-view-mode () @@ -1503,8 +1599,7 @@ toggle between displaying the document or editing it as text. (unless (eq major-mode 'fundamental-mode) major-mode)))) (kill-all-local-variables) - (set (make-local-variable 'doc-view-previous-major-mode) - prev-major-mode)) + (setq-local doc-view-previous-major-mode prev-major-mode)) (dolist (var doc-view-saved-settings) (set (make-local-variable (car var)) (cdr var))) @@ -1512,10 +1607,11 @@ toggle between displaying the document or editing it as text. ;; Figure out the document type. (unless doc-view-doc-type (doc-view-set-doc-type)) + (doc-view-set-up-single-converter) (doc-view-make-safe-dir doc-view-cache-directory) ;; Handle compressed files, remote files, files inside archives - (set (make-local-variable 'doc-view-buffer-file-name) + (setq-local doc-view-buffer-file-name (cond (jka-compr-really-do-compress ;; FIXME: there's a risk of name conflicts here. @@ -1554,20 +1650,19 @@ toggle between displaying the document or editing it as text. 'doc-view-new-window-function nil t) (image-mode-setup-winprops) - (set (make-local-variable 'mode-line-position) - '(" P" (:eval (number-to-string (doc-view-current-page))) - "/" (:eval (number-to-string (doc-view-last-page-number))))) + (setq-local mode-line-position + '(" P" (:eval (number-to-string (doc-view-current-page))) + "/" (:eval (number-to-string (doc-view-last-page-number))))) ;; Don't scroll unless the user specifically asked for it. - (set (make-local-variable 'auto-hscroll-mode) nil) - (set (make-local-variable 'mwheel-scroll-up-function) - 'doc-view-scroll-up-or-next-page) - (set (make-local-variable 'mwheel-scroll-down-function) - 'doc-view-scroll-down-or-previous-page) - (set (make-local-variable 'cursor-type) nil) + (setq-local auto-hscroll-mode nil) + (setq-local mwheel-scroll-up-function #'doc-view-scroll-up-or-next-page) + (setq-local mwheel-scroll-down-function + #'doc-view-scroll-down-or-previous-page) + (setq-local cursor-type nil) (use-local-map doc-view-mode-map) - (set (make-local-variable 'after-revert-hook) 'doc-view-reconvert-doc) - (set (make-local-variable 'bookmark-make-record-function) - 'doc-view-bookmark-make-record) + (add-hook 'after-revert-hook 'doc-view-reconvert-doc nil t) + (setq-local bookmark-make-record-function + #'doc-view-bookmark-make-record) (setq mode-name "DocView" buffer-read-only t major-mode 'doc-view-mode) @@ -1576,7 +1671,7 @@ toggle between displaying the document or editing it as text. ;; canonical view mode for PDF/PS/DVI files. This could be ;; switched on automatically depending on the value of ;; `view-read-only'. - (set (make-local-variable 'view-read-only) nil) + (setq-local view-read-only nil) (run-mode-hooks 'doc-view-mode-hook))) (defun doc-view-fallback-mode () diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index eb95fae2339..3d03e894534 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -1,4 +1,4 @@ -;;; advice.el --- An overloading mechanism for Emacs Lisp functions +;;; advice.el --- An overloading mechanism for Emacs Lisp functions -*- lexical-binding: t -*- ;; Copyright (C) 1993-1994, 2000-2013 Free Software Foundation, Inc. @@ -47,14 +47,12 @@ ;; @ Highlights: ;; ============= ;; - Clean definition of multiple, named before/around/after advices -;; for functions, macros, subrs and special forms +;; for functions and macros. ;; - Full control over the arguments an advised function will receive, ;; the binding environment in which it will be executed, as well as the ;; value it will return. -;; - Allows re/definition of interactive behavior for functions and subrs -;; - Every piece of advice can have its documentation string which will be -;; combined with the original documentation of the advised function at -;; call-time of `documentation' for proper command-key substitution. +;; - Allows re/definition of interactive behavior for commands. +;; - Every piece of advice can have its documentation string. ;; - The execution of every piece of advice can be protected against error ;; and non-local exits in preceding code or advices. ;; - Simple argument access either by name, or, more portable but as @@ -63,7 +61,7 @@ ;; version of a function. ;; - Advised functions can be byte-compiled either at file-compile time ;; (see preactivation) or activation time. -;; - Separation of advice definition and activation +;; - Separation of advice definition and activation. ;; - Forward advice is possible, that is ;; as yet undefined or autoload functions can be advised without having to ;; preload the file in which they are defined. @@ -77,7 +75,7 @@ ;; - En/disablement mechanism allows the use of different "views" of advised ;; functions depending on what pieces of advice are currently en/disabled ;; - Provides manipulation mechanisms for sets of advised functions via -;; regular expressions that match advice names +;; regular expressions that match advice names. ;; @ Overview, or how to read this file: ;; ===================================== @@ -113,23 +111,12 @@ ;; others come from the various Lisp advice mechanisms I've come across ;; so far, and a few are simply mine. -;; @ Comments, suggestions, bug reports: -;; ===================================== -;; If you find any bugs, have suggestions for new advice features, find the -;; documentation wrong, confusing, incomplete, or otherwise unsatisfactory, -;; have any questions about Advice, or have otherwise enlightening -;; comments feel free to send me email at <hans@cs.buffalo.edu>. - ;; @ Safety Rules and Emergency Exits: ;; =================================== ;; Before we begin: CAUTION!! ;; Advice provides you with a lot of rope to hang yourself on very ;; easily accessible trees, so, here are a few important things you -;; should know: Once Advice has been started with `ad-start-advice' -;; (which happens automatically when you load this file), it -;; generates an advised definition of the `documentation' function, and -;; it will enable automatic advice activation when functions get defined. -;; All of this can be undone at any time with `M-x ad-stop-advice'. +;; should know: ;; ;; If you experience any strange behavior/errors etc. that you attribute to ;; Advice or to some ill-advised function do one of the following: @@ -137,45 +124,37 @@ ;; - M-x ad-deactivate FUNCTION (if you have a definite suspicion what ;; function gives you problems) ;; - M-x ad-deactivate-all (if you don't have a clue what's going wrong) -;; - M-x ad-stop-advice (if you think the problem is related to the -;; advised functions used by Advice itself) ;; - M-x ad-recover-normality (for real emergencies) ;; - If none of the above solves your Advice-related problem go to another ;; terminal, kill your Emacs process and send me some hate mail. -;; The first three measures have restarts, i.e., once you've figured out +;; The first two measures have restarts, i.e., once you've figured out ;; the problem you can reactivate advised functions with either `ad-activate', -;; `ad-activate-all', or `ad-start-advice'. `ad-recover-normality' unadvises +;; or `ad-activate-all'. `ad-recover-normality' unadvises ;; everything so you won't be able to reactivate any advised functions, you'll ;; have to stick with their standard incarnations for the rest of the session. -;; IMPORTANT: With Advice loaded always do `M-x ad-deactivate-all' before -;; you byte-compile a file, because advised special forms and macros can lead -;; to unwanted compilation results. When you are done compiling use -;; `M-x ad-activate-all' to go back to the advised state of all your -;; advised functions. - ;; RELAX: Advice is pretty safe even if you are oblivious to the above. ;; I use it extensively and haven't run into any serious trouble in a long -;; time. Just wanted you to be warned. +;; time. Just wanted you to be warned. ;; @ Customization: ;; ================ ;; Look at the documentation of `ad-redefinition-action' for possible values -;; of this variable. Its default value is `warn' which will print a warning +;; of this variable. Its default value is `warn' which will print a warning ;; message when an already defined advised function gets redefined with a ;; new original definition and de/activated. ;; Look at the documentation of `ad-default-compilation-action' for possible -;; values of this variable. Its default value is `maybe' which will compile +;; values of this variable. Its default value is `maybe' which will compile ;; advised definitions during activation in case the byte-compiler is already -;; loaded. Otherwise, it will leave them uncompiled. +;; loaded. Otherwise, it will leave them uncompiled. ;; @ Motivation: ;; ============= ;; Before I go on explaining how advice works, here are four simple examples -;; how this package can be used. The first three are very useful, the last one +;; how this package can be used. The first three are very useful, the last one ;; is just a joke: ;;(defadvice switch-to-buffer (before existing-buffers-only activate) @@ -206,13 +185,12 @@ ;; @ Advice documentation: ;; ======================= -;; Below is general documentation of the various features of advice. For more +;; Below is general documentation of the various features of advice. For more ;; concrete examples check the corresponding sections in the tutorial part. ;; @@ Terminology: ;; =============== ;; - Emacs: Emacs as released by the GNU Project -;; - jwz: Jamie Zawinski - creator of the byte-compiler used in v19s. ;; - Advice: The name of this package. ;; - advices: Short for "pieces of advice". @@ -236,22 +214,22 @@ ;; <name> is the name of the advice which has to be a non-nil symbol. ;; Names uniquely identify a piece of advice in a certain advice class, ;; hence, advices can be redefined by defining an advice with the same class -;; and name. Advice names are global symbols, hence, the same name space +;; and name. Advice names are global symbols, hence, the same name space ;; conventions used for function names should be applied. ;; An optional <position> specifies where in the current list of advices of -;; the specified <class> this new advice will be placed. <position> has to +;; the specified <class> this new advice will be placed. <position> has to ;; be either `first', `last' or a number that specifies a zero-based -;; position (`first' is equivalent to 0). If no position is specified -;; `first' will be used as a default. If this call to `defadvice' redefines +;; position (`first' is equivalent to 0). If no position is specified +;; `first' will be used as a default. If this call to `defadvice' redefines ;; an already existing advice (see above) then the position argument will ;; be ignored and the position of the already existing advice will be used. ;; An optional <arglist> which has to be a list can be used to define the -;; argument list of the advised function. This argument list should of +;; argument list of the advised function. This argument list should of ;; course be compatible with the argument list of the original function, ;; otherwise functions that call the advised function with the original -;; argument list in mind will break. If more than one advice specify an +;; argument list in mind will break. If more than one advice specify an ;; argument list then the first one (the one with the smallest position) ;; found in the list of before/around/after advices will be used. @@ -267,10 +245,10 @@ ;; `disable': Specifies that the defined advice should be disabled, hence, ;; it will not be used in an activation until somebody enables it. ;; `preactivate': Specifies that the advised function should get preactivated -;; at macro-expansion/compile time of this `defadvice'. This +;; at macro-expansion/compile time of this `defadvice'. This ;; generates a compiled advised definition according to the ;; current advice state which will be used during activation -;; if appropriate. Only use this if the `defadvice' gets +;; if appropriate. Only use this if the `defadvice' gets ;; actually compiled. ;; An optional <documentation-string> can be supplied to document the advice. @@ -278,20 +256,20 @@ ;; documentation strings of the original function and other advices. ;; An optional <interactive-form> form can be supplied to change/add -;; interactive behavior of the original function. If more than one advice +;; interactive behavior of the original function. If more than one advice ;; has an `(interactive ...)' specification then the first one (the one ;; with the smallest position) found in the list of before/around/after ;; advices will be used. ;; A possibly empty list of <body-forms> specifies the body of the advice in -;; an implicit progn. The body of an advice can access/change arguments, +;; an implicit progn. The body of an advice can access/change arguments, ;; the return value, the binding environment, and can have all sorts of ;; other side effects. ;; @@ Assembling advised definitions: ;; ================================== ;; Suppose a function/macro/subr/special-form has N pieces of before advice, -;; M pieces of around advice and K pieces of after advice. Assuming none of +;; M pieces of around advice and K pieces of after advice. Assuming none of ;; the advices is protected, its advised definition will look like this ;; (body-form indices correspond to the position of the respective advice in ;; that advice class): @@ -330,11 +308,11 @@ ;; be expanded into a proper documentation string upon call of `documentation'. ;; (interactive ...) is an optional interactive form either taken from the -;; original function or from a before/around/after advice. For advised +;; original function or from a before/around/after advice. For advised ;; interactive subrs that do not have an interactive form specified in any ;; advice we have to use (interactive) and then call the subr interactively ;; if the advised function was called interactively, because the -;; interactive specification of subrs is not accessible. This is the only +;; interactive specification of subrs is not accessible. This is the only ;; case where changing the values of arguments will not have an affect ;; because they will be reset by the interactive specification of the subr. ;; If this is a problem one can always specify an interactive form in a @@ -343,45 +321,44 @@ ;; ;; Then the body forms of the various advices in the various classes of advice ;; are assembled in order. The forms of around advice L are normally part of -;; one of the forms of around advice L-1. An around advice can specify where +;; one of the forms of around advice L-1. An around advice can specify where ;; the forms of the wrapped or surrounded forms should go with the special -;; keyword `ad-do-it', which will be substituted with a `progn' containing the -;; forms of the surrounded code. +;; keyword `ad-do-it', which will run the forms of the surrounded code. ;; The innermost part of the around advice onion is ;; <apply original definition to <arglist>> -;; whose form depends on the type of the original function. The variable -;; `ad-return-value' will be set to its result. This variable is visible to +;; whose form depends on the type of the original function. The variable +;; `ad-return-value' will be set to its result. This variable is visible to ;; all pieces of advice which can access and modify it before it gets returned. ;; ;; The semantic structure of advised functions that contain protected pieces -;; of advice is the same. The only difference is that `unwind-protect' forms +;; of advice is the same. The only difference is that `unwind-protect' forms ;; make sure that the protected advice gets executed even if some previous -;; piece of advice had an error or a non-local exit. If any around advice is +;; piece of advice had an error or a non-local exit. If any around advice is ;; protected then the whole around advice onion will be protected. ;; @@ Argument access in advised functions: ;; ======================================== ;; As already mentioned, the simplest way to access the arguments of an -;; advised function in the body of an advice is to refer to them by name. To -;; do that, the advice programmer needs to know either the names of the +;; advised function in the body of an advice is to refer to them by name. +;; To do that, the advice programmer needs to know either the names of the ;; argument variables of the original function, or the names used in the -;; argument list redefinition given in a piece of advice. While this simple +;; argument list redefinition given in a piece of advice. While this simple ;; method might be sufficient in many cases, it has the disadvantage that it ;; is not very portable because it hardcodes the argument names into the ;; advice. If the definition of the original function changes the advice -;; might break even though the code might still be correct. Situations like +;; might break even though the code might still be correct. Situations like ;; that arise, for example, if one advises a subr like `eval-region' which ;; gets redefined in a non-advice style into a function by the edebug -;; package. If the advice assumes `eval-region' to be a subr it might break -;; once edebug is loaded. Similar situations arise when one wants to use the +;; package. If the advice assumes `eval-region' to be a subr it might break +;; once edebug is loaded. Similar situations arise when one wants to use the ;; same piece of advice across different versions of Emacs. ;; As a solution to that advice provides argument list access macros that get ;; translated into the proper access forms at activation time, i.e., when the -;; advised definition gets constructed. Access macros access actual arguments +;; advised definition gets constructed. Access macros access actual arguments ;; by position regardless of how these actual argument get distributed onto -;; the argument variables of a function. The rational behind this is that in +;; the argument variables of a function. The rational behind this is that in ;; Emacs Lisp the semantics of an argument is strictly determined by its ;; position (there are no keyword arguments). @@ -393,9 +370,9 @@ ;; ;; (foo 0 1 2 3 4 5 6) -;; which means that X=0, Y=1, Z=2 and R=(3 4 5 6). The assumption is that -;; the semantics of an actual argument is determined by its position. It is -;; this semantics that has to be known by the advice programmer. Then s/he +;; which means that X=0, Y=1, Z=2 and R=(3 4 5 6). The assumption is that +;; the semantics of an actual argument is determined by its position. It is +;; this semantics that has to be known by the advice programmer. Then s/he ;; can access these arguments in a piece of advice with some of the ;; following macros (the arrows indicate what value they will return): @@ -408,17 +385,17 @@ ;; `(ad-get-arg <position>)' will return the actual argument that was supplied ;; at <position>, `(ad-get-args <position>)' will return the list of actual -;; arguments supplied starting at <position>. Note that these macros can be +;; arguments supplied starting at <position>. Note that these macros can be ;; used without any knowledge about the form of the actual argument list of ;; the original function. ;; Similarly, `(ad-set-arg <position> <value-form>)' can be used to set the -;; value of the actual argument at <position> to <value-form>. For example, +;; value of the actual argument at <position> to <value-form>. For example, ;; ;; (ad-set-arg 5 "five") ;; ;; will have the effect that R=(3 4 "five" 6) once the original function is -;; called. `(ad-set-args <position> <value-list-form>)' can be used to set +;; called. `(ad-set-args <position> <value-list-form>)' can be used to set ;; the list of actual arguments starting at <position> to <value-list-form>. ;; For example, ;; @@ -427,7 +404,7 @@ ;; will have the effect that X=5, Y=4, Z=3 and R=(2 1 0) once the original ;; function is called. -;; All these access macros are text macros rather than real Lisp macros. When +;; All these access macros are text macros rather than real Lisp macros. When ;; the advised definition gets constructed they get replaced with actual access ;; forms depending on the argument list of the advised function, i.e., after ;; that argument access is in most cases as efficient as using the argument @@ -437,7 +414,7 @@ ;; ======================================================= ;; Some functions (such as `trace-function' defined in trace.el) need a ;; method of accessing the names and bindings of the arguments of an -;; arbitrary advised function. To do that within an advice one can use the +;; arbitrary advised function. To do that within an advice one can use the ;; special keyword `ad-arg-bindings' which is a text macro that will be ;; substituted with a form that will evaluate to a list of binding ;; specifications, one for every argument variable. These binding @@ -463,7 +440,7 @@ ;; ========================== ;; Because `defadvice' allows the specification of the argument list ;; of the advised function we need a mapping mechanism that maps this -;; argument list onto that of the original function. Hence SYM and +;; argument list onto that of the original function. Hence SYM and ;; NEWDEF have to be properly mapped onto the &rest variable when the ;; original definition is called. Advice automatically takes care of ;; that mapping, hence, the advice programmer can specify an argument @@ -474,11 +451,10 @@ ;; @@ Activation and deactivation: ;; =============================== ;; The definition of an advised function does not change until all its advice -;; gets actually activated. Activation can either happen with the `activate' +;; gets actually activated. Activation can either happen with the `activate' ;; flag specified in the `defadvice', with an explicit call or interactive -;; invocation of `ad-activate', or if forward advice is enabled (i.e., the -;; value of `ad-activate-on-definition' is t) at the time an already advised -;; function gets defined. +;; invocation of `ad-activate', or at the time an already advised function +;; gets defined. ;; When a function gets first activated its original definition gets saved, ;; all defined and enabled pieces of advice will get combined with the @@ -496,7 +472,7 @@ ;; the file that contained the `defadvice' with the `preactivate' flag. ;; `ad-deactivate' can be used to back-define an advised function to its -;; original definition. It can be called interactively or directly. Because +;; original definition. It can be called interactively or directly. Because ;; `ad-activate' caches the advised definition the function can be ;; reactivated via `ad-activate' with only minor overhead (it is checked ;; whether the current advice state is consistent with the cached @@ -504,12 +480,12 @@ ;; `ad-activate-regexp' and `ad-deactivate-regexp' can be used to de/activate ;; all currently advised function that have a piece of advice with a name that -;; contains a match for a regular expression. These functions can be used to +;; contains a match for a regular expression. These functions can be used to ;; de/activate sets of functions depending on certain advice naming ;; conventions. ;; Finally, `ad-activate-all' and `ad-deactivate-all' can be used to -;; de/activate all currently advised functions. These are useful to +;; de/activate all currently advised functions. These are useful to ;; (temporarily) return to an un/advised state. ;; @@@ Reasons for the separation of advice definition and activation: @@ -521,26 +497,26 @@ ;; The advantage of this is that various pieces of advice can be defined ;; before they get combined into an advised definition which avoids -;; unnecessary constructions of intermediate advised definitions. The more +;; unnecessary constructions of intermediate advised definitions. The more ;; important advantage is that it allows the implementation of forward advice. ;; Advice information for a certain function accumulates as the value of the -;; `advice-info' property of the function symbol. This accumulation is +;; `advice-info' property of the function symbol. This accumulation is ;; completely independent of the fact that that function might not yet be -;; defined. The special forms `defun' and `defmacro' have been advised to -;; check whether the function/macro they defined had advice information -;; associated with it. If so and forward advice is enabled, the original +;; defined. The macros `defun' and `defmacro' check whether the +;; function/macro they defined had advice information +;; associated with it. If so and forward advice is enabled, the original ;; definition will be saved, and then the advice will be activated. ;; @@ Enabling/disabling pieces or sets of advice: ;; =============================================== ;; A major motivation for the development of this advice package was to bring ;; a little bit more structure into the function overloading chaos in Emacs -;; Lisp. Many packages achieve some of their functionality by adding a little +;; Lisp. Many packages achieve some of their functionality by adding a little ;; bit (or a lot) to the standard functionality of some Emacs Lisp function. -;; ange-ftp is a very popular package that achieves its magic by overloading -;; most Emacs Lisp functions that deal with files. A popular function that's -;; overloaded by many packages is `expand-file-name'. The situation that one -;; function is multiply overloaded can arise easily. +;; ange-ftp is a very popular package that used to achieve its magic by +;; overloading most Emacs Lisp functions that deal with files. A popular +;; function that's overloaded by many packages is `expand-file-name'. +;; The situation that one function is multiply overloaded can arise easily. ;; Once in a while it would be desirable to be able to disable some/all ;; overloads of a particular package while keeping all the rest. Ideally - @@ -548,7 +524,7 @@ ;; I know I am dreaming right now... In that ideal case the enable/disable ;; mechanism of advice could be used to achieve just that. -;; Every piece of advice is associated with an enablement flag. When the +;; Every piece of advice is associated with an enablement flag. When the ;; advised definition of a particular function gets constructed (e.g., during ;; activation) only the currently enabled pieces of advice will be considered. ;; This mechanism allows one to have different "views" of an advised function @@ -556,17 +532,15 @@ ;; Another motivation for this mechanism is that it allows one to define a ;; piece of advice for some function yet keep it dormant until a certain -;; condition is met. Until then activation of the function will not make use -;; of that piece of advice. Once the condition is met the advice can be +;; condition is met. Until then activation of the function will not make use +;; of that piece of advice. Once the condition is met the advice can be ;; enabled and a reactivation of the function will add its functionality as -;; part of the new advised definition. For example, the advices of `defun' -;; etc. used by advice itself will stay disabled until `ad-start-advice' is -;; called and some variables have the proper values. Hence, if somebody +;; part of the new advised definition. Hence, if somebody ;; else advised these functions too and activates them the advices defined ;; by advice will get used only if they are intended to be used. ;; The main interface to this mechanism are the interactive functions -;; `ad-enable-advice' and `ad-disable-advice'. For example, the following +;; `ad-enable-advice' and `ad-disable-advice'. For example, the following ;; would disable a particular advice of the function `foo': ;; ;; (ad-disable-advice 'foo 'before 'my-advice) @@ -576,28 +550,28 @@ ;; ;; (ad-activate 'foo) ;; -;; or interactively. To disable whole sets of advices one can use a regular -;; expression mechanism. For example, let us assume that ange-ftp actually +;; or interactively. To disable whole sets of advices one can use a regular +;; expression mechanism. For example, let us assume that ange-ftp actually ;; used advice to overload all its functions, and that it used the ;; "ange-ftp-" prefix for all its advice names, then we could temporarily ;; disable all its advices with ;; -;; (ad-disable-regexp "^ange-ftp-") +;; (ad-disable-regexp "\\`ange-ftp-") ;; ;; and the following call would put that actually into effect: ;; -;; (ad-activate-regexp "^ange-ftp-") +;; (ad-activate-regexp "\\`ange-ftp-") ;; ;; A safer way would have been to use ;; -;; (ad-update-regexp "^ange-ftp-") +;; (ad-update-regexp "\\`ange-ftp-") ;; ;; instead which would have only reactivated currently actively advised -;; functions, but not functions that were currently inactive. All these +;; functions, but not functions that were currently inactive. All these ;; functions can also be called interactively. ;; A certain piece of advice is considered a match if its name contains a -;; match for the regular expression. To enable ange-ftp again we would use +;; match for the regular expression. To enable ange-ftp again we would use ;; `ad-enable-regexp' and then activate or update again. ;; @@ Forward advice, automatic advice activation: @@ -615,26 +589,19 @@ ;; Advice implements forward advice mainly via the following: 1) Separation ;; of advice definition and activation that makes it possible to accumulate ;; advice information without having the original function already defined, -;; 2) special versions of the built-in functions `fset/defalias' which check -;; for advice information whenever they define a function. If advice -;; information was found then the advice will immediately get activated when -;; the function gets defined. +;; 2) Use of the `defalias-fset-function' symbol property which lets +;; us advise the function when it gets defined. ;; Automatic advice activation means, that whenever a function gets defined -;; with either `defun', `defmacro', `fset' or by loading a byte-compiled +;; with either `defun', `defmacro', `defalias' or by loading a byte-compiled ;; file, and the function has some advice-info stored with it then that ;; advice will get activated right away. -;; @@@ Enabling automatic advice activation: -;; ========================================= -;; Automatic advice activation is enabled by default. It can be disabled with -;; `M-x ad-stop-advice' and enabled again with `M-x ad-start-advice'. - ;; @@ Caching of advised definitions: ;; ================================== ;; After an advised definition got constructed it gets cached as part of the ;; advised function's advice-info so it can be reused, for example, after an -;; intermediate deactivation. Because the advice-info of a function might +;; intermediate deactivation. Because the advice-info of a function might ;; change between the time of caching and reuse a cached definition gets ;; a cache-id associated with it so it can be verified whether the cached ;; definition is still valid (the main application of this is preactivation @@ -642,19 +609,19 @@ ;; When an advised function gets activated and a verifiable cached definition ;; is available, then that definition will be used instead of creating a new -;; advised definition from scratch. If you want to make sure that a new +;; advised definition from scratch. If you want to make sure that a new ;; definition gets constructed then you should use `ad-clear-cache' before you ;; activate the advised function. ;; @@ Preactivation: ;; ================= -;; Constructing an advised definition is moderately expensive. In a situation +;; Constructing an advised definition is moderately expensive. In a situation ;; where one package defines a lot of advised functions it might be ;; prohibitively expensive to do all the advised definition construction at -;; runtime. Preactivation is a mechanism that allows compile-time construction +;; runtime. Preactivation is a mechanism that allows compile-time construction ;; of compiled advised definitions that can be activated cheaply during -;; runtime. Preactivation uses the caching mechanism to do that. Here's how it -;; works: +;; runtime. Preactivation uses the caching mechanism to do that. Here's how +;; it works: ;; When the byte-compiler compiles a `defadvice' that has the `preactivate' ;; flag specified, it uses the current original definition of the advised @@ -665,27 +632,27 @@ ;; byte-compiler. ;; When the file with the compiled, preactivating `defadvice' gets loaded the ;; precompiled advised definition will be cached on the advised function's -;; advice-info. When it gets activated (can be immediately on execution of the +;; advice-info. When it gets activated (can be immediately on execution of the ;; `defadvice' or any time later) the cache-id gets checked against the ;; current state of advice and if it is verified the precompiled definition -;; will be used directly (the verification is pretty cheap). If it couldn't get -;; verified a new advised definition for that function will be built from -;; scratch, hence, the efficiency added by the preactivation mechanism does -;; not at all impair the flexibility of the advice mechanism. +;; will be used directly (the verification is pretty cheap). If it couldn't +;; get verified a new advised definition for that function will be built from +;; scratch, hence, the efficiency added by the preactivation mechanism does not +;; at all impair the flexibility of the advice mechanism. ;; MORAL: In order get all the efficiency out of preactivation the advice ;; state of an advised function at the time the file with the ;; preactivating `defadvice' gets byte-compiled should be exactly ;; the same as it will be when the advice of that function gets -;; actually activated. If it is not there is a high chance that the +;; actually activated. If it is not there is a high chance that the ;; cache-id will not match and hence a new advised definition will ;; have to be constructed at runtime. -;; Preactivation and forward advice do not contradict each other. It is +;; Preactivation and forward advice do not contradict each other. It is ;; perfectly ok to load a file with a preactivating `defadvice' before the -;; original definition of the advised function is available. The constructed +;; original definition of the advised function is available. The constructed ;; advised definition will be used once the original function gets defined and -;; its advice gets activated. The only constraint is that at the time the +;; its advice gets activated. The only constraint is that at the time the ;; file with the preactivating `defadvice' got compiled the original function ;; definition was available. @@ -697,18 +664,18 @@ ;; - `byte-compile' is part of the `features' variable even though you ;; did not use the byte-compiler ;; Right now advice does not provide an elegant way to find out whether -;; and why a preactivation failed. What you can do is to trace the +;; and why a preactivation failed. What you can do is to trace the ;; function `ad-cache-id-verification-code' (with the function ;; `trace-function-background' defined in my trace.el package) before -;; any of your advised functions get activated. After they got +;; any of your advised functions get activated. After they got ;; activated check whether all calls to `ad-cache-id-verification-code' -;; returned `verified' as a result. Other values indicate why the +;; returned `verified' as a result. Other values indicate why the ;; verification failed which should give you enough information to ;; fix your preactivation/compile/load/activation sequence. ;; IMPORTANT: There is one case (that I am aware of) that can make ;; preactivation fail, i.e., a preconstructed advised definition that does -;; NOT match the current state of advice gets used nevertheless. That case +;; NOT match the current state of advice gets used nevertheless. That case ;; arises if one package defines a certain piece of advice which gets used ;; during preactivation, and another package incompatibly redefines that ;; very advice (i.e., same function/class/name), and it is the second advice @@ -720,30 +687,20 @@ ;; MORAL-II: Redefining somebody else's advice is BAAAAD (to speak with ;; George Walker Bush), and why would you redefine your own advice anyway? ;; Advice is a mechanism to facilitate function redefinition, not advice -;; redefinition (wait until I write Meta-Advice :-). If you really have -;; to undo somebody else's advice try to write a "neutralizing" advice. +;; redefinition (wait until I write Meta-Advice :-). If you really have +;; to undo somebody else's advice, try to write a "neutralizing" advice. -;; @@ Advising macros and special forms and other dangerous things: -;; ================================================================ +;; @@ Advising macros and other dangerous things: +;; ============================================== ;; Look at the corresponding tutorial sections for more information on -;; these topics. Here it suffices to point out that the special treatment -;; of macros and special forms by the byte-compiler can lead to problems -;; when they get advised. Macros can create problems because they get -;; expanded at compile time, hence, they might not have all the necessary -;; runtime support and such advice cannot be de/activated or changed as -;; it is possible for functions. Special forms create problems because they -;; have to be advised "into" macros, i.e., an advised special form is a -;; implemented as a macro, hence, in most cases the byte-compiler will -;; not recognize it as a special form anymore which can lead to very strange -;; results. -;; -;; MORAL: - Only advise macros or special forms when you are absolutely sure -;; what you are doing. -;; - As a safety measure, always do `ad-deactivate-all' before you -;; byte-compile a file to make sure that even if some inconsiderate -;; person advised some special forms you'll get proper compilation -;; results. After compilation do `ad-activate-all' to get back to -;; the previous state. +;; these topics. Here it suffices to point out that the special treatment +;; of macros can lead to problems when they get advised. Macros can create +;; problems because they get expanded at compile or load time, hence, they +;; might not have all the necessary runtime support and such advice cannot be +;; de/activated or changed as it is possible for functions. +;; Special forms cannot be advised. +;; +;; MORAL: - Only advise macros when you are absolutely sure what you are doing. ;; @@ Adding a piece of advice with `ad-add-advice': ;; ================================================= @@ -754,10 +711,10 @@ ;; @@ Activation/deactivation advices, file load hooks: ;; ==================================================== ;; There are two special classes of advice called `activation' and -;; `deactivation'. The body forms of these advices are not included into the +;; `deactivation'. The body forms of these advices are not included into the ;; advised definition of a function, rather they are assembled into a hook ;; form which will be evaluated whenever the advice-info of the advised -;; function gets activated or deactivated. One application of this mechanism +;; function gets activated or deactivated. One application of this mechanism ;; is to define file load hooks for files that do not provide such hooks. ;; For example, suppose you want to print a message whenever `file-x' gets ;; loaded, and suppose the last function defined in `file-x' is @@ -769,7 +726,7 @@ ;; ;; This will constitute a forward advice for function `file-x-last-fn' which ;; will get activated when `file-x' is loaded (only if forward advice is -;; enabled of course). Because there are no "real" pieces of advice +;; enabled of course). Because there are no "real" pieces of advice ;; available for it, its definition will not be changed, but the activation ;; advice will be run during its activation which is equivalent to having a ;; file load hook for `file-x'. @@ -784,14 +741,14 @@ ;; enabled advices are considered during construction of an advised ;; definition. ;; - Activation: -;; Redefine an advised function with its advised definition. Constructs +;; Redefine an advised function with its advised definition. Constructs ;; an advised definition from scratch if no verifiable cached advised ;; definition is available and caches it. ;; - Deactivation: ;; Back-define an advised function to its original definition. ;; - Update: ;; Reactivate an advised function but only if its advice is currently -;; active. This can be used to bring all currently advised function up +;; active. This can be used to bring all currently advised function up ;; to date with the current state of advice without also activating ;; currently inactive functions. ;; - Caching: @@ -800,7 +757,7 @@ ;; - Preactivation: ;; Is the construction of an advised definition according to the current ;; state of advice during byte-compilation of a file with a preactivating -;; `defadvice'. That advised definition can then rather cheaply be used +;; `defadvice'. That advised definition can then rather cheaply be used ;; during activation without having to construct an advised definition ;; from scratch at runtime. @@ -860,12 +817,8 @@ ;; @ Foo games: An advice tutorial ;; =============================== -;; The following tutorial was created in Emacs 18.59. Left-justified +;; The following tutorial was created in Emacs 18.59. Left-justified ;; s-expressions are input forms followed by one or more result forms. -;; First we have to start the advice magic: -;; -;; (ad-start-advice) -;; nil ;; ;; We start by defining an innocent looking function `foo' that simply ;; adds 1 to its argument X: @@ -988,19 +941,6 @@ ;; (call-interactively 'foo) ;; 6 ;; -;; Let's have a look at what the definition of `foo' looks like now -;; (indentation added by hand for legibility): -;; -;; (symbol-function 'foo) -;; (lambda (x) -;; "$ad-doc: foo$" -;; (interactive (list 5)) -;; (let (ad-return-value) -;; (setq x (1- x)) -;; (setq x (1+ x)) -;; (setq ad-return-value (ad-Orig-foo x)) -;; ad-return-value)) -;; ;; @@ Around advices: ;; ================== ;; Now we'll try some `around' advices. An around advice is a wrapper around @@ -1038,20 +978,6 @@ ;; (foo 3) ;; 8 ;; -;; Again, let's see what the definition of `foo' looks like so far: -;; -;; (symbol-function 'foo) -;; (lambda (x) -;; "$ad-doc: foo$" -;; (interactive (list 5)) -;; (let (ad-return-value) -;; (setq x (1- x)) -;; (setq x (1+ x)) -;; (let ((x (* x 2))) -;; (let ((x (1+ x))) -;; (setq ad-return-value (ad-Orig-foo x)))) -;; ad-return-value)) -;; ;; @@ Controlling advice activation: ;; ================================= ;; In every `defadvice' so far we have used the flag `activate' to activate @@ -1071,9 +997,9 @@ ;; 8 ;; ;; Now we define another advice and activate which will also activate the -;; previous advice `fg-times-x'. Note the use of the special variable +;; previous advice `fg-times-x'. Note the use of the special variable ;; `ad-return-value' in the body of the advice which is set to the result of -;; the original function. If we change its value then the value returned by +;; the original function. If we change its value then the value returned by ;; the advised function will be changed accordingly: ;; ;; (defadvice foo (after fg-times-x-again act) @@ -1121,24 +1047,6 @@ ;; "Let's clean up now!" ;; error-in-foo ;; -;; Again, let's see what `foo' looks like: -;; -;; (symbol-function 'foo) -;; (lambda (x) -;; "$ad-doc: foo$" -;; (interactive (list 5)) -;; (let (ad-return-value) -;; (unwind-protect -;; (progn (setq x (1- x)) -;; (setq x (1+ x)) -;; (let ((x (* x 2))) -;; (let ((x (1+ x))) -;; (setq ad-return-value (ad-Orig-foo x)))) -;; (setq ad-return-value (* ad-return-value x)) -;; (setq ad-return-value (* ad-return-value x))) -;; (print "Let's clean up now!")) -;; ad-return-value)) -;; ;; @@ Compilation of advised definitions: ;; ====================================== ;; Finally, we can specify the `compile' keyword in a `defadvice' to say @@ -1150,13 +1058,10 @@ ;; (print "Let's clean up now!")) ;; foo ;; -;; Now `foo' is byte-compiled: +;; Now `foo's advice is byte-compiled: ;; -;; (symbol-function 'foo) -;; (lambda (x) -;; "$ad-doc: foo$" -;; (interactive (byte-code "....." [5] 1)) -;; (byte-code "....." [ad-return-value x nil ((byte-code "....." [print "Let's clean up now!"] 2)) * 2 ad-Orig-foo] 6)) +;; (byte-code-function-p 'ad-Advice-foo) +;; t ;; ;; (foo 3) ;; "Let's clean up now!" @@ -1262,7 +1167,7 @@ ;; deactivate functions that have a piece of advice defined by a certain ;; package (we save the old definition to check out caching): ;; -;; (setq old-definition (symbol-function 'foo)) +;; (setq old-definition (symbol-function 'ad-Advice-foo)) ;; (lambda (x) ....) ;; ;; (ad-deactivate-regexp "^fg-") @@ -1274,7 +1179,7 @@ ;; (ad-activate-regexp "^fg-") ;; nil ;; -;; (eq old-definition (symbol-function 'foo)) +;; (eq old-definition (symbol-function 'ad-Advice-foo)) ;; t ;; ;; (foo 3) @@ -1283,14 +1188,6 @@ ;; ;; @@ Forward advice: ;; ================== -;; To enable automatic activation of forward advice we first have to set -;; `ad-activate-on-definition' to t and restart advice: -;; -;; (setq ad-activate-on-definition t) -;; t -;; -;; (ad-start-advice) -;; (ad-activate-defined-function) ;; ;; Let's define a piece of advice for an undefined function: ;; @@ -1303,9 +1200,7 @@ ;; (fboundp 'bar) ;; nil ;; -;; Now we define it and the forward advice will get activated (only because -;; `ad-activate-on-definition' was t when we started advice above with -;; `ad-start-advice'): +;; Now we define it and the forward advice will get activated: ;; ;; (defun bar (x) ;; "Subtract 1 from X." @@ -1357,7 +1252,7 @@ ;; (ad-activate 'fie) ;; fie ;; -;; (eq cached-definition (symbol-function 'fie)) +;; (eq cached-definition (symbol-function 'ad-Advice-fie)) ;; t ;; ;; (fie 2) @@ -1365,7 +1260,7 @@ ;; ;; If you put a preactivating `defadvice' into a Lisp file that gets byte- ;; compiled then the constructed advised definition will get compiled by -;; the byte-compiler. For that to occur in a v18 Emacs you had to put the +;; the byte-compiler. For that to occur in a v18 Emacs you had to put the ;; `defadvice' inside a `defun' because the v18 compiler did not compile ;; top-level forms other than `defun' or `defmacro', for example, ;; @@ -1407,18 +1302,16 @@ ;; constructed during preactivation was used, even though we did not specify ;; the `compile' flag: ;; -;; (symbol-function 'fum) -;; (lambda (x) -;; "$ad-doc: fum$" -;; (byte-code "....." [ad-return-value x nil * 2 ad-Orig-fum] 4)) +;; (byte-code-function-p 'ad-Advice-fum) +;; t ;; ;; (fum 2) ;; 8 ;; ;; A preactivated definition will only be used if it matches the current -;; function definition and advice information. If it does not match it +;; function definition and advice information. If it does not match it ;; will simply be discarded and a new advised definition will be constructed -;; from scratch. For example, let's first remove all advice-info for `fum': +;; from scratch. For example, let's first remove all advice-info for `fum': ;; ;; (ad-unadvise 'fum) ;; (("fie") ("bar") ("foo") ...) @@ -1431,7 +1324,7 @@ ;; fum ;; ;; When we now try to use a preactivation it will not be used because the -;; current advice state is different from the one at preactivation time. This +;; current advice state is different from the one at preactivation time. This ;; is no tragedy, everything will work as expected just not as efficient, ;; because a new advised definition has to be constructed from scratch: ;; @@ -1440,7 +1333,7 @@ ;; ;; A new uncompiled advised definition got constructed: ;; -;; (ad-compiled-p (symbol-function 'fum)) +;; (byte-code-function-p 'ad-Advice-fum) ;; nil ;; ;; (fum 2) @@ -1448,7 +1341,7 @@ ;; ;; MORAL: To get all the efficiency out of preactivation the function ;; definition and advice state at preactivation time must be the same as the -;; state at activation time. Preactivation does work with forward advice, all +;; state at activation time. Preactivation does work with forward advice, all ;; that's necessary is that the definition of the forward advised function is ;; available when the `defadvice' with the preactivation gets compiled. ;; @@ -1702,15 +1595,9 @@ ;; @@ Compilation idiosyncrasies: ;; ============================== -;; `defadvice' expansion needs quite a few advice functions and variables, -;; hence, I need to preload the file before it can be compiled. To avoid -;; interference of bogus compiled files I always preload the source file: -(provide 'advice-preload) -;; During a normal load this is a noop: -(require 'advice-preload "advice.el") (require 'macroexp) ;; At run-time also, since ad-do-advised-functions returns code that uses it. -(require 'cl-lib) +(eval-when-compile (require 'cl-lib)) ;; @@ Variable definitions: ;; ======================== @@ -1776,36 +1663,6 @@ generates a copy of TREE." (funcall fUnCtIoN tReE)) (t tReE))) -;; @@ Save real definitions of subrs used by Advice: -;; ================================================= -;; Advice depends on the real, unmodified functionality of various subrs, -;; we save them here so advised versions will not interfere (eventually, -;; we will save all subrs used in code generated by Advice): - -(defmacro ad-save-real-definition (function) - (let ((saved-function (intern (format "ad-real-%s" function)))) - ;; Make sure the compiler is loaded during macro expansion: - (require 'byte-compile "bytecomp") - `(if (not (fboundp ',saved-function)) - (progn (fset ',saved-function (symbol-function ',function)) - ;; Copy byte-compiler properties: - ,@(if (get function 'byte-compile) - `((put ',saved-function 'byte-compile - ',(get function 'byte-compile)))) - ,@(if (get function 'byte-opcode) - `((put ',saved-function 'byte-opcode - ',(get function 'byte-opcode)))))))) - -(defun ad-save-real-definitions () - ;; Macro expansion will hardcode the values of the various byte-compiler - ;; properties into the compiled version of this function such that the - ;; proper values will be available at runtime without loading the compiler: - (ad-save-real-definition fset) - (ad-save-real-definition documentation)) - -(ad-save-real-definitions) - - ;; @@ Advice info access fns: ;; ========================== @@ -1819,7 +1676,7 @@ generates a copy of TREE." ;; (after adv1 adv2 ...) ;; (activation adv1 adv2 ...) ;; (deactivation adv1 adv2 ...) -;; (origname . <symbol fbound to origdef>) +;; (advicefunname . <symbol fbound to assembled advice function>) ;; (cache . (<advised-definition> . <id>))) ;; List of currently advised though not necessarily activated functions @@ -1840,15 +1697,13 @@ generates a copy of TREE." ad-advised-functions))) (defmacro ad-do-advised-functions (varform &rest body) - "`dolist'-style iterator that maps over `ad-advised-functions'. -\(ad-do-advised-functions (VAR [RESULT-FORM]) + "`dolist'-style iterator that maps over advised functions. +\(ad-do-advised-functions (VAR) BODY-FORM...) On each iteration VAR will be bound to the name of an advised function \(a symbol)." (declare (indent 1)) - `(cl-dolist (,(car varform) - ad-advised-functions - ,(car (cdr varform))) + `(dolist (,(car varform) ad-advised-functions) (setq ,(car varform) (intern (car ,(car varform)))) ,@body)) @@ -1858,8 +1713,15 @@ On each iteration VAR will be bound to the name of an advised function (defmacro ad-get-advice-info-macro (function) `(get ,function 'ad-advice-info)) -(defmacro ad-set-advice-info (function advice-info) - `(put ,function 'ad-advice-info ,advice-info)) +(defsubst ad-set-advice-info (function advice-info) + (cond + (advice-info + (add-function :around (get function 'defalias-fset-function) + #'ad--defalias-fset)) + ((get function 'defalias-fset-function) + (remove-function (get function 'defalias-fset-function) + #'ad--defalias-fset))) + (put function 'ad-advice-info advice-info)) (defmacro ad-copy-advice-info (function) `(copy-tree (get ,function 'ad-advice-info))) @@ -1867,7 +1729,7 @@ On each iteration VAR will be bound to the name of an advised function (defmacro ad-is-advised (function) "Return non-nil if FUNCTION has any advice info associated with it. This does not mean that the advice is also active." - (list 'ad-get-advice-info-macro function)) + `(ad-get-advice-info-macro ,function)) (defun ad-initialize-advice-info (function) "Initialize the advice info for FUNCTION. @@ -1907,18 +1769,17 @@ either t or nil, and DEFINITION should be a list of the form ;; ad-find-advice uses the alist structure directly -> ;; change if this data structure changes!! -(defmacro ad-advice-name (advice) - (list 'car advice)) -(defmacro ad-advice-protected (advice) - (list 'nth 1 advice)) -(defmacro ad-advice-enabled (advice) - (list 'nth 2 advice)) -(defmacro ad-advice-definition (advice) - (list 'nth 3 advice)) +(defsubst ad-advice-name (advice) (car advice)) +(defsubst ad-advice-protected (advice) (nth 1 advice)) +(defsubst ad-advice-enabled (advice) (nth 2 advice)) +(defsubst ad-advice-definition (advice) (nth 3 advice)) (defun ad-advice-set-enabled (advice flag) (rplaca (cdr (cdr advice)) flag)) +(defvar ad-advice-classes '(before around after activation deactivation) + "List of defined advice classes.") + (defun ad-class-p (thing) (memq thing ad-advice-classes)) (defun ad-name-p (thing) @@ -1931,9 +1792,6 @@ either t or nil, and DEFINITION should be a list of the form ;; @@ Advice access functions: ;; =========================== -;; List of defined advice classes: -(defvar ad-advice-classes '(before around after activation deactivation)) - (defun ad-has-enabled-advice (function class) "True if at least one of FUNCTION's advices in CLASS is enabled." (cl-dolist (advice (ad-get-advice-info-field function class)) @@ -1950,7 +1808,7 @@ Redefining advices affect the construction of an advised definition." (defun ad-has-any-advice (function) "True if the advice info of FUNCTION defines at least one advice." (and (ad-is-advised function) - (cl-dolist (class ad-advice-classes nil) + (cl-dolist (class ad-advice-classes) (if (ad-get-advice-info-field function class) (cl-return t))))) @@ -1966,76 +1824,30 @@ Redefining advices affect the construction of an advised definition." ;; @@ Dealing with automatic advice activation via `fset/defalias': ;; ================================================================ -;; Since Emacs 19.26 the built-in versions of `fset' and `defalias' -;; take care of automatic advice activation, hence, we don't have to -;; hack it anymore by advising `fset/defun/defmacro/byte-code/etc'. +;; Automatic activation happens when a function gets defined via `defalias', +;; which calls the `defalias-fset-function' (which we set to +;; `ad--defalias-fset') instead of `fset', if non-nil. -;; The functionality of the new `fset' is as follows: -;; -;; fset(sym,newdef) -;; assign NEWDEF to SYM -;; if (get SYM 'ad-advice-info) -;; ad-activate-internal(SYM, nil) -;; return (symbol-function SYM) -;; ;; Whether advised definitions created by automatic activations will be ;; compiled depends on the value of `ad-default-compilation-action'. -;; Since calling `ad-activate-internal' in the built-in definition of `fset' can -;; create major disasters we have to be a bit careful. One precaution is -;; to provide a dummy definition for `ad-activate-internal' which can be used to -;; turn off automatic advice activation (e.g., when `ad-stop-advice' or -;; `ad-recover-normality' are called). Another is to avoid recursive calls -;; to `ad-activate' by using `ad-with-auto-activation-disabled' where -;; appropriate, especially in a safe version of `fset'. - -;; For now define `ad-activate-internal' to the dummy definition: -(defun ad-activate-internal (function &optional compile) - "Automatic advice activation is disabled. `ad-start-advice' enables it." - nil) - -;; This is just a copy of the above: -(defun ad-activate-internal-off (function &optional compile) - "Automatic advice activation is disabled. `ad-start-advice' enables it." - nil) - -;; This will be t for top-level calls to `ad-activate-internal-on': -(defvar ad-activate-on-top-level t) - -(defmacro ad-with-auto-activation-disabled (&rest body) - `(let ((ad-activate-on-top-level nil)) - ,@body)) +(defalias 'ad-activate-internal 'ad-activate) -(defun ad-safe-fset (symbol definition) - "A safe `fset' which will never call `ad-activate-internal' recursively." - (ad-with-auto-activation-disabled - (ad-real-fset symbol definition))) +(defun ad-make-advicefunname (function) + "Make name to be used to call the assembled advice function." + (intern (format "ad-Advice-%s" function))) +(defun ad-get-orig-definition (function) ;FIXME: Rename to "-unadvised-". + (if (symbolp function) + (setq function (if (fboundp function) + (advice--strip-macro (symbol-function function))))) + (while (advice--p function) (setq function (advice--cdr function))) + function) -;; @@ Access functions for original definitions: -;; ============================================ -;; The advice-info of an advised function contains its `origname' which is -;; a symbol that is fbound to the original definition available at the first -;; proper activation of the function after a valid re/definition. If the -;; original was defined via fcell indirection then `origname' will be defined -;; just so. Hence, to get hold of the actual original definition of a function -;; we need to use `ad-real-orig-definition'. - -(defun ad-make-origname (function) - "Make name to be used to call the original FUNCTION." - (intern (format "ad-Orig-%s" function))) - -(defmacro ad-get-orig-definition (function) - `(let ((origname (ad-get-advice-info-field ,function 'origname))) - (if (fboundp origname) - (symbol-function origname)))) - -(defmacro ad-set-orig-definition (function definition) - `(ad-safe-fset - (ad-get-advice-info-field ,function 'origname) ,definition)) - -(defmacro ad-clear-orig-definition (function) - `(fmakunbound (ad-get-advice-info-field ,function 'origname))) +(defun ad-clear-advicefunname-definition (function) + (let ((advicefunname (ad-get-advice-info-field function 'advicefunname))) + (advice-remove function advicefunname) + (fmakunbound advicefunname))) ;; @@ Interactive input functions: @@ -2053,7 +1865,7 @@ function at point for which PREDICATE returns non-nil)." (error "ad-read-advised-function: There are no advised functions")) (setq default (or default - ;; Prefer func name at point, if it's in ad-advised-functions etc. + ;; Prefer func name at point, if it's an advised function etc. (let ((function (progn (require 'help) (function-called-at-point)))) @@ -2062,24 +1874,20 @@ function at point for which PREDICATE returns non-nil)." (or (null predicate) (funcall predicate function)) function)) - (ad-do-advised-functions (function) - (if (or (null predicate) - (funcall predicate function)) - (cl-return function))) + (cl-block nil + (ad-do-advised-functions (function) + (if (or (null predicate) + (funcall predicate function)) + (cl-return function)))) (error "ad-read-advised-function: %s" "There are no qualifying advised functions"))) - (let* ((ad-pReDiCaTe predicate) - (function + (let* ((function (completing-read (format "%s (default %s): " (or prompt "Function") default) ad-advised-functions (if predicate - (function - (lambda (function) - ;; Oops, no closures - the joys of dynamic scoping: - ;; `predicate' clashed with the `predicate' argument - ;; of `completing-read'..... - (funcall ad-pReDiCaTe (intern (car function)))))) + (lambda (function) + (funcall predicate (intern (car function))))) t))) (if (equal function "") (if (ad-is-advised default) @@ -2299,7 +2107,7 @@ See Info node `(elisp)Computed Advice' for detailed documentation." (cond ((not (ad-is-advised function)) (ad-initialize-advice-info function) (ad-set-advice-info-field - function 'origname (ad-make-origname function)))) + function 'advicefunname (ad-make-advicefunname function)))) (let* ((previous-position (ad-advice-position function class (ad-advice-name advice))) (advices (ad-get-advice-info-field function class)) @@ -2332,12 +2140,6 @@ See Info node `(elisp)Computed Advice' for detailed documentation." "Take a macro function DEFINITION and make a lambda out of it." `(cdr ,definition)) -(defun ad-special-form-p (definition) - "Non-nil if and only if DEFINITION is a special form." - (if (and (symbolp definition) (fboundp definition)) - (setq definition (indirect-function definition))) - (and (subrp definition) (eq (cdr (subr-arity definition)) 'unevalled))) - (defmacro ad-subr-p (definition) ;;"non-nil if DEFINITION is a subr." (list 'subrp definition)) @@ -2377,10 +2179,8 @@ See Info node `(elisp)Computed Advice' for detailed documentation." (cdr definition)) (t nil))) -(defun ad-arglist (definition &optional name) - "Return the argument list of DEFINITION. -If DEFINITION could be from a subr then its NAME should be -supplied to make subr arglist lookup more efficient." +(defun ad-arglist (definition) + "Return the argument list of DEFINITION." (require 'help-fns) (help-function-arglist (if (or (ad-macro-p definition) (ad-advice-p definition)) @@ -2392,7 +2192,7 @@ supplied to make subr arglist lookup more efficient." "Return the unexpanded docstring of DEFINITION." (let ((docstring (if (ad-compiled-p definition) - (ad-real-documentation definition t) + (documentation definition t) (car (cdr (cdr (ad-lambda-expression definition))))))) (if (or (stringp docstring) (natnump docstring)) @@ -2415,13 +2215,16 @@ Like `interactive-form', but also works on pieces of advice." (if (ad-interactive-form definition) 1 0)) (cdr (cdr (ad-lambda-expression definition))))))) -(defun ad-make-advised-definition-docstring (function) +(defun ad-make-advised-definition-docstring (_function) "Make an identifying docstring for the advised definition of FUNCTION. Put function name into the documentation string so we can infer the name of the advised function from the docstring. This is needed to generate a proper advised docstring even if we are just given a definition (see the code for `documentation')." - (propertize "Advice doc string" 'ad-advice-info function)) + (eval-when-compile + (propertize "Advice function assembled by advice.el." + 'dynamic-docstring-function + #'ad--make-advised-docstring))) (defun ad-advised-definition-p (definition) "Return non-nil if DEFINITION was generated from advice information." @@ -2430,20 +2233,19 @@ definition (see the code for `documentation')." (ad-compiled-p definition)) (let ((docstring (ad-docstring definition))) (and (stringp docstring) - (get-text-property 0 'ad-advice-info docstring))))) + (get-text-property 0 'dynamic-docstring-function docstring))))) (defun ad-definition-type (definition) "Return symbol that describes the type of DEFINITION." + ;; These symbols are only ever used to check a cache entry's validity. + ;; The suffix `2' reflects the fact that we're using version 2 of advice + ;; representations, so cache entries preactivated with version + ;; 1 can't be used. (cond - ((ad-macro-p definition) 'macro) - ((ad-subr-p definition) - (if (ad-special-form-p definition) - 'special-form - 'subr)) - ((or (ad-lambda-p definition) - (ad-compiled-p definition)) - 'function) - ((ad-advice-p definition) 'advice))) + ((ad-macro-p definition) 'macro2) + ((ad-subr-p definition) 'subr2) + ((or (ad-lambda-p definition) (ad-compiled-p definition)) 'fun2) + ((ad-advice-p definition) 'advice2))) ;; FIXME: Can this ever happen? (defun ad-has-proper-definition (function) "True if FUNCTION is a symbol with a proper definition. @@ -2463,9 +2265,9 @@ For that it has to be fbound with a non-autoload definition." definition)))) (defun ad-real-orig-definition (function) - "Find FUNCTION's real original definition starting from its `origname'." - (if (ad-is-advised function) - (ad-real-definition (ad-get-advice-info-field function 'origname)))) + (let* ((fun1 (ad-get-orig-definition function)) + (fun2 (indirect-function fun1))) + (unless (autoloadp fun2) fun2))) (defun ad-is-compilable (function) "True if FUNCTION has an interpreted definition that can be compiled." @@ -2474,25 +2276,17 @@ For that it has to be fbound with a non-autoload definition." (ad-macro-p (symbol-function function))) (not (ad-compiled-p (symbol-function function))))) +(defvar warning-suppress-types) ;From warnings.el. (defun ad-compile-function (function) - "Byte-compiles FUNCTION (or macro) if it is not yet compiled." - (interactive "aByte-compile function: ") - (if (ad-is-compilable function) - ;; Need to turn off auto-activation - ;; because `byte-compile' uses `fset': - (ad-with-auto-activation-disabled - (require 'bytecomp) - (require 'warnings) ;To define warning-suppress-types - ;before we let-bind it. - (let ((symbol (make-symbol "advice-compilation")) - (byte-compile-warnings byte-compile-warnings) - ;; Don't pop up windows showing byte-compiler warnings. - (warning-suppress-types '((bytecomp)))) - (if (featurep 'cl) - (byte-compile-disable-warning 'cl-functions)) - (fset symbol (symbol-function function)) - (byte-compile symbol) - (fset function (symbol-function symbol)))))) + "Byte-compile the assembled advice function." + (require 'bytecomp) + (require 'warnings) ;To define warning-suppress-types before we let-bind it. + (let ((byte-compile-warnings byte-compile-warnings) + ;; Don't pop up windows showing byte-compiler warnings. + (warning-suppress-types '((bytecomp)))) + (if (featurep 'cl) + (byte-compile-disable-warning 'cl-functions)) + (byte-compile (ad-get-advice-info-field function 'advicefunname)))) ;; @@@ Accessing argument lists: ;; ============================= @@ -2604,24 +2398,20 @@ The assignment starts at position INDEX." (let ((values-index 0) argument-access set-forms) (while (setq argument-access (ad-access-argument arglist index)) - (if (symbolp argument-access) - (setq set-forms - (cons (ad-set-argument - arglist index - (ad-element-access values-index 'ad-vAlUeS)) - set-forms)) - (setq set-forms - (cons (if (= (car argument-access) 0) - (list 'setq - (car (cdr argument-access)) - (ad-list-access values-index 'ad-vAlUeS)) - (list 'setcdr - (ad-list-access (1- (car argument-access)) - (car (cdr argument-access))) - (ad-list-access values-index 'ad-vAlUeS))) - set-forms)) - ;; terminate loop - (setq arglist nil)) + (push (if (symbolp argument-access) + (ad-set-argument + arglist index + (ad-element-access values-index 'ad-vAlUeS)) + (setq arglist nil) ;; Terminate loop. + (if (= (car argument-access) 0) + `(setq + ,(car (cdr argument-access)) + ,(ad-list-access values-index 'ad-vAlUeS)) + `(setcdr + ,(ad-list-access (1- (car argument-access)) + (car (cdr argument-access))) + ,(ad-list-access values-index 'ad-vAlUeS)))) + set-forms) (setq index (1+ index)) (setq values-index (1+ values-index))) (if (null set-forms) @@ -2630,8 +2420,8 @@ The assignment starts at position INDEX." (if (= (length set-forms) 1) ;; For exactly one set-form we can use values-form directly,... (ad-substitute-tree - (function (lambda (form) (eq form 'ad-vAlUeS))) - (function (lambda (form) values-form)) + (lambda (form) (eq form 'ad-vAlUeS)) + (lambda (_form) values-form) (car set-forms)) ;; ...if we have more we have to bind it to a variable: `(let ((ad-vAlUeS ,values-form)) @@ -2683,7 +2473,7 @@ Excess source arguments will be neglected, missing source arguments will be supplied as nil. Returns a `funcall' or `apply' form with the second element being `function' which has to be replaced by an actual function argument. Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return - `(funcall function a (car args) (car (cdr args)) (nth 2 args))'." + `(funcall ad--addoit-function a (car args) (car (cdr args)) (nth 2 args))'." (let* ((parsed-source-arglist (ad-parse-arglist source-arglist)) (source-reqopt-args (append (nth 0 parsed-source-arglist) (nth 1 parsed-source-arglist))) @@ -2697,15 +2487,14 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return ;; This produces ``error-proof'' target function calls with the exception ;; of a case like (&rest a) mapped onto (x &rest y) where the actual args ;; supplied to A might not be enough to supply the required target arg X - (append (list (if need-apply 'apply 'funcall) 'function) + (append (list (if need-apply 'apply 'funcall) 'ad--addoit-function) (cond (need-apply ;; `apply' can take care of that directly: (append source-reqopt-args (list source-rest-arg))) - (t (mapcar (function - (lambda (arg) - (setq target-arg-index (1+ target-arg-index)) - (ad-get-argument - source-arglist target-arg-index))) + (t (mapcar (lambda (_arg) + (setq target-arg-index (1+ target-arg-index)) + (ad-get-argument + source-arglist target-arg-index)) (append target-reqopt-args (and target-rest-arg ;; If we have a rest arg gobble up @@ -2713,13 +2502,6 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return (nthcdr (length target-reqopt-args) source-reqopt-args))))))))) -(defun ad-make-mapped-call (source-arglist target-arglist target-function) - "Make form to call TARGET-FUNCTION with args from SOURCE-ARGLIST." - (let ((mapped-form (ad-map-arglists source-arglist target-arglist))) - (if (eq (car mapped-form) 'funcall) - (cons target-function (cdr (cdr mapped-form))) - (prog1 mapped-form - (setcar (cdr mapped-form) (list 'quote target-function)))))) ;; @@@ Making an advised documentation string: ;; =========================================== @@ -2736,11 +2518,6 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return (let ((advice-docstring (ad-docstring (ad-advice-definition advice)))) (cond ((eq style 'plain) advice-docstring) - ((eq style 'freeze) - (format "Permanent %s-advice `%s':%s%s" - class (ad-advice-name advice) - (if advice-docstring "\n" "") - (or advice-docstring ""))) (t (if advice-docstring (format "%s-advice `%s':\n%s" (capitalize (symbol-name class)) @@ -2752,25 +2529,22 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return (require 'help-fns) ;For help-split-fundoc and help-add-fundoc-usage. -(defun ad-make-advised-docstring (function &optional style) +(defun ad--make-advised-docstring (origdoc function &optional style) "Construct a documentation string for the advised FUNCTION. It concatenates the original documentation with the documentation strings of the individual pieces of advice which will be formatted -according to STYLE. STYLE can be `plain' or `freeze', everything else +according to STYLE. STYLE can be `plain', everything else will be interpreted as `default'. The order of the advice documentation strings corresponds to before/around/after and the individual ordering in any of these classes." - (let* ((origdef (ad-real-orig-definition function)) - (origtype (symbol-name (ad-definition-type origdef))) - (origdoc - ;; Retrieve raw doc, key substitution will be taken care of later: - (ad-real-documentation origdef t)) - (usage (help-split-fundoc origdoc function)) - paragraphs advice-docstring ad-usage) + (if (and (symbolp function) + (string-match "\\`ad-+Advice-" (symbol-name function))) + (setq function + (intern (substring (symbol-name function) (match-end 0))))) + (let* ((usage (help-split-fundoc origdoc function)) + paragraphs advice-docstring) (setq usage (if (null usage) t (setq origdoc (cdr usage)) (car usage))) (if origdoc (setq paragraphs (list origdoc))) - (unless (eq style 'plain) - (push (concat "This " origtype " is advised.") paragraphs)) (dolist (class ad-advice-classes) (dolist (advice (ad-get-enabled-advices function class)) (setq advice-docstring @@ -2781,13 +2555,11 @@ in any of these classes." (propertize ;; separate paragraphs with blank lines: (mapconcat 'identity (nreverse paragraphs) "\n\n") - 'ad-advice-info function))) + ;; FIXME: what is this for? + 'dynamic-docstring-function + #'ad--make-advised-docstring))) (help-add-fundoc-usage origdoc usage))) -(defun ad-make-plain-docstring (function) - (ad-make-advised-docstring function 'plain)) -(defun ad-make-freeze-docstring (function) - (ad-make-advised-docstring function 'freeze)) ;; @@@ Accessing overriding arglists and interactive forms: ;; ======================================================== @@ -2821,64 +2593,18 @@ in any of these classes." (if (and (ad-is-advised function) (ad-has-redefining-advice function)) (let* ((origdef (ad-real-orig-definition function)) - (origname (ad-get-advice-info-field function 'origname)) - (orig-interactive-p (commandp origdef)) - (orig-subr-p (ad-subr-p origdef)) - (orig-special-form-p (ad-special-form-p origdef)) - (orig-macro-p (ad-macro-p origdef)) ;; Construct the individual pieces that we need for assembly: - (orig-arglist (ad-arglist origdef function)) + (orig-arglist (let ((args (ad-arglist origdef))) + ;; The arglist may still be unknown. + (if (listp args) args '(&rest args)))) (advised-arglist (or (ad-advised-arglist function) orig-arglist)) - (advised-interactive-form (ad-advised-interactive-form function)) - (interactive-form - (cond (orig-macro-p nil) - (advised-interactive-form) - ((interactive-form origdef) - (interactive-form - (if (and (symbolp function) (get function 'elp-info)) - (aref (get function 'elp-info) 2) - origdef))))) + (interactive-form (ad-advised-interactive-form function)) (orig-form - (cond ((or orig-special-form-p orig-macro-p) - ;; Special forms and macros will be advised into macros. - ;; The trick is to construct an expansion for the advised - ;; macro that does the correct thing when it gets eval'ed. - ;; For macros we'll just use the expansion of the original - ;; macro and return that. This way compiled advised macros - ;; will be expanded into something useful. Note that after - ;; advices have full control over whether they want to - ;; evaluate the expansion (the value of `ad-return-value') - ;; at macro expansion time or not. For special forms there - ;; is no solution that interacts reasonably with the - ;; compiler, hence we just evaluate the original at macro - ;; expansion time and return the result. The moral of that - ;; is that one should always deactivate advised special - ;; forms before one byte-compiles a file. - `(,(if orig-macro-p 'macroexpand 'eval) - (cons ',origname - ,(ad-get-arguments advised-arglist 0)))) - ((and orig-subr-p - orig-interactive-p - (not interactive-form) - (not advised-interactive-form)) - ;; Check whether we were called interactively - ;; in order to do proper prompting: - `(if (called-interactively-p 'any) - (call-interactively ',origname) - ,(ad-make-mapped-call advised-arglist - orig-arglist - origname))) - ;; And now for normal functions and non-interactive subrs - ;; (or subrs whose interactive behavior was advised): - (t (ad-make-mapped-call - advised-arglist orig-arglist origname))))) + (ad-map-arglists advised-arglist orig-arglist))) ;; Finally, build the sucker: (ad-assemble-advised-definition - (cond (orig-macro-p 'macro) - (orig-special-form-p 'special-form) - (t 'function)) advised-arglist (ad-make-advised-definition-docstring function) interactive-form @@ -2888,13 +2614,11 @@ in any of these classes." (ad-get-enabled-advices function 'after))))) (defun ad-assemble-advised-definition - (type args docstring interactive orig &optional befores arounds afters) - - "Assembles an original and its advices into an advised function. -It constructs a function or macro definition according to TYPE which has to -be either `macro', `function' or `special-form'. ARGS is the argument list -that has to be used, DOCSTRING if non-nil defines the documentation of the -definition, INTERACTIVE if non-nil is the interactive form to be used, + (args docstring interactive orig &optional befores arounds afters) + "Assemble the advices into an overall advice function. +ARGS is the argument list that has to be used, +DOCSTRING if non-nil defines the documentation of the definition, +INTERACTIVE if non-nil is the interactive form to be used, ORIG is a form that calls the body of the original unadvised function, and BEFORES, AROUNDS and AFTERS are the lists of advices with which ORIG should be modified. The assembled function will be returned." @@ -2922,8 +2646,8 @@ should be modified. The assembled function will be returned." (setq around-form-protected t)) (setq around-form (ad-substitute-tree - (function (lambda (form) (eq form 'ad-do-it))) - (function (lambda (form) around-form)) + (lambda (form) (eq form 'ad-do-it)) + (lambda (_form) around-form) (macroexp-progn (ad-body-forms (ad-advice-definition advice)))))) (setq after-forms @@ -2945,16 +2669,12 @@ should be modified. The assembled function will be returned." (ad-body-forms (ad-advice-definition advice))))))) (setq definition - `(,@(if (memq type '(macro special-form)) '(macro)) - lambda - ,args + `(lambda (ad--addoit-function ,@args) ,@(if docstring (list docstring)) ,@(if interactive (list interactive)) (let (ad-return-value) ,@after-forms - ,(if (eq type 'special-form) - '(list 'quote ad-return-value) - 'ad-return-value)))) + ad-return-value))) (ad-insert-argument-access-forms definition args))) @@ -3051,17 +2771,17 @@ advised definition from scratch." "Generate an identifying image of the current advices of FUNCTION." (let ((original-definition (ad-real-orig-definition function)) (cached-definition (ad-get-cache-definition function))) - (list (mapcar (function (lambda (advice) (ad-advice-name advice))) + (list (mapcar #'ad-advice-name (ad-get-enabled-advices function 'before)) - (mapcar (function (lambda (advice) (ad-advice-name advice))) + (mapcar #'ad-advice-name (ad-get-enabled-advices function 'around)) - (mapcar (function (lambda (advice) (ad-advice-name advice))) + (mapcar #'ad-advice-name (ad-get-enabled-advices function 'after)) (ad-definition-type original-definition) - (if (equal (ad-arglist original-definition function) + (if (equal (ad-arglist original-definition) (ad-arglist cached-definition)) t - (ad-arglist original-definition function)) + (ad-arglist original-definition)) (if (eq (ad-definition-type original-definition) 'function) (equal (interactive-form original-definition) (interactive-form cached-definition)))))) @@ -3106,7 +2826,7 @@ advised definition from scratch." (and (eq (nth 3 cache-id) (ad-definition-type original-definition)) (setq code 'arglist-mismatch) (equal (if (eq (nth 4 cache-id) t) - (ad-arglist original-definition function) + (ad-arglist original-definition) (nth 4 cache-id) ) (ad-arglist cached-definition)) (setq code 'interactive-form-mismatch) @@ -3146,10 +2866,8 @@ advised definition from scratch." (defun ad-preactivate-advice (function advice class position) "Preactivate FUNCTION and returns the constructed cache." - (let* ((function-defined-p (fboundp function)) - (old-definition - (if function-defined-p - (symbol-function function))) + (let* ((advicefunname (ad-get-advice-info-field function 'advicefunname)) + (old-advice (symbol-function advicefunname)) (old-advice-info (ad-copy-advice-info function)) (ad-advised-functions ad-advised-functions)) (unwind-protect @@ -3163,94 +2881,9 @@ advised definition from scratch." (list (ad-get-cache-definition function) (ad-get-cache-id function)))) (ad-set-advice-info function old-advice-info) - ;; Don't `fset' function to nil if it was previously unbound: - (if function-defined-p - (ad-safe-fset function old-definition) - (fmakunbound function))))) - - -;; @@ Freezing: -;; ============ -;; Freezing transforms a `defadvice' into a redefining `defun/defmacro' -;; for the advised function without keeping any advice information. This -;; feature was jwz's idea: It generates a dumpable function definition -;; whose documentation can be written to the DOC file, and the generated -;; code does not need any Advice runtime support. Of course, frozen advices -;; cannot be undone. - -;; Freezing only considers the advice of the particular `defadvice', other -;; already existing advices for the same function will be ignored. To ensure -;; proper interaction when an already advised function gets redefined with -;; a frozen advice, frozen advices always use the actual original definition -;; of the function, i.e., they are always at the core of the onion. E.g., if -;; an already advised function gets redefined with a frozen advice and then -;; unadvised, the frozen advice remains as the new definition of the function. - -;; While multiple freeze advices for a single function or freeze-advising -;; of an already advised function are possible, they are better avoided, -;; because definition/compile/load ordering is relevant, and it becomes -;; incomprehensible pretty quickly. - -(defun ad-make-freeze-definition (function advice class position) - (if (not (ad-has-proper-definition function)) - (error - "ad-make-freeze-definition: `%s' is not yet defined" - function)) - (let* ((name (ad-advice-name advice)) - ;; With a unique origname we can have multiple freeze advices - ;; for the same function, each overloading the previous one: - (unique-origname - (intern (format "%s-%s-%s" (ad-make-origname function) class name))) - (orig-definition - ;; If FUNCTION is already advised, we'll use its current origdef - ;; as the original definition of the frozen advice: - (or (ad-get-orig-definition function) - (symbol-function function))) - (old-advice-info - (if (ad-is-advised function) - (ad-copy-advice-info function))) - (real-docstring-fn - (symbol-function 'ad-make-advised-definition-docstring)) - (real-origname-fn - (symbol-function 'ad-make-origname)) - (frozen-definition - (unwind-protect - (progn - ;; Make sure we construct a proper docstring: - (ad-safe-fset 'ad-make-advised-definition-docstring - 'ad-make-freeze-docstring) - ;; Make sure `unique-origname' is used as the origname: - (ad-safe-fset 'ad-make-origname (lambda (x) unique-origname)) - ;; No we reset all current advice information to nil and - ;; generate an advised definition that's solely determined - ;; by ADVICE and the current origdef of FUNCTION: - (ad-set-advice-info function nil) - (ad-add-advice function advice class position) - ;; The following will provide proper real docstrings as - ;; well as a definition that will make the compiler happy: - (ad-set-orig-definition function orig-definition) - (ad-make-advised-definition function)) - ;; Restore the old advice state: - (ad-set-advice-info function old-advice-info) - ;; Restore functions: - (ad-safe-fset - 'ad-make-advised-definition-docstring real-docstring-fn) - (ad-safe-fset 'ad-make-origname real-origname-fn)))) - (if frozen-definition - (let* ((macro-p (ad-macro-p frozen-definition)) - (body (cdr (if macro-p - (ad-lambdafy frozen-definition) - frozen-definition)))) - `(progn - (if (not (fboundp ',unique-origname)) - (fset ',unique-origname - ;; avoid infinite recursion in case the function - ;; we want to freeze is already advised: - (or (ad-get-orig-definition ',function) - (symbol-function ',function)))) - (,(if macro-p 'defmacro 'defun) - ,function - ,@body)))))) + (advice-remove function advicefunname) + (fset advicefunname old-advice) + (if old-advice (advice-add function :around advicefunname))))) ;; @@ Activation and definition handling: @@ -3262,45 +2895,56 @@ If COMPILE is non-nil and not a negative number then it returns t. If COMPILE is a negative number then it returns nil. If COMPILE is nil then the result depends on the value of `ad-default-compilation-action' (which see)." - (if (integerp compile) - (>= compile 0) - (if compile - compile - (cond ((eq ad-default-compilation-action 'never) - nil) - ((eq ad-default-compilation-action 'always) - t) - ((eq ad-default-compilation-action 'like-original) - (or (ad-subr-p (ad-get-orig-definition function)) - (ad-compiled-p (ad-get-orig-definition function)))) - ;; everything else means `maybe': - (t (featurep 'byte-compile)))))) + (cond + ;; Don't compile until the real function definition is known (bug#12965). + ((not (ad-real-orig-definition function)) nil) + ((integerp compile) (>= compile 0)) + (compile) + ((eq ad-default-compilation-action 'never) nil) + ((eq ad-default-compilation-action 'always) t) + ((eq ad-default-compilation-action 'like-original) + (or (ad-subr-p (ad-get-orig-definition function)) + (ad-compiled-p (ad-get-orig-definition function)))) + ;; everything else means `maybe': + (t (featurep 'byte-compile)))) (defun ad-activate-advised-definition (function compile) "Redefine FUNCTION with its advised definition from cache or scratch. The resulting FUNCTION will be compiled if `ad-should-compile' returns t. The current definition and its cache-id will be put into the cache." - (let ((verified-cached-definition - (if (ad-verify-cache-id function) - (ad-get-cache-definition function)))) - (ad-safe-fset function - (or verified-cached-definition - (ad-make-advised-definition function))) + (let* ((verified-cached-definition + (if (ad-verify-cache-id function) + (ad-get-cache-definition function))) + (advicefunname (ad-get-advice-info-field function 'advicefunname)) + (old-ispec (interactive-form advicefunname))) + (fset advicefunname + (or verified-cached-definition + (ad-make-advised-definition function))) + (unless (equal (interactive-form advicefunname) old-ispec) + ;; If the interactive-spec of advicefunname has changed, force nadvice to + ;; refresh its copy. + (advice-remove function advicefunname)) + (advice-add function :around advicefunname) (if (ad-should-compile function compile) (ad-compile-function function)) (if verified-cached-definition - (if (not (eq verified-cached-definition (symbol-function function))) + (if (not (eq verified-cached-definition + (symbol-function advicefunname))) ;; we must have compiled, cache the compiled definition: - (ad-set-cache - function (symbol-function function) (ad-get-cache-id function))) + (ad-set-cache function (symbol-function advicefunname) + (ad-get-cache-id function))) ;; We created a new advised definition, cache it with a proper id: (ad-clear-cache function) ;; ad-make-cache-id needs the new cached definition: - (ad-set-cache function (symbol-function function) nil) + (ad-set-cache function (symbol-function advicefunname) nil) (ad-set-cache - function (symbol-function function) (ad-make-cache-id function))))) + function (symbol-function advicefunname) (ad-make-cache-id function))))) -(defun ad-handle-definition (function) +(defun ad--defalias-fset (fsetfun function newdef) + ;; Besides ad-redefinition-action we use this defalias-fset-function hook + ;; for two other reasons: + ;; - for `activation/deactivation' advices. + ;; - to rebuild the ad-Advice-* function with the right argument names. "Handle re/definition of an advised FUNCTION during de/activation. If FUNCTION does not have an original definition associated with it and the current definition is usable, then it will be stored as FUNCTION's @@ -3312,33 +2956,27 @@ associated with it but got redefined with a new definition and then de/activated. If you do not like the current redefinition action change the value of `ad-redefinition-action' and de/activate again." (let ((original-definition (ad-get-orig-definition function)) - (current-definition (if (ad-real-definition function) - (symbol-function function)))) + (current-definition (ad-get-orig-definition newdef))) (if original-definition (if current-definition - (if (and (not (eq current-definition original-definition)) - ;; Redefinition with an advised definition from a - ;; different function won't count as such: - (not (ad-advised-definition-p current-definition))) - ;; we have a redefinition: + (if (not (eq current-definition original-definition)) + ;; We have a redefinition: (if (not (memq ad-redefinition-action '(accept discard warn))) - (error "ad-handle-definition (see its doc): `%s' %s" + (error "ad-redefinition-action: `%s' %s" function "invalidly redefined") (if (eq ad-redefinition-action 'discard) - (ad-safe-fset function original-definition) - (ad-set-orig-definition function current-definition) + nil ;; Just drop it! + (funcall (or fsetfun #'fset) function newdef) + (ad-activate-internal function) (if (eq ad-redefinition-action 'warn) (message "ad-handle-definition: `%s' got redefined" function)))) ;; either advised def or correct original is in place: nil) - ;; we have an undefinition, ignore it: - nil) - (if current-definition - ;; we have a first definition, save it as original: - (ad-set-orig-definition function current-definition) - ;; we don't have anything noteworthy: - nil)))) + ;; We have an undefinition, ignore it: + (funcall (or fsetfun #'fset) function newdef)) + (funcall (or fsetfun #'fset) function newdef) + (when current-definition (ad-activate-internal function))))) ;; @@ The top-level advice interface: @@ -3364,24 +3002,20 @@ definition will always be cached for later usage." (interactive (list (ad-read-advised-function "Activate advice of") current-prefix-arg)) - (if ad-activate-on-top-level - ;; avoid recursive calls to `ad-activate': - (ad-with-auto-activation-disabled - (if (not (ad-is-advised function)) - (error "ad-activate: `%s' is not advised" function) - (ad-handle-definition function) - ;; Just return for forward advised and not yet defined functions: - (if (ad-get-orig-definition function) - (if (not (ad-has-any-advice function)) - (ad-unadvise function) - ;; Otherwise activate the advice: - (cond ((ad-has-redefining-advice function) - (ad-activate-advised-definition function compile) - (ad-set-advice-info-field function 'active t) - (eval (ad-make-hook-form function 'activation)) - function) - ;; Here we are if we have all disabled advices: - (t (ad-deactivate function))))))))) + (cond + ((not (ad-is-advised function)) + (error "ad-activate: `%s' is not advised" function)) + ;; Just return for forward advised and not yet defined functions: + ((not (ad-get-orig-definition function)) nil) + ((not (ad-has-any-advice function)) (ad-unadvise function)) + ;; Otherwise activate the advice: + ((ad-has-redefining-advice function) + (ad-activate-advised-definition function compile) + (ad-set-advice-info-field function 'active t) + (eval (ad-make-hook-form function 'activation)) + function) + ;; Here we are if we have all disabled advices: + (t (ad-deactivate function)))) (defalias 'ad-activate-on 'ad-activate) @@ -3396,11 +3030,10 @@ a call to `ad-activate'." (if (not (ad-is-advised function)) (error "ad-deactivate: `%s' is not advised" function) (cond ((ad-is-active function) - (ad-handle-definition function) (if (not (ad-get-orig-definition function)) (error "ad-deactivate: `%s' has no original definition" function) - (ad-safe-fset function (ad-get-orig-definition function)) + (ad-clear-advicefunname-definition function) (ad-set-advice-info-field function 'active nil) (eval (ad-make-hook-form function 'deactivation)) function))))) @@ -3422,7 +3055,7 @@ If FUNCTION was not advised this will be a noop." (cond ((ad-is-advised function) (if (ad-is-active function) (ad-deactivate function)) - (ad-clear-orig-definition function) + (ad-clear-advicefunname-definition function) (ad-set-advice-info function nil) (ad-pop-advised-function function)))) @@ -3437,9 +3070,7 @@ Use in emergencies." (list (intern (completing-read "Recover advised function: " obarray nil t)))) (cond ((ad-is-advised function) - (cond ((ad-get-orig-definition function) - (ad-safe-fset function (ad-get-orig-definition function)) - (ad-clear-orig-definition function))) + (ad-clear-advicefunname-definition function) (ad-set-advice-info function nil) (ad-pop-advised-function function)))) @@ -3519,7 +3150,7 @@ deactivation, which might run hooks and get into other trouble." ;; Completion alist of valid `defadvice' flags (defvar ad-defadvice-flags '(("protect") ("disable") ("activate") - ("compile") ("preactivate") ("freeze"))) + ("compile") ("preactivate"))) ;;;###autoload (defmacro defadvice (function args &rest body) @@ -3538,7 +3169,7 @@ POSITION ::= `first' | `last' | NUMBER. Optional, defaults to `first', ARGLIST ::= An optional argument list to be used for the advised function instead of the argument list of the original. The first one found in before/around/after-advices will be used. -FLAG ::= `protect'|`disable'|`activate'|`compile'|`preactivate'|`freeze'. +FLAG ::= `protect'|`disable'|`activate'|`compile'|`preactivate'. All flags can be specified with unambiguous initial substrings. DOCSTRING ::= Optional documentation for this piece of advice. INTERACTIVE-FORM ::= Optional interactive form to be used for the advised @@ -3564,13 +3195,6 @@ time. This generates a compiled advised definition according to the current advice state that will be used during activation if appropriate. Only use this if the `defadvice' gets actually compiled. -`freeze': Expands the `defadvice' into a redefining `defun/defmacro' according -to this particular single advice. No other advice information will be saved. -Frozen advices cannot be undone, they behave like a hard redefinition of -the advised function. `freeze' implies `activate' and `preactivate'. The -documentation of the advised function can be dumped onto the `DOC' file -during preloading. - See Info node `(elisp)Advising Functions' for comprehensive documentation. usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) [DOCSTRING] [INTERACTIVE-FORM] @@ -3620,29 +3244,24 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) (ad-preactivate-advice function advice class position)))) ;; Now for the things to be done at evaluation time: - (if (memq 'freeze flags) - ;; jwz's idea: Freeze the advised definition into a dumpable - ;; defun/defmacro whose docs can be written to the DOC file: - (ad-make-freeze-definition function advice class position) - ;; the normal case: - `(progn - (ad-add-advice ',function ',advice ',class ',position) - ,@(if preactivation - `((ad-set-cache - ',function - ;; the function will get compiled: - ,(cond ((ad-macro-p (car preactivation)) - `(ad-macrofy - (function - ,(ad-lambdafy - (car preactivation))))) - (t `(function - ,(car preactivation)))) - ',(car (cdr preactivation))))) - ,@(if (memq 'activate flags) - `((ad-activate ',function - ,(if (memq 'compile flags) t)))) - ',function)))) + `(progn + (ad-add-advice ',function ',advice ',class ',position) + ,@(if preactivation + `((ad-set-cache + ',function + ;; the function will get compiled: + ,(cond ((ad-macro-p (car preactivation)) + `(ad-macrofy + (function + ,(ad-lambdafy + (car preactivation))))) + (t `(function + ,(car preactivation)))) + ',(car (cdr preactivation))))) + ,@(if (memq 'activate flags) + `((ad-activate ',function + ,(if (memq 'compile flags) t)))) + ',function))) ;; @@ Tools: @@ -3670,59 +3289,35 @@ undone on exit of this macro." ;; Make forms to redefine functions to their ;; original definitions if they are advised: (setq index -1) - (mapcar - (function - (lambda (function) - (setq index (1+ index)) - `(ad-safe-fset - ',function - (or (ad-get-orig-definition ',function) - ,(car (nth index current-bindings)))))) - functions)) + (mapcar (lambda (function) + (setq index (1+ index)) + `(fset ',function + (or (ad-get-orig-definition ',function) + ,(car (nth index current-bindings))))) + functions)) ,@body) ,@(progn ;; Make forms to back-define functions to the definitions ;; they had outside this macro call: (setq index -1) - (mapcar - (function - (lambda (function) - (setq index (1+ index)) - `(ad-safe-fset - ',function - ,(car (nth index current-bindings))))) - functions)))))) + (mapcar (lambda (function) + (setq index (1+ index)) + `(fset ',function + ,(car (nth index current-bindings)))) + functions)))))) ;; @@ Starting, stopping and recovering from the advice package magic: ;; =================================================================== -(defun ad-start-advice () - "Start the automatic advice handling magic." - (interactive) - ;; Advising `ad-activate-internal' means death!! - (ad-set-advice-info 'ad-activate-internal nil) - (ad-safe-fset 'ad-activate-internal 'ad-activate)) - -(defun ad-stop-advice () - "Stop the automatic advice handling magic. -You should only need this in case of Advice-related emergencies." - (interactive) - ;; Advising `ad-activate-internal' means death!! - (ad-set-advice-info 'ad-activate-internal nil) - (ad-safe-fset 'ad-activate-internal 'ad-activate-internal-off)) - (defun ad-recover-normality () "Undo all advice related redefinitions and unadvises everything. Use only in REAL emergencies." (interactive) - ;; Advising `ad-activate-internal' means death!! - (ad-set-advice-info 'ad-activate-internal nil) - (ad-safe-fset 'ad-activate-internal 'ad-activate-internal-off) (ad-recover-all) - (setq ad-advised-functions nil)) - -(ad-start-advice) + (ad-do-advised-functions (function) + (message "Oops! Left over advised function %S" function) + (ad-pop-advised-function function))) (provide 'advice) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 0ddc78242ac..7375c2176ba 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1187,8 +1187,8 @@ boundp buffer-file-name buffer-local-variables buffer-modified-p buffer-substring byte-code-function-p capitalize car-less-than-car car cdr ceiling char-after char-before - char-equal char-to-string char-width - compare-strings concat coordinates-in-window-p + char-equal char-to-string char-width compare-strings + compare-window-configurations concat coordinates-in-window-p copy-alist copy-sequence copy-marker cos count-lines decode-char decode-time default-boundp default-value documentation downcase @@ -1196,17 +1196,18 @@ fboundp fceiling featurep ffloor file-directory-p file-exists-p file-locked-p file-name-absolute-p file-newer-than-file-p file-readable-p file-symlink-p file-writable-p - float float-time floor format format-time-string frame-visible-p - fround ftruncate + float float-time floor format format-time-string frame-first-window + frame-root-window frame-selected-window + frame-visible-p fround ftruncate get gethash get-buffer get-buffer-window getenv get-file-buffer hash-table-count int-to-string intern-soft keymap-parent length local-variable-if-set-p local-variable-p log log10 logand logb logior lognot logxor lsh langinfo - make-list make-string make-symbol - marker-buffer max member memq min mod multibyte-char-to-unibyte - next-window nth nthcdr number-to-string + make-list make-string make-symbol marker-buffer max member memq min + minibuffer-selected-window minibuffer-window + mod multibyte-char-to-unibyte next-window nth nthcdr number-to-string parse-colon-path plist-get plist-member prefix-numeric-value previous-window prin1-to-string propertize degrees-to-radians @@ -1221,9 +1222,19 @@ unibyte-char-to-multibyte upcase user-full-name user-login-name user-original-login-name custom-variable-p vconcat - window-buffer window-dedicated-p window-edges window-height - window-hscroll window-minibuffer-p window-width - zerop)) + window-absolute-pixel-edges window-at window-body-height + window-body-width window-buffer window-dedicated-p window-display-table + window-combination-limit window-edges window-frame window-fringes + window-height window-hscroll window-inside-edges + window-inside-absolute-pixel-edges window-inside-pixel-edges + window-left-child window-left-column window-margins window-minibuffer-p + window-next-buffers window-next-sibling window-new-normal + window-new-total window-normal-size window-parameter window-parameters + window-parent window-pixel-edges window-point window-prev-buffers + window-prev-sibling window-redisplay-end-trigger window-scroll-bars + window-start window-text-height window-top-child window-top-line + window-total-height window-total-width window-use-time window-vscroll + window-width zerop)) (side-effect-and-error-free-fns '(arrayp atom bobp bolp bool-vector-p @@ -1256,7 +1267,8 @@ this-single-command-raw-keys user-real-login-name user-real-uid user-uid vector vectorp visible-frame-list - wholenump window-configuration-p window-live-p windowp))) + wholenump window-configuration-p window-live-p + window-valid-p windowp))) (while side-effect-free-fns (put (car side-effect-free-fns) 'side-effect-free t) (setq side-effect-free-fns (cdr side-effect-free-fns))) diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 7322c0fbe6f..b44ec68e2bf 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -81,10 +81,14 @@ The return value of this function is not used." #'(lambda (f _args new-name when) `(make-obsolete ',f ',new-name ,when))) (list 'compiler-macro - #'(lambda (f _args compiler-function) - (if (not (symbolp compiler-function)) - (error "Only symbols are supported in `compiler-macro'") - `(put ',f 'compiler-macro #',compiler-function)))) + #'(lambda (f args compiler-function) + ;; FIXME: Make it possible to just reuse `args'. + `(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))))) (list 'doc-string #'(lambda (f _args pos) (list 'put (list 'quote f) ''doc-string-elt (list 'quote pos)))) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index ce3a3324e18..4e002cfc8cb 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -419,8 +419,8 @@ This list lives partly on the stack.") (defconst byte-compile-initial-macro-environment '( -;; (byte-compiler-options . (lambda (&rest forms) -;; (apply 'byte-compiler-options-handler forms))) + ;; (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 @@ -429,8 +429,19 @@ This list lives partly on the stack.") (byte-compile-top-level (byte-compile-preprocess (cons 'progn body))))))) (eval-and-compile . (lambda (&rest body) - (byte-compile-eval-before-compile (cons 'progn body)) - (cons 'progn 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))))) "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.") @@ -731,9 +742,11 @@ otherwise pop it") ;; Also, this lets us notice references to free variables. (defmacro byte-compile-push-bytecodes (&rest args) - "Push BYTE... onto BYTES, and increment PC by the number of bytes pushed. -ARGS is of the form (BYTE... BYTES PC), where BYTES and PC are variable names. -BYTES and PC are updated after evaluating all the arguments." + "Push bytes onto BVAR, and increment CVAR by the number of bytes pushed. +BVAR and CVAR are variables which are updated after evaluating +all the arguments. + +\(fn BYTE1 BYTE2 ... BYTEn BVAR CVAR)" (let ((byte-exprs (butlast args 2)) (bytes-var (car (last args 2))) (pc-var (car (last args)))) @@ -863,16 +876,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (let ((xs (pop hist-new)) old-autoloads) ;; Make sure the file was not already loaded before. - (unless (or (assoc (car xs) hist-orig) - ;; Don't give both the "noruntime" and - ;; "cl-functions" warning for the same function. - ;; FIXME This seems incorrect - these are two - ;; independent warnings. For example, you may be - ;; choosing to see the cl warnings but ignore them. - ;; You probably don't want to ignore noruntime in the - ;; same way. - (and (byte-compile-warning-enabled-p 'cl-functions) - (byte-compile-cl-file-p (car xs)))) + (unless (assoc (car xs) hist-orig) (dolist (s xs) (cond ((and (consp s) (eq t (car s))) @@ -1106,8 +1110,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (defun byte-compile-log-warning (string &optional fill level) (let ((warning-prefix-function 'byte-compile-warning-prefix) (warning-type-format "") - (warning-fill-prefix (if fill " ")) - (inhibit-read-only t)) + (warning-fill-prefix (if fill " "))) (display-warning 'bytecomp string level byte-compile-log-buffer))) (defun byte-compile-warn (format &rest args) @@ -2201,7 +2204,10 @@ list that represents a doc string reference. (when (and (consp (nth 1 form)) (eq (car (nth 1 form)) 'quote) (consp (cdr (nth 1 form))) - (symbolp (nth 1 (nth 1 form)))) + (symbolp (nth 1 (nth 1 form))) + ;; Don't add it if it's already defined. Otherwise, it might + ;; hide the actual definition. + (not (fboundp (nth 1 (nth 1 form))))) (push (cons (nth 1 (nth 1 form)) (cons 'autoload (cdr (cdr form)))) byte-compile-function-environment) @@ -2506,8 +2512,8 @@ If FORM is a lambda or a macro, byte-compile it as a function." (when (symbolp form) (unless (memq (car-safe fun) '(closure lambda)) (error "Don't know how to compile %S" fun)) - (setq fun (byte-compile--reify-function fun)) - (setq lexical-binding (eq (car fun) 'closure))) + (setq lexical-binding (eq (car fun) 'closure)) + (setq fun (byte-compile--reify-function fun))) (unless (eq (car-safe fun) 'lambda) (error "Don't know how to compile %S" fun)) ;; Expand macros. @@ -2820,7 +2826,8 @@ for symbols generated by the byte compiler itself." (setq body (nreverse body)) (setq body (list (if (and (eq tmp 'funcall) - (eq (car-safe (car body)) 'quote)) + (eq (car-safe (car body)) 'quote) + (symbolp (nth 1 (car body)))) (cons (nth 1 (car body)) (cdr body)) (cons tmp body)))) (or (eq output-type 'file) @@ -3701,10 +3708,10 @@ If CONDITION's value is (not (featurep 'emacs)) or (featurep 'xemacs), that suppresses all warnings during execution of BODY." (declare (indent 1) (debug t)) `(let* ((fbound-list (byte-compile-find-bound-condition - ,condition (list 'fboundp) + ,condition '(fboundp functionp) byte-compile-unresolved-functions)) (bound-list (byte-compile-find-bound-condition - ,condition (list 'boundp 'default-boundp))) + ,condition '(boundp default-boundp))) ;; Maybe add to the bound list. (byte-compile-bound-variables (append bound-list byte-compile-bound-variables))) diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index b90df7092ea..34892bf2fef 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -51,7 +51,8 @@ TYPE is a Common Lisp type specifier. ((eq type 'string) (if (stringp x) x (concat x))) ((eq type 'array) (if (arrayp x) x (vconcat x))) ((and (eq type 'character) (stringp x) (= (length x) 1)) (aref x 0)) - ((and (eq type 'character) (symbolp x)) (cl-coerce (symbol-name x) type)) + ((and (eq type 'character) (symbolp x)) + (cl-coerce (symbol-name x) type)) ((eq type 'float) (float x)) ((cl-typep x type) x) (t (error "Can't coerce %s to type %s" x type)))) @@ -69,7 +70,7 @@ strings case-insensitively." ((stringp x) (and (stringp y) (= (length x) (length y)) (or (string-equal x y) - (string-equal (downcase x) (downcase y))))) ; lazy but simple! + (string-equal (downcase x) (downcase y))))) ;Lazy but simple! ((numberp x) (and (numberp y) (= x y))) ((consp x) @@ -439,14 +440,14 @@ Optional second arg STATE is a random-state object." If STATE is t, return a new state object seeded from the time of day." (cond ((null state) (cl-make-random-state cl--random-state)) ((vectorp state) (copy-tree state t)) - ((integerp state) (vector 'cl-random-state-tag -1 30 state)) - (t (cl-make-random-state (cl-random-time))))) + ((integerp state) (vector 'cl--random-state-tag -1 30 state)) + (t (cl-make-random-state (cl--random-time))))) ;;;###autoload (defun cl-random-state-p (object) "Return t if OBJECT is a random-state object." (and (vectorp object) (= (length object) 4) - (eq (aref object 0) 'cl-random-state-tag))) + (eq (aref object 0) 'cl--random-state-tag))) ;; Implementation limits. diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 226e9607b40..2de8260c941 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -93,8 +93,8 @@ (require 'macroexp) -(defvar cl-optimize-speed 1) -(defvar cl-optimize-safety 1) +(defvar cl--optimize-speed 1) +(defvar cl--optimize-safety 1) ;;;###autoload (define-obsolete-variable-alias @@ -242,33 +242,31 @@ one value. (equal (buffer-name (symbol-value 'byte-compile--outbuffer)) " *Compiler Output*")))) -(defvar cl-proclaims-deferred nil) +(defvar cl--proclaims-deferred nil) (defun cl-proclaim (spec) "Record a global declaration specified by SPEC." - (if (fboundp 'cl-do-proclaim) (cl-do-proclaim spec t) - (push spec cl-proclaims-deferred)) + (if (fboundp 'cl--do-proclaim) (cl--do-proclaim spec t) + (push spec cl--proclaims-deferred)) nil) (defmacro cl-declaim (&rest specs) "Like `cl-proclaim', but takes any number of unevaluated, unquoted arguments. Puts `(cl-eval-when (compile load eval) ...)' around the declarations so that they are registered at compile-time as well as run-time." - (let ((body (mapcar (function (lambda (x) - (list 'cl-proclaim (list 'quote x)))) - specs))) - (if (cl--compiling-file) (cl-list* 'cl-eval-when '(compile load eval) body) - (cons 'progn body)))) ; avoid loading cl-macs.el for cl-eval-when + (let ((body (mapcar (lambda (x) `(cl-proclaim ',x)) specs))) + (if (cl--compiling-file) `(cl-eval-when (compile load eval) ,@body) + `(progn ,@body)))) ; Avoid loading cl-macs.el for cl-eval-when. ;;; Symbols. -(defun cl-random-time () +(defun cl--random-time () (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0)) (while (>= (cl-decf i) 0) (setq v (+ (* v 3) (aref time i)))) v)) -(defvar cl--gensym-counter (* (logand (cl-random-time) 1023) 100)) +(defvar cl--gensym-counter (* (logand (cl--random-time) 1023) 100)) ;;; Numbers. @@ -295,7 +293,8 @@ always returns nil." "Return t if INTEGER is even." (eq (logand integer 1) 0)) -(defvar cl--random-state (vector 'cl-random-state-tag -1 30 (cl-random-time))) +(defvar cl--random-state + (vector 'cl--random-state-tag -1 30 (cl--random-time))) (defconst cl-most-positive-float nil "The largest value that a Lisp float can hold. diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 4198c0e0063..734975f7f11 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -11,7 +11,7 @@ ;;;;;; cl--map-overlays cl--map-intervals cl--map-keymap-recursively ;;;;;; cl-notevery cl-notany cl-every cl-some cl-mapcon cl-mapcan ;;;;;; cl-mapl cl-mapc cl-maplist cl-map cl--mapcar-many cl-equalp -;;;;;; cl-coerce) "cl-extra" "cl-extra.el" "6c7926a10c377679687a2ab6a4d1c186") +;;;;;; cl-coerce) "cl-extra" "cl-extra.el" "c5730f2a706cb1efc5fec0a790d3ca72") ;;; Generated autoloads from cl-extra.el (autoload 'cl-coerce "cl-extra" "\ @@ -224,7 +224,7 @@ Return the value of SYMBOL's PROPNAME property, or DEFAULT if none. \(fn SYMBOL PROPNAME &optional DEFAULT)" nil nil) -(put 'cl-get 'compiler-macro #'cl--compiler-macro-get) +(eval-and-compile (put 'cl-get 'compiler-macro #'cl--compiler-macro-get)) (autoload 'cl-getf "cl-extra" "\ Search PROPLIST for property PROPNAME; return its value or DEFAULT. @@ -262,12 +262,12 @@ including `cl-block' and `cl-eval-when'. ;;;;;; cl-rotatef cl-shiftf cl-remf cl-psetf cl-declare cl-the cl-locally ;;;;;; cl-multiple-value-setq cl-multiple-value-bind cl-symbol-macrolet ;;;;;; cl-macrolet cl-labels cl-flet* cl-flet cl-progv cl-psetq -;;;;;; cl-do-all-symbols cl-do-symbols cl-dotimes cl-dolist cl-do* -;;;;;; cl-do cl-loop cl-return-from cl-return cl-block cl-etypecase +;;;;;; cl-do-all-symbols cl-do-symbols cl-tagbody cl-dotimes cl-dolist +;;;;;; cl-do* cl-do cl-loop cl-return-from cl-return cl-block cl-etypecase ;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when ;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp ;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*) -;;;;;; "cl-macs" "cl-macs.el" "ad8afd35d8d75f5f22e7547b02bac556") +;;;;;; "cl-macs" "cl-macs.el" "3b4d4e869f81f0b07ab3aa08f5478c2e") ;;; Generated autoloads from cl-macs.el (autoload 'cl--compiler-macro-list* "cl-macs" "\ @@ -465,6 +465,19 @@ nil. (put 'cl-dotimes 'lisp-indent-function '1) +(autoload 'cl-tagbody "cl-macs" "\ +Execute statements while providing for control transfers to labels. +Each element of LABELS-OR-STMTS can be either a label (integer or symbol) +or a `cons' cell, in which case it's taken to be a statement. +This distinction is made before performing macroexpansion. +Statements are executed in sequence left to right, discarding any return value, +stopping only when reaching the end of LABELS-OR-STMTS. +Any statement can transfer control at any time to the statements that follow +one of the labels with the special form (go LABEL). +Labels have lexical scope and dynamic extent. + +\(fn &rest LABELS-OR-STMTS)" nil t) + (autoload 'cl-do-symbols "cl-macs" "\ Loop over all symbols. Evaluate BODY with VAR bound to each interned symbol, or to each symbol @@ -759,7 +772,7 @@ surrounded by (cl-block NAME ...). ;;;;;; cl-nsubstitute-if cl-nsubstitute cl-substitute-if-not cl-substitute-if ;;;;;; cl-substitute cl-delete-duplicates cl-remove-duplicates cl-delete-if-not ;;;;;; cl-delete-if cl-delete cl-remove-if-not cl-remove-if cl-remove -;;;;;; cl-replace cl-fill cl-reduce) "cl-seq" "cl-seq.el" "5ce2761d9a21845a7f6a2da0e4543844") +;;;;;; cl-replace cl-fill cl-reduce) "cl-seq" "cl-seq.el" "51a70dea9cbc225165a50135956609aa") ;;; Generated autoloads from cl-seq.el (autoload 'cl-reduce "cl-seq" "\ @@ -1020,7 +1033,7 @@ Keywords supported: :test :test-not :key \(fn ITEM LIST [KEYWORD VALUE]...)" nil nil) -(put 'cl-member 'compiler-macro #'cl--compiler-macro-member) +(eval-and-compile (put 'cl-member 'compiler-macro #'cl--compiler-macro-member)) (autoload 'cl-member-if "cl-seq" "\ Find the first item satisfying PREDICATE in LIST. @@ -1050,7 +1063,7 @@ Keywords supported: :test :test-not :key \(fn ITEM LIST [KEYWORD VALUE]...)" nil nil) -(put 'cl-assoc 'compiler-macro #'cl--compiler-macro-assoc) +(eval-and-compile (put 'cl-assoc 'compiler-macro #'cl--compiler-macro-assoc)) (autoload 'cl-assoc-if "cl-seq" "\ Find the first item whose car satisfies PREDICATE in LIST. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index ab474ebb0db..b63086d7a5f 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -48,13 +48,13 @@ ;; `gv' is required here because cl-macs can be loaded before loaddefs.el. (require 'gv) -(defmacro cl-pop2 (place) +(defmacro cl--pop2 (place) (declare (debug edebug-sexps)) `(prog1 (car (cdr ,place)) (setq ,place (cdr (cdr ,place))))) -(defvar cl-optimize-safety) -(defvar cl-optimize-speed) +(defvar cl--optimize-safety) +(defvar cl--optimize-speed) ;;; Initialization. @@ -265,9 +265,11 @@ FORM is of the form (ARGS . BODY)." (require 'help-fns) (cons (help-add-fundoc-usage (if (stringp (car hdr)) (pop hdr)) - (format "%S" - (cons 'fn - (cl--make-usage-args orig-args)))) + ;; Be careful with make-symbol and (back)quote, + ;; see bug#12884. + (let ((print-gensym nil) (print-quoted t)) + (format "%S" (cons 'fn (cl--make-usage-args + orig-args))))) hdr))) (list `(let* ,cl--bind-lets ,@(nreverse cl--bind-forms) @@ -429,7 +431,7 @@ its argument list allows full Common Lisp conventions." (if (memq '&environment args) (error "&environment used incorrectly")) (let ((save-args args) (restarg (memq '&rest args)) - (safety (if (cl--compiling-file) cl-optimize-safety 3)) + (safety (if (cl--compiling-file) cl--optimize-safety 3)) (keys nil) (laterarg nil) (exactarg nil) minarg) (or num (setq num 0)) @@ -438,7 +440,7 @@ its argument list allows full Common Lisp conventions." (setq restarg (cadr restarg))) (push (list restarg expr) cl--bind-lets) (if (eq (car args) '&whole) - (push (list (cl-pop2 args) restarg) cl--bind-lets)) + (push (list (cl--pop2 args) restarg) cl--bind-lets)) (let ((p args)) (setq minarg restarg) (while (and p (not (memq (car p) cl--lambda-list-keywords))) @@ -474,7 +476,7 @@ its argument list allows full Common Lisp conventions." (if def `(if ,restarg ,poparg ,def) poparg)) (setq num (1+ num)))))) (if (eq (car args) '&rest) - (let ((arg (cl-pop2 args))) + (let ((arg (cl--pop2 args))) (if (consp arg) (cl--do-arglist arg restarg))) (or (eq (car args) '&key) (= safety 0) exactarg (push `(if ,restarg @@ -572,7 +574,7 @@ its argument list allows full Common Lisp conventions." ;;; The `cl-eval-when' form. -(defvar cl-not-toplevel nil) +(defvar cl--not-toplevel nil) ;;;###autoload (defmacro cl-eval-when (when &rest body) @@ -584,9 +586,9 @@ If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level. \(fn (WHEN...) BODY...)" (declare (indent 1) (debug ((&rest &or "compile" "load" "eval") body))) (if (and (fboundp 'cl--compiling-file) (cl--compiling-file) - (not cl-not-toplevel) (not (boundp 'for-effect))) ; horrible kludge + (not cl--not-toplevel) (not (boundp 'for-effect))) ;Horrible kludge. (let ((comp (or (memq 'compile when) (memq :compile-toplevel when))) - (cl-not-toplevel t)) + (cl--not-toplevel t)) (if (or (memq 'load when) (memq :load-toplevel when)) (if comp (cons 'progn (mapcar 'cl--compile-time-too body)) `(if nil nil ,@body)) @@ -757,7 +759,8 @@ This is compatible with Common Lisp, but note that `defun' and (defvar cl--loop-first-flag) (defvar cl--loop-initially) (defvar cl--loop-map-form) (defvar cl--loop-name) (defvar cl--loop-result) (defvar cl--loop-result-explicit) -(defvar cl--loop-result-var) (defvar cl--loop-steps) (defvar cl--loop-symbol-macs) +(defvar cl--loop-result-var) (defvar cl--loop-steps) +(defvar cl--loop-symbol-macs) ;;;###autoload (defmacro cl-loop (&rest loop-args) @@ -790,7 +793,8 @@ Valid clauses are: "return"] form] ;; Simple default, which covers 99% of the cases. symbolp form))) - (if (not (memq t (mapcar 'symbolp (delq nil (delq t (cl-copy-list loop-args)))))) + (if (not (memq t (mapcar #'symbolp + (delq nil (delq t (cl-copy-list loop-args)))))) `(cl-block nil (while t ,@loop-args)) (let ((cl--loop-args loop-args) (cl--loop-name nil) (cl--loop-bindings nil) (cl--loop-body nil) (cl--loop-steps nil) @@ -801,14 +805,16 @@ Valid clauses are: (cl--loop-map-form nil) (cl--loop-first-flag nil) (cl--loop-destr-temps nil) (cl--loop-symbol-macs nil)) (setq cl--loop-args (append cl--loop-args '(cl-end-loop))) - (while (not (eq (car cl--loop-args) 'cl-end-loop)) (cl-parse-loop-clause)) + (while (not (eq (car cl--loop-args) 'cl-end-loop)) + (cl--parse-loop-clause)) (if cl--loop-finish-flag (push `((,cl--loop-finish-flag t)) cl--loop-bindings)) (if cl--loop-first-flag (progn (push `((,cl--loop-first-flag t)) cl--loop-bindings) (push `(setq ,cl--loop-first-flag nil) cl--loop-steps))) (let* ((epilogue (nconc (nreverse cl--loop-finally) - (list (or cl--loop-result-explicit cl--loop-result)))) + (list (or cl--loop-result-explicit + cl--loop-result)))) (ands (cl--loop-build-ands (nreverse cl--loop-body))) (while-body (nconc (cadr ands) (nreverse cl--loop-steps))) (body (append @@ -828,7 +834,8 @@ Valid clauses are: `((if ,cl--loop-finish-flag (progn ,@epilogue) ,cl--loop-result-var))) epilogue)))) - (if cl--loop-result-var (push (list cl--loop-result-var) cl--loop-bindings)) + (if cl--loop-result-var + (push (list cl--loop-result-var) cl--loop-bindings)) (while cl--loop-bindings (if (cdar cl--loop-bindings) (setq body (list (cl--loop-let (pop cl--loop-bindings) body t))) @@ -838,7 +845,8 @@ Valid clauses are: (push (car (pop cl--loop-bindings)) lets)) (setq body (list (cl--loop-let lets body nil)))))) (if cl--loop-symbol-macs - (setq body (list `(cl-symbol-macrolet ,cl--loop-symbol-macs ,@body)))) + (setq body + (list `(cl-symbol-macrolet ,cl--loop-symbol-macs ,@body)))) `(cl-block ,cl--loop-name ,@body))))) ;; Below is a complete spec for cl-loop, in several parts that correspond @@ -993,7 +1001,7 @@ Valid clauses are: -(defun cl-parse-loop-clause () ; uses loop-* +(defun cl--parse-loop-clause () ; uses loop-* (let ((word (pop cl--loop-args)) (hash-types '(hash-key hash-keys hash-value hash-values)) (key-types '(key-code key-codes key-seq key-seqs @@ -1008,17 +1016,21 @@ Valid clauses are: ((eq word 'initially) (if (memq (car cl--loop-args) '(do doing)) (pop cl--loop-args)) - (or (consp (car cl--loop-args)) (error "Syntax error on `initially' clause")) + (or (consp (car cl--loop-args)) + (error "Syntax error on `initially' clause")) (while (consp (car cl--loop-args)) (push (pop cl--loop-args) cl--loop-initially))) ((eq word 'finally) (if (eq (car cl--loop-args) 'return) - (setq cl--loop-result-explicit (or (cl-pop2 cl--loop-args) '(quote nil))) + (setq cl--loop-result-explicit + (or (cl--pop2 cl--loop-args) '(quote nil))) (if (memq (car cl--loop-args) '(do doing)) (pop cl--loop-args)) - (or (consp (car cl--loop-args)) (error "Syntax error on `finally' clause")) + (or (consp (car cl--loop-args)) + (error "Syntax error on `finally' clause")) (if (and (eq (caar cl--loop-args) 'return) (null cl--loop-name)) - (setq cl--loop-result-explicit (or (nth 1 (pop cl--loop-args)) '(quote nil))) + (setq cl--loop-result-explicit + (or (nth 1 (pop cl--loop-args)) '(quote nil))) (while (consp (car cl--loop-args)) (push (pop cl--loop-args) cl--loop-finally))))) @@ -1034,7 +1046,8 @@ Valid clauses are: (if (eq word 'being) (setq word (pop cl--loop-args))) (if (memq word '(the each)) (setq word (pop cl--loop-args))) (if (memq word '(buffer buffers)) - (setq word 'in cl--loop-args (cons '(buffer-list) cl--loop-args))) + (setq word 'in + cl--loop-args (cons '(buffer-list) cl--loop-args))) (cond ((memq word '(from downfrom upfrom to downto upto @@ -1043,15 +1056,19 @@ Valid clauses are: (if (memq (car cl--loop-args) '(downto above)) (error "Must specify `from' value for downward cl-loop")) (let* ((down (or (eq (car cl--loop-args) 'downfrom) - (memq (cl-caddr cl--loop-args) '(downto above)))) + (memq (cl-caddr cl--loop-args) + '(downto above)))) (excl (or (memq (car cl--loop-args) '(above below)) - (memq (cl-caddr cl--loop-args) '(above below)))) - (start (and (memq (car cl--loop-args) '(from upfrom downfrom)) - (cl-pop2 cl--loop-args))) + (memq (cl-caddr cl--loop-args) + '(above below)))) + (start (and (memq (car cl--loop-args) + '(from upfrom downfrom)) + (cl--pop2 cl--loop-args))) (end (and (memq (car cl--loop-args) '(to upto downto above below)) - (cl-pop2 cl--loop-args))) - (step (and (eq (car cl--loop-args) 'by) (cl-pop2 cl--loop-args))) + (cl--pop2 cl--loop-args))) + (step (and (eq (car cl--loop-args) 'by) + (cl--pop2 cl--loop-args))) (end-var (and (not (macroexp-const-p end)) (make-symbol "--cl-var--"))) (step-var (and (not (macroexp-const-p step)) @@ -1085,7 +1102,7 @@ Valid clauses are: loop-for-sets)))) (push (list temp (if (eq (car cl--loop-args) 'by) - (let ((step (cl-pop2 cl--loop-args))) + (let ((step (cl--pop2 cl--loop-args))) (if (and (memq (car-safe step) '(quote function cl-function)) @@ -1097,7 +1114,8 @@ Valid clauses are: ((eq word '=) (let* ((start (pop cl--loop-args)) - (then (if (eq (car cl--loop-args) 'then) (cl-pop2 cl--loop-args) start))) + (then (if (eq (car cl--loop-args) 'then) + (cl--pop2 cl--loop-args) start))) (push (list var nil) loop-for-bindings) (if (or ands (eq (car cl--loop-args) 'and)) (progn @@ -1134,14 +1152,15 @@ Valid clauses are: (let ((ref (or (memq (car cl--loop-args) '(in-ref of-ref)) (and (not (memq (car cl--loop-args) '(in of))) (error "Expected `of'")))) - (seq (cl-pop2 cl--loop-args)) + (seq (cl--pop2 cl--loop-args)) (temp-seq (make-symbol "--cl-seq--")) - (temp-idx (if (eq (car cl--loop-args) 'using) - (if (and (= (length (cadr cl--loop-args)) 2) - (eq (cl-caadr cl--loop-args) 'index)) - (cadr (cl-pop2 cl--loop-args)) - (error "Bad `using' clause")) - (make-symbol "--cl-idx--")))) + (temp-idx + (if (eq (car cl--loop-args) 'using) + (if (and (= (length (cadr cl--loop-args)) 2) + (eq (cl-caadr cl--loop-args) 'index)) + (cadr (cl--pop2 cl--loop-args)) + (error "Bad `using' clause")) + (make-symbol "--cl-idx--")))) (push (list temp-seq seq) loop-for-bindings) (push (list temp-idx 0) loop-for-bindings) (if ref @@ -1164,15 +1183,17 @@ Valid clauses are: loop-for-steps))) ((memq word hash-types) - (or (memq (car cl--loop-args) '(in of)) (error "Expected `of'")) - (let* ((table (cl-pop2 cl--loop-args)) - (other (if (eq (car cl--loop-args) 'using) - (if (and (= (length (cadr cl--loop-args)) 2) - (memq (cl-caadr cl--loop-args) hash-types) - (not (eq (cl-caadr cl--loop-args) word))) - (cadr (cl-pop2 cl--loop-args)) - (error "Bad `using' clause")) - (make-symbol "--cl-var--")))) + (or (memq (car cl--loop-args) '(in of)) + (error "Expected `of'")) + (let* ((table (cl--pop2 cl--loop-args)) + (other + (if (eq (car cl--loop-args) 'using) + (if (and (= (length (cadr cl--loop-args)) 2) + (memq (cl-caadr cl--loop-args) hash-types) + (not (eq (cl-caadr cl--loop-args) word))) + (cadr (cl--pop2 cl--loop-args)) + (error "Bad `using' clause")) + (make-symbol "--cl-var--")))) (if (memq word '(hash-value hash-values)) (setq var (prog1 other (setq other var)))) (setq cl--loop-map-form @@ -1180,16 +1201,19 @@ Valid clauses are: ((memq word '(symbol present-symbol external-symbol symbols present-symbols external-symbols)) - (let ((ob (and (memq (car cl--loop-args) '(in of)) (cl-pop2 cl--loop-args)))) + (let ((ob (and (memq (car cl--loop-args) '(in of)) + (cl--pop2 cl--loop-args)))) (setq cl--loop-map-form `(mapatoms (lambda (,var) . --cl-map) ,ob)))) ((memq word '(overlay overlays extent extents)) (let ((buf nil) (from nil) (to nil)) (while (memq (car cl--loop-args) '(in of from to)) - (cond ((eq (car cl--loop-args) 'from) (setq from (cl-pop2 cl--loop-args))) - ((eq (car cl--loop-args) 'to) (setq to (cl-pop2 cl--loop-args))) - (t (setq buf (cl-pop2 cl--loop-args))))) + (cond ((eq (car cl--loop-args) 'from) + (setq from (cl--pop2 cl--loop-args))) + ((eq (car cl--loop-args) 'to) + (setq to (cl--pop2 cl--loop-args))) + (t (setq buf (cl--pop2 cl--loop-args))))) (setq cl--loop-map-form `(cl--map-overlays (lambda (,var ,(make-symbol "--cl-var--")) @@ -1201,11 +1225,13 @@ Valid clauses are: (var1 (make-symbol "--cl-var1--")) (var2 (make-symbol "--cl-var2--"))) (while (memq (car cl--loop-args) '(in of property from to)) - (cond ((eq (car cl--loop-args) 'from) (setq from (cl-pop2 cl--loop-args))) - ((eq (car cl--loop-args) 'to) (setq to (cl-pop2 cl--loop-args))) + (cond ((eq (car cl--loop-args) 'from) + (setq from (cl--pop2 cl--loop-args))) + ((eq (car cl--loop-args) 'to) + (setq to (cl--pop2 cl--loop-args))) ((eq (car cl--loop-args) 'property) - (setq prop (cl-pop2 cl--loop-args))) - (t (setq buf (cl-pop2 cl--loop-args))))) + (setq prop (cl--pop2 cl--loop-args))) + (t (setq buf (cl--pop2 cl--loop-args))))) (if (and (consp var) (symbolp (car var)) (symbolp (cdr var))) (setq var1 (car var) var2 (cdr var)) (push (list var `(cons ,var1 ,var2)) loop-for-sets)) @@ -1215,15 +1241,17 @@ Valid clauses are: ,buf ,prop ,from ,to)))) ((memq word key-types) - (or (memq (car cl--loop-args) '(in of)) (error "Expected `of'")) - (let ((cl-map (cl-pop2 cl--loop-args)) - (other (if (eq (car cl--loop-args) 'using) - (if (and (= (length (cadr cl--loop-args)) 2) - (memq (cl-caadr cl--loop-args) key-types) - (not (eq (cl-caadr cl--loop-args) word))) - (cadr (cl-pop2 cl--loop-args)) - (error "Bad `using' clause")) - (make-symbol "--cl-var--")))) + (or (memq (car cl--loop-args) '(in of)) + (error "Expected `of'")) + (let ((cl-map (cl--pop2 cl--loop-args)) + (other + (if (eq (car cl--loop-args) 'using) + (if (and (= (length (cadr cl--loop-args)) 2) + (memq (cl-caadr cl--loop-args) key-types) + (not (eq (cl-caadr cl--loop-args) word))) + (cadr (cl--pop2 cl--loop-args)) + (error "Bad `using' clause")) + (make-symbol "--cl-var--")))) (if (memq word '(key-binding key-bindings)) (setq var (prog1 other (setq other var)))) (setq cl--loop-map-form @@ -1243,7 +1271,8 @@ Valid clauses are: loop-for-steps))) ((memq word '(window windows)) - (let ((scr (and (memq (car cl--loop-args) '(in of)) (cl-pop2 cl--loop-args))) + (let ((scr (and (memq (car cl--loop-args) '(in of)) + (cl--pop2 cl--loop-args))) (temp (make-symbol "--cl-var--")) (minip (make-symbol "--cl-minip--"))) (push (list var (if scr @@ -1338,7 +1367,8 @@ Valid clauses are: ((memq word '(minimize minimizing maximize maximizing)) (let* ((what (pop cl--loop-args)) - (temp (if (cl--simple-expr-p what) what (make-symbol "--cl-var--"))) + (temp (if (cl--simple-expr-p what) what + (make-symbol "--cl-var--"))) (var (cl--loop-handle-accum nil)) (func (intern (substring (symbol-name word) 0 3))) (set `(setq ,var (if ,var (,func ,var ,temp) ,temp)))) @@ -1349,7 +1379,8 @@ Valid clauses are: ((eq word 'with) (let ((bindings nil)) (while (progn (push (list (pop cl--loop-args) - (and (eq (car cl--loop-args) '=) (cl-pop2 cl--loop-args))) + (and (eq (car cl--loop-args) '=) + (cl--pop2 cl--loop-args))) bindings) (eq (car cl--loop-args) 'and)) (pop cl--loop-args)) @@ -1362,19 +1393,23 @@ Valid clauses are: (push `(not ,(pop cl--loop-args)) cl--loop-body)) ((eq word 'always) - (or cl--loop-finish-flag (setq cl--loop-finish-flag (make-symbol "--cl-flag--"))) + (or cl--loop-finish-flag + (setq cl--loop-finish-flag (make-symbol "--cl-flag--"))) (push `(setq ,cl--loop-finish-flag ,(pop cl--loop-args)) cl--loop-body) (setq cl--loop-result t)) ((eq word 'never) - (or cl--loop-finish-flag (setq cl--loop-finish-flag (make-symbol "--cl-flag--"))) + (or cl--loop-finish-flag + (setq cl--loop-finish-flag (make-symbol "--cl-flag--"))) (push `(setq ,cl--loop-finish-flag (not ,(pop cl--loop-args))) cl--loop-body) (setq cl--loop-result t)) ((eq word 'thereis) - (or cl--loop-finish-flag (setq cl--loop-finish-flag (make-symbol "--cl-flag--"))) - (or cl--loop-result-var (setq cl--loop-result-var (make-symbol "--cl-var--"))) + (or cl--loop-finish-flag + (setq cl--loop-finish-flag (make-symbol "--cl-flag--"))) + (or cl--loop-result-var + (setq cl--loop-result-var (make-symbol "--cl-var--"))) (push `(setq ,cl--loop-finish-flag (not (setq ,cl--loop-result-var ,(pop cl--loop-args)))) cl--loop-body)) @@ -1382,11 +1417,11 @@ Valid clauses are: ((memq word '(if when unless)) (let* ((cond (pop cl--loop-args)) (then (let ((cl--loop-body nil)) - (cl-parse-loop-clause) + (cl--parse-loop-clause) (cl--loop-build-ands (nreverse cl--loop-body)))) (else (let ((cl--loop-body nil)) (if (eq (car cl--loop-args) 'else) - (progn (pop cl--loop-args) (cl-parse-loop-clause))) + (progn (pop cl--loop-args) (cl--parse-loop-clause))) (cl--loop-build-ands (nreverse cl--loop-body)))) (simple (and (eq (car then) t) (eq (car else) t)))) (if (eq (car cl--loop-args) 'end) (pop cl--loop-args)) @@ -1408,8 +1443,10 @@ Valid clauses are: (push (cons 'progn (nreverse (cons t body))) cl--loop-body))) ((eq word 'return) - (or cl--loop-finish-flag (setq cl--loop-finish-flag (make-symbol "--cl-var--"))) - (or cl--loop-result-var (setq cl--loop-result-var (make-symbol "--cl-var--"))) + (or cl--loop-finish-flag + (setq cl--loop-finish-flag (make-symbol "--cl-var--"))) + (or cl--loop-result-var + (setq cl--loop-result-var (make-symbol "--cl-var--"))) (push `(setq ,cl--loop-result-var ,(pop cl--loop-args) ,cl--loop-finish-flag nil) cl--loop-body)) @@ -1419,7 +1456,7 @@ Valid clauses are: (or handler (error "Expected a cl-loop keyword, found %s" word)) (funcall handler)))) (if (eq (car cl--loop-args) 'and) - (progn (pop cl--loop-args) (cl-parse-loop-clause))))) + (progn (pop cl--loop-args) (cl--parse-loop-clause))))) (defun cl--loop-let (specs body par) ; uses loop-* (let ((p specs) (temps nil) (new nil)) @@ -1438,10 +1475,12 @@ Valid clauses are: (if (and (consp (car specs)) (listp (caar specs))) (let* ((spec (caar specs)) (nspecs nil) (expr (cadr (pop specs))) - (temp (cdr (or (assq spec cl--loop-destr-temps) - (car (push (cons spec (or (last spec 0) - (make-symbol "--cl-var--"))) - cl--loop-destr-temps)))))) + (temp + (cdr (or (assq spec cl--loop-destr-temps) + (car (push (cons spec + (or (last spec 0) + (make-symbol "--cl-var--"))) + cl--loop-destr-temps)))))) (push (list temp expr) new) (while (consp spec) (push (list (pop spec) @@ -1450,24 +1489,27 @@ Valid clauses are: (setq specs (nconc (nreverse nspecs) specs))) (push (pop specs) new))) (if (eq body 'setq) - (let ((set (cons (if par 'cl-psetq 'setq) (apply 'nconc (nreverse new))))) + (let ((set (cons (if par 'cl-psetq 'setq) + (apply 'nconc (nreverse new))))) (if temps `(let* ,(nreverse temps) ,set) set)) `(,(if par 'let 'let*) ,(nconc (nreverse temps) (nreverse new)) ,@body)))) -(defun cl--loop-handle-accum (def &optional func) ; uses loop-* +(defun cl--loop-handle-accum (def &optional func) ; uses loop-* (if (eq (car cl--loop-args) 'into) - (let ((var (cl-pop2 cl--loop-args))) + (let ((var (cl--pop2 cl--loop-args))) (or (memq var cl--loop-accum-vars) (progn (push (list (list var def)) cl--loop-bindings) (push var cl--loop-accum-vars))) var) (or cl--loop-accum-var (progn - (push (list (list (setq cl--loop-accum-var (make-symbol "--cl-var--")) def)) - cl--loop-bindings) + (push (list (list + (setq cl--loop-accum-var (make-symbol "--cl-var--")) + def)) + cl--loop-bindings) (setq cl--loop-result (if func (list func cl--loop-accum-var) - cl--loop-accum-var)) + cl--loop-accum-var)) cl--loop-accum-var)))) (defun cl--loop-build-ands (clauses) @@ -1514,7 +1556,7 @@ such that COMBO is equivalent to (and . CLAUSES)." ((&rest &or symbolp (symbolp &optional form form)) (form body) cl-declarations body))) - (cl-expand-do-loop steps endtest body nil)) + (cl--expand-do-loop steps endtest body nil)) ;;;###autoload (defmacro cl-do* (steps endtest &rest body) @@ -1522,9 +1564,9 @@ such that COMBO is equivalent to (and . CLAUSES)." \(fn ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" (declare (indent 2) (debug cl-do)) - (cl-expand-do-loop steps endtest body t)) + (cl--expand-do-loop steps endtest body t)) -(defun cl-expand-do-loop (steps endtest body star) +(defun cl--expand-do-loop (steps endtest body star) `(cl-block nil (,(if star 'let* 'let) ,(mapcar (lambda (c) (if (consp c) (list (car c) (nth 1 c)) c)) @@ -1552,9 +1594,9 @@ An implicit nil block is established around the loop. \(fn (VAR LIST [RESULT]) BODY...)" (declare (debug ((symbolp form &optional form) cl-declarations body)) (indent 1)) - `(cl-block nil - (,(if (eq 'cl-dolist (symbol-function 'dolist)) 'cl--dolist 'dolist) - ,spec ,@body))) + (let ((loop `(dolist ,spec ,@body))) + (if (advice-member-p #'cl--wrap-in-nil-block 'dolist) + loop `(cl-block nil ,loop)))) ;;;###autoload (defmacro cl-dotimes (spec &rest body) @@ -1565,9 +1607,55 @@ nil. \(fn (VAR COUNT [RESULT]) BODY...)" (declare (debug cl-dolist) (indent 1)) - `(cl-block nil - (,(if (eq 'cl-dotimes (symbol-function 'dotimes)) 'cl--dotimes 'dotimes) - ,spec ,@body))) + (let ((loop `(dotimes ,spec ,@body))) + (if (advice-member-p #'cl--wrap-in-nil-block 'dotimes) + loop `(cl-block nil ,loop)))) + +(defvar cl--tagbody-alist nil) + +;;;###autoload +(defmacro cl-tagbody (&rest labels-or-stmts) + "Execute statements while providing for control transfers to labels. +Each element of LABELS-OR-STMTS can be either a label (integer or symbol) +or a `cons' cell, in which case it's taken to be a statement. +This distinction is made before performing macroexpansion. +Statements are executed in sequence left to right, discarding any return value, +stopping only when reaching the end of LABELS-OR-STMTS. +Any statement can transfer control at any time to the statements that follow +one of the labels with the special form (go LABEL). +Labels have lexical scope and dynamic extent." + (let ((blocks '()) + (first-label (if (consp (car labels-or-stmts)) + 'cl--preamble (pop labels-or-stmts)))) + (let ((block (list first-label))) + (dolist (label-or-stmt labels-or-stmts) + (if (consp label-or-stmt) (push label-or-stmt block) + ;; Add a "go to next block" to implement the fallthrough. + (unless (eq 'go (car-safe (car-safe block))) + (push `(go ,label-or-stmt) block)) + (push (nreverse block) blocks) + (setq block (list label-or-stmt)))) + (unless (eq 'go (car-safe (car-safe block))) + (push `(go cl--exit) block)) + (push (nreverse block) blocks)) + (let ((catch-tag (make-symbol "cl--tagbody-tag"))) + (push (cons 'cl--exit catch-tag) cl--tagbody-alist) + (dolist (block blocks) + (push (cons (car block) catch-tag) cl--tagbody-alist)) + (macroexpand-all + `(let ((next-label ',first-label)) + (while + (not (eq (setq next-label + (catch ',catch-tag + (cl-case next-label + ,@blocks))) + 'cl--exit)))) + `((go . ,(lambda (label) + (let ((catch-tag (cdr (assq label cl--tagbody-alist)))) + (unless catch-tag + (error "Unknown cl-tagbody go label `%S'" label)) + `(throw ',catch-tag ',label)))) + ,@macroexpand-all-environment))))) ;;;###autoload (defmacro cl-do-symbols (spec &rest body) @@ -1618,19 +1706,18 @@ second list (or to nil if VALUES is shorter than SYMBOLS); then the BODY forms are executed and their result is returned. This is much like a `let' form, except that the list of symbols can be computed at run-time." (declare (indent 2) (debug (form form body))) - (let ((bodyfun (make-symbol "cl--progv-body")) + (let ((bodyfun (make-symbol "body")) (binds (make-symbol "binds")) (syms (make-symbol "syms")) (vals (make-symbol "vals"))) `(progn - (defvar ,bodyfun) (let* ((,syms ,symbols) (,vals ,values) (,bodyfun (lambda () ,@body)) (,binds ())) (while ,syms (push (list (pop ,syms) (list 'quote (pop ,vals))) ,binds)) - (eval (list 'let ,binds '(funcall ,bodyfun))))))) + (eval (list 'let ,binds (list 'funcall (list 'quote ,bodyfun)))))))) (defvar cl--labels-convert-cache nil) @@ -1901,11 +1988,11 @@ values. For compatibility, (cl-values A B C) is a synonym for (list A B C). (declare (indent 1) (debug (cl-type-spec form))) form) -(defvar cl-proclaim-history t) ; for future compilers -(defvar cl-declare-stack t) ; for future compilers +(defvar cl--proclaim-history t) ; for future compilers +(defvar cl--declare-stack t) ; for future compilers -(defun cl-do-proclaim (spec hist) - (and hist (listp cl-proclaim-history) (push spec cl-proclaim-history)) +(defun cl--do-proclaim (spec hist) + (and hist (listp cl--proclaim-history) (push spec cl--proclaim-history)) (cond ((eq (car-safe spec) 'special) (if (boundp 'byte-compile-bound-variables) (setq byte-compile-bound-variables @@ -1930,9 +2017,9 @@ values. For compatibility, (cl-values A B C) is a synonym for (list A B C). '((0 nil) (1 t) (2 t) (3 t)))) (safety (assq (nth 1 (assq 'safety (cdr spec))) '((0 t) (1 t) (2 t) (3 nil))))) - (if speed (setq cl-optimize-speed (car speed) + (if speed (setq cl--optimize-speed (car speed) byte-optimize (nth 1 speed))) - (if safety (setq cl-optimize-safety (car safety) + (if safety (setq cl--optimize-safety (car safety) byte-compile-delete-errors (nth 1 safety))))) ((and (eq (car-safe spec) 'warn) (boundp 'byte-compile-warnings)) @@ -1944,10 +2031,10 @@ values. For compatibility, (cl-values A B C) is a synonym for (list A B C). nil) ;;; Process any proclamations made before cl-macs was loaded. -(defvar cl-proclaims-deferred) -(let ((p (reverse cl-proclaims-deferred))) - (while p (cl-do-proclaim (pop p) t)) - (setq cl-proclaims-deferred nil)) +(defvar cl--proclaims-deferred) +(let ((p (reverse cl--proclaims-deferred))) + (while p (cl--do-proclaim (pop p) t)) + (setq cl--proclaims-deferred nil)) ;;;###autoload (defmacro cl-declare (&rest specs) @@ -1960,8 +2047,8 @@ will turn off byte-compile warnings in the function. See Info node `(cl)Declarations' for details." (if (cl--compiling-file) (while specs - (if (listp cl-declare-stack) (push (car specs) cl-declare-stack)) - (cl-do-proclaim (pop specs) nil))) + (if (listp cl--declare-stack) (push (car specs) cl--declare-stack)) + (cl--do-proclaim (pop specs) nil))) nil) ;;; The standard modify macros. @@ -2207,7 +2294,7 @@ value, that slot cannot be set via `setf'. (copier (intern (format "copy-%s" name))) (predicate (intern (format "%s-p" name))) (print-func nil) (print-auto nil) - (safety (if (cl--compiling-file) cl-optimize-safety 3)) + (safety (if (cl--compiling-file) cl--optimize-safety 3)) (include nil) (tag (intern (format "cl-struct-%s" name))) (tag-symbol (intern (format "cl-struct-%s-tags" name))) @@ -2452,7 +2539,8 @@ The type name can then be used in `cl-typecase', `cl-check-type', etc." (if (consp (cadr type)) `(> ,val ,(cl-caadr type)) `(>= ,val ,(cadr type)))) ,(if (memq (cl-caddr type) '(* nil)) t - (if (consp (cl-caddr type)) `(< ,val ,(cl-caaddr type)) + (if (consp (cl-caddr type)) + `(< ,val ,(cl-caaddr type)) `(<= ,val ,(cl-caddr type))))))) ((memq (car type) '(and or not)) (cons (car type) @@ -2477,7 +2565,7 @@ TYPE is a Common Lisp-style type specifier." STRING is an optional description of the desired type." (declare (debug (place cl-type-spec &optional stringp))) (and (or (not (cl--compiling-file)) - (< cl-optimize-speed 3) (= cl-optimize-safety 3)) + (< cl--optimize-speed 3) (= cl--optimize-safety 3)) (let* ((temp (if (cl--simple-expr-p form 3) form (make-symbol "--cl-var--"))) (body `(or ,(cl--make-type-test temp type) @@ -2497,7 +2585,7 @@ They are not evaluated unless the assertion fails. If STRING is omitted, a default message listing FORM itself is used." (declare (debug (form &rest form))) (and (or (not (cl--compiling-file)) - (< cl-optimize-speed 3) (= cl-optimize-safety 3)) + (< cl--optimize-speed 3) (= cl--optimize-safety 3)) (let ((sargs (and show-args (delq nil (mapcar (lambda (x) (unless (macroexp-const-p x) @@ -2693,14 +2781,14 @@ surrounded by (cl-block NAME ...). ;;; Things that are side-effect-free. (mapc (lambda (x) (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)) + '(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)) - '(eql cl-floatp-safe cl-list* cl-subst cl-acons cl-equalp cl-random-state-p - copy-tree cl-sublis)) + '(eql cl-floatp-safe cl-list* cl-subst cl-acons cl-equalp + cl-random-state-p copy-tree cl-sublis)) (run-hooks 'cl-macs-load-hook) diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el index c0c2db0d9ae..fbf68f62b4a 100644 --- a/lisp/emacs-lisp/cl-seq.el +++ b/lisp/emacs-lisp/cl-seq.el @@ -105,6 +105,9 @@ (eq (not (funcall cl-test ,x ,y)) cl-test-not) (eql ,x ,y))) +;; Yuck! These vars are set/bound by cl--parsing-keywords to match :if :test +;; and :key keyword args, and they are also accessed (sometimes) via dynamic +;; scoping (and some of those accesses are from macro-expanded code). (defvar cl-test) (defvar cl-test-not) (defvar cl-if) (defvar cl-if-not) (defvar cl-key) @@ -333,7 +336,8 @@ This is a destructive function; it reuses the storage of SEQ whenever possible. (defun cl--delete-duplicates (cl-seq cl-keys cl-copy) (if (listp cl-seq) - (cl--parsing-keywords (:test :test-not :key (:start 0) :end :from-end :if) + (cl--parsing-keywords + (:test :test-not :key (:start 0) :end :from-end :if) () (if cl-from-end (let ((cl-p (nthcdr cl-start cl-seq)) cl-i) @@ -776,7 +780,8 @@ to avoid corrupting the original LIST1 and LIST2. (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1)))) (while cl-list2 (if (or cl-keys (numberp (car cl-list2))) - (setq cl-list1 (apply 'cl-adjoin (car cl-list2) cl-list1 cl-keys)) + (setq cl-list1 + (apply 'cl-adjoin (car cl-list2) cl-list1 cl-keys)) (or (memq (car cl-list2) cl-list1) (push (car cl-list2) cl-list1))) (pop cl-list2)) diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index 0ad7d4b1592..ea4d9511f9d 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -113,14 +113,6 @@ )) (defvaralias var (intern (format "cl-%s" var)))) -;; Before overwriting subr.el's `dotimes' and `dolist', let's remember -;; them under a different name, so we can use them in our implementation -;; of `dotimes' and `dolist'. -(unless (fboundp 'cl--dotimes) - (defalias 'cl--dotimes (symbol-function 'dotimes) "The non-CL `dotimes'.")) -(unless (fboundp 'cl--dolist) - (defalias 'cl--dolist (symbol-function 'dolist) "The non-CL `dolist'.")) - (dolist (fun '( (get* . cl-get) (random* . cl-random) @@ -228,13 +220,12 @@ callf2 callf letf* - ;; letf + letf rotatef shiftf remf psetf (define-setf-method . define-setf-expander) - declare the locally multiple-value-setq @@ -245,8 +236,6 @@ psetq do-all-symbols do-symbols - dotimes - dolist do* do loop @@ -328,6 +317,15 @@ (intern (format "cl-%s" fun))))) (defalias fun new))) +(defun cl--wrap-in-nil-block (fun &rest args) + `(cl-block nil ,(apply fun args))) +(advice-add 'dolist :around #'cl--wrap-in-nil-block) +(advice-add 'dotimes :around #'cl--wrap-in-nil-block) + +(defun cl--pass-args-to-cl-declare (&rest specs) + (macroexpand `(cl-declare ,@specs))) +(advice-add 'declare :after #'cl--pass-args-to-cl-declare) + ;;; Features provided a bit differently in Elisp. ;; First, the old lexical-let is now better served by `lexical-binding', tho @@ -506,28 +504,6 @@ rather than relying on `lexical-binding'." ;; not 100% compatible: not worth the trouble to add them to cl-lib.el, but we ;; still need to support old users of cl.el. -(defmacro cl--symbol-function (symbol) - "Like `symbol-function' but return `cl--unbound' if not bound." - ;; (declare (gv-setter (lambda (store) - ;; `(if (eq ,store 'cl--unbound) - ;; (fmakunbound ,symbol) (fset ,symbol ,store))))) - `(if (fboundp ,symbol) (symbol-function ,symbol) 'cl--unbound)) -(gv-define-setter cl--symbol-function (store symbol) - `(if (eq ,store 'cl--unbound) (fmakunbound ,symbol) (fset ,symbol ,store))) - -(defmacro letf (bindings &rest body) - "Dynamically scoped let-style bindings for places. -For more details, see `cl-letf'. This macro behaves like that one -in almost every respect (apart from details that relate to some -deprecated usage of `symbol-function' in place forms)." ; bug#12760 - (declare (indent 1) (debug cl-letf)) - ;; Like cl-letf, but with special handling of symbol-function. - `(cl-letf ,(mapcar (lambda (x) (if (eq (car-safe (car x)) 'symbol-function) - `((cl--symbol-function ,@(cdar x)) ,@(cdr x)) - x)) - bindings) - ,@body)) - (defun cl--gv-adapt (cl-gv do) ;; This function is used by all .elc files that use define-setf-expander and ;; were compiled with Emacs>=24.3. diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el index 5607c9b0698..f88cb0ef9bb 100644 --- a/lisp/emacs-lisp/crm.el +++ b/lisp/emacs-lisp/crm.el @@ -30,12 +30,12 @@ ;; a single prompt, optionally using completion. ;; Multiple strings are specified by separating each of the strings -;; with a prespecified separator character. For example, if the -;; separator character is a comma, the strings 'alice', 'bob', and +;; with a prespecified separator regexp. For example, if the +;; separator regexp is ",", the strings 'alice', 'bob', and ;; 'eve' would be specified as 'alice,bob,eve'. -;; The default value for the separator character is the value of -;; `crm-default-separator' (comma). The separator character may be +;; The default value for the separator regexp is the value of +;; `crm-default-separator' (comma). The separator regexp may be ;; changed by modifying the value of `crm-separator'. ;; Contiguous strings of non-separator-characters are referred to as @@ -96,14 +96,14 @@ ;; first revamped version ;;; Code: -(defconst crm-default-separator "," - "Default separator for `completing-read-multiple'.") +(defconst crm-default-separator "[ \t]*,[ \t]*" + "Default separator regexp for `completing-read-multiple'.") (defvar crm-separator crm-default-separator - "Separator used for separating strings in `completing-read-multiple'. -It should be a single character string that doesn't appear in the list of -completion candidates. Modify this value to make `completing-read-multiple' -use a separator other than `crm-default-separator'.") + "Separator regexp used for separating strings in `completing-read-multiple'. +It should be a regexp that does not match the list of completion candidates. +Modify this value to make `completing-read-multiple' use a separator other +than `crm-default-separator'.") (defvar crm-local-completion-map (let ((map (make-sparse-keymap))) @@ -173,13 +173,17 @@ Place an overlay on the element, with a `field' property, and return it." (overlay-put ol 'field (make-symbol "crm")) ol)) +(defmacro crm--completion-command (command) + "Make COMMAND a completion command for `completing-read-multiple'." + `(let ((ol (crm--select-current-element))) + (unwind-protect + ,command + (delete-overlay ol)))) + (defun crm-completion-help () "Display a list of possible completions of the current minibuffer element." (interactive) - (let ((ol (crm--select-current-element))) - (unwind-protect - (minibuffer-completion-help) - (delete-overlay ol))) + (crm--completion-command (minibuffer-completion-help)) nil) (defun crm-complete () @@ -188,19 +192,13 @@ If no characters can be completed, display a list of possible completions. Return t if the current element is now a valid match; otherwise return nil." (interactive) - (let ((ol (crm--select-current-element))) - (unwind-protect - (minibuffer-complete) - (delete-overlay ol)))) + (crm--completion-command (minibuffer-complete))) (defun crm-complete-word () "Complete the current element at most a single word. Like `minibuffer-complete-word' but for `completing-read-multiple'." (interactive) - (let ((ol (crm--select-current-element))) - (unwind-protect - (minibuffer-complete-word) - (delete-overlay ol)))) + (crm--completion-command (minibuffer-complete-word))) (defun crm-complete-and-exit () "If all of the minibuffer elements are valid completions then exit. @@ -222,9 +220,10 @@ This function is modeled after `minibuffer-complete-and-exit'." (setq doexit nil)) (goto-char (overlay-end ol)) (delete-overlay ol)) - (not (eobp)))) + (not (eobp))) + (looking-at crm-separator)) ;; Skip to the next element. - (forward-char 1)) + (goto-char (match-end 0))) (if doexit (exit-minibuffer)))) (defun crm--choose-completion-string (choice buffer base-position @@ -248,12 +247,12 @@ By using this functionality, a user may specify multiple strings at a single prompt, optionally using completion. Multiple strings are specified by separating each of the strings with -a prespecified separator character. For example, if the separator -character is a comma, the strings 'alice', 'bob', and 'eve' would be +a prespecified separator regexp. For example, if the separator +regexp is \",\", the strings 'alice', 'bob', and 'eve' would be specified as 'alice,bob,eve'. -The default value for the separator character is the value of -`crm-default-separator' (comma). The separator character may be +The default value for the separator regexp is the value of +`crm-default-separator' (comma). The separator regexp may be changed by modifying the value of `crm-separator'. Contiguous strings of non-separator-characters are referred to as @@ -282,8 +281,8 @@ INHERIT-INPUT-METHOD." (map (if require-match crm-local-must-match-map crm-local-completion-map)) - ;; If the user enters empty input, read-from-minibuffer returns - ;; the empty string, not DEF. + ;; If the user enters empty input, `read-from-minibuffer' + ;; returns the empty string, not DEF. (input (read-from-minibuffer prompt initial-input map nil hist def inherit-input-method))) diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 472706d886b..0728e86d072 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -1,4 +1,4 @@ -;;; debug.el --- debuggers and related commands for Emacs +;;; debug.el --- debuggers and related commands for Emacs -*- lexical-binding: t -*- ;; Copyright (C) 1985-1986, 1994, 2001-2013 Free Software Foundation, ;; Inc. @@ -82,9 +82,6 @@ The value used here is passed to `quit-restore-window'." :group 'debugger :version "24.3") -(defvar debug-function-list nil - "List of functions currently set for debug on entry.") - (defvar debugger-step-after-exit nil "Non-nil means \"single-step\" after the debugger exits.") @@ -147,7 +144,7 @@ where CAUSE can be: ;;;###autoload (setq debugger 'debug) ;;;###autoload -(defun debug (&rest debugger-args) +(defun debug (&rest args) "Enter debugger. \\<debugger-mode-map>`\\[debugger-continue]' returns from the debugger. Arguments are mainly for use when this is called from the internals of the evaluator. @@ -166,6 +163,7 @@ first will be printed into the backtrace buffer." (if (get-buffer "*Backtrace*") (with-current-buffer (get-buffer "*Backtrace*") (list major-mode (buffer-string))))) + (debugger-args args) (debugger-buffer (get-buffer-create "*Backtrace*")) (debugger-old-buffer (current-buffer)) (debugger-window nil) @@ -220,11 +218,11 @@ first will be printed into the backtrace buffer." (save-excursion (when (eq (car debugger-args) 'debug) ;; Skip the frames for backtrace-debug, byte-code, - ;; and implement-debug-on-entry. - (backtrace-debug 3 t) + ;; debug--implement-debug-on-entry and the advice's `apply'. + (backtrace-debug 4 t) ;; Place an extra debug-on-exit for macro's. - (when (eq 'lambda (car-safe (cadr (backtrace-frame 3)))) - (backtrace-debug 4 t))) + (when (eq 'lambda (car-safe (cadr (backtrace-frame 4)))) + (backtrace-debug 5 t))) (pop-to-buffer debugger-buffer `((display-buffer-reuse-window @@ -319,7 +317,7 @@ first will be printed into the backtrace buffer." (setq debug-on-next-call debugger-step-after-exit) debugger-value))) -(defun debugger-setup-buffer (debugger-args) +(defun debugger-setup-buffer (args) "Initialize the `*Backtrace*' buffer for entry to the debugger. That buffer should be current already." (setq buffer-read-only nil) @@ -335,20 +333,22 @@ That buffer should be current already." (delete-region (point) (progn (search-forward "\n debug(") - (forward-line (if (eq (car debugger-args) 'debug) - 2 ; Remove implement-debug-on-entry frame. + (forward-line (if (eq (car args) 'debug) + ;; Remove debug--implement-debug-on-entry + ;; and the advice's `apply' frame. + 3 1)) (point))) (insert "Debugger entered") ;; lambda is for debug-on-call when a function call is next. ;; debug is for debug-on-entry function called. - (pcase (car debugger-args) + (pcase (car args) ((or `lambda `debug) (insert "--entering a function:\n")) ;; Exiting a function. (`exit (insert "--returning value: ") - (setq debugger-value (nth 1 debugger-args)) + (setq debugger-value (nth 1 args)) (prin1 debugger-value (current-buffer)) (insert ?\n) (delete-char 1) @@ -357,7 +357,7 @@ That buffer should be current already." ;; Debugger entered for an error. (`error (insert "--Lisp error: ") - (prin1 (nth 1 debugger-args) (current-buffer)) + (prin1 (nth 1 args) (current-buffer)) (insert ?\n)) ;; debug-on-call, when the next thing is an eval. (`t @@ -365,8 +365,8 @@ That buffer should be current already." ;; User calls debug directly. (_ (insert ": ") - (prin1 (if (eq (car debugger-args) 'nil) - (cdr debugger-args) debugger-args) + (prin1 (if (eq (car args) 'nil) + (cdr args) args) (current-buffer)) (insert ?\n))) ;; After any frame that uses eval-buffer, @@ -526,9 +526,10 @@ removes itself from that hook." (count 0)) (while (not (eq (cadr (backtrace-frame count)) 'debug)) (setq count (1+ count))) - ;; Skip implement-debug-on-entry frame. - (when (eq 'implement-debug-on-entry (cadr (backtrace-frame (1+ count)))) - (setq count (1+ count))) + ;; Skip debug--implement-debug-on-entry frame. + (when (eq 'debug--implement-debug-on-entry + (cadr (backtrace-frame (1+ count)))) + (setq count (+ 2 count))) (goto-char (point-min)) (when (looking-at "Debugger entered--\\(Lisp error\\|returning value\\):") (goto-char (match-end 0)) @@ -695,10 +696,10 @@ Applies to the frame whose line point is on in the backtrace." :help "Continue to exit from this frame, with all debug-on-entry suspended")) (define-key menu-map [deb-cont] '(menu-item "Continue" debugger-continue - :help "Continue, evaluating this expression without stopping")) + :help "Continue, evaluating this expression without stopping")) (define-key menu-map [deb-step] '(menu-item "Step through" debugger-step-through - :help "Proceed, stepping through subexpressions of this expression")) + :help "Proceed, stepping through subexpressions of this expression")) map)) (put 'debugger-mode 'mode-class 'special) @@ -778,7 +779,7 @@ For the cross-reference format, see `help-make-xrefs'." ;; When you change this, you may also need to change the number of ;; frames that the debugger skips. -(defun implement-debug-on-entry () +(defun debug--implement-debug-on-entry (&rest _ignore) "Conditionally call the debugger. A call to this function is inserted by `debug-on-entry' to cause functions to break on entry." @@ -786,12 +787,6 @@ functions to break on entry." nil (funcall debugger 'debug))) -(defun debugger-special-form-p (symbol) - "Return whether SYMBOL is a special form." - (and (fboundp symbol) - (subrp (symbol-function symbol)) - (eq (cdr (subr-arity (symbol-function symbol))) 'unevalled))) - ;;;###autoload (defun debug-on-entry (function) "Request FUNCTION to invoke debugger each time it is called. @@ -809,7 +804,7 @@ Use \\[cancel-debug-on-entry] to cancel the effect of this command. Redefining FUNCTION also cancels it." (interactive (let ((fn (function-called-at-point)) val) - (when (debugger-special-form-p fn) + (when (special-form-p fn) (setq fn nil)) (setq val (completing-read (if fn @@ -818,36 +813,21 @@ Redefining FUNCTION also cancels it." obarray #'(lambda (symbol) (and (fboundp symbol) - (not (debugger-special-form-p symbol)))) + (not (special-form-p symbol)))) t nil nil (symbol-name fn))) (list (if (equal val "") fn (intern val))))) - ;; FIXME: Use advice.el. - (when (debugger-special-form-p function) - (error "Function %s is a special form" function)) - (if (or (symbolp (symbol-function function)) - (subrp (symbol-function function))) - ;; The function is built-in or aliased to another function. - ;; Create a wrapper in which we can add the debug call. - (fset function `(lambda (&rest debug-on-entry-args) - ,(interactive-form (symbol-function function)) - (apply ',(symbol-function function) - debug-on-entry-args))) - (when (autoloadp (symbol-function function)) - ;; The function is autoloaded. Load its real definition. - (autoload-do-load (symbol-function function) function)) - (when (or (not (consp (symbol-function function))) - (and (eq (car (symbol-function function)) 'macro) - (not (consp (cdr (symbol-function function)))))) - ;; The function is byte-compiled. Create a wrapper in which - ;; we can add the debug call. - (debug-convert-byte-code function))) - (unless (consp (symbol-function function)) - (error "Definition of %s is not a list" function)) - (fset function (debug-on-entry-1 function t)) - (unless (memq function debug-function-list) - (push function debug-function-list)) + (advice-add function :before #'debug--implement-debug-on-entry) function) +(defun debug--function-list () + "List of functions currently set for debug on entry." + (let ((funs '())) + (mapatoms + (lambda (s) + (when (advice-member-p #'debug--implement-debug-on-entry s) + (push s funs)))) + funs)) + ;;;###autoload (defun cancel-debug-on-entry (&optional function) "Undo effect of \\[debug-on-entry] on FUNCTION. @@ -858,80 +838,16 @@ To specify a nil argument interactively, exit with an empty minibuffer." (list (let ((name (completing-read "Cancel debug on entry to function (default all functions): " - (mapcar 'symbol-name debug-function-list) nil t))) + (mapcar #'symbol-name (debug--function-list)) nil t))) (when name (unless (string= name "") (intern name)))))) - (if (and function - (not (string= function ""))) ; Pre 22.1 compatibility test. + (if function (progn - (let ((defn (debug-on-entry-1 function nil))) - (condition-case nil - (when (and (equal (nth 1 defn) '(&rest debug-on-entry-args)) - (eq (car (nth 3 defn)) 'apply)) - ;; `defn' is a wrapper introduced in debug-on-entry. - ;; Get rid of it since we don't need it any more. - (setq defn (nth 1 (nth 1 (nth 3 defn))))) - (error nil)) - (fset function defn)) - (setq debug-function-list (delq function debug-function-list)) + (advice-remove function #'debug--implement-debug-on-entry) function) (message "Cancelling debug-on-entry for all functions") - (mapcar 'cancel-debug-on-entry debug-function-list))) - -(defun debug-arglist (definition) - ;; FIXME: copied from ad-arglist. - "Return the argument list of DEFINITION." - (require 'help-fns) - (help-function-arglist definition 'preserve-names)) - -(defun debug-convert-byte-code (function) - (let* ((defn (symbol-function function)) - (macro (eq (car-safe defn) 'macro))) - (when macro (setq defn (cdr defn))) - (when (byte-code-function-p defn) - (let* ((args (debug-arglist defn)) - (body - `((,(if (memq '&rest args) #'apply #'funcall) - ,defn - ,@(remq '&rest (remq '&optional args)))))) - (if (> (length defn) 5) - ;; The mere presence of field 5 is sufficient to make - ;; it interactive. - (push `(interactive ,(aref defn 5)) body)) - (if (and (> (length defn) 4) (aref defn 4)) - ;; Use `documentation' here, to get the actual string, - ;; in case the compiled function has a reference - ;; to the .elc file. - (setq body (cons (documentation function) body))) - (setq defn `(closure (t) ,args ,@body))) - (when macro (setq defn (cons 'macro defn))) - (fset function defn)))) - -(defun debug-on-entry-1 (function flag) - (let* ((defn (symbol-function function)) - (tail defn)) - (when (eq (car-safe tail) 'macro) - (setq tail (cdr tail))) - (if (not (memq (car-safe tail) '(closure lambda))) - ;; Only signal an error when we try to set debug-on-entry. - ;; When we try to clear debug-on-entry, we are now done. - (when flag - (error "%s is not a user-defined Lisp function" function)) - (if (eq (car tail) 'closure) (setq tail (cdr tail))) - (setq tail (cdr tail)) - ;; Skip the docstring. - (when (and (stringp (cadr tail)) (cddr tail)) - (setq tail (cdr tail))) - ;; Skip the interactive form. - (when (eq 'interactive (car-safe (cadr tail))) - (setq tail (cdr tail))) - (unless (eq flag (equal (cadr tail) '(implement-debug-on-entry))) - ;; Add/remove debug statement as needed. - (setcdr tail (if flag - (cons '(implement-debug-on-entry) (cdr tail)) - (cddr tail))))) - defn)) + (mapcar #'cancel-debug-on-entry (debug--function-list)))) (defun debugger-list-functions () "Display a list of all the functions now set to debug on entry." @@ -941,17 +857,18 @@ To specify a nil argument interactively, exit with an empty minibuffer." (called-interactively-p 'interactive)) (with-output-to-temp-buffer (help-buffer) (with-current-buffer standard-output - (if (null debug-function-list) - (princ "No debug-on-entry functions now\n") - (princ "Functions set to debug on entry:\n\n") - (dolist (fun debug-function-list) - (make-text-button (point) (progn (prin1 fun) (point)) - 'type 'help-function - 'help-args (list fun)) - (terpri)) - (terpri) - (princ "Note: if you have redefined a function, then it may no longer\n") - (princ "be set to debug on entry, even if it is in the list."))))) + (let ((funs (debug--function-list))) + (if (null funs) + (princ "No debug-on-entry functions now\n") + (princ "Functions set to debug on entry:\n\n") + (dolist (fun funs) + (make-text-button (point) (progn (prin1 fun) (point)) + 'type 'help-function + 'help-args (list fun)) + (terpri)) + (terpri) + (princ "Note: if you have redefined a function, then it may no longer\n") + (princ "be set to debug on entry, even if it is in the list.")))))) (provide 'debug) diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index a5876ee0bda..684f9d90878 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -296,16 +296,32 @@ is not very useful." ;; Use a default docstring. (setq docstring (if (null parent) - (format "Major-mode. -Uses keymap `%s', abbrev table `%s' and syntax-table `%s'." map abbrev syntax) + ;; FIXME filling. + (format "Major-mode.\nUses keymap `%s'%s%s." map + (if abbrev (format "%s abbrev table `%s'" + (if syntax "," " and") abbrev) "") + (if syntax (format " and syntax-table `%s'" syntax) "")) (format "Major mode derived from `%s' by `define-derived-mode'. -It inherits all of the parent's attributes, but has its own keymap, -abbrev table and syntax table: - - `%s', `%s' and `%s' - -which more-or-less shadow %s's corresponding tables." - parent map abbrev syntax parent)))) +It inherits all of the parent's attributes, but has its own keymap%s: + + `%s'%s + +which more-or-less shadow%s %s's corresponding table%s." + parent + (cond ((and abbrev syntax) + ",\nabbrev table and syntax table") + (abbrev "\nand abbrev table") + (syntax "\nand syntax table") + (t "")) + map + (cond ((and abbrev syntax) + (format ", `%s' and `%s'" abbrev syntax)) + ((or abbrev syntax) + (format " and `%s'" (or abbrev syntax))) + (t "")) + (if (or abbrev syntax) "" "s") + parent + (if (or abbrev syntax) "s" ""))))) (unless (string-match (regexp-quote (symbol-name hook)) docstring) ;; Make sure the docstring mentions the mode's hook. diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index e3888db2a57..52e12013fd3 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -461,8 +461,8 @@ STREAM or the value of `standard-input' may be: This version, from Edebug, maybe instruments the expression. But the STREAM must be the current buffer to do so. Whether it instruments is -also dependent on the values of `edebug-all-defs' and -`edebug-all-forms'." +also dependent on the values of the option `edebug-all-defs' and +the option `edebug-all-forms'." (or stream (setq stream standard-input)) (if (eq stream (current-buffer)) (edebug-read-and-maybe-wrap-form) @@ -484,8 +484,8 @@ similarly. Reinitialize the face according to `defface' specification. With a prefix argument, instrument the code for Edebug. -Setting `edebug-all-defs' to a non-nil value reverses the meaning of -the prefix argument. Code is then instrumented when this function is +Setting option `edebug-all-defs' to a non-nil value reverses the meaning +of the prefix argument. Code is then instrumented when this function is invoked without a prefix argument If acting on a `defun' for FUNCTION, and the function was instrumented, @@ -4259,22 +4259,53 @@ With prefix argument, make it a temporary breakpoint." ;;; Autoloading of Edebug accessories ;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu +(defun edebug--require-cl-read () + (require 'edebug-cl-read)) + (if (featurep 'cl-read) - (add-hook 'edebug-setup-hook - (function (lambda () (require 'edebug-cl-read)))) + (add-hook 'edebug-setup-hook #'edebug--require-cl-read) ;; The following causes edebug-cl-read to be loaded when you load cl-read.el. - (add-hook 'cl-read-load-hooks - (function (lambda () (require 'edebug-cl-read))))) + (add-hook 'cl-read-load-hooks #'edebug--require-cl-read)) ;;; Finalize Loading +;; When edebugging a function, some of the sub-expressions are +;; wrapped in (edebug-enter (lambda () ..)), so we need to teach +;; called-interactively-p that calls within the inner lambda should refer to +;; the outside function. +(add-hook 'called-interactively-p-functions + #'edebug--called-interactively-skip) +(defun edebug--called-interactively-skip (i frame1 frame2) + (when (and (eq (car-safe (nth 1 frame1)) 'lambda) + (eq (nth 1 (nth 1 frame1)) '()) + (eq (nth 1 frame2) 'edebug-enter)) + ;; `edebug-enter' calls itself on its first invocation. + (if (eq (nth 1 (internal--called-interactively-p--get-frame i)) + 'edebug-enter) + 2 1))) + ;; Finally, hook edebug into the rest of Emacs. ;; There are probably some other things that could go here. ;; Install edebug read and eval functions. (edebug-install-read-eval-functions) +(defun edebug-unload-function () + "Unload the Edebug source level debugger." + (when edebug-active + (setq edebug-active nil) + (unwind-protect + (abort-recursive-edit) + ;; We still want to run unload-feature to completion + (run-with-idle-timer 0 nil #'(lambda () (unload-feature 'edebug))))) + (remove-hook 'called-interactively-p-functions + 'edebug--called-interactively-skip) + (remove-hook 'cl-read-load-hooks 'edebug--require-cl-read) + (edebug-uninstall-read-eval-functions) + ;; continue standard unloading + nil) + (provide 'edebug) ;;; edebug.el ends here diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 5d0c85fa20a..7a22e1222c9 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -2850,28 +2850,36 @@ this object." (v (eieio-oref this (car publa))) ) (unless (or (not i) (equal v (car publd))) + (unless (bolp) + (princ "\n")) (princ (make-string (* eieio-print-depth 2) ? )) (princ (symbol-name i)) - (princ " ") (if (car publp) ;; Use our public printer - (funcall (car publp) v) + (progn + (princ " ") + (funcall (car publp) v)) ;; Use our generic override prin1 function. - (eieio-override-prin1 v)) - (princ "\n")))) + (princ (if (or (eieio-object-p v) + (eieio-object-p (car-safe v))) + "\n" " ")) + (eieio-override-prin1 v))))) (setq publa (cdr publa) publd (cdr publd) - publp (cdr publp))) - (princ (make-string (* eieio-print-depth 2) ? ))) - (princ ")\n"))) + publp (cdr publp)))) + (princ ")") + (when (= eieio-print-depth 0) + (princ "\n")))) (defun eieio-override-prin1 (thing) "Perform a `prin1' on THING taking advantage of object knowledge." (cond ((eieio-object-p thing) (object-write thing)) - ((listp thing) + ((consp thing) (eieio-list-prin1 thing)) ((class-p thing) (princ (class-name thing))) + ((or (keywordp thing) (booleanp thing)) + (prin1 thing)) ((symbolp thing) (princ (concat "'" (symbol-name thing)))) (t (prin1 thing)))) @@ -2882,16 +2890,16 @@ this object." (progn (princ "'") (prin1 list)) - (princ "(list ") - (if (eieio-object-p (car list)) (princ "\n ")) - (while list - (if (eieio-object-p (car list)) - (object-write (car list)) - (princ "'") - (prin1 (car list))) - (princ " ") - (setq list (cdr list))) (princ (make-string (* eieio-print-depth 2) ? )) + (princ "(list") + (let ((eieio-print-depth (1+ eieio-print-depth))) + (while list + (princ "\n") + (if (eieio-object-p (car list)) + (object-write (car list)) + (princ (make-string (* eieio-print-depth 2) ? )) + (eieio-override-prin1 (car list))) + (setq list (cdr list)))) (princ ")"))) diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index bc02d9a7551..f1321eb4e6d 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -1,4 +1,4 @@ -;;; elp.el --- Emacs Lisp Profiler +;;; elp.el --- Emacs Lisp Profiler -*- lexical-binding: t -*- ;; Copyright (C) 1994-1995, 1997-1998, 2001-2013 Free Software ;; Foundation, Inc. @@ -124,6 +124,7 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) ;; start of user configuration variables ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv @@ -148,9 +149,9 @@ Results are displayed with the `elp-results' command." "Non-nil specifies ELP results sorting function. These functions are currently available: - elp-sort-by-call-count -- sort by the highest call count - elp-sort-by-total-time -- sort by the highest total time - elp-sort-by-average-time -- sort by the highest average times + `elp-sort-by-call-count' -- sort by the highest call count + `elp-sort-by-total-time' -- sort by the highest total time + `elp-sort-by-average-time' -- sort by the highest average times You can write your own sort function. It should adhere to the interface specified by the PREDICATE argument for `sort'. @@ -167,7 +168,7 @@ If a number, no function that has been called fewer than that number of times will be displayed in the output buffer. If nil, all functions will be displayed." :type '(choice integer - (const :tag "Show All" nil)) + (const :tag "Show All" nil)) :group 'elp) (defcustom elp-use-standard-output nil @@ -193,9 +194,6 @@ In other words, a new unique buffer is create every time you run (defconst elp-timer-info-property 'elp-info "ELP information property name.") -(defvar elp-all-instrumented-list nil - "List of all functions currently being instrumented.") - (defvar elp-record-p t "Controls whether functions should record times or not. This variable is set by the master function.") @@ -205,7 +203,7 @@ This variable is set by the master function.") (defvar elp-not-profilable ;; First, the functions used inside each instrumented function: - '(elp-wrapper called-interactively-p + '(called-interactively-p ;; Then the functions used by the above functions. I used ;; (delq nil (mapcar (lambda (x) (and (symbolp x) (fboundp x) x)) ;; (aref (symbol-function 'elp-wrapper) 2))) @@ -223,60 +221,21 @@ them would thus lead to infinite recursion.") (fboundp fun) (not (or (memq fun elp-not-profilable) (keymapp fun) - (memq (car-safe (symbol-function fun)) '(autoload macro)) - (condition-case nil - (when (subrp (indirect-function fun)) - (eq 'unevalled - (cdr (subr-arity (indirect-function fun))))) - (error nil)))))) + (autoloadp (symbol-function fun)) ;FIXME: Why not just load it? + (special-form-p fun))))) +(defconst elp--advice-name 'ELP-instrumentation\ ) ;;;###autoload (defun elp-instrument-function (funsym) "Instrument FUNSYM for profiling. FUNSYM must be a symbol of a defined function." (interactive "aFunction to instrument: ") - ;; restore the function. this is necessary to avoid infinite - ;; recursion of already instrumented functions (i.e. elp-wrapper - ;; calling elp-wrapper ad infinitum). it is better to simply - ;; restore the function than to throw an error. this will work - ;; properly in the face of eval-defun because if the function was - ;; redefined, only the timer info will be nil'd out since - ;; elp-restore-function is smart enough not to trash the new - ;; definition. - (elp-restore-function funsym) - (let* ((funguts (symbol-function funsym)) - (infovec (vector 0 0 funguts)) - (newguts '(lambda (&rest args)))) - ;; we cannot profile macros - (and (eq (car-safe funguts) 'macro) - (error "ELP cannot profile macro: %s" funsym)) - ;; TBD: at some point it might be better to load the autoloaded - ;; function instead of throwing an error. if we do this, then we - ;; probably want elp-instrument-package to be updated with the - ;; newly loaded list of functions. i'm not sure it's smart to do - ;; the autoload here, since that could have side effects, and - ;; elp-instrument-function is similar (in my mind) to defun-ish - ;; type functionality (i.e. it shouldn't execute the function). - (and (autoloadp funguts) - (error "ELP cannot profile autoloaded function: %s" funsym)) + (let* ((infovec (vector 0 0))) ;; We cannot profile functions used internally during profiling. (unless (elp-profilable-p funsym) (error "ELP cannot profile the function: %s" funsym)) - ;; put rest of newguts together - (if (commandp funsym) - (setq newguts (append newguts '((interactive))))) - (setq newguts (append newguts `((elp-wrapper - (quote ,funsym) - ,(when (commandp funsym) - '(called-interactively-p 'any)) - args)))) - ;; to record profiling times, we set the symbol's function - ;; definition so that it runs the elp-wrapper function with the - ;; function symbol as an argument. We place the old function - ;; definition on the info vector. - ;; - ;; The info vector data structure is a 3 element vector. The 0th + ;; The info vector data structure is a 2 element vector. The 0th ;; element is the call-count, i.e. the total number of times this ;; function has been entered. This value is bumped up on entry to ;; the function so that non-local exists are still recorded. TBD: @@ -285,72 +244,45 @@ FUNSYM must be a symbol of a defined function." ;; The 1st element is the total amount of time in seconds that has ;; been spent inside this function. This number is added to on ;; function exit. - ;; - ;; The 2nd element is the old function definition list. This gets - ;; funcall'd in between start/end time retrievals. I believe that - ;; this lets us profile even byte-compiled functions. - ;; put the info vector on the property list + ;; Put the info vector on the property list. (put funsym elp-timer-info-property infovec) ;; Set the symbol's new profiling function definition to run - ;; elp-wrapper. - (let ((advice-info (get funsym 'ad-advice-info))) - (if advice-info - (progn - ;; If function is advised, don't let Advice change - ;; its definition from under us during the `fset'. - (put funsym 'ad-advice-info nil) - (fset funsym newguts) - (put funsym 'ad-advice-info advice-info)) - (fset funsym newguts))) - - ;; add this function to the instrumentation list - (unless (memq funsym elp-all-instrumented-list) - (push funsym elp-all-instrumented-list)))) + ;; ELP wrapper. + (advice-add funsym :around (elp--make-wrapper funsym) + `((name . ,elp--advice-name))))) + +(defun elp--instrumented-p (sym) + (advice-member-p elp--advice-name sym)) (defun elp-restore-function (funsym) "Restore an instrumented function to its original definition. Argument FUNSYM is the symbol of a defined function." - (interactive "aFunction to restore: ") - (let ((info (get funsym elp-timer-info-property))) - ;; delete the function from the all instrumented list - (setq elp-all-instrumented-list - (delq funsym elp-all-instrumented-list)) - - ;; if the function was the master, reset the master - (if (eq funsym elp-master) - (setq elp-master nil - elp-record-p t)) - - ;; zap the properties - (put funsym elp-timer-info-property nil) - - ;; restore the original function definition, but if the function - ;; wasn't instrumented do nothing. we do this after the above - ;; because its possible the function got un-instrumented due to - ;; circumstances beyond our control. Also, check to make sure - ;; that the current function symbol points to elp-wrapper. If - ;; not, then the user probably did an eval-defun, or loaded a - ;; byte-compiled version, while the function was instrumented and - ;; we don't want to destroy the new definition. can it ever be - ;; the case that a lisp function can be compiled instrumented? - (and info - (functionp funsym) - (not (byte-code-function-p (symbol-function funsym))) - (assq 'elp-wrapper (symbol-function funsym)) - (fset funsym (aref info 2))))) + (interactive + (list + (intern + (completing-read "Function to restore: " obarray + #'elp--instrumented-p t)))) + ;; If the function was the master, reset the master. + (if (eq funsym elp-master) + (setq elp-master nil + elp-record-p t)) + + ;; Zap the properties. + (put funsym elp-timer-info-property nil) + + (advice-remove funsym elp--advice-name)) ;;;###autoload (defun elp-instrument-list (&optional list) "Instrument, for profiling, all functions in `elp-function-list'. Use optional LIST if provided instead. If called interactively, read LIST using the minibuffer." - (interactive "PList of functions to instrument: ") + (interactive "PList of functions to instrument: ") ;FIXME: Doesn't work?! (unless (listp list) (signal 'wrong-type-argument (list 'listp list))) - (let ((list (or list elp-function-list))) - (mapcar 'elp-instrument-function list))) + (mapcar #'elp-instrument-function (or list elp-function-list))) ;;;###autoload (defun elp-instrument-package (prefix) @@ -371,15 +303,13 @@ For example, to instrument all ELP functions, do the following: (defun elp-restore-list (&optional list) "Restore the original definitions for all functions in `elp-function-list'. Use optional LIST if provided instead." - (interactive "PList of functions to restore: ") - (let ((list (or list elp-function-list))) - (mapcar 'elp-restore-function list))) + (interactive "PList of functions to restore: ") ;FIXME: Doesn't work!? + (mapcar #'elp-restore-function (or list elp-function-list))) (defun elp-restore-all () "Restore the original definitions of all functions being profiled." (interactive) - (elp-restore-list elp-all-instrumented-list)) - + (mapatoms #'elp-restore-function)) (defun elp-reset-function (funsym) "Reset the profiling information for FUNSYM." @@ -395,30 +325,36 @@ Use optional LIST if provided instead." (defun elp-reset-list (&optional list) "Reset the profiling information for all functions in `elp-function-list'. Use optional LIST if provided instead." - (interactive "PList of functions to reset: ") + (interactive "PList of functions to reset: ") ;FIXME: Doesn't work!? (let ((list (or list elp-function-list))) (mapcar 'elp-reset-function list))) (defun elp-reset-all () "Reset the profiling information for all functions being profiled." (interactive) - (elp-reset-list elp-all-instrumented-list)) + (mapatoms (lambda (sym) + (if (get sym elp-timer-info-property) + (elp-reset-function sym))))) (defun elp-set-master (funsym) "Set the master function for profiling." - (interactive "aMaster function: ") - ;; when there's a master function, recording is turned off by - ;; default + (interactive + (list + (intern + (completing-read "Master function: " obarray + #'elp--instrumented-p + t nil nil (if elp-master (symbol-name elp-master)))))) + ;; When there's a master function, recording is turned off by default. (setq elp-master funsym elp-record-p nil) - ;; make sure master function is instrumented - (or (memq funsym elp-all-instrumented-list) + ;; Make sure master function is instrumented. + (or (elp--instrumented-p funsym) (elp-instrument-function funsym))) (defun elp-unset-master () "Unset the master function." (interactive) - ;; when there's no master function, recording is turned on by default. + ;; When there's no master function, recording is turned on by default. (setq elp-master nil elp-record-p t)) @@ -426,49 +362,40 @@ Use optional LIST if provided instead." (defsubst elp-elapsed-time (start end) (float-time (time-subtract end start))) -(defun elp-wrapper (funsym interactive-p args) - "This function has been instrumented for profiling by the ELP. +(defun elp--make-wrapper (funsym) + "Make the piece of advice that instruments FUNSYM." + (lambda (func &rest args) + "This function has been instrumented for profiling by the ELP. ELP is the Emacs Lisp Profiler. To restore the function to its original definition, use \\[elp-restore-function] or \\[elp-restore-all]." - ;; turn on recording if this is the master function - (if (and elp-master - (eq funsym elp-master)) - (setq elp-record-p t)) - ;; get info vector and original function symbol - (let* ((info (get funsym elp-timer-info-property)) - (func (aref info 2)) - result) - (or func - (error "%s is not instrumented for profiling" funsym)) - (if (not elp-record-p) - ;; when not recording, just call the original function symbol - ;; and return the results. - (setq result - (if interactive-p - (call-interactively func) - (apply func args))) - ;; we are recording times - (let (enter-time exit-time) - ;; increment the call-counter - (aset info 0 (1+ (aref info 0))) - ;; now call the old symbol function, checking to see if it - ;; should be called interactively. make sure we return the - ;; correct value - (if interactive-p - (setq enter-time (current-time) - result (call-interactively func) - exit-time (current-time)) + ;; turn on recording if this is the master function + (if (and elp-master + (eq funsym elp-master)) + (setq elp-record-p t)) + ;; get info vector and original function symbol + (let* ((info (get funsym elp-timer-info-property)) + result) + (or func + (error "%s is not instrumented for profiling" funsym)) + (if (not elp-record-p) + ;; when not recording, just call the original function symbol + ;; and return the results. + (setq result (apply func args)) + ;; we are recording times + (let (enter-time exit-time) + ;; increment the call-counter + (cl-incf (aref info 0)) (setq enter-time (current-time) result (apply func args) - exit-time (current-time))) - ;; calculate total time in function - (aset info 1 (+ (aref info 1) (elp-elapsed-time enter-time exit-time))) - )) - ;; turn off recording if this is the master function - (if (and elp-master - (eq funsym elp-master)) - (setq elp-record-p nil)) - result)) + exit-time (current-time)) + ;; calculate total time in function + (cl-incf (aref info 1) (elp-elapsed-time enter-time exit-time)) + )) + ;; turn off recording if this is the master function + (if (and elp-master + (eq funsym elp-master)) + (setq elp-record-p nil)) + result))) ;; shut the byte-compiler up @@ -582,57 +509,58 @@ displayed." (elp-et-len (length et-header)) (at-header "Average Time") (elp-at-len (length at-header)) - (resvec - (mapcar - (function - (lambda (funsym) - (let* ((info (get funsym elp-timer-info-property)) - (symname (format "%s" funsym)) - (cc (aref info 0)) - (tt (aref info 1))) - (if (not info) - (insert "No profiling information found for: " - symname) - (setq longest (max longest (length symname))) - (vector cc tt (if (zerop cc) - 0.0 ;avoid arithmetic div-by-zero errors - (/ (float tt) (float cc))) - symname))))) - elp-all-instrumented-list)) + (resvec '()) ) ; end let* + (mapatoms + (lambda (funsym) + (when (elp--instrumented-p funsym) + (let* ((info (get funsym elp-timer-info-property)) + (symname (format "%s" funsym)) + (cc (aref info 0)) + (tt (aref info 1))) + (if (not info) + (insert "No profiling information found for: " + symname) + (setq longest (max longest (length symname))) + (push + (vector cc tt (if (zerop cc) + 0.0 ;avoid arithmetic div-by-zero errors + (/ (float tt) (float cc))) + symname) + resvec)))))) ;; If printing to stdout, insert the header so it will print. ;; Otherwise use header-line-format. (setq elp-field-len (max titlelen longest)) (if (or elp-use-standard-output noninteractive) - (progn - (insert title) - (if (> longest titlelen) - (progn - (insert-char 32 (- longest titlelen)))) - (insert " " cc-header " " et-header " " at-header "\n") - (insert-char ?= elp-field-len) - (insert " ") - (insert-char ?= elp-cc-len) - (insert " ") - (insert-char ?= elp-et-len) - (insert " ") - (insert-char ?= elp-at-len) - (insert "\n")) - (let ((column 0)) - (setq header-line-format - (mapconcat - (lambda (title) - (prog1 - (concat - (propertize " " - 'display (list 'space :align-to column) - 'face 'fixed-pitch) - title) - (setq column (+ column 2 - (if (= column 0) - elp-field-len - (length title)))))) - (list title cc-header et-header at-header) "")))) + (progn + (insert title) + (if (> longest titlelen) + (progn + (insert-char 32 (- longest titlelen)))) + (insert " " cc-header " " et-header " " at-header "\n") + (insert-char ?= elp-field-len) + (insert " ") + (insert-char ?= elp-cc-len) + (insert " ") + (insert-char ?= elp-et-len) + (insert " ") + (insert-char ?= elp-at-len) + (insert "\n")) + (let ((column 0)) + (setq header-line-format + (mapconcat + (lambda (title) + (prog1 + (concat + (propertize " " + 'display (list 'space :align-to column) + 'face 'fixed-pitch) + title) + (setq column (+ column 2 + (if (= column 0) + elp-field-len + (length title)))))) + (list title cc-header et-header at-header) "")))) ;; if sorting is enabled, then sort the results list. in either ;; case, call elp-output-result to output the result in the ;; buffer @@ -644,7 +572,7 @@ displayed." (pop-to-buffer resultsbuf) ;; copy results to standard-output? (if (or elp-use-standard-output noninteractive) - (princ (buffer-substring (point-min) (point-max))) + (princ (buffer-substring (point-min) (point-max))) (goto-char (point-min))) ;; reset profiling info if desired (and elp-reset-after-results diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 00100c0f6fb..531e83c1e6a 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -1,4 +1,4 @@ -;;; ert-x.el --- Staging area for experimental extensions to ERT +;;; ert-x.el --- Staging area for experimental extensions to ERT -*- lexical-binding: t -*- ;; Copyright (C) 2008, 2010-2013 Free Software Foundation, Inc. @@ -28,8 +28,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'ert) @@ -90,8 +89,8 @@ ERT--THUNK with that buffer as current." (kill-buffer ert--buffer) (remhash ert--buffer ert--test-buffers)))) -(defmacro* ert-with-test-buffer ((&key ((:name name-form))) - &body body) +(cl-defmacro ert-with-test-buffer ((&key ((:name name-form))) + &body body) "Create a test buffer and run BODY in that buffer. To be used in ERT tests. If BODY finishes successfully, the test @@ -116,10 +115,10 @@ the name of the test and the result of NAME-FORM." "Kill all test buffers that are still live." (interactive) (let ((count 0)) - (maphash (lambda (buffer dummy) + (maphash (lambda (buffer _dummy) (when (or (not (buffer-live-p buffer)) (kill-buffer buffer)) - (incf count))) + (cl-incf count))) ert--test-buffers) (message "%s out of %s test buffers killed" count (hash-table-count ert--test-buffers))) @@ -149,9 +148,9 @@ the rest are arguments to the command. NOTE: Since the command is not called by `call-interactively' test for `called-interactively' in the command will fail." - (assert (listp command) t) - (assert (commandp (car command)) t) - (assert (not unread-command-events) t) + (cl-assert (listp command) t) + (cl-assert (commandp (car command)) t) + (cl-assert (not unread-command-events) t) (let (return-value) ;; For the order of things here see command_loop_1 in keyboard.c. ;; @@ -175,7 +174,7 @@ test for `called-interactively' in the command will fail." (when (boundp 'last-repeatable-command) (setq last-repeatable-command real-last-command)) (when (and deactivate-mark transient-mark-mode) (deactivate-mark)) - (assert (not unread-command-events) t) + (cl-assert (not unread-command-events) t) return-value)) (defun ert-run-idle-timers () @@ -198,7 +197,7 @@ rather than the entire match." (with-temp-buffer (insert s) (dolist (x regexps) - (destructuring-bind (regexp subexp) (if (listp x) x `(,x nil)) + (cl-destructuring-bind (regexp subexp) (if (listp x) x `(,x nil)) (goto-char (point-min)) (while (re-search-forward regexp nil t) (replace-match "" t t nil subexp)))) @@ -224,15 +223,15 @@ would return the string \"foo bar baz quux\" where the substring None of the ARGS are modified, but the return value may share structure with the plists in ARGS." (with-temp-buffer - (loop with current-plist = nil - for x in args do - (etypecase x - (string (let ((begin (point))) - (insert x) - (set-text-properties begin (point) current-plist))) - (list (unless (zerop (mod (length x) 2)) - (error "Odd number of args in plist: %S" x)) - (setq current-plist x)))) + (cl-loop with current-plist = nil + for x in args do + (cl-etypecase x + (string (let ((begin (point))) + (insert x) + (set-text-properties begin (point) current-plist))) + (list (unless (zerop (mod (length x) 2)) + (error "Odd number of args in plist: %S" x)) + (setq current-plist x)))) (buffer-string))) @@ -245,8 +244,8 @@ buffer, and renames the original buffer back to BUFFER-NAME. This is useful if THUNK has undesirable side-effects on an Emacs buffer with a fixed name such as *Messages*." - (lexical-let ((new-buffer-name (generate-new-buffer-name - (format "%s orig buffer" buffer-name)))) + (let ((new-buffer-name (generate-new-buffer-name + (format "%s orig buffer" buffer-name)))) (with-current-buffer (get-buffer-create buffer-name) (rename-buffer new-buffer-name)) (unwind-protect @@ -258,7 +257,7 @@ buffer with a fixed name such as *Messages*." (with-current-buffer new-buffer-name (rename-buffer buffer-name))))) -(defmacro* ert-with-buffer-renamed ((buffer-name-form) &body body) +(cl-defmacro ert-with-buffer-renamed ((buffer-name-form) &body body) "Protect the buffer named BUFFER-NAME from side-effects and run BODY. See `ert-call-with-buffer-renamed' for details." diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 134dbc1b6a6..dd849362228 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -1,4 +1,4 @@ -;;; ert.el --- Emacs Lisp Regression Testing +;;; ert.el --- Emacs Lisp Regression Testing -*- lexical-binding: t -*- ;; Copyright (C) 2007-2008, 2010-2013 Free Software Foundation, Inc. @@ -54,8 +54,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'button) (require 'debug) (require 'easymenu) @@ -105,33 +104,33 @@ "A reimplementation of `remove-if-not'. ERT-PRED is a predicate, ERT-LIST is the input list." - (loop for ert-x in ert-list - if (funcall ert-pred ert-x) - collect ert-x)) + (cl-loop for ert-x in ert-list + if (funcall ert-pred ert-x) + collect ert-x)) (defun ert--intersection (a b) "A reimplementation of `intersection'. Intersect the sets A and B. Elements are compared using `eql'." - (loop for x in a - if (memql x b) - collect x)) + (cl-loop for x in a + if (memql x b) + collect x)) (defun ert--set-difference (a b) "A reimplementation of `set-difference'. Subtract the set B from the set A. Elements are compared using `eql'." - (loop for x in a - unless (memql x b) - collect x)) + (cl-loop for x in a + unless (memql x b) + collect x)) (defun ert--set-difference-eq (a b) "A reimplementation of `set-difference'. Subtract the set B from the set A. Elements are compared using `eq'." - (loop for x in a - unless (memq x b) - collect x)) + (cl-loop for x in a + unless (memq x b) + collect x)) (defun ert--union (a b) "A reimplementation of `union'. Compute the union of the sets A and B. @@ -149,7 +148,7 @@ Elements are compared using `eql'." (make-symbol (format "%s%s" prefix (prog1 ert--gensym-counter - (incf ert--gensym-counter)))))) + (cl-incf ert--gensym-counter)))))) (defun ert--coerce-to-vector (x) "Coerce X to a vector." @@ -158,19 +157,19 @@ Elements are compared using `eql'." x (vconcat x))) -(defun* ert--remove* (x list &key key test) +(cl-defun ert--remove* (x list &key key test) "Does not support all the keywords of remove*." (unless key (setq key #'identity)) (unless test (setq test #'eql)) - (loop for y in list - unless (funcall test x (funcall key y)) - collect y)) + (cl-loop for y in list + unless (funcall test x (funcall key y)) + collect y)) (defun ert--string-position (c s) "Return the position of the first occurrence of C in S, or nil if none." - (loop for i from 0 - for x across s - when (eql x c) return i)) + (cl-loop for i from 0 + for x across s + when (eql x c) return i)) (defun ert--mismatch (a b) "Return index of first element that differs between A and B. @@ -184,29 +183,30 @@ Like `mismatch'. Uses `equal' for comparison." (t (let ((la (length a)) (lb (length b))) - (assert (arrayp a) t) - (assert (arrayp b) t) - (assert (<= la lb) t) - (loop for i below la - when (not (equal (aref a i) (aref b i))) return i - finally (return (if (/= la lb) - la - (assert (equal a b) t) - nil))))))) + (cl-assert (arrayp a) t) + (cl-assert (arrayp b) t) + (cl-assert (<= la lb) t) + (cl-loop for i below la + when (not (equal (aref a i) (aref b i))) return i + finally (cl-return (if (/= la lb) + la + (cl-assert (equal a b) t) + nil))))))) (defun ert--subseq (seq start &optional end) "Return a subsequence of SEQ from START to END." (when (char-table-p seq) (error "Not supported")) (let ((vector (substring (ert--coerce-to-vector seq) start end))) - (etypecase seq + (cl-etypecase seq (vector vector) (string (concat vector)) (list (append vector nil)) - (bool-vector (loop with result = (make-bool-vector (length vector) nil) - for i below (length vector) do - (setf (aref result i) (aref vector i)) - finally (return result))) - (char-table (assert nil))))) + (bool-vector (cl-loop with result + = (make-bool-vector (length vector) nil) + for i below (length vector) do + (setf (aref result i) (aref vector i)) + finally (cl-return result))) + (char-table (cl-assert nil))))) (defun ert-equal-including-properties (a b) "Return t if A and B have similar structure and contents. @@ -225,10 +225,10 @@ Emacs bug 6581 at URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'." ;;; Defining and locating tests. ;; The data structure that represents a test case. -(defstruct ert-test +(cl-defstruct ert-test (name nil) (documentation nil) - (body (assert nil)) + (body (cl-assert nil)) (most-recent-result nil) (expected-result-type ':passed) (tags '())) @@ -273,7 +273,7 @@ Returns a two-element list containing the keys-and-values plist and the body." (let ((extracted-key-accu '()) (remaining keys-and-body)) - (while (and (consp remaining) (keywordp (first remaining))) + (while (keywordp (car-safe remaining)) (let ((keyword (pop remaining))) (unless (consp remaining) (error "Value expected after keyword %S in %S" @@ -283,13 +283,13 @@ and the body." keys-and-body)) (push (cons keyword (pop remaining)) extracted-key-accu))) (setq extracted-key-accu (nreverse extracted-key-accu)) - (list (loop for (key . value) in extracted-key-accu - collect key - collect value) + (list (cl-loop for (key . value) in extracted-key-accu + collect key + collect value) remaining))) ;;;###autoload -(defmacro* ert-deftest (name () &body docstring-keys-and-body) +(cl-defmacro ert-deftest (name () &body docstring-keys-and-body) "Define NAME (a symbol) as a test. BODY is evaluated as a `progn' when the test is run. It should @@ -313,12 +313,13 @@ description of valid values for RESULT-TYPE. (indent 2)) (let ((documentation nil) (documentation-supplied-p nil)) - (when (stringp (first docstring-keys-and-body)) + (when (stringp (car docstring-keys-and-body)) (setq documentation (pop docstring-keys-and-body) documentation-supplied-p t)) - (destructuring-bind ((&key (expected-result nil expected-result-supplied-p) - (tags nil tags-supplied-p)) - body) + (cl-destructuring-bind + ((&key (expected-result nil expected-result-supplied-p) + (tags nil tags-supplied-p)) + body) (ert--parse-keys-and-body docstring-keys-and-body) `(progn (ert-set-test ',name @@ -405,10 +406,10 @@ DATA is displayed to the user and should state the reason of the failure." (t (let ((fn-name (car form)) (arg-forms (cdr form))) - (assert (or (symbolp fn-name) - (and (consp fn-name) - (eql (car fn-name) 'lambda) - (listp (cdr fn-name))))) + (cl-assert (or (symbolp fn-name) + (and (consp fn-name) + (eql (car fn-name) 'lambda) + (listp (cdr fn-name))))) (let ((fn (ert--gensym "fn-")) (args (ert--gensym "args-")) (value (ert--gensym "value-")) @@ -446,35 +447,34 @@ should return code that calls INNER-FORM and performs the checks and error signaling specific to the particular variant of `should'. The code that INNER-EXPANDER returns must not call FORM-DESCRIPTION-FORM before it has called INNER-FORM." - (lexical-let ((inner-expander inner-expander)) - (ert--expand-should-1 - whole form - (lambda (inner-form form-description-form value-var) - (let ((form-description (ert--gensym "form-description-"))) - `(let (,form-description) - ,(funcall inner-expander - `(unwind-protect - ,inner-form - (setq ,form-description ,form-description-form) - (ert--signal-should-execution ,form-description)) - `,form-description - value-var))))))) - -(defmacro* should (form) + (ert--expand-should-1 + whole form + (lambda (inner-form form-description-form value-var) + (let ((form-description (ert--gensym "form-description-"))) + `(let (,form-description) + ,(funcall inner-expander + `(unwind-protect + ,inner-form + (setq ,form-description ,form-description-form) + (ert--signal-should-execution ,form-description)) + `,form-description + value-var)))))) + +(cl-defmacro should (form) "Evaluate FORM. If it returns nil, abort the current test as failed. Returns the value of FORM." (ert--expand-should `(should ,form) form - (lambda (inner-form form-description-form value-var) + (lambda (inner-form form-description-form _value-var) `(unless ,inner-form (ert-fail ,form-description-form))))) -(defmacro* should-not (form) +(cl-defmacro should-not (form) "Evaluate FORM. If it returns non-nil, abort the current test as failed. Returns nil." (ert--expand-should `(should-not ,form) form - (lambda (inner-form form-description-form value-var) + (lambda (inner-form form-description-form _value-var) `(unless (not ,inner-form) (ert-fail ,form-description-form))))) @@ -485,10 +485,10 @@ Returns nil." Determines whether CONDITION matches TYPE and EXCLUDE-SUBTYPES, and aborts the current test as failed if it doesn't." (let ((signaled-conditions (get (car condition) 'error-conditions)) - (handled-conditions (etypecase type + (handled-conditions (cl-etypecase type (list type) (symbol (list type))))) - (assert signaled-conditions) + (cl-assert signaled-conditions) (unless (ert--intersection signaled-conditions handled-conditions) (ert-fail (append (funcall form-description-fn) @@ -507,7 +507,7 @@ and aborts the current test as failed if it doesn't." ;; FIXME: The expansion will evaluate the keyword args (if any) in ;; nonstandard order. -(defmacro* should-error (form &rest keys &key type exclude-subtypes) +(cl-defmacro should-error (form &rest keys &key type exclude-subtypes) "Evaluate FORM and check that it signals an error. The error signaled needs to match TYPE. TYPE should be a list @@ -555,19 +555,19 @@ failed." (defun ert--proper-list-p (x) "Return non-nil if X is a proper list, nil otherwise." - (loop + (cl-loop for firstp = t then nil for fast = x then (cddr fast) for slow = x then (cdr slow) do - (when (null fast) (return t)) - (when (not (consp fast)) (return nil)) - (when (null (cdr fast)) (return t)) - (when (not (consp (cdr fast))) (return nil)) - (when (and (not firstp) (eq fast slow)) (return nil)))) + (when (null fast) (cl-return t)) + (when (not (consp fast)) (cl-return nil)) + (when (null (cdr fast)) (cl-return t)) + (when (not (consp (cdr fast))) (cl-return nil)) + (when (and (not firstp) (eq fast slow)) (cl-return nil)))) (defun ert--explain-format-atom (x) "Format the atom X for `ert--explain-equal'." - (typecase x + (cl-typecase x (fixnum (list x (format "#x%x" x) (format "?%c" x))) (t x))) @@ -576,7 +576,7 @@ failed." Returns nil if they are." (if (not (equal (type-of a) (type-of b))) `(different-types ,a ,b) - (etypecase a + (cl-etypecase a (cons (let ((a-proper-p (ert--proper-list-p a)) (b-proper-p (ert--proper-list-p b))) @@ -588,19 +588,19 @@ Returns nil if they are." ,a ,b first-mismatch-at ,(ert--mismatch a b)) - (loop for i from 0 - for ai in a - for bi in b - for xi = (ert--explain-equal-rec ai bi) - do (when xi (return `(list-elt ,i ,xi))) - finally (assert (equal a b) t))) + (cl-loop for i from 0 + for ai in a + for bi in b + for xi = (ert--explain-equal-rec ai bi) + do (when xi (cl-return `(list-elt ,i ,xi))) + finally (cl-assert (equal a b) t))) (let ((car-x (ert--explain-equal-rec (car a) (car b)))) (if car-x `(car ,car-x) (let ((cdr-x (ert--explain-equal-rec (cdr a) (cdr b)))) (if cdr-x `(cdr ,cdr-x) - (assert (equal a b) t) + (cl-assert (equal a b) t) nil)))))))) (array (if (not (equal (length a) (length b))) `(arrays-of-different-length ,(length a) ,(length b) @@ -608,12 +608,12 @@ Returns nil if they are." ,@(unless (char-table-p a) `(first-mismatch-at ,(ert--mismatch a b)))) - (loop for i from 0 - for ai across a - for bi across b - for xi = (ert--explain-equal-rec ai bi) - do (when xi (return `(array-elt ,i ,xi))) - finally (assert (equal a b) t)))) + (cl-loop for i from 0 + for ai across a + for bi across b + for xi = (ert--explain-equal-rec ai bi) + do (when xi (cl-return `(array-elt ,i ,xi))) + finally (cl-assert (equal a b) t)))) (atom (if (not (equal a b)) (if (and (symbolp a) (symbolp b) (string= a b)) `(different-symbols-with-the-same-name ,a ,b) @@ -632,10 +632,10 @@ Returns nil if they are." (defun ert--significant-plist-keys (plist) "Return the keys of PLIST that have non-null values, in order." - (assert (zerop (mod (length plist) 2)) t) - (loop for (key value . rest) on plist by #'cddr - unless (or (null value) (memq key accu)) collect key into accu - finally (return accu))) + (cl-assert (zerop (mod (length plist) 2)) t) + (cl-loop for (key value . rest) on plist by #'cddr + unless (or (null value) (memq key accu)) collect key into accu + finally (cl-return accu))) (defun ert--plist-difference-explanation (a b) "Return a programmer-readable explanation of why A and B are different plists. @@ -643,8 +643,8 @@ Returns nil if they are." Returns nil if they are equivalent, i.e., have the same value for each key, where absent values are treated as nil. The order of key/value pairs in each list does not matter." - (assert (zerop (mod (length a) 2)) t) - (assert (zerop (mod (length b) 2)) t) + (cl-assert (zerop (mod (length a) 2)) t) + (cl-assert (zerop (mod (length b) 2)) t) ;; Normalizing the plists would be another way to do this but it ;; requires a total ordering on all lisp objects (since any object ;; is valid as a text property key). Perhaps defining such an @@ -654,21 +654,21 @@ key/value pairs in each list does not matter." (keys-b (ert--significant-plist-keys b)) (keys-in-a-not-in-b (ert--set-difference-eq keys-a keys-b)) (keys-in-b-not-in-a (ert--set-difference-eq keys-b keys-a))) - (flet ((explain-with-key (key) - (let ((value-a (plist-get a key)) - (value-b (plist-get b key))) - (assert (not (equal value-a value-b)) t) - `(different-properties-for-key - ,key ,(ert--explain-equal-including-properties value-a - value-b))))) + (cl-flet ((explain-with-key (key) + (let ((value-a (plist-get a key)) + (value-b (plist-get b key))) + (cl-assert (not (equal value-a value-b)) t) + `(different-properties-for-key + ,key ,(ert--explain-equal-including-properties value-a + value-b))))) (cond (keys-in-a-not-in-b - (explain-with-key (first keys-in-a-not-in-b))) + (explain-with-key (car keys-in-a-not-in-b))) (keys-in-b-not-in-a - (explain-with-key (first keys-in-b-not-in-a))) + (explain-with-key (car keys-in-b-not-in-a))) (t - (loop for key in keys-a - when (not (equal (plist-get a key) (plist-get b key))) - return (explain-with-key key))))))) + (cl-loop for key in keys-a + when (not (equal (plist-get a key) (plist-get b key))) + return (explain-with-key key))))))) (defun ert--abbreviate-string (s len suffixp) "Shorten string S to at most LEN chars. @@ -692,29 +692,30 @@ Returns a programmer-readable explanation of why A and B are not `ert-equal-including-properties', or nil if they are." (if (not (equal a b)) (ert--explain-equal a b) - (assert (stringp a) t) - (assert (stringp b) t) - (assert (eql (length a) (length b)) t) - (loop for i from 0 to (length a) - for props-a = (text-properties-at i a) - for props-b = (text-properties-at i b) - for difference = (ert--plist-difference-explanation props-a props-b) - do (when difference - (return `(char ,i ,(substring-no-properties a i (1+ i)) - ,difference - context-before - ,(ert--abbreviate-string - (substring-no-properties a 0 i) - 10 t) - context-after - ,(ert--abbreviate-string - (substring-no-properties a (1+ i)) - 10 nil)))) - ;; TODO(ohler): Get `equal-including-properties' fixed in - ;; Emacs, delete `ert-equal-including-properties', and - ;; re-enable this assertion. - ;;finally (assert (equal-including-properties a b) t) - ))) + (cl-assert (stringp a) t) + (cl-assert (stringp b) t) + (cl-assert (eql (length a) (length b)) t) + (cl-loop for i from 0 to (length a) + for props-a = (text-properties-at i a) + for props-b = (text-properties-at i b) + for difference = (ert--plist-difference-explanation + props-a props-b) + do (when difference + (cl-return `(char ,i ,(substring-no-properties a i (1+ i)) + ,difference + context-before + ,(ert--abbreviate-string + (substring-no-properties a 0 i) + 10 t) + context-after + ,(ert--abbreviate-string + (substring-no-properties a (1+ i)) + 10 nil)))) + ;; TODO(ohler): Get `equal-including-properties' fixed in + ;; Emacs, delete `ert-equal-including-properties', and + ;; re-enable this assertion. + ;;finally (cl-assert (equal-including-properties a b) t) + ))) (put 'ert-equal-including-properties 'ert-explainer 'ert--explain-equal-including-properties) @@ -729,8 +730,8 @@ Returns a programmer-readable explanation of why A and B are not Bound dynamically. This is a list of (PREFIX . MESSAGE) pairs.") -(defmacro* ert-info ((message-form &key ((:prefix prefix-form) "Info: ")) - &body body) +(cl-defmacro ert-info ((message-form &key ((:prefix prefix-form) "Info: ")) + &body body) "Evaluate MESSAGE-FORM and BODY, and report the message if BODY fails. To be used within ERT tests. MESSAGE-FORM should evaluate to a @@ -750,18 +751,19 @@ and is displayed in front of the value of MESSAGE-FORM." "Non-nil means enter debugger when a test fails or terminates with an error.") ;; The data structures that represent the result of running a test. -(defstruct ert-test-result +(cl-defstruct ert-test-result (messages nil) (should-forms nil) ) -(defstruct (ert-test-passed (:include ert-test-result))) -(defstruct (ert-test-result-with-condition (:include ert-test-result)) - (condition (assert nil)) - (backtrace (assert nil)) - (infos (assert nil))) -(defstruct (ert-test-quit (:include ert-test-result-with-condition))) -(defstruct (ert-test-failed (:include ert-test-result-with-condition))) -(defstruct (ert-test-aborted-with-non-local-exit (:include ert-test-result))) +(cl-defstruct (ert-test-passed (:include ert-test-result))) +(cl-defstruct (ert-test-result-with-condition (:include ert-test-result)) + (condition (cl-assert nil)) + (backtrace (cl-assert nil)) + (infos (cl-assert nil))) +(cl-defstruct (ert-test-quit (:include ert-test-result-with-condition))) +(cl-defstruct (ert-test-failed (:include ert-test-result-with-condition))) +(cl-defstruct (ert-test-aborted-with-non-local-exit + (:include ert-test-result))) (defun ert--record-backtrace () @@ -774,7 +776,7 @@ and is displayed in front of the value of MESSAGE-FORM." ;; `ert-results-pop-to-backtrace-for-test-at-point' given that we ;; already have `ert-results-rerun-test-debugging-errors-at-point'. ;; For batch use, however, printing the backtrace may be useful. - (loop + (cl-loop ;; 6 is the number of frames our own debugger adds (when ;; compiled; more when interpreted). FIXME: Need to describe a ;; procedure for determining this constant. @@ -791,33 +793,33 @@ and is displayed in front of the value of MESSAGE-FORM." (print-level 8) (print-length 50)) (dolist (frame backtrace) - (ecase (first frame) + (cl-ecase (car frame) ((nil) ;; Special operator. - (destructuring-bind (special-operator &rest arg-forms) + (cl-destructuring-bind (special-operator &rest arg-forms) (cdr frame) (insert - (format " %S\n" (list* special-operator arg-forms))))) + (format " %S\n" (cons special-operator arg-forms))))) ((t) ;; Function call. - (destructuring-bind (fn &rest args) (cdr frame) + (cl-destructuring-bind (fn &rest args) (cdr frame) (insert (format " %S(" fn)) - (loop for firstp = t then nil - for arg in args do - (unless firstp - (insert " ")) - (insert (format "%S" arg))) + (cl-loop for firstp = t then nil + for arg in args do + (unless firstp + (insert " ")) + (insert (format "%S" arg))) (insert ")\n"))))))) ;; A container for the state of the execution of a single test and ;; environment data needed during its execution. -(defstruct ert--test-execution-info - (test (assert nil)) - (result (assert nil)) +(cl-defstruct ert--test-execution-info + (test (cl-assert nil)) + (result (cl-assert nil)) ;; A thunk that may be called when RESULT has been set to its final ;; value and test execution should be terminated. Should not ;; return. - (exit-continuation (assert nil)) + (exit-continuation (cl-assert nil)) ;; The binding of `debugger' outside of the execution of the test. next-debugger ;; The binding of `ert-debug-on-error' that is in effect for the @@ -826,7 +828,7 @@ and is displayed in front of the value of MESSAGE-FORM." ;; don't remember whether this feature is important.) ert-debug-on-error) -(defun ert--run-test-debugger (info debugger-args) +(defun ert--run-test-debugger (info args) "During a test run, `debugger' is bound to a closure that calls this function. This function records failures and errors and either terminates @@ -834,21 +836,21 @@ the test silently or calls the interactive debugger, as appropriate. INFO is the ert--test-execution-info corresponding to this test -run. DEBUGGER-ARGS are the arguments to `debugger'." - (destructuring-bind (first-debugger-arg &rest more-debugger-args) - debugger-args - (ecase first-debugger-arg +run. ARGS are the arguments to `debugger'." + (cl-destructuring-bind (first-debugger-arg &rest more-debugger-args) + args + (cl-ecase first-debugger-arg ((lambda debug t exit nil) - (apply (ert--test-execution-info-next-debugger info) debugger-args)) + (apply (ert--test-execution-info-next-debugger info) args)) (error - (let* ((condition (first more-debugger-args)) - (type (case (car condition) + (let* ((condition (car more-debugger-args)) + (type (cl-case (car condition) ((quit) 'quit) (otherwise 'failed))) (backtrace (ert--record-backtrace)) (infos (reverse ert--infos))) (setf (ert--test-execution-info-result info) - (ecase type + (cl-ecase type (quit (make-ert-test-quit :condition condition :backtrace backtrace @@ -859,39 +861,42 @@ run. DEBUGGER-ARGS are the arguments to `debugger'." :infos infos)))) ;; Work around Emacs's heuristic (in eval.c) for detecting ;; errors in the debugger. - (incf num-nonmacro-input-events) + (cl-incf num-nonmacro-input-events) ;; FIXME: We should probably implement more fine-grained ;; control a la non-t `debug-on-error' here. (cond ((ert--test-execution-info-ert-debug-on-error info) - (apply (ert--test-execution-info-next-debugger info) debugger-args)) + (apply (ert--test-execution-info-next-debugger info) args)) (t)) (funcall (ert--test-execution-info-exit-continuation info))))))) -(defun ert--run-test-internal (ert-test-execution-info) - "Low-level function to run a test according to ERT-TEST-EXECUTION-INFO. +(defun ert--run-test-internal (test-execution-info) + "Low-level function to run a test according to TEST-EXECUTION-INFO. This mainly sets up debugger-related bindings." - (lexical-let ((info ert-test-execution-info)) - (setf (ert--test-execution-info-next-debugger info) debugger - (ert--test-execution-info-ert-debug-on-error info) ert-debug-on-error) - (catch 'ert--pass - ;; For now, each test gets its own temp buffer and its own - ;; window excursion, just to be safe. If this turns out to be - ;; too expensive, we can remove it. - (with-temp-buffer - (save-window-excursion - (let ((debugger (lambda (&rest debugger-args) - (ert--run-test-debugger info debugger-args))) - (debug-on-error t) - (debug-on-quit t) - ;; FIXME: Do we need to store the old binding of this - ;; and consider it in `ert--run-test-debugger'? - (debug-ignored-errors nil) - (ert--infos '())) - (funcall (ert-test-body (ert--test-execution-info-test info)))))) - (ert-pass)) - (setf (ert--test-execution-info-result info) (make-ert-test-passed))) + (setf (ert--test-execution-info-next-debugger test-execution-info) debugger + (ert--test-execution-info-ert-debug-on-error test-execution-info) + ert-debug-on-error) + (catch 'ert--pass + ;; For now, each test gets its own temp buffer and its own + ;; window excursion, just to be safe. If this turns out to be + ;; too expensive, we can remove it. + (with-temp-buffer + (save-window-excursion + (let ((debugger (lambda (&rest args) + (ert--run-test-debugger test-execution-info + args))) + (debug-on-error t) + (debug-on-quit t) + ;; FIXME: Do we need to store the old binding of this + ;; and consider it in `ert--run-test-debugger'? + (debug-ignored-errors nil) + (ert--infos '())) + (funcall (ert-test-body (ert--test-execution-info-test + test-execution-info)))))) + (ert-pass)) + (setf (ert--test-execution-info-result test-execution-info) + (make-ert-test-passed)) nil) (defun ert--force-message-log-buffer-truncation () @@ -929,18 +934,18 @@ The elements are of type `ert-test'.") Returns the result and stores it in ERT-TEST's `most-recent-result' slot." (setf (ert-test-most-recent-result ert-test) nil) - (block error - (lexical-let ((begin-marker - (with-current-buffer (get-buffer-create "*Messages*") - (set-marker (make-marker) (point-max))))) + (cl-block error + (let ((begin-marker + (with-current-buffer (get-buffer-create "*Messages*") + (point-max-marker)))) (unwind-protect - (lexical-let ((info (make-ert--test-execution-info - :test ert-test - :result - (make-ert-test-aborted-with-non-local-exit) - :exit-continuation (lambda () - (return-from error nil)))) - (should-form-accu (list))) + (let ((info (make-ert--test-execution-info + :test ert-test + :result + (make-ert-test-aborted-with-non-local-exit) + :exit-continuation (lambda () + (cl-return-from error nil)))) + (should-form-accu (list))) (unwind-protect (let ((ert--should-execution-observer (lambda (form-description) @@ -982,32 +987,32 @@ t -- Always matches. RESULT." ;; It would be easy to add `member' and `eql' types etc., but I ;; haven't bothered yet. - (etypecase result-type + (cl-etypecase result-type ((member nil) nil) ((member t) t) ((member :failed) (ert-test-failed-p result)) ((member :passed) (ert-test-passed-p result)) (cons - (destructuring-bind (operator &rest operands) result-type - (ecase operator + (cl-destructuring-bind (operator &rest operands) result-type + (cl-ecase operator (and - (case (length operands) + (cl-case (length operands) (0 t) (t - (and (ert-test-result-type-p result (first operands)) - (ert-test-result-type-p result `(and ,@(rest operands))))))) + (and (ert-test-result-type-p result (car operands)) + (ert-test-result-type-p result `(and ,@(cdr operands))))))) (or - (case (length operands) + (cl-case (length operands) (0 nil) (t - (or (ert-test-result-type-p result (first operands)) - (ert-test-result-type-p result `(or ,@(rest operands))))))) + (or (ert-test-result-type-p result (car operands)) + (ert-test-result-type-p result `(or ,@(cdr operands))))))) (not - (assert (eql (length operands) 1)) - (not (ert-test-result-type-p result (first operands)))) + (cl-assert (eql (length operands) 1)) + (not (ert-test-result-type-p result (car operands)))) (satisfies - (assert (eql (length operands) 1)) - (funcall (first operands) result))))))) + (cl-assert (eql (length operands) 1)) + (funcall (car operands) result))))))) (defun ert-test-result-expected-p (test result) "Return non-nil if TEST's expected result type matches RESULT." @@ -1048,9 +1053,9 @@ set implied by them without checking whether it is really contained in UNIVERSE." ;; This code needs to match the etypecase in ;; `ert-insert-human-readable-selector'. - (etypecase selector + (cl-etypecase selector ((member nil) nil) - ((member t) (etypecase universe + ((member t) (cl-etypecase universe (list universe) ((member t) (ert-select-tests "" universe)))) ((member :new) (ert-select-tests @@ -1078,7 +1083,7 @@ contained in UNIVERSE." universe)) ((member :unexpected) (ert-select-tests `(not :expected) universe)) (string - (etypecase universe + (cl-etypecase universe ((member t) (mapcar #'ert-get-test (apropos-internal selector #'ert-test-boundp))) (list (ert--remove-if-not (lambda (test) @@ -1088,51 +1093,51 @@ contained in UNIVERSE." universe)))) (ert-test (list selector)) (symbol - (assert (ert-test-boundp selector)) + (cl-assert (ert-test-boundp selector)) (list (ert-get-test selector))) (cons - (destructuring-bind (operator &rest operands) selector - (ecase operator + (cl-destructuring-bind (operator &rest operands) selector + (cl-ecase operator (member (mapcar (lambda (purported-test) - (etypecase purported-test - (symbol (assert (ert-test-boundp purported-test)) + (cl-etypecase purported-test + (symbol (cl-assert (ert-test-boundp purported-test)) (ert-get-test purported-test)) (ert-test purported-test))) operands)) (eql - (assert (eql (length operands) 1)) + (cl-assert (eql (length operands) 1)) (ert-select-tests `(member ,@operands) universe)) (and ;; Do these definitions of AND, NOT and OR satisfy de ;; Morgan's laws? Should they? - (case (length operands) + (cl-case (length operands) (0 (ert-select-tests 't universe)) - (t (ert-select-tests `(and ,@(rest operands)) - (ert-select-tests (first operands) + (t (ert-select-tests `(and ,@(cdr operands)) + (ert-select-tests (car operands) universe))))) (not - (assert (eql (length operands) 1)) + (cl-assert (eql (length operands) 1)) (let ((all-tests (ert-select-tests 't universe))) (ert--set-difference all-tests - (ert-select-tests (first operands) + (ert-select-tests (car operands) all-tests)))) (or - (case (length operands) + (cl-case (length operands) (0 (ert-select-tests 'nil universe)) - (t (ert--union (ert-select-tests (first operands) universe) - (ert-select-tests `(or ,@(rest operands)) + (t (ert--union (ert-select-tests (car operands) universe) + (ert-select-tests `(or ,@(cdr operands)) universe))))) (tag - (assert (eql (length operands) 1)) - (let ((tag (first operands))) + (cl-assert (eql (length operands) 1)) + (let ((tag (car operands))) (ert-select-tests `(satisfies ,(lambda (test) (member tag (ert-test-tags test)))) universe))) (satisfies - (assert (eql (length operands) 1)) - (ert--remove-if-not (first operands) + (cl-assert (eql (length operands) 1)) + (ert--remove-if-not (car operands) (ert-select-tests 't universe)))))))) (defun ert--insert-human-readable-selector (selector) @@ -1141,26 +1146,27 @@ contained in UNIVERSE." ;; `backtrace' slot of the result objects in the ;; `most-recent-result' slots of test case objects in (eql ...) or ;; (member ...) selectors. - (labels ((rec (selector) - ;; This code needs to match the etypecase in `ert-select-tests'. - (etypecase selector - ((or (member nil t - :new :failed :passed - :expected :unexpected) - string - symbol) - selector) - (ert-test - (if (ert-test-name selector) - (make-symbol (format "<%S>" (ert-test-name selector))) - (make-symbol "<unnamed test>"))) - (cons - (destructuring-bind (operator &rest operands) selector - (ecase operator - ((member eql and not or) - `(,operator ,@(mapcar #'rec operands))) - ((member tag satisfies) - selector))))))) + (cl-labels ((rec (selector) + ;; This code needs to match the etypecase in + ;; `ert-select-tests'. + (cl-etypecase selector + ((or (member nil t + :new :failed :passed + :expected :unexpected) + string + symbol) + selector) + (ert-test + (if (ert-test-name selector) + (make-symbol (format "<%S>" (ert-test-name selector))) + (make-symbol "<unnamed test>"))) + (cons + (cl-destructuring-bind (operator &rest operands) selector + (cl-ecase operator + ((member eql and not or) + `(,operator ,@(mapcar #'rec operands))) + ((member tag satisfies) + selector))))))) (insert (format "%S" (rec selector))))) @@ -1177,21 +1183,21 @@ contained in UNIVERSE." ;; that corresponds to this run in order to be able to update the ;; statistics correctly when a test is re-run interactively and has a ;; different result than before. -(defstruct ert--stats - (selector (assert nil)) +(cl-defstruct ert--stats + (selector (cl-assert nil)) ;; The tests, in order. - (tests (assert nil) :type vector) + (tests (cl-assert nil) :type vector) ;; A map of test names (or the test objects themselves for unnamed ;; tests) to indices into the `tests' vector. - (test-map (assert nil) :type hash-table) + (test-map (cl-assert nil) :type hash-table) ;; The results of the tests during this run, in order. - (test-results (assert nil) :type vector) + (test-results (cl-assert nil) :type vector) ;; The start times of the tests, in order, as reported by ;; `current-time'. - (test-start-times (assert nil) :type vector) + (test-start-times (cl-assert nil) :type vector) ;; The end times of the tests, in order, as reported by ;; `current-time'. - (test-end-times (assert nil) :type vector) + (test-end-times (cl-assert nil) :type vector) (passed-expected 0) (passed-unexpected 0) (failed-expected 0) @@ -1241,21 +1247,25 @@ Also changes the counters in STATS to match." (results (ert--stats-test-results stats)) (old-test (aref tests pos)) (map (ert--stats-test-map stats))) - (flet ((update (d) - (if (ert-test-result-expected-p (aref tests pos) - (aref results pos)) - (etypecase (aref results pos) - (ert-test-passed (incf (ert--stats-passed-expected stats) d)) - (ert-test-failed (incf (ert--stats-failed-expected stats) d)) - (null) - (ert-test-aborted-with-non-local-exit) - (ert-test-quit)) - (etypecase (aref results pos) - (ert-test-passed (incf (ert--stats-passed-unexpected stats) d)) - (ert-test-failed (incf (ert--stats-failed-unexpected stats) d)) - (null) - (ert-test-aborted-with-non-local-exit) - (ert-test-quit))))) + (cl-flet ((update (d) + (if (ert-test-result-expected-p (aref tests pos) + (aref results pos)) + (cl-etypecase (aref results pos) + (ert-test-passed + (cl-incf (ert--stats-passed-expected stats) d)) + (ert-test-failed + (cl-incf (ert--stats-failed-expected stats) d)) + (null) + (ert-test-aborted-with-non-local-exit) + (ert-test-quit)) + (cl-etypecase (aref results pos) + (ert-test-passed + (cl-incf (ert--stats-passed-unexpected stats) d)) + (ert-test-failed + (cl-incf (ert--stats-failed-unexpected stats) d)) + (null) + (ert-test-aborted-with-non-local-exit) + (ert-test-quit))))) ;; Adjust counters to remove the result that is currently in stats. (update -1) ;; Put new test and result into stats. @@ -1273,11 +1283,11 @@ Also changes the counters in STATS to match." SELECTOR is the selector that was used to select TESTS." (setq tests (ert--coerce-to-vector tests)) (let ((map (make-hash-table :size (length tests)))) - (loop for i from 0 - for test across tests - for key = (ert--stats-test-key test) do - (assert (not (gethash key map))) - (setf (gethash key map) i)) + (cl-loop for i from 0 + for test across tests + for key = (ert--stats-test-key test) do + (cl-assert (not (gethash key map))) + (setf (gethash key map) i)) (make-ert--stats :selector selector :tests tests :test-map map @@ -1319,8 +1329,8 @@ SELECTOR is the selector that was used to select TESTS." (force-mode-line-update) (unwind-protect (progn - (loop for test in tests do - (ert-run-or-rerun-test stats test listener)) + (cl-loop for test in tests do + (ert-run-or-rerun-test stats test listener)) (setq abortedp nil)) (setf (ert--stats-aborted-p stats) abortedp) (setf (ert--stats-end-time stats) (current-time)) @@ -1344,7 +1354,7 @@ SELECTOR is the selector that was used to select TESTS." "Return a character that represents the test result RESULT. EXPECTEDP specifies whether the result was expected." - (let ((s (etypecase result + (let ((s (cl-etypecase result (ert-test-passed ".P") (ert-test-failed "fF") (null "--") @@ -1356,7 +1366,7 @@ EXPECTEDP specifies whether the result was expected." "Return a string that represents the test result RESULT. EXPECTEDP specifies whether the result was expected." - (let ((s (etypecase result + (let ((s (cl-etypecase result (ert-test-passed '("passed" "PASSED")) (ert-test-failed '("failed" "FAILED")) (null '("unknown" "UNKNOWN")) @@ -1378,9 +1388,9 @@ Ensures a final newline is inserted." "Insert `ert-info' infos from RESULT into current buffer. RESULT must be an `ert-test-result-with-condition'." - (check-type result ert-test-result-with-condition) + (cl-check-type result ert-test-result-with-condition) (dolist (info (ert-test-result-with-condition-infos result)) - (destructuring-bind (prefix . message) info + (cl-destructuring-bind (prefix . message) info (let ((begin (point)) (indentation (make-string (+ (length prefix) 4) ?\s)) (end nil)) @@ -1416,14 +1426,14 @@ Returns the stats object." (ert-run-tests selector (lambda (event-type &rest event-args) - (ecase event-type + (cl-ecase event-type (run-started - (destructuring-bind (stats) event-args + (cl-destructuring-bind (stats) event-args (message "Running %s tests (%s)" (length (ert--stats-tests stats)) (ert--format-time-iso8601 (ert--stats-start-time stats))))) (run-ended - (destructuring-bind (stats abortedp) event-args + (cl-destructuring-bind (stats abortedp) event-args (let ((unexpected (ert-stats-completed-unexpected stats)) (expected-failures (ert--stats-failed-expected stats))) (message "\n%sRan %s tests, %s results as expected%s (%s)%s\n" @@ -1441,19 +1451,19 @@ Returns the stats object." (format "\n%s expected failures" expected-failures))) (unless (zerop unexpected) (message "%s unexpected results:" unexpected) - (loop for test across (ert--stats-tests stats) - for result = (ert-test-most-recent-result test) do - (when (not (ert-test-result-expected-p test result)) - (message "%9s %S" - (ert-string-for-test-result result nil) - (ert-test-name test)))) + (cl-loop for test across (ert--stats-tests stats) + for result = (ert-test-most-recent-result test) do + (when (not (ert-test-result-expected-p test result)) + (message "%9s %S" + (ert-string-for-test-result result nil) + (ert-test-name test)))) (message "%s" ""))))) (test-started ) (test-ended - (destructuring-bind (stats test result) event-args + (cl-destructuring-bind (stats test result) event-args (unless (ert-test-result-expected-p test result) - (etypecase result + (cl-etypecase result (ert-test-passed (message "Test %S passed unexpectedly" (ert-test-name test))) (ert-test-result-with-condition @@ -1479,7 +1489,7 @@ Returns the stats object." (ert--pp-with-indentation-and-newline (ert-test-result-with-condition-condition result))) (goto-char (1- (point-max))) - (assert (looking-at "\n")) + (cl-assert (looking-at "\n")) (delete-char 1) (message "Test %S condition:" (ert-test-name test)) (message "%s" (buffer-string)))) @@ -1527,7 +1537,7 @@ the tests)." (1 font-lock-keyword-face nil t) (2 font-lock-function-name-face nil t))))) -(defun* ert--remove-from-list (list-var element &key key test) +(cl-defun ert--remove-from-list (list-var element &key key test) "Remove ELEMENT from the value of LIST-VAR if present. This can be used as an inverse of `add-to-list'." @@ -1552,7 +1562,7 @@ If ADD-DEFAULT-TO-PROMPT is non-nil, PROMPT will be modified to include the default, if any. Signals an error if no test name was read." - (etypecase default + (cl-etypecase default (string (let ((symbol (intern-soft default))) (unless (and symbol (ert-test-boundp symbol)) (setq default nil)))) @@ -1609,11 +1619,11 @@ Nothing more than an interactive interface to `ert-make-test-unbound'." ;;; Display of test progress and results. ;; An entry in the results buffer ewoc. There is one entry per test. -(defstruct ert--ewoc-entry - (test (assert nil)) +(cl-defstruct ert--ewoc-entry + (test (cl-assert nil)) ;; If the result of this test was expected, its ewoc entry is hidden ;; initially. - (hidden-p (assert nil)) + (hidden-p (cl-assert nil)) ;; An ewoc entry may be collapsed to hide details such as the error ;; condition. ;; @@ -1689,7 +1699,7 @@ Also sets `ert--results-progress-bar-button-begin'." ((ert--stats-current-test stats) 'running) ((ert--stats-end-time stats) 'finished) (t 'preparing)))) - (ecase state + (cl-ecase state (preparing (insert "")) (aborted @@ -1700,12 +1710,12 @@ Also sets `ert--results-progress-bar-button-begin'." (t (insert "Aborted.")))) (running - (assert (ert--stats-current-test stats)) + (cl-assert (ert--stats-current-test stats)) (insert "Running test: ") (ert-insert-test-name-button (ert-test-name (ert--stats-current-test stats)))) (finished - (assert (not (ert--stats-current-test stats))) + (cl-assert (not (ert--stats-current-test stats))) (insert "Finished."))) (insert "\n") (if (ert--stats-end-time stats) @@ -1808,7 +1818,7 @@ non-nil, returns the face for expected results.." (defun ert-face-for-stats (stats) "Return a face that represents STATS." (cond ((ert--stats-aborted-p stats) 'nil) - ((plusp (ert-stats-completed-unexpected stats)) + ((cl-plusp (ert-stats-completed-unexpected stats)) (ert-face-for-test-result nil)) ((eql (ert-stats-completed-expected stats) (ert-stats-total stats)) (ert-face-for-test-result t)) @@ -1819,7 +1829,7 @@ non-nil, returns the face for expected results.." (let* ((test (ert--ewoc-entry-test entry)) (stats ert--results-stats) (result (let ((pos (ert--stats-test-pos stats test))) - (assert pos) + (cl-assert pos) (aref (ert--stats-test-results stats) pos))) (hiddenp (ert--ewoc-entry-hidden-p entry)) (expandedp (ert--ewoc-entry-expanded-p entry)) @@ -1845,7 +1855,7 @@ non-nil, returns the face for expected results.." (ert--string-first-line (ert-test-documentation test)) 'font-lock-face 'font-lock-doc-face) "\n")) - (etypecase result + (cl-etypecase result (ert-test-passed (if (ert-test-result-expected-p test result) (insert " passed\n") @@ -1903,9 +1913,10 @@ BUFFER-NAME, if non-nil, is the buffer name to use." (make-string (ert-stats-total stats) (ert-char-for-test-result nil t))) (set (make-local-variable 'ert--results-listener) listener) - (loop for test across (ert--stats-tests stats) do - (ewoc-enter-last ewoc - (make-ert--ewoc-entry :test test :hidden-p t))) + (cl-loop for test across (ert--stats-tests stats) do + (ewoc-enter-last ewoc + (make-ert--ewoc-entry :test test + :hidden-p t))) (ert--results-update-ewoc-hf ert--results-ewoc ert--results-stats) (goto-char (1- (point-max))) buffer))))) @@ -1940,21 +1951,21 @@ and how to display message." default nil)) nil)) (unless message-fn (setq message-fn 'message)) - (lexical-let ((output-buffer-name output-buffer-name) - buffer - listener - (message-fn message-fn)) + (let ((output-buffer-name output-buffer-name) + buffer + listener + (message-fn message-fn)) (setq listener (lambda (event-type &rest event-args) - (ecase event-type + (cl-ecase event-type (run-started - (destructuring-bind (stats) event-args + (cl-destructuring-bind (stats) event-args (setq buffer (ert--setup-results-buffer stats listener output-buffer-name)) (pop-to-buffer buffer))) (run-ended - (destructuring-bind (stats abortedp) event-args + (cl-destructuring-bind (stats abortedp) event-args (funcall message-fn "%sRan %s tests, %s results were as expected%s" (if (not abortedp) @@ -1971,19 +1982,19 @@ and how to display message." ert--results-ewoc) stats))) (test-started - (destructuring-bind (stats test) event-args + (cl-destructuring-bind (stats test) event-args (with-current-buffer buffer (let* ((ewoc ert--results-ewoc) (pos (ert--stats-test-pos stats test)) (node (ewoc-nth ewoc pos))) - (assert node) + (cl-assert node) (setf (ert--ewoc-entry-test (ewoc-data node)) test) (aset ert--results-progress-bar-string pos (ert-char-for-test-result nil t)) (ert--results-update-stats-display-maybe ewoc stats) (ewoc-invalidate ewoc node))))) (test-ended - (destructuring-bind (stats test result) event-args + (cl-destructuring-bind (stats test result) event-args (with-current-buffer buffer (let* ((ewoc ert--results-ewoc) (pos (ert--stats-test-pos stats test)) @@ -2015,28 +2026,28 @@ and how to display message." (define-derived-mode ert-results-mode special-mode "ERT-Results" "Major mode for viewing results of ERT test runs.") -(loop for (key binding) in - '(;; Stuff that's not in the menu. - ("\t" forward-button) - ([backtab] backward-button) - ("j" ert-results-jump-between-summary-and-result) - ("L" ert-results-toggle-printer-limits-for-test-at-point) - ("n" ert-results-next-test) - ("p" ert-results-previous-test) - ;; Stuff that is in the menu. - ("R" ert-results-rerun-all-tests) - ("r" ert-results-rerun-test-at-point) - ("d" ert-results-rerun-test-at-point-debugging-errors) - ("." ert-results-find-test-at-point-other-window) - ("b" ert-results-pop-to-backtrace-for-test-at-point) - ("m" ert-results-pop-to-messages-for-test-at-point) - ("l" ert-results-pop-to-should-forms-for-test-at-point) - ("h" ert-results-describe-test-at-point) - ("D" ert-delete-test) - ("T" ert-results-pop-to-timings) - ) - do - (define-key ert-results-mode-map key binding)) +(cl-loop for (key binding) in + '( ;; Stuff that's not in the menu. + ("\t" forward-button) + ([backtab] backward-button) + ("j" ert-results-jump-between-summary-and-result) + ("L" ert-results-toggle-printer-limits-for-test-at-point) + ("n" ert-results-next-test) + ("p" ert-results-previous-test) + ;; Stuff that is in the menu. + ("R" ert-results-rerun-all-tests) + ("r" ert-results-rerun-test-at-point) + ("d" ert-results-rerun-test-at-point-debugging-errors) + ("." ert-results-find-test-at-point-other-window) + ("b" ert-results-pop-to-backtrace-for-test-at-point) + ("m" ert-results-pop-to-messages-for-test-at-point) + ("l" ert-results-pop-to-should-forms-for-test-at-point) + ("h" ert-results-describe-test-at-point) + ("D" ert-delete-test) + ("T" ert-results-pop-to-timings) + ) + do + (define-key ert-results-mode-map key binding)) (easy-menu-define ert-results-mode-menu ert-results-mode-map "Menu for `ert-results-mode'." @@ -2116,15 +2127,15 @@ To be used in the ERT results buffer." EWOC-FN specifies the direction and should be either `ewoc-prev' or `ewoc-next'. If there are no more nodes in that direction, an error is signaled with the message ERROR-MESSAGE." - (loop + (cl-loop (setq node (funcall ewoc-fn ert--results-ewoc node)) (when (null node) (error "%s" error-message)) (unless (ert--ewoc-entry-hidden-p (ewoc-data node)) (goto-char (ewoc-location node)) - (return)))) + (cl-return)))) -(defun ert--results-expand-collapse-button-action (button) +(defun ert--results-expand-collapse-button-action (_button) "Expand or collapse the test node BUTTON belongs to." (let* ((ewoc ert--results-ewoc) (node (save-excursion @@ -2153,11 +2164,11 @@ To be used in the ERT results buffer." (defun ert--ewoc-position (ewoc node) ;; checkdoc-order: nil "Return the position of NODE in EWOC, or nil if NODE is not in EWOC." - (loop for i from 0 - for node-here = (ewoc-nth ewoc 0) then (ewoc-next ewoc node-here) - do (when (eql node node-here) - (return i)) - finally (return nil))) + (cl-loop for i from 0 + for node-here = (ewoc-nth ewoc 0) then (ewoc-next ewoc node-here) + do (when (eql node node-here) + (cl-return i)) + finally (cl-return nil))) (defun ert-results-jump-between-summary-and-result () "Jump back and forth between the test run summary and individual test results. @@ -2205,7 +2216,7 @@ To be used in the ERT results buffer." "Return the test at point, or nil. To be used in the ERT results buffer." - (assert (eql major-mode 'ert-results-mode)) + (cl-assert (eql major-mode 'ert-results-mode)) (if (ert--results-test-node-or-null-at-point) (let* ((node (ert--results-test-node-at-point)) (test (ert--ewoc-entry-test (ewoc-data node)))) @@ -2277,9 +2288,9 @@ definition." (point)) ((eventp last-command-event) (posn-point (event-start last-command-event))) - (t (assert nil)))) + (t (cl-assert nil)))) -(defun ert--results-progress-bar-button-action (button) +(defun ert--results-progress-bar-button-action (_button) "Jump to details for the test represented by the character clicked in BUTTON." (goto-char (ert--button-action-position)) (ert-results-jump-between-summary-and-result)) @@ -2289,7 +2300,7 @@ definition." To be used in the ERT results buffer." (interactive) - (assert (eql major-mode 'ert-results-mode)) + (cl-assert (eql major-mode 'ert-results-mode)) (let ((selector (ert--stats-selector ert--results-stats))) (ert-run-tests-interactively selector (buffer-name)))) @@ -2298,13 +2309,13 @@ To be used in the ERT results buffer." To be used in the ERT results buffer." (interactive) - (destructuring-bind (test redefinition-state) + (cl-destructuring-bind (test redefinition-state) (ert--results-test-at-point-allow-redefinition) (when (null test) (error "No test at point")) (let* ((stats ert--results-stats) (progress-message (format "Running %stest %S" - (ecase redefinition-state + (cl-ecase redefinition-state ((nil) "") (redefined "new definition of ") (deleted "deleted ")) @@ -2345,7 +2356,7 @@ To be used in the ERT results buffer." (stats ert--results-stats) (pos (ert--stats-test-pos stats test)) (result (aref (ert--stats-test-results stats) pos))) - (etypecase result + (cl-etypecase result (ert-test-passed (error "Test passed, no backtrace available")) (ert-test-result-with-condition (let ((backtrace (ert-test-result-with-condition-backtrace result)) @@ -2403,13 +2414,14 @@ To be used in the ERT results buffer." (ert-simple-view-mode) (if (null (ert-test-result-should-forms result)) (insert "\n(No should forms during this test.)\n") - (loop for form-description in (ert-test-result-should-forms result) - for i from 1 do - (insert "\n") - (insert (format "%s: " i)) - (let ((begin (point))) - (ert--pp-with-indentation-and-newline form-description) - (ert--make-xrefs-region begin (point))))) + (cl-loop for form-description + in (ert-test-result-should-forms result) + for i from 1 do + (insert "\n") + (insert (format "%s: " i)) + (let ((begin (point))) + (ert--pp-with-indentation-and-newline form-description) + (ert--make-xrefs-region begin (point))))) (goto-char (point-min)) (insert "`should' forms executed during test `") (ert-insert-test-name-button (ert-test-name test)) @@ -2438,17 +2450,16 @@ To be used in the ERT results buffer." To be used in the ERT results buffer." (interactive) (let* ((stats ert--results-stats) - (start-times (ert--stats-test-start-times stats)) - (end-times (ert--stats-test-end-times stats)) (buffer (get-buffer-create "*ERT timings*")) - (data (loop for test across (ert--stats-tests stats) - for start-time across (ert--stats-test-start-times stats) - for end-time across (ert--stats-test-end-times stats) - collect (list test - (float-time (subtract-time end-time - start-time)))))) + (data (cl-loop for test across (ert--stats-tests stats) + for start-time across (ert--stats-test-start-times + stats) + for end-time across (ert--stats-test-end-times stats) + collect (list test + (float-time (subtract-time + end-time start-time)))))) (setq data (sort data (lambda (a b) - (> (second a) (second b))))) + (> (cl-second a) (cl-second b))))) (pop-to-buffer buffer) (let ((inhibit-read-only t)) (buffer-disable-undo) @@ -2457,13 +2468,13 @@ To be used in the ERT results buffer." (if (null data) (insert "(No data)\n") (insert (format "%-3s %8s %8s\n" "" "time" "cumul")) - (loop for (test time) in data - for cumul-time = time then (+ cumul-time time) - for i from 1 do - (let ((begin (point))) - (insert (format "%3s: %8.3f %8.3f " i time cumul-time)) - (ert-insert-test-name-button (ert-test-name test)) - (insert "\n")))) + (cl-loop for (test time) in data + for cumul-time = time then (+ cumul-time time) + for i from 1 do + (progn + (insert (format "%3s: %8.3f %8.3f " i time cumul-time)) + (ert-insert-test-name-button (ert-test-name test)) + (insert "\n")))) (goto-char (point-min)) (insert "Tests by run time (seconds):\n\n") (forward-line 1)))) @@ -2476,7 +2487,7 @@ To be used in the ERT results buffer." (error "Requires Emacs 24")) (let (test-name test-definition) - (etypecase test-or-test-name + (cl-etypecase test-or-test-name (symbol (setq test-name test-or-test-name test-definition (ert-get-test test-or-test-name))) (ert-test (setq test-name (ert-test-name test-or-test-name) diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index e3e5b321047..cf090e5e758 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -441,6 +441,26 @@ The return value is the last VAL in the list. `(logior (logand ,v ,mask) (logand ,getter (lognot ,mask)))))))))) +;;; References + +;;;###autoload +(defmacro gv-ref (place) + "Return a reference to PLACE. +This is like the `&' operator of the C language." + (gv-letplace (getter setter) place + `(cons (lambda () ,getter) + (lambda (gv--val) ,(funcall setter 'gv--val))))) + +(defsubst gv-deref (ref) + "Dereference REF, returning the referenced value. +This is like the `*' operator of the C language. +REF must have been previously obtained with `gv-ref'." + (funcall (car ref))) +;; Don't use `declare' because it seems to introduce circularity problems: +;; Warning: Eager macro-expansion skipped due to cycle: +;; … => (load "gv.el") => (macroexpand-all (defsubst gv-deref …)) => (macroexpand (defun …)) => (load "gv.el") +(gv-define-setter gv-deref (v ref) `(funcall (cdr ,ref) ,v)) + ;;; Vaguely related definitions that should be moved elsewhere. ;; (defun alist-get (key alist) diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el index 024790d7b4b..f2e691102d4 100644 --- a/lisp/emacs-lisp/lisp-mnt.el +++ b/lisp/emacs-lisp/lisp-mnt.el @@ -209,10 +209,10 @@ If the given section does not exist, return nil." The HEADER is the section string marking the beginning of the section. If the given section does not exist, return nil. -The end of the section is defined as the beginning of the next -section of the same level or lower. The function -`lisp-outline-level' is used to compute the level of a section. -If no such section exists, return the end of the buffer." +The section ends before the first non-comment text or the next +section of the same level or lower; whatever comes first. The +function `lisp-outline-level' is used to compute the level of +a section." (require 'outline) ;; for outline-regexp. (let ((start (lm-section-start header))) (when start @@ -230,9 +230,15 @@ If no such section exists, return the end of the buffer." (beginning-of-line) (lisp-outline-level)) level))) - (if next-section-found - (line-beginning-position) - (point-max))))))) + (min (if next-section-found + (progn (beginning-of-line 0) + (unless (looking-at " ") + (beginning-of-line 2)) + (point)) + (point-max)) + (progn (goto-char start) + (while (forward-comment 1)) + (point)))))))) (defsubst lm-code-start () "Return the buffer location of the `Code' start marker." @@ -283,13 +289,8 @@ The returned value is a list of strings, one per line." (when res (setq res (list res)) (forward-line 1) - (while (and (or (looking-at (concat lm-header-prefix "[\t ]+")) - (and (not (looking-at - (lm-get-header-re "\\sw\\(\\sw\\|\\s_\\)*"))) - (looking-at lm-header-prefix))) - (goto-char (match-end 0)) - (looking-at ".+")) - (setq res (cons (match-string-no-properties 0) res)) + (while (looking-at "^;+\\(\t\\|[\t\s]\\{2,\\}\\)\\(.+\\)") + (push (match-string-no-properties 2) res) (forward-line 1))) (nreverse res)))) @@ -307,10 +308,13 @@ If FILE is nil, execute BODY in the current buffer." (emacs-lisp-mode) ,@body) (save-excursion - ;; Switching major modes is too drastic, so just switch - ;; temporarily to the Emacs Lisp mode syntax table. - (with-syntax-table emacs-lisp-mode-syntax-table - ,@body)))))) + (save-restriction + (widen) + (goto-char (point-min)) + ;; Switching major modes is too drastic, so just switch + ;; temporarily to the Emacs Lisp mode syntax table. + (with-syntax-table emacs-lisp-mode-syntax-table + ,@body))))))) ;; Fixme: Probably this should be amalgamated with copyright.el; also ;; we need a check for ranges in copyright years. @@ -490,6 +494,14 @@ absent, return nil." (when start (buffer-substring-no-properties start (lm-commentary-end)))))) +(defun lm-homepage (&optional file) + "Return the homepage in file FILE, or current buffer if FILE is nil." + (let ((page (lm-with-file file + (lm-header "\\(?:x-\\)?\\(?:homepage\\|url\\)")))) + (if (and page (string-match "^<.+>$" page)) + (substring page 1 -1) + page))) + ;;; Verification and synopses (defun lm-insert-at-column (col &rest strings) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index fc1cfe7afd1..cd60d80b056 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -187,57 +187,50 @@ It has `lisp-mode-abbrev-table' as its parent." font-lock-string-face)))) font-lock-comment-face)) -(defun lisp-mode-variables (&optional lisp-syntax keywords-case-insensitive) +(defun lisp-mode-variables (&optional lisp-syntax keywords-case-insensitive + bar-not-symbol) "Common initialization routine for lisp modes. The LISP-SYNTAX argument is used by code in inf-lisp.el and is \(uselessly) passed from pp.el, chistory.el, gnus-kill.el and score-mode.el. KEYWORDS-CASE-INSENSITIVE non-nil means that for -font-lock keywords will not be case sensitive." +font-lock keywords will not be case sensitive. BAR-NOT-SYMBOL +non-nil means that | is not a symbol character." (when lisp-syntax (set-syntax-table lisp-mode-syntax-table)) - (make-local-variable 'paragraph-ignore-fill-prefix) - (setq paragraph-ignore-fill-prefix t) - (make-local-variable 'fill-paragraph-function) - (setq fill-paragraph-function 'lisp-fill-paragraph) + (setq-local paragraph-ignore-fill-prefix t) + (setq-local fill-paragraph-function 'lisp-fill-paragraph) ;; Adaptive fill mode gets the fill wrong for a one-line paragraph made of ;; a single docstring. Let's fix it here. - (set (make-local-variable 'adaptive-fill-function) - (lambda () (if (looking-at "\\s-+\"[^\n\"]+\"\\s-*$") ""))) + (setq-local adaptive-fill-function + (lambda () (if (looking-at "\\s-+\"[^\n\"]+\"\\s-*$") ""))) ;; Adaptive fill mode gets in the way of auto-fill, ;; and should make no difference for explicit fill ;; because lisp-fill-paragraph should do the job. ;; I believe that newcomment's auto-fill code properly deals with it -stef ;;(set (make-local-variable 'adaptive-fill-mode) nil) - (make-local-variable 'indent-line-function) - (setq indent-line-function 'lisp-indent-line) - (make-local-variable 'outline-regexp) - (setq outline-regexp ";;;\\(;* [^ \t\n]\\|###autoload\\)\\|(") - (make-local-variable 'outline-level) - (setq outline-level 'lisp-outline-level) - (make-local-variable 'comment-start) - (setq comment-start ";") - (make-local-variable 'comment-start-skip) + (setq-local indent-line-function 'lisp-indent-line) + (setq-local outline-regexp ";;;\\(;* [^ \t\n]\\|###autoload\\)\\|(") + (setq-local outline-level 'lisp-outline-level) + (setq-local add-log-current-defun-function #'lisp-current-defun-name) + (setq-local comment-start ";") ;; Look within the line for a ; following an even number of backslashes ;; after either a non-backslash or the line beginning. - (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *") - (make-local-variable 'font-lock-comment-start-skip) + (setq-local comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *") ;; Font lock mode uses this only when it KNOWS a comment is starting. - (setq font-lock-comment-start-skip ";+ *") - (make-local-variable 'comment-add) - (setq comment-add 1) ;default to `;;' in comment-region - (make-local-variable 'comment-column) - (setq comment-column 40) + (setq-local font-lock-comment-start-skip ";+ *") + (setq-local comment-add 1) ;default to `;;' in comment-region + (setq-local comment-column 40) ;; Don't get confused by `;' in doc strings when paragraph-filling. - (set (make-local-variable 'comment-use-global-state) t) - (make-local-variable 'imenu-generic-expression) - (setq imenu-generic-expression lisp-imenu-generic-expression) - (make-local-variable 'multibyte-syntax-as-symbol) - (setq multibyte-syntax-as-symbol t) - (set (make-local-variable 'syntax-begin-function) 'beginning-of-defun) + (setq-local comment-use-global-state t) + (setq-local imenu-generic-expression lisp-imenu-generic-expression) + (setq-local multibyte-syntax-as-symbol t) + (setq-local syntax-begin-function 'beginning-of-defun) (setq font-lock-defaults `((lisp-font-lock-keywords lisp-font-lock-keywords-1 lisp-font-lock-keywords-2) - nil ,keywords-case-insensitive (("+-*/.<>=!?$%_&~^:@" . "w")) nil + nil ,keywords-case-insensitive + ((,(concat "+-*/.<>=!?$%_&~^:@" (if bar-not-symbol "" "|")) . "w")) + nil (font-lock-mark-block-function . mark-defun) (font-lock-syntactic-face-function . lisp-font-lock-syntactic-face-function)))) @@ -249,6 +242,32 @@ font-lock keywords will not be case sensitive." 1000 len))) +(defun lisp-current-defun-name () + "Return the name of the defun at point, or nil." + (save-excursion + (let ((location (point))) + ;; If we are now precisely at the beginning of a defun, make sure + ;; beginning-of-defun finds that one rather than the previous one. + (or (eobp) (forward-char 1)) + (beginning-of-defun) + ;; Make sure we are really inside the defun found, not after it. + (when (and (looking-at "\\s(") + (progn (end-of-defun) + (< location (point))) + (progn (forward-sexp -1) + (>= location (point)))) + (if (looking-at "\\s(") + (forward-char 1)) + ;; Skip the defining construct name, typically "defun" or + ;; "defvar". + (forward-sexp 1) + ;; The second element is usually a symbol being defined. If it + ;; is not, use the first symbol in it. + (skip-chars-forward " \t\n'(") + (buffer-substring-no-properties (point) + (progn (forward-sexp 1) + (point))))))) + (defvar lisp-mode-shared-map (let ((map (make-sparse-keymap))) (define-key map "\e\C-q" 'indent-sexp) @@ -320,6 +339,22 @@ font-lock keywords will not be case sensitive." (bindings--define-key prof-map [prof-func] '(menu-item "Instrument Function..." elp-instrument-function :help "Instrument a function for profiling")) + ;; Maybe this should be in a separate submenu from the ELP stuff? + (bindings--define-key prof-map [sep-natprof] menu-bar-separator) + (bindings--define-key prof-map [prof-natprof-stop] + '(menu-item "Stop Native Profiler" profiler-stop + :help "Stop recording profiling information" + :enable (and (featurep 'profiler) + (profiler-running-p)))) + (bindings--define-key prof-map [prof-natprof-report] + '(menu-item "Show Profiler Report" profiler-report + :help "Show the current profiler report" + :enable (and (featurep 'profiler) + (profiler-running-p)))) + (bindings--define-key prof-map [prof-natprof-start] + '(menu-item "Start Native Profiler..." profiler-start + :help "Start recording profiling information")) + (bindings--define-key menu-map [lint] (cons "Linting" lint-map)) (bindings--define-key lint-map [lint-di] '(menu-item "Lint Directory..." elint-directory @@ -518,11 +553,10 @@ or to switch back to an existing one. Entry to this mode calls the value of `lisp-mode-hook' if that value is non-nil." - (lisp-mode-variables nil t) - (set (make-local-variable 'find-tag-default-function) 'lisp-find-tag-default) - (make-local-variable 'comment-start-skip) - (setq comment-start-skip - "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *") + (lisp-mode-variables nil t t) + (setq-local find-tag-default-function 'lisp-find-tag-default) + (setq-local comment-start-skip + "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *") (setq imenu-case-fold-search t)) (defun lisp-find-tag-default () @@ -816,6 +850,7 @@ this command arranges for all errors to enter the debugger." (defun eval-defun-1 (form) "Treat some expressions specially. Reset the `defvar' and `defcustom' variables to the initial value. +\(For `defcustom', use the :set function if there is one.) Reinitialize the face according to the `defface' specification." ;; The code in edebug-defun should be consistent with this, but not ;; the same, since this gets a macroexpanded form. @@ -831,14 +866,19 @@ Reinitialize the face according to the `defface' specification." ;; `custom-declare-variable' with a quoted value arg. ((and (eq (car form) 'custom-declare-variable) (default-boundp (eval (nth 1 form) lexical-binding))) - ;; Force variable to be bound. - (set-default (eval (nth 1 form) lexical-binding) - ;; The second arg is an expression that evaluates to - ;; an expression. The second evaluation is the one - ;; normally performed not be normal execution but by - ;; custom-initialize-set (for example), which does not - ;; use lexical-binding. - (eval (eval (nth 2 form) lexical-binding))) + ;; Force variable to be bound, using :set function if specified. + (let ((setfunc (memq :set form))) + (when setfunc + (setq setfunc (car-safe (cdr-safe setfunc))) + (or (functionp setfunc) (setq setfunc nil))) + (funcall (or setfunc 'set-default) + (eval (nth 1 form) lexical-binding) + ;; The second arg is an expression that evaluates to + ;; an expression. The second evaluation is the one + ;; normally performed not by normal execution but by + ;; custom-initialize-set (for example), which does not + ;; use lexical-binding. + (eval (eval (nth 2 form) lexical-binding)))) form) ;; `defface' is macroexpanded to `custom-declare-face'. ((eq (car form) 'custom-declare-face) @@ -847,21 +887,8 @@ Reinitialize the face according to the `defface' specification." (setq face-new-frame-defaults (assq-delete-all face-symbol face-new-frame-defaults)) (put face-symbol 'face-defface-spec nil) - (put face-symbol 'face-documentation (nth 3 form)) - ;; Setting `customized-face' to the new spec after calling - ;; the form, but preserving the old saved spec in `saved-face', - ;; imitates the situation when the new face spec is set - ;; temporarily for the current session in the customize - ;; buffer, thus allowing `face-user-default-spec' to use the - ;; new customized spec instead of the saved spec. - ;; Resetting `saved-face' temporarily to nil is needed to let - ;; `defface' change the spec, regardless of a saved spec. - (prog1 `(prog1 ,form - (put ,(nth 1 form) 'saved-face - ',(get face-symbol 'saved-face)) - (put ,(nth 1 form) 'customized-face - ,(nth 2 form))) - (put face-symbol 'saved-face nil)))) + (put face-symbol 'face-override-spec nil)) + form) ((eq (car form) 'progn) (cons 'progn (mapcar 'eval-defun-1 (cdr form)))) (t form))) @@ -914,11 +941,12 @@ Return the result of evaluation." If the current defun is actually a call to `defvar' or `defcustom', evaluating it this way resets the variable using its initial value -expression even if the variable already has some other value. -\(Normally `defvar' and `defcustom' do not alter the value if there -already is one.) In an analogous way, evaluating a `defface' -overrides any customizations of the face, so that it becomes -defined exactly as the `defface' expression says. +expression (using the defcustom's :set function if there is one), even +if the variable already has some other value. \(Normally `defvar' and +`defcustom' do not alter the value if there already is one.) In an +analogous way, evaluating a `defface' overrides any customizations of +the face, so that it becomes defined exactly as the `defface' expression +says. If `eval-expression-debug-on-error' is non-nil, which is the default, this command arranges for all errors to enter the debugger. diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 3bf08ee8a97..6bb796434fd 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -124,7 +124,10 @@ and also to avoid outputting the warning during normal execution." (macroexp--funcall-if-compiled ',when-compiled) ,form)) (t - (message "%s" msg) + (message "%s%s" (if (stringp load-file-name) + (concat (file-relative-name load-file-name) ": ") + "") + msg) form)))) (defun macroexp--obsolete-warning (fun obsolescence-data type) diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el new file mode 100644 index 00000000000..b0711fed26c --- /dev/null +++ b/lisp/emacs-lisp/nadvice.el @@ -0,0 +1,457 @@ +;;; nadvice.el --- Light-weight advice primitives for Elisp functions -*- lexical-binding: t -*- + +;; Copyright (C) 2012-2013 Free Software Foundation, Inc. + +;; Author: Stefan Monnier <monnier@iro.umontreal.ca> +;; Keywords: extensions, lisp, tools +;; Package: emacs + +;; This program 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. + +;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This package lets you add behavior (which we call "piece of advice") to +;; existing functions, like the old `advice.el' package, but with much fewer +;; bells ans whistles. It comes in 2 parts: +;; +;; - The first part lets you add/remove functions, similarly to +;; add/remove-hook, from any "place" (i.e. as accepted by `setf') that +;; holds a function. +;; This part provides mainly 2 macros: `add-function' and `remove-function'. +;; +;; - The second part provides `advice-add' and `advice-remove' which are +;; refined version of the previous macros specially tailored for the case +;; where the place that we want to modify is a `symbol-function'. + +;;; Code: + +;;;; Lightweight advice/hook +(defvar advice--where-alist + '((:around "\300\301\302\003#\207" 5) + (:before "\300\301\002\"\210\300\302\002\"\207" 4) + (:after "\300\302\002\"\300\301\003\"\210\207" 5) + (:after-until "\300\302\002\"\206\013\000\300\301\002\"\207" 4) + (:after-while "\300\302\002\"\205\013\000\300\301\002\"\207" 4) + (:before-until "\300\301\002\"\206\013\000\300\302\002\"\207" 4) + (:before-while "\300\301\002\"\205\013\000\300\302\002\"\207" 4)) + "List of descriptions of how to add a function. +Each element has the form (WHERE BYTECODE STACK) where: + WHERE is a keyword indicating where the function is added. + BYTECODE is the corresponding byte-code that will be used. + STACK is the amount of stack space needed by the byte-code.") + +(defvar advice--bytecodes (mapcar #'cadr advice--where-alist)) + +(defun advice--p (object) + (and (byte-code-function-p object) + (eq 128 (aref object 0)) + (memq (length object) '(5 6)) + (memq (aref object 1) advice--bytecodes) + (eq #'apply (aref (aref object 2) 0)))) + +(defsubst advice--car (f) (aref (aref f 2) 1)) +(defsubst advice--cdr (f) (aref (aref f 2) 2)) +(defsubst advice--props (f) (aref (aref f 2) 3)) + +(defun advice--make-docstring (_string function) + "Build the raw doc-string of SYMBOL, presumably advised." + (let ((flist (indirect-function function)) + (docstring nil)) + (if (eq 'macro (car-safe flist)) (setq flist (cdr flist))) + (while (advice--p flist) + (let ((bytecode (aref flist 1)) + (where nil)) + (dolist (elem advice--where-alist) + (if (eq bytecode (cadr elem)) (setq where (car elem)))) + (setq docstring + (concat + docstring + (propertize (format "%s advice: " where) + 'face 'warning) + (let ((fun (advice--car flist))) + (if (symbolp fun) (format "`%S'" fun) + (let* ((name (cdr (assq 'name (advice--props flist)))) + (doc (documentation fun t)) + (usage (help-split-fundoc doc function))) + (if usage (setq doc (cdr usage))) + (if name + (if doc + (format "%s\n%s" name doc) + (format "%s" name)) + (or doc "No documentation"))))) + "\n"))) + (setq flist (advice--cdr flist))) + (if docstring (setq docstring (concat docstring "\n"))) + (let* ((origdoc (unless (eq function flist) ;Avoid inf-loops. + (documentation flist t))) + (usage (help-split-fundoc origdoc function))) + (setq usage (if (null usage) + (let ((arglist (help-function-arglist flist))) + (format "%S" (help-make-usage function arglist))) + (setq origdoc (cdr usage)) (car usage))) + (help-add-fundoc-usage (concat docstring origdoc) usage)))) + +(defvar advice--docstring + ;; Can't eval-when-compile nor use defconst because it then gets pure-copied, + ;; which drops the text-properties. + ;;(eval-when-compile + (propertize "Advised function" + 'dynamic-docstring-function #'advice--make-docstring)) ;; ) + +(defun advice-eval-interactive-spec (spec) + "Evaluate the interactive spec SPEC." + (cond + ((stringp spec) + ;; There's no direct access to the C code (in call-interactively) that + ;; processes those specs, but that shouldn't stop us, should it? + ;; FIXME: Despite appearances, this is not faithful: SPEC and + ;; (advice-eval-interactive-spec SPEC) will behave subtly differently w.r.t + ;; command-history (and maybe a few other details). + (call-interactively `(lambda (&rest args) (interactive ,spec) args))) + ;; ((functionp spec) (funcall spec)) + (t (eval spec)))) + +(defun advice--make-interactive-form (function main) + ;; TODO: make it so that interactive spec can be a constant which + ;; dynamically checks the advice--car/cdr to do its job. + ;; For that, advice-eval-interactive-spec needs to be more faithful. + ;; FIXME: The calls to interactive-form below load autoloaded functions + ;; too eagerly. + (let ((fspec (cadr (interactive-form function)))) + (when (eq 'function (car-safe fspec)) ;; Macroexpanded lambda? + (setq fspec (nth 1 fspec))) + (if (functionp fspec) + `(funcall ',fspec + ',(cadr (interactive-form main))) + (cadr (or (interactive-form function) + (interactive-form main)))))) + +(defsubst advice--make-1 (byte-code stack-depth function main props) + "Build a function value that adds FUNCTION to MAIN." + (let ((adv-sig (gethash main advertised-signature-table)) + (advice + (apply #'make-byte-code 128 byte-code + (vector #'apply function main props) stack-depth + advice--docstring + (when (or (commandp function) (commandp main)) + (list (advice--make-interactive-form + function main)))))) + (when adv-sig (puthash advice adv-sig advertised-signature-table)) + advice)) + +(defun advice--make (where function main props) + "Build a function value that adds FUNCTION to MAIN at WHERE. +WHERE is a symbol to select an entry in `advice--where-alist'." + (let ((desc (assq where advice--where-alist))) + (unless desc (error "Unknown add-function location `%S'" where)) + (advice--make-1 (nth 1 desc) (nth 2 desc) + function main props))) + +(defun advice--member-p (function definition) + (let ((found nil)) + (while (and (not found) (advice--p definition)) + (if (or (equal function (advice--car definition)) + (equal function (cdr (assq 'name (advice--props definition))))) + (setq found t) + (setq definition (advice--cdr definition)))) + found)) + +(defun advice--tweak (flist tweaker) + (if (not (advice--p flist)) + (funcall tweaker nil flist nil) + (let ((first (advice--car flist)) + (rest (advice--cdr flist)) + (props (advice--props flist))) + (let ((val (funcall tweaker first rest props))) + (if val (car val) + (let ((nrest (advice--tweak rest tweaker))) + (if (eq rest nrest) flist + (advice--make-1 (aref flist 1) (aref flist 3) + first nrest props)))))))) + +;;;###autoload +(defun advice--remove-function (flist function) + (advice--tweak flist + (lambda (first rest props) + (cond ((not first) rest) + ((or (equal function first) + (equal function (cdr (assq 'name props)))) + (list rest)))))) + +(defvar advice--buffer-local-function-sample nil) + +(defun advice--set-buffer-local (var val) + (if (function-equal val advice--buffer-local-function-sample) + (kill-local-variable var) + (set (make-local-variable var) val))) + +;;;###autoload +(defun advice--buffer-local (var) + "Buffer-local value of VAR, presumed to contain a function." + (declare (gv-setter advice--set-buffer-local)) + (if (local-variable-p var) (symbol-value var) + (setq advice--buffer-local-function-sample + (lambda (&rest args) (apply (default-value var) args))))) + +;;;###autoload +(defmacro add-function (where place function &optional props) + ;; TODO: + ;; - obsolete with-wrapper-hook (mostly requires buffer-local support). + ;; - provide some kind of control over ordering. E.g. debug-on-entry, ELP + ;; and tracing want to stay first. + ;; - maybe let `where' specify some kind of predicate and use it + ;; to implement things like mode-local or eieio-defmethod. + ;; Of course, that only makes sense if the predicates of all advices can + ;; be combined and made more efficient. + ;; :before is like a normal add-hook on a normal hook. + ;; :before-while is like add-hook on run-hook-with-args-until-failure. + ;; :before-until is like add-hook on run-hook-with-args-until-success. + ;; Same with :after-* but for (add-hook ... 'append). + "Add a piece of advice on the function stored at PLACE. +FUNCTION describes the code to add. WHERE describes where to add it. +WHERE can be explained by showing the resulting new function, as the +result of combining FUNCTION and the previous value of PLACE, which we +call OLDFUN here: +`:before' (lambda (&rest r) (apply FUNCTION r) (apply OLDFUN r)) +`:after' (lambda (&rest r) (prog1 (apply OLDFUN r) (apply FUNCTION r))) +`:around' (lambda (&rest r) (apply FUNCTION OLDFUN r)) +`:before-while' (lambda (&rest r) (and (apply FUNCTION r) (apply OLDFUN r))) +`:before-until' (lambda (&rest r) (or (apply FUNCTION r) (apply OLDFUN r))) +`:after-while' (lambda (&rest r) (and (apply OLDFUN r) (apply FUNCTION r))) +`:after-until' (lambda (&rest r) (or (apply OLDFUN r) (apply FUNCTION r))) +If FUNCTION was already added, do nothing. +PROPS is an alist of additional properties, among which the following have +a special meaning: +- `name': a string or symbol. It can be used to refer to this piece of advice. + +PLACE cannot be a simple variable. Instead it should either be +\(default-value 'VAR) or (local 'VAR) depending on whether FUNCTION +should be applied to VAR buffer-locally or globally. + +If one of FUNCTION or OLDFUN is interactive, then the resulting function +is also interactive. There are 3 cases: +- FUNCTION is not interactive: the interactive spec of OLDFUN is used. +- The interactive spec of FUNCTION is itself a function: it should take one + argument (the interactive spec of OLDFUN, which it can pass to + `advice-eval-interactive-spec') and return the list of arguments to use. +- Else, use the interactive spec of FUNCTION and ignore the one of OLDFUN." + (declare (debug t)) ;;(indent 2) + (cond ((eq 'local (car-safe place)) + (setq place `(advice--buffer-local ,@(cdr place)))) + ((symbolp place) + (error "Use (default-value '%S) or (local '%S)" place place))) + `(advice--add-function ,where (gv-ref ,place) ,function ,props)) + +;;;###autoload +(defun advice--add-function (where ref function props) + (unless (advice--member-p function (gv-deref ref)) + (setf (gv-deref ref) + (advice--make where function (gv-deref ref) props)))) + +(defmacro remove-function (place function) + "Remove the FUNCTION piece of advice from PLACE. +If FUNCTION was not added to PLACE, do nothing. +Instead of FUNCTION being the actual function, it can also be the `name' +of the piece of advice." + (declare (debug t)) + (cond ((eq 'local (car-safe place)) + (setq place `(advice--buffer-local ,@(cdr place)))) + ((symbolp place) + (error "Use (default-value '%S) or (local '%S)" place place))) + (gv-letplace (getter setter) place + (macroexp-let2 nil new `(advice--remove-function ,getter ,function) + `(unless (eq ,new ,getter) ,(funcall setter new))))) + +;;;; Specific application of add-function to `symbol-function' for advice. + +(defun advice--subst-main (old new) + (advice--tweak old + (lambda (first _rest _props) (if (not first) new)))) + +(defun advice--normalize (symbol def) + (cond + ((special-form-p def) + ;; Not worth the trouble trying to handle this, I think. + (error "advice-add failure: %S is a special form" symbol)) + ((and (symbolp def) + (eq 'macro (car-safe (ignore-errors (indirect-function def))))) + (let ((newval (cons 'macro (cdr (indirect-function def))))) + (put symbol 'advice--saved-rewrite (cons def newval)) + newval)) + ;; `f' might be a pure (hence read-only) cons! + ((and (eq 'macro (car-safe def)) + (not (ignore-errors (setcdr def (cdr def)) t))) + (cons 'macro (cdr def))) + (t def))) + +(defsubst advice--strip-macro (x) + (if (eq 'macro (car-safe x)) (cdr x) x)) + +(defun advice--defalias-fset (fsetfun symbol newdef) + (when (get symbol 'advice--saved-rewrite) + (put symbol 'advice--saved-rewrite nil)) + (setq newdef (advice--normalize symbol newdef)) + (let* ((olddef (advice--strip-macro + (if (fboundp symbol) (symbol-function symbol)))) + (oldadv + (cond + ((null (get symbol 'advice--pending)) + (or olddef + (progn + (message "Delayed advice activation failed for %s: no data" + symbol) + nil))) + ((or (not olddef) (autoloadp olddef)) + (prog1 (get symbol 'advice--pending) + (put symbol 'advice--pending nil))) + (t (message "Dropping left-over advice--pending for %s" symbol) + (put symbol 'advice--pending nil) + olddef)))) + (let* ((snewdef (advice--strip-macro newdef)) + (snewadv (advice--subst-main oldadv snewdef))) + (funcall (or fsetfun #'fset) symbol + (if (eq snewdef newdef) snewadv (cons 'macro snewadv)))))) + + +;;;###autoload +(defun advice-add (symbol where function &optional props) + "Like `add-function' but for the function named SYMBOL. +Contrary to `add-function', this will properly handle the cases where SYMBOL +is defined as a macro, alias, command, ..." + ;; TODO: + ;; - record the advice location, to display in describe-function. + ;; - change all defadvice in lisp/**/*.el. + ;; - rewrite advice.el on top of this. + ;; - obsolete advice.el. + (let* ((f (and (fboundp symbol) (symbol-function symbol))) + (nf (advice--normalize symbol f))) + (unless (eq f nf) ;; Most importantly, if nf == nil! + (fset symbol nf)) + (add-function where (cond + ((eq (car-safe nf) 'macro) (cdr nf)) + ;; Reasons to delay installation of the advice: + ;; - If the function is not yet defined, installing + ;; the advice would affect `fboundp'ness. + ;; - If it's an autoloaded command, + ;; advice--make-interactive-form would end up + ;; loading the command eagerly. + ;; - `autoload' does nothing if the function is + ;; not an autoload or undefined. + ((or (not nf) (autoloadp nf)) + (get symbol 'advice--pending)) + (t (symbol-function symbol))) + function props) + (add-function :around (get symbol 'defalias-fset-function) + #'advice--defalias-fset)) + nil) + +;;;###autoload +(defun advice-remove (symbol function) + "Like `remove-function' but for the function named SYMBOL. +Contrary to `remove-function', this will work also when SYMBOL is a macro +and it will not signal an error if SYMBOL is not `fboundp'. +Instead of the actual function to remove, FUNCTION can also be the `name' +of the piece of advice." + (when (fboundp symbol) + (let ((f (symbol-function symbol))) + ;; Can't use the `if' place here, because the body is too large, + ;; resulting in use of code that only works with lexical-scoping. + (remove-function (if (eq (car-safe f) 'macro) + (cdr f) + (symbol-function symbol)) + function) + (unless (advice--p + (if (eq (car-safe f) 'macro) (cdr f) (symbol-function symbol))) + ;; Not advised any more. + (remove-function (get symbol 'defalias-fset-function) + #'advice--defalias-fset) + (if (eq (symbol-function symbol) + (cdr (get symbol 'advice--saved-rewrite))) + (fset symbol (car (get symbol 'advice--saved-rewrite)))))) + nil)) + +;; (defun advice-mapc (fun symbol) +;; "Apply FUN to every function added as advice to SYMBOL. +;; FUN is called with a two arguments: the function that was added, and the +;; properties alist that was specified when it was added." +;; (let ((def (or (get symbol 'advice--pending) +;; (if (fboundp symbol) (symbol-function symbol))))) +;; (while (advice--p def) +;; (funcall fun (advice--car def) (advice--props def)) +;; (setq def (advice--cdr def))))) + +;;;###autoload +(defun advice-member-p (advice function-name) + "Return non-nil if ADVICE has been added to FUNCTION-NAME. +Instead of ADVICE being the actual function, it can also be the `name' +of the piece of advice." + (advice--member-p advice + (or (get function-name 'advice--pending) + (advice--strip-macro + (if (fboundp function-name) + (symbol-function function-name)))))) + +;; When code is advised, called-interactively-p needs to be taught to skip +;; the advising frames. +;; FIXME: This Major Ugly Hack won't handle calls to called-interactively-p +;; done from the advised function if the deepest advice is an around advice! +;; In other cases (calls from an advice or calls from the advised function when +;; the deepest advice is not an around advice), it should hopefully get +;; it right. +(add-hook 'called-interactively-p-functions + #'advice--called-interactively-skip) +(defun advice--called-interactively-skip (origi frame1 frame2) + (let* ((i origi) + (get-next-frame + (lambda () + (setq frame1 frame2) + (setq frame2 (internal--called-interactively-p--get-frame i)) + ;; (message "Advice Frame %d = %S" i frame2) + (setq i (1+ i))))) + (when (and (eq (nth 1 frame2) 'apply) + (progn + (funcall get-next-frame) + (advice--p (indirect-function (nth 1 frame2))))) + (funcall get-next-frame) + ;; If we now have the symbol, this was the head advice and + ;; we're done. + (while (advice--p (nth 1 frame1)) + ;; This was an inner advice called from some earlier advice. + ;; The stack frames look different depending on the particular + ;; kind of the earlier advice. + (let ((inneradvice (nth 1 frame1))) + (if (and (eq (nth 1 frame2) 'apply) + (progn + (funcall get-next-frame) + (advice--p (indirect-function + (nth 1 frame2))))) + ;; The earlier advice was something like a before/after + ;; advice where the "next" code is called directly by the + ;; advice--p object. + (funcall get-next-frame) + ;; It's apparently an around advice, where the "next" is + ;; called by the body of the advice in any way it sees fit, + ;; so we need to skip the frames of that body. + (while + (progn + (funcall get-next-frame) + (not (and (eq (nth 1 frame2) 'apply) + (eq (nth 3 frame2) inneradvice))))) + (funcall get-next-frame) + (funcall get-next-frame)))) + (- i origi 1)))) + + +(provide 'nadvice) +;;; nadvice.el ends here diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 69834810d11..e000c343721 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -431,30 +431,31 @@ MATCH is the pattern that needs to be matched, of the form: (match ,symd . ,(pcase--upat (cdr qpat)))) :pcase--fail))) ;; A QPattern but not for a cons, can only go to the `else' side. - ((eq (car-safe pat) '\`) (cons :pcase--fail nil)) + ((eq (car-safe pat) '\`) '(:pcase--fail . nil)) ((and (eq (car-safe pat) 'pred) (or (member (cons 'consp (cadr pat)) pcase-mutually-exclusive-predicates) (member (cons (cadr pat) 'consp) pcase-mutually-exclusive-predicates))) - (cons :pcase--fail nil)))) + '(:pcase--fail . nil)))) (defun pcase--split-equal (elem pat) (cond ;; The same match will give the same result. ((and (eq (car-safe pat) '\`) (equal (cadr pat) elem)) - (cons :pcase--succeed :pcase--fail)) + '(:pcase--succeed . :pcase--fail)) ;; A different match will fail if this one succeeds. ((and (eq (car-safe pat) '\`) ;; (or (integerp (cadr pat)) (symbolp (cadr pat)) ;; (consp (cadr pat))) ) - (cons :pcase--fail nil)) + '(:pcase--fail . nil)) ((and (eq (car-safe pat) 'pred) (symbolp (cadr pat)) - (get (cadr pat) 'side-effect-free) - (funcall (cadr pat) elem)) - (cons :pcase--succeed nil)))) + (get (cadr pat) 'side-effect-free)) + (if (funcall (cadr pat) elem) + '(:pcase--succeed . nil) + '(:pcase--fail . nil))))) (defun pcase--split-member (elems pat) ;; Based on pcase--split-equal. @@ -462,7 +463,7 @@ MATCH is the pattern that needs to be matched, of the form: ;; The same match (or a match of membership in a superset) will ;; give the same result, but we don't know how to check it. ;; (??? - ;; (cons :pcase--succeed nil)) + ;; '(:pcase--succeed . nil)) ;; A match for one of the elements may succeed or fail. ((and (eq (car-safe pat) '\`) (member (cadr pat) elems)) nil) @@ -471,7 +472,7 @@ MATCH is the pattern that needs to be matched, of the form: ;; (or (integerp (cadr pat)) (symbolp (cadr pat)) ;; (consp (cadr pat))) ) - (cons :pcase--fail nil)) + '(:pcase--fail . nil)) ((and (eq (car-safe pat) 'pred) (symbolp (cadr pat)) (get (cadr pat) 'side-effect-free) @@ -479,21 +480,21 @@ MATCH is the pattern that needs to be matched, of the form: (dolist (elem elems) (unless (funcall p elem) (setq all nil))) all)) - (cons :pcase--succeed nil)))) + '(:pcase--succeed . nil)))) (defun pcase--split-pred (upat pat) ;; FIXME: For predicates like (pred (> a)), two such predicates may ;; actually refer to different variables `a'. (let (test) (cond - ((equal upat pat) (cons :pcase--succeed :pcase--fail)) + ((equal upat pat) '(:pcase--succeed . :pcase--fail)) ((and (eq 'pred (car upat)) (eq 'pred (car-safe pat)) (or (member (cons (cadr upat) (cadr pat)) pcase-mutually-exclusive-predicates) (member (cons (cadr pat) (cadr upat)) pcase-mutually-exclusive-predicates))) - (cons :pcase--fail nil)) + '(:pcase--fail . nil)) ((and (eq 'pred (car upat)) (eq '\` (car-safe pat)) (symbolp (cadr upat)) @@ -502,8 +503,8 @@ MATCH is the pattern that needs to be matched, of the form: (ignore-errors (setq test (list (funcall (cadr upat) (cadr pat)))))) (if (car test) - (cons nil :pcase--fail) - (cons :pcase--fail nil)))))) + '(nil . :pcase--fail) + '(:pcase--fail . nil)))))) (defun pcase--fgrep (vars sexp) "Check which of the symbols VARS appear in SEXP." diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index 3eaacd24ec8..8b019d0a785 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -307,13 +307,13 @@ This function is called, by name, directly by the C code." ;; Run handler. ;; We do this after rescheduling so that the handler function ;; can cancel its own timer successfully with cancel-timer. - (condition-case nil + (condition-case-unless-debug err ;; Timer functions should not change the current buffer. ;; If they do, all kinds of nasty surprises can happen, ;; and it can be hellish to track down their source. (save-current-buffer (apply (timer--function timer) (timer--args timer))) - (error nil)) + (error (message "Error in timer: %S" err))) (if retrigger (setf (timer--triggered timer) nil))) (error "Bogus timer event")))) diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el index 3e55b7c88fa..09c4969cf18 100644 --- a/lisp/emacs-lisp/trace.el +++ b/lisp/emacs-lisp/trace.el @@ -1,4 +1,4 @@ -;;; trace.el --- tracing facility for Emacs Lisp functions +;;; trace.el --- tracing facility for Emacs Lisp functions -*- lexical-binding: t -*- ;; Copyright (C) 1993, 1998, 2000-2013 Free Software Foundation, Inc. @@ -38,11 +38,6 @@ ;; generation of trace output won't interfere with what you are currently ;; doing. -;; Requirement: -;; ============ -;; trace.el needs advice.el version 2.0 or later which you can get from the -;; same place from where you got trace.el. - ;; Restrictions: ;; ============= ;; - Traced subrs when called interactively will always show nil as the @@ -55,17 +50,6 @@ ;; + Macros that were expanded during compilation ;; - All the restrictions that apply to advice.el -;; Installation: -;; ============= -;; Put this file together with advice.el (version 2.0 or later) somewhere -;; into your Emacs `load-path', byte-compile it/them for efficiency, and -;; put the following autoload declarations into your .emacs -;; -;; (autoload 'trace-function "trace" "Trace a function" t) -;; (autoload 'trace-function-background "trace" "Trace a function" t) -;; -;; or explicitly load it with (require 'trace) or (load "trace"). - ;; Usage: ;; ====== ;; - To trace a function say `M-x trace-function' which will ask you for the @@ -151,18 +135,15 @@ ;;; Code: -(require 'advice) - (defgroup trace nil "Tracing facility for Emacs Lisp functions." :prefix "trace-" :group 'lisp) ;;;###autoload -(defcustom trace-buffer (purecopy "*trace-output*") +(defcustom trace-buffer "*trace-output*" "Trace output will by default go to that buffer." - :type 'string - :group 'trace) + :type 'string) ;; Current level of traced function invocation: (defvar trace-level 0) @@ -176,78 +157,111 @@ (defvar inhibit-trace nil "If non-nil, all tracing is temporarily inhibited.") -(defun trace-entry-message (function level argument-bindings) - ;; Generates a string that describes that FUNCTION has been entered at - ;; trace LEVEL with ARGUMENT-BINDINGS. - (format "%s%s%d -> %s: %s\n" - (mapconcat 'char-to-string (make-string (1- level) ?|) " ") - (if (> level 1) " " "") - level - function - (let ((print-circle t)) - (mapconcat (lambda (binding) - (concat - (symbol-name (ad-arg-binding-field binding 'name)) - "=" - ;; do this so we'll see strings: - (prin1-to-string - (ad-arg-binding-field binding 'value)))) - argument-bindings - " ")))) - -(defun trace-exit-message (function level value) - ;; Generates a string that describes that FUNCTION has been exited at - ;; trace LEVEL and that it returned VALUE. - (format "%s%s%d <- %s: %s\n" - (mapconcat 'char-to-string (make-string (1- level) ?|) " ") - (if (> level 1) " " "") - level - function - ;; do this so we'll see strings: - (let ((print-circle t)) (prin1-to-string value)))) - -(defun trace-make-advice (function buffer background) - ;; Builds the piece of advice to be added to FUNCTION's advice info - ;; so that it will generate the proper trace output in BUFFER - ;; (quietly if BACKGROUND is t). - (ad-make-advice - trace-advice-name nil t - `(advice - lambda () - (let ((trace-level (1+ trace-level)) - (trace-buffer (get-buffer-create ,buffer))) - (unless inhibit-trace - (with-current-buffer trace-buffer - (set (make-local-variable 'window-point-insertion-type) t) - ,(unless background '(display-buffer trace-buffer)) - (goto-char (point-max)) - ;; Insert a separator from previous trace output: - (if (= trace-level 1) (insert trace-separator)) - (insert - (trace-entry-message - ',function trace-level ad-arg-bindings)))) - ad-do-it - (unless inhibit-trace - (with-current-buffer trace-buffer - ,(unless background '(display-buffer trace-buffer)) - (goto-char (point-max)) - (insert - (trace-exit-message - ',function trace-level ad-return-value)))))))) - -(defun trace-function-internal (function buffer background) - ;; Adds trace advice for FUNCTION and activates it. - (ad-add-advice - function - (trace-make-advice function (or buffer trace-buffer) background) - 'around 'last) - (ad-activate function nil)) +(defun trace-entry-message (function level args context) + "Generate a string that describes that FUNCTION has been entered. +LEVEL is the trace level, ARGS is the list of arguments passed to FUNCTION, +and CONTEXT is a string describing the dynamic context (e.g. values of +some global variables)." + (let ((print-circle t)) + (format "%s%s%d -> %S%s\n" + (mapconcat 'char-to-string (make-string (1- level) ?|) " ") + (if (> level 1) " " "") + level + ;; FIXME: Make it so we can click the function name to jump to its + ;; definition and/or untrace it. + (cons function args) + context))) + +(defun trace-exit-message (function level value context) + "Generate a string that describes that FUNCTION has exited. +LEVEL is the trace level, VALUE value returned by FUNCTION, +and CONTEXT is a string describing the dynamic context (e.g. values of +some global variables)." + (let ((print-circle t)) + (format "%s%s%d <- %s: %S%s\n" + (mapconcat 'char-to-string (make-string (1- level) ?|) " ") + (if (> level 1) " " "") + level + function + ;; Do this so we'll see strings: + value + context))) + +(defvar trace--timer nil) + +(defun trace-make-advice (function buffer background context) + "Build the piece of advice to be added to trace FUNCTION. +FUNCTION is the name of the traced function. +BUFFER is the buffer where the trace should be printed. +BACKGROUND if nil means to display BUFFER. +CONTEXT if non-nil should be a function that returns extra info that should +be printed along with the arguments in the trace." + (lambda (body &rest args) + (let ((trace-level (1+ trace-level)) + (trace-buffer (get-buffer-create buffer)) + (ctx (funcall context))) + (unless inhibit-trace + (with-current-buffer trace-buffer + (set (make-local-variable 'window-point-insertion-type) t) + (unless (or background trace--timer + (get-buffer-window trace-buffer 'visible)) + (setq trace--timer + ;; Postpone the display to some later time, in case we + ;; can't actually do it now. + (run-with-timer 0 nil + (lambda () + (setq trace--timer nil) + (display-buffer trace-buffer))))) + (goto-char (point-max)) + ;; Insert a separator from previous trace output: + (if (= trace-level 1) (insert trace-separator)) + (insert + (trace-entry-message + function trace-level args ctx)))) + (let ((result)) + (unwind-protect + (setq result (list (apply body args))) + (unless inhibit-trace + (let ((ctx (funcall context))) + (with-current-buffer trace-buffer + (unless background (display-buffer trace-buffer)) + (goto-char (point-max)) + (insert + (trace-exit-message + function + trace-level + (if result (car result) '\!non-local\ exit\!) + ctx)))))) + (car result))))) + +(defun trace-function-internal (function buffer background context) + "Add trace advice for FUNCTION." + (advice-add + function :around + (trace-make-advice function (or buffer trace-buffer) background + (or context (lambda () ""))) + `((name . ,trace-advice-name)))) (defun trace-is-traced (function) - (ad-find-advice function 'around trace-advice-name)) + (advice-member-p trace-advice-name function)) + +(defun trace--read-args (prompt) + (cons + (intern (completing-read prompt obarray 'fboundp t)) + (when current-prefix-arg + (list + (read-buffer "Output to buffer: " trace-buffer) + (let ((exp + (let ((minibuffer-completing-symbol t)) + (read-from-minibuffer "Context expression: " + nil read-expression-map t + 'read-expression-history)))) + (lambda () + (let ((print-circle t)) + (concat " [" (prin1-to-string (eval exp t)) "]")))))))) ;;;###autoload -(defun trace-function (function &optional buffer) +(defun trace-function-foreground (function &optional buffer context) "Traces FUNCTION with trace output going to BUFFER. For every call of FUNCTION Lisp-style trace messages that display argument and return values will be inserted into BUFFER. This function generates the @@ -257,31 +271,19 @@ Do not use this to trace functions that switch buffers or do any other display oriented stuff, use `trace-function-background' instead. To untrace a function, use `untrace-function' or `untrace-all'." - (interactive - (list - (intern (completing-read "Trace function: " obarray 'fboundp t)) - (read-buffer "Output to buffer: " trace-buffer))) - (trace-function-internal function buffer nil)) + (interactive (trace--read-args "Trace function: ")) + (trace-function-internal function buffer nil context)) ;;;###autoload -(defun trace-function-background (function &optional buffer) +(defun trace-function-background (function &optional buffer context) "Traces FUNCTION with trace output going quietly to BUFFER. -When this tracing is enabled, every call to FUNCTION writes -a Lisp-style trace message (showing the arguments and return value) -into BUFFER. This function generates advice to trace FUNCTION -and activates it together with any other advice there might be. -The trace output goes to BUFFER quietly, without changing -the window or buffer configuration. - -BUFFER defaults to `trace-buffer'. +Like `trace-function-foreground' but without popping up the trace BUFFER or +changing the window configuration." + (interactive (trace--read-args "Trace function in background: ")) + (trace-function-internal function buffer t context)) -To untrace a function, use `untrace-function' or `untrace-all'." - (interactive - (list - (intern - (completing-read "Trace function in background: " obarray 'fboundp t)) - (read-buffer "Output to buffer: " trace-buffer))) - (trace-function-internal function buffer t)) +;;;###autoload +(defalias 'trace-function 'trace-function-foreground) (defun untrace-function (function) "Untraces FUNCTION and possibly activates all remaining advice. @@ -289,16 +291,14 @@ Activation is performed with `ad-update', hence remaining advice will get activated only if the advice of FUNCTION is currently active. If FUNCTION was not traced this is a noop." (interactive - (list (ad-read-advised-function "Untrace function" 'trace-is-traced))) - (when (trace-is-traced function) - (ad-remove-advice function 'around trace-advice-name) - (ad-update function))) + (list (intern (completing-read "Untrace function: " + obarray #'trace-is-traced t)))) + (advice-remove function trace-advice-name)) (defun untrace-all () "Untraces all currently traced functions." (interactive) - (ad-do-advised-functions (function) - (untrace-function function))) + (mapatoms #'untrace-function)) (provide 'trace) diff --git a/lisp/env.el b/lisp/env.el index 9e3aed95f8a..5618404cb67 100644 --- a/lisp/env.el +++ b/lisp/env.el @@ -57,31 +57,28 @@ If it is also not t, RET does not exit if it does non-null completion." ;; History list for VALUE argument to setenv. (defvar setenv-history nil) +(defconst env--substitute-vars-regexp + "\\$\\(?:\\(?1:[[:alnum:]_]+\\)\\|{\\(?1:[^{}]+\\)}\\|\\$\\)") -(defun substitute-env-vars (string) +(defun substitute-env-vars (string &optional only-defined) "Substitute environment variables referred to in STRING. `$FOO' where FOO is an environment variable name means to substitute the value of that variable. The variable name should be terminated with a character not a letter, digit or underscore; otherwise, enclose the entire variable name in braces. For instance, in `ab$cd-x', `$cd' is treated as an environment variable. +If ONLY-DEFINED is nil, references to undefined environment variables +are replaced by the empty string; if it is non-nil, they are left unchanged. Use `$$' to insert a single dollar sign." (let ((start 0)) - (while (string-match - (eval-when-compile - (rx (or (and "$" (submatch (1+ (regexp "[[:alnum:]_]")))) - (and "${" (submatch (minimal-match (0+ anything))) "}") - "$$"))) - string start) + (while (string-match env--substitute-vars-regexp string start) (cond ((match-beginning 1) (let ((value (getenv (match-string 1 string)))) + (if (and (null value) only-defined) + (setq start (match-end 0)) (setq string (replace-match (or value "") t t string) - start (+ (match-beginning 0) (length value))))) - ((match-beginning 2) - (let ((value (getenv (match-string 2 string)))) - (setq string (replace-match (or value "") t t string) - start (+ (match-beginning 0) (length value))))) + start (+ (match-beginning 0) (length value)))))) (t (setq string (replace-match "$" t t string) start (+ (match-beginning 0) 1))))) @@ -185,7 +182,7 @@ VARIABLE should be a string. Value is nil if VARIABLE is undefined in the environment. Otherwise, value is a string. If optional parameter FRAME is non-nil, then it should be a -frame. This function will look up VARIABLE in its 'environment +frame. This function will look up VARIABLE in its `environment' parameter. Otherwise, this function searches `process-environment' for diff --git a/lisp/epg.el b/lisp/epg.el index 340fc76fb8c..3f04aa2e07a 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -37,6 +37,8 @@ (defvar epg-key-id nil) (defvar epg-context nil) (defvar epg-debug-buffer nil) +(defvar epg-agent-file nil) +(defvar epg-agent-mtime nil) ;; from gnupg/include/cipher.h (defconst epg-cipher-algorithm-alist @@ -161,6 +163,7 @@ (defvar epg-prompt-alist nil) (put 'epg-error 'error-conditions '(epg-error error)) +(put 'epg-error 'error-message "GPG error") (defun epg-make-data-from-file (file) "Make a data object from FILE." @@ -970,7 +973,8 @@ This function is for internal use only." "Convert SIGNATURE to a human readable string." (let* ((user-id (cdr (assoc (epg-signature-key-id signature) epg-user-id-alist))) - (pubkey-algorithm (epg-signature-pubkey-algorithm signature))) + (pubkey-algorithm (epg-signature-pubkey-algorithm signature)) + (key-id (epg-signature-key-id signature))) (concat (cond ((eq (epg-signature-status signature) 'good) "Good signature from ") @@ -984,7 +988,7 @@ This function is for internal use only." "Signature made by revoked key ") ((eq (epg-signature-status signature) 'no-pubkey) "No public key for ")) - (epg-signature-key-id signature) + key-id (if user-id (concat " " (if (stringp user-id) @@ -1130,12 +1134,12 @@ This function is for internal use only." (if (eq (epg-context-protocol context) 'CMS) epg-gpgsm-program epg-gpg-program))) - (let* ((args (append (list "--no-tty" + (let* ((agent-info (getenv "GPG_AGENT_INFO")) + (args (append (list "--no-tty" "--status-fd" "1" "--yes") (if (and (not (eq (epg-context-protocol context) 'CMS)) - (string-match ":" (or (getenv "GPG_AGENT_INFO") - ""))) + (string-match ":" (or agent-info ""))) '("--use-agent")) (if (and (not (eq (epg-context-protocol context) 'CMS)) (epg-context-progress-callback context)) @@ -1152,16 +1156,45 @@ This function is for internal use only." (coding-system-for-write 'binary) (coding-system-for-read 'binary) process-connection-type + (process-environment process-environment) (orig-mode (default-file-modes)) (buffer (generate-new-buffer " *epg*")) - process) + process + terminal-name + agent-file + (agent-mtime '(0 0 0 0))) + ;; Set GPG_TTY and TERM for pinentry-curses. Note that we can't + ;; use `terminal-name' here to get the real pty name for the child + ;; process, though /dev/fd/0" is not portable. + (unless (memq system-type '(ms-dos windows-nt)) + (with-temp-buffer + (condition-case nil + (when (= (call-process "tty" "/dev/fd/0" t) 0) + (delete-char -1) + (setq terminal-name (buffer-string))) + (file-error)))) + (when terminal-name + (setq process-environment + (cons (concat "GPG_TTY=" terminal-name) + (cons "TERM=xterm" process-environment)))) + ;; Record modified time of gpg-agent socket to restore the Emacs + ;; frame on text terminal in `epg-wait-for-completion'. + ;; See + ;; <http://lists.gnu.org/archive/html/emacs-devel/2007-02/msg00755.html> + ;; for more details. + (when (and agent-info (string-match "\\(.*\\):[0-9]+:[0-9]+" agent-info)) + (setq agent-file (match-string 1 agent-info) + agent-mtime (or (nth 5 (file-attributes agent-file)) '(0 0 0 0)))) (if epg-debug (save-excursion (unless epg-debug-buffer (setq epg-debug-buffer (generate-new-buffer " *epg-debug*"))) (set-buffer epg-debug-buffer) (goto-char (point-max)) - (insert (format "%s %s\n" + (insert (if agent-info + (format "GPG_AGENT_INFO=%s\n" agent-info) + "GPG_AGENT_INFO is not set\n") + (format "%s %s\n" (if (eq (epg-context-protocol context) 'CMS) epg-gpgsm-program epg-gpg-program) @@ -1180,7 +1213,11 @@ This function is for internal use only." (make-local-variable 'epg-key-id) (setq epg-key-id nil) (make-local-variable 'epg-context) - (setq epg-context context)) + (setq epg-context context) + (make-local-variable 'epg-agent-file) + (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) @@ -1257,6 +1294,13 @@ This function is for internal use only." (accept-process-output (epg-context-process context) 1)) ;; This line is needed to run the process-filter right now. (sleep-for 0.1) + ;; Restore Emacs frame on text terminal, when pinentry-curses has terminated. + (if (with-current-buffer (process-buffer (epg-context-process context)) + (and epg-agent-file + (> (float-time (or (nth 5 (file-attributes epg-agent-file)) + '(0 0 0 0))) + (float-time epg-agent-mtime)))) + (redraw-frame (selected-frame))) (epg-context-set-result-for context 'error (nreverse (epg-context-result-for context 'error)))) diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog index c0a204c80b3..bbe551c735d 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog @@ -1,4 +1,46 @@ -2012-11-13 Glenn Morris <rgm@gnu.org> +2013-01-11 Dmitry Antipov <dmantipov@yandex.ru> + + * erc-dcc.el (erc-dcc-send-file): Use point-min-marker. + (erc-dcc-chat-setup): Use point-max-marker. + +2013-01-04 Glenn Morris <rgm@gnu.org> + + * erc-backend.el (312): Fix typo. (Bug#13235) + +2012-11-30 Glenn Morris <rgm@gnu.org> + + * erc.el (erc-accidental-paste-threshold-seconds): Add :version. + +2012-11-30 Eric Hanchrow <eric.hanchrow@gmail.com> + + * erc.el (erc-last-input-time): New variable. + (erc-accidental-paste-threshold-seconds): New option to avoid + sending accidentally-pasted text to the server (Bug#11592). + (erc-send-current-line): Use it. + +2012-11-30 Chong Yidong <cyd@gnu.org> + + * erc.el (erc-lurker-cleanup, erc-lurker-p): Use float-time. + +2012-11-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * erc-backend.el: Fix last change that missed calls to `second' + (bug#12970). + +2012-11-19 Stefan Monnier <monnier@iro.umontreal.ca> + + Use cl-lib instead of cl, and interactive-p => called-interactively-p. + * erc-track.el, erc-networks.el, erc-netsplit.el, erc-dcc.el: + * erc-backend.el: Use cl-lib, nth, pcase, and called-interactively-p + instead of cl. + * erc-speedbar.el, erc-services.el, erc-pcomplete.el, erc-notify.el: + * erc-match.el, erc-log.el, erc-join.el, erc-ezbounce.el: + * erc-capab.el: Don't require cl since we don't use it. + * erc.el: Use cl-lib, nth, pcase, and called-interactively-p i.s.o cl. + (erc-lurker-ignore-chars, erc-common-server-suffixes): + Move before first use. + +2012-11-16 Glenn Morris <rgm@gnu.org> * erc.el (erc-modules): Add "notifications". Tweak "hecomplete" doc. diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index bdcffc42f55..3d3ac791f08 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -98,7 +98,7 @@ ;;; Code: (require 'erc-compat) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;; There's a fairly strong mutual dependency between erc.el and erc-backend.el. ;; Luckily, erc.el does not need erc-backend.el for macroexpansion whereas the ;; reverse is true: @@ -109,7 +109,7 @@ (defvar erc-server-responses (make-hash-table :test #'equal) "Hashtable mapping server responses to their handler hooks.") -(defstruct (erc-response (:conc-name erc-response.)) +(cl-defstruct (erc-response (:conc-name erc-response.)) (unparsed "" :type string) (sender "" :type string) (command "" :type string) @@ -950,7 +950,7 @@ PROCs `process-buffer' is `current-buffer' when this function is called." (push str (erc-response.command-args msg)))) (setf (erc-response.contents msg) - (first (erc-response.command-args msg))) + (car (erc-response.command-args msg))) (setf (erc-response.command-args msg) (nreverse (erc-response.command-args msg))) @@ -1045,7 +1045,7 @@ Finds hooks by looking in the `erc-server-responses' hashtable." (name &rest name) &optional sexp sexp def-body)) -(defmacro* define-erc-response-handler ((name &rest aliases) +(cl-defmacro define-erc-response-handler ((name &rest aliases) &optional extra-fn-doc extra-var-doc &rest fn-body) "Define an ERC handler hook/function pair. @@ -1154,11 +1154,11 @@ add things to `%s' instead." "") name hook-name)) (fn-alternates - (loop for alias in aliases - collect (intern (format "erc-server-%s" alias)))) + (cl-loop for alias in aliases + collect (intern (format "erc-server-%s" alias)))) (var-alternates - (loop for alias in aliases - collect (intern (format "erc-server-%s-functions" alias))))) + (cl-loop for alias in aliases + collect (intern (format "erc-server-%s-functions" alias))))) `(prog2 ;; Normal hook variable. (defvar ,hook-name ',fn-name ,(format hook-doc name)) @@ -1172,19 +1172,19 @@ add things to `%s' instead." (put ',hook-name 'definition-name ',name) ;; Hashtable map of responses to hook variables - ,@(loop for response in (cons name aliases) - for var in (cons hook-name var-alternates) - collect `(puthash ,(format "%s" response) ',var - erc-server-responses)) + ,@(cl-loop for response in (cons name aliases) + for var in (cons hook-name var-alternates) + collect `(puthash ,(format "%s" response) ',var + erc-server-responses)) ;; Alternates. ;; Functions are defaliased, hook variables are defvared so we ;; can add hooks to one alias, but not another. - ,@(loop for fn in fn-alternates - for var in var-alternates - for a in aliases - nconc (list `(defalias ',fn ',fn-name) - `(defvar ,var ',fn-name ,(format hook-doc a)) - `(put ',var 'definition-name ',hook-name)))))) + ,@(cl-loop for fn in fn-alternates + for var in var-alternates + for a in aliases + nconc (list `(defalias ',fn ',fn-name) + `(defvar ,var ',fn-name ,(format hook-doc a)) + `(put ',var 'definition-name ',hook-name)))))) (define-erc-response-handler (ERROR) "Handle an ERROR command from the server." nil @@ -1196,10 +1196,10 @@ add things to `%s' instead." (define-erc-response-handler (INVITE) "Handle invitation messages." nil - (let ((target (first (erc-response.command-args parsed))) + (let ((target (car (erc-response.command-args parsed))) (chnl (erc-response.contents parsed))) - (multiple-value-bind (nick login host) - (values-list (erc-parse-user (erc-response.sender parsed))) + (pcase-let ((`(,nick ,login ,host) + (erc-parse-user (erc-response.sender parsed)))) (setq erc-invitation chnl) (when (string= target (erc-current-nick)) (erc-display-message @@ -1212,8 +1212,8 @@ add things to `%s' instead." nil (let ((chnl (erc-response.contents parsed)) (buffer nil)) - (multiple-value-bind (nick login host) - (values-list (erc-parse-user (erc-response.sender parsed))) + (pcase-let ((`(,nick ,login ,host) + (erc-parse-user (erc-response.sender parsed)))) ;; strip the stupid combined JOIN facility (IRC 2.9) (if (string-match "^\\(.*\\)?\^g.*$" chnl) (setq chnl (match-string 1 chnl))) @@ -1249,12 +1249,12 @@ add things to `%s' instead." (define-erc-response-handler (KICK) "Handle kick messages received from the server." nil - (let* ((ch (first (erc-response.command-args parsed))) - (tgt (second (erc-response.command-args parsed))) + (let* ((ch (nth 0 (erc-response.command-args parsed))) + (tgt (nth 1 (erc-response.command-args parsed))) (reason (erc-trim-string (erc-response.contents parsed))) (buffer (erc-get-buffer ch proc))) - (multiple-value-bind (nick login host) - (values-list (erc-parse-user (erc-response.sender parsed))) + (pcase-let ((`(,nick ,login ,host) + (erc-parse-user (erc-response.sender parsed)))) (erc-remove-channel-member buffer tgt) (cond ((string= tgt (erc-current-nick)) @@ -1277,11 +1277,11 @@ add things to `%s' instead." (define-erc-response-handler (MODE) "Handle server mode changes." nil - (let ((tgt (first (erc-response.command-args parsed))) + (let ((tgt (car (erc-response.command-args parsed))) (mode (mapconcat 'identity (cdr (erc-response.command-args parsed)) " "))) - (multiple-value-bind (nick login host) - (values-list (erc-parse-user (erc-response.sender parsed))) + (pcase-let ((`(,nick ,login ,host) + (erc-parse-user (erc-response.sender parsed)))) (erc-log (format "MODE: %s -> %s: %s" nick tgt mode)) ;; dirty hack (let ((buf (cond ((erc-channel-p tgt) @@ -1305,8 +1305,8 @@ add things to `%s' instead." "Handle nick change messages." nil (let ((nn (erc-response.contents parsed)) bufs) - (multiple-value-bind (nick login host) - (values-list (erc-parse-user (erc-response.sender parsed))) + (pcase-let ((`(,nick ,login ,host) + (erc-parse-user (erc-response.sender parsed)))) (setq bufs (erc-buffer-list-with-nick nick proc)) (erc-log (format "NICK: %s -> %s" nick nn)) ;; if we had a query with this user, make sure future messages will be @@ -1340,11 +1340,11 @@ add things to `%s' instead." (define-erc-response-handler (PART) "Handle part messages." nil - (let* ((chnl (first (erc-response.command-args parsed))) + (let* ((chnl (car (erc-response.command-args parsed))) (reason (erc-trim-string (erc-response.contents parsed))) (buffer (erc-get-buffer chnl proc))) - (multiple-value-bind (nick login host) - (values-list (erc-parse-user (erc-response.sender parsed))) + (pcase-let ((`(,nick ,login ,host) + (erc-parse-user (erc-response.sender parsed)))) (erc-remove-channel-member buffer nick) (erc-display-message parsed 'notice buffer 'PART ?n nick ?u login @@ -1361,7 +1361,7 @@ add things to `%s' instead." (define-erc-response-handler (PING) "Handle ping messages." nil - (let ((pinger (first (erc-response.command-args parsed)))) + (let ((pinger (car (erc-response.command-args parsed)))) (erc-log (format "PING: %s" pinger)) ;; ping response to the server MUST be forced, or you can lose big (erc-server-send (format "PONG :%s" pinger) t) @@ -1379,7 +1379,7 @@ add things to `%s' instead." (when erc-verbose-server-ping (erc-display-message parsed 'notice proc 'PONG - ?h (first (erc-response.command-args parsed)) ?i erc-server-lag + ?h (car (erc-response.command-args parsed)) ?i erc-server-lag ?s (if (/= erc-server-lag 1) "s" ""))) (erc-update-mode-line)))) @@ -1451,8 +1451,8 @@ add things to `%s' instead." "Another user has quit IRC." nil (let ((reason (erc-response.contents parsed)) bufs) - (multiple-value-bind (nick login host) - (values-list (erc-parse-user (erc-response.sender parsed))) + (pcase-let ((`(,nick ,login ,host) + (erc-parse-user (erc-response.sender parsed)))) (setq bufs (erc-buffer-list-with-nick nick proc)) (erc-remove-user nick) (setq reason (erc-wash-quit-reason reason nick login host)) @@ -1462,12 +1462,12 @@ add things to `%s' instead." (define-erc-response-handler (TOPIC) "The channel topic has changed." nil - (let* ((ch (first (erc-response.command-args parsed))) + (let* ((ch (car (erc-response.command-args parsed))) (topic (erc-trim-string (erc-response.contents parsed))) (time (format-time-string erc-server-timestamp-format (current-time)))) - (multiple-value-bind (nick login host) - (values-list (erc-parse-user (erc-response.sender parsed))) + (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-topic ch (format "%s\C-o (%s, %s)" topic nick time)) (erc-display-message parsed 'notice (erc-get-buffer ch proc) @@ -1477,8 +1477,8 @@ add things to `%s' instead." (define-erc-response-handler (WALLOPS) "Display a WALLOPS message." nil (let ((message (erc-response.contents parsed))) - (multiple-value-bind (nick login host) - (values-list (erc-parse-user (erc-response.sender parsed))) + (pcase-let ((`(,nick ,login ,host) + (erc-parse-user (erc-response.sender parsed)))) (erc-display-message parsed 'notice nil 'WALLOPS ?n nick ?m message)))) @@ -1486,7 +1486,7 @@ add things to `%s' instead." (define-erc-response-handler (001) "Set `erc-server-current-nick' to reflect server settings and display the welcome message." nil - (erc-set-current-nick (first (erc-response.command-args parsed))) + (erc-set-current-nick (car (erc-response.command-args parsed))) (erc-update-mode-line) ; needed here? (setq erc-nick-change-attempt-count 0) (setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick))) @@ -1507,16 +1507,16 @@ add things to `%s' instead." (define-erc-response-handler (004) "Display the server's identification." nil - (multiple-value-bind (server-name server-version) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,server-name ,server-version) + (cdr (erc-response.command-args parsed)))) (setq erc-server-version server-version) (setq erc-server-announced-name server-name) (erc-update-mode-line-buffer (process-buffer proc)) (erc-display-message parsed 'notice proc 's004 ?s server-name ?v server-version - ?U (fourth (erc-response.command-args parsed)) - ?C (fifth (erc-response.command-args parsed))))) + ?U (nth 3 (erc-response.command-args parsed)) + ?C (nth 4 (erc-response.command-args parsed))))) (define-erc-response-handler (005) "Set the variable `erc-server-parameters' and display the received message. @@ -1547,7 +1547,7 @@ A server may send more than one 005 message." (define-erc-response-handler (221) "Display the current user modes." nil - (let* ((nick (first (erc-response.command-args parsed))) + (let* ((nick (car (erc-response.command-args parsed))) (modes (mapconcat 'identity (cdr (erc-response.command-args parsed)) " "))) (erc-set-modes nick modes) @@ -1556,17 +1556,17 @@ A server may send more than one 005 message." (define-erc-response-handler (252) "Display the number of IRC operators online." nil (erc-display-message parsed 'notice 'active 's252 - ?i (second (erc-response.command-args parsed)))) + ?i (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (253) "Display the number of unknown connections." nil (erc-display-message parsed 'notice 'active 's253 - ?i (second (erc-response.command-args parsed)))) + ?i (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (254) "Display the number of channels formed." nil (erc-display-message parsed 'notice 'active 's254 - ?i (second (erc-response.command-args parsed)))) + ?i (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (250 251 255 256 257 258 259 265 266 377 378) "Generic display of server messages as notices. @@ -1576,8 +1576,8 @@ See `erc-display-server-message'." nil (define-erc-response-handler (275) "Display secure connection message." nil - (multiple-value-bind (nick user message) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,nick ,user ,message) + (cdr (erc-response.command-args parsed)))) (erc-display-message parsed 'notice 'active 's275 ?n nick @@ -1590,13 +1590,13 @@ See `erc-display-server-message'." nil (define-erc-response-handler (301) "AWAY notice." nil (erc-display-message parsed 'notice 'active 's301 - ?n (second (erc-response.command-args parsed)) + ?n (cadr (erc-response.command-args parsed)) ?r (erc-response.contents parsed))) (define-erc-response-handler (303) "ISON reply" nil (erc-display-message parsed 'notice 'active 's303 - ?n (second (erc-response.command-args parsed)))) + ?n (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (305) "Return from AWAYness." nil @@ -1612,8 +1612,8 @@ See `erc-display-server-message'." nil (define-erc-response-handler (307) "Display nick-identified message." nil - (multiple-value-bind (nick user message) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,nick ,user ,message) + (cdr (erc-response.command-args parsed)))) (erc-display-message parsed 'notice 'active 's307 ?n nick @@ -1624,8 +1624,8 @@ See `erc-display-server-message'." nil "WHOIS/WHOWAS notices." nil (let ((fname (erc-response.contents parsed)) (catalog-entry (intern (format "s%s" (erc-response.command parsed))))) - (multiple-value-bind (nick user host) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,nick ,user ,host) + (cdr (erc-response.command-args parsed)))) (erc-update-user-nick nick nick host nil fname user) (erc-display-message parsed 'notice 'active catalog-entry @@ -1633,8 +1633,8 @@ See `erc-display-server-message'." nil (define-erc-response-handler (312) "Server name response in WHOIS." nil - (multiple-value-bind (nick server-host) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,nick ,server-host) + (cdr (erc-response.command-args parsed)))) (erc-display-message parsed 'notice 'active 's312 ?n nick ?s server-host ?c (erc-response.contents parsed)))) @@ -1643,7 +1643,7 @@ See `erc-display-server-message'." nil "IRC Operator response in WHOIS." nil (erc-display-message parsed 'notice 'active 's313 - ?n (second (erc-response.command-args parsed)))) + ?n (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (315 318 323 369) ;; 315 - End of WHO @@ -1655,8 +1655,8 @@ See `erc-display-server-message'." nil (define-erc-response-handler (317) "IDLE notice." nil - (multiple-value-bind (nick seconds-idle on-since time) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,nick ,seconds-idle ,on-since ,time) + (cdr (erc-response.command-args parsed)))) (setq time (when on-since (format-time-string erc-server-timestamp-format (erc-string-to-emacs-time on-since)))) @@ -1674,14 +1674,14 @@ See `erc-display-server-message'." nil "Channel names in WHOIS response." nil (erc-display-message parsed 'notice 'active 's319 - ?n (second (erc-response.command-args parsed)) + ?n (cadr (erc-response.command-args parsed)) ?c (erc-response.contents parsed))) (define-erc-response-handler (320) "Identified user in WHOIS." nil (erc-display-message parsed 'notice 'active 's320 - ?n (second (erc-response.command-args parsed)))) + ?n (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (321) "LIST header." nil @@ -1696,16 +1696,16 @@ See `erc-display-server-message'." nil (define-erc-response-handler (322) "LIST notice." nil (let ((topic (erc-response.contents parsed))) - (multiple-value-bind (channel num-users) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,channel ,num-users) + (cdr (erc-response.command-args parsed)))) (add-to-list 'erc-channel-list (list channel)) (erc-update-channel-topic channel topic)))) (defun erc-server-322-message (proc parsed) "Display a message for the 322 event." (let ((topic (erc-response.contents parsed))) - (multiple-value-bind (channel num-users) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,channel ,num-users) + (cdr (erc-response.command-args parsed)))) (erc-display-message parsed 'notice proc 's322 ?c channel ?u num-users ?t (or topic ""))))) @@ -1713,7 +1713,7 @@ See `erc-display-server-message'." nil (define-erc-response-handler (324) "Channel or nick modes." nil - (let ((channel (second (erc-response.command-args parsed))) + (let ((channel (cadr (erc-response.command-args parsed))) (modes (mapconcat 'identity (cddr (erc-response.command-args parsed)) " "))) (erc-set-modes channel modes) @@ -1723,16 +1723,16 @@ See `erc-display-server-message'." nil (define-erc-response-handler (328) "Channel URL (on freenode network)." nil - (let ((channel (second (erc-response.command-args parsed))) + (let ((channel (cadr (erc-response.command-args parsed))) (url (erc-response.contents parsed))) (erc-display-message parsed 'notice (erc-get-buffer channel proc) 's328 ?c channel ?u url))) (define-erc-response-handler (329) "Channel creation date." nil - (let ((channel (second (erc-response.command-args parsed))) + (let ((channel (cadr (erc-response.command-args parsed))) (time (erc-string-to-emacs-time - (third (erc-response.command-args parsed))))) + (nth 2 (erc-response.command-args parsed))))) (erc-display-message parsed 'notice (erc-get-buffer channel proc) 's329 ?c channel ?t (format-time-string erc-server-timestamp-format @@ -1748,22 +1748,22 @@ See `erc-display-server-message'." nil ;; authaccount == (aref parsed 4) ;; authmsg == (aref parsed 5) ;; The guesses below are, well, just that. -- Lawrence 2004/05/10 - (let ((nick (second (erc-response.command-args parsed))) - (authaccount (third (erc-response.command-args parsed))) + (let ((nick (cadr (erc-response.command-args parsed))) + (authaccount (nth 2 (erc-response.command-args parsed))) (authmsg (erc-response.contents parsed))) (erc-display-message parsed 'notice 'active 's330 ?n nick ?a authmsg ?i authaccount))) (define-erc-response-handler (331) "No topic set for channel." nil - (let ((channel (second (erc-response.command-args parsed))) + (let ((channel (cadr (erc-response.command-args parsed))) (topic (erc-response.contents parsed))) (erc-display-message parsed 'notice (erc-get-buffer channel proc) 's331 ?c channel))) (define-erc-response-handler (332) "TOPIC notice." nil - (let ((channel (second (erc-response.command-args parsed))) + (let ((channel (cadr (erc-response.command-args parsed))) (topic (erc-response.contents parsed))) (erc-update-channel-topic channel topic) (erc-display-message parsed 'notice (erc-get-buffer channel proc) @@ -1771,8 +1771,8 @@ See `erc-display-server-message'." nil (define-erc-response-handler (333) "Who set the topic, and when." nil - (multiple-value-bind (channel nick time) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,channel ,nick ,time) + (cdr (erc-response.command-args parsed)))) (setq time (format-time-string erc-server-timestamp-format (erc-string-to-emacs-time time))) (erc-update-channel-topic channel @@ -1784,15 +1784,15 @@ See `erc-display-server-message'." nil (define-erc-response-handler (341) "Let user know when an INVITE attempt has been sent successfully." nil - (multiple-value-bind (nick channel) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,nick ,channel) + (cdr (erc-response.command-args parsed)))) (erc-display-message parsed 'notice (erc-get-buffer channel proc) 's341 ?n nick ?c channel))) (define-erc-response-handler (352) "WHO notice." nil - (multiple-value-bind (channel user host server nick away-flag) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,channel ,user ,host ,server ,nick ,away-flag) + (cdr (erc-response.command-args parsed)))) (let ((full-name (erc-response.contents parsed)) hopcount) (when (string-match "\\(^[0-9]+ \\)\\(.*\\)$" full-name) @@ -1806,7 +1806,7 @@ See `erc-display-server-message'." nil (define-erc-response-handler (353) "NAMES notice." nil - (let ((channel (third (erc-response.command-args parsed))) + (let ((channel (nth 2 (erc-response.command-args parsed))) (users (erc-response.contents parsed))) (erc-display-message parsed 'notice (or (erc-get-buffer channel proc) 'active) @@ -1816,13 +1816,13 @@ See `erc-display-server-message'." nil (define-erc-response-handler (366) "End of NAMES." nil - (erc-with-buffer ((second (erc-response.command-args parsed)) proc) + (erc-with-buffer ((cadr (erc-response.command-args parsed)) proc) (erc-channel-end-receiving-names))) (define-erc-response-handler (367) "Channel ban list entries." nil - (multiple-value-bind (channel banmask setter time) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,channel ,banmask ,setter ,time) + (cdr (erc-response.command-args parsed)))) ;; setter and time are not standard (if setter (erc-display-message parsed 'notice 'active 's367-set-by @@ -1836,7 +1836,7 @@ See `erc-display-server-message'." nil (define-erc-response-handler (368) "End of channel ban list." nil - (let ((channel (second (erc-response.command-args parsed)))) + (let ((channel (cadr (erc-response.command-args parsed)))) (erc-display-message parsed 'notice 'active 's368 ?c channel))) @@ -1845,8 +1845,8 @@ See `erc-display-server-message'." nil ;; FIXME: Yet more magic numbers in original code, I'm guessing this ;; command takes two arguments, and doesn't have any "contents". -- ;; Lawrence 2004/05/10 - (multiple-value-bind (from to) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,from ,to) + (cdr (erc-response.command-args parsed)))) (erc-display-message parsed 'notice 'active 's379 ?c from ?f to))) @@ -1854,12 +1854,12 @@ See `erc-display-server-message'." nil "Server's time string." nil (erc-display-message parsed 'notice 'active - 's391 ?s (second (erc-response.command-args parsed)) - ?t (third (erc-response.command-args parsed)))) + 's391 ?s (cadr (erc-response.command-args parsed)) + ?t (nth 2 (erc-response.command-args parsed)))) (define-erc-response-handler (401) "No such nick/channel." nil - (let ((nick/channel (second (erc-response.command-args parsed)))) + (let ((nick/channel (cadr (erc-response.command-args parsed)))) (when erc-whowas-on-nosuchnick (erc-log (format "cmd: WHOWAS: %s" nick/channel)) (erc-server-send (format "WHOWAS %s 1" nick/channel))) @@ -1869,23 +1869,23 @@ See `erc-display-server-message'." nil (define-erc-response-handler (403) "No such channel." nil (erc-display-message parsed '(notice error) 'active - 's403 ?c (second (erc-response.command-args parsed)))) + 's403 ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (404) "Cannot send to channel." nil (erc-display-message parsed '(notice error) 'active - 's404 ?c (second (erc-response.command-args parsed)))) + 's404 ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (405) "Can't join that many channels." nil (erc-display-message parsed '(notice error) 'active - 's405 ?c (second (erc-response.command-args parsed)))) + 's405 ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (406) "No such nick." nil (erc-display-message parsed '(notice error) 'active - 's406 ?n (second (erc-response.command-args parsed)))) + 's406 ?n (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (412) "No text to send." nil @@ -1894,33 +1894,33 @@ See `erc-display-server-message'." nil (define-erc-response-handler (421) "Unknown command." nil (erc-display-message parsed '(notice error) 'active 's421 - ?c (second (erc-response.command-args parsed)))) + ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (432) "Bad nick." nil (erc-display-message parsed '(notice error) 'active 's432 - ?n (second (erc-response.command-args parsed)))) + ?n (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (433) "Login-time \"nick in use\"." nil - (erc-nickname-in-use (second (erc-response.command-args parsed)) + (erc-nickname-in-use (cadr (erc-response.command-args parsed)) "already in use")) (define-erc-response-handler (437) "Nick temporarily unavailable (on IRCnet)." nil - (let ((nick/channel (second (erc-response.command-args parsed)))) + (let ((nick/channel (cadr (erc-response.command-args parsed)))) (unless (erc-channel-p nick/channel) (erc-nickname-in-use nick/channel "temporarily unavailable")))) (define-erc-response-handler (442) "Not on channel." nil (erc-display-message parsed '(notice error) 'active 's442 - ?c (second (erc-response.command-args parsed)))) + ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (461) "Not enough parameters for command." nil (erc-display-message parsed '(notice error) 'active 's461 - ?c (second (erc-response.command-args parsed)) + ?c (cadr (erc-response.command-args parsed)) ?m (erc-response.contents parsed))) (define-erc-response-handler (465) @@ -1936,37 +1936,37 @@ See `erc-display-server-message'." nil (erc-display-message parsed '(notice error) nil (intern (format "s%s" (erc-response.command parsed))) - ?c (second (erc-response.command-args parsed)))) + ?c (cadr (erc-response.command-args parsed)))) (define-erc-response-handler (475) "Channel key needed." nil (erc-display-message parsed '(notice error) nil 's475 - ?c (second (erc-response.command-args parsed))) + ?c (cadr (erc-response.command-args parsed))) (when erc-prompt-for-channel-key - (let ((channel (second (erc-response.command-args parsed))) + (let ((channel (cadr (erc-response.command-args parsed))) (key (read-from-minibuffer (format "Channel %s is mode +k. Enter key (RET to cancel): " - (second (erc-response.command-args parsed)))))) + (cadr (erc-response.command-args parsed)))))) (when (and key (> (length key) 0)) (erc-cmd-JOIN channel key))))) (define-erc-response-handler (477) "Channel doesn't support modes." nil - (let ((channel (second (erc-response.command-args parsed))) + (let ((channel (cadr (erc-response.command-args parsed))) (message (erc-response.contents parsed))) (erc-display-message parsed 'notice (erc-get-buffer channel proc) (format "%s: %s" channel message)))) (define-erc-response-handler (482) "You need to be a channel operator to do that." nil - (let ((channel (second (erc-response.command-args parsed))) + (let ((channel (cadr (erc-response.command-args parsed))) (message (erc-response.contents parsed))) (erc-display-message parsed '(error notice) 'active 's482 ?c channel ?m message))) (define-erc-response-handler (671) "Secure connection response in WHOIS." nil - (let ((nick (second (erc-response.command-args parsed))) + (let ((nick (cadr (erc-response.command-args parsed))) (securemsg (erc-response.contents parsed))) (erc-display-message parsed 'notice 'active 's671 ?n nick ?a securemsg))) diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el index c037a086e26..4d22b2c5f50 100644 --- a/lisp/erc/erc-capab.el +++ b/lisp/erc/erc-capab.el @@ -68,7 +68,6 @@ ;;; Code: (require 'erc) -(eval-when-compile (require 'cl)) ;;; Customization: diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index d5cee08c811..c27bb629f9d 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -54,9 +54,7 @@ ;;; Code: (require 'erc) -(eval-when-compile - (require 'cl) - (require 'pcomplete)) +(eval-when-compile (require 'pcomplete)) ;;;###autoload (autoload 'erc-dcc-mode "erc-dcc") (define-erc-module dcc nil @@ -277,7 +275,7 @@ Argument IP is the address as a string. The result is also a string." (* (nth 1 ips) 65536.0) (* (nth 2 ips) 256.0) (nth 3 ips)))) - (if (interactive-p) + (if (called-interactively-p 'interactive) (message "%s is %.0f" ip res) (format "%.0f" res))))) @@ -380,8 +378,8 @@ created subprocess, or nil." (with-no-warnings ; obsolete since 23.1 (set-process-filter-multibyte process nil))))) (file-error - (unless (and (string= "Cannot bind server socket" (cadr err)) - (string= "address already in use" (caddr err))) + (unless (and (string= "Cannot bind server socket" (nth 1 err)) + (string= "address already in use" (nth 2 err))) (signal (car err) (cdr err))) (setq port (1+ port)) (unless (< port upper) @@ -434,38 +432,38 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc." (pcomplete-here (append '("chat" "close" "get" "list") (when (fboundp 'make-network-process) '("send")))) (pcomplete-here - (case (intern (downcase (pcomplete-arg 1))) - (chat (mapcar (lambda (elt) (plist-get elt :nick)) + (pcase (intern (downcase (pcomplete-arg 1))) + (`chat (mapcar (lambda (elt) (plist-get elt :nick)) + (erc-remove-if-not + #'(lambda (elt) + (eq (plist-get elt :type) 'CHAT)) + erc-dcc-list))) + (`close (erc-delete-dups + (mapcar (lambda (elt) (symbol-name (plist-get elt :type))) + erc-dcc-list))) + (`get (mapcar #'erc-dcc-nick (erc-remove-if-not #'(lambda (elt) - (eq (plist-get elt :type) 'CHAT)) + (eq (plist-get elt :type) 'GET)) erc-dcc-list))) - (close (erc-delete-dups - (mapcar (lambda (elt) (symbol-name (plist-get elt :type))) - erc-dcc-list))) - (get (mapcar #'erc-dcc-nick - (erc-remove-if-not - #'(lambda (elt) - (eq (plist-get elt :type) 'GET)) - erc-dcc-list))) - (send (pcomplete-erc-all-nicks)))) + (`send (pcomplete-erc-all-nicks)))) (pcomplete-here - (case (intern (downcase (pcomplete-arg 2))) - (get (mapcar (lambda (elt) (plist-get elt :file)) - (erc-remove-if-not - #'(lambda (elt) - (and (eq (plist-get elt :type) 'GET) - (erc-nick-equal-p (erc-extract-nick - (plist-get elt :nick)) - (pcomplete-arg 1)))) - erc-dcc-list))) - (close (mapcar #'erc-dcc-nick - (erc-remove-if-not - #'(lambda (elt) - (eq (plist-get elt :type) - (intern (upcase (pcomplete-arg 1))))) - erc-dcc-list))) - (send (pcomplete-entries))))) + (pcase (intern (downcase (pcomplete-arg 2))) + (`get (mapcar (lambda (elt) (plist-get elt :file)) + (erc-remove-if-not + #'(lambda (elt) + (and (eq (plist-get elt :type) 'GET) + (erc-nick-equal-p (erc-extract-nick + (plist-get elt :nick)) + (pcomplete-arg 1)))) + erc-dcc-list))) + (`close (mapcar #'erc-dcc-nick + (erc-remove-if-not + #'(lambda (elt) + (eq (plist-get elt :type) + (intern (upcase (pcomplete-arg 1))))) + erc-dcc-list))) + (`send (pcomplete-entries))))) (defun erc-dcc-do-CHAT-command (proc &optional nick) (when nick @@ -899,7 +897,7 @@ other client." (let* ((buffer (erc-dcc-find-file file)) (size (buffer-size buffer)) (start (with-current-buffer buffer - (set-marker (make-marker) (point-min)))) + (point-min-marker))) (sproc (erc-dcc-server "dcc-send" 'erc-dcc-send-filter 'erc-dcc-send-sentinel)) @@ -1168,7 +1166,7 @@ other client." (setq erc-dcc-from nick) (setq erc-dcc-entry-data entry) (setq erc-dcc-unprocessed-output "") - (setq erc-insert-marker (set-marker (make-marker) (point-max))) + (setq erc-insert-marker (point-max-marker)) (setq erc-input-marker (make-marker)) (erc-display-prompt buffer (point-max)) (set-process-buffer proc buffer) @@ -1248,7 +1246,7 @@ other client." (defun erc-dcc-no-such-nick (proc parsed) "Detect and handle no-such-nick replies from the IRC server." - (let* ((elt (erc-dcc-member :nick (second (erc-response.command-args parsed)) + (let* ((elt (erc-dcc-member :nick (nth 1 (erc-response.command-args parsed)) :parent proc)) (peer (plist-get elt :peer))) (when (or (and (processp peer) (not (eq (process-status peer) 'open))) diff --git a/lisp/erc/erc-ezbounce.el b/lisp/erc/erc-ezbounce.el index 760a442a198..32a4f39305a 100644 --- a/lisp/erc/erc-ezbounce.el +++ b/lisp/erc/erc-ezbounce.el @@ -26,7 +26,6 @@ ;;; Code: (require 'erc) -(eval-when-compile (require 'cl)) (defgroup erc-ezbounce nil "Interface to the EZBounce IRC bouncer (a virtual IRC server)" diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el index 391b178cc7b..b6e6dfc5253 100644 --- a/lisp/erc/erc-join.el +++ b/lisp/erc/erc-join.el @@ -34,7 +34,6 @@ (require 'erc) (require 'auth-source) -(eval-when-compile (require 'cl)) (defgroup erc-autojoin nil "Enable autojoining." diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el index 9bdb7849fe6..465babc74f7 100644 --- a/lisp/erc/erc-log.el +++ b/lisp/erc/erc-log.el @@ -93,9 +93,7 @@ ;;; Code: (require 'erc) -(eval-when-compile - (require 'erc-networks) - (require 'cl)) +(eval-when-compile (require 'erc-networks)) (defgroup erc-log nil "Logging facilities for ERC." @@ -429,7 +427,8 @@ You can save every individual message by putting this function on file t 'nomessage)))) (let ((coding-system-for-write coding-system)) (write-region start end file t 'nomessage)))) - (if (and erc-truncate-buffer-on-save (interactive-p)) + (if (and erc-truncate-buffer-on-save + (called-interactively-p 'interactive)) (progn (let ((inhibit-read-only t)) (erase-buffer)) (move-marker erc-last-saved-position (point-max)) diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 0bafb43312c..7ca86b5ac95 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -35,7 +35,6 @@ ;;; Code: (require 'erc) -(eval-when-compile (require 'cl)) ;; Customization: diff --git a/lisp/erc/erc-netsplit.el b/lisp/erc/erc-netsplit.el index b630ebed807..7afbcd94273 100644 --- a/lisp/erc/erc-netsplit.el +++ b/lisp/erc/erc-netsplit.el @@ -31,7 +31,6 @@ ;;; Code: (require 'erc) -(eval-when-compile (require 'cl)) (defgroup erc-netsplit nil "Netsplit detection tries to automatically figure when a @@ -107,7 +106,7 @@ join from that split has been detected or not.") (dolist (elt erc-netsplit-list) (if (member nick (nthcdr 3 elt)) (progn - (if (not (caddr elt)) + (if (not (nth 2 elt)) (progn (erc-display-message parsed 'notice (process-buffer proc) @@ -149,7 +148,7 @@ join from that split has been detected or not.") ;; element for this netsplit exists already (progn (setcdr (nthcdr 2 ass) (cons nick (nthcdr 3 ass))) - (when (caddr ass) + (when (nth 2 ass) ;; There was already a netjoin for this netsplit, it ;; seems like the old one didn't get finished... (erc-display-message @@ -194,7 +193,7 @@ join from that split has been detected or not.") nil 'notice 'active 'netsplit-wholeft ?s (car elt) ?n (mapconcat 'erc-extract-nick (nthcdr 3 elt) " ") - ?t (if (caddr elt) + ?t (if (nth 2 elt) "(joining)" ""))))) t) diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index 885e47fc233..177f3714ae2 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -40,7 +40,7 @@ ;;; Code: (require 'erc) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;; Variables @@ -729,10 +729,10 @@ search for a match in `erc-networks-alist'." (or ;; Loop through `erc-networks-alist' looking for a match. (let ((server (or erc-server-announced-name erc-session-server))) - (loop for (name matcher) in erc-networks-alist - when (and matcher - (string-match (concat matcher "\\'") server)) - do (return name))) + (cl-loop for (name matcher) in erc-networks-alist + when (and matcher + (string-match (concat matcher "\\'") server)) + do (cl-return name))) 'Unknown))) (defun erc-network () @@ -789,8 +789,8 @@ As an example: (cond ((numberp p) (push p result)) ((listp p) - (setq result (nconc (loop for i from (cadr p) downto (car p) - collect i) + (setq result (nconc (cl-loop for i from (cadr p) downto (car p) + collect i) result))))) (nreverse result))) diff --git a/lisp/erc/erc-notify.el b/lisp/erc/erc-notify.el index 65ed34965d8..7061b035e54 100644 --- a/lisp/erc/erc-notify.el +++ b/lisp/erc/erc-notify.el @@ -30,9 +30,7 @@ (require 'erc) (require 'erc-networks) -(eval-when-compile - (require 'cl) - (require 'pcomplete)) +(eval-when-compile (require 'pcomplete)) ;;;; Customizable variables diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el index 212ad50a639..410a3c6d04c 100644 --- a/lisp/erc/erc-pcomplete.el +++ b/lisp/erc/erc-pcomplete.el @@ -43,7 +43,6 @@ (require 'erc) (require 'erc-compat) (require 'time-date) -(eval-when-compile (require 'cl)) (defgroup erc-pcomplete nil "Programmable completion for ERC" diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el index 10cbc37645b..1e3c3b17a23 100644 --- a/lisp/erc/erc-services.el +++ b/lisp/erc/erc-services.el @@ -62,7 +62,7 @@ (require 'erc) (require 'erc-networks) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) ;; Customization: diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index 5d55cc8d6fc..af043bdb2c1 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el @@ -38,7 +38,6 @@ (require 'erc) (require 'speedbar) (condition-case nil (require 'dframe) (error nil)) -(eval-when-compile (require 'cl)) ;;; Customization: diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 182b99bd47a..054c135fa67 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -34,7 +34,7 @@ ;; * Add extensibility so that custom functions can track ;; custom modification types. -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'erc) (require 'erc-compat) (require 'erc-match) @@ -484,7 +484,7 @@ START is the minimum length of the name used." ;;; Test: -(assert +(cl-assert (and ;; verify examples from the doc strings (equal (let ((erc-track-shorten-aggressively nil)) @@ -869,7 +869,7 @@ Use `erc-make-mode-line-buffer-name' to create buttons." (setq erc-modified-channels-alist (delete (assq buffer erc-modified-channels-alist) erc-modified-channels-alist)) - (when (interactive-p) + (when (called-interactively-p 'interactive) (erc-modified-channels-display))) (defun erc-track-find-face (faces) @@ -980,7 +980,7 @@ is in `erc-mode'." (add-to-list 'faces cur))) faces)) -(assert +(cl-assert (let ((str "is bold")) (put-text-property 3 (length str) 'face '(bold erc-current-nick-face) @@ -1030,17 +1030,17 @@ relative to `erc-track-switch-direction'" (let ((dir erc-track-switch-direction) offset) (when (< arg 0) - (setq dir (case dir - (oldest 'newest) - (newest 'oldest) - (mostactive 'leastactive) - (leastactive 'mostactive) - (importance 'oldest))) + (setq dir (pcase dir + (`oldest 'newest) + (`newest 'oldest) + (`mostactive 'leastactive) + (`leastactive 'mostactive) + (`importance 'oldest))) (setq arg (- arg))) - (setq offset (case dir - ((oldest leastactive) + (setq offset (pcase dir + ((or `oldest `leastactive) (- (length erc-modified-channels-alist) arg)) - (t (1- arg)))) + (_ (1- arg)))) ;; normalize out of range user input (cond ((>= offset (length erc-modified-channels-alist)) (setq offset (1- (length erc-modified-channels-alist)))) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 01991e599df..042ad09decf 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -67,7 +67,7 @@ (defconst erc-version-string "Version 5.3" "ERC version. This is used by function `erc-version'.") -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl-lib)) (require 'font-lock) (require 'pp) (require 'thingatpt) @@ -369,7 +369,7 @@ If no server buffer exists, return nil." (with-current-buffer ,buffer ,@body))))) -(defstruct (erc-server-user (:type vector) :named) +(cl-defstruct (erc-server-user (:type vector) :named) ;; User data nickname host login full-name info ;; Buffers @@ -379,7 +379,7 @@ If no server buffer exists, return nil." (buffers nil) ) -(defstruct (erc-channel-user (:type vector) :named) +(cl-defstruct (erc-channel-user (:type vector) :named) op voice ;; Last message time (in the form of the return value of ;; (current-time) @@ -1386,7 +1386,7 @@ If BUFFER is nil, the current buffer is used." t)) (erc-server-send (format "ISON %s" nick)) (while (eq erc-online-p 'unknown) (accept-process-output)) - (if (interactive-p) + (if (called-interactively-p 'interactive) (message "%s is %sonline" (or erc-online-p nick) (if erc-online-p "" "not ")) @@ -2157,11 +2157,11 @@ functions in here get called with the parameters SERVER and NICK." (list :server server :port port :nick nick :password passwd))) ;;;###autoload -(defun* erc (&key (server (erc-compute-server)) - (port (erc-compute-port)) - (nick (erc-compute-nick)) - password - (full-name (erc-compute-full-name))) +(cl-defun erc (&key (server (erc-compute-server)) + (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. @@ -2383,24 +2383,24 @@ If STRING is nil, the function does nothing." (while list (setq elt (car list)) (cond ((integerp elt) ; POSITION - (incf (car list) shift)) + (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) - (incf (car elt) shift) - (incf (cdr elt) shift)) + (cl-incf (car elt) shift) + (cl-incf (cdr elt) shift)) ((stringp (car elt)) ; (TEXT . POSITION) - (incf (cdr elt) (* (if (natnump (cdr elt)) 1 -1) shift))) + (cl-incf (cdr elt) (* (if (natnump (cdr elt)) 1 -1) shift))) ((null (car elt)) ; (nil PROPERTY VALUE BEG . END) (let ((cons (nthcdr 3 elt))) - (incf (car cons) shift) - (incf (cdr cons) shift))) + (cl-incf (car cons) shift) + (cl-incf (cdr cons) shift))) ((and (featurep 'xemacs) (extentp (car elt))) ; (EXTENT START END) - (incf (nth 1 elt) shift) - (incf (nth 2 elt) shift))) + (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-]*" @@ -2477,6 +2477,13 @@ purposes." :group 'erc-lurker :type 'boolean) +(defcustom erc-lurker-ignore-chars "`_" + "Characters at the end of a nick to strip for activity tracking purposes. + +See also `erc-lurker-trim-nicks'." + :group 'erc-lurker + :type 'string) + (defun erc-lurker-maybe-trim (nick) "Maybe trim trailing `erc-lurker-ignore-chars' from NICK. @@ -2491,13 +2498,6 @@ non-nil." "" nick) nick)) -(defcustom erc-lurker-ignore-chars "`_" - "Characters at the end of a nick to strip for activity tracking purposes. - -See also `erc-lurker-trim-nicks'." - :group 'erc-lurker - :type 'string) - (defcustom erc-lurker-hide-list nil "List of IRC type messages to hide when sent by lurkers. @@ -2534,9 +2534,9 @@ consumption for long-lived IRC or Emacs sessions." (maphash (lambda (nick last-PRIVMSG-time) (when - (> (time-to-seconds (time-subtract - (current-time) - last-PRIVMSG-time)) + (> (float-time (time-subtract + (current-time) + last-PRIVMSG-time)) erc-lurker-threshold-time) (remhash nick hash))) hash) @@ -2580,7 +2580,8 @@ updates of `erc-lurker-state'." (server (erc-canonicalize-server-name erc-server-announced-name))) (when (equal command "PRIVMSG") - (when (>= (incf erc-lurker-cleanup-count) erc-lurker-cleanup-interval) + (when (>= (cl-incf erc-lurker-cleanup-count) + erc-lurker-cleanup-interval) (setq erc-lurker-cleanup-count 0) (erc-lurker-cleanup)) (unless (gethash server erc-lurker-state) @@ -2601,10 +2602,21 @@ server within `erc-lurker-threshold-time'. See also (gethash (erc-lurker-maybe-trim nick) (gethash server erc-lurker-state (make-hash-table))))) (or (null last-PRIVMSG-time) - (> (time-to-seconds + (> (float-time (time-subtract (current-time) last-PRIVMSG-time)) erc-lurker-threshold-time)))) +(defcustom erc-common-server-suffixes + '(("openprojects.net$" . "OPN") + ("freenode.net$" . "freenode") + ("oftc.net$" . "OFTC")) + "Alist of common server name suffixes. +This variable is used in mode-line display to save screen +real estate. Set it to nil if you want to avoid changing +displayed hostnames." + :group 'erc-mode-line-and-header + :type 'alist) + (defun erc-canonicalize-server-name (server) "Returns the canonical network name for SERVER if any, otherwise `erc-server-announced-name'. SERVER is matched against @@ -3115,37 +3127,37 @@ If SERVER is non-nil, use that, rather than the current server." (add-to-list 'symlist (cons (erc-once-with-server-event 311 `(string= ,nick - (second + (nth 1 (erc-response.command-args parsed)))) 'erc-server-311-functions)) (add-to-list 'symlist (cons (erc-once-with-server-event 312 `(string= ,nick - (second + (nth 1 (erc-response.command-args parsed)))) 'erc-server-312-functions)) (add-to-list 'symlist (cons (erc-once-with-server-event 318 `(string= ,nick - (second + (nth 1 (erc-response.command-args parsed)))) 'erc-server-318-functions)) (add-to-list 'symlist (cons (erc-once-with-server-event 319 `(string= ,nick - (second + (nth 1 (erc-response.command-args parsed)))) 'erc-server-319-functions)) (add-to-list 'symlist (cons (erc-once-with-server-event 320 `(string= ,nick - (second + (nth 1 (erc-response.command-args parsed)))) 'erc-server-320-functions)) (add-to-list 'symlist (cons (erc-once-with-server-event 330 `(string= ,nick - (second + (nth 1 (erc-response.command-args parsed)))) 'erc-server-330-functions)) (add-to-list 'symlist @@ -4328,8 +4340,8 @@ See also: `erc-echo-notice-in-user-buffers', (defun erc-banlist-store (proc parsed) "Record ban entries for a channel." - (multiple-value-bind (channel mask whoset) - (values-list (cdr (erc-response.command-args parsed))) + (pcase-let ((`(,channel ,mask ,whoset) + (cdr (erc-response.command-args parsed)))) ;; Determine to which buffer the message corresponds (let ((buffer (erc-get-buffer channel proc))) (with-current-buffer buffer @@ -4340,7 +4352,7 @@ See also: `erc-echo-notice-in-user-buffers', (defun erc-banlist-finished (proc parsed) "Record that we have received the banlist." - (let* ((channel (second (erc-response.command-args parsed))) + (let* ((channel (nth 1 (erc-response.command-args parsed))) (buffer (erc-get-buffer channel proc))) (with-current-buffer buffer (put 'erc-channel-banlist 'received-from-server t))) @@ -4349,7 +4361,7 @@ See also: `erc-echo-notice-in-user-buffers', (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 (first (erc-response.command-args parsed))) + (let* ((tgt (car (erc-response.command-args parsed))) (mode (erc-response.contents parsed)) (whoset (erc-response.sender parsed)) (buffer (erc-get-buffer tgt proc))) @@ -5203,42 +5215,66 @@ Specifically, return the position of `erc-insert-marker'." "Return the value of `point' at the end of the input line." (point-max)) +(defvar erc-last-input-time 0 + "Time of last call to `erc-send-current-line'. +If that function has never been called, the value is 0.") + +(defcustom erc-accidental-paste-threshold-seconds nil + "Minimum time, in seconds, before sending new lines via IRC. +If the value is a number, `erc-send-current-line' signals an +error if its previous invocation was less than this much time +ago. This is useful so that if you accidentally enter large +amounts of text into the ERC buffer, that text is not sent to the +IRC server. + +If the value is nil, `erc-send-current-line' always considers any +submitted line to be intentional." + :group 'erc + :version "24.4" + :type '(choice number (other :tag "disabled" nil))) + (defun erc-send-current-line () "Parse current line and send it to IRC." (interactive) - (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)))))) + (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)) + (switch-to-buffer "*ERC Accidental Paste Overflow*") + (lwarn 'erc :warning + "You seem to have accidentally pasted some text!")))) (defun erc-user-input () "Return the input of the user in the current buffer." @@ -6000,7 +6036,7 @@ entry of `channel-members'." (if cuser (setq op (erc-channel-user-op cuser) voice (erc-channel-user-voice cuser))) - (if (interactive-p) + (if (called-interactively-p 'interactive) (message "%s is %s@%s%s%s" nick login host (if full-name (format " (%s)" full-name) "") @@ -6088,17 +6124,6 @@ Otherwise, use the `erc-header-line' face." :group 'erc-paranoia :type 'boolean) -(defcustom erc-common-server-suffixes - '(("openprojects.net$" . "OPN") - ("freenode.net$" . "freenode") - ("oftc.net$" . "OFTC")) - "Alist of common server name suffixes. -This variable is used in mode-line display to save screen -real estate. Set it to nil if you want to avoid changing -displayed hostnames." - :group 'erc-mode-line-and-header - :type 'alist) - (defcustom erc-mode-line-away-status-format "(AWAY since %a %b %d %H:%M) " "When you're away on a server, this is shown in the mode line. @@ -6302,7 +6327,7 @@ If optional argument HERE is non-nil, insert version number at point." (format "ERC %s (GNU Emacs %s)" erc-version-string emacs-version))) (if here (insert version-string) - (if (interactive-p) + (if (called-interactively-p 'interactive) (message "%s" version-string) version-string)))) @@ -6322,7 +6347,7 @@ If optional argument HERE is non-nil, insert version number at point." ", "))) (if here (insert string) - (if (interactive-p) + (if (called-interactively-p 'interactive) (message "%s" string) string)))) diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index 9e061b64504..f6dd0d5e990 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -306,12 +306,13 @@ Remove (unlink) the FILE(s).") (eshell-eval-using-options "mkdir" args '((?h "help" nil nil "show this usage screen") + (?p "parents" nil em-parents "make parent directories as needed") :external "mkdir" :show-usage :usage "[OPTION] DIRECTORY... Create the DIRECTORY(ies), if they do not already exist.") (while args - (eshell-funcalln 'make-directory (car args)) + (eshell-funcalln 'make-directory (car args) em-parents) (setq args (cdr args))) nil)) diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 2f49a21e76c..f9b86219e9b 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -229,6 +229,7 @@ If N or M is nil, it means the end of the list." "Content of $PATH. It might be different from \(getenv \"PATH\"\), when `default-directory' points to a remote host.") +(make-variable-buffer-local 'eshell-path-env) (defun eshell-parse-colon-path (path-env) "Split string with `parse-colon-path'. diff --git a/lisp/faces.el b/lisp/faces.el index 1a86bca7d7b..60410733514 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -487,44 +487,44 @@ with the `default' face (which is always completely specified)." (defalias 'face-background-pixmap 'face-stipple) -;; FIXME all of these -p functions ignore inheritance (cf face-stipple). -;; Ie, a face that inherits from an underlined face but does not -;; specify :underline will return nil. -;; So these functions don't actually tell you anything about how the -;; face will _appear_. So not very useful IMO. -(defun face-underline-p (face &optional frame) +(defun face-underline-p (face &optional frame inherit) "Return non-nil if FACE specifies a non-nil underlining. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). -If FRAME is omitted or nil, use the selected frame." - (face-attribute-specified-or (face-attribute face :underline frame) nil)) +If FRAME is omitted or nil, use the selected frame. +Optional argument INHERIT is passed to `face-attribute'." + (face-attribute-specified-or + (face-attribute face :underline frame inherit) nil)) -(defun face-inverse-video-p (face &optional frame) +(defun face-inverse-video-p (face &optional frame inherit) "Return non-nil if FACE specifies a non-nil inverse-video. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). -If FRAME is omitted or nil, use the selected frame." - (eq (face-attribute face :inverse-video frame) t)) +If FRAME is omitted or nil, use the selected frame. +Optional argument INHERIT is passed to `face-attribute'." + (eq (face-attribute face :inverse-video frame inherit) t)) -(defun face-bold-p (face &optional frame) +(defun face-bold-p (face &optional frame inherit) "Return non-nil if the font of FACE is bold on FRAME. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). If FRAME is omitted or nil, use the selected frame. +Optional argument INHERIT is passed to `face-attribute'. Use `face-attribute' for finer control." - (let ((bold (face-attribute face :weight frame))) + (let ((bold (face-attribute face :weight frame inherit))) (memq bold '(semi-bold bold extra-bold ultra-bold)))) -(defun face-italic-p (face &optional frame) +(defun face-italic-p (face &optional frame inherit) "Return non-nil if the font of FACE is italic on FRAME. If the optional argument FRAME is given, report on face FACE in that frame. If FRAME is t, report on the defaults for face FACE (for new frames). If FRAME is omitted or nil, use the selected frame. +Optional argument INHERIT is passed to `face-attribute'. Use `face-attribute' for finer control." - (let ((italic (face-attribute face :slant frame))) + (let ((italic (face-attribute face :slant frame inherit))) (memq italic '(italic oblique)))) @@ -862,7 +862,7 @@ Use `set-face-attribute' to ``unspecify'' underlining." 'set-face-underline "24.3") -(defun set-face-inverse-video-p (face inverse-video-p &optional frame) +(defun set-face-inverse-video (face inverse-video-p &optional frame) "Specify whether face FACE is in inverse video. INVERSE-VIDEO-P non-nil means FACE displays explicitly in inverse video. INVERSE-VIDEO-P nil means FACE explicitly is not in inverse video. @@ -870,14 +870,13 @@ FRAME nil or not specified means change face on all frames. Use `set-face-attribute' to ``unspecify'' the inverse video attribute." (interactive (let ((list (read-face-and-attribute :inverse-video))) - (list (car list) (eq (car (cdr list)) t)))) + (list (car list) (if (cadr list) t)))) (set-face-attribute face frame :inverse-video inverse-video-p)) +(define-obsolete-function-alias 'set-face-inverse-video-p + 'set-face-inverse-video "24.4") -;; The -p suffix is a hostage to fortune. What if we want to extend -;; this to allow more than boolean options? Exactly this happened -;; to set-face-underline-p. -(defun set-face-bold-p (face bold-p &optional frame) +(defun set-face-bold (face bold-p &optional frame) "Specify whether face FACE is bold. BOLD-P non-nil means FACE should explicitly display bold. BOLD-P nil means FACE should explicitly display non-bold. @@ -887,8 +886,10 @@ Use `set-face-attribute' or `modify-face' for finer control." (make-face-unbold face frame) (make-face-bold face frame))) +(define-obsolete-function-alias 'set-face-bold-p 'set-face-bold "24.4") -(defun set-face-italic-p (face italic-p &optional frame) + +(defun set-face-italic (face italic-p &optional frame) "Specify whether face FACE is italic. ITALIC-P non-nil means FACE should explicitly display italic. ITALIC-P nil means FACE should explicitly display non-italic. @@ -898,6 +899,8 @@ Use `set-face-attribute' or `modify-face' for finer control." (make-face-unitalic face frame) (make-face-italic face frame))) +(define-obsolete-function-alias 'set-face-italic-p 'set-face-italic "24.4") + (defalias 'set-face-background-pixmap 'set-face-stipple) @@ -1586,44 +1589,79 @@ If SPEC is nil, return nil." (mapcar (lambda (x) (list (car x) 'unspecified)) face-attribute-name-alist))))) -(defun face-spec-set (face spec &optional for-defface) - "Set and apply the face spec for FACE. -If the optional argument FOR-DEFFACE is omitted or nil, set the -overriding spec to SPEC, recording it in the `face-override-spec' -property of FACE. See `defface' for the format of SPEC. - -If FOR-DEFFACE is non-nil, set the base spec (the one set by -`defface' and Custom). In this case, SPEC is ignored; the caller -is responsible for putting the face spec in the `saved-face', -`customized-face', or `face-defface-spec', as appropriate. - -The appearance of FACE is controlled by the base spec, by any -custom theme specs on top of that, and by the overriding spec on -top of all the rest." - (if for-defface - ;; When we reset the face based on its custom spec, then it is - ;; unmodified as far as Custom is concerned. - (put (or (get face 'face-alias) face) 'face-modified nil) - ;; When we change a face based on a spec from outside custom, - ;; record it for future frames. - (put (or (get face 'face-alias) face) 'face-override-spec spec)) - ;; Reset each frame according to the rules implied by all its specs. - (dolist (frame (frame-list)) - (face-spec-recalc face frame))) +(defun face-spec-set (face spec &optional spec-type) + "Set the face spec SPEC for FACE. +See `defface' for the format of SPEC. + +The appearance of each face is controlled by its spec, and by the +internal face attributes (which can be frame-specific and can be +set via `set-face-attribute'). + +The argument SPEC-TYPE determines which spec to set: + nil or `face-override-spec' means the override spec (which is + usually what you want if calling this function outside of + Custom code); + `customized-face' or `saved-face' means the customized spec or + the saved custom spec; + `face-defface-spec' means the default spec + (usually set only via `defface'); + `reset' means to ignore SPEC, but clear the `customized-face' + and `face-override-spec' specs; +Any other value means not to set any spec, but to run the +function for its other effects. + +In addition to setting the face spec, this function defines FACE +as a valid face name if it is not already one, and (re)calculates +the face's attributes on existing frames." + (if (get face 'face-alias) + (setq face (get face 'face-alias))) + ;; Save SPEC to the relevant symbol property. + (unless spec-type + (setq spec-type 'face-override-spec)) + (if (memq spec-type '(face-defface-spec face-override-spec + customized-face saved-face)) + (put face spec-type spec)) + (if (memq spec-type '(reset saved-face)) + (put face 'customized-face nil)) + ;; Setting the face spec via Custom empties out any override spec, + ;; similar to how setting a variable via Custom changes its values. + (if (memq spec-type '(customized-face saved-face reset)) + (put face 'face-override-spec nil)) + ;; If we reset the face based on its custom spec, it is unmodified + ;; as far as Custom is concerned. + (unless (eq face 'face-override-spec) + (put face 'face-modified nil)) + (if (facep face) + ;; If the face already exists, recalculate it. + (dolist (frame (frame-list)) + (face-spec-recalc face frame)) + ;; Otherwise, initialize it on all frames. + (make-empty-face face) + (let ((value (face-user-default-spec face)) + (have-window-system (memq initial-window-system '(x w32 ns)))) + (dolist (frame (frame-list)) + (face-spec-set-2 face frame value) + (when (memq (window-system frame) '(x w32 ns)) + (setq have-window-system t))) + (if have-window-system + (make-face-x-resource-internal face))))) (defun face-spec-recalc (face frame) "Reset the face attributes of FACE on FRAME according to its specs. This applies the defface/custom spec first, then the custom theme specs, then the override spec." + (while (get face 'face-alias) + (setq face (get face 'face-alias))) (face-spec-reset-face face frame) - (let ((face-sym (or (get face 'face-alias) face))) - (or (get face 'customized-face) - (get face 'saved-face) - (face-spec-set-2 face frame (face-default-spec face))) - (let ((theme-faces (reverse (get face-sym 'theme-face)))) - (dolist (spec theme-faces) - (face-spec-set-2 face frame (cadr spec)))) - (face-spec-set-2 face frame (get face-sym 'face-override-spec)))) + ;; If FACE is customized or themed, set the custom spec from + ;; `theme-face' records, which completely replace the defface spec + ;; rather than inheriting from it. + (let ((theme-faces (get face 'theme-face))) + (if theme-faces + (dolist (spec (reverse theme-faces)) + (face-spec-set-2 face frame (cadr spec))) + (face-spec-set-2 face frame (face-default-spec face)))) + (face-spec-set-2 face frame (get face 'face-override-spec))) (defun face-spec-set-2 (face frame spec) "Set the face attributes of FACE on FRAME according to SPEC." diff --git a/lisp/ffap.el b/lisp/ffap.el index 98421936b96..c5b0784e5a2 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -181,7 +181,7 @@ Note this name may be omitted if it equals the default ;; Could just use `url-nonrelative-link' of w3, if loaded. ;; This regexp is not exhaustive, it just matches common cases. (concat - "\\`\\(" + "\\(" "news\\(post\\)?:\\|mailto:\\|file:" ; no host ok "\\|" "\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\)://" ; needs host @@ -321,7 +321,7 @@ disable FFAP most of the time." "Last value returned by `ffap-next-guess'.") (defvar ffap-string-at-point-region '(1 1) - "List (BEG END), last region returned by `ffap-string-at-point'.") + "List (BEG END), last region returned by the function `ffap-string-at-point'.") (defun ffap-next-guess (&optional back lim) "Move point to next file or URL, and return it as a string. @@ -346,7 +346,7 @@ Optional argument BACK says to search backwards. Optional argument WRAP says to try wrapping around if necessary. Interactively: use a single prefix to search backwards, double prefix to wrap forward, triple to wrap backwards. -Actual search is done by `ffap-next-guess'." +Actual search is done by the function `ffap-next-guess'." (interactive (cdr (assq (prefix-numeric-value current-prefix-arg) '((1) (4 t) (16 nil t) (64 t t))))) @@ -606,10 +606,11 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"." (defsubst ffap-url-p (string) "If STRING looks like an URL, return it (maybe improved), else nil." - (let ((case-fold-search t)) - (and ffap-url-regexp (string-match ffap-url-regexp string) - ;; I lied, no improvement: - string))) + (when (and (stringp string) ffap-url-regexp) + (let* ((case-fold-search t) + (match (string-match ffap-url-regexp string))) + (cond ((eq match 0) string) + (match (substring string match)))))) ;; Broke these out of ffap-fixup-url, for use of ffap-url package. (defun ffap-url-unwrap-local (url) @@ -1027,14 +1028,14 @@ If a given RFC isn't in these then `ffap-rfc-path' is offered." "Alist of \(MODE CHARS BEG END\), where MODE is a symbol, possibly a major-mode name, or one of the symbol `file', `url', `machine', and `nocolon'. -`ffap-string-at-point' uses the data fields as follows: +Function `ffap-string-at-point' uses the data fields as follows: 1. find a maximal string of CHARS around point, 2. strip BEG chars before point from the beginning, 3. Strip END chars after point from the end.") (defvar ffap-string-at-point nil ;; Added at suggestion of RHOGEE (for ff-paths), 7/24/95. - "Last string returned by `ffap-string-at-point'.") + "Last string returned by the function `ffap-string-at-point'.") (defun ffap-string-at-point (&optional mode) "Return a string of characters from around point. @@ -1042,7 +1043,8 @@ MODE (defaults to value of `major-mode') is a symbol used to look up string syntax parameters in `ffap-string-at-point-mode-alist'. If MODE is not found, we use `file' instead of MODE. If the region is active, return a string from the region. -Sets `ffap-string-at-point' and `ffap-string-at-point-region'." +Sets the variable `ffap-string-at-point' and the variable +`ffap-string-at-point-region'." (let* ((args (cdr (or (assq (or mode major-mode) ffap-string-at-point-mode-alist) @@ -1067,7 +1069,8 @@ Sets `ffap-string-at-point' and `ffap-string-at-point-region'." (defun ffap-string-around () ;; Sometimes useful to decide how to treat a string. - "Return string of two chars around last `ffap-string-at-point'. + "Return string of two chars around last result of function +`ffap-string-at-point'. Assumes the buffer has not changed." (save-excursion (format "%c%c" @@ -1081,7 +1084,7 @@ Assumes the buffer has not changed." (defun ffap-copy-string-as-kill (&optional mode) ;; Requested by MCOOK. Useful? - "Call `ffap-string-at-point', and copy result to `kill-ring'." + "Call function `ffap-string-at-point', and copy result to `kill-ring'." (interactive) (let ((str (ffap-string-at-point mode))) (if (equal "" str) @@ -1122,10 +1125,8 @@ Assumes the buffer has not changed." (equal (ffap-string-around) "<>") ;; (ffap-user-p name): (not (string-match "~" (expand-file-name (concat "~" name))))) - (setq name (concat "mailto:" name)))) - - (if (ffap-url-p name) - name))))) + (setq name (concat "mailto:" name))) + ((ffap-url-p name))))))) (defvar ffap-gopher-regexp "^.*\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *\\(.*\\) *$" @@ -1297,13 +1298,11 @@ which may actually result in an URL rather than a filename." (let (dir) ;; Tricky: guess may have or be a local directory, like "w3/w3.elc" ;; or "w3/" or "../el/ffap.el" or "../../../" - (or (ffap-url-p guess) - (progn - (or (ffap-file-remote-p guess) - (setq guess - (abbreviate-file-name (expand-file-name guess)) - )) - (setq dir (file-name-directory guess)))) + (unless (ffap-url-p guess) + (unless (ffap-file-remote-p guess) + (setq guess + (abbreviate-file-name (expand-file-name guess)))) + (setq dir (file-name-directory guess))) (let ((minibuffer-completing-file-name t) (completion-ignore-case read-file-name-completion-ignore-case) (fnh-elem (cons ffap-url-regexp 'url-file-handler))) @@ -1327,11 +1326,8 @@ which may actually result in an URL rather than a filename." ;; other modifications to be lost (e.g. when Tramp gets loaded ;; during the completing-read call). (setq file-name-handler-alist (delq fnh-elem file-name-handler-alist)))) - ;; Do file substitution like (interactive "F"), suggested by MCOOK. - (or (ffap-url-p guess) (setq guess (substitute-in-file-name guess))) - ;; Should not do it on url's, where $ is a common (VMS?) character. - ;; Note: upcoming url.el package ought to handle this automatically. - guess)) + (or (ffap-url-p guess) + (substitute-in-file-name guess)))) (defun ffap-read-url-internal (string pred action) "Complete URLs from history, treating given string as valid." @@ -1346,11 +1342,10 @@ which may actually result in an URL rather than a filename." (t t)))) (defun ffap-read-file-or-url-internal (string pred action) - (unless string ;Why would this ever happen? - (setq string default-directory)) - (if (ffap-url-p string) - (ffap-read-url-internal string pred action) - (read-file-name-internal string pred action))) + (let ((url (ffap-url-p string))) + (if url + (ffap-read-url-internal url pred action) + (read-file-name-internal (or string default-directory) pred action)))) ;; The rest of this page is just to work with package complete.el. ;; This code assumes that you load ffap.el after complete.el. @@ -1371,7 +1366,7 @@ which may actually result in an URL rather than a filename." :version "22.1") (defvar ffap-highlight-overlay nil - "Overlay used by `ffap-highlight'.") + "Overlay used by function `ffap-highlight'.") (defun ffap-highlight (&optional remove) "If `ffap-highlight' is set, highlight the guess in this buffer. @@ -1441,30 +1436,31 @@ and the functions `ffap-file-at-point' and `ffap-url-at-point'." (let (current-prefix-arg) ; we already interpreted it (call-interactively ffap-file-finder)) (or filename (setq filename (ffap-prompter))) - (cond - ((ffap-url-p filename) - (let (current-prefix-arg) ; w3 2.3.25 bug, reported by KPC - (funcall ffap-url-fetcher filename))) - ((and ffap-pass-wildcards-to-dired - ffap-dired-wildcards - (string-match ffap-dired-wildcards filename)) - (funcall ffap-directory-finder filename)) - ((and ffap-dired-wildcards - (string-match ffap-dired-wildcards filename) - find-file-wildcards - ;; Check if it's find-file that supports wildcards arg - (memq ffap-file-finder '(find-file find-alternate-file))) - (funcall ffap-file-finder (expand-file-name filename) t)) - ((or (not ffap-newfile-prompt) - (file-exists-p filename) - (y-or-n-p "File does not exist, create buffer? ")) - (funcall ffap-file-finder - ;; expand-file-name fixes "~/~/.emacs" bug sent by CHUCKR. - (expand-file-name filename))) - ;; User does not want to find a non-existent file: - ((signal 'file-error (list "Opening file buffer" - "no such file or directory" - filename)))))) + (let ((url (ffap-url-p filename))) + (cond + (url + (let (current-prefix-arg) + (funcall ffap-url-fetcher url))) + ((and ffap-pass-wildcards-to-dired + ffap-dired-wildcards + (string-match ffap-dired-wildcards filename)) + (funcall ffap-directory-finder filename)) + ((and ffap-dired-wildcards + (string-match ffap-dired-wildcards filename) + find-file-wildcards + ;; Check if it's find-file that supports wildcards arg + (memq ffap-file-finder '(find-file find-alternate-file))) + (funcall ffap-file-finder (expand-file-name filename) t)) + ((or (not ffap-newfile-prompt) + (file-exists-p filename) + (y-or-n-p "File does not exist, create buffer? ")) + (funcall ffap-file-finder + ;; expand-file-name fixes "~/~/.emacs" bug sent by CHUCKR. + (expand-file-name filename))) + ;; User does not want to find a non-existent file: + ((signal 'file-error (list "Opening file buffer" + "no such file or directory" + filename))))))) ;; Shortcut: allow {M-x ffap} rather than {M-x find-file-at-point}. ;;;###autoload @@ -1740,7 +1736,7 @@ Only intended for interactive use." (call-interactively 'ffap))) (defun ffap-literally () - "Like `ffap' and `find-file-literally'. + "Like `ffap' and command `find-file-literally'. Only intended for interactive use." (interactive) (let ((ffap-file-finder 'find-file-literally)) @@ -1820,25 +1816,26 @@ If `dired-at-point-require-prefix' is set, the prefix meaning is reversed." (let (current-prefix-arg) ; already interpreted (call-interactively ffap-directory-finder)) (or filename (setq filename (dired-at-point-prompter))) - (cond - ((ffap-url-p filename) - (funcall ffap-url-fetcher filename)) - ((and ffap-dired-wildcards - (string-match ffap-dired-wildcards filename)) - (funcall ffap-directory-finder filename)) - ((file-exists-p filename) - (if (file-directory-p filename) + (let ((url (ffap-url-p filename))) + (cond + (url + (funcall ffap-url-fetcher url)) + ((and ffap-dired-wildcards + (string-match ffap-dired-wildcards filename)) + (funcall ffap-directory-finder filename)) + ((file-exists-p filename) + (if (file-directory-p filename) + (funcall ffap-directory-finder + (expand-file-name filename)) (funcall ffap-directory-finder - (expand-file-name filename)) - (funcall ffap-directory-finder - (concat (expand-file-name filename) "*")))) - ((and (file-writable-p - (or (file-name-directory (directory-file-name filename)) - filename)) - (y-or-n-p "Directory does not exist, create it? ")) - (make-directory filename) - (funcall ffap-directory-finder filename)) - ((error "No such file or directory `%s'" filename))))) + (concat (expand-file-name filename) "*")))) + ((and (file-writable-p + (or (file-name-directory (directory-file-name filename)) + filename)) + (y-or-n-p "Directory does not exist, create it? ")) + (make-directory filename) + (funcall ffap-directory-finder filename)) + ((error "No such file or directory `%s'" filename)))))) (defun dired-at-point-prompter (&optional guess) ;; Does guess and prompt step for find-file-at-point. @@ -1851,23 +1848,23 @@ If `dired-at-point-require-prefix' is set, the prefix meaning is reversed." (ffap-url-regexp "Dired file or URL: ") (t "Dired file: ")) (prog1 - (setq guess (or guess - (let ((guess (ffap-guesser))) - (if (or (not guess) - (ffap-url-p guess) - (ffap-file-remote-p guess)) - guess - (setq guess (abbreviate-file-name - (expand-file-name guess))) - (cond - ;; Interpret local directory as a directory. - ((file-directory-p guess) - (file-name-as-directory guess)) - ;; Get directory component from local files. - ((file-regular-p guess) - (file-name-directory guess)) - (guess)))) - )) + (setq guess + (let ((guess (or guess (ffap-guesser)))) + (cond + ((null guess) nil) + ((ffap-url-p guess)) + ((ffap-file-remote-p guess) + guess) + ((progn + (setq guess (abbreviate-file-name + (expand-file-name guess))) + ;; Interpret local directory as a directory. + (file-directory-p guess)) + (file-name-as-directory guess)) + ;; Get directory component from local files. + ((file-regular-p guess) + (file-name-directory guess)) + (guess)))) (and guess (ffap-highlight)))) (ffap-highlight t))) @@ -1916,22 +1913,17 @@ Only intended for interactive use." (defun ffap-guess-file-name-at-point () "Try to get a file name at point. This hook is intended to be put in `file-name-at-point-functions'." - (when (fboundp 'ffap-guesser) - ;; Logic from `ffap-read-file-or-url' and `dired-at-point-prompter'. - (let ((guess (ffap-guesser))) - (setq guess - (if (or (not guess) - (and (fboundp 'ffap-url-p) - (ffap-url-p guess)) - (and (fboundp 'ffap-file-remote-p) - (ffap-file-remote-p guess))) - guess - (abbreviate-file-name (expand-file-name guess)))) - (when guess - (if (file-directory-p guess) - (file-name-as-directory guess) - guess))))) - + (let ((guess (ffap-guesser))) + (when (stringp guess) + (let ((url (ffap-url-p guess))) + (or url + (progn + (unless (ffap-file-remote-p guess) + (setq guess + (abbreviate-file-name (expand-file-name guess)))) + (if (file-directory-p guess) + (file-name-as-directory guess) + guess))))))) ;;; Offer default global bindings (`ffap-bindings'): diff --git a/lisp/filecache.el b/lisp/filecache.el index 496cac402b3..ae3cb8d074a 100644 --- a/lisp/filecache.el +++ b/lisp/filecache.el @@ -139,9 +139,6 @@ ;;; Code: -(eval-when-compile - (require 'find-lisp)) - (defgroup file-cache nil "Find files using a pre-loaded cache." :group 'files @@ -270,44 +267,63 @@ files of names DIRNAME1/FILENAME, DIRNAME2/FILENAME, ...") ;; Functions to add files to the cache ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun file-cache--read-list (file op-prompt) + (let* ((fun (if file 'read-file-name 'read-directory-name)) + (type (if file "file" "directory")) + (prompt-1 (concat op-prompt " " type ": ")) + (prompt-2 (concat op-prompt " another " type "?")) + (continue t) + result) + (while continue + (push (funcall fun prompt-1 nil nil t) result) + (setq continue (y-or-n-p prompt-2))) + (nreverse result))) + ;;;###autoload (defun file-cache-add-directory (directory &optional regexp) - "Add DIRECTORY to the file cache. -If the optional REGEXP argument is non-nil, only files which match it will -be added to the cache." - (interactive "DAdd files from directory: ") + "Add all files in DIRECTORY to the file cache. +If called from Lisp with a non-nil REGEXP argument is non-nil, +only add files whose names match REGEXP." + (interactive (list (read-directory-name "Add files from directory: " + nil nil t) + nil)) ;; Not an error, because otherwise we can't use load-paths that ;; contain non-existent directories. - (if (not (file-accessible-directory-p directory)) - (message "Directory %s does not exist" directory) + (when (file-accessible-directory-p directory) (let* ((dir (expand-file-name directory)) (dir-files (directory-files dir t regexp))) ;; Filter out files we don't want to see (dolist (file dir-files) - (if (file-directory-p file) - (setq dir-files (delq file dir-files)) - (dolist (regexp file-cache-filter-regexps) - (if (string-match regexp file) - (setq dir-files (delq file dir-files)))))) + (if (file-directory-p file) + (setq dir-files (delq file dir-files)) + (dolist (regexp file-cache-filter-regexps) + (if (string-match regexp file) + (setq dir-files (delq file dir-files)))))) (file-cache-add-file-list dir-files)))) ;;;###autoload -(defun file-cache-add-directory-list (directory-list &optional regexp) - "Add DIRECTORY-LIST (a list of directory names) to the file cache. +(defun file-cache-add-directory-list (directories &optional regexp) + "Add DIRECTORIES (a list of directory names) to the file cache. +If called interactively, read the directory names one by one. If the optional REGEXP argument is non-nil, only files which match it will be added to the cache. Note that the REGEXP is applied to the files in each directory, not to the directory list itself." - (interactive "XAdd files from directory list: ") - (mapcar - (lambda (dir) (file-cache-add-directory dir regexp)) - directory-list)) - -(defun file-cache-add-file-list (file-list) - "Add FILE-LIST (a list of file names) to the file cache. -Interactively, FILE-LIST is read as a Lisp expression, which -should evaluate to the desired list of file names." - (interactive "XFile List: ") - (mapcar 'file-cache-add-file file-list)) + (interactive (list (file-cache--read-list nil "Add"))) + (dolist (dir directories) + (file-cache-add-directory dir regexp)) + (let ((n (length directories))) + (message "Filecache: cached file names from %d director%s." + n (if (= n 1) "y" "ies")))) + +(defun file-cache-add-file-list (files) + "Add FILES (a list of file names) to the file cache. +If called interactively, read the file names one by one." + (interactive (list (file-cache--read-list t "Add"))) + (dolist (f files) + (file-cache-add-file f)) + (let ((n (length files))) + (message "Filecache: cached %d file name%s." + n (if (= n 1) "" "s")))) ;; Workhorse function @@ -315,23 +331,25 @@ should evaluate to the desired list of file names." (defun file-cache-add-file (file) "Add FILE to the file cache." (interactive "fAdd File: ") - (if (not (file-exists-p file)) - (message "Filecache: file %s does not exist" file) - (let* ((file-name (file-name-nondirectory file)) - (dir-name (file-name-directory file)) - (the-entry (assoc-string - file-name file-cache-alist - file-cache-ignore-case))) - ;; Does the entry exist already? - (if the-entry - (if (or (and (stringp (cdr the-entry)) - (string= dir-name (cdr the-entry))) - (and (listp (cdr the-entry)) - (member dir-name (cdr the-entry)))) - nil - (setcdr the-entry (cons dir-name (cdr the-entry)))) - ;; If not, add it to the cache - (push (list file-name dir-name) file-cache-alist))))) + (setq file (file-truename file)) + (unless (file-exists-p file) + (error "Filecache: file %s does not exist" file)) + (let* ((file-name (file-name-nondirectory file)) + (dir-name (file-name-directory file)) + (the-entry (assoc-string file-name file-cache-alist + file-cache-ignore-case))) + (cond ((null the-entry) + ;; If the entry wasn't in the cache, add it. + (push (list file-name dir-name) file-cache-alist) + (if (called-interactively-p 'interactive) + (message "Filecache: cached file name %s." file))) + ((not (member dir-name (cdr the-entry))) + (setcdr the-entry (cons dir-name (cdr the-entry))) + (if (called-interactively-p 'interactive) + (message "Filecache: cached file name %s." file))) + (t + (if (called-interactively-p 'interactive) + (message "Filecache: %s is already cached." file)))))) ;;;###autoload (defun file-cache-add-directory-using-find (directory) @@ -368,6 +386,8 @@ STRING is passed as an argument to the locate command." string) (file-cache-add-from-file-cache-buffer)) +(autoload 'find-lisp-find-files "find-lisp") + ;;;###autoload (defun file-cache-add-directory-recursively (dir &optional regexp) "Adds DIR and any subdirectories to the file-cache. @@ -376,18 +396,16 @@ If the optional REGEXP argument is non-nil, only files which match it will be added to the cache. Note that the REGEXP is applied to the files in each directory, not to the directory list itself." (interactive "DAdd directory: ") - (require 'find-lisp) (mapcar - (function - (lambda (file) - (or (file-directory-p file) - (let (filtered) - (dolist (regexp file-cache-filter-regexps) - (and (string-match regexp file) - (setq filtered t))) - filtered) - (file-cache-add-file file)))) - (find-lisp-find-files dir (if regexp regexp "^")))) + (lambda (file) + (or (file-directory-p file) + (let (filtered) + (dolist (regexp file-cache-filter-regexps) + (and (string-match regexp file) + (setq filtered t))) + filtered) + (file-cache-add-file file))) + (find-lisp-find-files dir (or regexp "^")))) (defun file-cache-add-from-file-cache-buffer (&optional regexp) "Add any entries found in the file cache buffer. @@ -417,17 +435,26 @@ or the optional REGEXP argument." ;; This clears *all* files with the given name (defun file-cache-delete-file (file) - "Delete FILE from the file cache." + "Delete FILE (a relative file name) from the file cache. +Return nil if FILE was not in the file cache, non-nil otherwise." (interactive (list (completing-read "Delete file from cache: " file-cache-alist))) - (setq file-cache-alist - (delq (assoc-string file file-cache-alist file-cache-ignore-case) - file-cache-alist))) - -(defun file-cache-delete-file-list (file-list) - "Delete FILE-LIST (a list of files) from the file cache." - (interactive "XFile List: ") - (mapcar 'file-cache-delete-file file-list)) + (let ((elt (assoc-string file file-cache-alist file-cache-ignore-case))) + (setq file-cache-alist (delq elt file-cache-alist)) + elt)) + +(defun file-cache-delete-file-list (files &optional message) + "Delete FILES (a list of files) from the file cache. +If called interactively, read the file names one by one. +If MESSAGE is non-nil, or if called interactively, print a +message reporting the number of file names deleted." + (interactive (list (file-cache--read-list t "Uncache") t)) + (let ((n 0)) + (dolist (f files) + (if (file-cache-delete-file f) + (setq n (1+ n)))) + (message "Filecache: uncached %d file name%s." + n (if (= n 1) "" "s")))) (defun file-cache-delete-file-regexp (regexp) "Delete files matching REGEXP from the file cache." @@ -436,21 +463,18 @@ or the optional REGEXP argument." (dolist (elt file-cache-alist) (and (string-match regexp (car elt)) (push (car elt) delete-list))) - (file-cache-delete-file-list delete-list) - (message "Filecache: deleted %d files from file cache" - (length delete-list)))) + (file-cache-delete-file-list delete-list))) (defun file-cache-delete-directory (directory) "Delete DIRECTORY from the file cache." (interactive "DDelete directory from file cache: ") (let ((dir (expand-file-name directory)) - (result 0)) + (n 0)) (dolist (entry file-cache-alist) (if (file-cache-do-delete-directory dir entry) - (setq result (1+ result)))) - (if (zerop result) - (error "Filecache: no entries containing %s found in cache" directory) - (message "Filecache: deleted %d entries" result)))) + (setq n (1+ n)))) + (message "Filecache: uncached %d file name%s." + n (if (= n 1) "" "s")))) (defun file-cache-do-delete-directory (dir entry) (let ((directory-list (cdr entry)) @@ -461,10 +485,12 @@ or the optional REGEXP argument." (delq entry file-cache-alist)) (setcdr entry (delete directory directory-list)))))) -(defun file-cache-delete-directory-list (directory-list) - "Delete DIRECTORY-LIST (a list of directories) from the file cache." - (interactive "XDirectory List: ") - (mapcar 'file-cache-delete-directory directory-list)) +(defun file-cache-delete-directory-list (directories) + "Delete DIRECTORIES (a list of directory names) from the file cache. +If called interactively, read the directory names one by one." + (interactive (list (file-cache--read-list nil "Uncache"))) + (dolist (d directories) + (file-cache-delete-directory d))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Utility functions diff --git a/lisp/files.el b/lisp/files.el index 4aa913a4268..b015b53db3c 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -209,7 +209,6 @@ have fast storage with limited space, such as a RAM disk." (declare-function dired-unmark "dired" (arg)) (declare-function dired-do-flagged-delete "dired" (&optional nomessage)) (declare-function dos-8+3-filename "dos-fns" (filename)) -(declare-function view-mode-disable "view" ()) (declare-function dosified-file-name "dos-fns" (file-name)) (defvar file-name-invalid-regexp @@ -733,7 +732,7 @@ The path separator is colon in GNU and GNU-like systems." ;; This is a case where .elc makes a lot of sense. (interactive (list (let ((completion-ignored-extensions (remove ".elc" completion-ignored-extensions))) - (read-file-name "Load file: ")))) + (read-file-name "Load file: " nil nil 'lambda)))) (load (expand-file-name file) nil nil t)) (defun locate-file (filename path &optional suffixes predicate) @@ -2125,7 +2124,7 @@ unless NOMODES is non-nil." (setq buffer-read-only t)) (unless nomodes (when (and view-read-only view-mode) - (view-mode-disable)) + (view-mode -1)) (normal-mode t) ;; If requested, add a newline at the end of the file. (and (memq require-final-newline '(visit visit-save)) @@ -2358,7 +2357,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" . archive-mode) ("\\.\\(diffs?\\|patch\\|rej\\)\\'" . diff-mode) ("\\.\\(dif\\|pat\\)\\'" . diff-mode) ; for MSDOG ("\\.[eE]?[pP][sS]\\'" . ps-mode) - ("\\.\\(?:PDF\\|DVI\\|OD[FGPST]\\|DOCX?\\|XLSX?\\|PPTX?\\|pdf\\|dvi\\|od[fgpst]\\|docx?\\|xlsx?\\|pptx?\\)\\'" . doc-view-mode-maybe) + ("\\.\\(?:PDF\\|DVI\\|OD[FGPST]\\|DOCX?\\|XLSX?\\|PPTX?\\|pdf\\|djvu\\|dvi\\|od[fgpst]\\|docx?\\|xlsx?\\|pptx?\\)\\'" . doc-view-mode-maybe) ("configure\\.\\(ac\\|in\\)\\'" . autoconf-mode) ("\\.s\\(v\\|iv\\|ieve\\)\\'" . sieve-mode) ("BROWSE\\'" . ebrowse-tree-mode) @@ -2505,25 +2504,31 @@ They may happen to contain sequences that look like local variable specifications, but are not really, or they may be containers for member files with their own local variable sections, which are not appropriate for the containing file. -See also `inhibit-local-variables-suffixes'.") +The function `inhibit-local-variables-p' uses this.") (define-obsolete-variable-alias 'inhibit-first-line-modes-suffixes 'inhibit-local-variables-suffixes "24.1") (defvar inhibit-local-variables-suffixes nil "List of regexps matching suffixes to remove from file names. -When checking `inhibit-local-variables-regexps', we first discard -from the end of the file name anything that matches one of these regexps.") +The function `inhibit-local-variables-p' uses this: when checking +a file name, it first discards from the end of the name anything that +matches one of these regexps.") + +;; Can't think of any situation in which you'd want this to be nil... +(defvar inhibit-local-variables-ignore-case t + "Non-nil means `inhibit-local-variables-p' ignores case.") -;; TODO explicitly add case-fold-search t? (defun inhibit-local-variables-p () "Return non-nil if file local variables should be ignored. This checks the file (or buffer) name against `inhibit-local-variables-regexps' -and `inhibit-local-variables-suffixes'." +and `inhibit-local-variables-suffixes'. If +`inhibit-local-variables-ignore-case' is non-nil, this ignores case." (let ((temp inhibit-local-variables-regexps) (name (if buffer-file-name (file-name-sans-versions buffer-file-name) - (buffer-name)))) + (buffer-name))) + (case-fold-search inhibit-local-variables-ignore-case)) (while (let ((sufs inhibit-local-variables-suffixes)) (while (and sufs (not (string-match (car sufs) name))) (setq sufs (cdr sufs))) @@ -3390,30 +3395,39 @@ It is dangerous if either of these conditions are met: (setq ok t))) ok)))))))) +(defun hack-one-local-variable--obsolete (var) + (let ((o (get var 'byte-obsolete-variable))) + (when o + (let ((instead (nth 0 o)) + (since (nth 2 o))) + (message "%s is obsolete%s; %s" + var (if since (format " (since %s)" since)) + (if (stringp instead) instead + (format "use `%s' instead" instead))))))) + (defun hack-one-local-variable (var val) "Set local variable VAR with value VAL. If VAR is `mode', call `VAL-mode' as a function unless it's already the major mode." - (cond ((eq var 'mode) - (let ((mode (intern (concat (downcase (symbol-name val)) - "-mode")))) - (unless (eq (indirect-function mode) - (indirect-function major-mode)) - (if (memq mode minor-mode-list) - ;; A minor mode must be passed an argument. - ;; Otherwise, if the user enables the minor mode in a - ;; major mode hook, this would toggle it off. - (funcall mode 1) - (funcall mode))))) - ((eq var 'eval) - (save-excursion (eval val))) - (t - ;; Make sure the string has no text properties. - ;; Some text properties can get evaluated in various ways, - ;; so it is risky to put them on with a local variable list. - (if (stringp val) - (set-text-properties 0 (length val) nil val)) - (set (make-local-variable var) val)))) + (pcase var + (`mode + (let ((mode (intern (concat (downcase (symbol-name val)) + "-mode")))) + (unless (eq (indirect-function mode) + (indirect-function major-mode)) + (funcall mode)))) + (`eval + (pcase val + (`(add-hook ',hook . ,_) (hack-one-local-variable--obsolete hook))) + (save-excursion (eval val))) + (_ + (hack-one-local-variable--obsolete var) + ;; Make sure the string has no text properties. + ;; Some text properties can get evaluated in various ways, + ;; so it is risky to put them on with a local variable list. + (if (stringp val) + (set-text-properties 0 (length val) nil val)) + (set (make-local-variable var) val)))) ;;; Handling directory-local variables, aka project settings. @@ -3671,10 +3685,13 @@ and `file-local-variables-alist', without applying them." (dir-locals-get-class-variables class) dir-name nil))) (when variables (dolist (elt variables) - (unless (memq (car elt) '(eval mode)) - (setq dir-local-variables-alist - (assq-delete-all (car elt) dir-local-variables-alist))) - (push elt dir-local-variables-alist)) + (if (eq (car elt) 'coding) + (display-warning :warning + "Coding cannot be specified by dir-locals") + (unless (memq (car elt) '(eval mode)) + (setq dir-local-variables-alist + (assq-delete-all (car elt) dir-local-variables-alist))) + (push elt dir-local-variables-alist))) (hack-local-variables-filter variables dir-name))))))) (defun hack-dir-local-variables-non-file-buffer () @@ -3864,6 +3881,27 @@ Interactively, confirmation is required unless you supply a prefix argument." ;; the one at the old location. (vc-find-file-hook)) +(defun file-extended-attributes (filename) + "Return an alist of extended attributes of file FILENAME. + +Extended attributes are platform-specific metadata about the file, +such as SELinux context, list of ACL entries, etc." + `((acl . ,(file-acl filename)) + (selinux-context . ,(file-selinux-context filename)))) + +(defun set-file-extended-attributes (filename attributes) + "Set extended attributes of file FILENAME to ATTRIBUTES. + +ATTRIBUTES must be an alist of file attributes as returned by +`file-extended-attributes'." + (dolist (elt attributes) + (let ((attr (car elt)) + (val (cdr elt))) + (cond ((eq attr 'acl) + (set-file-acl filename val)) + ((eq attr 'selinux-context) + (set-file-selinux-context filename val)))))) + (defun backup-buffer () "Make a backup of the disk file visited by the current buffer, if appropriate. This is normally done before saving the buffer the first time. @@ -3873,13 +3911,14 @@ variable `make-backup-files'. If it's done by renaming, then the file is no longer accessible under its old name. The value is non-nil after a backup was made by renaming. -It has the form (MODES SELINUXCONTEXT BACKUPNAME). +It has the form (MODES EXTENDED-ATTRIBUTES BACKUPNAME). MODES is the result of `file-modes' on the original file; this means that the caller, after saving the buffer, should change the modes of the new file to agree with the old modes. -SELINUXCONTEXT is the result of `file-selinux-context' on the original -file; this means that the caller, after saving the buffer, should change -the SELinux context of the new file to agree with the old context. +EXTENDED-ATTRIBUTES is the result of `file-extended-attributes' +on the original file; this means that the caller, after saving +the buffer, should change the extended attributes of the new file +to agree with the old attributes. BACKUPNAME is the backup file name, which is the old file renamed." (if (and make-backup-files (not backup-inhibited) (not buffer-backed-up) @@ -3908,7 +3947,8 @@ BACKUPNAME is the backup file name, which is the old file renamed." (y-or-n-p (format "Delete excess backup versions of %s? " real-file-name))))) (modes (file-modes buffer-file-name)) - (context (file-selinux-context buffer-file-name))) + (extended-attributes + (file-extended-attributes buffer-file-name))) ;; Actually write the back up file. (condition-case () (if (or file-precious-flag @@ -3926,12 +3966,15 @@ BACKUPNAME is the backup file name, which is the old file renamed." (and (integerp (nth 2 attr)) (integerp backup-by-copying-when-privileged-mismatch) (<= (nth 2 attr) backup-by-copying-when-privileged-mismatch))) - (or (nth 9 attr) - (not (file-ownership-preserved-p real-file-name))))))) - (backup-buffer-copy real-file-name backupname modes context) + (not (file-ownership-preserved-p + real-file-name t)))))) + (backup-buffer-copy real-file-name + backupname modes + extended-attributes) ;; rename-file should delete old backup. (rename-file real-file-name backupname t) - (setq setmodes (list modes context backupname))) + (setq setmodes (list modes extended-attributes + backupname))) (file-error ;; If trouble writing the backup, write it in ;; .emacs.d/%backup%. @@ -3939,7 +3982,8 @@ BACKUPNAME is the backup file name, which is the old file renamed." (message "Cannot write backup file; backing up in %s" backupname) (sleep-for 1) - (backup-buffer-copy real-file-name backupname modes context))) + (backup-buffer-copy real-file-name backupname + modes extended-attributes))) (setq buffer-backed-up t) ;; Now delete the old versions, if desired. (if delete-old-versions @@ -3951,7 +3995,7 @@ BACKUPNAME is the backup file name, which is the old file renamed." setmodes) (file-error nil)))))) -(defun backup-buffer-copy (from-name to-name modes context) +(defun backup-buffer-copy (from-name to-name modes extended-attributes) (let ((umask (default-file-modes))) (unwind-protect (progn @@ -3977,10 +4021,12 @@ BACKUPNAME is the backup file name, which is the old file renamed." nil))) ;; Reset the umask. (set-default-file-modes umask))) - (and modes - (set-file-modes to-name (logand modes #o1777))) - (and context - (set-file-selinux-context to-name context))) + ;; If set-file-extended-attributes fails, fall back on set-file-modes. + (unless (and extended-attributes + (with-demoted-errors + (set-file-extended-attributes to-name extended-attributes))) + (and modes + (set-file-modes to-name (logand modes #o1777))))) (defvar file-name-version-regexp "\\(?:~\\|\\.~[-[:alnum:]:#@^._]+\\(?:~[[:digit:]]+\\)?~\\)" @@ -4004,22 +4050,44 @@ See also `file-name-version-regexp'." (string-match (concat file-name-version-regexp "\\'") name)))))) -(defun file-ownership-preserved-p (file) - "Return t if deleting FILE and rewriting it would preserve the owner." +(defun file-ownership-preserved-p (file &optional group) + "Return t if deleting FILE and rewriting it would preserve the owner. +Return nil if FILE does not exist, or if deleting and recreating it +might not preserve the owner. If GROUP is non-nil, check whether +the group would be preserved too." (let ((handler (find-file-name-handler file 'file-ownership-preserved-p))) (if handler - (funcall handler 'file-ownership-preserved-p file) + (funcall handler 'file-ownership-preserved-p file group) (let ((attributes (file-attributes file 'integer))) ;; Return t if the file doesn't exist, since it's true that no ;; information would be lost by an (attempted) delete and create. (or (null attributes) - (= (nth 2 attributes) (user-uid)) - ;; Files created on Windows by Administrator (RID=500) - ;; have the Administrators group (RID=544) recorded as - ;; their owner. Rewriting them will still preserve the - ;; owner. - (and (eq system-type 'windows-nt) - (= (user-uid) 500) (= (nth 2 attributes) 544))))))) + (and (or (= (nth 2 attributes) (user-uid)) + ;; Files created on Windows by Administrator (RID=500) + ;; have the Administrators group (RID=544) recorded as + ;; their owner. Rewriting them will still preserve the + ;; owner. + (and (eq system-type 'windows-nt) + (= (user-uid) 500) (= (nth 2 attributes) 544))) + (or (not group) + ;; On BSD-derived systems files always inherit the parent + ;; directory's group, so skip the group-gid test. + (memq system-type '(berkeley-unix darwin gnu/kfreebsd)) + (= (nth 3 attributes) (group-gid))) + (let* ((parent (or (file-name-directory file) ".")) + (parent-attributes (file-attributes parent 'integer))) + (and parent-attributes + ;; On some systems, a file created in a setuid directory + ;; inherits that directory's owner. + (or + (= (nth 2 parent-attributes) (user-uid)) + (string-match "^...[^sS]" (nth 8 parent-attributes))) + ;; On many systems, a file created in a setgid directory + ;; inherits that directory's group. On some systems + ;; this happens even if the setgid bit is not set. + (or (not group) + (= (nth 3 parent-attributes) + (nth 3 attributes))))))))))) (defun file-name-sans-extension (filename) "Return FILENAME sans final \"extension\". @@ -4555,8 +4623,11 @@ Before and after saving the buffer, this function runs (if setmodes (condition-case () (progn - (set-file-modes buffer-file-name (car setmodes)) - (set-file-selinux-context buffer-file-name (nth 1 setmodes))) + (unless + (with-demoted-errors + (set-file-modes buffer-file-name (car setmodes))) + (set-file-extended-attributes buffer-file-name + (nth 1 setmodes)))) (error nil)))) ;; If the auto-save file was recent before this command, ;; delete it now. @@ -4569,7 +4640,8 @@ Before and after saving the buffer, this function runs ;; This does the "real job" of writing a buffer into its visited file ;; and making a backup file. This is what is normally done ;; but inhibited if one of write-file-functions returns non-nil. -;; It returns a value (MODES SELINUXCONTEXT BACKUPNAME), like backup-buffer. +;; It returns a value (MODES EXTENDED-ATTRIBUTES BACKUPNAME), like +;; backup-buffer. (defun basic-save-buffer-1 () (prog1 (if save-buffer-coding-system @@ -4581,7 +4653,8 @@ Before and after saving the buffer, this function runs (setq buffer-file-coding-system-explicit (cons last-coding-system-used nil))))) -;; This returns a value (MODES SELINUXCONTEXT BACKUPNAME), like backup-buffer. +;; This returns a value (MODES EXTENDED-ATTRIBUTES BACKUPNAME), like +;; backup-buffer. (defun basic-save-buffer-2 () (let (tempsetmodes setmodes) (if (not (file-writable-p buffer-file-name)) @@ -4656,7 +4729,7 @@ Before and after saving the buffer, this function runs (setq setmodes (or setmodes (list (or (file-modes buffer-file-name) (logand ?\666 umask)) - (file-selinux-context buffer-file-name) + (file-extended-attributes buffer-file-name) buffer-file-name))) ;; We succeeded in writing the temp file, ;; so rename it. @@ -4668,10 +4741,16 @@ Before and after saving the buffer, this function runs (cond ((and tempsetmodes (not setmodes)) ;; Change the mode back, after writing. (setq setmodes (list (file-modes buffer-file-name) - (file-selinux-context buffer-file-name) + (file-extended-attributes buffer-file-name) buffer-file-name)) - (set-file-modes buffer-file-name (logior (car setmodes) 128)) - (set-file-selinux-context buffer-file-name (nth 1 setmodes))))) + ;; If set-file-extended-attributes fails, fall back on + ;; set-file-modes. + (unless + (with-demoted-errors + (set-file-extended-attributes buffer-file-name + (nth 1 setmodes))) + (set-file-modes buffer-file-name + (logior (car setmodes) 128)))))) (let (success) (unwind-protect (progn @@ -5403,18 +5482,20 @@ Then you'll be asked about a number of files to recover." (let ((ls-lisp-support-shell-wildcards t)) (dired (concat auto-save-list-file-prefix "*") (concat dired-listing-switches " -t"))) + (use-local-map (nconc (make-sparse-keymap) (current-local-map))) + (define-key (current-local-map) "\C-c\C-c" 'recover-session-finish) (save-excursion (goto-char (point-min)) (or (looking-at " Move to the session you want to recover,") (let ((inhibit-read-only t)) ;; Each line starts with a space ;; so that Font Lock mode won't highlight the first character. - (insert " Move to the session you want to recover,\n" - " then type C-c C-c to select it.\n\n" - " You can also delete some of these files;\n" - " type d on a line to mark that file for deletion.\n\n")))) - (use-local-map (nconc (make-sparse-keymap) (current-local-map))) - (define-key (current-local-map) "\C-c\C-c" 'recover-session-finish)) + (insert " To recover a session, move to it and type C-c C-c.\n" + (substitute-command-keys + " To delete a session file, type \ +\\[dired-flag-file-deletion] on its line to flag + the file for deletion, then \\[dired-do-flagged-delete] to \ +delete flagged files.\n\n")))))) (defun recover-session-finish () "Choose one saved session to recover auto-save files from. @@ -5648,7 +5729,7 @@ See also `auto-save-file-name-p'." (defun auto-save-file-name-p (filename) "Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'. FILENAME should lack slashes. You can redefine this for customization." - (string-match "^#.*#$" filename)) + (string-match "\\`#.*#\\'" filename)) (defun wildcard-to-regexp (wildcard) "Given a shell file name pattern WILDCARD, return an equivalent regexp. diff --git a/lisp/find-cmd.el b/lisp/find-cmd.el index a766b9091fe..a41a32762dc 100644 --- a/lisp/find-cmd.el +++ b/lisp/find-cmd.el @@ -63,6 +63,7 @@ (cnewer . (1)) (ctime . (1)) (empty . (0)) + (executable . (0)) (false . (0)) (fstype . (1)) (gid . (1)) @@ -70,37 +71,43 @@ (ilname . (1)) (iname . (1)) (inum . (1)) - (iwholename . (1)) + (ipath . (1)) (iregex . (1)) + (iwholename . (1)) (links . (1)) (lname . (1)) (mmin . (1)) (mtime . (1)) (name . (1)) (newer . (1)) - (nouser . (0)) (nogroup . (0)) + (nouser . (0)) (path . (1)) (perm . (0)) + (readable . (0)) (regex . (1)) - (wholename . (1)) + (samefile . (1)) (size . (1)) (true . (0)) (type . (1)) (uid . (1)) (used . (1)) (user . (1)) + (wholename . (1)) + (writable . (0)) (xtype . (nil)) ;; normal options (always true) + (daystart . (0)) (depth . (0)) (maxdepth . (1)) (mindepth . (1)) (mount . (0)) (noleaf . (0)) - (xdev . (0)) (ignore_readdir_race . (0)) (noignore_readdir_race . (0)) + (regextype . (1)) + (xdev . (0)) ;; actions (delete . (0)) diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 7a2577eabbb..f714eaab233 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -469,7 +469,7 @@ optimized.") "Alist of additional `font-lock-keywords' elements for major modes. Each element has the form (MODE KEYWORDS . HOW). -`font-lock-set-defaults' adds the elements in the list KEYWORDS to +Function `font-lock-set-defaults' adds the elements in the list KEYWORDS to `font-lock-keywords' when Font Lock is turned on in major mode MODE. If HOW is nil, KEYWORDS are added at the beginning of @@ -484,7 +484,7 @@ This is normally set via `font-lock-add-keywords' and (defvar font-lock-removed-keywords-alist nil "Alist of `font-lock-keywords' elements to be removed for major modes. -Each element has the form (MODE . KEYWORDS). `font-lock-set-defaults' +Each element has the form (MODE . KEYWORDS). Function `font-lock-set-defaults' removes the elements in the list KEYWORDS from `font-lock-keywords' when Font Lock is turned on in major mode MODE. diff --git a/lisp/frame.el b/lisp/frame.el index 6b6b7a28c66..2c17b781caa 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1654,12 +1654,60 @@ terminals, cursor blinking is controlled by the terminal." 'blink-cursor-start)))) +;; Frame maximization/fullscreen + +(defun toggle-frame-maximized () + "Toggle maximization state of the selected frame. +Maximize the selected frame or un-maximize if it is already maximized. +Respect window manager screen decorations. +If the frame is in fullscreen mode, don't change its mode, +just toggle the temporary frame parameter `maximized', +so the frame will go to the right maximization state +after disabling fullscreen mode. +See also `toggle-frame-fullscreen'." + (interactive) + (if (eq (frame-parameter nil 'fullscreen) 'fullscreen) + (modify-frame-parameters + nil + `((maximized + . ,(unless (eq (frame-parameter nil 'maximized) 'maximized) + 'maximized)))) + (modify-frame-parameters + nil + `((fullscreen + . ,(unless (eq (frame-parameter nil 'fullscreen) 'maximized) + 'maximized)))))) + +(defun toggle-frame-fullscreen () + "Toggle fullscreen mode of the selected frame. +Enable fullscreen mode of the selected frame or disable if it is +already fullscreen. Ignore window manager screen decorations. +When turning on fullscreen mode, remember the previous value of the +maximization state in the temporary frame parameter `maximized'. +Restore the maximization state when turning off fullscreen mode. +See also `toggle-frame-maximized'." + (interactive) + (modify-frame-parameters + nil + `((maximized + . ,(unless (eq (frame-parameter nil 'fullscreen) 'fullscreen) + (frame-parameter nil 'fullscreen))) + (fullscreen + . ,(if (eq (frame-parameter nil 'fullscreen) 'fullscreen) + (if (eq (frame-parameter nil 'maximized) 'maximized) + 'maximized) + 'fullscreen))))) + + ;;;; Key bindings (define-key ctl-x-5-map "2" 'make-frame-command) (define-key ctl-x-5-map "1" 'delete-other-frames) (define-key ctl-x-5-map "0" 'delete-frame) (define-key ctl-x-5-map "o" 'other-frame) +(define-key global-map [f11] 'toggle-frame-fullscreen) +(define-key global-map [(meta f10)] 'toggle-frame-maximized) +(define-key esc-map [f10] 'toggle-frame-maximized) ;; Misc. diff --git a/lisp/generic-x.el b/lisp/generic-x.el index e77cbe1eb14..d0250cb5210 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el @@ -549,6 +549,9 @@ like an INI file. You can add this hook to `find-file-hook'." (concat (w32-shell-name) " -c " (buffer-file-name))))) (eval-when-compile (require 'comint)) +(declare-function comint-mode "comint" ()) +(declare-function comint-exec "comint" (buffer name command startfile switches)) + (defun bat-generic-mode-run-as-comint () "Run the current BAT file in a comint buffer." (interactive) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 0bf13ae4eb9..745e0ede5a8 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,99 @@ +2013-01-21 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-sum.el (gnus-summary-read-group-1): Protect against not being + able to find the article, which can happen in debbugs groups, + apparently. + +2013-01-16 Glenn Morris <rgm@gnu.org> + + * smiley.el (smiley-style): Make the file loadable in batch mode. + +2013-01-15 Stefan Monnier <monnier@iro.umontreal.ca> + + * nnimap.el (nnimap-keepalive): Don't throw an error if there's no more + imap process running. + +2013-01-14 Julien Danjou <julien@danjou.info> + + * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): + Compare addresses against addresses, not against the full From field. + +2013-01-13 Richard Stallman <rms@gnu.org> + + * message.el (message-forward-make-body-mime): New args BEG, END + specify what part of FORWARD-BUFFER to use. Do the work directly + instead of calling `mml-insert-buffer'. + +2013-01-11 Aaron S. Hawley <Aaron.Hawley@vtinfo.com> + + * gnus-start.el (gnus-check-new-newsgroups): Fix ambiguous doc string + cross-reference(s). + + * gnus-sum.el (gnus-summary-newsgroup-prefix): Fix ambiguous doc string + cross-reference(s). + +2013-01-11 Dmitry Antipov <dmantipov@yandex.ru> + + * gnus-art.el (gnus-mime-display-security): Use point-min-marker + and point-max-marker. + * gnus-async.el (gnus-async-article-callback): Use point-max-marker. + +2013-01-10 Uwe Brauer <oub@mat.ucm.es> (tiny change) + + * mml-smime.el (mml-smime-encrypt-to-self): New user option analogous + to mml2015-encrypt-to-self. + (mml-smime-epg-encrypt): Respect mml-smime-encrypt-to-self. + +2013-01-09 Daiki Ueno <ueno@gnu.org> + + * mml-smime.el (epg-sub-key-fingerprint): Autoload for + mml-smime-epg-find-usable-secret-key. + +2013-01-08 Glenn Morris <rgm@gnu.org> + + * mml-smime.el (mml-smime-sign-with-sender): Add :version. + +2013-01-07 Daiki Ueno <ueno@gnu.org> + + * mml-smime.el: Support signing by sender. + Requested by Uwe Brauer. + (mml-smime-sign-with-sender): New user option analogous + to mml2015-sign-with-sender. + (mml-smime-epg-sign): Respect mml-smime-sign-with-sender. + (mml-smime-epg-find-usable-secret-key): New helper function copied from + mml2015.el. + +2012-12-31 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-msg.el (gnus-inews-insert-gcc): Don't insert Gcc headers if Gnus + isn't running, because Gnus will probably not know how to handle the + Gcc header (bug#11941). + + * nnimap.el (nnimap-update-info): Treat \Deleted articles as \Read + articles. + +2012-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnfolder.el (nnfolder-recursive-directory-files): New function. + (nnfolder-generate-active-file): Make this function work with recursive + folder names. + +2012-12-27 Lars Ingebrigtsen <larsi@gnus.org> + + * nntp.el (nntp-open-connection): Use HELP as the capability command + instead of CAPABILITY because Typhoon v2.2.2.503 chokes completely on + unknown commands. And CAPABILITY is an unknown command (bug#12763). + +2012-12-27 Wolfgang Jenkner <wjenkner@inode.at> + + * gnus-spec.el (gnus-face-face-function): Don't use nil as no-op face + place holder since this gives `Invalid face reference: nil' messages. + Use the `default' face instead. It has the same effect here, even + though it is not no-op. + + * gnus-util.el + (gnus-put-text-property-excluding-characters-with-faces): Similarly. + 2012-12-27 Lars Ingebrigtsen <larsi@gnus.org> * gnus-msg.el (gnus-summary-resend-message): Don't bug out on @@ -6,18 +102,243 @@ 2012-12-27 Glenn Morris <rgm@gnu.org> * plstore.el (plstore-passphrase-callback-function): - Fix file/buffer typo. (Bug#13264) + Use plstore-get-file. + +2012-12-27 Andreas Schwab <schwab@linux-m68k.org> -2012-12-24 Andreas Schwab <schwab@linux-m68k.org> + * mml2015.el (mml2015-epg-key-image): Separate attribute stream from + stderr. * nnimap.el (nnimap-find-article-by-message-id): Don't error out if group is nil. -2012-12-23 Andreas Schwab <schwab@linux-m68k.org> - * shr.el (shr-tag-em): Render as italic, not bold. -2012-12-02 Andreas Schwab <schwab@linux-m68k.org> +2012-12-26 Katsumi Yamaoka <yamaoka@jpl.org> + + * mml2015.el (mml2015-epg-key-image): Use mm-set-buffer-multibyte. + +2012-12-25 Adam Sjøgren <asjo@koldfront.dk> + + * mml2015.el (mml2015-epg-key-image): use --attribute-fd rather than + temporary file to get PGP key image. Pass no-show-photos when extracting + image to avoid having it pop up twice. + +2012-12-26 Lars Ingebrigtsen <larsi@gnus.org> + + * gnus-art.el (gnus-article-treat-types): Include text/html as parts + eligible for treatment. + + * gnus-util.el (gnus-goto-colon): Move to the beginning of the visual + lines. This makes summary commands with hidden threads work more + reliably. + + * gnus-cite.el (gnus-article-hide-citation-maybe): Leave an expansion + button to mark the hidden citations (bug#9395). + +2012-12-26 Daiki Ueno <ueno@gnu.org> + + * mml2015.el (mml2015-epg-signature-to-string): New function. + (mml2015-epg-verify-result-to-string): New function. + (mml2015-epg-decrypt, mml2015-epg-clear-decrypt, mml2015-epg-verify) + (mml2015-epg-clear-verify): Use mml2015-epg-verify-result-to-string + instead of epg-verify-result-to-string. + (epg-signature-key-id, epg-signature-to-string): Autoload. + (epg-verify-result-to-string): Remove autoload. + +2012-12-25 Adam Sjøgren <asjo@koldfront.dk> + + * mml2015.el (mml2015-epg-key-image): New function, to retrieve photo + ID image from GPG public key. + (mml2015-epg-key-image-to-string): New function. + +2012-12-25 Leo Liu <sdl.web@gmail.com> + + * plstore.el (plstore-passphrase-callback-function): Fix error when + error when plstore-cache-passphrase-for-symmetric-encryption is set + (bug#13264). + +2012-12-25 Lars Ingebrigtsen <larsi@gnus.org> + + * gnus-sum.el (gnus-set-global-variables): Don't copy over the summary + buffer to the article buffer here, because that clobbers multiple + article buffers. + + * gnus-art.el (gnus-article-setup-buffer): Make sure that the article + buffer always points to the right summary buffer. + +2012-12-25 John Wiegley <jwiegley@gmail.com> + + * auth-source.el (auth-source-netrc-parse): Allow using "password" as + the password (bug#12097). + +2012-12-25 Lars Ingebrigtsen <larsi@gnus.org> + + * shr.el (shr-tag-a): Don't tagify <A> elements that don't have HREFs + (bug#13263). + + * gnus-salt.el (gnus-highlight-selected-tree): Check whether the Tree + buffer exists before using it (bug#12475). + + * gnus-agent.el (gnus-agent-fetch-articles): Don't fetch articles from + offline groups (bug#11937). + + * message.el (message-yank-original): When using customize to set the + value of `message-cite-style', the variable it set to a symbol that's + the name of the variable, which must then be dereferenced (bug#12616). + +2012-12-25 Wolfgang Jenkner <wjenkner@inode.at> + + * lisp/gnus-spec.el (gnus-face-face-function): Initialize the value of + the `face' property with a list whose car is the face specified in the + format string and whose cdr is (nil). + * lisp/gnus-util.el + (gnus-put-text-property-excluding-characters-with-faces): + Change accordingly. + (gnus-get-text-property-excluding-characters-with-faces): New function. + * lisp/gnus-sum.el (gnus-summary-highlight-line): + * lisp/gnus-salt.el (gnus-tree-highlight-node): + * lisp/gnus-group.el (gnus-group-highlight-line): Use it. + +2012-12-25 Lars Ingebrigtsen <larsi@gnus.org> + + * nnimap.el (nnimap-authenticator): Expand to allow specifying the + login methods. + (nnimap-login): Respect the `nnimap-authenticator' variable. + + * gnus-sum.el (gnus-summary-push-marks-to-backend): Push the complete + mark state when moving articles. Otherwise unticked articles will get + their ticks back after moving. + +2012-12-24 Lars Ingebrigtsen <larsi@gnus.org> + + * gnus-srvr.el (gnus-browse-delete-group): Fix syntax error. + + * message.el (message-ignored-news-headers): Always remove + X-Message-SMTP-Method to avoid information leakage if the user + mistakenly inserts the header into news messages. + + * gnus-srvr.el (gnus-browse-delete-group): New command and keystroke. + + * gnus-sum.el (gnus-summary-hide-thread): If point were further to the + right than four characters, this command would move point to + `point-max'. Don't do that. + + * gnus-group.el (gnus-group-read-ephemeral-group): Set the active data + to nil to allow re-selecting groups that gain articles. + (gnus-bug-group-download-format-alist): Update the URL. + +2012-12-23 Andreas Schwab <schwab@suse.de> + + * shr.el (shr-tag-em): Render em as italic, not bold. + +2012-12-23 Lars Ingebrigtsen <larsi@gnus.org> + + * gnus-int.el (gnus-backend-trace): Factor out into its own function + for reuse. + (gnus-open-server): Use it to add more tracing. + (gnus-finish-retrieve-group-infos): Add backend tracing. + (gnus-backend-trace): Also note the elapsed seconds. + +2012-12-22 Philipp Haselwarter <philipp@haselwarter.org> + + * gnus-sync.el (gnus-sync-file-encrypt-to, gnus-sync-save): + Set epa-file-encrypt-to from variable to avoid querying. + +2012-12-14 Akinori MUSHA <knu@iDaemons.org> (tiny change) + + * sieve-mode.el (sieve-font-lock-keywords): + Keywords should be word delimited. (Bug#13173) + +2012-12-12 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-browse-html-parts): Use <div align="left"> + instead of <pre> to align message header. + +2012-12-12 Sam Steingold <sds@gnu.org> + + * gnus.el (gnus-other-frame-resume-function): Add user option. + (gnus-other-frame): Call `gnus-other-frame-resume-function' on resume. + +2012-12-06 Sam Steingold <sds@gnu.org> + + * gnus-start.el (gnus-before-resume-hook): Add. + (gnus-1): Run it when Gnus is alive. + +2012-12-06 Katsumi Yamaoka <yamaoka@jpl.org> + + * gmm-utils.el (gmm-called-interactively-p): Restore as a macro. + * gnus-art.el (article-unsplit-urls) + * gnus-bookmark.el (gnus-bookmark-bmenu-list) + * gnus-registry.el (gnus-registry-get-article-marks) + * message.el (message-goto-body): Use it. + (message-called-interactively-p): Remove. + + * spam-stat.el (spam-stat-called-interactively-p): New macro. + (spam-stat-score-buffer): Use it. + + * spam.el: Silence the warnings against BBDB functions when compiling. + + * gnus-score.el (gnus-score-decode-text-parts): + Use append+mapcar instead of the cl function mapcan. + + * gmm-utils.el (gmm-flet): Remove. + + * gnus-sync.el (gnus-sync-lesync-call): + Avoid overriding json-alist-p. + + * message.el (message-read-from-minibuffer): + Avoid overriding mail-abbrev-in-expansion-header-p. + +2012-12-05 Sam Steingold <sds@gnu.org> + + * gnus.el (gnus-delete-gnus-frame): Extract from `gnus-other-frame'. + (gnus-other-frame): Add `gnus-delete-gnus-frame' to + `gnus-suspend-gnus-hook' in addition to `gnus-exit-gnus-hook'. + +2012-12-05 Katsumi Yamaoka <yamaoka@jpl.org> + + * gmm-utils.el (gmm-called-interactively-p): Revert. + This seems to cause Emacs to get stuck! + * gnus-art.el (article-unsplit-urls) + * gnus-bookmark.el (gnus-bookmark-bmenu-list) + * gnus-registry.el (gnus-registry-get-article-marks) + * message.el (message-goto-body) + (message-called-interactively-p): Revert. + + * gmm-utils.el (gmm-called-interactively-p): New function. + * gnus-art.el (article-unsplit-urls) + * gnus-bookmark.el (gnus-bookmark-bmenu-list) + * gnus-registry.el (gnus-registry-get-article-marks) + * message.el (message-goto-body): Use it. + (message-called-interactively-p): Remove. + + * gmm-utils.el (gmm-flet): Restore it using cl-letf. + * gnus-sync.el (gnus-sync-lesync-call) + * message.el (message-read-from-minibuffer): Use it. + +2012-12-05 Katsumi Yamaoka <yamaoka@jpl.org> + + * gmm-utils.el (gmm-flet): Remove. + * gnus-sync.el (gnus-sync-lesync-call) + * message.el (message-read-from-minibuffer): Don't use it. + +2012-12-04 Katsumi Yamaoka <yamaoka@jpl.org> + + * gmm-utils.el (gmm-labels): Use cl-labels if available. + +2012-12-04 Katsumi Yamaoka <yamaoka@jpl.org> + + * gmm-utils.el (gmm-flet, gmm-labels): New macros. + + * gnus-sync.el (gnus-sync-lesync-call) + * message.el (message-read-from-minibuffer): Use gmm-flet. + + * gnus-score.el (gnus-score-decode-text-parts): Use gmm-labels. + + * gnus-util.el (gnus-macroexpand-all): Remove. + +2012-12-03 Andreas Schwab <schwab@linux-m68k.org> * gnus-sum.el (gnus-summary-mode-map): Bind gnus-summary-widget-forward to TAB, not [tab]. @@ -26,13 +347,18 @@ * gnus-sync.el (gnus-sync-newsrc-offsets): Restore definition. (gnus-sync-save): Use correct format for gnus-sync-newsrc-loader. +2012-11-19 Katsumi Yamaoka <yamaoka@jpl.org> + + * message.el (message-get-reply-headers): + Make sure the reply goes to the author if it is a wide reply. + 2012-11-16 Jan Tatarik <jan.tatarik@gmail.com> * gnus-score.el (gnus-score-body): * gnus-logic.el (gnus-advanced-body): Don't score by headers when scoring by body. -2012-11-13 Glenn Morris <rgm@gnu.org> +2012-11-16 Glenn Morris <rgm@gnu.org> * gnus-diary.el (nndiary-request-create-group-functions) (nndiary-request-update-info-functions) @@ -40,6 +366,36 @@ (nndiary-request-accept-article-functions): Use new names for hooks rather than obsolete aliases. +2012-11-08 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-article-browse-html-parts): Always replace charset + in meta tag with the one the part specifies in its header. + +2012-11-02 Stephen Eglen <S.J.Eglen@damtp.cam.ac.uk> + + * gnus-dired.el (gnus-dired-attach): Attach to last used message buffer + by default. + +2012-11-02 Katsumi Yamaoka <yamaoka@jpl.org> + + New UIDL implementation. + + * mail-source.el (mail-sources, mail-source-keyword-map): + Add :leave as a pop3 keyword. + (mail-source-fetch-pop): Bind pop3-leave-mail-on-server. + + * pop3.el (pop3-leave-mail-on-server): Allow number. + (pop3-uidl-file, pop3-uidl-file-backup): New user options. + (pop3-movemail): Add UIDL support. + (pop3-send-streaming-command): Take a list of mail numbers instead of + the number of mails. + (pop3-write-to-file): Add X-UIDL header. + (pop3-uidl-stat, pop3-uidl-dele, pop3-uidl-load, pop3-uidl-save) + (pop3-uidl-add-xheader): New functions. + + * message.el (message-ignored-resent-headers): + Add X-Content-Length and X-UIDL headers. + 2012-10-23 Stefan Monnier <monnier@iro.umontreal.ca> * nndiary.el (nndiary-request-create-group-functions) diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index 6e6c74509f0..ac16200adb2 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el @@ -1008,7 +1008,7 @@ Note that the MAX parameter is used so we can exit the parse early." (while (and (zerop (forward-line 1)) (looking-at "$"))) (narrow-to-region (point) (point))) - ((member elem tokens) + ((and (member elem tokens) (null pair)) ;; Tokens that don't have a following value are ignored, ;; except "default". (when (and pair (or (cdr pair) diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el index c009ac762c5..8bafb7d0f6b 100644 --- a/lisp/gnus/gmm-utils.el +++ b/lisp/gnus/gmm-utils.el @@ -417,6 +417,31 @@ coding-system." (write-region start end filename append visit lockname)) (write-region start end filename append visit lockname mustbenew))) +;; `interactive-p' is obsolete since Emacs 23.2. +(defmacro gmm-called-interactively-p (kind) + (condition-case nil + (progn + (eval '(called-interactively-p 'any)) + ;; Emacs >=23.2 + `(called-interactively-p ,kind)) + ;; Emacs <23.2 + (wrong-number-of-arguments '(called-interactively-p)) + ;; XEmacs + (void-function '(interactive-p)))) + +;; `labels' is obsolete since Emacs 24.3. +(defmacro gmm-labels (bindings &rest body) + "Make temporary function bindings. +The bindings can be recursive and the scoping is lexical, but capturing +them in closures will only work if `lexical-binding' is in use. But in +Emacs 24.2 and older, the lexical scoping is handled via `lexical-let' +rather than relying on `lexical-binding'. + +\(fn ((FUNC ARGLIST BODY...) ...) FORM...)" + `(,(progn (require 'cl) (if (fboundp 'cl-labels) 'cl-labels 'labels)) + ,bindings ,@body)) +(put 'gmm-labels 'lisp-indent-function 1) + (provide 'gmm-utils) ;;; gmm-utils.el ends here diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 681ae6c0a09..1d0f346e10f 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -1489,7 +1489,8 @@ downloaded into the agent." (defun gnus-agent-fetch-articles (group articles) "Fetch ARTICLES from GROUP and put them into the Agent." - (when articles + (when (and articles + (gnus-online (gnus-group-method group))) (gnus-agent-load-alist group) (let* ((alist gnus-agent-article-alist) (headers (if (< (length articles) 2) nil gnus-newsgroup-headers)) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 74733356283..25a555f3d8b 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -1121,8 +1121,8 @@ parts. When nil, redisplay article." (const :tag "Header" head))) (defvar gnus-article-treat-types '("text/plain" "text/x-verbatim" - "text/x-patch") - "Parts to treat.") + "text/x-patch" "text/html") + "Part types eligible for treatment.") (defvar gnus-inhibit-treatment nil "Whether to inhibit treatment.") @@ -2718,7 +2718,7 @@ If READ-CHARSET, ask for a coding system." (while (re-search-forward "\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t) (replace-match "\\1\\3" t))) - (when (interactive-p) + (when (gmm-called-interactively-p 'any) (gnus-treat-article nil)))) (defun article-wash-html () @@ -2877,21 +2877,23 @@ message header will be added to the bodies of the \"text/html\" parts." ;; Add a meta html tag to specify charset and a header. (cond (header - (let (title eheader body hcharset coding force-charset) + (let (title eheader body hcharset coding) (with-temp-buffer (mm-enable-multibyte) (setq case-fold-search t) (insert header "\n") (setq title (message-fetch-field "subject")) (goto-char (point-min)) - (while (re-search-forward "\\(<\\)\\|\\(>\\)\\|&" nil t) + (while (re-search-forward "\\(<\\)\\|\\(>\\)\\|\\(&\\)\\|\n" + nil t) (replace-match (cond ((match-beginning 1) "<") ((match-beginning 2) ">") - (t "&")))) + ((match-beginning 3) "&") + (t "<br>\n")))) (goto-char (point-min)) - (insert "<pre>\n") + (insert "<div align=\"left\">\n") (goto-char (point-max)) - (insert "</pre>\n<hr>\n") + (insert "</div>\n<hr>\n") ;; We have to examine charset one by one since ;; charset specified in parts might be different. (if (eq charset 'gnus-decoded) @@ -2900,8 +2902,7 @@ message header will be added to the bodies of the \"text/html\" parts." charset) title (when title (mm-encode-coding-string title charset)) - body (mm-encode-coding-string content charset) - force-charset t) + body (mm-encode-coding-string content charset)) (setq hcharset (mm-find-mime-charset-region (point-min) (point-max))) (cond ((= (length hcharset) 1) @@ -2932,8 +2933,7 @@ message header will be added to the bodies of the \"text/html\" parts." body (mm-encode-coding-string (mm-decode-coding-string content body) - charset) - force-charset t))) + charset)))) (setq charset hcharset eheader (mm-encode-coding-string (buffer-string) coding) @@ -2947,7 +2947,7 @@ message header will be added to the bodies of the \"text/html\" parts." (mm-disable-multibyte) (insert body) (when charset - (mm-add-meta-html-tag handle charset force-charset)) + (mm-add-meta-html-tag handle charset t)) (when title (goto-char (point-min)) (unless (search-forward "<title>" nil t) @@ -4539,18 +4539,17 @@ commands: (gnus-article-mode)) (setq truncate-lines gnus-article-truncate-lines) (current-buffer)) - (with-current-buffer (gnus-get-buffer-create name) - (gnus-article-mode) - (setq truncate-lines gnus-article-truncate-lines) - (make-local-variable 'gnus-summary-buffer) - (setq gnus-summary-buffer - (gnus-summary-buffer-name gnus-newsgroup-name)) - (gnus-summary-set-local-parameters gnus-newsgroup-name) - (when article-lapsed-timer - (gnus-stop-date-timer)) - (when gnus-article-update-date-headers - (gnus-start-date-timer gnus-article-update-date-headers)) - (current-buffer))))) + (let ((summary gnus-summary-buffer)) + (with-current-buffer (gnus-get-buffer-create name) + (gnus-article-mode) + (setq truncate-lines gnus-article-truncate-lines) + (set (make-local-variable 'gnus-summary-buffer) summary) + (gnus-summary-set-local-parameters gnus-newsgroup-name) + (when article-lapsed-timer + (gnus-stop-date-timer)) + (when gnus-article-update-date-headers + (gnus-start-date-timer gnus-article-update-date-headers)) + (current-buffer)))))) (defun gnus-article-stop-animations () (dolist (timer (and (boundp 'timer-list) @@ -8689,9 +8688,7 @@ For example: gnus-mime-security-button-end-line-format)) (gnus-insert-mime-security-button handle))) (mm-set-handle-multipart-parameter - handle 'gnus-region - (cons (set-marker (make-marker) (point-min)) - (set-marker (make-marker) (point-max)))) + handle 'gnus-region (cons (point-min-marker) (point-max-marker))) (goto-char (point-max)))) (defun gnus-mime-security-run-function (function) diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el index 41b0cc25006..c5d64332547 100644 --- a/lisp/gnus/gnus-async.el +++ b/lisp/gnus/gnus-async.el @@ -254,7 +254,7 @@ that was fetched." gnus-async-article-alist (cons (list (intern (format "%s-%d" group article) gnus-async-hashtb) - mark (set-marker (make-marker) (point-max)) + mark (point-max-marker) group article) gnus-async-article-alist)))) (if (not (gnus-buffer-live-p summary)) diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el index 5afdb064fa9..7a3d273622a 100644 --- a/lisp/gnus/gnus-bookmark.el +++ b/lisp/gnus/gnus-bookmark.el @@ -367,7 +367,7 @@ The leftmost column displays a D if the bookmark is flagged for deletion, or > if it is flagged for displaying." (interactive) (gnus-bookmark-maybe-load-default-file) - (if (interactive-p) + (if (gmm-called-interactively-p 'any) (switch-to-buffer (get-buffer-create "*Gnus Bookmark List*")) (set-buffer (get-buffer-create "*Gnus Bookmark List*"))) (let ((inhibit-read-only t) diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index 708b60442da..3840f33687c 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el @@ -745,28 +745,14 @@ See also the documentation for `gnus-article-highlight-citation'." (gnus-article-search-signature) (setq total (count-lines start (point))) (while atts - (setq hidden (+ hidden (length (cdr (assoc (cdar atts) - gnus-cite-prefix-alist)))) + (setq hidden (+ hidden (length + (cdr (assoc (cdar atts) + gnus-cite-prefix-alist)))) atts (cdr atts))) (when (or force (and (> (* 100 hidden) (* gnus-cite-hide-percentage total)) (> hidden gnus-cite-hide-absolute))) - (gnus-add-wash-type 'cite) - (setq atts gnus-cite-attribution-alist) - (while atts - (setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist)) - atts (cdr atts)) - (while total - (setq hidden (car total) - total (cdr total)) - (goto-char (point-min)) - (forward-line (1- hidden)) - (unless (assq hidden gnus-cite-attribution-alist) - (gnus-add-text-properties - (point) (progn (forward-line 1) (point)) - (nconc (list 'article-type 'cite) - gnus-hidden-properties))))))))) - (gnus-set-mode-line 'article))) + (gnus-article-hide-citation))))))) (defun gnus-article-hide-citation-in-followups () "Hide cited text in non-root articles." diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el index e5ebb39f6d2..1592d73684c 100644 --- a/lisp/gnus/gnus-dired.el +++ b/lisp/gnus/gnus-dired.el @@ -155,8 +155,8 @@ filenames." (setq destination (if (= (length bufs) 1) (get-buffer (car bufs)) - (gnus-completing-read "Attach to which mail composition buffer" - bufs t))) + (gnus-completing-read "Attach to buffer" + bufs t nil nil (car bufs)))) ;; setup a new mail composition buffer (let ((mail-user-agent gnus-dired-mail-mode) ;; A workaround to prevent Gnus from displaying the Gnus diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 675d94fd26a..700d319228f 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -1667,7 +1667,7 @@ and ends at END." (let ((face (cdar (gnus-group-update-eval-form group gnus-group-highlight)))) - (unless (eq face (get-text-property beg 'face)) + (unless (eq face (gnus-get-text-property-excluding-characters-with-faces beg 'face)) (let ((inhibit-read-only t)) (gnus-put-text-property-excluding-characters-with-faces beg end 'face @@ -2310,6 +2310,7 @@ Return the name of the group if selection was successful." (let ((group (if (gnus-group-foreign-p group) group (gnus-group-prefixed-name (gnus-group-real-name group) method)))) + (gnus-set-active group nil) (gnus-sethash group `(-1 nil (,group @@ -2441,7 +2442,7 @@ Valid input formats include: (gnus-read-ephemeral-gmane-group group start range))) (defcustom gnus-bug-group-download-format-alist - '((emacs . "http://debbugs.gnu.org/%s;mboxmaint=yes;mboxstat=yes") + '((emacs . "http://debbugs.gnu.org/cgi/bugreport.cgi?bug=%s;mboxmaint=yes;mboxstat=yes") (debian . "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s&mbox=yes;mboxmaint=yes")) "Alist of symbols for bug trackers and the corresponding URL format string. diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index 0a02138ee58..81e0252cf93 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el @@ -249,16 +249,23 @@ If it is down, start it up (again)." (defvar gnus-backend-trace nil) +(defun gnus-backend-trace (type form) + (with-current-buffer (get-buffer-create "*gnus trace*") + (buffer-disable-undo) + (goto-char (point-max)) + (insert (format-time-string "%H:%M:%S") + (format " %.2fs %s %S\n" + (if (numberp gnus-backend-trace) + (- (float-time) gnus-backend-trace) + 0) + type form)) + (setq gnus-backend-trace (float-time)))) + (defun gnus-open-server (gnus-command-method) "Open a connection to GNUS-COMMAND-METHOD." (when (stringp gnus-command-method) (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (when gnus-backend-trace - (with-current-buffer (get-buffer-create "*gnus trace*") - (buffer-disable-undo) - (goto-char (point-max)) - (insert (format-time-string "%H:%M:%S") - (format " %S\n" gnus-command-method)))) + (gnus-backend-trace :opening gnus-command-method) (let ((elem (assoc gnus-command-method gnus-opened-servers)) (server (gnus-method-to-server-name gnus-command-method))) ;; If this method was previously denied, we just return nil. @@ -333,6 +340,7 @@ If it is down, start it up (again)." (save-excursion (gnus-agent-possibly-synchronize-flags-server gnus-command-method))) + (gnus-backend-trace :opened gnus-command-method) result))))) (defun gnus-close-server (gnus-command-method) @@ -353,9 +361,13 @@ If it is down, start it up (again)." "Read and update infos from GNUS-COMMAND-METHOD." (when (stringp gnus-command-method) (setq gnus-command-method (gnus-server-to-method gnus-command-method))) - (funcall (gnus-get-function gnus-command-method 'finish-retrieve-group-infos) - (nth 1 gnus-command-method) - infos data)) + (gnus-backend-trace :finishing gnus-command-method) + (prog1 + (funcall (gnus-get-function gnus-command-method + 'finish-retrieve-group-infos) + (nth 1 gnus-command-method) + infos data) + (gnus-backend-trace :finished gnus-command-method))) (defun gnus-retrieve-group-data-early (gnus-command-method infos) "Start early async retrieval of data from GNUS-COMMAND-METHOD." diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index c7509e858f7..f7b2d8b99d9 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -1745,7 +1745,8 @@ this is a reply." (setq var (cdr var))) result))) name) - (when (or groups gcc-self-val) + (when (and (or groups gcc-self-val) + (gnus-alive-p)) (when (stringp groups) (setq groups (list groups))) (save-excursion diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index a0013c0ee2c..e808b1975b4 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -982,7 +982,7 @@ only the last one's marks are returned." (let* ((article (last articles)) (id (gnus-registry-fetch-message-id-fast article)) (marks (when id (gnus-registry-get-id-key id 'mark)))) - (when (interactive-p) + (when (gmm-called-interactively-p 'any) (gnus-message 1 "Marks are %S" marks)) marks)) diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el index 2126d56bb00..48b51d2c95d 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el @@ -659,7 +659,7 @@ Two predefined functions are available: (while (and list (not (eval (caar list)))) (setq list (cdr list))))) - (unless (eq (setq face (cdar list)) (get-text-property beg 'face)) + (unless (eq (setq face (cdar list)) (gnus-get-text-property-excluding-characters-with-faces beg 'face)) (gnus-put-text-property-excluding-characters-with-faces beg end 'face (if (boundp face) (symbol-value face) face))))) @@ -828,31 +828,33 @@ Two predefined functions are available: (defun gnus-highlight-selected-tree (article) "Highlight the selected article in the tree." - (let ((buf (current-buffer)) - region) - (set-buffer gnus-tree-buffer) - (when (setq region (gnus-tree-article-region article)) - (when (or (not gnus-selected-tree-overlay) - (gnus-extent-detached-p gnus-selected-tree-overlay)) - ;; Create a new overlay. - (gnus-overlay-put - (setq gnus-selected-tree-overlay - (gnus-make-overlay (point-min) (1+ (point-min)))) - 'face gnus-selected-tree-face)) - ;; Move the overlay to the article. - (gnus-move-overlay - gnus-selected-tree-overlay (goto-char (car region)) (cdr region)) - (gnus-tree-minimize) - (gnus-tree-recenter) - (let ((selected (selected-window))) - (when (gnus-get-buffer-window (set-buffer gnus-tree-buffer) t) - (select-window (gnus-get-buffer-window (set-buffer gnus-tree-buffer) t)) - (gnus-horizontal-recenter) - (select-window selected)))) -;; If we remove this save-excursion, it updates the wrong mode lines?!? - (with-current-buffer gnus-tree-buffer - (gnus-set-mode-line 'tree)) - (set-buffer buf))) + (when (buffer-live-p gnus-tree-buffer) + (let ((buf (current-buffer)) + region) + (set-buffer gnus-tree-buffer) + (when (setq region (gnus-tree-article-region article)) + (when (or (not gnus-selected-tree-overlay) + (gnus-extent-detached-p gnus-selected-tree-overlay)) + ;; Create a new overlay. + (gnus-overlay-put + (setq gnus-selected-tree-overlay + (gnus-make-overlay (point-min) (1+ (point-min)))) + 'face gnus-selected-tree-face)) + ;; Move the overlay to the article. + (gnus-move-overlay + gnus-selected-tree-overlay (goto-char (car region)) (cdr region)) + (gnus-tree-minimize) + (gnus-tree-recenter) + (let ((selected (selected-window))) + (when (gnus-get-buffer-window (set-buffer gnus-tree-buffer) t) + (select-window + (gnus-get-buffer-window (set-buffer gnus-tree-buffer) t)) + (gnus-horizontal-recenter) + (select-window selected)))) + ;; If we remove this save-excursion, it updates the wrong mode lines?!? + (with-current-buffer gnus-tree-buffer + (gnus-set-mode-line 'tree)) + (set-buffer buf)))) (defun gnus-tree-highlight-article (article face) (with-current-buffer (gnus-get-tree-buffer) diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index 625f2c989b2..da5c31325bd 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -33,6 +33,7 @@ (require 'gnus-win) (require 'message) (require 'score-mode) +(require 'gmm-utils) (defcustom gnus-global-score-files nil "List of global score files and directories. @@ -1718,33 +1719,37 @@ score in `gnus-newsgroup-scored' by SCORE." nil) (defun gnus-score-decode-text-parts () - (labels ((mm-text-parts (handle) - (cond ((stringp (car handle)) - (let ((parts (mapcan #'mm-text-parts (cdr handle)))) - (if (equal "multipart/alternative" (car handle)) - ;; pick the first supported alternative - (list (car parts)) - parts))) - - ((bufferp (car handle)) - (when (string-match "^text/" (mm-handle-media-type handle)) - (list handle))) - - (t (mapcan #'mm-text-parts handle)))) - (my-mm-display-part (handle) - (when handle - (save-restriction - (narrow-to-region (point) (point)) - (mm-display-inline handle) - (goto-char (point-max)))))) + (gmm-labels + ((mm-text-parts + (handle) + (cond ((stringp (car handle)) + (let ((parts (apply #'append + (mapcar #'mm-text-parts (cdr handle))))) + (if (equal "multipart/alternative" (car handle)) + ;; pick the first supported alternative + (list (car parts)) + parts))) + + ((bufferp (car handle)) + (when (string-match "^text/" (mm-handle-media-type handle)) + (list handle))) + + (t (apply #'append (mapcar #'mm-text-parts handle))))) + (my-mm-display-part + (handle) + (when handle + (save-restriction + (narrow-to-region (point) (point)) + (mm-display-inline handle) + (goto-char (point-max)))))) (let (;(mm-text-html-renderer 'w3m-standalone) - (handles (mm-dissect-buffer t))) + (handles (mm-dissect-buffer t))) (save-excursion - (article-goto-body) - (delete-region (point) (point-max)) - (mapc #'my-mm-display-part (mm-text-parts handles)) - handles)))) + (article-goto-body) + (delete-region (point) (point-max)) + (mapc #'my-mm-display-part (mm-text-parts handles)) + handles)))) (defun gnus-score-body (scores header now expire &optional trace) (if gnus-agent-fetching diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el index c355b9a551f..446e8260203 100644 --- a/lisp/gnus/gnus-spec.el +++ b/lisp/gnus/gnus-spec.el @@ -265,7 +265,14 @@ Return a list of updated types." (defun gnus-face-face-function (form type) `(gnus-add-text-properties (point) (progn ,@form (point)) - '(gnus-face t face ,(symbol-value (intern (format "gnus-face-%d" type)))))) + (cons 'face + (cons + ;; Delay consing the value of the `face' property until + ;; `gnus-add-text-properties' runs, since it will be modified + ;; by `gnus-put-text-property-excluding-characters-with-faces'. + (list ',(symbol-value (intern (format "gnus-face-%d" type))) 'default) + ;; Redundant now, but still convenient. + '(gnus-face t))))) (defun gnus-balloon-face-function (form type) `(gnus-put-text-property diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index 8493c8871a9..69774587d80 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -713,6 +713,7 @@ claim them." "q" gnus-browse-exit "Q" gnus-browse-exit "d" gnus-browse-describe-group + [delete] gnus-browse-delete-group "\C-c\C-c" gnus-browse-exit "?" gnus-browse-describe-briefly @@ -964,6 +965,16 @@ how new groups will be entered into the group buffer." (interactive (list (gnus-browse-group-name))) (gnus-group-describe-group nil group)) +(defun gnus-browse-delete-group (group force) + "Delete the current group. Only meaningful with editable groups. +If FORCE (the prefix) is non-nil, all the articles in the group will +be deleted. This is \"deleted\" as in \"removed forever from the face +of the Earth\". There is no undo. The user will be prompted before +doing the deletion." + (interactive (list (gnus-browse-group-name) + current-prefix-arg)) + (gnus-group-delete-group group force)) + (defun gnus-browse-unsubscribe-group () "Toggle subscription of the current group in the browse buffer." (let ((sub nil) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 1ef475adbe7..aa8b6bf2703 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -110,7 +110,7 @@ ask the servers (primary, secondary, and archive servers) to list new groups since the last time it checked: 1. This variable is `ask-server'. 2. This variable is a list of select methods (see below). - 3. `gnus-read-active-file' is nil or `some'. + 3. Option `gnus-read-active-file' is nil or `some'. 4. A prefix argument is given to `gnus-find-new-newsgroups' interactively. Thus, if this variable is `ask-server' or a list of select methods or @@ -395,7 +395,16 @@ This hook is called after Gnus is connected to the NNTP server." (defcustom gnus-before-startup-hook nil "A hook called before startup. -This hook is called as the first thing when Gnus is started." +This hook is called as the first thing when Gnus is started. +See also `gnus-before-resume-hook'." + :group 'gnus-start + :type 'hook) + +(defcustom gnus-before-resume-hook nil + "A hook called before resuming Gnus after suspend. +This hook is called as the first thing when Gnus is resumed after a suspend. +See also `gnus-before-startup-hook'." + :version "24.4" :group 'gnus-start :type 'hook) @@ -749,6 +758,7 @@ prompt the user for the name of an NNTP server to use." (if (gnus-alive-p) (progn + (gnus-run-hooks 'gnus-before-resume-hook) (switch-to-buffer gnus-group-buffer) (gnus-group-get-new-news (and (numberp arg) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 32ef7029456..658863f9f00 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -1167,7 +1167,7 @@ using `gnus-ignored-from-addresses'." (defcustom gnus-summary-newsgroup-prefix "=> " "*String prefixed to the Newsgroup field in the summary -line when using `gnus-ignored-from-addresses'." +line when using the option `gnus-ignored-from-addresses'." :version "22.1" :group 'gnus-summary :type 'string) @@ -3493,8 +3493,8 @@ If the setup was successful, non-nil is returned." (set-buffer buffer) (setq gnus-summary-buffer (current-buffer)) (not gnus-newsgroup-prepared)) - ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu> - (setq gnus-summary-buffer (set-buffer (gnus-get-buffer-create buffer))) + (set-buffer (gnus-get-buffer-create buffer)) + (setq gnus-summary-buffer (current-buffer)) (gnus-summary-mode group) (when (gnus-group-quit-config group) (set (make-local-variable 'gnus-single-article-buffer) nil)) @@ -3552,11 +3552,7 @@ buffer that was in action when the last article was fetched." (if (consp (car locals)) (set (caar locals) (pop vlist)) (set (car locals) (pop vlist))) - (setq locals (cdr locals)))) - ;; The article buffer also has local variables. - (when (gnus-buffer-live-p gnus-article-buffer) - (set-buffer gnus-article-buffer) - (setq gnus-summary-buffer summary)))))) + (setq locals (cdr locals)))))))) (defun gnus-summary-article-unread-p (article) "Say whether ARTICLE is unread or not." @@ -3655,17 +3651,18 @@ buffer that was in action when the last article was fetched." (or (car (funcall gnus-extract-address-components from)) from)) -(defun gnus-summary-from-or-to-or-newsgroups (header gnus-tmp-from) +(defun gnus-summary-from-or-to-or-newsgroups (header from) (let ((mail-parse-charset gnus-newsgroup-charset) - (ignored-from-addresses (gnus-ignored-from-addresses)) - ; Is it really necessary to do this next part for each summary line? - ; Luckily, doesn't seem to slow things down much. - (mail-parse-ignored-charsets - (with-current-buffer gnus-summary-buffer - gnus-newsgroup-ignored-charsets))) + (ignored-from-addresses (gnus-ignored-from-addresses)) + ;; Is it really necessary to do this next part for each summary line? + ;; Luckily, doesn't seem to slow things down much. + (mail-parse-ignored-charsets + (with-current-buffer gnus-summary-buffer + gnus-newsgroup-ignored-charsets)) + (address (cadr (gnus-extract-address-components from)))) (or (and ignored-from-addresses - (string-match ignored-from-addresses gnus-tmp-from) + (string-match ignored-from-addresses address) (let ((extra-headers (mail-header-extra header)) to newsgroups) @@ -3684,9 +3681,7 @@ buffer that was in action when the last article was fetched." gnus-newsgroup-name)) 'nntp) (gnus-group-real-name gnus-newsgroup-name)))) (concat gnus-summary-newsgroup-prefix newsgroups))))) - (gnus-string-mark-left-to-right - (inline - (gnus-summary-extract-address-component gnus-tmp-from)))))) + (gnus-string-mark-left-to-right (gnus-summary-extract-address-component from))))) (defun gnus-summary-insert-line (gnus-tmp-header gnus-tmp-level gnus-tmp-current @@ -4063,9 +4058,10 @@ If SELECT-ARTICLES, only select those articles from GROUP." gnus-auto-select-first) (progn (let ((art (gnus-summary-article-number))) - (unless (and (not gnus-plugged) - (or (memq art gnus-newsgroup-undownloaded) - (memq art gnus-newsgroup-downloadable))) + (when (and art + gnus-plugged + (not (memq art gnus-newsgroup-undownloaded)) + (not (memq art gnus-newsgroup-downloadable))) (gnus-summary-goto-article art)))) ;; Don't select any articles. (gnus-summary-position-point) @@ -7874,7 +7870,6 @@ If STOP is non-nil, just stop when reaching the end of the message. Also see the variable `gnus-article-skip-boring'." (interactive "P") - (setq gnus-summary-buffer (current-buffer)) (gnus-set-global-variables) (let ((article (gnus-summary-article-number)) (article-window (get-buffer-window gnus-article-buffer t)) @@ -10127,17 +10122,20 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (defun gnus-summary-push-marks-to-backend (article) (let ((set nil) + (del nil) (marks gnus-article-mark-lists)) (unless (memq article gnus-newsgroup-unreads) (push 'read set)) (while marks - (when (and (eq (gnus-article-mark-to-type (cdar marks)) 'list) - (memq article (symbol-value - (intern (format "gnus-newsgroup-%s" - (caar marks)))))) - (push (cdar marks) set)) + (if (and (eq (gnus-article-mark-to-type (cdar marks)) 'list) + (memq article (symbol-value + (intern (format "gnus-newsgroup-%s" + (caar marks)))))) + (push (cdar marks) set) + (push (cdar marks) del)) (pop marks)) - (gnus-request-set-mark gnus-newsgroup-name `(((,article) set ,set))))) + (gnus-request-set-mark gnus-newsgroup-name `(((,article) set ,set) + ((,article) del ,del))))) (defun gnus-summary-copy-article (&optional n to-newsgroup select-method) "Copy the current article to some other group. @@ -11647,10 +11645,10 @@ If PREDICATE is supplied, threads that satisfy this predicate will not be hidden. Returns nil if no threads were there to be hidden." (interactive) + (beginning-of-line) (let ((start (point)) (starteol (line-end-position)) (article (gnus-summary-article-number))) - (goto-char start) ;; Go forward until either the buffer ends or the subthread ends. (when (and (not (eobp)) (or (zerop (gnus-summary-next-thread 1 t)) @@ -12521,7 +12519,7 @@ If REVERSE, save parts that do not match TYPE." (memq article gnus-newsgroup-undownloaded) (not (memq article gnus-newsgroup-cached))))) (let ((face (funcall (gnus-summary-highlight-line-0)))) - (unless (eq face (get-text-property beg 'face)) + (unless (eq face (gnus-get-text-property-excluding-characters-with-faces beg 'face)) (gnus-put-text-property-excluding-characters-with-faces beg (point-at-eol) 'face (setq face (if (boundp face) (symbol-value face) face))) diff --git a/lisp/gnus/gnus-sync.el b/lisp/gnus/gnus-sync.el index 3d20c238a5e..8cf92df5b91 100644 --- a/lisp/gnus/gnus-sync.el +++ b/lisp/gnus/gnus-sync.el @@ -112,8 +112,9 @@ this setting is harmless until the user chooses a sync backend." (defcustom gnus-sync-newsrc-offsets '(2 3) "List of per-group data to be synchronized." :group 'gnus-sync + :version "24.4" :type '(set (const :tag "Read ranges" 2) - (const :tag "Marks" 3))) + (const :tag "Marks" 3))) (defcustom gnus-sync-global-vars nil "List of global variables to be synchronized. @@ -137,6 +138,11 @@ and `gnus-topic-alist'. Also see `gnus-variable-list'." (defvar gnus-sync-newsrc-loader nil "Carrier for newsrc data") +(defcustom gnus-sync-file-encrypt-to nil + "If non-nil, `epa-file-encrypt-to' is set from this for encrypting the Sync + file." + :group 'gnus-sync) + (defcustom gnus-sync-lesync-name (system-name) "The LeSync name for this machine." :group 'gnus-sync @@ -175,16 +181,15 @@ and `gnus-topic-alist'. Also see `gnus-variable-list'." (defun gnus-sync-lesync-call (url method headers &optional kvdata) "Make an access request to URL using KVDATA and METHOD. KVDATA must be an alist." - (flet ((json-alist-p (list) (gnus-sync-json-alist-p list))) ; temp patch - (let ((url-request-method method) - (url-request-extra-headers headers) - (url-request-data (if kvdata (json-encode kvdata) nil))) - (with-current-buffer (url-retrieve-synchronously url) - (let ((data (gnus-sync-lesync-parse))) - (gnus-message 12 "gnus-sync-lesync-call: %s URL %s sent %S got %S" - method url `((headers . ,headers) (data ,kvdata)) data) - (kill-buffer (current-buffer)) - data))))) + (let ((url-request-method method) + (url-request-extra-headers headers) + (url-request-data (if kvdata (json-encode kvdata) nil))) + (with-current-buffer (url-retrieve-synchronously url) + (let ((data (gnus-sync-lesync-parse))) + (gnus-message 12 "gnus-sync-lesync-call: %s URL %s sent %S got %S" + method url `((headers . ,headers) (data ,kvdata)) data) + (kill-buffer (current-buffer)) + data)))) (defun gnus-sync-lesync-PUT (url headers &optional data) (gnus-sync-lesync-call url "PUT" headers data)) @@ -762,6 +767,9 @@ With a prefix, FORCE is set and all groups will be saved." (progn (let ((coding-system-for-write gnus-ding-file-coding-system) (standard-output (current-buffer))) + (when gnus-sync-file-encrypt-to + (set (make-local-variable 'epa-file-encrypt-to) + gnus-sync-file-encrypt-to)) (princ (format ";; -*- mode:emacs-lisp; coding: %s; -*-\n" gnus-ding-file-coding-system)) (princ ";; Gnus sync data v. 0.0.1\n") diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 6f00eec786d..df805c6fb26 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -225,7 +225,7 @@ is slower." (defun gnus-goto-colon () - (beginning-of-line) + (move-beginning-of-line 1) (let ((eol (point-at-eol))) (goto-char (or (text-property-any (point) eol 'gnus-position t) (search-forward ":" eol t) @@ -866,18 +866,29 @@ If there's no subdirectory, delete DIRECTORY as well." (setq beg (point))) (gnus-overlay-put (gnus-make-overlay beg (point)) prop val))))) -(defun gnus-put-text-property-excluding-characters-with-faces (beg end - prop val) - "The same as `put-text-property', but don't put props on characters with the `gnus-face' property." - (let ((b beg)) - (while (/= b end) - (when (get-text-property b 'gnus-face) - (setq b (next-single-property-change b 'gnus-face nil end))) - (when (/= b end) +(defun gnus-put-text-property-excluding-characters-with-faces (beg end prop val) + "The same as `put-text-property', except where `gnus-face' is set. +If so, and PROP is `face', set the second element of its value to VAL. +Otherwise, do nothing." + (while (< beg end) + ;; Property values are compared with `eq'. + (let ((stop (next-single-property-change beg 'face nil end))) + (if (get-text-property beg 'gnus-face) + (when (eq prop 'face) + (setcar (cdr (get-text-property beg 'face)) (or val 'default))) (inline - (gnus-put-text-property - b (setq b (next-single-property-change b 'gnus-face nil end)) - prop val)))))) + (gnus-put-text-property beg stop prop val))) + (setq beg stop)))) + +(defun gnus-get-text-property-excluding-characters-with-faces (pos prop) + "The same as `get-text-property', except where `gnus-face' is set. +If so, and PROP is `face', return the second element of its value. +Otherwise, return the value." + (let ((val (get-text-property pos prop))) + (if (and (get-text-property pos 'gnus-face) + (eq prop 'face)) + (cadr val) + (get-text-property pos prop)))) (defmacro gnus-faces-at (position) "Return a list of faces at POSITION." @@ -1938,27 +1949,6 @@ to case differences." (string-equal (downcase str1) (downcase prefix)) (string-equal str1 prefix)))))) -(eval-and-compile - (if (fboundp 'macroexpand-all) - (defalias 'gnus-macroexpand-all 'macroexpand-all) - (defun gnus-macroexpand-all (form &optional environment) - "Return result of expanding macros at all levels in FORM. -If no macros are expanded, FORM is returned unchanged. -The second optional arg ENVIRONMENT specifies an environment of macro -definitions to shadow the loaded ones for use in file byte-compilation." - (if (consp form) - (let ((idx 1) - (len (length (setq form (copy-sequence form)))) - expanded) - (while (< idx len) - (setcar (nthcdr idx form) (gnus-macroexpand-all (nth idx form) - environment)) - (setq idx (1+ idx))) - (if (eq (setq expanded (macroexpand form environment)) form) - form - (gnus-macroexpand-all expanded environment))) - form)))) - ;; Simple check: can be a macro but this way, although slow, it's really clear. ;; We don't use `bound-and-true-p' because it's not in XEmacs. (defun gnus-bound-and-true-p (sym) diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index d0e8d805206..ffb4694f4a8 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -2495,7 +2495,16 @@ Disabling the agent may result in noticeable loss of performance." :type 'boolean) (defcustom gnus-other-frame-function 'gnus - "Function called by the command `gnus-other-frame'." + "Function called by the command `gnus-other-frame' when starting Gnus." + :group 'gnus-start + :type '(choice (function-item gnus) + (function-item gnus-no-server) + (function-item gnus-slave) + (function-item gnus-slave-no-server))) + +(defcustom gnus-other-frame-resume-function 'gnus-group-get-new-news + "Function called by the command `gnus-other-frame' when resuming Gnus." + :version "24.4" :group 'gnus-start :type '(choice (function-item gnus) (function-item gnus-no-server) @@ -4348,13 +4357,22 @@ server." (interactive "P") (gnus arg nil 'slave)) +(defun gnus-delete-gnus-frame () + "Delete gnus frame unless it is the only one. +Used for `gnus-exit-gnus-hook' in `gnus-other-frame'." + (when (and (frame-live-p gnus-other-frame-object) + (cdr (frame-list))) + (delete-frame gnus-other-frame-object)) + (setq gnus-other-frame-object nil)) + ;;;###autoload (defun gnus-other-frame (&optional arg display) "Pop up a frame to read news. This will call one of the Gnus commands which is specified by the user option `gnus-other-frame-function' (default `gnus') with the argument -ARG if Gnus is not running, otherwise just pop up a Gnus frame. The -optional second argument DISPLAY should be a standard display string +ARG if Gnus is not running, otherwise pop up a Gnus frame and run the +command specified by `gnus-other-frame-resume-function'. +The optional second argument DISPLAY should be a standard display string such as \"unix:0\" to specify where to pop up a frame. If DISPLAY is omitted or the function `make-frame-on-display' is not available, the current display is used." @@ -4386,14 +4404,16 @@ current display is used." (make-frame-on-display display gnus-other-frame-parameters) (make-frame gnus-other-frame-parameters)))) (if alive - (switch-to-buffer gnus-group-buffer) + (progn (switch-to-buffer gnus-group-buffer) + (funcall gnus-other-frame-resume-function arg)) (funcall gnus-other-frame-function arg) - (add-hook 'gnus-exit-gnus-hook - (lambda nil - (when (and (frame-live-p gnus-other-frame-object) - (cdr (frame-list))) - (delete-frame gnus-other-frame-object)) - (setq gnus-other-frame-object nil))))))) + (add-hook 'gnus-exit-gnus-hook 'gnus-delete-gnus-frame) + ;; One might argue that `gnus-delete-gnus-frame' should not be called + ;; from `gnus-suspend-gnus-hook', but, on the other hand, one might + ;; argue that it should. No matter what you think, for the sake of + ;; those who want it to be called from it, please keep (defun + ;; gnus-delete-gnus-frame) even if you remove the next `add-hook'. + (add-hook 'gnus-suspend-gnus-hook 'gnus-delete-gnus-frame))))) ;;;###autoload (defun gnus (&optional arg dont-connect slave) diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index c53968db352..9cc2e6ac09c 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -63,7 +63,7 @@ This variable is a list of mail source specifiers. See Info node `(gnus)Mail Source Specifiers'." :group 'mail-source - :version "23.1" ;; No Gnus + :version "24.4" :link '(custom-manual "(gnus)Mail Source Specifiers") :type `(choice (const :tag "None" nil) @@ -159,7 +159,18 @@ See Info node `(gnus)Mail Source Specifiers'." :value nil (const :tag "Clear" nil) (const starttls) - (const :tag "SSL/TLS" ssl))))) + (const :tag "SSL/TLS" ssl))) + (group :inline t + (const :format "" :value :leave) + (choice :format "\ +%{Leave mail on server%}:\n\t\t%[Value Menu%] %v" + :value nil + (const :tag "\ +Don't leave mails" nil) + (const :tag "\ +Leave all mails" t) + (number :tag "\ +Leave mails for this many days" :value 14))))) (cons :tag "Maildir (qmail, postfix...)" (const :format "" maildir) (checklist :tag "Options" :greedy t @@ -340,7 +351,8 @@ Common keywords should be listed here.") (:function) (:password) (:authentication password) - (:stream nil)) + (:stream nil) + (:leave)) (maildir (:path (or (getenv "MAILDIR") "~/Maildir/")) (:subdirs ("cur" "new")) @@ -825,7 +837,8 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) (pop3-port port) (pop3-authentication-scheme (if (eq authentication 'apop) 'apop 'pass)) - (pop3-stream-type stream)) + (pop3-stream-type stream) + (pop3-leave-mail-on-server leave)) (if (or debug-on-quit debug-on-error) (save-excursion (pop3-movemail mail-source-crash-box)) (condition-case err diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 4e40b1afaa6..808e1edd6c3 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -264,7 +264,7 @@ This is a list of regexps and regexp matches." :type 'sexp) (defcustom message-ignored-news-headers - "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:" + "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:\\|^X-Message-SMTP-Method:" "*Regexp of headers to be removed unconditionally before posting." :group 'message-news :group 'message-headers @@ -592,8 +592,10 @@ Done before generating the new subject of a forward." ;; comes back to you (e.g. a mailing-list to which you subscribe, in which ;; case you may be removed from the list on the grounds that mail to you ;; bounced with a "mailing loop" error). - "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From \\|^Delivered-To:" + "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From \\|^Delivered-To:\ +\\|^X-Content-Length:\\|^X-UIDL:" "*All headers that match this regexp will be deleted when resending a message." + :version "24.4" :group 'message-interface :link '(custom-manual "(message)Resending") :type '(repeat :value-to-internal (lambda (widget value) @@ -3135,22 +3137,10 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." (push-mark) (message-position-on-field "Summary" "Subject")) -(eval-when-compile - (defmacro message-called-interactively-p (kind) - (condition-case nil - (progn - (eval '(called-interactively-p 'any)) - ;; Emacs >=23.2 - `(called-interactively-p ,kind)) - ;; Emacs <23.2 - (wrong-number-of-arguments '(called-interactively-p)) - ;; XEmacs - (void-function '(interactive-p))))) - (defun message-goto-body () "Move point to the beginning of the message body." (interactive) - (when (and (message-called-interactively-p 'any) + (when (and (gmm-called-interactively-p 'any) (looking-at "[ \t]*\n")) (expand-abbrev)) (push-mark) @@ -3824,7 +3814,9 @@ prefix, and don't delete any headers." (interactive "P") ;; eval the let forms contained in message-cite-style (eval - `(let ,message-cite-style + `(let ,(if (symbolp message-cite-style) + (symbol-value message-cite-style) + message-cite-style) (message--yank-original-internal ',arg)))) (defun message-yank-buffer (buffer) @@ -6728,11 +6720,16 @@ The function is called with one parameter, a cons cell ..." ", ")) mct (message-fetch-field "mail-copies-to") author (or (message-fetch-field "mail-reply-to") - (message-fetch-field "reply-to") - (message-fetch-field "from") - "") + (message-fetch-field "reply-to")) mft (and message-use-mail-followup-to - (message-fetch-field "mail-followup-to")))) + (message-fetch-field "mail-followup-to"))) + ;; Make sure this message goes to the author if this is a wide + ;; reply, since Reply-To address may be a list address a mailing + ;; list server added. + (when (and wide author) + (setq cc (concat author ", " cc))) + (when (or wide (not author)) + (setq author (or (message-fetch-field "from") "")))) ;; Handle special values of Mail-Copies-To. (when mct @@ -7379,12 +7376,13 @@ Optional DIGEST will use digest to forward." (dolist (elem ignored) (message-remove-header elem t)))))) -(defun message-forward-make-body-mime (forward-buffer) +(defun message-forward-make-body-mime (forward-buffer &optional beg end) (let ((b (point))) (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n") (save-restriction (narrow-to-region (point) (point)) - (mml-insert-buffer forward-buffer) + (insert-buffer-substring forward-buffer beg end) + (mml-quote-region (point-min) (point-max)) (goto-char (point-min)) (when (looking-at "From ") (replace-match "X-From-Line: ")) @@ -8134,8 +8132,7 @@ regexp VARSTR." (if (fboundp 'mail-abbrevs-setup) (let ((minibuffer-setup-hook 'mail-abbrevs-setup) (minibuffer-local-map message-minibuffer-local-map)) - (flet ((mail-abbrev-in-expansion-header-p nil t)) - (read-from-minibuffer prompt initial-contents))) + (read-from-minibuffer prompt initial-contents)) (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook) (minibuffer-local-map message-minibuffer-local-map)) (read-string prompt initial-contents)))) diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el index 3e769d396b0..6ea55377e02 100644 --- a/lisp/gnus/mml-smime.el +++ b/lisp/gnus/mml-smime.el @@ -74,6 +74,18 @@ Whether the passphrase is cached at all is controlled by :group 'mime-security :type '(repeat (string :tag "Key ID"))) +(defcustom mml-smime-sign-with-sender nil + "If t, use message sender so find a key to sign with." + :group 'mime-security + :version "24.4" + :type 'boolean) + +(defcustom mml-smime-encrypt-to-self nil + "If t, add your own key ID to recipient list when encryption." + :group 'mime-security + :version "24.4" + :type 'boolean) + (defun mml-smime-sign (cont) (let ((func (nth 1 (assq mml-smime-use mml-smime-function-alist)))) (if func @@ -323,6 +335,7 @@ Whether the passphrase is cached at all is controlled by (autoload 'epg-encrypt-string "epg") (autoload 'epg-passphrase-callback-function "epg") (autoload 'epg-context-set-passphrase-callback "epg") + (autoload 'epg-sub-key-fingerprint "epg") (autoload 'epg-configuration "epg-config") (autoload 'epg-expand-group "epg-config") (autoload 'epa-select-keys "epa")) @@ -366,6 +379,24 @@ Whether the passphrase is cached at all is controlled by (setq pointer (cdr pointer)))) (setq keys (cdr keys))))) +;; XXX: since gpg --list-secret-keys does not return validity of each +;; key, `mml-smime-epg-find-usable-key' defined above is not enough for +;; secret keys. The function `mml-smime-epg-find-usable-secret-key' +;; below looks at appropriate public keys to check usability. +(defun mml-smime-epg-find-usable-secret-key (context name usage) + (let ((secret-keys (epg-list-keys context name t)) + secret-key) + (while (and (not secret-key) secret-keys) + (if (mml-smime-epg-find-usable-key + (epg-list-keys context (epg-sub-key-fingerprint + (car (epg-key-sub-key-list + (car secret-keys))))) + usage) + (setq secret-key (car secret-keys) + secret-keys nil) + (setq secret-keys (cdr secret-keys)))) + secret-key)) + (autoload 'mml-compute-boundary "mml") ;; We require mm-decode, which requires mm-bodies, which autoloads @@ -376,29 +407,36 @@ Whether the passphrase is cached at all is controlled by (let* ((inhibit-redisplay t) (context (epg-make-context 'CMS)) (boundary (mml-compute-boundary cont)) + (sender (message-options-get 'message-sender)) + (signer-names (or mml-smime-signers + (if (and mml-smime-sign-with-sender sender) + (list (concat "<" sender ">"))))) signer-key (signers (or (message-options-get 'mml-smime-epg-signers) (message-options-set - 'mml-smime-epg-signers - (if (eq mm-sign-option 'guided) - (epa-select-keys context "\ + 'mml-smime-epg-signers + (if (eq mm-sign-option 'guided) + (epa-select-keys context "\ Select keys for signing. If no one is selected, default secret key is used. " - mml-smime-signers t) - (if mml-smime-signers - (mapcar - (lambda (signer) - (setq signer-key (mml-smime-epg-find-usable-key - (epg-list-keys context signer t) - 'sign)) - (unless (or signer-key - (y-or-n-p - (format "No secret key for %s; skip it? " + signer-names + t) + (if (or sender mml-smime-signers) + (delq nil + (mapcar + (lambda (signer) + (setq signer-key + (mml-smime-epg-find-usable-secret-key + context signer 'sign)) + (unless (or signer-key + (y-or-n-p + (format + "No secret key for %s; skip it? " signer))) - (error "No secret key for %s" signer)) - signer-key) - mml-smime-signers)))))) + (error "No secret key for %s" signer)) + signer-key) + signer-names))))))) signature micalg) (epg-context-set-signers context signers) (if mml-smime-cache-passphrase @@ -443,13 +481,17 @@ Content-Disposition: attachment; filename=smime.p7s (goto-char (point-max)))) (defun mml-smime-epg-encrypt (cont) - (let ((inhibit-redisplay t) - (context (epg-make-context 'CMS)) - (config (epg-configuration)) - (recipients (message-options-get 'mml-smime-epg-recipients)) - cipher signers - (boundary (mml-compute-boundary cont)) - recipient-key) + (let* ((inhibit-redisplay t) + (context (epg-make-context 'CMS)) + (config (epg-configuration)) + (recipients (message-options-get 'mml-smime-epg-recipients)) + cipher signers + (sender (message-options-get 'message-sender)) + (signer-names (or mml-smime-signers + (if (and mml-smime-sign-with-sender sender) + (list (concat "<" sender ">"))))) + (boundary (mml-compute-boundary cont)) + recipient-key) (unless recipients (setq recipients (apply #'nconc @@ -462,6 +504,10 @@ Content-Disposition: attachment; filename=smime.p7s (message-options-set 'message-recipients (read-string "Recipients: "))) "[ \f\t\n\r\v,]+")))) + (when mml-smime-encrypt-to-self + (unless signer-names + (error "Neither message sender nor mml-smime-signers are set")) + (setq recipients (nconc recipients signer-names))) (if (eq mm-encrypt-option 'guided) (setq recipients (epa-select-keys context "\ diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index af65872b0cf..275a4867e85 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -735,6 +735,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (defvar epg-user-id-alist) (defvar epg-digest-algorithm-alist) +(defvar epg-gpg-program) (defvar inhibit-redisplay) (autoload 'epg-make-context "epg") @@ -743,7 +744,6 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (autoload 'epg-context-set-signers "epg") (autoload 'epg-context-result-for "epg") (autoload 'epg-new-signature-digest-algorithm "epg") -(autoload 'epg-verify-result-to-string "epg") (autoload 'epg-list-keys "epg") (autoload 'epg-decrypt-string "epg") (autoload 'epg-verify-string "epg") @@ -755,6 +755,8 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (autoload 'epg-sub-key-capability "epg") (autoload 'epg-sub-key-validity "epg") (autoload 'epg-sub-key-fingerprint "epg") +(autoload 'epg-signature-key-id "epg") +(autoload 'epg-signature-to-string "epg") (autoload 'epg-configuration "epg-config") (autoload 'epg-expand-group "epg-config") (autoload 'epa-select-keys "epa") @@ -818,6 +820,35 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (setq secret-keys (cdr secret-keys)))) secret-key)) +(defun mml2015-epg-key-image (key-id) + "Return the image of a key, if any" + (with-temp-buffer + (mm-set-buffer-multibyte nil) + (let* ((coding-system-for-write 'binary) + (coding-system-for-read 'binary) + (data (shell-command-to-string + (format "%s --list-options no-show-photos --attribute-fd 3 --list-keys %s 3>&1 >/dev/null 2>&1" + epg-gpg-program key-id)))) + (when (> (length data) 0) + (insert (substring data 16)) + (create-image (buffer-string) nil t))))) + +(defun mml2015-epg-key-image-to-string (key-id) + "Return a string with the image of a key, if any" + (let* ((result "") + (key-image (mml2015-epg-key-image key-id))) + (when key-image + (setq result " ") + (put-text-property 1 2 'display key-image result)) + result)) + +(defun mml2015-epg-signature-to-string (signature) + (concat (epg-signature-to-string signature) + (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")) + (defun mml2015-epg-decrypt (handle ctl) (catch 'error (let ((inhibit-redisplay t) @@ -860,7 +891,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info (concat "OK\n" - (epg-verify-result-to-string + (mml2015-epg-verify-result-to-string (epg-context-result-for context 'verify)))) (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "OK")) @@ -908,7 +939,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (if (epg-context-result-for context 'verify) (mm-set-handle-multipart-parameter mm-security-handle 'gnus-details - (epg-verify-result-to-string + (mml2015-epg-verify-result-to-string (epg-context-result-for context 'verify))))))) (defun mml2015-epg-verify (handle ctl) @@ -942,7 +973,8 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (throw 'error handle))) (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info - (epg-verify-result-to-string (epg-context-result-for context 'verify))) + (mml2015-epg-verify-result-to-string + (epg-context-result-for context 'verify))) handle))) (defun mml2015-epg-clear-verify () @@ -965,7 +997,7 @@ If set, it overrides the setting of `mml2015-sign-with-sender'." (progn (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info - (epg-verify-result-to-string + (mml2015-epg-verify-result-to-string (epg-context-result-for context 'verify))) (delete-region (point-min) (point-max)) (insert (mm-decode-coding-string plain coding-system-for-read))) diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el index 7dfdb9ebcfd..e189ab531f0 100644 --- a/lisp/gnus/nnfolder.el +++ b/lisp/gnus/nnfolder.el @@ -1004,6 +1004,28 @@ deleted. Point is left where the deleted region was." (nnfolder-save-nov)) (current-buffer)))))) +(defun nnfolder-recursive-directory-files (dir prefix) + (let ((files nil)) + (dolist (file (directory-files dir)) + (cond + ((or (file-symlink-p (expand-file-name file dir)) + (member file '("." ".."))) + ;; Ignore + ) + ((file-directory-p (expand-file-name file dir)) + (setq files (nconc (nnfolder-recursive-directory-files + (expand-file-name file dir) + (if prefix + (concat prefix "." (directory-file-name file)) + (file-name-nondirectory file))) + files))) + ((file-regular-p (expand-file-name file dir)) + (push (if prefix + (concat prefix "." file) + file) + files)))) + files)) + ;;;###autoload (defun nnfolder-generate-active-file () "Look for mbox folders in the nnfolder directory and make them into groups. @@ -1020,10 +1042,13 @@ This command does not work if you use short group names." (when (not (message-mail-file-mbox-p file)) (ignore-errors (delete-file file))))) - (dolist (file (directory-files nnfolder-directory)) + (dolist (file (if nnmail-use-long-file-names + (directory-files nnfolder-directory) + (nnfolder-recursive-directory-files + nnfolder-directory nil))) (when (and (not (backup-file-name-p file)) (message-mail-file-mbox-p - (nnheader-concat nnfolder-directory file))) + (nnfolder-group-pathname file))) (let ((oldgroup (assoc file nnfolder-group-alist))) (if oldgroup (nnheader-message 5 "Refreshing group %s..." file) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 307d8247912..9c18bc2cff0 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -99,7 +99,8 @@ Uses the same syntax as `nnmail-split-methods'.") (defvoo nnimap-authenticator nil "How nnimap authenticate itself to the server. -Possible choices are nil (use default methods) or `anonymous'.") +Possible choices are nil (use default methods), `anonymous', +`login', `plain' and `cram-md5'.") (defvoo nnimap-expunge t "If non-nil, expunge articles after deleting them. @@ -338,7 +339,8 @@ textual parts.") (nnimap-last-command-time nnimap-object))) ;; More than five minutes since the last command. (* 5 60))) - (nnimap-send-command "NOOP"))))))) + (ignore-errors ;E.g. "buffer foo has no process". + (nnimap-send-command "NOOP")))))))) (defun nnimap-open-connection (buffer) ;; Be backwards-compatible -- the earlier value of nnimap-stream was @@ -366,7 +368,7 @@ textual parts.") (defun nnimap-open-connection-1 (buffer) (unless nnimap-keepalive-timer (setq nnimap-keepalive-timer (run-at-time (* 60 15) (* 60 15) - 'nnimap-keepalive))) + #'nnimap-keepalive))) (with-current-buffer (nnimap-make-process-buffer buffer) (let* ((coding-system-for-read 'binary) (coding-system-for-write 'binary) @@ -487,9 +489,13 @@ textual parts.") ;; round trips than CRAM-MD5, and it's less likely to be buggy), ;; and we're using an encrypted connection. ((and (not (nnimap-capability "LOGINDISABLED")) - (eq (nnimap-stream-type nnimap-object) 'tls)) + (eq (nnimap-stream-type nnimap-object) 'tls) + (or (null nnimap-authenticator) + (eq nnimap-authenticator 'login))) (nnimap-command "LOGIN %S %S" user password)) - ((nnimap-capability "AUTH=CRAM-MD5") + ((and (nnimap-capability "AUTH=CRAM-MD5") + (or (null nnimap-authenticator) + (eq nnimap-authenticator 'cram-md5))) (erase-buffer) (let ((sequence (nnimap-send-command "AUTHENTICATE CRAM-MD5")) (challenge (nnimap-wait-for-line "^\\+\\(.*\\)\n"))) @@ -502,9 +508,13 @@ textual parts.") (base64-decode-string challenge)))) "\r\n")) (nnimap-wait-for-response sequence))) - ((not (nnimap-capability "LOGINDISABLED")) + ((and (not (nnimap-capability "LOGINDISABLED")) + (or (null nnimap-authenticator) + (eq nnimap-authenticator 'login))) (nnimap-command "LOGIN %S %S" user password)) - ((nnimap-capability "AUTH=PLAIN") + ((and (nnimap-capability "AUTH=PLAIN") + (or (null nnimap-authenticator) + (eq nnimap-authenticator 'plain))) (nnimap-command "AUTHENTICATE PLAIN %s" (base64-encode-string @@ -1411,7 +1421,9 @@ textual parts.") (gnus-set-difference (gnus-set-difference existing - (cdr (assoc '%Seen flags))) + (gnus-sorted-union + (cdr (assoc '%Seen flags)) + (cdr (assoc '%Deleted flags)))) (cdr (assoc '%Flagged flags))))) (read (gnus-range-difference (cons start-article high) unread))) diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index a21fc85752c..58135a1e598 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -1282,7 +1282,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the "nntpd" pbuffer nntp-address nntp-port-number :type (cadr (assoc nntp-open-connection-function map)) :end-of-command "^\\([2345]\\|[.]\\).*\n" - :capability-command "CAPABILITIES\r\n" + :capability-command "HELP\r\n" :success "^3" :starttls-function (lambda (capabilities) diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el index 719dff471ad..5ccbd197ff0 100644 --- a/lisp/gnus/pop3.el +++ b/lisp/gnus/pop3.el @@ -98,20 +98,53 @@ set this to 1." :group 'pop3) (defcustom pop3-leave-mail-on-server nil - "*Non-nil if the mail is to be left on the POP server after fetching. - -If `pop3-leave-mail-on-server' is non-nil the mail is to be left -on the POP server after fetching. Note that POP servers maintain -no state information between sessions, so what the client -believes is there and what is actually there may not match up. -If they do not, then you may get duplicate mails or the whole -thing can fall apart and leave you with a corrupt mailbox." - ;; We can't use the UILD support from XEmacs mail-lib or cvs.m17n.org: - ;; http://thread.gmane.org/v9lld8fml4.fsf@marauder.physik.uni-ulm.de - ;; http://thread.gmane.org/b9yy8hzy9ej.fsf@jpl.org - ;; Any volunteer to re-implement this? - :version "22.1" ;; Oort Gnus - :type 'boolean + "Non-nil if the mail is to be left on the POP server after fetching. +Mails once fetched will never be fetched again by the UIDL control. + +If this is neither nil nor a number, all mails will be left on the +server. If this is a number, leave mails on the server for this many +days since you first checked new mails. If this is nil, mails will be +deleted on the server right after fetching. + +Gnus users should use the `:leave' keyword in a mail source to direct +the behaviour per server, rather than directly modifying this value. + +Note that POP servers maintain no state information between sessions, +so what the client believes is there and what is actually there may +not match up. If they do not, then you may get duplicate mails or +the whole thing can fall apart and leave you with a corrupt mailbox." + :version "24.4" + :type '(choice (const :tag "Don't leave mails" nil) + (const :tag "Leave all mails" t) + (number :tag "Leave mails for this many days" :value 14)) + :group 'pop3) + +(defcustom pop3-uidl-file "~/.pop3-uidl" + "File used to save UIDL." + :version "24.4" + :type 'file + :group 'pop3) + +(defcustom pop3-uidl-file-backup '(0 9) + "How to backup the UIDL file `pop3-uidl-file' when updating. +If it is a list of numbers, the first one binds `kept-old-versions' and +the other binds `kept-new-versions' to keep number of oldest and newest +versions. Otherwise, the value binds `version-control' (which see). + +Note: Backup will take place whenever you check new mails on a server. +So, you may lose the backup files having been saved before a trouble +if you set it so as to make too few backups whereas you have access to +many servers." + :version "24.4" + :type '(choice (group :tag "Keep versions" :format "\n%v" :indent 3 + (number :tag "oldest") + (number :tag "newest")) + (sexp :format "%v" + :match (lambda (widget value) + (condition-case nil + (not (and (numberp (car value)) + (numberp (car (cdr value))))) + (error t))))) :group 'pop3) (defvar pop3-timestamp nil @@ -144,34 +177,66 @@ Shorter values mean quicker response, but are more CPU intensive.") (truncate pop3-read-timeout)) 1000)))))) +(defvar pop3-uidl) +;; List of UIDLs of existing messages at present in the server: +;; ("UIDL1" "UIDL2" "UIDL3"...) + +(defvar pop3-uidl-saved) +;; Locally saved UIDL data; an alist of the server, the user, and the UIDL +;; and timestamp pairs: +;; (("SERVER_A" ("USER_A1" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...) +;; ("USER_A2" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...) +;; ...) +;; ("SERVER_B" ("USER_B1" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...) +;; ("USER_B2" "UIDL1" TIMESTAMP1 "UIDL2" TIMESTAMP2...) +;; ...)) +;; Where TIMESTAMP is the most significant two digits of an Emacs time, +;; i.e. the return value of `current-time'. + ;;;###autoload (defun pop3-movemail (file) "Transfer contents of a maildrop to the specified FILE. Use streaming commands." - (let* ((process (pop3-open-server pop3-mailhost pop3-port)) - message-count message-total-size) + (let ((process (pop3-open-server pop3-mailhost pop3-port)) + messages total-size + pop3-uidl + pop3-uidl-saved) (pop3-logon process) - (with-current-buffer (process-buffer process) + (if pop3-leave-mail-on-server + (setq messages (pop3-uidl-stat process) + total-size (cadr messages) + messages (car messages)) (let ((size (pop3-stat process))) - (setq message-count (car size) - message-total-size (cadr size))) - (when (> message-count 0) - (pop3-send-streaming-command - process "RETR" message-count message-total-size) - (pop3-write-to-file file) + (dotimes (i (car size)) (push (1+ i) messages)) + (setq messages (nreverse messages) + total-size (cadr size)))) + (when messages + (with-current-buffer (process-buffer process) + (pop3-send-streaming-command process "RETR" messages total-size) + (pop3-write-to-file file messages) (unless pop3-leave-mail-on-server - (pop3-send-streaming-command - process "DELE" message-count nil)))) - (pop3-quit process) + (pop3-send-streaming-command process "DELE" messages nil)))) + (if pop3-leave-mail-on-server + (when (prog1 (pop3-uidl-dele process) (pop3-quit process)) + (pop3-uidl-save)) + (pop3-quit process) + ;; Remove UIDL data for the account that got not to leave mails. + (setq pop3-uidl-saved (pop3-uidl-load)) + (let ((elt (assoc pop3-maildrop + (cdr (assoc pop3-mailhost pop3-uidl-saved))))) + (when elt + (setcdr elt nil) + (pop3-uidl-save)))) t)) -(defun pop3-send-streaming-command (process command count total-size) +(defun pop3-send-streaming-command (process command messages total-size) (erase-buffer) - (let ((i 1) + (let ((count (length messages)) + (i 1) (start-point (point-min)) (waited-for 0)) - (while (>= count i) - (process-send-string process (format "%s %d\r\n" command i)) + (while messages + (process-send-string process (format "%s %d\r\n" command (pop messages))) ;; Only do 100 messages at a time to avoid pipe stalls. (when (zerop (% i pop3-stream-length)) (setq start-point @@ -207,7 +272,7 @@ Use streaming commands." (pop3-accept-process-output process)) start-point) -(defun pop3-write-to-file (file) +(defun pop3-write-to-file (file messages) (let ((pop-buffer (current-buffer)) (start (point-min)) beg end @@ -230,6 +295,8 @@ Use streaming commands." (pop3-clean-region hstart (point)) (goto-char (point-max)) (pop3-munge-message-separator hstart (point)) + (when pop3-leave-mail-on-server + (pop3-uidl-add-xheader hstart (pop messages))) (goto-char (point-max)))))) (let ((coding-system-for-write 'binary)) (goto-char (point-min)) @@ -275,6 +342,184 @@ Use streaming commands." (pop3-quit process) message-count)) +(defun pop3-uidl-stat (process) + "Return a list of unread message numbers and total size." + (pop3-send-command process "UIDL") + (let (err messages size) + (if (condition-case code + (progn + (pop3-read-response process) + t) + (error (setq err (error-message-string code)) + nil)) + (let ((start pop3-read-point) + saved list) + (with-current-buffer (process-buffer process) + (while (not (re-search-forward "^\\.\r\n" nil t)) + (unless (memq (process-status process) '(open run)) + (error "pop3 server closed the connection")) + (pop3-accept-process-output process) + (goto-char start)) + (setq pop3-read-point (point-marker) + pop3-uidl nil) + (while (progn (forward-line -1) (>= (point) start)) + (when (looking-at "[0-9]+ \\([^\n\r ]+\\)") + (push (match-string 1) pop3-uidl))) + (when pop3-uidl + (setq pop3-uidl-saved (pop3-uidl-load) + saved (cdr (assoc pop3-maildrop + (cdr (assoc pop3-mailhost + pop3-uidl-saved))))) + (let ((i (length pop3-uidl))) + (while (> i 0) + (unless (member (nth (1- i) pop3-uidl) saved) + (push i messages)) + (decf i))) + (when messages + (setq list (pop3-list process) + size 0) + (dolist (msg messages) + (setq size (+ size (cdr (assq msg list))))) + (list messages size))))) + (message "%s doesn't support UIDL (%s), so we try a regressive way..." + pop3-mailhost err) + (sit-for 1) + (setq size (pop3-stat process)) + (dotimes (i (car size)) (push (1+ i) messages)) + (setcar size (nreverse messages)) + size))) + +(defun pop3-uidl-dele (process) + "Delete messages according to `pop3-leave-mail-on-server'. +Return non-nil if it is necessary to update the local UIDL file." + (let* ((ctime (current-time)) + (srvr (assoc pop3-mailhost pop3-uidl-saved)) + (saved (assoc pop3-maildrop (cdr srvr))) + i uidl mod new tstamp dele) + (setcdr (cdr ctime) nil) + ;; Add new messages to the data to be saved. + (cond ((and pop3-uidl saved) + (setq i (1- (length pop3-uidl))) + (while (>= i 0) + (unless (member (setq uidl (nth i pop3-uidl)) (cdr saved)) + (push ctime new) + (push uidl new)) + (decf i))) + (pop3-uidl + (setq new (apply 'nconc (mapcar (lambda (elt) (list elt ctime)) + pop3-uidl))))) + (when new (setq mod t)) + ;; List expirable messages and delete them from the data to be saved. + (setq ctime (when (numberp pop3-leave-mail-on-server) + (/ (+ (* (car ctime) 65536.0) (cadr ctime)) 86400)) + i (1- (length saved))) + (while (> i 0) + (if (member (setq uidl (nth (1- i) saved)) pop3-uidl) + (progn + (setq tstamp (nth i saved)) + (if (and ctime + (> (- ctime (/ (+ (* (car tstamp) 65536.0) (cadr tstamp)) + 86400)) + pop3-leave-mail-on-server)) + ;; Mails to delete. + (progn + (setq mod t) + (push uidl dele)) + ;; Mails to keep. + (push tstamp new) + (push uidl new))) + ;; Mails having been deleted in the server. + (setq mod t)) + (decf i 2)) + (cond (saved + (setcdr saved new)) + (srvr + (setcdr (last srvr) (list (cons pop3-maildrop new)))) + (t + (add-to-list 'pop3-uidl-saved + (list pop3-mailhost (cons pop3-maildrop new)) + t))) + ;; Actually delete the messages in the server. + (when dele + (setq uidl nil + i (length pop3-uidl)) + (while (> i 0) + (when (member (nth (1- i) pop3-uidl) dele) + (push i uidl)) + (decf i)) + (when uidl + (pop3-send-streaming-command process "DELE" uidl nil))) + mod)) + +(defun pop3-uidl-load () + "Load saved UIDL." + (when (file-exists-p pop3-uidl-file) + (with-temp-buffer + (condition-case code + (progn + (insert-file-contents pop3-uidl-file) + (goto-char (point-min)) + (read (current-buffer))) + (error + (message "Error while loading %s (%s)" + pop3-uidl-file (error-message-string code)) + (sit-for 1) + nil))))) + +(defun pop3-uidl-save () + "Save UIDL." + (with-temp-buffer + (if pop3-uidl-saved + (progn + (insert "(") + (dolist (srvr pop3-uidl-saved) + (when (cdr srvr) + (insert "(\"" (pop srvr) "\"\n ") + (dolist (elt srvr) + (when (cdr elt) + (insert "(\"" (pop elt) "\"\n ") + (while elt + (insert (format "\"%s\" %s\n " (pop elt) (pop elt)))) + (delete-char -4) + (insert ")\n "))) + (delete-char -3) + (if (eq (char-before) ?\)) + (insert ")\n ") + (goto-char (1+ (point-at-bol))) + (delete-region (point) (point-max))))) + (when (eq (char-before) ? ) + (delete-char -2)) + (insert ")\n")) + (insert "()\n")) + (let ((buffer-file-name pop3-uidl-file) + (delete-old-versions t) + (kept-new-versions kept-new-versions) + (kept-old-versions kept-old-versions) + (version-control version-control)) + (if (consp pop3-uidl-file-backup) + (setq kept-new-versions (cadr pop3-uidl-file-backup) + kept-old-versions (car pop3-uidl-file-backup) + version-control t) + (setq version-control pop3-uidl-file-backup)) + (save-buffer)))) + +(defun pop3-uidl-add-xheader (start msgno) + "Add X-UIDL header." + (let ((case-fold-search t)) + (save-restriction + (narrow-to-region start (progn + (goto-char start) + (search-forward "\n\n" nil 'move) + (1- (point)))) + (goto-char start) + (while (re-search-forward "^x-uidl:" nil t) + (while (progn + (forward-line 1) + (memq (char-after) '(?\t ? )))) + (delete-region (match-beginning 0) (point))) + (goto-char (point-max)) + (insert "X-UIDL: " (nth (1- msgno) pop3-uidl) "\n")))) + (defcustom pop3-stream-type nil "*Transport security type for POP3 connections. This may be either nil (plain connection), `ssl' (use an @@ -663,6 +908,13 @@ and close the connection." ;; Possible responses: ;; +OK [all delete marks removed] +;; UIDL [msg] +;; Arguments: a message-id (optional) +;; Restrictions: transaction state; msg must not be deleted +;; Possible responses: +;; +OK [uidl listing follows] +;; -ERR [no such message] + ;;; UPDATE STATE ;; QUIT diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el index ae3108a0a67..c9bf324b4fa 100644 --- a/lisp/gnus/shr.el +++ b/lisp/gnus/shr.el @@ -931,7 +931,8 @@ ones, in case fg and bg are nil." (start (point)) shr-start) (shr-generic cont) - (shr-urlify (or shr-start start) (shr-expand-url url) title))) + (when url + (shr-urlify (or shr-start start) (shr-expand-url url) title)))) (defun shr-tag-object (cont) (let ((start (point)) diff --git a/lisp/gnus/sieve-mode.el b/lisp/gnus/sieve-mode.el index 712ba34fb68..64768370488 100644 --- a/lisp/gnus/sieve-mode.el +++ b/lisp/gnus/sieve-mode.el @@ -131,14 +131,17 @@ (eval-when-compile (list ;; control commands - (cons (regexp-opt '("require" "if" "else" "elsif" "stop")) + (cons (regexp-opt '("require" "if" "else" "elsif" "stop") + 'words) 'sieve-control-commands-face) ;; action commands - (cons (regexp-opt '("fileinto" "redirect" "reject" "keep" "discard")) + (cons (regexp-opt '("fileinto" "redirect" "reject" "keep" "discard") + 'words) 'sieve-action-commands-face) ;; test commands (cons (regexp-opt '("address" "allof" "anyof" "exists" "false" - "true" "header" "not" "size" "envelope")) + "true" "header" "not" "size" "envelope") + 'words) 'sieve-test-commands-face) (cons "\\Sw+:\\sw+" 'sieve-tagged-arguments-face)))) diff --git a/lisp/gnus/smiley.el b/lisp/gnus/smiley.el index 6381f5bf9d9..eb71134457c 100644 --- a/lisp/gnus/smiley.el +++ b/lisp/gnus/smiley.el @@ -59,7 +59,10 @@ (defcustom smiley-style (if (or (and (fboundp 'face-attribute) - (>= (face-attribute 'default :height) 160)) + ;; In batch mode, attributes can be unspecified. + (condition-case nil + (>= (face-attribute 'default :height) 160) + (error nil))) (and (fboundp 'face-height) (>= (face-height 'default) 14))) 'medium diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el index 1ef645d2003..d75e8198842 100644 --- a/lisp/gnus/spam-stat.el +++ b/lisp/gnus/spam-stat.el @@ -494,6 +494,18 @@ where DIFF is the difference between SCORE and 0.5." (setcdr (nthcdr 14 result) nil) result)) +(eval-when-compile + (defmacro spam-stat-called-interactively-p (kind) + (condition-case nil + (progn + (eval '(called-interactively-p 'any)) + ;; Emacs >=23.2 + `(called-interactively-p ,kind)) + ;; Emacs <23.2 + (wrong-number-of-arguments '(called-interactively-p)) + ;; XEmacs + (void-function '(interactive-p))))) + (defun spam-stat-score-buffer () "Return a score describing the spam-probability for this buffer. Add user supplied modifications if supplied." @@ -511,7 +523,7 @@ Add user supplied modifications if supplied." (error nil))) (ans (if score1s (+ score0 score1s) score0))) - (when (interactive-p) + (when (spam-stat-called-interactively-p 'any) (message "%S" ans)) ans)) diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index d84518b68b5..063ba28d6eb 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -2092,22 +2092,24 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (declare-function gnus-extract-address-components "gnus-util" (from)) (eval-and-compile - (when (condition-case nil - (progn - (require 'bbdb) - (require 'bbdb-com)) - (file-error - ;; `bbdb-records' should not be bound as an autoload function - ;; before loading bbdb because of `bbdb-hashtable-size'. - (defalias 'bbdb-buffer 'ignore) - (defalias 'bbdb-create-internal 'ignore) - (defalias 'bbdb-records 'ignore) - (defalias 'spam-BBDB-register-routine 'ignore) - (defalias 'spam-enter-ham-BBDB 'ignore) - (defalias 'spam-exists-in-BBDB-p 'ignore) - (defalias 'bbdb-gethash 'ignore) - nil)) + (condition-case nil + (progn + (require 'bbdb) + (require 'bbdb-com)) + (file-error + ;; `bbdb-records' should not be bound as an autoload function + ;; before loading bbdb because of `bbdb-hashtable-size'. + (defalias 'bbdb-buffer 'ignore) + (defalias 'bbdb-create-internal 'ignore) + (defalias 'bbdb-records 'ignore) + (defalias 'spam-BBDB-register-routine 'ignore) + (defalias 'spam-enter-ham-BBDB 'ignore) + (defalias 'spam-exists-in-BBDB-p 'ignore) + (defalias 'bbdb-gethash 'ignore) + nil))) +(eval-and-compile + (when (featurep 'bbdb-com) ;; when the BBDB changes, we want to clear out our cache (defun spam-clear-cache-BBDB (&rest immaterial) (spam-clear-cache 'spam-use-BBDB)) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index d38501509bb..04bcc9c0763 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -789,7 +789,7 @@ it is displayed along with the global value." (cond ((bufferp locus) (princ (format "Local in buffer %s; " - (buffer-name)))) + (buffer-name buffer)))) ((framep locus) (princ (format "It is a frame-local variable; "))) ((terminal-live-p locus) diff --git a/lisp/help-macro.el b/lisp/help-macro.el index 7e81fc2d702..566f1597596 100644 --- a/lisp/help-macro.el +++ b/lisp/help-macro.el @@ -134,7 +134,7 @@ and then returns." (when (or (eq char ??) (eq char help-char) (memq char help-event-list)) (setq config (current-window-configuration)) - (switch-to-buffer-other-window "*Help*") + (pop-to-buffer " *Metahelp*" nil t) (and (fboundp 'make-frame) (not (eq (window-frame (selected-window)) prev-frame)) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 33c3ab3b717..b5aca1a4445 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -322,7 +322,7 @@ Commands: (defconst help-xref-symbol-regexp (purecopy (concat "\\(\\<\\(\\(variable\\|option\\)\\|" ; Link to var - "\\(function\\|command\\)\\|" ; Link to function + "\\(function\\|command\\|call\\)\\|" ; Link to function "\\(face\\)\\|" ; Link to face "\\(symbol\\|program\\|property\\)\\|" ; Don't link "\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)" @@ -677,7 +677,8 @@ help buffer." " is also a " "face." "\n\n" facedoc)) ;; Don't record the `describe-function' item in the stack. (setq help-xref-stack-item nil) - (help-setup-xref (list #'help-xref-interned symbol) nil))))))) + (help-setup-xref (list #'help-xref-interned symbol) nil)))) + (goto-char (point-min))))) ;; Navigation/hyperlinking with xrefs diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index 476399225f4..cbd8ac5ebad 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -1,4 +1,4 @@ -;;; hi-lock.el --- minor mode for interactive automatic highlighting +;;; hi-lock.el --- minor mode for interactive automatic highlighting -*- lexical-binding: t -*- ;; Copyright (C) 2000-2013 Free Software Foundation, Inc. @@ -135,6 +135,13 @@ patterns." ;; It can have a function value. (put 'hi-lock-file-patterns-policy 'risky-local-variable t) +(defcustom hi-lock-auto-select-face nil + "Non-nil if highlighting commands should not prompt for face names. +When non-nil, each hi-lock command will cycle through faces in +`hi-lock-face-defaults' without prompting." + :type 'boolean + :version "24.4") + (defgroup hi-lock-faces nil "Faces for hi-lock." :group 'hi-lock @@ -198,11 +205,13 @@ patterns." "Face for hi-lock mode." :group 'hi-lock-faces) -(defvar hi-lock-file-patterns nil +(defvar-local hi-lock-file-patterns nil "Patterns found in file for hi-lock. Should not be changed.") +(put 'hi-lock-file-patterns 'permanent-local t) -(defvar hi-lock-interactive-patterns nil +(defvar-local hi-lock-interactive-patterns nil "Patterns provided to hi-lock by user. Should not be changed.") +(put 'hi-lock-interactive-patterns 'permanent-local t) (define-obsolete-variable-alias 'hi-lock-face-history 'hi-lock-face-defaults "23.1") @@ -211,9 +220,6 @@ patterns." "hi-blue-b" "hi-red-b" "hi-green-b" "hi-black-hb") "Default faces for hi-lock interactive functions.") -;;(dolist (f hi-lock-face-defaults) -;; (unless (facep f) (error "%s not a face" f))) - (define-obsolete-variable-alias 'hi-lock-regexp-history 'regexp-history "23.1") @@ -232,11 +238,6 @@ that older functionality. This variable avoids multiple reminders.") Assumption is made if `hi-lock-mode' used in the *scratch* buffer while a library is being loaded.") -(make-variable-buffer-local 'hi-lock-interactive-patterns) -(put 'hi-lock-interactive-patterns 'permanent-local t) -(make-variable-buffer-local 'hi-lock-file-patterns) -(put 'hi-lock-file-patterns 'permanent-local t) - (defvar hi-lock-menu (let ((map (make-sparse-keymap "Hi Lock"))) (define-key-after map [highlight-regexp] @@ -461,58 +462,113 @@ updated as you type." (unless hi-lock-mode (hi-lock-mode 1)) (hi-lock-set-pattern regexp face)) +(defun hi-lock-keyword->face (keyword) + (cadr (cadr (cadr keyword)))) ; Keyword looks like (REGEXP (0 'FACE) ...). + (declare-function x-popup-menu "menu.c" (position menu)) +(defun hi-lock--regexps-at-point () + (let ((regexps '())) + ;; When using overlays, there is no ambiguity on the best + ;; choice of regexp. + (let ((regexp (get-char-property (point) 'hi-lock-overlay-regexp))) + (when regexp (push regexp regexps))) + ;; With font-locking on, check if the cursor is on a highlighted text. + (let ((face-after (get-text-property (point) 'face)) + (face-before + (unless (bobp) (get-text-property (1- (point)) 'face))) + (faces (mapcar #'hi-lock-keyword->face + hi-lock-interactive-patterns))) + (unless (memq face-before faces) (setq face-before nil)) + (unless (memq face-after faces) (setq face-after nil)) + (when (and face-before face-after (not (eq face-before face-after))) + (setq face-before nil)) + (when (or face-after face-before) + (let* ((hi-text + (buffer-substring-no-properties + (if face-before + (or (previous-single-property-change (point) 'face) + (point-min)) + (point)) + (if face-after + (or (next-single-property-change (point) 'face) + (point-max)) + (point))))) + ;; Compute hi-lock patterns that match the + ;; highlighted text at point. Use this later in + ;; during completing-read. + (dolist (hi-lock-pattern hi-lock-interactive-patterns) + (let ((regexp (car hi-lock-pattern))) + (if (string-match regexp hi-text) + (push regexp regexps))))))) + regexps)) + +(defvar-local hi-lock--unused-faces nil + "List of faces that is not used and is available for highlighting new text. +Face names from this list come from `hi-lock-face-defaults'.") + ;;;###autoload (defalias 'unhighlight-regexp 'hi-lock-unface-buffer) ;;;###autoload (defun hi-lock-unface-buffer (regexp) "Remove highlighting of each match to REGEXP set by hi-lock. Interactively, prompt for REGEXP, accepting only regexps -previously inserted by hi-lock interactive functions." +previously inserted by hi-lock interactive functions. +If REGEXP is t (or if \\[universal-argument] was specified interactively), +then remove all hi-lock highlighting." (interactive - (if (and (display-popup-menus-p) - (listp last-nonmenu-event) - use-dialog-box) - (catch 'snafu - (or - (x-popup-menu - t - (cons - `keymap - (cons "Select Pattern to Unhighlight" - (mapcar (lambda (pattern) - (list (car pattern) - (format - "%s (%s)" (car pattern) - (symbol-name - (car - (cdr (car (cdr (car (cdr pattern)))))))) - (cons nil nil) - (car pattern))) - hi-lock-interactive-patterns)))) - ;; If the user clicks outside the menu, meaning that they - ;; change their mind, x-popup-menu returns nil, and - ;; interactive signals a wrong number of arguments error. - ;; To prevent that, we return an empty string, which will - ;; effectively disable the rest of the function. - (throw 'snafu '("")))) - (let ((history-list (mapcar (lambda (p) (car p)) - hi-lock-interactive-patterns))) - (unless hi-lock-interactive-patterns - (error "No highlighting to remove")) + (cond + (current-prefix-arg (list t)) + ((and (display-popup-menus-p) + (listp last-nonmenu-event) + use-dialog-box) + (catch 'snafu + (or + (x-popup-menu + t + (cons + `keymap + (cons "Select Pattern to Unhighlight" + (mapcar (lambda (pattern) + (list (car pattern) + (format + "%s (%s)" (car pattern) + (hi-lock-keyword->face pattern)) + (cons nil nil) + (car pattern))) + hi-lock-interactive-patterns)))) + ;; If the user clicks outside the menu, meaning that they + ;; change their mind, x-popup-menu returns nil, and + ;; interactive signals a wrong number of arguments error. + ;; To prevent that, we return an empty string, which will + ;; effectively disable the rest of the function. + (throw 'snafu '(""))))) + (t + ;; Un-highlighting triggered via keyboard action. + (unless hi-lock-interactive-patterns + (error "No highlighting to remove")) + ;; Infer the regexp to un-highlight based on cursor position. + (let* ((defaults (or (hi-lock--regexps-at-point) + (mapcar #'car hi-lock-interactive-patterns)))) (list - (completing-read "Regexp to unhighlight: " - hi-lock-interactive-patterns nil t - (car (car hi-lock-interactive-patterns)) - (cons 'history-list 1)))))) - (let ((keyword (assoc regexp hi-lock-interactive-patterns))) + (completing-read (if (null defaults) + "Regexp to unhighlight: " + (format "Regexp to unhighlight (default %s): " + (car defaults))) + hi-lock-interactive-patterns + nil t nil nil defaults)))))) + (dolist (keyword (if (eq regexp t) hi-lock-interactive-patterns + (list (assoc regexp hi-lock-interactive-patterns)))) (when keyword + (let ((face (hi-lock-keyword->face keyword))) + ;; Make `face' the next one to use by default. + (when (symbolp face) ;Don't add it if it's a list (bug#13297). + (add-to-list 'hi-lock--unused-faces (face-name face)))) (font-lock-remove-keywords nil (list keyword)) (setq hi-lock-interactive-patterns (delq keyword hi-lock-interactive-patterns)) (remove-overlays - nil nil 'hi-lock-overlay-regexp (hi-lock-string-serialize regexp)) + nil nil 'hi-lock-overlay-regexp (hi-lock--hashcons (car keyword))) (when font-lock-fontified (font-lock-fontify-buffer))))) ;;;###autoload @@ -567,32 +623,44 @@ not suitable." regexp)) (defun hi-lock-read-face-name () - "Read face name from minibuffer with completion and history." - (intern (completing-read - "Highlight using face: " - obarray 'facep t - (cons (car hi-lock-face-defaults) - (let ((prefix - (try-completion - (substring (car hi-lock-face-defaults) 0 1) - hi-lock-face-defaults))) - (if (and (stringp prefix) - (not (equal prefix (car hi-lock-face-defaults)))) - (length prefix) 0))) - 'face-name-history - (cdr hi-lock-face-defaults)))) + "Return face for interactive highlighting. +When `hi-lock-auto-select-face' is non-nil, just return the next face. +Otherwise, read face name from minibuffer with completion and history." + (unless hi-lock-interactive-patterns + (setq hi-lock--unused-faces hi-lock-face-defaults)) + (let* ((last-used-face + (when hi-lock-interactive-patterns + (face-name (hi-lock-keyword->face + (car hi-lock-interactive-patterns))))) + (defaults (append hi-lock--unused-faces + (cdr (member last-used-face hi-lock-face-defaults)) + hi-lock-face-defaults)) + face) + (if (and hi-lock-auto-select-face (not current-prefix-arg)) + (setq face (or (pop hi-lock--unused-faces) (car defaults))) + (setq face (completing-read + (format "Highlight using face (default %s): " + (car defaults)) + obarray 'facep t nil 'face-name-history defaults)) + ;; Update list of un-used faces. + (setq hi-lock--unused-faces (remove face hi-lock--unused-faces)) + ;; Grow the list of defaults. + (add-to-list 'hi-lock-face-defaults face t)) + (intern face))) (defun hi-lock-set-pattern (regexp face) "Highlight REGEXP with face FACE." + ;; Hashcons the regexp, so it can be passed to remove-overlays later. + (setq regexp (hi-lock--hashcons regexp)) (let ((pattern (list regexp (list 0 (list 'quote face) t)))) - (unless (member pattern hi-lock-interactive-patterns) + ;; Refuse to highlight a text that is already highlighted. + (unless (assoc regexp hi-lock-interactive-patterns) (push pattern hi-lock-interactive-patterns) (if font-lock-mode (progn (font-lock-add-keywords nil (list pattern) t) (font-lock-fontify-buffer)) - (let* ((serial (hi-lock-string-serialize regexp)) - (range-min (- (point) (/ hi-lock-highlight-range 2))) + (let* ((range-min (- (point) (/ hi-lock-highlight-range 2))) (range-max (+ (point) (/ hi-lock-highlight-range 2))) (search-start (max (point-min) @@ -605,7 +673,7 @@ not suitable." (while (re-search-forward regexp search-end t) (let ((overlay (make-overlay (match-beginning 0) (match-end 0)))) (overlay-put overlay 'hi-lock-overlay t) - (overlay-put overlay 'hi-lock-overlay-regexp serial) + (overlay-put overlay 'hi-lock-overlay-regexp regexp) (overlay-put overlay 'face face)) (goto-char (match-end 0))))))))) @@ -655,25 +723,14 @@ not suitable." (font-lock-add-keywords nil hi-lock-file-patterns t) (font-lock-add-keywords nil hi-lock-interactive-patterns t))) -(defvar hi-lock-string-serialize-hash - (make-hash-table :test 'equal) - "Hash table used to assign unique numbers to strings.") +(defvar hi-lock--hashcons-hash + (make-hash-table :test 'equal :weakness t) + "Hash table used to hash cons regexps.") -(defvar hi-lock-string-serialize-serial 1 - "Number assigned to last new string in call to `hi-lock-string-serialize'. -A string is considered new if it had not previously been used in a call to -`hi-lock-string-serialize'.") - -(defun hi-lock-string-serialize (string) - "Return unique serial number for STRING." - (interactive) - (let ((val (gethash string hi-lock-string-serialize-hash))) - (if val val - (puthash string - (setq hi-lock-string-serialize-serial - (1+ hi-lock-string-serialize-serial)) - hi-lock-string-serialize-hash) - hi-lock-string-serialize-serial))) +(defun hi-lock--hashcons (string) + "Return unique object equal to STRING." + (or (gethash string hi-lock--hashcons-hash) + (puthash string string hi-lock--hashcons-hash))) (defun hi-lock-unload-function () "Unload the Hi-Lock library." diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el index 66440ef1cf2..17b91245d60 100644 --- a/lisp/hilit-chg.el +++ b/lisp/hilit-chg.el @@ -523,28 +523,12 @@ the text properties of type `hilit-chg'." (remove-overlays beg end 'hilit-chg t) (hilit-chg-display-changes beg end)) -;; Inspired by font-lock. Something like this should be moved to subr.el. -(defmacro highlight-save-buffer-state (&rest body) - "Bind variables according to VARLIST and eval BODY restoring buffer state." - (declare (indent 0) (debug t)) - (let ((modified (make-symbol "modified"))) - `(let* ((,modified (buffer-modified-p)) - (inhibit-modification-hooks t) - deactivate-mark - ;; So we don't check the file's mtime. - buffer-file-name - buffer-file-truename) - (progn - ,@body) - (unless ,modified - (restore-buffer-modified-p nil))))) - ;;;###autoload (defun highlight-changes-remove-highlight (beg end) "Remove the change face from the region between BEG and END. This allows you to manually remove highlighting from uninteresting changes." (interactive "r") - (highlight-save-buffer-state + (with-silent-modifications (remove-text-properties beg end '(hilit-chg nil)) (hilit-chg-fixup beg end))) @@ -568,40 +552,40 @@ This allows you to manually remove highlighting from uninteresting changes." (if (and highlight-changes-mode highlight-changes-visible-mode) (hilit-chg-fixup beg end)) - (highlight-save-buffer-state - (if (and (= beg end) (> leng-before 0)) - ;; deletion - (progn - ;; The eolp and bolp tests are a kludge! But they prevent - ;; rather nasty looking displays when deleting text at the end - ;; of line, such as normal corrections as one is typing and - ;; immediately makes a correction, and when deleting first - ;; character of a line. - ;; (if (= leng-before 1) - ;; (if (eolp) - ;; (setq beg-decr 0 end-incr 0) - ;; (if (bolp) - ;; (setq beg-decr 0)))) - ;; (setq beg (max (- beg beg-decr) (point-min))) - (setq end (min (+ end end-incr) (point-max))) - (setq type 'hilit-chg-delete)) - ;; Not a deletion. - ;; Most of the time the following is not necessary, but - ;; if the current text was marked as a deletion then - ;; the old overlay is still in effect. So if the user adds some - ;; text where she earlier deleted text, we have to remove the - ;; deletion marking, and replace it explicitly with a `changed' - ;; marking, otherwise its highlighting would disappear. - (if (eq (get-text-property end 'hilit-chg) 'hilit-chg-delete) - (save-restriction - (widen) - (put-text-property end (+ end 1) 'hilit-chg 'hilit-chg) - (if highlight-changes-visible-mode - (hilit-chg-fixup beg (+ end 1)))))) - (unless no-property-change - (put-text-property beg end 'hilit-chg type)) - (if (or highlight-changes-visible-mode no-property-change) - (hilit-chg-make-ov type beg end))))))) + (with-silent-modifications + (if (and (= beg end) (> leng-before 0)) + ;; deletion + (progn + ;; The eolp and bolp tests are a kludge! But they prevent + ;; rather nasty looking displays when deleting text at the end + ;; of line, such as normal corrections as one is typing and + ;; immediately makes a correction, and when deleting first + ;; character of a line. + ;; (if (= leng-before 1) + ;; (if (eolp) + ;; (setq beg-decr 0 end-incr 0) + ;; (if (bolp) + ;; (setq beg-decr 0)))) + ;; (setq beg (max (- beg beg-decr) (point-min))) + (setq end (min (+ end end-incr) (point-max))) + (setq type 'hilit-chg-delete)) + ;; Not a deletion. + ;; Most of the time the following is not necessary, but + ;; if the current text was marked as a deletion then + ;; the old overlay is still in effect. So if the user adds some + ;; text where she earlier deleted text, we have to remove the + ;; deletion marking, and replace it explicitly with a `changed' + ;; marking, otherwise its highlighting would disappear. + (if (eq (get-text-property end 'hilit-chg) 'hilit-chg-delete) + (save-restriction + (widen) + (put-text-property end (+ end 1) 'hilit-chg 'hilit-chg) + (if highlight-changes-visible-mode + (hilit-chg-fixup end (+ end 1)))))) + (unless no-property-change + (put-text-property beg end 'hilit-chg type)) + (if (or highlight-changes-visible-mode no-property-change) + (hilit-chg-make-ov type beg end))))))) (defun hilit-chg-update () "Update a buffer's highlight changes when visibility changed." @@ -635,7 +619,7 @@ This removes all saved change information." (message "Cannot remove highlighting from read-only mode buffer %s" (buffer-name)) (remove-hook 'after-change-functions 'hilit-chg-set-face-on-change t) - (highlight-save-buffer-state + (with-silent-modifications (hilit-chg-hide-changes) (hilit-chg-map-changes (lambda (_prop start stop) diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 231e7bddbc0..8f934b86288 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -1362,24 +1362,27 @@ group." (defun ibuffer-mark-forward (arg) "Mark the buffer on this line, and move forward ARG lines. If point is on a group name, this function operates on that group." - (interactive "P") - (ibuffer-mark-interactive arg ibuffer-marked-char 1)) + (interactive "p") + (ibuffer-mark-interactive arg ibuffer-marked-char)) (defun ibuffer-unmark-forward (arg) "Unmark the buffer on this line, and move forward ARG lines. If point is on a group name, this function operates on that group." - (interactive "P") - (ibuffer-mark-interactive arg ?\s 1)) + (interactive "p") + (ibuffer-mark-interactive arg ?\s)) (defun ibuffer-unmark-backward (arg) "Unmark the buffer on this line, and move backward ARG lines. If point is on a group name, this function operates on that group." - (interactive "P") - (ibuffer-mark-interactive arg ?\s -1)) + (interactive "p") + (ibuffer-unmark-forward (- arg))) -(defun ibuffer-mark-interactive (arg mark movement) +(defun ibuffer-mark-interactive (arg mark &optional movement) (ibuffer-assert-ibuffer-mode) (or arg (setq arg 1)) + ;; deprecated movement argument + (when (and movement (< movement 0)) + (setq arg (- arg))) (ibuffer-forward-line 0) (ibuffer-aif (get-text-property (point) 'ibuffer-filter-group-name) (progn @@ -1389,8 +1392,12 @@ If point is on a group name, this function operates on that group." (let ((inhibit-read-only t)) (while (> arg 0) (ibuffer-set-mark mark) - (ibuffer-forward-line movement t) - (setq arg (1- arg)))))) + (ibuffer-forward-line 1 t) + (setq arg (1- arg))) + (while (< arg 0) + (ibuffer-forward-line -1 t) + (ibuffer-set-mark mark) + (setq arg (1+ arg)))))) (defun ibuffer-set-mark (mark) (ibuffer-assert-ibuffer-mode) diff --git a/lisp/icomplete.el b/lisp/icomplete.el index e1eda278da2..9407de4f6d9 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -71,6 +71,11 @@ (make-obsolete-variable 'icomplete-prospects-length 'icomplete-prospects-height "23.1") +(defcustom icomplete-separator " | " + "String used by icomplete to separate alternatives in the minibuffer." + :type 'string + :version "24.4") + ;;;_* User Customization variables (defcustom icomplete-prospects-height ;; 20 is an estimated common size for the prompt + minibuffer content, to @@ -97,11 +102,6 @@ See `icomplete-delay-completions-threshold'." :type 'integer :group 'icomplete) -(defcustom icomplete-show-key-bindings t - "If non-nil, show key bindings as well as completion for sole matches." - :type 'boolean - :group 'icomplete) - (defcustom icomplete-minibuffer-setup-hook nil "Icomplete-specific customization of minibuffer setup. @@ -145,23 +145,6 @@ Use `icomplete-mode' function to set it up properly for incremental minibuffer completion.") (add-hook 'icomplete-post-command-hook 'icomplete-exhibit) -(defun icomplete-get-keys (func-name) - "Return strings naming keys bound to FUNC-NAME, or nil if none. -Examines the prior, not current, buffer, presuming that current buffer -is minibuffer." - (when (commandp func-name) - (save-excursion - (let* ((sym (intern func-name)) - (buf (other-buffer nil t)) - (keys (with-current-buffer buf (where-is-internal sym)))) - (when keys - (concat "<" - (mapconcat 'key-description - (sort keys - #'(lambda (x y) - (< (length x) (length y)))) - ", ") - ">")))))) ;;;_ = icomplete-with-completion-tables (defvar icomplete-with-completion-tables '(internal-complete-buffer) "Specialized completion tables with which icomplete should operate. @@ -169,6 +152,37 @@ is minibuffer." Icomplete does not operate with any specialized completion tables except those on this list.") +(defvar icomplete-minibuffer-map + (let ((map (make-sparse-keymap))) + (define-key map [?\M-\t] 'minibuffer-force-complete) + (define-key map [?\C-j] 'minibuffer-force-complete-and-exit) + (define-key map [?\C-s] 'icomplete-forward-completions) + (define-key map [?\C-r] 'icomplete-backward-completions) + map)) + +(defun icomplete-forward-completions () + "Step forward completions by one entry. +Second entry becomes the first and can be selected with +`minibuffer-force-complete-and-exit'." + (interactive) + (let* ((comps (completion-all-sorted-completions)) + (last (last comps))) + (setcdr last (cons (car comps) (cdr last))) + (completion--cache-all-sorted-completions (cdr comps)))) + +(defun icomplete-backward-completions () + "Step backward completions by one entry. +Last entry becomes the first and can be selected with +`minibuffer-force-complete-and-exit'." + (interactive) + (let* ((comps (completion-all-sorted-completions)) + (last-but-one (last comps 2)) + (last (cdr last-but-one))) + (when last + (setcdr last-but-one (cdr last)) + (push (car last) comps) + (completion--cache-all-sorted-completions comps)))) + ;;;_ > icomplete-mode (&optional prefix) ;;;###autoload (define-minor-mode icomplete-mode @@ -208,6 +222,8 @@ Conditions are: Usually run by inclusion in `minibuffer-setup-hook'." (when (and icomplete-mode (icomplete-simple-completing-p)) (set (make-local-variable 'completion-show-inline-help) nil) + (use-local-map (make-composed-keymap icomplete-minibuffer-map + (current-local-map))) (add-hook 'pre-command-hook (lambda () (let ((non-essential t)) (run-hooks 'icomplete-pre-command-hook))) @@ -239,27 +255,29 @@ and `minibuffer-setup-hook'." (goto-char (point-max)) ; Insert the match-status information: (if (and (> (point-max) (minibuffer-prompt-end)) - buffer-undo-list ; Wait for some user input. - (or - ;; Don't bother with delay after certain number of chars: - (> (- (point) (field-beginning)) icomplete-max-delay-chars) - ;; Don't delay if alternatives number is small enough: - (and (sequencep minibuffer-completion-table) - (< (length minibuffer-completion-table) - icomplete-delay-completions-threshold)) - ;; Delay - give some grace time for next keystroke, before + buffer-undo-list ; Wait for some user input. + (or + ;; Don't bother with delay after certain number of chars: + (> (- (point) (field-beginning)) icomplete-max-delay-chars) + ;; Don't delay if the completions are known. + completion-all-sorted-completions + ;; Don't delay if alternatives number is small enough: + (and (sequencep minibuffer-completion-table) + (< (length minibuffer-completion-table) + icomplete-delay-completions-threshold)) + ;; Delay - give some grace time for next keystroke, before ;; embarking on computing completions: (sit-for icomplete-compute-delay))) (let ((text (while-no-input - (icomplete-completions - (field-string) - minibuffer-completion-table - minibuffer-completion-predicate + (icomplete-completions + (field-string) + minibuffer-completion-table + minibuffer-completion-predicate (not minibuffer-completion-confirm)))) (buffer-undo-list t) deactivate-mark) ;; Do nothing if while-no-input was aborted. - (when (stringp text) + (when (stringp text) (move-overlay icomplete-overlay (point) (point) (current-buffer)) ;; The current C cursor code doesn't know to use the overlay's ;; marker's stickiness to figure out whether to place the cursor @@ -319,12 +337,16 @@ are exhibited within the square braces.)" ((= compare (length name)) ;; Typical case: name is a prefix. (substring most compare)) - ((< compare 5) most) - (t (concat "..." (substring most compare)))) + ;; Don't bother truncating if it doesn't gain + ;; us at least 2 columns. + ((< compare 3) most) + (t (concat "…" (substring most compare)))) close-bracket))) ;;"-prospects" - more than one candidate - (prospects-len (+ (length determ) 6 ;; take {,...} into account - (string-width (buffer-string)))) + (prospects-len (+ (length determ) + (string-width icomplete-separator) + 3 ;; take {…} into account + (string-width (buffer-string)))) (prospects-max ;; Max total length to use, including the minibuffer content. (* (+ icomplete-prospects-height @@ -355,7 +377,9 @@ are exhibited within the square braces.)" (cond ((string-equal comp "") (setq most-is-exact t)) ((member comp prospects)) (t (setq prospects-len - (+ (string-width comp) 1 prospects-len)) + (+ (string-width comp) + (string-width icomplete-separator) + prospects-len)) (if (< prospects-len prospects-max) (push comp prospects) (setq limit t)))))) @@ -365,17 +389,14 @@ are exhibited within the square braces.)" (if prospects (concat determ "{" - (and most-is-exact ",") - (mapconcat 'identity (nreverse prospects) ",") - (and limit ",...") + (and most-is-exact + (substring icomplete-separator + (string-match "[^ ]" icomplete-separator))) + (mapconcat 'identity (nreverse prospects) + icomplete-separator) + (and limit (concat icomplete-separator "…")) "}") - (concat determ - " [Matched" - (let ((keys (and icomplete-show-key-bindings - (commandp (intern-soft most)) - (icomplete-get-keys most)))) - (if keys (concat "; " keys) "")) - "]")))))) + (concat determ " [Matched]")))))) ;;_* Local emacs vars. ;;Local variables: diff --git a/lisp/ido.el b/lisp/ido.el index cda40211763..008561aa268 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -2389,7 +2389,10 @@ If cursor is not at the end of the user input, move to end of input." (ido-buffer-internal 'insert 'insert-buffer "Insert buffer: " nil ido-text 'ido-enter-insert-file)) ((eq ido-exit 'dired) - (dired (concat ido-current-directory (or ido-text "")))) + (funcall (cond ((eq method 'other-window) 'dired-other-window) + ((eq method 'other-frame) 'dired-other-frame) + (t 'dired)) + (concat ido-current-directory (or ido-text "")))) ((eq ido-exit 'ffap) (find-file-at-point)) @@ -3764,7 +3767,11 @@ This is to make them appear as if they were \"virtual buffers\"." ido-enable-flex-matching (> (length ido-text) 1) (not ido-enable-regexp)) - (setq re (mapconcat #'regexp-quote (split-string ido-text "" t) ".*")) + (setq re (concat (regexp-quote (string (aref ido-text 0))) + (mapconcat (lambda (c) + (concat "[^" (string c) "]*" + (regexp-quote (string c)))) + (substring ido-text 1) ""))) (if ido-enable-prefix (setq re (concat "\\`" re))) (mapc diff --git a/lisp/image-dired.el b/lisp/image-dired.el index f0483e6217a..354e16b0bfb 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -2454,6 +2454,8 @@ when using per-directory thumbnail file storage")) (defvar image-dired-widget-list nil "List to keep track of meta data in edit buffer.") +(declare-function widget-forward "wid-edit" (arg)) + ;;;###autoload (defun image-dired-dired-edit-comment-and-tags () "Edit comment and tags of current or marked image files. diff --git a/lisp/image-mode.el b/lisp/image-mode.el index a95dde1d999..6a13d528037 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -278,28 +278,50 @@ stopping if the top or bottom edge of the image is reached." ;; Adjust frame and image size. -(defun image-mode-fit-frame () - "Toggle whether to fit the frame to the current image. -This function assumes the current frame has only one window." - ;; FIXME: This does not take into account decorations like mode-line, - ;; minibuffer, header-line, ... - (interactive) - (let* ((saved (frame-parameter nil 'image-mode-saved-size)) +(defun image-mode-fit-frame (&optional frame toggle) + "Fit FRAME to the current image. +If FRAME is omitted or nil, it defaults to the selected frame. +All other windows on the frame are deleted. + +If called interactively, or if TOGGLE is non-nil, toggle between +fitting FRAME to the current image and restoring the size and +window configuration prior to the last `image-mode-fit-frame' +call." + (interactive (list nil t)) + (let* ((buffer (current-buffer)) (display (image-get-display-property)) - (size (image-display-size display))) - (if (and saved - (eq (caar saved) (frame-width)) - (eq (cdar saved) (frame-height))) - (progn ;; Toggle back to previous non-fitted size. - (set-frame-parameter nil 'image-mode-saved-size nil) - (setq size (cdr saved))) - ;; Round up size, and save current size so we can toggle back to it. - (setcar size (ceiling (car size))) - (setcdr size (ceiling (cdr size))) - (set-frame-parameter nil 'image-mode-saved-size - (cons size (cons (frame-width) (frame-height))))) - (set-frame-width (selected-frame) (car size)) - (set-frame-height (selected-frame) (cdr size)))) + (size (image-display-size display)) + (saved (frame-parameter frame 'image-mode-saved-params)) + (window-configuration (current-window-configuration frame)) + (width (frame-width frame)) + (height (frame-height frame))) + (with-selected-frame (or frame (selected-frame)) + (if (and toggle saved + (= (caar saved) width) + (= (cdar saved) height)) + (progn + (set-frame-width frame (car (nth 1 saved))) + (set-frame-height frame (cdr (nth 1 saved))) + (set-window-configuration (nth 2 saved)) + (set-frame-parameter frame 'image-mode-saved-params nil)) + (delete-other-windows) + (switch-to-buffer buffer t t) + (let* ((edges (window-inside-edges)) + (inner-width (- (nth 2 edges) (nth 0 edges))) + (inner-height (- (nth 3 edges) (nth 1 edges)))) + (set-frame-width frame (+ (ceiling (car size)) + width (- inner-width))) + (set-frame-height frame (+ (ceiling (cdr size)) + height (- inner-height))) + ;; The frame size after the above `set-frame-*' calls may + ;; differ from what we specified, due to window manager + ;; interference. We have to call `frame-width' and + ;; `frame-height' to get the actual results. + (set-frame-parameter frame 'image-mode-saved-params + (list (cons (frame-width) + (frame-height)) + (cons width height) + window-configuration))))))) ;;; Image Mode setup @@ -317,6 +339,8 @@ This function assumes the current frame has only one window." (define-key map (kbd "SPC") 'image-scroll-up) (define-key map (kbd "DEL") 'image-scroll-down) (define-key map (kbd "RET") 'image-toggle-animation) + (define-key map "n" 'image-next-file) + (define-key map "p" 'image-previous-file) (define-key map [remap forward-char] 'image-forward-hscroll) (define-key map [remap backward-char] 'image-backward-hscroll) (define-key map [remap right-char] 'image-forward-hscroll) @@ -596,6 +620,52 @@ Otherwise it plays once, then stops." (if image-animate-loop t))))))))) +;;; Switching to the next/previous image + +(defun image-next-file (&optional n) + "Visit the next image in the same directory as the current image file. +With optional argument N, visit the Nth image file after the +current one, in cyclic alphabetical order. + +This command visits the specified file via `find-alternate-file', +replacing the current Image mode buffer." + (interactive "p") + (unless (derived-mode-p 'image-mode) + (error "The buffer is not in Image mode")) + (unless buffer-file-name + (error "The current image is not associated with a file")) + (let* ((file (file-name-nondirectory buffer-file-name)) + (images (image-mode--images-in-directory file)) + (idx 0)) + (catch 'image-visit-next-file + (dolist (f images) + (if (string= f file) + (throw 'image-visit-next-file (1+ idx))) + (setq idx (1+ idx)))) + (setq idx (mod (+ idx (or n 1)) (length images))) + (find-alternate-file (nth idx images)))) + +(defun image-previous-file (&optional n) + "Visit the preceding image in the same directory as the current file. +With optional argument N, visit the Nth image file preceding the +current one, in cyclic alphabetical order. + +This command visits the specified file via `find-alternate-file', +replacing the current Image mode buffer." + (interactive "p") + (image-next-file (- n))) + +(defun image-mode--images-in-directory (file) + (let* ((dir (file-name-directory buffer-file-name)) + (files (directory-files dir nil + (image-file-name-regexp) t))) + ;; Add the current file to the list of images if necessary, in + ;; case it does not match `image-file-name-regexp'. + (unless (member file files) + (push file files)) + (sort files 'string-lessp))) + + ;;; Support for bookmark.el (declare-function bookmark-make-record-default "bookmark" (&optional no-file no-context posn)) diff --git a/lisp/image.el b/lisp/image.el index 9be1d6a1639..73b25f6da67 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -309,16 +309,13 @@ be determined." Value is a symbol specifying the image type, or nil if type cannot be determined." (let (type first) - (or - (catch 'found - (dolist (elem image-type-file-name-regexps) - (when (string-match-p (car elem) file) - (setq type (cdr elem)) - (or first (setq first type)) - (if (image-type-available-p type) - (throw 'found type))))) - ;; If nothing seems to be supported, return the first type that matched. - first))) + (catch 'found + (dolist (elem image-type-file-name-regexps first) + (when (string-match-p (car elem) file) + (if (image-type-available-p (setq type (cdr elem))) + (throw 'found type) + ;; If nothing seems to be supported, return first type that matched. + (or first (setq first type)))))))) ;;;###autoload (defun image-type (source &optional type data-p) diff --git a/lisp/imenu.el b/lisp/imenu.el index 0b5d69d6233..435d97fcdb4 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -447,6 +447,8 @@ Don't move point." Simple elements in the alist look like (INDEX-NAME . POSITION). POSITION is the buffer position of the item; to go to the item is simply to move point to that position. +POSITION is passed to `imenu-default-goto-function', so it can be a non-number +if that variable has been changed (e.g. Semantic uses overlays for POSITIONs). Special elements look like (INDEX-NAME POSITION FUNCTION ARGUMENTS...). To \"go to\" a special element means applying FUNCTION @@ -546,9 +548,7 @@ The returned alist DOES NOT share structure with MENULIST." Return a split and sorted copy of ALIST. The returned alist DOES NOT share structure with ALIST." (mapcar (lambda (elt) - (if (and (consp elt) - (stringp (car elt)) - (listp (cdr elt))) + (if (imenu--subalist-p elt) (imenu--split-menu (cdr elt) (car elt)) elt)) alist)) diff --git a/lisp/info.el b/lisp/info.el index 96c22e15110..e230ed0f82c 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -397,6 +397,10 @@ Marker points nowhere if file has no tag table.") (defvar 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 "Non-nil if current Info file supports index cookies.") @@ -742,11 +746,15 @@ in `Info-file-supports-index-cookies-list'." (push dir Info-directory-list))))))) ;;;###autoload -(defun info-other-window (&optional file-or-node) +(defun info-other-window (&optional file-or-node buffer) "Like `info' but show the Info buffer in another window." - (interactive (if current-prefix-arg - (list (read-file-name "Info file name: " nil nil t)))) - (info-setup file-or-node (switch-to-buffer-other-window "*info*"))) + (interactive (list + (if (and current-prefix-arg (not (numberp current-prefix-arg))) + (read-file-name "Info file name: " nil nil t)) + (if (numberp current-prefix-arg) + (format "*info*<%s>" current-prefix-arg)))) + (info-setup file-or-node + (switch-to-buffer-other-window (or buffer "*info*")))) ;;;###autoload (put 'info 'info-file (purecopy "emacs")) ;;;###autoload @@ -763,8 +771,9 @@ with the top-level Info directory. In interactive use, a non-numeric prefix argument directs this command to read a file name from the minibuffer. -A numeric prefix argument selects an Info buffer with the prefix number -appended to the Info buffer name. + +A numeric prefix argument N selects an Info buffer named +\"*info*<%s>\". The search path for Info files is in the variable `Info-directory-list'. The top-level Info directory is made by combining all the files named `dir' @@ -1668,7 +1677,9 @@ escaped (\\\",\\\\)." " (" (if (stringp Info-current-file) (replace-regexp-in-string - "%" "%%" (file-name-nondirectory Info-current-file)) + "%" "%%" + (file-name-sans-extension + (file-name-nondirectory Info-current-file))) (format "*%S*" Info-current-file)) ") " (if Info-current-node @@ -1692,7 +1703,9 @@ escaped (\\\",\\\\)." If NODENAME is of the form (FILENAME)NODENAME, the node is in the Info file FILENAME; otherwise, NODENAME should be in the current Info file (or one of its sub-files). -Completion is available, but only for node names in the current Info file. +Completion is available for node names in the current Info file as well as +in the Info file FILENAME after the closing parenthesis in (FILENAME). +Empty NODENAME in (FILENAME) defaults to the Top node. If FORK is non-nil (interactively with a prefix arg), show the node in a new Info buffer. If FORK is a string, it is the name to use for the new buffer." @@ -1729,6 +1742,7 @@ list of valid filename suffixes for Info files. See (when (file-name-absolute-p string) (setq dirs (list (file-name-directory string)))) (let ((names nil) + (names-sans-suffix nil) (suffix (concat (regexp-opt suffixes t) "\\'")) (string-dir (file-name-directory string))) (dolist (dir dirs) @@ -1751,7 +1765,14 @@ list of valid filename suffixes for Info files. See ;; add the unsuffixed name as a completion option. (when (string-match suffix file) (setq file (substring file 0 (match-beginning 0))) - (push (if string-dir (concat string-dir file) file) names))))) + (push (if string-dir (concat string-dir file) file) + names-sans-suffix))))) + ;; If there is just one file, don't duplicate it with suffixes, + ;; so `Info-read-node-name-1' will be able to complete a single + ;; candidate and to add the terminating ")". + (if (and (= (length names) 1) (= (length names-sans-suffix) 1)) + (setq names names-sans-suffix) + (setq names (append names-sans-suffix names))) (complete-with-action action names string pred))) (defun Info-read-node-name-1 (string predicate code) @@ -1769,12 +1790,23 @@ See `completing-read' for a description of arguments and usage." (substring string 1) predicate code)) - ;; If a file name was given, then any node is fair game. - ((string-match "\\`(" string) - (cond - ((eq code nil) string) - ((eq code t) nil) - (t t))) + ;; If a file name was given, complete nodes in the file. + ((string-match "\\`(\\([^)]+\\))" string) + (let ((file0 (match-string 0 string)) + (file1 (match-string 1 string)) + (nodename (substring string (match-end 0)))) + (if (and (equal nodename "") (eq code 'lambda)) + ;; Empty node name is permitted that means "Top". + t + (completion-table-with-context + file0 + (apply-partially + (lambda (string pred action) + (complete-with-action + action + (Info-build-node-completions (Info-find-file file1)) + string pred))) + nodename predicate code)))) ;; Otherwise use Info-read-node-completion-table. (t (complete-with-action code Info-read-node-completion-table string predicate)))) @@ -1783,7 +1815,9 @@ See `completing-read' for a description of arguments and usage." (defun Info-read-node-name (prompt) "Read an Info node name with completion, prompting with PROMPT. A node name can have the form \"NODENAME\", referring to a node -in the current Info file, or \"(FILENAME)NODENAME\"." +in the current Info file, or \"(FILENAME)NODENAME\", referring to +a node in FILENAME. \"(FILENAME)\" is a short format to go to +the Top node in FILENAME." (let* ((completion-ignore-case t) (Info-read-node-completion-table (Info-build-node-completions)) (nodename (completing-read prompt 'Info-read-node-name-1 nil t))) @@ -1791,41 +1825,54 @@ in the current Info file, or \"(FILENAME)NODENAME\"." (Info-read-node-name prompt) nodename))) -(defun Info-build-node-completions () - (or Info-current-file-completions - (let ((compl nil) - ;; Bind this in case the user sets it to nil. - (case-fold-search t) - (node-regexp "Node: *\\([^,\n]*\\) *[,\n\t]")) - (save-excursion - (save-restriction - (or Info-tag-table-marker - (error "No Info tags found")) - (if (marker-buffer Info-tag-table-marker) - (let ((marker Info-tag-table-marker)) - (set-buffer (marker-buffer marker)) - (widen) - (goto-char marker) - (while (re-search-forward "\n\\(Node\\|Ref\\): \\(.*\\)\177" nil t) - (setq compl - (cons (list (match-string-no-properties 2)) - compl)))) +(defun Info-build-node-completions (&optional filename) + (if filename + (or (cdr (assoc filename Info-file-completions)) + (with-temp-buffer + (Info-mode) + (Info-goto-node (format "(%s)Top" filename)) + (Info-build-node-completions-1) + (push (cons filename Info-current-file-completions) Info-file-completions) + Info-current-file-completions)) + (or Info-current-file-completions + (Info-build-node-completions-1)))) + +(defun Info-build-node-completions-1 () + (let ((compl nil) + ;; Bind this in case the user sets it to nil. + (case-fold-search t) + (node-regexp "Node: *\\([^,\n]*\\) *[,\n\t]")) + (save-excursion + (save-restriction + (or Info-tag-table-marker + (error "No Info tags found")) + (if (marker-buffer Info-tag-table-marker) + (let ((marker Info-tag-table-marker)) + (set-buffer (marker-buffer marker)) (widen) - (goto-char (point-min)) - ;; If the buffer begins with a node header, process that first. - (if (Info-node-at-bob-matching node-regexp) - (setq compl (list (match-string-no-properties 1)))) - ;; Now for the rest of the nodes. - (while (search-forward "\n\^_" nil t) - (forward-line 1) - (let ((beg (point))) - (forward-line 1) - (if (re-search-backward node-regexp beg t) - (setq compl - (cons (list (match-string-no-properties 1)) - compl)))))))) - (setq compl (cons '("*") compl)) - (set (make-local-variable 'Info-current-file-completions) compl)))) + (goto-char marker) + (while (re-search-forward "\n\\(Node\\|Ref\\): \\(.*\\)\177" nil t) + (setq compl + (cons (list (match-string-no-properties 2)) + compl)))) + (widen) + (goto-char (point-min)) + ;; If the buffer begins with a node header, process that first. + (if (Info-node-at-bob-matching node-regexp) + (setq compl (list (match-string-no-properties 1)))) + ;; Now for the rest of the nodes. + (while (search-forward "\n\^_" nil t) + (forward-line 1) + (let ((beg (point))) + (forward-line 1) + (if (re-search-backward node-regexp beg t) + (setq compl + (cons (list (match-string-no-properties 1)) + compl)))))))) + (setq compl (cons '("*") (nreverse compl))) + (set (make-local-variable 'Info-current-file-completions) compl) + compl)) + (defun Info-restore-point (hl) "If this node has been visited, restore the point value when we left." @@ -4032,7 +4079,9 @@ With a zero prefix arg, put the name inside a function call to `info'." (unless Info-current-node (user-error "No current Info node")) (let ((node (if (stringp Info-current-file) - (concat "(" (file-name-nondirectory Info-current-file) ") " + (concat "(" (file-name-sans-extension + (file-name-nondirectory Info-current-file)) + ") " Info-current-node)))) (if (zerop (prefix-numeric-value arg)) (setq node (concat "(info \"" node "\")"))) @@ -4264,7 +4313,7 @@ If the element is just a file name, the file name also serves as the prefix.") The `info-file' property of COMMAND says which Info manual to search. If COMMAND has no property, the variable `Info-file-list-for-emacs' defines heuristics for which Info manual to try. -The locations are of the format used in `Info-history', i.e. +The locations are of the format used in the variable `Info-history', i.e. \(FILENAME NODENAME BUFFERPOS), where BUFFERPOS is the line number in the first element of the returned list (which is treated specially in `Info-goto-emacs-command-node'), and 0 for the rest elements of a list." @@ -4419,7 +4468,8 @@ first line or header line, and for breadcrumb links.") (if (not (equal node "Top")) node (format "(%s)Top" (if (stringp Info-current-file) - (file-name-nondirectory Info-current-file) + (file-name-sans-extension + (file-name-nondirectory Info-current-file)) ;; Some legacy code can still use a symbol. Info-current-file))))) (setq line (concat @@ -4531,7 +4581,8 @@ first line or header line, and for breadcrumb links.") (if (re-search-forward (format "File: %s\\([^,\n\t]+\\)," (if (stringp Info-current-file) - (file-name-nondirectory Info-current-file) + (file-name-sans-extension + (file-name-nondirectory Info-current-file)) Info-current-file)) header-end t) (put-text-property (match-beginning 1) (match-end 1) @@ -4836,6 +4887,17 @@ first line or header line, and for breadcrumb links.") ;; current Info node. (eval-when-compile (require 'speedbar)) +(declare-function speedbar-add-expansion-list "speedbar" (new-list)) +(declare-function speedbar-center-buffer-smartly "speedbar" ()) +(declare-function speedbar-change-expand-button-char "speedbar" (char)) +(declare-function speedbar-change-initial-expansion-list "speedbar" (new-default)) +(declare-function speedbar-delete-subblock "speedbar" (indent)) +(declare-function speedbar-make-specialized-keymap "speedbar" ()) +(declare-function speedbar-make-tag-line "speedbar" + (exp-button-type exp-button-char exp-button-function + exp-button-data tag-button tag-button-function + tag-button-data tag-button-face depth)) + (defvar Info-speedbar-key-map nil "Keymap used when in the Info display mode.") @@ -5058,7 +5120,8 @@ BUFFER is the buffer speedbar is requesting buttons for." "This implements the `bookmark-make-record-function' type (which see) for Info nodes." (let* ((file (and (stringp Info-current-file) - (file-name-nondirectory Info-current-file))) + (file-name-sans-extension + (file-name-nondirectory Info-current-file)))) (bookmark-name (if file (concat "(" file ") " Info-current-node) Info-current-node)) @@ -5086,8 +5149,16 @@ type returned by `Info-bookmark-make-record', which see." ;;;###autoload (defun info-display-manual (manual) - "Go to Info buffer that displays MANUAL, creating it if none already exists." - (interactive "sManual name: ") + "Display an Info buffer displaying MANUAL. +If there is an existing Info buffer for MANUAL, display it. +Otherwise, visit the manual in a new Info buffer." + (interactive + (list + (progn + (info-initialize) + (completing-read "Manual name: " + (info--manual-names) + nil t)))) (let ((blist (buffer-list)) (manual-re (concat "\\(/\\|\\`\\)" manual "\\(\\.\\|\\'\\)")) (case-fold-search t) @@ -5102,7 +5173,25 @@ type returned by `Info-bookmark-make-record', which see." (if found (switch-to-buffer found) (info-initialize) - (info (Info-find-file manual))))) + (info (Info-find-file manual) + (generate-new-buffer-name "*info*"))))) + +(defun info--manual-names () + (let (names) + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (and (eq major-mode 'Info-mode) + (stringp Info-current-file) + (not (string= (substring (buffer-name) 0 1) " ")) + (push (file-name-sans-extension + (file-name-nondirectory Info-current-file)) + names)))) + (delete-dups (append (nreverse names) + (all-completions + "" + (apply-partially 'Info-read-node-name-2 + Info-directory-list + (mapcar 'car Info-suffix-list))))))) (provide 'info) diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index f51daa0eac0..35c303f0ea8 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -2945,20 +2945,26 @@ at the beginning of the name. This function also accepts a hexadecimal number of Unicode code point or a number in hash notation, e.g. #o21430 for octal, #x2318 for hex, or #10r8984 for decimal." - (let* ((completion-ignore-case t) - (input (completing-read - prompt - (lambda (string pred action) - (if (eq action 'metadata) - '(metadata (category . unicode-name)) - (complete-with-action action (ucs-names) string pred)))))) - (cond - ((string-match-p "\\`[0-9a-fA-F]+\\'" input) - (string-to-number input 16)) - ((string-match-p "\\`#" input) - (read input)) - (t - (cdr (assoc-string input (ucs-names) t)))))) + (let* ((enable-recursive-minibuffers t) + (completion-ignore-case t) + (input + (completing-read + prompt + (lambda (string pred action) + (if (eq action 'metadata) + '(metadata (category . unicode-name)) + (complete-with-action action (ucs-names) string pred))))) + (char + (cond + ((string-match-p "\\`[0-9a-fA-F]+\\'" input) + (string-to-number input 16)) + ((string-match-p "\\`#" input) + (read input)) + (t + (cdr (assoc-string input (ucs-names) t)))))) + (unless (characterp char) + (error "Invalid character")) + char)) (define-obsolete-function-alias 'ucs-insert 'insert-char "24.3") (define-key ctl-x-map "8\r" 'insert-char) diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 6fa589a9622..995df2fb9a7 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -891,7 +891,7 @@ or one is an alias of the other." (and (vectorp eol-type-1) (vectorp eol-type-2))))))) (defun add-to-coding-system-list (coding-system) - "Add CODING-SYSTEM to `coding-system-list' while keeping it sorted." + "Add CODING-SYSTEM to variable `coding-system-list' while keeping it sorted." (if (or (null coding-system-list) (coding-system-lessp coding-system (car coding-system-list))) (setq coding-system-list (cons coding-system coding-system-list)) diff --git a/lisp/isearch.el b/lisp/isearch.el index e8bcf7679ae..e16e3840d0d 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -176,7 +176,7 @@ is non-nil if the user quits the search.") (defvar isearch-message-function nil "Function to call to display the search prompt. -If nil, use `isearch-message'.") +If nil, use function `isearch-message'.") (defvar isearch-wrap-function nil "Function to call to wrap the search when search is failed. @@ -374,10 +374,12 @@ but outside of this help window when you type them in Isearch mode, they exit Isearch mode before displaying global help." isearch-help-map) +(defvar isearch--display-help-action '(nil (inhibit-same-window . t))) + (defun isearch-help-for-help () "Display Isearch help menu." (interactive) - (let (same-window-buffer-names same-window-regexps) + (let ((display-buffer-overriding-action isearch--display-help-action)) (isearch-help-for-help-internal)) (isearch-update)) @@ -385,7 +387,7 @@ they exit Isearch mode before displaying global help." "Show a list of all keys defined in Isearch mode, and their definitions. This is like `describe-bindings', but displays only Isearch keys." (interactive) - (let (same-window-buffer-names same-window-regexps) + (let ((display-buffer-overriding-action isearch--display-help-action)) (with-help-window "*Help*" (with-current-buffer standard-output (princ "Isearch Mode Bindings:\n") @@ -394,14 +396,14 @@ This is like `describe-bindings', but displays only Isearch keys." (defun isearch-describe-key () "Display documentation of the function invoked by isearch key." (interactive) - (let (same-window-buffer-names same-window-regexps) + (let ((display-buffer-overriding-action isearch--display-help-action)) (call-interactively 'describe-key)) (isearch-update)) (defun isearch-describe-mode () "Display documentation of Isearch mode." (interactive) - (let (same-window-buffer-names same-window-regexps) + (let ((display-buffer-overriding-action isearch--display-help-action)) (describe-function 'isearch-forward)) (isearch-update)) @@ -518,7 +520,7 @@ This is like `describe-bindings', but displays only Isearch keys." (define-key map "\C-x" nil) (define-key map [?\C-x t] 'isearch-other-control-char) (define-key map "\C-x8" nil) - (define-key map "\C-x8\r" 'isearch-other-control-char) + (define-key map "\C-x8\r" 'isearch-insert-char-by-name) map) "Keymap for `isearch-mode'.") @@ -1099,7 +1101,7 @@ nonincremental search instead via `isearch-edit-string'." (defun isearch-fail-pos (&optional msg) "Return position of first mismatch in search string, or nil if none. -If MSG is non-nil, use `isearch-message', otherwise `isearch-string'." +If MSG is non-nil, use variable `isearch-message', otherwise `isearch-string'." (let ((cmds isearch-cmds) (curr-msg (if msg isearch-message isearch-string)) succ-msg) @@ -1116,23 +1118,17 @@ If MSG is non-nil, use `isearch-message', otherwise `isearch-string'." (length succ-msg) 0)))) -(defun isearch-edit-string () - "Edit the search string in the minibuffer. -The following additional command keys are active while editing. -\\<minibuffer-local-isearch-map> -\\[exit-minibuffer] to resume incremental searching with the edited string. -\\[isearch-nonincremental-exit-minibuffer] to do one nonincremental search. -\\[isearch-forward-exit-minibuffer] to resume isearching forward. -\\[isearch-reverse-exit-minibuffer] to resume isearching backward. -\\[isearch-complete-edit] to complete the search string using the search ring." - +(defmacro with-isearch-suspended (&rest body) + "Exit Isearch mode, run BODY, and reinvoke the pending search. +You can update the global isearch variables by setting new values to +`isearch-new-string', `isearch-new-message', `isearch-new-forward', +`isearch-new-word', `isearch-new-case-fold'." ;; This code is very hairy for several reasons, explained in the code. ;; Mainly, isearch-mode must be terminated while editing and then restarted. ;; If there were a way to catch any change of buffer from the minibuffer, ;; this could be simplified greatly. ;; Editing doesn't back up the search point. Should it? - (interactive) - (condition-case nil + `(condition-case nil (progn (let ((isearch-nonincremental isearch-nonincremental) @@ -1195,29 +1191,7 @@ The following additional command keys are active while editing. (setq old-point (point) old-other-end isearch-other-end) (unwind-protect - (let* ((message-log-max nil) - ;; Don't add a new search string to the search ring here - ;; in `read-from-minibuffer'. It should be added only - ;; by `isearch-update-ring' called from `isearch-done'. - (history-add-new-input nil) - ;; Binding minibuffer-history-symbol to nil is a work-around - ;; for some incompatibility with gmhist. - (minibuffer-history-symbol)) - (setq isearch-new-string - (read-from-minibuffer - (isearch-message-prefix nil isearch-nonincremental) - (cons isearch-string (1+ (or (isearch-fail-pos) - (length isearch-string)))) - minibuffer-local-isearch-map nil - (if isearch-regexp - (cons 'regexp-search-ring - (1+ (or regexp-search-ring-yank-pointer -1))) - (cons 'search-ring - (1+ (or search-ring-yank-pointer -1)))) - nil t) - isearch-new-message - (mapconcat 'isearch-text-char-description - isearch-new-string ""))) + (progn ,@body) ;; Set point at the start (end) of old match if forward (backward), ;; so after exiting minibuffer isearch resumes at the start (end) @@ -1276,6 +1250,41 @@ The following additional command keys are active while editing. (isearch-abort) ;; outside of let to restore outside global values ))) +(defun isearch-edit-string () + "Edit the search string in the minibuffer. +The following additional command keys are active while editing. +\\<minibuffer-local-isearch-map> +\\[exit-minibuffer] to resume incremental searching with the edited string. +\\[isearch-nonincremental-exit-minibuffer] to do one nonincremental search. +\\[isearch-forward-exit-minibuffer] to resume isearching forward. +\\[isearch-reverse-exit-minibuffer] to resume isearching backward. +\\[isearch-complete-edit] to complete the search string using the search ring." + (interactive) + (with-isearch-suspended + (let* ((message-log-max nil) + ;; Don't add a new search string to the search ring here + ;; in `read-from-minibuffer'. It should be added only + ;; by `isearch-update-ring' called from `isearch-done'. + (history-add-new-input nil) + ;; Binding minibuffer-history-symbol to nil is a work-around + ;; for some incompatibility with gmhist. + (minibuffer-history-symbol)) + (setq isearch-new-string + (read-from-minibuffer + (isearch-message-prefix nil isearch-nonincremental) + (cons isearch-string (1+ (or (isearch-fail-pos) + (length isearch-string)))) + minibuffer-local-isearch-map nil + (if isearch-regexp + (cons 'regexp-search-ring + (1+ (or regexp-search-ring-yank-pointer -1))) + (cons 'search-ring + (1+ (or search-ring-yank-pointer -1)))) + nil t) + isearch-new-message + (mapconcat 'isearch-text-char-description + isearch-new-string ""))))) + (defun isearch-nonincremental-exit-minibuffer () (interactive) (setq isearch-nonincremental t) @@ -1705,6 +1714,9 @@ and reads its face argument using `hi-lock-read-face-name'." (defun isearch-delete-char () "Discard last input item and move point back. +Last input means the last character or the last isearch command +that added or deleted characters from the search string, +moved point, toggled regexp mode or case-sensitivity, etc. If no previous match was done, just beep." (interactive) (if (null (cdr isearch-cmds)) @@ -1714,6 +1726,8 @@ If no previous match was done, just beep." (defun isearch-del-char (&optional arg) "Delete character from end of search string and search again. +Unlike `isearch-delete-char', it only deletes the last character, +but doesn't cancel the effect of other isearch command. If search string is empty, just beep." (interactive "p") (if (= 0 (length isearch-string)) @@ -1834,6 +1848,17 @@ Subword is used when `subword-mode' is activated. " (lambda () (let ((inhibit-field-text-motion t)) (line-end-position (if (eolp) 2 1)))))) +(defun isearch-insert-char-by-name () + "Read a character by its Unicode name and insert it into search string." + (interactive) + (with-isearch-suspended + (let ((char (read-char-by-name "Insert character (Unicode name or hex): "))) + (when char + (setq isearch-new-string (concat isearch-string (string char)) + isearch-new-message (concat isearch-message + (mapconcat 'isearch-text-char-description + (string char) ""))))))) + (defun isearch-search-and-update () ;; Do the search and update the display. (when (or isearch-success diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el index 7be5df72c84..668f1ec963a 100644 --- a/lisp/jit-lock.el +++ b/lisp/jit-lock.el @@ -257,6 +257,47 @@ the variable `jit-lock-stealth-nice'." (remove-hook 'after-change-functions 'jit-lock-after-change t) (remove-hook 'fontification-functions 'jit-lock-function)))) +(define-minor-mode jit-lock-debug-mode + "Minor mode to help debug code run from jit-lock. +When this minor mode is enabled, jit-lock runs as little code as possible +during redisplay and moves the rest to a timer, where things +like `debug-on-error' and Edebug can be used." + :global t + (when jit-lock-defer-timer + (cancel-timer jit-lock-defer-timer) + (setq jit-lock-defer-timer nil)) + (when jit-lock-debug-mode + (setq jit-lock-defer-timer + (run-with-idle-timer 0 t #'jit-lock--debug-fontify)))) + +(defvar jit-lock--debug-fontifying nil) + +(defun jit-lock--debug-fontify () + "Fontify what was deferred for debugging." + (when (and (not jit-lock--debug-fontifying) + jit-lock-defer-buffers (not memory-full)) + (let ((jit-lock--debug-fontifying t) + (inhibit-debugger nil)) ;FIXME: Not sufficient! + ;; Mark the deferred regions back to `fontified = nil' + (dolist (buffer jit-lock-defer-buffers) + (when (buffer-live-p buffer) + (with-current-buffer buffer + ;; (message "Jit-Debug %s" (buffer-name)) + (with-buffer-prepared-for-jit-lock + (let ((pos (point-min))) + (while + (progn + (when (eq (get-text-property pos 'fontified) 'defer) + (let ((beg pos) + (end (setq pos (next-single-property-change + pos 'fontified + nil (point-max))))) + (put-text-property beg end 'fontified nil) + (jit-lock-fontify-now beg end))) + (setq pos (next-single-property-change + pos 'fontified))))))))) + (setq jit-lock-defer-buffers nil)))) + (defun jit-lock-register (fun &optional contextual) "Register FUN as a fontification function to be called in this buffer. FUN will be called with two arguments START and END indicating the region @@ -504,7 +545,8 @@ non-nil in a repeated invocation of this function." pos (setq pos (next-single-property-change pos 'fontified nil (point-max))) 'fontified nil)) - (setq pos (next-single-property-change pos 'fontified))))))))) + (setq pos (next-single-property-change + pos 'fontified))))))))) (setq jit-lock-defer-buffers nil) ;; Force fontification of the visible parts. (let ((jit-lock-defer-timer nil)) diff --git a/lisp/json.el b/lisp/json.el index a0cd116279a..29beaedebe9 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2006-2013 Free Software Foundation, Inc. ;; Author: Edward O'Connor <ted@oconnor.cx> -;; Version: 1.3 +;; Version: 1.4 ;; Keywords: convenience ;; This file is part of GNU Emacs. @@ -48,10 +48,10 @@ ;; 2006-12-29 - XEmacs support, from Aidan Kehoe <kehoea@parhasard.net>. ;; 2008-02-21 - Installed in GNU Emacs. ;; 2011-10-17 - Patch `json-alist-p' and `json-plist-p' to avoid recursion -tzz +;; 2012-10-25 - Added pretty-printed reformatting -Ryan Crum (ryan@ryancrum.org) ;;; Code: -(eval-when-compile (require 'cl)) ;; Compatibility code @@ -99,6 +99,24 @@ If this has the same value as `json-false', you might not be able to tell the difference between `false' and `null'. Consider let-binding this around your call to `json-read' instead of `setq'ing it.") +(defvar json-encoding-separator "," + "Value to use as an element separator when encoding.") + +(defvar json-encoding-default-indentation " " + "The default indentation level for encoding. +Used only when `json-encoding-pretty-print' is non-nil.") + +(defvar json--encoding-current-indentation "\n" + "Internally used to keep track of the current indentation level of encoding. +Used only when `json-encoding-pretty-print' is non-nil.") + +(defvar json-encoding-pretty-print nil + "If non-nil, then the output of `json-encode' will be pretty-printed.") + +(defvar json-encoding-lisp-style-closings nil + "If non-nil, ] and } closings will be formatted lisp-style, +without indentation.") + ;;; Utilities @@ -124,6 +142,14 @@ this around your call to `json-read' instead of `setq'ing it.") 'not-plist))) (null list)) +(defmacro json--with-indentation (body) + `(let ((json--encoding-current-indentation + (if json-encoding-pretty-print + (concat json--encoding-current-indentation + json-encoding-default-indentation) + ""))) + ,body)) + ;; Reader utilities (defsubst json-advance (&optional n) @@ -402,41 +428,70 @@ Please see the documentation of `json-object-type' and `json-key-type'." (defun json-encode-hash-table (hash-table) "Return a JSON representation of HASH-TABLE." - (format "{%s}" + (format "{%s%s}" (json-join (let (r) - (maphash - (lambda (k v) - (push (format "%s:%s" - (json-encode-key k) - (json-encode v)) - r)) - hash-table) + (json--with-indentation + (maphash + (lambda (k v) + (push (format + (if json-encoding-pretty-print + "%s%s: %s" + "%s%s:%s") + json--encoding-current-indentation + (json-encode-key k) + (json-encode v)) + r)) + hash-table)) r) - ", "))) + json-encoding-separator) + (if (or (not json-encoding-pretty-print) + json-encoding-lisp-style-closings) + "" + json--encoding-current-indentation))) ;; List encoding (including alists and plists) (defun json-encode-alist (alist) "Return a JSON representation of ALIST." - (format "{%s}" - (json-join (mapcar (lambda (cons) - (format "%s:%s" - (json-encode-key (car cons)) - (json-encode (cdr cons)))) - alist) - ", "))) + (format "{%s%s}" + (json-join + (json--with-indentation + (mapcar (lambda (cons) + (format (if json-encoding-pretty-print + "%s%s: %s" + "%s%s:%s") + json--encoding-current-indentation + (json-encode-key (car cons)) + (json-encode (cdr cons)))) + alist)) + json-encoding-separator) + (if (or (not json-encoding-pretty-print) + json-encoding-lisp-style-closings) + "" + json--encoding-current-indentation))) (defun json-encode-plist (plist) "Return a JSON representation of PLIST." (let (result) - (while plist - (push (concat (json-encode-key (car plist)) - ":" - (json-encode (cadr plist))) - result) - (setq plist (cddr plist))) - (concat "{" (json-join (nreverse result) ", ") "}"))) + (json--with-indentation + (while plist + (push (concat + json--encoding-current-indentation + (json-encode-key (car plist)) + (if json-encoding-pretty-print + ": " + ":") + (json-encode (cadr plist))) + result) + (setq plist (cddr plist)))) + (concat "{" + (json-join (nreverse result) json-encoding-separator) + (if (and json-encoding-pretty-print + (not json-encoding-lisp-style-closings)) + json--encoding-current-indentation + "") + "}"))) (defun json-encode-list (list) "Return a JSON representation of LIST. @@ -475,7 +530,22 @@ become JSON objects." (defun json-encode-array (array) "Return a JSON representation of ARRAY." - (concat "[" (mapconcat 'json-encode array ", ") "]")) + (if (and json-encoding-pretty-print + (> (length array) 0)) + (concat + (json--with-indentation + (concat (format "[%s" json--encoding-current-indentation) + (json-join (mapcar 'json-encode array) + (format "%s%s" + json-encoding-separator + json--encoding-current-indentation)))) + (format "%s]" + (if json-encoding-lisp-style-closings + "" + json--encoding-current-indentation))) + (concat "[" + (mapconcat 'json-encode array json-encoding-separator) + "]"))) @@ -542,6 +612,21 @@ Advances point just past JSON object." ((listp object) (json-encode-list object)) (t (signal 'json-error (list object))))) +;; Pretty printing + +(defun json-pretty-print-buffer () + "Pretty-print current buffer." + (interactive) + (json-pretty-print (point-min) (point-max))) + +(defun json-pretty-print (begin end) + "Pretty-print selected region." + (interactive "r") + (atomic-change-group + (let ((json-encoding-pretty-print t) + (txt (delete-and-extract-region begin end))) + (insert (json-encode (json-read-from-string txt)))))) + (provide 'json) ;;; json.el ends here diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index ea603db6a56..81787682692 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -5,7 +5,7 @@ ;;;### (autoloads (5x5-crack 5x5-crack-xor-mutate 5x5-crack-mutating-best ;;;;;; 5x5-crack-mutating-current 5x5-crack-randomly 5x5) "5x5" -;;;;;; "play/5x5.el" (20707 18685 911514 0)) +;;;;;; "play/5x5.el" (20545 57511 257469 0)) ;;; Generated autoloads from play/5x5.el (autoload '5x5 "5x5" "\ @@ -68,7 +68,7 @@ should return a grid vector array that is the new solution. ;;;*** ;;;### (autoloads (ada-mode ada-add-extensions) "ada-mode" "progmodes/ada-mode.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20576 42138 697312 0)) ;;; Generated autoloads from progmodes/ada-mode.el (autoload 'ada-add-extensions "ada-mode" "\ @@ -88,7 +88,7 @@ Ada mode is the major mode for editing Ada code. ;;;*** ;;;### (autoloads (ada-header) "ada-stmt" "progmodes/ada-stmt.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from progmodes/ada-stmt.el (autoload 'ada-header "ada-stmt" "\ @@ -99,7 +99,7 @@ Insert a descriptive header at the top of the file. ;;;*** ;;;### (autoloads (ada-find-file) "ada-xref" "progmodes/ada-xref.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20458 56750 651721 0)) ;;; Generated autoloads from progmodes/ada-xref.el (autoload 'ada-find-file "ada-xref" "\ @@ -114,15 +114,16 @@ Completion is available. ;;;;;; add-change-log-entry-other-window add-change-log-entry find-change-log ;;;;;; prompt-for-change-log-name add-log-mailing-address add-log-full-name ;;;;;; add-log-current-defun-function) "add-log" "vc/add-log.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20665 59189 799105 0)) ;;; Generated autoloads from vc/add-log.el (put 'change-log-default-name 'safe-local-variable 'string-or-null-p) (defvar add-log-current-defun-function nil "\ If non-nil, function to guess name of surrounding function. -It is used by `add-log-current-defun' in preference to built-in rules. -Returns function's name as a string, or nil if outside a function.") +It is called by `add-log-current-defun' with no argument, and +should return the function's name as a string, or nil if point is +outside a function.") (custom-autoload 'add-log-current-defun-function "add-log" t) @@ -213,15 +214,6 @@ Runs `change-log-mode-hook'. \(fn)" t nil) -(defvar add-log-lisp-like-modes '(emacs-lisp-mode lisp-mode scheme-mode dsssl-mode lisp-interaction-mode) "\ -Modes that look like Lisp to `add-log-current-defun'.") - -(defvar add-log-c-like-modes '(c-mode c++-mode c++-c-mode objc-mode) "\ -Modes that look like C to `add-log-current-defun'.") - -(defvar add-log-tex-like-modes '(TeX-mode plain-TeX-mode LaTeX-mode tex-mode) "\ -Modes that look like TeX to `add-log-current-defun'.") - (autoload 'add-log-current-defun "add-log" "\ Return name of function definition point is in, or nil. @@ -253,7 +245,7 @@ old-style time formats for entries are supported. ;;;### (autoloads (defadvice ad-activate ad-add-advice ad-disable-advice ;;;;;; ad-enable-advice ad-default-compilation-action ad-redefinition-action) -;;;;;; "advice" "emacs-lisp/advice.el" (20707 18685 911514 0)) +;;;;;; "advice" "emacs-lisp/advice.el" (20660 41272 835092 0)) ;;; Generated autoloads from emacs-lisp/advice.el (defvar ad-redefinition-action 'warn "\ @@ -352,7 +344,7 @@ POSITION ::= `first' | `last' | NUMBER. Optional, defaults to `first', ARGLIST ::= An optional argument list to be used for the advised function instead of the argument list of the original. The first one found in before/around/after-advices will be used. -FLAG ::= `protect'|`disable'|`activate'|`compile'|`preactivate'|`freeze'. +FLAG ::= `protect'|`disable'|`activate'|`compile'|`preactivate'. All flags can be specified with unambiguous initial substrings. DOCSTRING ::= Optional documentation for this piece of advice. INTERACTIVE-FORM ::= Optional interactive form to be used for the advised @@ -378,13 +370,6 @@ time. This generates a compiled advised definition according to the current advice state that will be used during activation if appropriate. Only use this if the `defadvice' gets actually compiled. -`freeze': Expands the `defadvice' into a redefining `defun/defmacro' according -to this particular single advice. No other advice information will be saved. -Frozen advices cannot be undone, they behave like a hard redefinition of -the advised function. `freeze' implies `activate' and `preactivate'. The -documentation of the advised function can be dumped onto the `DOC' file -during preloading. - See Info node `(elisp)Advising Functions' for comprehensive documentation. usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) [DOCSTRING] [INTERACTIVE-FORM] @@ -398,7 +383,7 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) ;;;### (autoloads (align-newline-and-indent align-unhighlight-rule ;;;;;; align-highlight-rule align-current align-entire align-regexp -;;;;;; align) "align" "align.el" (20707 18685 911514 0)) +;;;;;; align) "align" "align.el" (20566 63671 243798 0)) ;;; Generated autoloads from align.el (autoload 'align "align" "\ @@ -489,7 +474,7 @@ A replacement function for `newline-and-indent', aligning as it goes. ;;;### (autoloads (outlineify-sticky allout-mode allout-mode-p allout-auto-activation ;;;;;; allout-setup allout-auto-activation-helper) "allout" "allout.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20651 26294 774003 0)) ;;; Generated autoloads from allout.el (autoload 'allout-auto-activation-helper "allout" "\ @@ -850,7 +835,7 @@ for details on preparing Emacs for automatic allout activation. ;;;### (autoloads (allout-widgets-mode allout-widgets-auto-activation ;;;;;; allout-widgets-setup allout-widgets) "allout-widgets" "allout-widgets.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20545 57511 257469 0)) ;;; Generated autoloads from allout-widgets.el (let ((loads (get 'allout-widgets 'custom-loads))) (if (member '"allout-widgets" loads) nil (put 'allout-widgets 'custom-loads (cons '"allout-widgets" loads)))) @@ -910,7 +895,7 @@ outline hot-spot navigation (see `allout-mode'). ;;;*** ;;;### (autoloads (ange-ftp-hook-function ange-ftp-reread-dir) "ange-ftp" -;;;;;; "net/ange-ftp.el" (20707 18685 911514 0)) +;;;;;; "net/ange-ftp.el" (20566 63671 243798 0)) ;;; Generated autoloads from net/ange-ftp.el (defalias 'ange-ftp-re-read-dir 'ange-ftp-reread-dir) @@ -932,7 +917,7 @@ directory, so that Emacs will know its current contents. ;;;*** ;;;### (autoloads (animate-birthday-present animate-sequence animate-string) -;;;;;; "animate" "play/animate.el" (20707 18685 911514 0)) +;;;;;; "animate" "play/animate.el" (20545 57511 257469 0)) ;;; Generated autoloads from play/animate.el (autoload 'animate-string "animate" "\ @@ -965,7 +950,7 @@ the buffer *Birthday-Present-for-Name*. ;;;*** ;;;### (autoloads (ansi-color-process-output ansi-color-for-comint-mode-on) -;;;;;; "ansi-color" "ansi-color.el" (20707 18685 911514 0)) +;;;;;; "ansi-color" "ansi-color.el" (20642 11326 759953 0)) ;;; Generated autoloads from ansi-color.el (autoload 'ansi-color-for-comint-mode-on "ansi-color" "\ @@ -991,7 +976,7 @@ This is a good function to put in `comint-output-filter-functions'. ;;;*** ;;;### (autoloads (antlr-set-tabs antlr-mode antlr-show-makefile-rules) -;;;;;; "antlr-mode" "progmodes/antlr-mode.el" (20707 18685 911514 +;;;;;; "antlr-mode" "progmodes/antlr-mode.el" (20566 63671 243798 ;;;;;; 0)) ;;; Generated autoloads from progmodes/antlr-mode.el @@ -1028,7 +1013,7 @@ Used in `antlr-mode'. Also a useful function in `java-mode-hook'. ;;;*** ;;;### (autoloads (appt-activate appt-add) "appt" "calendar/appt.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from calendar/appt.el (autoload 'appt-add "appt" "\ @@ -1051,8 +1036,8 @@ ARG is positive, otherwise off. ;;;### (autoloads (apropos-documentation apropos-value apropos-library ;;;;;; apropos apropos-documentation-property apropos-command apropos-variable -;;;;;; apropos-read-pattern) "apropos" "apropos.el" (20707 18685 -;;;;;; 911514 0)) +;;;;;; apropos-read-pattern) "apropos" "apropos.el" (20523 62082 +;;;;;; 997685 0)) ;;; Generated autoloads from apropos.el (autoload 'apropos-read-pattern "apropos" "\ @@ -1160,8 +1145,8 @@ Returns list of symbols and documentation found. ;;;*** -;;;### (autoloads (archive-mode) "arc-mode" "arc-mode.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (archive-mode) "arc-mode" "arc-mode.el" (20647 +;;;;;; 29243 972198 0)) ;;; Generated autoloads from arc-mode.el (autoload 'archive-mode "arc-mode" "\ @@ -1181,7 +1166,7 @@ archive. ;;;*** -;;;### (autoloads (array-mode) "array" "array.el" (20707 18685 911514 +;;;### (autoloads (array-mode) "array" "array.el" (20355 10021 546955 ;;;;;; 0)) ;;; Generated autoloads from array.el @@ -1253,8 +1238,8 @@ Entering array mode calls the function `array-mode-hook'. ;;;*** -;;;### (autoloads (artist-mode) "artist" "textmodes/artist.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (artist-mode) "artist" "textmodes/artist.el" (20513 +;;;;;; 18948 537867 0)) ;;; Generated autoloads from textmodes/artist.el (autoload 'artist-mode "artist" "\ @@ -1459,8 +1444,8 @@ Keymap summary ;;;*** -;;;### (autoloads (asm-mode) "asm-mode" "progmodes/asm-mode.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (asm-mode) "asm-mode" "progmodes/asm-mode.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from progmodes/asm-mode.el (autoload 'asm-mode "asm-mode" "\ @@ -1488,7 +1473,7 @@ Special commands: ;;;*** ;;;### (autoloads (auth-source-cache-expiry) "auth-source" "gnus/auth-source.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20698 56506 332830 0)) ;;; Generated autoloads from gnus/auth-source.el (defvar auth-source-cache-expiry 7200 "\ @@ -1501,7 +1486,7 @@ let-binding.") ;;;*** ;;;### (autoloads (autoarg-kp-mode autoarg-mode) "autoarg" "autoarg.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from autoarg.el (defvar autoarg-mode nil "\ @@ -1562,7 +1547,7 @@ This is similar to `autoarg-mode' but rebinds the keypad keys ;;;*** ;;;### (autoloads (autoconf-mode) "autoconf" "progmodes/autoconf.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20665 59189 799105 0)) ;;; Generated autoloads from progmodes/autoconf.el (autoload 'autoconf-mode "autoconf" "\ @@ -1573,7 +1558,7 @@ Major mode for editing Autoconf configure.ac files. ;;;*** ;;;### (autoloads (auto-insert-mode define-auto-insert auto-insert) -;;;;;; "autoinsert" "autoinsert.el" (20707 18685 911514 0)) +;;;;;; "autoinsert" "autoinsert.el" (20566 63671 243798 0)) ;;; Generated autoloads from autoinsert.el (autoload 'auto-insert "autoinsert" "\ @@ -1613,7 +1598,7 @@ insert a template for the file depending on the mode of the buffer. ;;;### (autoloads (batch-update-autoloads update-directory-autoloads ;;;;;; update-file-autoloads) "autoload" "emacs-lisp/autoload.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20594 43050 277913 0)) ;;; Generated autoloads from emacs-lisp/autoload.el (put 'generated-autoload-file 'safe-local-variable 'stringp) @@ -1664,7 +1649,7 @@ should be non-nil). ;;;### (autoloads (global-auto-revert-mode turn-on-auto-revert-tail-mode ;;;;;; auto-revert-tail-mode turn-on-auto-revert-mode auto-revert-mode) -;;;;;; "autorevert" "autorevert.el" (20707 18685 911514 0)) +;;;;;; "autorevert" "autorevert.el" (20476 31768 298871 0)) ;;; Generated autoloads from autorevert.el (autoload 'auto-revert-mode "autorevert" "\ @@ -1753,7 +1738,7 @@ specifies in the mode line. ;;;*** ;;;### (autoloads (mouse-avoidance-mode mouse-avoidance-mode) "avoid" -;;;;;; "avoid.el" (20707 18685 911514 0)) +;;;;;; "avoid.el" (20593 22184 581574 0)) ;;; Generated autoloads from avoid.el (defvar mouse-avoidance-mode nil "\ @@ -1794,7 +1779,7 @@ definition of \"random distance\".) ;;;*** ;;;### (autoloads (display-battery-mode battery) "battery" "battery.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20685 44469 497553 0)) ;;; Generated autoloads from battery.el (put 'battery-mode-line-string 'risky-local-variable t) @@ -1830,7 +1815,7 @@ seconds. ;;;*** ;;;### (autoloads (benchmark benchmark-run-compiled benchmark-run) -;;;;;; "benchmark" "emacs-lisp/benchmark.el" (20707 18685 911514 +;;;;;; "benchmark" "emacs-lisp/benchmark.el" (20557 48712 315579 ;;;;;; 0)) ;;; Generated autoloads from emacs-lisp/benchmark.el @@ -1868,7 +1853,7 @@ For non-interactive use see also `benchmark-run' and ;;;*** ;;;### (autoloads (bibtex-search-entry bibtex-mode bibtex-initialize) -;;;;;; "bibtex" "textmodes/bibtex.el" (20707 18685 911514 0)) +;;;;;; "bibtex" "textmodes/bibtex.el" (20576 13095 881042 0)) ;;; Generated autoloads from textmodes/bibtex.el (autoload 'bibtex-initialize "bibtex" "\ @@ -1957,7 +1942,7 @@ A prefix arg negates the value of `bibtex-search-entry-globally'. ;;;*** ;;;### (autoloads (bibtex-style-mode) "bibtex-style" "textmodes/bibtex-style.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from textmodes/bibtex-style.el (autoload 'bibtex-style-mode "bibtex-style" "\ @@ -1969,7 +1954,7 @@ Major mode for editing BibTeX style files. ;;;### (autoloads (binhex-decode-region binhex-decode-region-external ;;;;;; binhex-decode-region-internal) "binhex" "mail/binhex.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from mail/binhex.el (defconst binhex-begin-line "^:...............................................................$" "\ @@ -1993,8 +1978,8 @@ Binhex decode region between START and END. ;;;*** -;;;### (autoloads (blackbox) "blackbox" "play/blackbox.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (blackbox) "blackbox" "play/blackbox.el" (20551 +;;;;;; 9899 283417 0)) ;;; Generated autoloads from play/blackbox.el (autoload 'blackbox "blackbox" "\ @@ -2117,7 +2102,7 @@ a reflection. ;;;;;; bookmark-save bookmark-write bookmark-delete bookmark-insert ;;;;;; bookmark-rename bookmark-insert-location bookmark-relocate ;;;;;; bookmark-jump-other-window bookmark-jump bookmark-set) "bookmark" -;;;;;; "bookmark.el" (20707 18685 911514 0)) +;;;;;; "bookmark.el" (20630 20152 156327 0)) ;;; Generated autoloads from bookmark.el (define-key ctl-x-r-map "b" 'bookmark-jump) (define-key ctl-x-r-map "m" 'bookmark-set) @@ -2318,7 +2303,7 @@ Incremental search of bookmarks, hiding the non-matches as we go. ;;;;;; browse-url-xdg-open browse-url-at-mouse browse-url-at-point ;;;;;; browse-url browse-url-of-region browse-url-of-dired-file ;;;;;; browse-url-of-buffer browse-url-of-file browse-url-browser-function) -;;;;;; "browse-url" "net/browse-url.el" (20707 18685 911514 0)) +;;;;;; "browse-url" "net/browse-url.el" (20566 63671 243798 0)) ;;; Generated autoloads from net/browse-url.el (defvar browse-url-browser-function 'browse-url-default-browser "\ @@ -2634,7 +2619,7 @@ from `browse-url-elinks-wrapper'. ;;;*** ;;;### (autoloads (bs-show bs-customize bs-cycle-previous bs-cycle-next) -;;;;;; "bs" "bs.el" (20707 18685 911514 0)) +;;;;;; "bs" "bs.el" (20576 13095 881042 0)) ;;; Generated autoloads from bs.el (autoload 'bs-cycle-next "bs" "\ @@ -2674,8 +2659,8 @@ name of buffer configuration. ;;;*** -;;;### (autoloads (bubbles) "bubbles" "play/bubbles.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (bubbles) "bubbles" "play/bubbles.el" (20566 63671 +;;;;;; 243798 0)) ;;; Generated autoloads from play/bubbles.el (autoload 'bubbles "bubbles" "\ @@ -2697,7 +2682,7 @@ columns on its right towards the left. ;;;*** ;;;### (autoloads (bug-reference-prog-mode bug-reference-mode) "bug-reference" -;;;;;; "progmodes/bug-reference.el" (20707 18685 911514 0)) +;;;;;; "progmodes/bug-reference.el" (20593 22184 581574 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))))) @@ -2721,7 +2706,7 @@ Like `bug-reference-mode', but only buttonize in comments and strings. ;;;;;; batch-byte-compile-if-not-done display-call-tree byte-compile ;;;;;; compile-defun byte-compile-file byte-recompile-directory ;;;;;; byte-force-recompile byte-compile-enable-warning byte-compile-disable-warning) -;;;;;; "bytecomp" "emacs-lisp/bytecomp.el" (20707 18685 911514 0)) +;;;;;; "bytecomp" "emacs-lisp/bytecomp.el" (20656 44218 805102 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) @@ -2841,8 +2826,8 @@ and corresponding effects. ;;;*** -;;;### (autoloads nil "cal-china" "calendar/cal-china.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads nil "cal-china" "calendar/cal-china.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from calendar/cal-china.el (put 'calendar-chinese-time-zone 'risky-local-variable t) @@ -2851,8 +2836,8 @@ and corresponding effects. ;;;*** -;;;### (autoloads nil "cal-dst" "calendar/cal-dst.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads nil "cal-dst" "calendar/cal-dst.el" (20461 32935 +;;;;;; 300400 0)) ;;; Generated autoloads from calendar/cal-dst.el (put 'calendar-daylight-savings-starts 'risky-local-variable t) @@ -2864,7 +2849,7 @@ and corresponding effects. ;;;*** ;;;### (autoloads (calendar-hebrew-list-yahrzeits) "cal-hebrew" "calendar/cal-hebrew.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from calendar/cal-hebrew.el (autoload 'calendar-hebrew-list-yahrzeits "cal-hebrew" "\ @@ -2880,8 +2865,8 @@ from the cursor position. ;;;### (autoloads (defmath calc-embedded-activate calc-embedded calc-grab-rectangle ;;;;;; calc-grab-region full-calc-keypad calc-keypad calc-eval quick-calc -;;;;;; full-calc calc calc-dispatch) "calc" "calc/calc.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; full-calc calc calc-dispatch) "calc" "calc/calc.el" (20685 +;;;;;; 44469 497553 0)) ;;; Generated autoloads from calc/calc.el (define-key ctl-x-map "*" 'calc-dispatch) @@ -2965,8 +2950,8 @@ See Info node `(calc)Defining Functions'. ;;;*** -;;;### (autoloads (calc-undo) "calc-undo" "calc/calc-undo.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (calc-undo) "calc-undo" "calc/calc-undo.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from calc/calc-undo.el (autoload 'calc-undo "calc-undo" "\ @@ -2976,8 +2961,8 @@ See Info node `(calc)Defining Functions'. ;;;*** -;;;### (autoloads (calculator) "calculator" "calculator.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (calculator) "calculator" "calculator.el" (20476 +;;;;;; 31768 298871 0)) ;;; Generated autoloads from calculator.el (autoload 'calculator "calculator" "\ @@ -2988,8 +2973,8 @@ See the documentation for `calculator-mode' for more information. ;;;*** -;;;### (autoloads (calendar) "calendar" "calendar/calendar.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (calendar) "calendar" "calendar/calendar.el" (20594 +;;;;;; 43050 277913 0)) ;;; Generated autoloads from calendar/calendar.el (autoload 'calendar "calendar" "\ @@ -3033,7 +3018,7 @@ This function is suitable for execution in an init file. ;;;*** ;;;### (autoloads (canlock-verify canlock-insert-header) "canlock" -;;;;;; "gnus/canlock.el" (20707 18685 911514 0)) +;;;;;; "gnus/canlock.el" (20355 10021 546955 0)) ;;; Generated autoloads from gnus/canlock.el (autoload 'canlock-insert-header "canlock" "\ @@ -3051,7 +3036,7 @@ it fails. ;;;*** ;;;### (autoloads (capitalized-words-mode) "cap-words" "progmodes/cap-words.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from progmodes/cap-words.el (autoload 'capitalized-words-mode "cap-words" "\ @@ -3090,15 +3075,15 @@ Obsoletes `c-forward-into-nomenclature'. ;;;*** -;;;### (autoloads nil "cc-compat" "progmodes/cc-compat.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads nil "cc-compat" "progmodes/cc-compat.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from progmodes/cc-compat.el (put 'c-indent-level 'safe-local-variable 'integerp) ;;;*** ;;;### (autoloads (c-guess-basic-syntax) "cc-engine" "progmodes/cc-engine.el" -;;;;;; (20718 7922 212742 0)) +;;;;;; (20681 47415 473102 0)) ;;; Generated autoloads from progmodes/cc-engine.el (autoload 'c-guess-basic-syntax "cc-engine" "\ @@ -3110,8 +3095,8 @@ Return the syntactic context of the current line. ;;;### (autoloads (c-guess-install c-guess-region-no-install c-guess-region ;;;;;; c-guess-buffer-no-install c-guess-buffer c-guess-no-install -;;;;;; c-guess) "cc-guess" "progmodes/cc-guess.el" (20707 18685 -;;;;;; 911514 0)) +;;;;;; c-guess) "cc-guess" "progmodes/cc-guess.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from progmodes/cc-guess.el (defvar c-guess-guessed-offsets-alist nil "\ @@ -3211,7 +3196,7 @@ the absolute file name of the file if STYLE-NAME is nil. ;;;### (autoloads (awk-mode pike-mode idl-mode java-mode objc-mode ;;;;;; c++-mode c-mode c-initialize-cc-mode) "cc-mode" "progmodes/cc-mode.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20665 59189 799105 0)) ;;; Generated autoloads from progmodes/cc-mode.el (autoload 'c-initialize-cc-mode "cc-mode" "\ @@ -3388,7 +3373,7 @@ Key bindings: ;;;*** ;;;### (autoloads (c-set-offset c-add-style c-set-style) "cc-styles" -;;;;;; "progmodes/cc-styles.el" (20707 18685 911514 0)) +;;;;;; "progmodes/cc-styles.el" (20566 63671 243798 0)) ;;; Generated autoloads from progmodes/cc-styles.el (autoload 'c-set-style "cc-styles" "\ @@ -3439,8 +3424,8 @@ and exists only for compatibility reasons. ;;;*** -;;;### (autoloads nil "cc-vars" "progmodes/cc-vars.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads nil "cc-vars" "progmodes/cc-vars.el" (20595 63909 +;;;;;; 923329 0)) ;;; Generated autoloads from progmodes/cc-vars.el (put 'c-basic-offset 'safe-local-variable 'integerp) (put 'c-backslash-column 'safe-local-variable 'integerp) @@ -3450,7 +3435,7 @@ and exists only for compatibility reasons. ;;;### (autoloads (ccl-execute-with-args check-ccl-program define-ccl-program ;;;;;; declare-ccl-program ccl-dump ccl-compile) "ccl" "international/ccl.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from international/ccl.el (autoload 'ccl-compile "ccl" "\ @@ -3711,7 +3696,7 @@ See the documentation of `define-ccl-program' for the detail of CCL program. ;;;*** ;;;### (autoloads (cconv-closure-convert) "cconv" "emacs-lisp/cconv.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20453 5437 764254 0)) ;;; Generated autoloads from emacs-lisp/cconv.el (autoload 'cconv-closure-convert "cconv" "\ @@ -3726,7 +3711,7 @@ Returns a form where all lambdas don't have any free variables. ;;;*** ;;;### (autoloads (cfengine-auto-mode cfengine2-mode cfengine3-mode) -;;;;;; "cfengine" "progmodes/cfengine.el" (20707 18685 911514 0)) +;;;;;; "cfengine" "progmodes/cfengine.el" (20355 10021 546955 0)) ;;; Generated autoloads from progmodes/cfengine.el (autoload 'cfengine3-mode "cfengine" "\ @@ -3756,7 +3741,7 @@ on the buffer contents ;;;*** ;;;### (autoloads (check-declare-directory check-declare-file) "check-declare" -;;;;;; "emacs-lisp/check-declare.el" (20707 18685 911514 0)) +;;;;;; "emacs-lisp/check-declare.el" (20378 29222 722320 0)) ;;; Generated autoloads from emacs-lisp/check-declare.el (autoload 'check-declare-file "check-declare" "\ @@ -3781,7 +3766,7 @@ Returns non-nil if any false statements are found. ;;;;;; checkdoc-comments checkdoc-continue checkdoc-start checkdoc-current-buffer ;;;;;; checkdoc-eval-current-buffer checkdoc-message-interactive ;;;;;; checkdoc-interactive checkdoc checkdoc-list-of-strings-p) -;;;;;; "checkdoc" "emacs-lisp/checkdoc.el" (20707 18685 911514 0)) +;;;;;; "checkdoc" "emacs-lisp/checkdoc.el" (20647 29243 972198 0)) ;;; Generated autoloads from emacs-lisp/checkdoc.el (put 'checkdoc-force-docstrings-flag 'safe-local-variable 'booleanp) (put 'checkdoc-force-history-flag 'safe-local-variable 'booleanp) @@ -3977,7 +3962,7 @@ checking of documentation strings. ;;;### (autoloads (pre-write-encode-hz post-read-decode-hz encode-hz-buffer ;;;;;; encode-hz-region decode-hz-buffer decode-hz-region) "china-util" -;;;;;; "language/china-util.el" (20707 18685 911514 0)) +;;;;;; "language/china-util.el" (20355 10021 546955 0)) ;;; Generated autoloads from language/china-util.el (autoload 'decode-hz-region "china-util" "\ @@ -4015,7 +4000,7 @@ Encode the text in the current buffer to HZ. ;;;*** ;;;### (autoloads (command-history list-command-history repeat-matching-complex-command) -;;;;;; "chistory" "chistory.el" (20707 18685 911514 0)) +;;;;;; "chistory" "chistory.el" (20355 10021 546955 0)) ;;; Generated autoloads from chistory.el (autoload 'repeat-matching-complex-command "chistory" "\ @@ -4055,7 +4040,7 @@ and runs the normal hook `command-history-hook'. ;;;*** ;;;### (autoloads (common-lisp-indent-function) "cl-indent" "emacs-lisp/cl-indent.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from emacs-lisp/cl-indent.el (autoload 'common-lisp-indent-function "cl-indent" "\ @@ -4133,8 +4118,8 @@ For example, the function `case' has an indent property ;;;*** -;;;### (autoloads nil "cl-lib" "emacs-lisp/cl-lib.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads nil "cl-lib" "emacs-lisp/cl-lib.el" (20677 50357 +;;;;;; 68628 0)) ;;; Generated autoloads from emacs-lisp/cl-lib.el (define-obsolete-variable-alias 'custom-print-functions 'cl-custom-print-functions "24.3") @@ -4162,7 +4147,7 @@ a future Emacs interpreter will be able to use it.") ;;;*** ;;;### (autoloads (c-macro-expand) "cmacexp" "progmodes/cmacexp.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20566 63671 243798 0)) ;;; Generated autoloads from progmodes/cmacexp.el (autoload 'c-macro-expand "cmacexp" "\ @@ -4182,8 +4167,8 @@ For use inside Lisp programs, see also `c-macro-expansion'. ;;;*** -;;;### (autoloads (run-scheme) "cmuscheme" "cmuscheme.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (run-scheme) "cmuscheme" "cmuscheme.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from cmuscheme.el (autoload 'run-scheme "cmuscheme" "\ @@ -4203,8 +4188,8 @@ is run). ;;;*** -;;;### (autoloads (color-name-to-rgb) "color" "color.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (color-name-to-rgb) "color" "color.el" (20650 54512 +;;;;;; 564403 0)) ;;; Generated autoloads from color.el (autoload 'color-name-to-rgb "color" "\ @@ -4226,7 +4211,7 @@ If FRAME cannot display COLOR, return nil. ;;;### (autoloads (comint-redirect-results-list-from-process comint-redirect-results-list ;;;;;; comint-redirect-send-command-to-process comint-redirect-send-command ;;;;;; comint-run make-comint make-comint-in-buffer) "comint" "comint.el" -;;;;;; (20714 7872 790163 728000)) +;;;;;; (20700 11832 779612 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) "\ @@ -4326,7 +4311,7 @@ REGEXP-GROUP is the regular expression group in REGEXP to use. ;;;*** ;;;### (autoloads (compare-windows) "compare-w" "vc/compare-w.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from vc/compare-w.el (autoload 'compare-windows "compare-w" "\ @@ -4363,8 +4348,8 @@ on third call it again advances points to the next difference and so on. ;;;;;; compilation-shell-minor-mode compilation-mode compilation-start ;;;;;; compile compilation-disable-input compile-command compilation-search-path ;;;;;; compilation-ask-about-save compilation-window-height compilation-start-hook -;;;;;; compilation-mode-hook) "compile" "progmodes/compile.el" (20718 -;;;;;; 7971 773710 0)) +;;;;;; compilation-mode-hook) "compile" "progmodes/compile.el" (20690 +;;;;;; 62389 885263 0)) ;;; Generated autoloads from progmodes/compile.el (defvar compilation-mode-hook nil "\ @@ -4546,7 +4531,7 @@ This is the value of `next-error-function' in Compilation buffers. ;;;*** ;;;### (autoloads (dynamic-completion-mode) "completion" "completion.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20495 51111 757560 0)) ;;; Generated autoloads from completion.el (defvar dynamic-completion-mode nil "\ @@ -4571,7 +4556,7 @@ if ARG is omitted or nil. ;;;### (autoloads (conf-xdefaults-mode conf-ppd-mode conf-colon-mode ;;;;;; conf-space-keywords conf-space-mode conf-javaprop-mode conf-windows-mode ;;;;;; conf-unix-mode conf-mode) "conf-mode" "textmodes/conf-mode.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from textmodes/conf-mode.el (autoload 'conf-mode "conf-mode" "\ @@ -4727,7 +4712,7 @@ For details see `conf-mode'. Example: ;;;*** ;;;### (autoloads (shuffle-vector cookie-snarf cookie-insert cookie) -;;;;;; "cookie1" "play/cookie1.el" (20707 18685 911514 0)) +;;;;;; "cookie1" "play/cookie1.el" (20545 57511 257469 0)) ;;; Generated autoloads from play/cookie1.el (autoload 'cookie "cookie1" "\ @@ -4759,8 +4744,8 @@ Randomly permute the elements of VECTOR (all permutations equally likely). ;;;*** ;;;### (autoloads (copyright-update-directory copyright copyright-fix-years -;;;;;; copyright-update) "copyright" "emacs-lisp/copyright.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; copyright-update) "copyright" "emacs-lisp/copyright.el" (20518 +;;;;;; 12580 46478 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) @@ -4799,7 +4784,7 @@ If FIX is non-nil, run `copyright-fix-years' instead. ;;;*** ;;;### (autoloads (cperl-perldoc-at-point cperl-perldoc cperl-mode) -;;;;;; "cperl-mode" "progmodes/cperl-mode.el" (20707 18685 911514 +;;;;;; "cperl-mode" "progmodes/cperl-mode.el" (20701 32695 861936 ;;;;;; 0)) ;;; Generated autoloads from progmodes/cperl-mode.el (put 'cperl-indent-level 'safe-local-variable 'integerp) @@ -4999,7 +4984,7 @@ Run a `perldoc' on the word around point. ;;;*** ;;;### (autoloads (cpp-parse-edit cpp-highlight-buffer) "cpp" "progmodes/cpp.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from progmodes/cpp.el (autoload 'cpp-highlight-buffer "cpp" "\ @@ -5018,7 +5003,7 @@ Edit display information for cpp conditionals. ;;;*** ;;;### (autoloads (crisp-mode crisp-mode) "crisp" "emulation/crisp.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20593 22184 581574 0)) ;;; Generated autoloads from emulation/crisp.el (defvar crisp-mode nil "\ @@ -5044,7 +5029,7 @@ if ARG is omitted or nil. ;;;*** ;;;### (autoloads (completing-read-multiple) "crm" "emacs-lisp/crm.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from emacs-lisp/crm.el (autoload 'completing-read-multiple "crm" "\ @@ -5079,8 +5064,8 @@ INHERIT-INPUT-METHOD. ;;;*** -;;;### (autoloads (css-mode) "css-mode" "textmodes/css-mode.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (css-mode) "css-mode" "textmodes/css-mode.el" (20665 +;;;;;; 59189 799105 0)) ;;; Generated autoloads from textmodes/css-mode.el (autoload 'css-mode "css-mode" "\ @@ -5091,7 +5076,7 @@ Major mode to edit Cascading Style Sheets. ;;;*** ;;;### (autoloads (cua-selection-mode cua-mode) "cua-base" "emulation/cua-base.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20434 17809 692608 0)) ;;; Generated autoloads from emulation/cua-base.el (defvar cua-mode nil "\ @@ -5151,7 +5136,7 @@ Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings. ;;;;;; customize-mode customize customize-push-and-save customize-save-variable ;;;;;; customize-set-variable customize-set-value custom-menu-sort-alphabetically ;;;;;; custom-buffer-sort-alphabetically custom-browse-sort-alphabetically) -;;;;;; "cus-edit" "cus-edit.el" (20707 18685 911514 0)) +;;;;;; "cus-edit" "cus-edit.el" (20657 65077 880084 0)) ;;; Generated autoloads from cus-edit.el (defvar custom-browse-sort-alphabetically nil "\ @@ -5463,8 +5448,8 @@ The format is suitable for use with `easy-menu-define'. ;;;*** ;;;### (autoloads (customize-themes describe-theme custom-theme-visit-theme -;;;;;; customize-create-theme) "cus-theme" "cus-theme.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; customize-create-theme) "cus-theme" "cus-theme.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from cus-theme.el (autoload 'customize-create-theme "cus-theme" "\ @@ -5498,7 +5483,7 @@ omitted, a buffer named *Custom Themes* is used. ;;;*** ;;;### (autoloads (cvs-status-mode) "cvs-status" "vc/cvs-status.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20476 31768 298871 0)) ;;; Generated autoloads from vc/cvs-status.el (autoload 'cvs-status-mode "cvs-status" "\ @@ -5509,7 +5494,7 @@ Mode used for cvs status output. ;;;*** ;;;### (autoloads (global-cwarn-mode cwarn-mode) "cwarn" "progmodes/cwarn.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20577 33959 40183 0)) ;;; Generated autoloads from progmodes/cwarn.el (autoload 'cwarn-mode "cwarn" "\ @@ -5554,7 +5539,7 @@ See `cwarn-mode' for more information on Cwarn mode. ;;;### (autoloads (standard-display-cyrillic-translit cyrillic-encode-alternativnyj-char ;;;;;; cyrillic-encode-koi8-r-char) "cyril-util" "language/cyril-util.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from language/cyril-util.el (autoload 'cyrillic-encode-koi8-r-char "cyril-util" "\ @@ -5583,7 +5568,7 @@ If the argument is nil, we return the display table to its standard state. ;;;*** ;;;### (autoloads (dabbrev-expand dabbrev-completion) "dabbrev" "dabbrev.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20397 45851 446679 0)) ;;; Generated autoloads from dabbrev.el (put 'dabbrev-case-fold-search 'risky-local-variable t) (put 'dabbrev-case-replace 'risky-local-variable t) @@ -5630,7 +5615,7 @@ See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion]. ;;;*** ;;;### (autoloads (data-debug-new-buffer) "data-debug" "cedet/data-debug.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20586 48936 135199 0)) ;;; Generated autoloads from cedet/data-debug.el (autoload 'data-debug-new-buffer "data-debug" "\ @@ -5640,8 +5625,8 @@ Create a new data-debug buffer with NAME. ;;;*** -;;;### (autoloads (dbus-handle-event) "dbus" "net/dbus.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (dbus-handle-event) "dbus" "net/dbus.el" (20614 +;;;;;; 54428 654267 0)) ;;; Generated autoloads from net/dbus.el (autoload 'dbus-handle-event "dbus" "\ @@ -5654,8 +5639,8 @@ If the HANDLER returns a `dbus-error', it is propagated as return message. ;;;*** -;;;### (autoloads (dcl-mode) "dcl-mode" "progmodes/dcl-mode.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (dcl-mode) "dcl-mode" "progmodes/dcl-mode.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from progmodes/dcl-mode.el (autoload 'dcl-mode "dcl-mode" "\ @@ -5782,7 +5767,7 @@ There is some minimal font-lock support (see vars ;;;*** ;;;### (autoloads (cancel-debug-on-entry debug-on-entry debug) "debug" -;;;;;; "emacs-lisp/debug.el" (20707 18685 911514 0)) +;;;;;; "emacs-lisp/debug.el" (20642 11326 759953 0)) ;;; Generated autoloads from emacs-lisp/debug.el (setq debugger 'debug) @@ -5796,7 +5781,7 @@ You may call with no args, or you may pass nil as the first arg and any other args you like. In that case, the list of args after the first will be printed into the backtrace buffer. -\(fn &rest DEBUGGER-ARGS)" t nil) +\(fn &rest ARGS)" t nil) (autoload 'debug-on-entry "debug" "\ Request FUNCTION to invoke debugger each time it is called. @@ -5826,7 +5811,7 @@ To specify a nil argument interactively, exit with an empty minibuffer. ;;;*** ;;;### (autoloads (decipher-mode decipher) "decipher" "play/decipher.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20566 63671 243798 0)) ;;; Generated autoloads from play/decipher.el (autoload 'decipher "decipher" "\ @@ -5855,8 +5840,8 @@ The most useful commands are: ;;;*** ;;;### (autoloads (delimit-columns-rectangle delimit-columns-region -;;;;;; delimit-columns-customize) "delim-col" "delim-col.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; delimit-columns-customize) "delim-col" "delim-col.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from delim-col.el (autoload 'delimit-columns-customize "delim-col" "\ @@ -5880,8 +5865,8 @@ START and END delimits the corners of text rectangle. ;;;*** -;;;### (autoloads (delphi-mode) "delphi" "progmodes/delphi.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (delphi-mode) "delphi" "progmodes/delphi.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from progmodes/delphi.el (autoload 'delphi-mode "delphi" "\ @@ -5932,8 +5917,8 @@ with no args, if that value is non-nil. ;;;*** -;;;### (autoloads (delete-selection-mode) "delsel" "delsel.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (delete-selection-mode) "delsel" "delsel.el" (20613 +;;;;;; 49078 764749 0)) ;;; Generated autoloads from delsel.el (defalias 'pending-delete-mode 'delete-selection-mode) @@ -5963,7 +5948,7 @@ any selection. ;;;*** ;;;### (autoloads (derived-mode-init-mode-variables define-derived-mode) -;;;;;; "derived" "emacs-lisp/derived.el" (20707 18685 911514 0)) +;;;;;; "derived" "emacs-lisp/derived.el" (20660 60553 594737 612000)) ;;; Generated autoloads from emacs-lisp/derived.el (autoload 'define-derived-mode "derived" "\ @@ -6030,7 +6015,7 @@ the first time the mode is used. ;;;*** ;;;### (autoloads (describe-char describe-text-properties) "descr-text" -;;;;;; "descr-text.el" (20707 18685 911514 0)) +;;;;;; "descr-text.el" (20660 41272 835092 0)) ;;; Generated autoloads from descr-text.el (autoload 'describe-text-properties "descr-text" "\ @@ -6067,7 +6052,7 @@ relevant to POS. ;;;### (autoloads (desktop-revert desktop-save-in-desktop-dir desktop-change-dir ;;;;;; desktop-load-default desktop-read desktop-remove desktop-save ;;;;;; desktop-clear desktop-locals-to-save desktop-save-mode) "desktop" -;;;;;; "desktop.el" (20707 18685 911514 0)) +;;;;;; "desktop.el" (20662 46799 344737 276000)) ;;; Generated autoloads from desktop.el (defvar desktop-save-mode nil "\ @@ -6256,7 +6241,7 @@ Revert to the last loaded desktop. ;;;### (autoloads (gnus-article-outlook-deuglify-article gnus-outlook-deuglify-article ;;;;;; gnus-article-outlook-repair-attribution gnus-article-outlook-unwrap-lines) -;;;;;; "deuglify" "gnus/deuglify.el" (20707 18685 911514 0)) +;;;;;; "deuglify" "gnus/deuglify.el" (20355 10021 546955 0)) ;;; Generated autoloads from gnus/deuglify.el (autoload 'gnus-article-outlook-unwrap-lines "deuglify" "\ @@ -6289,7 +6274,7 @@ Deuglify broken Outlook (Express) articles and redisplay. ;;;*** ;;;### (autoloads (diary-mode diary-mail-entries diary) "diary-lib" -;;;;;; "calendar/diary-lib.el" (20707 18685 911514 0)) +;;;;;; "calendar/diary-lib.el" (20668 35382 940599 0)) ;;; Generated autoloads from calendar/diary-lib.el (autoload 'diary "diary-lib" "\ @@ -6333,7 +6318,7 @@ Major mode for editing the diary file. ;;;### (autoloads (diff-buffer-with-file diff-latest-backup-file ;;;;;; diff-backup diff diff-command diff-switches) "diff" "vc/diff.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20570 60708 993668 0)) ;;; Generated autoloads from vc/diff.el (defvar diff-switches (purecopy "-c") "\ @@ -6382,7 +6367,7 @@ This requires the external program `diff' to be in your `exec-path'. ;;;*** ;;;### (autoloads (diff-minor-mode diff-mode) "diff-mode" "vc/diff-mode.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20690 62389 885263 0)) ;;; Generated autoloads from vc/diff-mode.el (autoload 'diff-mode "diff-mode" "\ @@ -6414,7 +6399,7 @@ the mode if ARG is omitted or nil. ;;;*** -;;;### (autoloads (dig) "dig" "net/dig.el" (20707 18685 911514 0)) +;;;### (autoloads (dig) "dig" "net/dig.el" (20355 10021 546955 0)) ;;; Generated autoloads from net/dig.el (autoload 'dig "dig" "\ @@ -6426,8 +6411,8 @@ Optional arguments are passed to `dig-invoke'. ;;;*** ;;;### (autoloads (dired-mode dired-noselect dired-other-frame dired-other-window -;;;;;; dired dired-listing-switches) "dired" "dired.el" (20707 18685 -;;;;;; 911514 0)) +;;;;;; dired dired-listing-switches) "dired" "dired.el" (20685 44764 +;;;;;; 669491 35000)) ;;; Generated autoloads from dired.el (defvar dired-listing-switches (purecopy "-al") "\ @@ -6548,7 +6533,7 @@ Keybindings: ;;;*** ;;;### (autoloads (dirtrack dirtrack-mode) "dirtrack" "dirtrack.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20648 50109 802321 0)) ;;; Generated autoloads from dirtrack.el (autoload 'dirtrack-mode "dirtrack" "\ @@ -6578,8 +6563,8 @@ from `default-directory'. ;;;*** -;;;### (autoloads (disassemble) "disass" "emacs-lisp/disass.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (disassemble) "disass" "emacs-lisp/disass.el" (20497 +;;;;;; 6436 957082 0)) ;;; Generated autoloads from emacs-lisp/disass.el (autoload 'disassemble "disass" "\ @@ -6598,7 +6583,7 @@ redefine OBJECT if it is a symbol. ;;;;;; standard-display-g1 standard-display-ascii standard-display-default ;;;;;; standard-display-8bit describe-current-display-table describe-display-table ;;;;;; set-display-table-slot display-table-slot make-display-table) -;;;;;; "disp-table" "disp-table.el" (20707 18685 911514 0)) +;;;;;; "disp-table" "disp-table.el" (20355 10021 546955 0)) ;;; Generated autoloads from disp-table.el (autoload 'make-display-table "disp-table" "\ @@ -6720,7 +6705,7 @@ in `.emacs'. ;;;*** ;;;### (autoloads (dissociated-press) "dissociate" "play/dissociate.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20545 57511 257469 0)) ;;; Generated autoloads from play/dissociate.el (autoload 'dissociated-press "dissociate" "\ @@ -6736,8 +6721,8 @@ Default is 2. ;;;*** -;;;### (autoloads (dnd-protocol-alist) "dnd" "dnd.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (dnd-protocol-alist) "dnd" "dnd.el" (20355 10021 +;;;;;; 546955 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)) "\ @@ -6758,7 +6743,7 @@ if some action was made, or nil if the URL is ignored.") ;;;*** ;;;### (autoloads (dns-mode-soa-increment-serial dns-mode) "dns-mode" -;;;;;; "textmodes/dns-mode.el" (20707 18685 911514 0)) +;;;;;; "textmodes/dns-mode.el" (20355 10021 546955 0)) ;;; Generated autoloads from textmodes/dns-mode.el (autoload 'dns-mode "dns-mode" "\ @@ -6782,8 +6767,8 @@ Locate SOA record and increment the serial field. ;;;*** ;;;### (autoloads (doc-view-bookmark-jump doc-view-minor-mode doc-view-mode-maybe -;;;;;; doc-view-mode doc-view-mode-p) "doc-view" "doc-view.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; doc-view-mode doc-view-mode-p) "doc-view" "doc-view.el" (20581 +;;;;;; 31014 234484 0)) ;;; Generated autoloads from doc-view.el (autoload 'doc-view-mode-p "doc-view" "\ @@ -6829,8 +6814,8 @@ See the command `doc-view-mode' for more information on this mode. ;;;*** -;;;### (autoloads (doctor) "doctor" "play/doctor.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (doctor) "doctor" "play/doctor.el" (20545 57511 +;;;;;; 257469 0)) ;;; Generated autoloads from play/doctor.el (autoload 'doctor "doctor" "\ @@ -6840,8 +6825,8 @@ Switch to *doctor* buffer and start giving psychotherapy. ;;;*** -;;;### (autoloads (double-mode) "double" "double.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (double-mode) "double" "double.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from double.el (autoload 'double-mode "double" "\ @@ -6857,8 +6842,8 @@ strings when pressed twice. See `double-map' for details. ;;;*** -;;;### (autoloads (dunnet) "dunnet" "play/dunnet.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (dunnet) "dunnet" "play/dunnet.el" (20545 57511 +;;;;;; 257469 0)) ;;; Generated autoloads from play/dunnet.el (autoload 'dunnet "dunnet" "\ @@ -6870,7 +6855,7 @@ Switch to *dungeon* buffer and start game. ;;;### (autoloads (easy-mmode-defsyntax easy-mmode-defmap easy-mmode-define-keymap ;;;;;; define-globalized-minor-mode define-minor-mode) "easy-mmode" -;;;;;; "emacs-lisp/easy-mmode.el" (20707 18685 911514 0)) +;;;;;; "emacs-lisp/easy-mmode.el" (20574 57775 217760 0)) ;;; Generated autoloads from emacs-lisp/easy-mmode.el (defalias 'easy-mmode-define-minor-mode 'define-minor-mode) @@ -7005,8 +6990,8 @@ CSS contains a list of syntax specifications of the form (CHAR . SYNTAX). ;;;*** ;;;### (autoloads (easy-menu-change easy-menu-create-menu easy-menu-do-define -;;;;;; easy-menu-define) "easymenu" "emacs-lisp/easymenu.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; easy-menu-define) "easymenu" "emacs-lisp/easymenu.el" (20615 +;;;;;; 49194 141673 0)) ;;; Generated autoloads from emacs-lisp/easymenu.el (autoload 'easy-menu-define "easymenu" "\ @@ -7151,7 +7136,7 @@ To implement dynamic menus, either call this from ;;;;;; ebnf-eps-file ebnf-eps-directory ebnf-spool-region ebnf-spool-buffer ;;;;;; ebnf-spool-file ebnf-spool-directory ebnf-print-region ebnf-print-buffer ;;;;;; ebnf-print-file ebnf-print-directory ebnf-customize) "ebnf2ps" -;;;;;; "progmodes/ebnf2ps.el" (20707 18685 911514 0)) +;;;;;; "progmodes/ebnf2ps.el" (20566 63671 243798 0)) ;;; Generated autoloads from progmodes/ebnf2ps.el (autoload 'ebnf-customize "ebnf2ps" "\ @@ -7425,8 +7410,8 @@ See `ebnf-style-database' documentation. ;;;;;; ebrowse-tags-find-declaration-other-window ebrowse-tags-find-definition ;;;;;; ebrowse-tags-view-definition ebrowse-tags-find-declaration ;;;;;; ebrowse-tags-view-declaration ebrowse-member-mode ebrowse-electric-choose-tree -;;;;;; ebrowse-tree-mode) "ebrowse" "progmodes/ebrowse.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; ebrowse-tree-mode) "ebrowse" "progmodes/ebrowse.el" (20561 +;;;;;; 18280 338092 0)) ;;; Generated autoloads from progmodes/ebrowse.el (autoload 'ebrowse-tree-mode "ebrowse" "\ @@ -7575,7 +7560,7 @@ Display statistics for a class tree. ;;;*** ;;;### (autoloads (electric-buffer-list) "ebuff-menu" "ebuff-menu.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20523 62082 997685 0)) ;;; Generated autoloads from ebuff-menu.el (autoload 'electric-buffer-list "ebuff-menu" "\ @@ -7608,7 +7593,7 @@ Run hooks in `electric-buffer-menu-mode-hook' on entry. ;;;*** ;;;### (autoloads (Electric-command-history-redo-expression) "echistory" -;;;;;; "echistory.el" (20707 18685 911514 0)) +;;;;;; "echistory.el" (20355 10021 546955 0)) ;;; Generated autoloads from echistory.el (autoload 'Electric-command-history-redo-expression "echistory" "\ @@ -7620,7 +7605,7 @@ With prefix arg NOCONFIRM, execute current line as-is without editing. ;;;*** ;;;### (autoloads (ecomplete-setup) "ecomplete" "gnus/ecomplete.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from gnus/ecomplete.el (autoload 'ecomplete-setup "ecomplete" "\ @@ -7630,8 +7615,8 @@ With prefix arg NOCONFIRM, execute current line as-is without editing. ;;;*** -;;;### (autoloads (global-ede-mode) "ede" "cedet/ede.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (global-ede-mode) "ede" "cedet/ede.el" (20590 45996 +;;;;;; 129575 0)) ;;; Generated autoloads from cedet/ede.el (defvar global-ede-mode nil "\ @@ -7658,7 +7643,7 @@ an EDE controlled project. ;;;### (autoloads (edebug-all-forms edebug-all-defs edebug-eval-top-level-form ;;;;;; edebug-basic-spec edebug-all-forms edebug-all-defs) "edebug" -;;;;;; "emacs-lisp/edebug.el" (20707 18685 911514 0)) +;;;;;; "emacs-lisp/edebug.el" (20683 2742 588278 0)) ;;; Generated autoloads from emacs-lisp/edebug.el (defvar edebug-all-defs nil "\ @@ -7731,8 +7716,8 @@ Toggle edebugging of all forms. ;;;;;; ediff-merge-directories-with-ancestor ediff-merge-directories ;;;;;; ediff-directories3 ediff-directory-revisions ediff-directories ;;;;;; ediff-buffers3 ediff-buffers ediff-backup ediff-current-file -;;;;;; ediff-files3 ediff-files) "ediff" "vc/ediff.el" (20707 18685 -;;;;;; 911514 0)) +;;;;;; ediff-files3 ediff-files) "ediff" "vc/ediff.el" (20495 51111 +;;;;;; 757560 0)) ;;; Generated autoloads from vc/ediff.el (autoload 'ediff-files "ediff" "\ @@ -7964,7 +7949,7 @@ With optional NODE, goes to that node. ;;;*** ;;;### (autoloads (ediff-customize) "ediff-help" "vc/ediff-help.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from vc/ediff-help.el (autoload 'ediff-customize "ediff-help" "\ @@ -7975,7 +7960,7 @@ With optional NODE, goes to that node. ;;;*** ;;;### (autoloads (ediff-show-registry) "ediff-mult" "vc/ediff-mult.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20614 54428 654267 0)) ;;; Generated autoloads from vc/ediff-mult.el (autoload 'ediff-show-registry "ediff-mult" "\ @@ -7988,7 +7973,7 @@ Display Ediff's registry. ;;;*** ;;;### (autoloads (ediff-toggle-use-toolbar ediff-toggle-multiframe) -;;;;;; "ediff-util" "vc/ediff-util.el" (20707 18685 911514 0)) +;;;;;; "ediff-util" "vc/ediff-util.el" (20683 39246 740032 0)) ;;; Generated autoloads from vc/ediff-util.el (autoload 'ediff-toggle-multiframe "ediff-util" "\ @@ -8009,7 +7994,7 @@ To change the default, set the variable `ediff-use-toolbar-p', which see. ;;;### (autoloads (format-kbd-macro read-kbd-macro edit-named-kbd-macro ;;;;;; edit-last-kbd-macro edit-kbd-macro) "edmacro" "edmacro.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20476 31768 298871 0)) ;;; Generated autoloads from edmacro.el (autoload 'edit-kbd-macro "edmacro" "\ @@ -8058,7 +8043,7 @@ or nil, use a compact 80-column format. ;;;*** ;;;### (autoloads (edt-emulation-on edt-set-scroll-margins) "edt" -;;;;;; "emulation/edt.el" (20707 18685 911514 0)) +;;;;;; "emulation/edt.el" (20566 63671 243798 0)) ;;; Generated autoloads from emulation/edt.el (autoload 'edt-set-scroll-margins "edt" "\ @@ -8076,7 +8061,7 @@ Turn on EDT Emulation. ;;;*** ;;;### (autoloads (electric-helpify with-electric-help) "ehelp" "ehelp.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20593 22184 581574 0)) ;;; Generated autoloads from ehelp.el (autoload 'with-electric-help "ehelp" "\ @@ -8113,7 +8098,7 @@ BUFFER is put back into its original major mode. ;;;*** ;;;### (autoloads (customize-object) "eieio-custom" "emacs-lisp/eieio-custom.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20586 48936 135199 0)) ;;; Generated autoloads from emacs-lisp/eieio-custom.el (autoload 'customize-object "eieio-custom" "\ @@ -8126,7 +8111,7 @@ Optional argument GROUP is the sub-group of slots to display. ;;;### (autoloads (eieio-describe-generic eieio-describe-constructor ;;;;;; eieio-describe-class eieio-browse) "eieio-opt" "emacs-lisp/eieio-opt.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20617 41641 89638 0)) ;;; Generated autoloads from emacs-lisp/eieio-opt.el (autoload 'eieio-browse "eieio-opt" "\ @@ -8160,7 +8145,7 @@ Also extracts information about all methods specific to this generic. ;;;*** ;;;### (autoloads (turn-on-eldoc-mode eldoc-mode eldoc-minor-mode-string) -;;;;;; "eldoc" "emacs-lisp/eldoc.el" (20707 18685 911514 0)) +;;;;;; "eldoc" "emacs-lisp/eldoc.el" (20355 10021 546955 0)) ;;; Generated autoloads from emacs-lisp/eldoc.el (defvar eldoc-minor-mode-string (purecopy " ElDoc") "\ @@ -8207,7 +8192,7 @@ Emacs Lisp mode) that support ElDoc.") ;;;*** ;;;### (autoloads (electric-layout-mode electric-pair-mode electric-indent-mode) -;;;;;; "electric" "electric.el" (20707 18685 911514 0)) +;;;;;; "electric" "electric.el" (20613 49078 764749 0)) ;;; Generated autoloads from electric.el (defvar electric-indent-chars '(10) "\ @@ -8277,8 +8262,8 @@ The variable `electric-layout-rules' says when and how to insert newlines. ;;;*** -;;;### (autoloads (elide-head) "elide-head" "elide-head.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (elide-head) "elide-head" "elide-head.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from elide-head.el (autoload 'elide-head "elide-head" "\ @@ -8295,7 +8280,7 @@ This is suitable as an entry on `find-file-hook' or appropriate mode hooks. ;;;### (autoloads (elint-initialize elint-defun elint-current-buffer ;;;;;; elint-directory elint-file) "elint" "emacs-lisp/elint.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20486 36135 22104 0)) ;;; Generated autoloads from emacs-lisp/elint.el (autoload 'elint-file "elint" "\ @@ -8331,8 +8316,8 @@ optional prefix argument REINIT is non-nil. ;;;*** ;;;### (autoloads (elp-results elp-instrument-package elp-instrument-list -;;;;;; elp-instrument-function) "elp" "emacs-lisp/elp.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; elp-instrument-function) "elp" "emacs-lisp/elp.el" (20642 +;;;;;; 11326 759953 0)) ;;; Generated autoloads from emacs-lisp/elp.el (autoload 'elp-instrument-function "elp" "\ @@ -8367,7 +8352,7 @@ displayed. ;;;*** ;;;### (autoloads (emacs-lock-mode) "emacs-lock" "emacs-lock.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20577 33959 40183 0)) ;;; Generated autoloads from emacs-lock.el (autoload 'emacs-lock-mode "emacs-lock" "\ @@ -8395,7 +8380,7 @@ Other values are interpreted as usual. ;;;*** ;;;### (autoloads (report-emacs-bug) "emacsbug" "mail/emacsbug.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20680 26549 383882 0)) ;;; Generated autoloads from mail/emacsbug.el (autoload 'report-emacs-bug "emacsbug" "\ @@ -8410,7 +8395,7 @@ Prompts for bug subject. Leaves you in a mail buffer. ;;;;;; emerge-revisions emerge-files-with-ancestor-remote emerge-files-remote ;;;;;; emerge-files-with-ancestor-command emerge-files-command emerge-buffers-with-ancestor ;;;;;; emerge-buffers emerge-files-with-ancestor emerge-files) "emerge" -;;;;;; "vc/emerge.el" (20627 28531 447943 0)) +;;;;;; "vc/emerge.el" (20576 42138 697312 0)) ;;; Generated autoloads from vc/emerge.el (autoload 'emerge-files "emerge" "\ @@ -8471,7 +8456,7 @@ Emerge two RCS revisions of a file, with another revision as ancestor. ;;;*** ;;;### (autoloads (enriched-decode enriched-encode enriched-mode) -;;;;;; "enriched" "textmodes/enriched.el" (20707 18685 911514 0)) +;;;;;; "enriched" "textmodes/enriched.el" (20461 32935 300400 0)) ;;; Generated autoloads from textmodes/enriched.el (autoload 'enriched-mode "enriched" "\ @@ -8511,8 +8496,8 @@ Commands: ;;;;;; epa-sign-region epa-verify-cleartext-in-region epa-verify-region ;;;;;; epa-decrypt-armor-in-region epa-decrypt-region epa-encrypt-file ;;;;;; epa-sign-file epa-verify-file epa-decrypt-file epa-select-keys -;;;;;; epa-list-secret-keys epa-list-keys) "epa" "epa.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; epa-list-secret-keys epa-list-keys) "epa" "epa.el" (20577 +;;;;;; 33959 40183 0)) ;;; Generated autoloads from epa.el (autoload 'epa-list-keys "epa" "\ @@ -8690,8 +8675,8 @@ Insert selected KEYS after the point. ;;;*** ;;;### (autoloads (epa-dired-do-encrypt epa-dired-do-sign epa-dired-do-verify -;;;;;; epa-dired-do-decrypt) "epa-dired" "epa-dired.el" (20707 18685 -;;;;;; 911514 0)) +;;;;;; epa-dired-do-decrypt) "epa-dired" "epa-dired.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from epa-dired.el (autoload 'epa-dired-do-decrypt "epa-dired" "\ @@ -8717,7 +8702,7 @@ Encrypt marked files. ;;;*** ;;;### (autoloads (epa-file-disable epa-file-enable epa-file-handler) -;;;;;; "epa-file" "epa-file.el" (20707 18685 911514 0)) +;;;;;; "epa-file" "epa-file.el" (20355 10021 546955 0)) ;;; Generated autoloads from epa-file.el (autoload 'epa-file-handler "epa-file" "\ @@ -8739,7 +8724,7 @@ Encrypt marked files. ;;;### (autoloads (epa-global-mail-mode epa-mail-import-keys epa-mail-encrypt ;;;;;; epa-mail-sign epa-mail-verify epa-mail-decrypt epa-mail-mode) -;;;;;; "epa-mail" "epa-mail.el" (20707 18685 911514 0)) +;;;;;; "epa-mail" "epa-mail.el" (20566 63671 243798 0)) ;;; Generated autoloads from epa-mail.el (autoload 'epa-mail-mode "epa-mail" "\ @@ -8809,8 +8794,8 @@ if ARG is omitted or nil. ;;;*** -;;;### (autoloads (epg-make-context) "epg" "epg.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (epg-make-context) "epg" "epg.el" (20701 32695 +;;;;;; 861936 0)) ;;; Generated autoloads from epg.el (autoload 'epg-make-context "epg" "\ @@ -8821,7 +8806,7 @@ Return a context object. ;;;*** ;;;### (autoloads (epg-expand-group epg-check-configuration epg-configuration) -;;;;;; "epg-config" "epg-config.el" (20707 18685 911514 0)) +;;;;;; "epg-config" "epg-config.el" (20373 11301 906925 0)) ;;; Generated autoloads from epg-config.el (autoload 'epg-configuration "epg-config" "\ @@ -8842,7 +8827,7 @@ Look at CONFIG and try to expand GROUP. ;;;*** ;;;### (autoloads (erc-handle-irc-url erc-tls erc erc-select-read-args) -;;;;;; "erc" "erc/erc.el" (20707 18685 911514 0)) +;;;;;; "erc" "erc/erc.el" (20665 23726 628150 0)) ;;; Generated autoloads from erc/erc.el (autoload 'erc-select-read-args "erc" "\ @@ -8890,36 +8875,36 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL. ;;;*** -;;;### (autoloads nil "erc-autoaway" "erc/erc-autoaway.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads nil "erc-autoaway" "erc/erc-autoaway.el" (20591 +;;;;;; 33616 626144 310000)) ;;; Generated autoloads from erc/erc-autoaway.el (autoload 'erc-autoaway-mode "erc-autoaway") ;;;*** -;;;### (autoloads nil "erc-button" "erc/erc-button.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads nil "erc-button" "erc/erc-button.el" (20593 22184 +;;;;;; 581574 0)) ;;; Generated autoloads from erc/erc-button.el (autoload 'erc-button-mode "erc-button" nil t) ;;;*** -;;;### (autoloads nil "erc-capab" "erc/erc-capab.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads nil "erc-capab" "erc/erc-capab.el" (20650 54512 +;;;;;; 564403 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" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads nil "erc-compat" "erc/erc-compat.el" (20591 33616 +;;;;;; 736174 412000)) ;;; Generated autoloads from erc/erc-compat.el (autoload 'erc-define-minor-mode "erc-compat") ;;;*** ;;;### (autoloads (erc-ctcp-query-DCC pcomplete/erc-mode/DCC erc-cmd-DCC) -;;;;;; "erc-dcc" "erc/erc-dcc.el" (20707 18685 911514 0)) +;;;;;; "erc-dcc" "erc/erc-dcc.el" (20650 54512 564403 0)) ;;; Generated autoloads from erc/erc-dcc.el (autoload 'erc-dcc-mode "erc-dcc") @@ -8949,7 +8934,7 @@ that subcommand. ;;;*** ;;;### (autoloads nil "erc-desktop-notifications" "erc/erc-desktop-notifications.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20593 22184 581574 0)) ;;; Generated autoloads from erc/erc-desktop-notifications.el (autoload 'erc-notifications-mode "erc-desktop-notifications" "" t) @@ -8959,7 +8944,7 @@ that subcommand. ;;;;;; erc-ezb-add-session erc-ezb-end-of-session-list erc-ezb-init-session-list ;;;;;; erc-ezb-identify erc-ezb-notice-autodetect erc-ezb-lookup-action ;;;;;; erc-ezb-get-login erc-cmd-ezb) "erc-ezbounce" "erc/erc-ezbounce.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20650 54512 564403 0)) ;;; Generated autoloads from erc/erc-ezbounce.el (autoload 'erc-cmd-ezb "erc-ezbounce" "\ @@ -9021,8 +9006,8 @@ Add EZBouncer convenience functions to ERC. ;;;*** -;;;### (autoloads (erc-fill) "erc-fill" "erc/erc-fill.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (erc-fill) "erc-fill" "erc/erc-fill.el" (20591 +;;;;;; 33616 776163 920000)) ;;; Generated autoloads from erc/erc-fill.el (autoload 'erc-fill-mode "erc-fill" nil t) @@ -9035,7 +9020,7 @@ You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'. ;;;*** ;;;### (autoloads (erc-identd-stop erc-identd-start) "erc-identd" -;;;;;; "erc/erc-identd.el" (20707 18685 911514 0)) +;;;;;; "erc/erc-identd.el" (20591 33616 794740 81000)) ;;; Generated autoloads from erc/erc-identd.el (autoload 'erc-identd-mode "erc-identd") @@ -9057,7 +9042,7 @@ system. ;;;*** ;;;### (autoloads (erc-create-imenu-index) "erc-imenu" "erc/erc-imenu.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20591 33616 794740 81000)) ;;; Generated autoloads from erc/erc-imenu.el (autoload 'erc-create-imenu-index "erc-imenu" "\ @@ -9067,22 +9052,22 @@ system. ;;;*** -;;;### (autoloads nil "erc-join" "erc/erc-join.el" (20707 18685 911514 +;;;### (autoloads nil "erc-join" "erc/erc-join.el" (20650 54512 564403 ;;;;;; 0)) ;;; Generated autoloads from erc/erc-join.el (autoload 'erc-autojoin-mode "erc-join" nil t) ;;;*** -;;;### (autoloads nil "erc-list" "erc/erc-list.el" (20707 18685 911514 -;;;;;; 0)) +;;;### (autoloads nil "erc-list" "erc/erc-list.el" (20591 33616 824757 +;;;;;; 867000)) ;;; Generated autoloads from erc/erc-list.el (autoload 'erc-list-mode "erc-list") ;;;*** ;;;### (autoloads (erc-save-buffer-in-logs erc-logging-enabled) "erc-log" -;;;;;; "erc/erc-log.el" (20707 18685 911514 0)) +;;;;;; "erc/erc-log.el" (20650 54512 564403 0)) ;;; Generated autoloads from erc/erc-log.el (autoload 'erc-log-mode "erc-log" nil t) @@ -9114,7 +9099,7 @@ You can save every individual message by putting this function on ;;;### (autoloads (erc-delete-dangerous-host erc-add-dangerous-host ;;;;;; erc-delete-keyword erc-add-keyword erc-delete-fool erc-add-fool ;;;;;; erc-delete-pal erc-add-pal) "erc-match" "erc/erc-match.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20650 54512 564403 0)) ;;; Generated autoloads from erc/erc-match.el (autoload 'erc-match-mode "erc-match") @@ -9160,15 +9145,15 @@ Delete dangerous-host interactively to `erc-dangerous-hosts'. ;;;*** -;;;### (autoloads nil "erc-menu" "erc/erc-menu.el" (20707 18685 911514 -;;;;;; 0)) +;;;### (autoloads nil "erc-menu" "erc/erc-menu.el" (20591 33616 844710 +;;;;;; 904000)) ;;; Generated autoloads from erc/erc-menu.el (autoload 'erc-menu-mode "erc-menu" nil t) ;;;*** ;;;### (autoloads (erc-cmd-WHOLEFT) "erc-netsplit" "erc/erc-netsplit.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20650 54512 564403 0)) ;;; Generated autoloads from erc/erc-netsplit.el (autoload 'erc-netsplit-mode "erc-netsplit") @@ -9180,7 +9165,7 @@ Show who's gone. ;;;*** ;;;### (autoloads (erc-server-select erc-determine-network) "erc-networks" -;;;;;; "erc/erc-networks.el" (20707 18685 911514 0)) +;;;;;; "erc/erc-networks.el" (20650 54512 564403 0)) ;;; Generated autoloads from erc/erc-networks.el (autoload 'erc-determine-network "erc-networks" "\ @@ -9198,7 +9183,7 @@ Interactively select a server to connect to using `erc-server-alist'. ;;;*** ;;;### (autoloads (pcomplete/erc-mode/NOTIFY erc-cmd-NOTIFY) "erc-notify" -;;;;;; "erc/erc-notify.el" (20707 18685 911514 0)) +;;;;;; "erc/erc-notify.el" (20650 54512 564403 0)) ;;; Generated autoloads from erc/erc-notify.el (autoload 'erc-notify-mode "erc-notify" nil t) @@ -9216,36 +9201,36 @@ with args, toggle notify status of people. ;;;*** -;;;### (autoloads nil "erc-page" "erc/erc-page.el" (20707 18685 911514 -;;;;;; 0)) +;;;### (autoloads nil "erc-page" "erc/erc-page.el" (20591 33616 864734 +;;;;;; 46000)) ;;; Generated autoloads from erc/erc-page.el (autoload 'erc-page-mode "erc-page") ;;;*** -;;;### (autoloads nil "erc-pcomplete" "erc/erc-pcomplete.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads nil "erc-pcomplete" "erc/erc-pcomplete.el" (20650 +;;;;;; 54512 564403 0)) ;;; Generated autoloads from erc/erc-pcomplete.el (autoload 'erc-completion-mode "erc-pcomplete" nil t) ;;;*** -;;;### (autoloads nil "erc-replace" "erc/erc-replace.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads nil "erc-replace" "erc/erc-replace.el" (20591 33616 +;;;;;; 874723 983000)) ;;; Generated autoloads from erc/erc-replace.el (autoload 'erc-replace-mode "erc-replace") ;;;*** -;;;### (autoloads nil "erc-ring" "erc/erc-ring.el" (20707 18685 911514 -;;;;;; 0)) +;;;### (autoloads nil "erc-ring" "erc/erc-ring.el" (20591 33616 884730 +;;;;;; 605000)) ;;; Generated autoloads from erc/erc-ring.el (autoload 'erc-ring-mode "erc-ring" nil t) ;;;*** ;;;### (autoloads (erc-nickserv-identify erc-nickserv-identify-mode) -;;;;;; "erc-services" "erc/erc-services.el" (20707 18685 911514 +;;;;;; "erc-services" "erc/erc-services.el" (20650 54512 564403 ;;;;;; 0)) ;;; Generated autoloads from erc/erc-services.el (autoload 'erc-services-mode "erc-services" nil t) @@ -9263,15 +9248,15 @@ When called interactively, read the password using `read-passwd'. ;;;*** -;;;### (autoloads nil "erc-sound" "erc/erc-sound.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads nil "erc-sound" "erc/erc-sound.el" (20591 33616 +;;;;;; 894723 303000)) ;;; Generated autoloads from erc/erc-sound.el (autoload 'erc-sound-mode "erc-sound") ;;;*** ;;;### (autoloads (erc-speedbar-browser) "erc-speedbar" "erc/erc-speedbar.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20650 54512 564403 0)) ;;; Generated autoloads from erc/erc-speedbar.el (autoload 'erc-speedbar-browser "erc-speedbar" "\ @@ -9282,22 +9267,22 @@ This will add a speedbar major display mode. ;;;*** -;;;### (autoloads nil "erc-spelling" "erc/erc-spelling.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads nil "erc-spelling" "erc/erc-spelling.el" (20591 +;;;;;; 33616 904733 437000)) ;;; Generated autoloads from erc/erc-spelling.el (autoload 'erc-spelling-mode "erc-spelling" nil t) ;;;*** -;;;### (autoloads nil "erc-stamp" "erc/erc-stamp.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads nil "erc-stamp" "erc/erc-stamp.el" (20593 22184 +;;;;;; 581574 0)) ;;; Generated autoloads from erc/erc-stamp.el (autoload 'erc-timestamp-mode "erc-stamp" nil t) ;;;*** ;;;### (autoloads (erc-track-minor-mode) "erc-track" "erc/erc-track.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20650 54512 564403 0)) ;;; Generated autoloads from erc/erc-track.el (defvar erc-track-minor-mode nil "\ @@ -9323,8 +9308,8 @@ keybindings will not do anything useful. ;;;*** ;;;### (autoloads (erc-truncate-buffer erc-truncate-buffer-to-size) -;;;;;; "erc-truncate" "erc/erc-truncate.el" (20707 18685 911514 -;;;;;; 0)) +;;;;;; "erc-truncate" "erc/erc-truncate.el" (20591 33616 934716 +;;;;;; 526000)) ;;; Generated autoloads from erc/erc-truncate.el (autoload 'erc-truncate-mode "erc-truncate" nil t) @@ -9344,7 +9329,7 @@ Meant to be used in hooks, like `erc-insert-post-hook'. ;;;*** ;;;### (autoloads (erc-xdcc-add-file) "erc-xdcc" "erc/erc-xdcc.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20591 33616 934716 526000)) ;;; Generated autoloads from erc/erc-xdcc.el (autoload 'erc-xdcc-mode "erc-xdcc") @@ -9357,7 +9342,7 @@ Add a file to `erc-xdcc-files'. ;;;### (autoloads (ert-describe-test ert-run-tests-interactively ;;;;;; ert-run-tests-batch-and-exit ert-run-tests-batch ert-deftest) -;;;;;; "ert" "emacs-lisp/ert.el" (20707 18685 911514 0)) +;;;;;; "ert" "emacs-lisp/ert.el" (20655 23358 697173 0)) ;;; Generated autoloads from emacs-lisp/ert.el (autoload 'ert-deftest "ert" "\ @@ -9423,7 +9408,7 @@ Display the documentation for TEST-OR-TEST-NAME (a symbol or ert-test). ;;;*** ;;;### (autoloads (ert-kill-all-test-buffers) "ert-x" "emacs-lisp/ert-x.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20655 23358 697173 0)) ;;; Generated autoloads from emacs-lisp/ert-x.el (put 'ert-with-test-buffer 'lisp-indent-function 1) @@ -9435,8 +9420,8 @@ Kill all test buffers that are still live. ;;;*** -;;;### (autoloads (eshell-mode) "esh-mode" "eshell/esh-mode.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (eshell-mode) "esh-mode" "eshell/esh-mode.el" (20593 +;;;;;; 22184 581574 0)) ;;; Generated autoloads from eshell/esh-mode.el (autoload 'eshell-mode "esh-mode" "\ @@ -9449,7 +9434,7 @@ Emacs shell interactive mode. ;;;*** ;;;### (autoloads (eshell-command-result eshell-command eshell) "eshell" -;;;;;; "eshell/eshell.el" (20707 18685 911514 0)) +;;;;;; "eshell/eshell.el" (20577 33959 40183 0)) ;;; Generated autoloads from eshell/eshell.el (autoload 'eshell "eshell" "\ @@ -9490,7 +9475,7 @@ corresponding to a successful execution. ;;;;;; visit-tags-table tags-table-mode find-tag-default-function ;;;;;; find-tag-hook tags-add-tables tags-compression-info-list ;;;;;; tags-table-list tags-case-fold-search) "etags" "progmodes/etags.el" -;;;;;; (20708 61830 550462 877000)) +;;;;;; (20693 38586 665915 0)) ;;; Generated autoloads from progmodes/etags.el (defvar tags-file-name nil "\ @@ -9518,8 +9503,11 @@ Use the `etags' program to make a tags table file.") (custom-autoload 'tags-table-list "etags" t) (defvar tags-compression-info-list (purecopy '("" ".Z" ".bz2" ".gz" ".xz" ".tgz")) "\ -List of extensions tried by etags when `auto-compression-mode' is on. -An empty string means search the non-compressed file.") +List of extensions tried by etags when jka-compr is used. +An empty string means search the non-compressed file. +These extensions will be tried only if jka-compr was activated +\(i.e. via customize of `auto-compression-mode' or by calling the function +`auto-compression-mode').") (custom-autoload 'tags-compression-info-list "etags" t) @@ -9805,7 +9793,7 @@ for \\[find-tag] (which see). ;;;;;; ethio-fidel-to-sera-marker ethio-fidel-to-sera-region ethio-fidel-to-sera-buffer ;;;;;; ethio-sera-to-fidel-marker ethio-sera-to-fidel-region ethio-sera-to-fidel-buffer ;;;;;; setup-ethiopic-environment-internal) "ethio-util" "language/ethio-util.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from language/ethio-util.el (autoload 'setup-ethiopic-environment-internal "ethio-util" "\ @@ -9975,7 +9963,7 @@ With ARG, insert that many delimiters. ;;;### (autoloads (eudc-load-eudc eudc-query-form eudc-expand-inline ;;;;;; eudc-get-phone eudc-get-email eudc-set-server) "eudc" "net/eudc.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20478 3673 653810 0)) ;;; Generated autoloads from net/eudc.el (autoload 'eudc-set-server "eudc" "\ @@ -10031,7 +10019,7 @@ This does nothing except loading eudc by autoload side-effect. ;;;### (autoloads (eudc-display-jpeg-as-button eudc-display-jpeg-inline ;;;;;; eudc-display-sound eudc-display-mail eudc-display-url eudc-display-generic-binary) -;;;;;; "eudc-bob" "net/eudc-bob.el" (20707 18685 911514 0)) +;;;;;; "eudc-bob" "net/eudc-bob.el" (20355 10021 546955 0)) ;;; Generated autoloads from net/eudc-bob.el (autoload 'eudc-display-generic-binary "eudc-bob" "\ @@ -10067,7 +10055,7 @@ Display a button for the JPEG DATA. ;;;*** ;;;### (autoloads (eudc-try-bbdb-insert eudc-insert-record-at-point-into-bbdb) -;;;;;; "eudc-export" "net/eudc-export.el" (20707 18685 911514 0)) +;;;;;; "eudc-export" "net/eudc-export.el" (20355 10021 546955 0)) ;;; Generated autoloads from net/eudc-export.el (autoload 'eudc-insert-record-at-point-into-bbdb "eudc-export" "\ @@ -10084,7 +10072,7 @@ Call `eudc-insert-record-at-point-into-bbdb' if on a record. ;;;*** ;;;### (autoloads (eudc-edit-hotlist) "eudc-hotlist" "net/eudc-hotlist.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from net/eudc-hotlist.el (autoload 'eudc-edit-hotlist "eudc-hotlist" "\ @@ -10094,8 +10082,8 @@ Edit the hotlist of directory servers in a specialized buffer. ;;;*** -;;;### (autoloads (ewoc-create) "ewoc" "emacs-lisp/ewoc.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (ewoc-create) "ewoc" "emacs-lisp/ewoc.el" (20453 +;;;;;; 5437 764254 0)) ;;; Generated autoloads from emacs-lisp/ewoc.el (autoload 'ewoc-create "ewoc" "\ @@ -10124,7 +10112,7 @@ fourth arg NOSEP non-nil inhibits this. ;;;### (autoloads (executable-make-buffer-file-executable-if-script-p ;;;;;; executable-self-display executable-set-magic executable-interpret ;;;;;; executable-command-find-posix-p) "executable" "progmodes/executable.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20533 6181 437016 717000)) ;;; Generated autoloads from progmodes/executable.el (autoload 'executable-command-find-posix-p "executable" "\ @@ -10167,7 +10155,7 @@ file modes. ;;;### (autoloads (expand-jump-to-next-slot expand-jump-to-previous-slot ;;;;;; expand-abbrev-hook expand-add-abbrevs) "expand" "expand.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from expand.el (autoload 'expand-add-abbrevs "expand" "\ @@ -10216,8 +10204,8 @@ This is used only in conjunction with `expand-add-abbrevs'. ;;;*** -;;;### (autoloads (f90-mode) "f90" "progmodes/f90.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (f90-mode) "f90" "progmodes/f90.el" (20679 5689 +;;;;;; 779225 0)) ;;; Generated autoloads from progmodes/f90.el (autoload 'f90-mode "f90" "\ @@ -10287,8 +10275,8 @@ with no args, if that value is non-nil. ;;;### (autoloads (variable-pitch-mode buffer-face-toggle buffer-face-set ;;;;;; buffer-face-mode text-scale-adjust text-scale-decrease text-scale-increase ;;;;;; text-scale-set face-remap-set-base face-remap-reset-base -;;;;;; face-remap-add-relative) "face-remap" "face-remap.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; face-remap-add-relative) "face-remap" "face-remap.el" (20622 +;;;;;; 22438 32851 0)) ;;; Generated autoloads from face-remap.el (autoload 'face-remap-add-relative "face-remap" "\ @@ -10451,8 +10439,8 @@ Besides the choice of face, it is the same as `buffer-face-mode'. ;;;### (autoloads (feedmail-queue-reminder feedmail-run-the-queue ;;;;;; feedmail-run-the-queue-global-prompt feedmail-run-the-queue-no-prompts -;;;;;; feedmail-send-it) "feedmail" "mail/feedmail.el" (20627 28531 -;;;;;; 447943 0)) +;;;;;; feedmail-send-it) "feedmail" "mail/feedmail.el" (20566 63671 +;;;;;; 243798 0)) ;;; Generated autoloads from mail/feedmail.el (autoload 'feedmail-send-it "feedmail" "\ @@ -10507,7 +10495,7 @@ you can set `feedmail-queue-reminder-alist' to nil. ;;;### (autoloads (ffap-bindings ffap-guess-file-name-at-point dired-at-point ;;;;;; ffap-at-mouse ffap-menu find-file-at-point ffap-next) "ffap" -;;;;;; "ffap.el" (20707 18685 911514 0)) +;;;;;; "ffap.el" (20671 11582 624449 0)) ;;; Generated autoloads from ffap.el (autoload 'ffap-next "ffap" "\ @@ -10573,23 +10561,24 @@ Evaluate the forms in variable `ffap-bindings'. ;;;### (autoloads (file-cache-minibuffer-complete file-cache-add-directory-recursively ;;;;;; file-cache-add-directory-using-locate file-cache-add-directory-using-find ;;;;;; file-cache-add-file file-cache-add-directory-list file-cache-add-directory) -;;;;;; "filecache" "filecache.el" (20707 18685 911514 0)) +;;;;;; "filecache" "filecache.el" (20648 50109 802321 0)) ;;; Generated autoloads from filecache.el (autoload 'file-cache-add-directory "filecache" "\ -Add DIRECTORY to the file cache. -If the optional REGEXP argument is non-nil, only files which match it will -be added to the cache. +Add all files in DIRECTORY to the file cache. +If called from Lisp with a non-nil REGEXP argument is non-nil, +only add files whose names match REGEXP. \(fn DIRECTORY &optional REGEXP)" t nil) (autoload 'file-cache-add-directory-list "filecache" "\ -Add DIRECTORY-LIST (a list of directory names) to the file cache. +Add DIRECTORIES (a list of directory names) to the file cache. +If called interactively, read the directory names one by one. If the optional REGEXP argument is non-nil, only files which match it will be added to the cache. Note that the REGEXP is applied to the files in each directory, not to the directory list itself. -\(fn DIRECTORY-LIST &optional REGEXP)" t nil) +\(fn DIRECTORIES &optional REGEXP)" t nil) (autoload 'file-cache-add-file "filecache" "\ Add FILE to the file cache. @@ -10633,8 +10622,8 @@ the name is considered already unique; only the second substitution ;;;;;; copy-file-locals-to-dir-locals delete-dir-local-variable ;;;;;; add-dir-local-variable delete-file-local-variable-prop-line ;;;;;; add-file-local-variable-prop-line delete-file-local-variable -;;;;;; add-file-local-variable) "files-x" "files-x.el" (20707 18685 -;;;;;; 911514 0)) +;;;;;; add-file-local-variable) "files-x" "files-x.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from files-x.el (autoload 'add-file-local-variable "files-x" "\ @@ -10699,8 +10688,8 @@ Copy directory-local variables to the -*- line. ;;;*** -;;;### (autoloads (filesets-init) "filesets" "filesets.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (filesets-init) "filesets" "filesets.el" (20614 +;;;;;; 54428 654267 0)) ;;; Generated autoloads from filesets.el (autoload 'filesets-init "filesets" "\ @@ -10711,8 +10700,8 @@ Set up hooks, load the cache file -- if existing -- and build the menu. ;;;*** -;;;### (autoloads (find-cmd) "find-cmd" "find-cmd.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (find-cmd) "find-cmd" "find-cmd.el" (20655 23358 +;;;;;; 697173 0)) ;;; Generated autoloads from find-cmd.el (autoload 'find-cmd "find-cmd" "\ @@ -10732,7 +10721,7 @@ result is a string that should be ready for the command line. ;;;*** ;;;### (autoloads (find-grep-dired find-name-dired find-dired) "find-dired" -;;;;;; "find-dired.el" (20707 18685 911514 0)) +;;;;;; "find-dired.el" (20355 10021 546955 0)) ;;; Generated autoloads from find-dired.el (autoload 'find-dired "find-dired" "\ @@ -10772,7 +10761,7 @@ use in place of \"-ls\" as the final argument. ;;;### (autoloads (ff-mouse-find-other-file-other-window ff-mouse-find-other-file ;;;;;; ff-find-other-file ff-get-other-file ff-special-constructs) -;;;;;; "find-file" "find-file.el" (20707 18685 911514 0)) +;;;;;; "find-file" "find-file.el" (20387 44199 24128 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)))) "\ @@ -10868,7 +10857,7 @@ Visit the file you click on in another window. ;;;;;; find-variable find-variable-noselect find-function-other-frame ;;;;;; find-function-other-window find-function find-function-noselect ;;;;;; find-function-search-for-symbol find-library) "find-func" -;;;;;; "emacs-lisp/find-func.el" (20707 18685 911514 0)) +;;;;;; "emacs-lisp/find-func.el" (20497 6436 957082 0)) ;;; Generated autoloads from emacs-lisp/find-func.el (autoload 'find-library "find-func" "\ @@ -11027,8 +11016,8 @@ Define some key bindings for the find-function family of functions. ;;;*** ;;;### (autoloads (find-lisp-find-dired-filter find-lisp-find-dired-subdirectories -;;;;;; find-lisp-find-dired) "find-lisp" "find-lisp.el" (20707 18685 -;;;;;; 911514 0)) +;;;;;; find-lisp-find-dired) "find-lisp" "find-lisp.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from find-lisp.el (autoload 'find-lisp-find-dired "find-lisp" "\ @@ -11049,7 +11038,7 @@ Change the filter on a find-lisp-find-dired buffer to REGEXP. ;;;*** ;;;### (autoloads (finder-by-keyword finder-commentary finder-list-keywords) -;;;;;; "finder" "finder.el" (20707 18685 911514 0)) +;;;;;; "finder" "finder.el" (20355 10021 546955 0)) ;;; Generated autoloads from finder.el (autoload 'finder-list-keywords "finder" "\ @@ -11071,7 +11060,7 @@ Find packages matching a given keyword. ;;;*** ;;;### (autoloads (enable-flow-control-on enable-flow-control) "flow-ctrl" -;;;;;; "flow-ctrl.el" (20707 18685 911514 0)) +;;;;;; "flow-ctrl.el" (20566 63671 243798 0)) ;;; Generated autoloads from flow-ctrl.el (autoload 'enable-flow-control "flow-ctrl" "\ @@ -11093,7 +11082,7 @@ to get the effect of a C-q. ;;;*** ;;;### (autoloads (fill-flowed fill-flowed-encode) "flow-fill" "gnus/flow-fill.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from gnus/flow-fill.el (autoload 'fill-flowed-encode "flow-fill" "\ @@ -11109,8 +11098,8 @@ to get the effect of a C-q. ;;;*** ;;;### (autoloads (flymake-find-file-hook flymake-mode-off flymake-mode-on -;;;;;; flymake-mode) "flymake" "progmodes/flymake.el" (20707 18685 -;;;;;; 911514 0)) +;;;;;; flymake-mode) "flymake" "progmodes/flymake.el" (20642 11326 +;;;;;; 759953 0)) ;;; Generated autoloads from progmodes/flymake.el (autoload 'flymake-mode "flymake" "\ @@ -11140,7 +11129,7 @@ Turn flymake mode off. ;;;### (autoloads (flyspell-buffer flyspell-region flyspell-mode-off ;;;;;; turn-off-flyspell turn-on-flyspell flyspell-mode flyspell-prog-mode) -;;;;;; "flyspell" "textmodes/flyspell.el" (20707 18685 911514 0)) +;;;;;; "flyspell" "textmodes/flyspell.el" (20566 63671 243798 0)) ;;; Generated autoloads from textmodes/flyspell.el (autoload 'flyspell-prog-mode "flyspell" "\ @@ -11212,7 +11201,7 @@ Flyspell whole buffer. ;;;### (autoloads (follow-delete-other-windows-and-split follow-mode ;;;;;; turn-off-follow-mode turn-on-follow-mode) "follow" "follow.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20501 3499 284800 0)) ;;; Generated autoloads from follow.el (autoload 'turn-on-follow-mode "follow" "\ @@ -11280,8 +11269,8 @@ selected if the original window is the first one in the frame. ;;;*** -;;;### (autoloads (footnote-mode) "footnote" "mail/footnote.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (footnote-mode) "footnote" "mail/footnote.el" (20478 +;;;;;; 3673 653810 0)) ;;; Generated autoloads from mail/footnote.el (autoload 'footnote-mode "footnote" "\ @@ -11300,7 +11289,7 @@ play around with the following keys: ;;;*** ;;;### (autoloads (forms-find-file-other-window forms-find-file forms-mode) -;;;;;; "forms" "forms.el" (20707 18685 911514 0)) +;;;;;; "forms" "forms.el" (20427 14766 970343 0)) ;;; Generated autoloads from forms.el (autoload 'forms-mode "forms" "\ @@ -11337,7 +11326,7 @@ Visit a file in Forms mode in other window. ;;;*** ;;;### (autoloads (fortran-mode) "fortran" "progmodes/fortran.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20438 24024 724594 589000)) ;;; Generated autoloads from progmodes/fortran.el (autoload 'fortran-mode "fortran" "\ @@ -11415,8 +11404,8 @@ with no args, if that value is non-nil. ;;;*** ;;;### (autoloads (fortune fortune-to-signature fortune-compile fortune-from-region -;;;;;; fortune-add-fortune) "fortune" "play/fortune.el" (20707 18685 -;;;;;; 911514 0)) +;;;;;; fortune-add-fortune) "fortune" "play/fortune.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from play/fortune.el (autoload 'fortune-add-fortune "fortune" "\ @@ -11465,7 +11454,7 @@ and choose the directory as the fortune-file. ;;;*** ;;;### (autoloads (gdb gdb-enable-debug) "gdb-mi" "progmodes/gdb-mi.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20609 10405 476026 0)) ;;; Generated autoloads from progmodes/gdb-mi.el (defvar gdb-enable-debug nil "\ @@ -11543,8 +11532,8 @@ detailed description of this mode. ;;;*** ;;;### (autoloads (generic-make-keywords-list generic-mode generic-mode-internal -;;;;;; define-generic-mode) "generic" "emacs-lisp/generic.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; define-generic-mode) "generic" "emacs-lisp/generic.el" (20406 +;;;;;; 8611 875037 0)) ;;; Generated autoloads from emacs-lisp/generic.el (defvar generic-mode-list nil "\ @@ -11623,7 +11612,7 @@ regular expression that can be used as an element of ;;;*** ;;;### (autoloads (glasses-mode) "glasses" "progmodes/glasses.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20478 3673 653810 0)) ;;; Generated autoloads from progmodes/glasses.el (autoload 'glasses-mode "glasses" "\ @@ -11639,7 +11628,7 @@ add virtual separators (like underscores) at places they belong to. ;;;### (autoloads (gmm-tool-bar-from-list gmm-widget-p gmm-error ;;;;;; gmm-message gmm-regexp-concat) "gmm-utils" "gnus/gmm-utils.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20672 32446 100992 0)) ;;; Generated autoloads from gnus/gmm-utils.el (autoload 'gmm-regexp-concat "gmm-utils" "\ @@ -11694,8 +11683,8 @@ DEFAULT-MAP specifies the default key map for ICON-LIST. ;;;*** ;;;### (autoloads (gnus gnus-other-frame gnus-slave gnus-no-server -;;;;;; gnus-slave-no-server) "gnus" "gnus/gnus.el" (20707 18685 -;;;;;; 911514 0)) +;;;;;; gnus-slave-no-server) "gnus" "gnus/gnus.el" (20681 1859 197031 +;;;;;; 0)) ;;; Generated autoloads from gnus/gnus.el (when (fboundp 'custom-autoload) (custom-autoload 'gnus-select-method "gnus")) @@ -11725,8 +11714,9 @@ Read news as a slave. Pop up a frame to read news. This will call one of the Gnus commands which is specified by the user option `gnus-other-frame-function' (default `gnus') with the argument -ARG if Gnus is not running, otherwise just pop up a Gnus frame. The -optional second argument DISPLAY should be a standard display string +ARG if Gnus is not running, otherwise pop up a Gnus frame and run the +command specified by `gnus-other-frame-resume-function'. +The optional second argument DISPLAY should be a standard display string such as \"unix:0\" to specify where to pop up a frame. If DISPLAY is omitted or the function `make-frame-on-display' is not available, the current display is used. @@ -11748,7 +11738,7 @@ prompt the user for the name of an NNTP server to use. ;;;;;; gnus-agent-get-undownloaded-list gnus-agent-delete-group ;;;;;; gnus-agent-rename-group gnus-agent-possibly-save-gcc gnus-agentize ;;;;;; gnus-slave-unplugged gnus-plugged gnus-unplugged) "gnus-agent" -;;;;;; "gnus/gnus-agent.el" (20707 18685 911514 0)) +;;;;;; "gnus/gnus-agent.el" (20698 56506 332830 0)) ;;; Generated autoloads from gnus/gnus-agent.el (autoload 'gnus-unplugged "gnus-agent" "\ @@ -11839,7 +11829,7 @@ If CLEAN, obsolete (ignore). ;;;*** ;;;### (autoloads (gnus-article-prepare-display) "gnus-art" "gnus/gnus-art.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20700 11832 779612 0)) ;;; Generated autoloads from gnus/gnus-art.el (autoload 'gnus-article-prepare-display "gnus-art" "\ @@ -11850,7 +11840,7 @@ Make the current buffer look like a nice article. ;;;*** ;;;### (autoloads (gnus-bookmark-bmenu-list gnus-bookmark-jump gnus-bookmark-set) -;;;;;; "gnus-bookmark" "gnus/gnus-bookmark.el" (20707 18685 911514 +;;;;;; "gnus-bookmark" "gnus/gnus-bookmark.el" (20672 32446 100992 ;;;;;; 0)) ;;; Generated autoloads from gnus/gnus-bookmark.el @@ -11876,8 +11866,8 @@ deletion, or > if it is flagged for displaying. ;;;### (autoloads (gnus-cache-delete-group gnus-cache-rename-group ;;;;;; gnus-cache-generate-nov-databases gnus-cache-generate-active -;;;;;; gnus-jog-cache) "gnus-cache" "gnus/gnus-cache.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; gnus-jog-cache) "gnus-cache" "gnus/gnus-cache.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from gnus/gnus-cache.el (autoload 'gnus-jog-cache "gnus-cache" "\ @@ -11919,7 +11909,7 @@ supported. ;;;*** ;;;### (autoloads (gnus-delay-initialize gnus-delay-send-queue gnus-delay-article) -;;;;;; "gnus-delay" "gnus/gnus-delay.el" (20707 18685 911514 0)) +;;;;;; "gnus-delay" "gnus/gnus-delay.el" (20355 10021 546955 0)) ;;; Generated autoloads from gnus/gnus-delay.el (autoload 'gnus-delay-article "gnus-delay" "\ @@ -11955,7 +11945,7 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil. ;;;*** ;;;### (autoloads (gnus-user-format-function-D gnus-user-format-function-d) -;;;;;; "gnus-diary" "gnus/gnus-diary.el" (20707 18685 911514 0)) +;;;;;; "gnus-diary" "gnus/gnus-diary.el" (20647 29243 972198 0)) ;;; Generated autoloads from gnus/gnus-diary.el (autoload 'gnus-user-format-function-d "gnus-diary" "\ @@ -11971,7 +11961,7 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil. ;;;*** ;;;### (autoloads (turn-on-gnus-dired-mode) "gnus-dired" "gnus/gnus-dired.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20628 29298 719852 0)) ;;; Generated autoloads from gnus/gnus-dired.el (autoload 'turn-on-gnus-dired-mode "gnus-dired" "\ @@ -11982,7 +11972,7 @@ Convenience method to turn on gnus-dired-mode. ;;;*** ;;;### (autoloads (gnus-draft-reminder) "gnus-draft" "gnus/gnus-draft.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from gnus/gnus-draft.el (autoload 'gnus-draft-reminder "gnus-draft" "\ @@ -11994,8 +11984,8 @@ Reminder user if there are unsent drafts. ;;;### (autoloads (gnus-convert-png-to-face gnus-convert-face-to-png ;;;;;; gnus-face-from-file gnus-x-face-from-file gnus-insert-random-x-face-header -;;;;;; gnus-random-x-face) "gnus-fun" "gnus/gnus-fun.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; gnus-random-x-face) "gnus-fun" "gnus/gnus-fun.el" (20549 +;;;;;; 54573 979353 0)) ;;; Generated autoloads from gnus/gnus-fun.el (autoload 'gnus-random-x-face "gnus-fun" "\ @@ -12040,7 +12030,7 @@ FILE should be a PNG file that's 48x48 and smaller than or equal to ;;;*** ;;;### (autoloads (gnus-treat-mail-gravatar gnus-treat-from-gravatar) -;;;;;; "gnus-gravatar" "gnus/gnus-gravatar.el" (20707 18685 911514 +;;;;;; "gnus-gravatar" "gnus/gnus-gravatar.el" (20355 10021 546955 ;;;;;; 0)) ;;; Generated autoloads from gnus/gnus-gravatar.el @@ -12059,7 +12049,7 @@ If gravatars are already displayed, remove them. ;;;*** ;;;### (autoloads (gnus-fetch-group-other-frame gnus-fetch-group) -;;;;;; "gnus-group" "gnus/gnus-group.el" (20707 18685 911514 0)) +;;;;;; "gnus-group" "gnus/gnus-group.el" (20698 56506 332830 0)) ;;; Generated autoloads from gnus/gnus-group.el (autoload 'gnus-fetch-group "gnus-group" "\ @@ -12077,7 +12067,7 @@ Pop up a frame and enter GROUP. ;;;*** ;;;### (autoloads (gnus-html-prefetch-images gnus-article-html) "gnus-html" -;;;;;; "gnus/gnus-html.el" (20707 18685 911514 0)) +;;;;;; "gnus/gnus-html.el" (20355 10021 546955 0)) ;;; Generated autoloads from gnus/gnus-html.el (autoload 'gnus-article-html "gnus-html" "\ @@ -12093,7 +12083,7 @@ Pop up a frame and enter GROUP. ;;;*** ;;;### (autoloads (gnus-batch-score) "gnus-kill" "gnus/gnus-kill.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20495 51111 757560 0)) ;;; Generated autoloads from gnus/gnus-kill.el (defalias 'gnus-batch-kill 'gnus-batch-score) @@ -12108,7 +12098,7 @@ Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score ;;;### (autoloads (gnus-mailing-list-mode gnus-mailing-list-insinuate ;;;;;; turn-on-gnus-mailing-list-mode) "gnus-ml" "gnus/gnus-ml.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from gnus/gnus-ml.el (autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" "\ @@ -12133,7 +12123,7 @@ Minor mode for providing mailing-list commands. ;;;### (autoloads (gnus-group-split-fancy gnus-group-split gnus-group-split-update ;;;;;; gnus-group-split-setup) "gnus-mlspl" "gnus/gnus-mlspl.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from gnus/gnus-mlspl.el (autoload 'gnus-group-split-setup "gnus-mlspl" "\ @@ -12234,7 +12224,7 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\") returns: ;;;*** ;;;### (autoloads (gnus-button-reply gnus-button-mailto gnus-msg-mail) -;;;;;; "gnus-msg" "gnus/gnus-msg.el" (20707 18685 911514 0)) +;;;;;; "gnus-msg" "gnus/gnus-msg.el" (20701 32695 861936 0)) ;;; Generated autoloads from gnus/gnus-msg.el (autoload 'gnus-msg-mail "gnus-msg" "\ @@ -12261,7 +12251,7 @@ Like `message-reply'. ;;;*** ;;;### (autoloads (gnus-notifications) "gnus-notifications" "gnus/gnus-notifications.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20593 22184 581574 0)) ;;; Generated autoloads from gnus/gnus-notifications.el (autoload 'gnus-notifications "gnus-notifications" "\ @@ -12279,7 +12269,7 @@ This is typically a function to add in ;;;### (autoloads (gnus-treat-newsgroups-picon gnus-treat-mail-picon ;;;;;; gnus-treat-from-picon) "gnus-picon" "gnus/gnus-picon.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20523 62082 997685 0)) ;;; Generated autoloads from gnus/gnus-picon.el (autoload 'gnus-treat-from-picon "gnus-picon" "\ @@ -12306,7 +12296,7 @@ If picons are already displayed, remove them. ;;;;;; gnus-sorted-nintersection gnus-sorted-range-intersection ;;;;;; gnus-sorted-intersection gnus-intersection gnus-sorted-complement ;;;;;; gnus-sorted-ndifference gnus-sorted-difference) "gnus-range" -;;;;;; "gnus/gnus-range.el" (20707 18685 911514 0)) +;;;;;; "gnus/gnus-range.el" (20544 36659 880486 0)) ;;; Generated autoloads from gnus/gnus-range.el (autoload 'gnus-sorted-difference "gnus-range" "\ @@ -12374,7 +12364,7 @@ Add NUM into sorted LIST by side effect. ;;;*** ;;;### (autoloads (gnus-registry-install-hooks gnus-registry-initialize) -;;;;;; "gnus-registry" "gnus/gnus-registry.el" (20707 18685 911514 +;;;;;; "gnus-registry" "gnus/gnus-registry.el" (20672 32446 100992 ;;;;;; 0)) ;;; Generated autoloads from gnus/gnus-registry.el @@ -12391,8 +12381,8 @@ Install the registry hooks. ;;;*** ;;;### (autoloads (gnus-sieve-article-add-rule gnus-sieve-generate -;;;;;; gnus-sieve-update) "gnus-sieve" "gnus/gnus-sieve.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; gnus-sieve-update) "gnus-sieve" "gnus/gnus-sieve.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from gnus/gnus-sieve.el (autoload 'gnus-sieve-update "gnus-sieve" "\ @@ -12420,7 +12410,7 @@ See the documentation for these variables and functions for details. ;;;*** ;;;### (autoloads (gnus-update-format) "gnus-spec" "gnus/gnus-spec.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20701 32695 861936 0)) ;;; Generated autoloads from gnus/gnus-spec.el (autoload 'gnus-update-format "gnus-spec" "\ @@ -12431,7 +12421,7 @@ Update the format specification near point. ;;;*** ;;;### (autoloads (gnus-declare-backend) "gnus-start" "gnus/gnus-start.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20681 47415 473102 0)) ;;; Generated autoloads from gnus/gnus-start.el (autoload 'gnus-declare-backend "gnus-start" "\ @@ -12442,7 +12432,7 @@ Declare back end NAME with ABILITIES as a Gnus back end. ;;;*** ;;;### (autoloads (gnus-summary-bookmark-jump) "gnus-sum" "gnus/gnus-sum.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20698 56506 332830 0)) ;;; Generated autoloads from gnus/gnus-sum.el (autoload 'gnus-summary-bookmark-jump "gnus-sum" "\ @@ -12454,7 +12444,7 @@ BOOKMARK is a bookmark name or a bookmark record. ;;;*** ;;;### (autoloads (gnus-sync-install-hooks gnus-sync-initialize) -;;;;;; "gnus-sync" "gnus/gnus-sync.el" (20707 18685 911514 0)) +;;;;;; "gnus-sync" "gnus/gnus-sync.el" (20696 14774 167809 0)) ;;; Generated autoloads from gnus/gnus-sync.el (autoload 'gnus-sync-initialize "gnus-sync" "\ @@ -12470,7 +12460,7 @@ Install the sync hooks. ;;;*** ;;;### (autoloads (gnus-add-configuration) "gnus-win" "gnus/gnus-win.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20447 49522 409090 0)) ;;; Generated autoloads from gnus/gnus-win.el (autoload 'gnus-add-configuration "gnus-win" "\ @@ -12481,7 +12471,7 @@ Add the window configuration CONF to `gnus-buffer-configuration'. ;;;*** ;;;### (autoloads (gnutls-min-prime-bits) "gnutls" "net/gnutls.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20476 31768 298871 0)) ;;; Generated autoloads from net/gnutls.el (defvar gnutls-min-prime-bits 256 "\ @@ -12497,8 +12487,8 @@ A value of nil says to use the default GnuTLS value.") ;;;*** -;;;### (autoloads (gomoku) "gomoku" "play/gomoku.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (gomoku) "gomoku" "play/gomoku.el" (20626 19492 +;;;;;; 855904 0)) ;;; Generated autoloads from play/gomoku.el (autoload 'gomoku "gomoku" "\ @@ -12525,8 +12515,8 @@ Use \\[describe-mode] for more info. ;;;*** ;;;### (autoloads (goto-address-prog-mode goto-address-mode goto-address -;;;;;; goto-address-at-point) "goto-addr" "net/goto-addr.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; goto-address-at-point) "goto-addr" "net/goto-addr.el" (20566 +;;;;;; 63671 243798 0)) ;;; Generated autoloads from net/goto-addr.el (define-obsolete-function-alias 'goto-address-at-mouse 'goto-address-at-point "22.1") @@ -12568,7 +12558,7 @@ Like `goto-address-mode', but only for comments and strings. ;;;*** ;;;### (autoloads (gravatar-retrieve-synchronously gravatar-retrieve) -;;;;;; "gravatar" "gnus/gravatar.el" (20707 18685 911514 0)) +;;;;;; "gravatar" "gnus/gravatar.el" (20355 10021 546955 0)) ;;; Generated autoloads from gnus/gravatar.el (autoload 'gravatar-retrieve "gravatar" "\ @@ -12586,8 +12576,8 @@ Retrieve MAIL-ADDRESS gravatar and returns it. ;;;### (autoloads (zrgrep rgrep lgrep grep-find grep grep-mode grep-compute-defaults ;;;;;; grep-process-setup grep-setup-hook grep-find-command grep-command -;;;;;; grep-window-height) "grep" "progmodes/grep.el" (20707 18685 -;;;;;; 911514 0)) +;;;;;; grep-window-height) "grep" "progmodes/grep.el" (20690 62389 +;;;;;; 885263 0)) ;;; Generated autoloads from progmodes/grep.el (defvar grep-window-height nil "\ @@ -12750,7 +12740,7 @@ file name to `*.gz', and sets `grep-highlight-matches' to `always'. ;;;*** -;;;### (autoloads (gs-load-image) "gs" "gs.el" (20707 18685 911514 +;;;### (autoloads (gs-load-image) "gs" "gs.el" (20355 10021 546955 ;;;;;; 0)) ;;; Generated autoloads from gs.el @@ -12765,8 +12755,8 @@ the form \"WINDOW-ID PIXMAP-ID\". Value is non-nil if successful. ;;;*** ;;;### (autoloads (gud-tooltip-mode gdb-script-mode jdb pdb perldb -;;;;;; xdb dbx sdb gud-gdb) "gud" "progmodes/gud.el" (20712 38790 -;;;;;; 413794 0)) +;;;;;; xdb dbx sdb gud-gdb) "gud" "progmodes/gud.el" (20614 55343 +;;;;;; 384716 548000)) ;;; Generated autoloads from progmodes/gud.el (autoload 'gud-gdb "gud" "\ @@ -12854,9 +12844,9 @@ it if ARG is omitted or nil. ;;;*** -;;;### (autoloads (setf gv-define-simple-setter gv-define-setter +;;;### (autoloads (gv-ref setf gv-define-simple-setter gv-define-setter ;;;;;; gv--defun-declaration gv-define-expander gv-letplace gv-get) -;;;;;; "gv" "emacs-lisp/gv.el" (20707 18685 911514 0)) +;;;;;; "gv" "emacs-lisp/gv.el" (20643 32183 554981 0)) ;;; Generated autoloads from emacs-lisp/gv.el (autoload 'gv-get "gv" "\ @@ -12947,10 +12937,16 @@ The return value is the last VAL in the list. (put 'gv-place 'edebug-form-spec 'edebug-match-form) +(autoload 'gv-ref "gv" "\ +Return a reference to PLACE. +This is like the `&' operator of the C language. + +\(fn PLACE)" nil t) + ;;;*** -;;;### (autoloads (handwrite) "handwrite" "play/handwrite.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (handwrite) "handwrite" "play/handwrite.el" (20566 +;;;;;; 63671 243798 0)) ;;; Generated autoloads from play/handwrite.el (autoload 'handwrite "handwrite" "\ @@ -12968,7 +12964,7 @@ Variables: `handwrite-linespace' (default 12) ;;;*** ;;;### (autoloads (hanoi-unix-64 hanoi-unix hanoi) "hanoi" "play/hanoi.el" -;;;;;; (20627 28531 447943 0)) +;;;;;; (20478 3673 653810 0)) ;;; Generated autoloads from play/hanoi.el (autoload 'hanoi "hanoi" "\ @@ -12997,7 +12993,7 @@ to be updated. ;;;### (autoloads (mail-check-payment mail-add-payment-async mail-add-payment ;;;;;; hashcash-verify-payment hashcash-insert-payment-async hashcash-insert-payment) -;;;;;; "hashcash" "mail/hashcash.el" (20707 18685 911514 0)) +;;;;;; "hashcash" "mail/hashcash.el" (20355 10021 546955 0)) ;;; Generated autoloads from mail/hashcash.el (autoload 'hashcash-insert-payment "hashcash" "\ @@ -13042,8 +13038,8 @@ Prefix arg sets default accept amount temporarily. ;;;### (autoloads (scan-buf-previous-region scan-buf-next-region ;;;;;; scan-buf-move-to-region help-at-pt-display-when-idle help-at-pt-set-timer ;;;;;; help-at-pt-cancel-timer display-local-help help-at-pt-kbd-string -;;;;;; help-at-pt-string) "help-at-pt" "help-at-pt.el" (20707 18685 -;;;;;; 911514 0)) +;;;;;; help-at-pt-string) "help-at-pt" "help-at-pt.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from help-at-pt.el (autoload 'help-at-pt-string "help-at-pt" "\ @@ -13173,7 +13169,7 @@ different regions. With numeric argument ARG, behaves like ;;;### (autoloads (doc-file-to-info doc-file-to-man describe-categories ;;;;;; describe-syntax describe-variable variable-at-point describe-function-1 ;;;;;; find-lisp-object-file-name help-C-file-name describe-function) -;;;;;; "help-fns" "help-fns.el" (20707 18685 911514 0)) +;;;;;; "help-fns" "help-fns.el" (20692 17721 295021 0)) ;;; Generated autoloads from help-fns.el (autoload 'describe-function "help-fns" "\ @@ -13253,7 +13249,7 @@ Produce a texinfo buffer with sorted doc-strings from the DOC file. ;;;*** ;;;### (autoloads (three-step-help) "help-macro" "help-macro.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20686 65335 65598 0)) ;;; Generated autoloads from help-macro.el (defvar three-step-help nil "\ @@ -13270,7 +13266,7 @@ gives the window that lists the options.") ;;;### (autoloads (help-bookmark-jump help-xref-on-pp help-insert-xref-button ;;;;;; help-xref-button help-make-xrefs help-buffer help-setup-xref ;;;;;; help-mode-finish help-mode-setup help-mode) "help-mode" "help-mode.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20647 29243 972198 0)) ;;; Generated autoloads from help-mode.el (autoload 'help-mode "help-mode" "\ @@ -13370,7 +13366,7 @@ BOOKMARK is a bookmark name or a bookmark record. ;;;*** ;;;### (autoloads (Helper-help Helper-describe-bindings) "helper" -;;;;;; "emacs-lisp/helper.el" (20707 18685 911514 0)) +;;;;;; "emacs-lisp/helper.el" (20355 10021 546955 0)) ;;; Generated autoloads from emacs-lisp/helper.el (autoload 'Helper-describe-bindings "helper" "\ @@ -13386,7 +13382,7 @@ Provide help for current mode. ;;;*** ;;;### (autoloads (hexlify-buffer hexl-find-file hexl-mode) "hexl" -;;;;;; "hexl.el" (20707 18685 911514 0)) +;;;;;; "hexl.el" (20523 62082 997685 0)) ;;; Generated autoloads from hexl.el (autoload 'hexl-mode "hexl" "\ @@ -13483,7 +13479,7 @@ This discards the buffer's undo information. ;;;### (autoloads (hi-lock-write-interactive-patterns hi-lock-unface-buffer ;;;;;; hi-lock-face-phrase-buffer hi-lock-face-buffer hi-lock-line-face-buffer ;;;;;; global-hi-lock-mode hi-lock-mode) "hi-lock" "hi-lock.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20679 5689 779225 0)) ;;; Generated autoloads from hi-lock.el (autoload 'hi-lock-mode "hi-lock" "\ @@ -13616,6 +13612,8 @@ updated as you type. Remove highlighting of each match to REGEXP set by hi-lock. Interactively, prompt for REGEXP, accepting only regexps previously inserted by hi-lock interactive functions. +If REGEXP is t (or if \\[universal-argument] was specified interactively), +then remove all hi-lock highlighting. \(fn REGEXP)" t nil) @@ -13631,7 +13629,7 @@ be found in variable `hi-lock-interactive-patterns'. ;;;*** ;;;### (autoloads (hide-ifdef-mode) "hideif" "progmodes/hideif.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20588 4262 531841 0)) ;;; Generated autoloads from progmodes/hideif.el (autoload 'hide-ifdef-mode "hideif" "\ @@ -13675,7 +13673,7 @@ Several variables affect how the hiding is done: ;;;*** ;;;### (autoloads (turn-off-hideshow hs-minor-mode) "hideshow" "progmodes/hideshow.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20566 63671 243798 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))) "\ @@ -13741,8 +13739,8 @@ Unconditionally turn off `hs-minor-mode'. ;;;;;; highlight-compare-buffers highlight-changes-rotate-faces ;;;;;; highlight-changes-previous-change highlight-changes-next-change ;;;;;; highlight-changes-remove-highlight highlight-changes-visible-mode -;;;;;; highlight-changes-mode) "hilit-chg" "hilit-chg.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; highlight-changes-mode) "hilit-chg" "hilit-chg.el" (20680 +;;;;;; 26549 383882 0)) ;;; Generated autoloads from hilit-chg.el (autoload 'highlight-changes-mode "hilit-chg" "\ @@ -13874,7 +13872,7 @@ See `highlight-changes-mode' for more information on Highlight-Changes mode. ;;;*** ;;;### (autoloads (make-hippie-expand-function hippie-expand hippie-expand-try-functions-list) -;;;;;; "hippie-exp" "hippie-exp.el" (20707 18685 911514 0)) +;;;;;; "hippie-exp" "hippie-exp.el" (20660 41272 835092 0)) ;;; Generated autoloads from hippie-exp.el (defvar hippie-expand-try-functions-list '(try-complete-file-name-partially try-complete-file-name try-expand-all-abbrevs try-expand-list try-expand-line try-expand-dabbrev try-expand-dabbrev-all-buffers try-expand-dabbrev-from-kill try-complete-lisp-symbol-partially try-complete-lisp-symbol) "\ @@ -13906,7 +13904,7 @@ argument VERBOSE non-nil makes the function verbose. ;;;*** ;;;### (autoloads (global-hl-line-mode hl-line-mode) "hl-line" "hl-line.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from hl-line.el (autoload 'hl-line-mode "hl-line" "\ @@ -13959,7 +13957,7 @@ Global-Hl-Line mode uses the functions `global-hl-line-unhighlight' and ;;;;;; holiday-bahai-holidays holiday-islamic-holidays holiday-christian-holidays ;;;;;; holiday-hebrew-holidays holiday-other-holidays holiday-local-holidays ;;;;;; holiday-oriental-holidays holiday-general-holidays) "holidays" -;;;;;; "calendar/holidays.el" (20707 18685 911514 0)) +;;;;;; "calendar/holidays.el" (20566 63671 243798 0)) ;;; Generated autoloads from calendar/holidays.el (define-obsolete-variable-alias 'general-holidays 'holiday-general-holidays "23.1") @@ -14107,8 +14105,8 @@ The optional LABEL is used to label the buffer created. ;;;*** -;;;### (autoloads (html2text) "html2text" "gnus/html2text.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (html2text) "html2text" "gnus/html2text.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from gnus/html2text.el (autoload 'html2text "html2text" "\ @@ -14119,7 +14117,7 @@ Convert HTML to plain text in the current buffer. ;;;*** ;;;### (autoloads (htmlfontify-copy-and-link-dir htmlfontify-buffer) -;;;;;; "htmlfontify" "htmlfontify.el" (20707 18685 911514 0)) +;;;;;; "htmlfontify" "htmlfontify.el" (20614 54428 654267 0)) ;;; Generated autoloads from htmlfontify.el (autoload 'htmlfontify-buffer "htmlfontify" "\ @@ -14152,8 +14150,8 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'. ;;;*** ;;;### (autoloads (define-ibuffer-filter define-ibuffer-op define-ibuffer-sorter -;;;;;; define-ibuffer-column) "ibuf-macs" "ibuf-macs.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; define-ibuffer-column) "ibuf-macs" "ibuf-macs.el" (20478 +;;;;;; 3673 653810 0)) ;;; Generated autoloads from ibuf-macs.el (autoload 'define-ibuffer-column "ibuf-macs" "\ @@ -14242,7 +14240,7 @@ bound to the current value of the filter. ;;;*** ;;;### (autoloads (ibuffer ibuffer-other-window ibuffer-list-buffers) -;;;;;; "ibuffer" "ibuffer.el" (20707 18685 911514 0)) +;;;;;; "ibuffer" "ibuffer.el" (20647 29243 972198 0)) ;;; Generated autoloads from ibuffer.el (autoload 'ibuffer-list-buffers "ibuffer" "\ @@ -14283,7 +14281,7 @@ FORMATS is the value to use for `ibuffer-formats'. ;;;### (autoloads (icalendar-import-buffer icalendar-import-file ;;;;;; icalendar-export-region icalendar-export-file) "icalendar" -;;;;;; "calendar/icalendar.el" (20707 18685 911514 0)) +;;;;;; "calendar/icalendar.el" (20593 22184 581574 0)) ;;; Generated autoloads from calendar/icalendar.el (autoload 'icalendar-export-file "icalendar" "\ @@ -14335,8 +14333,8 @@ buffer `*icalendar-errors*'. ;;;*** -;;;### (autoloads (icomplete-mode) "icomplete" "icomplete.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (icomplete-mode) "icomplete" "icomplete.el" (20688 +;;;;;; 20662 910837 0)) ;;; Generated autoloads from icomplete.el (defvar icomplete-mode nil "\ @@ -14358,8 +14356,8 @@ the mode if ARG is omitted or nil. ;;;*** -;;;### (autoloads (icon-mode) "icon" "progmodes/icon.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (icon-mode) "icon" "progmodes/icon.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from progmodes/icon.el (autoload 'icon-mode "icon" "\ @@ -14400,7 +14398,7 @@ with no args, if that value is non-nil. ;;;*** ;;;### (autoloads (idlwave-shell) "idlw-shell" "progmodes/idlw-shell.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20572 16038 402143 0)) ;;; Generated autoloads from progmodes/idlw-shell.el (autoload 'idlwave-shell "idlw-shell" "\ @@ -14426,7 +14424,7 @@ See also the variable `idlwave-shell-prompt-pattern'. ;;;*** ;;;### (autoloads (idlwave-mode) "idlwave" "progmodes/idlwave.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20576 42138 697312 0)) ;;; Generated autoloads from progmodes/idlwave.el (autoload 'idlwave-mode "idlwave" "\ @@ -14560,8 +14558,8 @@ The main features of this mode are ;;;;;; ido-find-alternate-file ido-find-file-other-window ido-find-file ;;;;;; ido-find-file-in-dir ido-switch-buffer-other-frame ido-insert-buffer ;;;;;; ido-kill-buffer ido-display-buffer ido-switch-buffer-other-window -;;;;;; ido-switch-buffer ido-mode ido-mode) "ido" "ido.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; ido-switch-buffer ido-mode ido-mode) "ido" "ido.el" (20665 +;;;;;; 23733 615437 420000)) ;;; Generated autoloads from ido.el (defvar ido-mode nil "\ @@ -14820,7 +14818,7 @@ DEF, if non-nil, is the default value. ;;;*** -;;;### (autoloads (ielm) "ielm" "ielm.el" (20707 18685 911514 0)) +;;;### (autoloads (ielm) "ielm" "ielm.el" (20566 63671 243798 0)) ;;; Generated autoloads from ielm.el (autoload 'ielm "ielm" "\ @@ -14831,8 +14829,8 @@ Switches to the buffer `*ielm*', or creates it if it does not exist. ;;;*** -;;;### (autoloads (iimage-mode) "iimage" "iimage.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (iimage-mode) "iimage" "iimage.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from iimage.el (define-obsolete-function-alias 'turn-on-iimage-mode 'iimage-mode "24.1") @@ -14853,7 +14851,7 @@ the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. ;;;;;; create-image image-type-auto-detected-p image-type-available-p ;;;;;; image-type image-type-from-file-name image-type-from-file-header ;;;;;; image-type-from-buffer image-type-from-data) "image" "image.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20648 50109 802321 0)) ;;; Generated autoloads from image.el (autoload 'image-type-from-data "image" "\ @@ -15053,7 +15051,7 @@ If Emacs is compiled without ImageMagick support, this does nothing. ;;;;;; image-dired-jump-thumbnail-buffer image-dired-delete-tag ;;;;;; image-dired-tag-files image-dired-show-all-from-dir image-dired-display-thumbs ;;;;;; image-dired-dired-with-window-configuration image-dired-dired-toggle-marked-thumbs) -;;;;;; "image-dired" "image-dired.el" (20707 18685 911514 0)) +;;;;;; "image-dired" "image-dired.el" (20648 50109 802321 0)) ;;; Generated autoloads from image-dired.el (autoload 'image-dired-dired-toggle-marked-thumbs "image-dired" "\ @@ -15191,7 +15189,7 @@ easy-to-use form. ;;;### (autoloads (auto-image-file-mode insert-image-file image-file-name-regexp ;;;;;; image-file-name-regexps image-file-name-extensions) "image-file" -;;;;;; "image-file.el" (20707 18685 911514 0)) +;;;;;; "image-file.el" (20355 10021 546955 0)) ;;; Generated autoloads from image-file.el (defvar image-file-name-extensions (purecopy '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" "xpm" "pbm" "pgm" "ppm" "pnm" "svg")) "\ @@ -15254,7 +15252,7 @@ An image file is one whose name has an extension in ;;;*** ;;;### (autoloads (image-bookmark-jump image-mode-as-text image-minor-mode -;;;;;; image-mode) "image-mode" "image-mode.el" (20718 7922 212742 +;;;;;; image-mode) "image-mode" "image-mode.el" (20656 44218 805102 ;;;;;; 0)) ;;; Generated autoloads from image-mode.el @@ -15300,7 +15298,7 @@ on these modes. ;;;*** ;;;### (autoloads (imenu imenu-add-menubar-index imenu-add-to-menubar -;;;;;; imenu-sort-function) "imenu" "imenu.el" (20707 18685 911514 +;;;;;; imenu-sort-function) "imenu" "imenu.el" (20644 53049 326201 ;;;;;; 0)) ;;; Generated autoloads from imenu.el @@ -15441,7 +15439,7 @@ for more information. ;;;### (autoloads (indian-2-column-to-ucs-region in-is13194-pre-write-conversion ;;;;;; in-is13194-post-read-conversion indian-compose-string indian-compose-region) -;;;;;; "ind-util" "language/ind-util.el" (20707 18685 911514 0)) +;;;;;; "ind-util" "language/ind-util.el" (20355 10021 546955 0)) ;;; Generated autoloads from language/ind-util.el (autoload 'indian-compose-region "ind-util" "\ @@ -15472,7 +15470,7 @@ Convert old Emacs Devanagari characters to UCS. ;;;*** ;;;### (autoloads (inferior-lisp) "inf-lisp" "progmodes/inf-lisp.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20584 7212 455152 0)) ;;; Generated autoloads from progmodes/inf-lisp.el (autoload 'inferior-lisp "inf-lisp" "\ @@ -15494,7 +15492,7 @@ of `inferior-lisp-program'). Runs the hooks from ;;;;;; Info-goto-emacs-key-command-node Info-goto-emacs-command-node ;;;;;; Info-mode info-finder info-apropos Info-index Info-directory ;;;;;; Info-on-current-buffer info-standalone info-emacs-bug info-emacs-manual -;;;;;; info info-other-window) "info" "info.el" (20707 18685 911514 +;;;;;; info info-other-window) "info" "info.el" (20702 53568 929244 ;;;;;; 0)) ;;; Generated autoloads from info.el @@ -15520,7 +15518,7 @@ reasons. Normally, you should either set INFOPATH or customize (autoload 'info-other-window "info" "\ Like `info' but show the Info buffer in another window. -\(fn &optional FILE-OR-NODE)" t nil) +\(fn &optional FILE-OR-NODE BUFFER)" t nil) (put 'info 'info-file (purecopy "emacs")) (autoload 'info "info" "\ @@ -15536,8 +15534,9 @@ with the top-level Info directory. In interactive use, a non-numeric prefix argument directs this command to read a file name from the minibuffer. -A numeric prefix argument selects an Info buffer with the prefix number -appended to the Info buffer name. + +A numeric prefix argument N selects an Info buffer named +\"*info*<%s>\". The search path for Info files is in the variable `Info-directory-list'. The top-level Info directory is made by combining all the files named `dir' @@ -15697,7 +15696,9 @@ type returned by `Info-bookmark-make-record', which see. \(fn BMK)" nil nil) (autoload 'info-display-manual "info" "\ -Go to Info buffer that displays MANUAL, creating it if none already exists. +Display an Info buffer displaying MANUAL. +If there is an existing Info buffer for MANUAL, display it. +Otherwise, visit the manual in a new Info buffer. \(fn MANUAL)" t nil) @@ -15705,7 +15706,7 @@ Go to Info buffer that displays MANUAL, creating it if none already exists. ;;;### (autoloads (info-complete-file info-complete-symbol info-lookup-file ;;;;;; info-lookup-symbol info-lookup-reset) "info-look" "info-look.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20474 44971 970015 0)) ;;; Generated autoloads from info-look.el (autoload 'info-lookup-reset "info-look" "\ @@ -15754,7 +15755,7 @@ Perform completion on file preceding point. ;;;### (autoloads (info-xref-docstrings info-xref-check-all-custom ;;;;;; info-xref-check-all info-xref-check) "info-xref" "info-xref.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20476 31768 298871 0)) ;;; Generated autoloads from info-xref.el (autoload 'info-xref-check "info-xref" "\ @@ -15837,7 +15838,7 @@ the sources handy. ;;;*** ;;;### (autoloads (batch-info-validate Info-validate Info-split Info-split-threshold -;;;;;; Info-tagify) "informat" "informat.el" (20707 18685 911514 +;;;;;; Info-tagify) "informat" "informat.el" (20355 10021 546955 ;;;;;; 0)) ;;; Generated autoloads from informat.el @@ -15884,7 +15885,7 @@ For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\" ;;;*** ;;;### (autoloads (inversion-require-emacs) "inversion" "cedet/inversion.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20590 45996 129575 0)) ;;; Generated autoloads from cedet/inversion.el (autoload 'inversion-require-emacs "inversion" "\ @@ -15897,7 +15898,7 @@ Only checks one based on which kind of Emacs is being run. ;;;### (autoloads (isearch-process-search-multibyte-characters isearch-toggle-input-method ;;;;;; isearch-toggle-specified-input-method) "isearch-x" "international/isearch-x.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from international/isearch-x.el (autoload 'isearch-toggle-specified-input-method "isearch-x" "\ @@ -15917,8 +15918,8 @@ Toggle input method in interactive search. ;;;*** -;;;### (autoloads (isearchb-activate) "isearchb" "isearchb.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (isearchb-activate) "isearchb" "isearchb.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from isearchb.el (autoload 'isearchb-activate "isearchb" "\ @@ -15934,7 +15935,7 @@ accessed via isearchb. ;;;### (autoloads (iso-cvt-define-menu iso-cvt-write-only iso-cvt-read-only ;;;;;; iso-sgml2iso iso-iso2sgml iso-iso2duden iso-iso2gtex iso-gtex2iso ;;;;;; iso-tex2iso iso-iso2tex iso-german iso-spanish) "iso-cvt" -;;;;;; "international/iso-cvt.el" (20707 18685 911514 0)) +;;;;;; "international/iso-cvt.el" (20355 10021 546955 0)) ;;; Generated autoloads from international/iso-cvt.el (autoload 'iso-spanish "iso-cvt" "\ @@ -16025,7 +16026,7 @@ Add submenus to the File menu, to convert to and from various formats. ;;;*** ;;;### (autoloads nil "iso-transl" "international/iso-transl.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20486 36135 22104 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) @@ -16033,10 +16034,11 @@ Add submenus to the File menu, to convert to and from various formats. ;;;*** ;;;### (autoloads (ispell-message ispell-minor-mode ispell ispell-complete-word-interior-frag -;;;;;; ispell-complete-word ispell-continue ispell-buffer ispell-comments-and-strings -;;;;;; ispell-region ispell-change-dictionary ispell-kill-ispell -;;;;;; ispell-help ispell-pdict-save ispell-word ispell-personal-dictionary) -;;;;;; "ispell" "textmodes/ispell.el" (20707 18685 911514 0)) +;;;;;; ispell-complete-word ispell-continue ispell-buffer-with-debug +;;;;;; ispell-buffer ispell-comments-and-strings ispell-region ispell-change-dictionary +;;;;;; ispell-kill-ispell ispell-help ispell-pdict-save ispell-word +;;;;;; ispell-personal-dictionary) "ispell" "textmodes/ispell.el" +;;;;;; (20669 56247 196168 0)) ;;; Generated autoloads from textmodes/ispell.el (put 'ispell-check-comments 'safe-local-variable (lambda (a) (memq a '(nil t exclusive)))) @@ -16189,6 +16191,12 @@ Check the current buffer for spelling errors interactively. \(fn)" t nil) +(autoload 'ispell-buffer-with-debug "ispell" "\ +`ispell-buffer' with some output sent to `ispell-debug-buffer' buffer. +Use APPEND to append the info to previous buffer if exists. + +\(fn &optional APPEND)" t nil) + (autoload 'ispell-continue "ispell" "\ Continue a halted spelling session beginning with the current word. @@ -16263,8 +16271,8 @@ You can bind this to the key C-c i in GNUS or mail by adding to ;;;*** -;;;### (autoloads (iswitchb-mode) "iswitchb" "iswitchb.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (iswitchb-mode) "iswitchb" "iswitchb.el" (20577 +;;;;;; 33959 40183 0)) ;;; Generated autoloads from iswitchb.el (defvar iswitchb-mode nil "\ @@ -16292,7 +16300,7 @@ between buffers using substrings. See `iswitchb' for details. ;;;### (autoloads (read-hiragana-string japanese-zenkaku-region japanese-hankaku-region ;;;;;; japanese-hiragana-region japanese-katakana-region japanese-zenkaku ;;;;;; japanese-hankaku japanese-hiragana japanese-katakana setup-japanese-environment-internal) -;;;;;; "japan-util" "language/japan-util.el" (20707 18685 911514 +;;;;;; "japan-util" "language/japan-util.el" (20355 10021 546955 ;;;;;; 0)) ;;; Generated autoloads from language/japan-util.el @@ -16371,7 +16379,7 @@ If non-nil, second arg INITIAL-INPUT is a string to insert before reading. ;;;*** ;;;### (autoloads (jka-compr-uninstall jka-compr-handler) "jka-compr" -;;;;;; "jka-compr.el" (20707 18685 911514 0)) +;;;;;; "jka-compr.el" (20355 10021 546955 0)) ;;; Generated autoloads from jka-compr.el (defvar jka-compr-inhibit nil "\ @@ -16394,7 +16402,7 @@ by `jka-compr-installed'. ;;;*** -;;;### (autoloads (js-mode) "js" "progmodes/js.el" (20707 18685 911514 +;;;### (autoloads (js-mode) "js" "progmodes/js.el" (20665 59189 799105 ;;;;;; 0)) ;;; Generated autoloads from progmodes/js.el @@ -16409,7 +16417,7 @@ Major mode for editing JavaScript. ;;;### (autoloads (keypad-setup keypad-numlock-shifted-setup keypad-shifted-setup ;;;;;; keypad-numlock-setup keypad-setup) "keypad" "emulation/keypad.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from emulation/keypad.el (defvar keypad-setup nil "\ @@ -16465,7 +16473,7 @@ the decimal key on the keypad is mapped to DECIMAL instead of `.' ;;;*** ;;;### (autoloads (kinsoku) "kinsoku" "international/kinsoku.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from international/kinsoku.el (autoload 'kinsoku "kinsoku" "\ @@ -16486,8 +16494,8 @@ the context of text formatting. ;;;*** -;;;### (autoloads (kkc-region) "kkc" "international/kkc.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (kkc-region) "kkc" "international/kkc.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from international/kkc.el (defvar kkc-after-update-conversion-functions nil "\ @@ -16512,7 +16520,7 @@ and the return value is the length of the conversion. ;;;### (autoloads (kmacro-end-call-mouse kmacro-end-and-call-macro ;;;;;; kmacro-end-or-call-macro kmacro-start-macro-or-insert-counter ;;;;;; kmacro-call-macro kmacro-end-macro kmacro-start-macro kmacro-exec-ring-item) -;;;;;; "kmacro" "kmacro.el" (20707 18685 911514 0)) +;;;;;; "kmacro" "kmacro.el" (20471 22929 875294 592000)) ;;; Generated autoloads from kmacro.el (global-set-key "\C-x(" 'kmacro-start-macro) (global-set-key "\C-x)" 'kmacro-end-macro) @@ -16623,7 +16631,7 @@ If kbd macro currently being defined end it before activating it. ;;;*** ;;;### (autoloads (setup-korean-environment-internal) "korea-util" -;;;;;; "language/korea-util.el" (20707 18685 911514 0)) +;;;;;; "language/korea-util.el" (20501 3499 284800 0)) ;;; Generated autoloads from language/korea-util.el (defvar default-korean-keyboard (purecopy (if (string-match "3" (or (getenv "HANGUL_KEYBOARD_TYPE") "")) "3" "")) "\ @@ -16638,7 +16646,7 @@ The kind of Korean keyboard for Korean input method. ;;;*** ;;;### (autoloads (landmark landmark-test-run) "landmark" "play/landmark.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20545 57511 257469 0)) ;;; Generated autoloads from play/landmark.el (defalias 'landmark-repeat 'landmark-test-run) @@ -16670,7 +16678,7 @@ Use \\[describe-mode] for more info. ;;;### (autoloads (lao-compose-region lao-composition-function lao-transcribe-roman-to-lao-string ;;;;;; lao-transcribe-single-roman-syllable-to-lao lao-compose-string) -;;;;;; "lao-util" "language/lao-util.el" (20707 18685 911514 0)) +;;;;;; "lao-util" "language/lao-util.el" (20355 10021 546955 0)) ;;; Generated autoloads from language/lao-util.el (autoload 'lao-compose-string "lao-util" "\ @@ -16709,7 +16717,7 @@ Transcribe Romanized Lao string STR to Lao character string. ;;;### (autoloads (latexenc-find-file-coding-system latexenc-coding-system-to-inputenc ;;;;;; latexenc-inputenc-to-coding-system latex-inputenc-coding-alist) -;;;;;; "latexenc" "international/latexenc.el" (20707 18685 911514 +;;;;;; "latexenc" "international/latexenc.el" (20355 10021 546955 ;;;;;; 0)) ;;; Generated autoloads from international/latexenc.el @@ -16742,8 +16750,8 @@ coding system names is determined from `latex-inputenc-coding-alist'. ;;;*** ;;;### (autoloads (latin1-display-ucs-per-lynx latin1-display latin1-display) -;;;;;; "latin1-disp" "international/latin1-disp.el" (20707 18685 -;;;;;; 911514 0)) +;;;;;; "latin1-disp" "international/latin1-disp.el" (20577 33959 +;;;;;; 40183 0)) ;;; Generated autoloads from international/latin1-disp.el (defvar latin1-display nil "\ @@ -16785,7 +16793,7 @@ use either \\[customize] or the function `latin1-display'.") ;;;*** ;;;### (autoloads (ld-script-mode) "ld-script" "progmodes/ld-script.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from progmodes/ld-script.el (autoload 'ld-script-mode "ld-script" "\ @@ -16795,7 +16803,7 @@ A major mode to edit GNU ld script files ;;;*** -;;;### (autoloads (life) "life" "play/life.el" (20707 18685 911514 +;;;### (autoloads (life) "life" "play/life.el" (20545 57511 257469 ;;;;;; 0)) ;;; Generated autoloads from play/life.el @@ -16810,7 +16818,7 @@ generations (this defaults to 1). ;;;*** ;;;### (autoloads (global-linum-mode linum-mode) "linum" "linum.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20580 10161 446444 0)) ;;; Generated autoloads from linum.el (autoload 'linum-mode "linum" "\ @@ -16846,8 +16854,8 @@ See `linum-mode' for more information on Linum mode. ;;;*** -;;;### (autoloads (unload-feature) "loadhist" "loadhist.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (unload-feature) "loadhist" "loadhist.el" (20476 +;;;;;; 31768 298871 0)) ;;; Generated autoloads from loadhist.el (autoload 'unload-feature "loadhist" "\ @@ -16879,7 +16887,7 @@ something strange, such as redefining an Emacs function. ;;;*** ;;;### (autoloads (locate-with-filter locate locate-ls-subdir-switches) -;;;;;; "locate" "locate.el" (20707 18685 911514 0)) +;;;;;; "locate" "locate.el" (20566 63671 243798 0)) ;;; Generated autoloads from locate.el (defvar locate-ls-subdir-switches (purecopy "-al") "\ @@ -16931,8 +16939,8 @@ except that FILTER is not optional. ;;;*** -;;;### (autoloads (log-edit) "log-edit" "vc/log-edit.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (log-edit) "log-edit" "vc/log-edit.el" (20586 48936 +;;;;;; 135199 0)) ;;; Generated autoloads from vc/log-edit.el (autoload 'log-edit "log-edit" "\ @@ -16963,8 +16971,8 @@ done. Otherwise, it uses the current buffer. ;;;*** -;;;### (autoloads (log-view-mode) "log-view" "vc/log-view.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (log-view-mode) "log-view" "vc/log-view.el" (20515 +;;;;;; 36389 544939 0)) ;;; Generated autoloads from vc/log-view.el (autoload 'log-view-mode "log-view" "\ @@ -16974,35 +16982,9 @@ Major mode for browsing CVS log output. ;;;*** -;;;### (autoloads (longlines-mode) "longlines" "longlines.el" (20707 -;;;;;; 18685 911514 0)) -;;; Generated autoloads from longlines.el - -(autoload 'longlines-mode "longlines" "\ -Toggle Long Lines mode in this buffer. -With a prefix argument ARG, enable Long Lines mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. - -When Long Lines mode is enabled, long lines are wrapped if they -extend beyond `fill-column'. The soft newlines used for line -wrapping will not show up when the text is yanked or saved to -disk. - -If the variable `longlines-auto-wrap' is non-nil, lines are -automatically wrapped whenever the buffer is changed. You can -always call `fill-paragraph' to fill individual paragraphs. - -If the variable `longlines-show-hard-newlines' is non-nil, hard -newlines are indicated with a symbol. - -\(fn &optional ARG)" t nil) - -;;;*** - ;;;### (autoloads (print-region lpr-region print-buffer lpr-buffer -;;;;;; lpr-command lpr-switches printer-name) "lpr" "lpr.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; lpr-command lpr-switches printer-name) "lpr" "lpr.el" (20476 +;;;;;; 31768 298871 0)) ;;; Generated autoloads from lpr.el (defvar lpr-windows-system (memq system-type '(ms-dos windows-nt)) "\ @@ -17098,7 +17080,7 @@ for further customization of the printer command. ;;;*** ;;;### (autoloads (ls-lisp-support-shell-wildcards) "ls-lisp" "ls-lisp.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from ls-lisp.el (defvar ls-lisp-support-shell-wildcards t "\ @@ -17109,8 +17091,8 @@ Otherwise they are treated as Emacs regexps (for backward compatibility).") ;;;*** -;;;### (autoloads (lunar-phases) "lunar" "calendar/lunar.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (lunar-phases) "lunar" "calendar/lunar.el" (20566 +;;;;;; 63671 243798 0)) ;;; Generated autoloads from calendar/lunar.el (autoload 'lunar-phases "lunar" "\ @@ -17124,8 +17106,8 @@ This function is suitable for execution in an init file. ;;;*** -;;;### (autoloads (m4-mode) "m4-mode" "progmodes/m4-mode.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (m4-mode) "m4-mode" "progmodes/m4-mode.el" (20665 +;;;;;; 59189 799105 0)) ;;; Generated autoloads from progmodes/m4-mode.el (autoload 'm4-mode "m4-mode" "\ @@ -17136,7 +17118,7 @@ A major mode to edit m4 macro files. ;;;*** ;;;### (autoloads (apply-macro-to-region-lines kbd-macro-query insert-kbd-macro -;;;;;; name-last-kbd-macro) "macros" "macros.el" (20707 18685 911514 +;;;;;; name-last-kbd-macro) "macros" "macros.el" (20355 10021 546955 ;;;;;; 0)) ;;; Generated autoloads from macros.el @@ -17226,7 +17208,7 @@ and then select the region of un-tablified names and use ;;;*** ;;;### (autoloads (what-domain mail-extract-address-components) "mail-extr" -;;;;;; "mail/mail-extr.el" (20707 18685 911514 0)) +;;;;;; "mail/mail-extr.el" (20355 10021 546955 0)) ;;; Generated autoloads from mail/mail-extr.el (autoload 'mail-extract-address-components "mail-extr" "\ @@ -17258,7 +17240,7 @@ Convert mail domain DOMAIN to the country it corresponds to. ;;;### (autoloads (mail-hist-put-headers-into-history mail-hist-keep-history ;;;;;; mail-hist-enable mail-hist-define-keys) "mail-hist" "mail/mail-hist.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20566 63671 243798 0)) ;;; Generated autoloads from mail/mail-hist.el (autoload 'mail-hist-define-keys "mail-hist" "\ @@ -17290,7 +17272,7 @@ This function normally would be called when the message is sent. ;;;### (autoloads (mail-fetch-field mail-unquote-printable-region ;;;;;; mail-unquote-printable mail-quote-printable-region mail-quote-printable ;;;;;; mail-file-babyl-p mail-dont-reply-to-names mail-use-rfc822) -;;;;;; "mail-utils" "mail/mail-utils.el" (20707 18685 911514 0)) +;;;;;; "mail-utils" "mail/mail-utils.el" (20355 10021 546955 0)) ;;; Generated autoloads from mail/mail-utils.el (defvar mail-use-rfc822 nil "\ @@ -17365,8 +17347,8 @@ matches may be returned from the message body. ;;;*** ;;;### (autoloads (define-mail-abbrev build-mail-abbrevs mail-abbrevs-setup -;;;;;; mail-abbrevs-mode) "mailabbrev" "mail/mailabbrev.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; mail-abbrevs-mode) "mailabbrev" "mail/mailabbrev.el" (20672 +;;;;;; 32446 100992 0)) ;;; Generated autoloads from mail/mailabbrev.el (defvar mail-abbrevs-mode nil "\ @@ -17417,7 +17399,7 @@ double-quotes. ;;;### (autoloads (mail-complete mail-completion-at-point-function ;;;;;; define-mail-alias expand-mail-aliases mail-complete-style) -;;;;;; "mailalias" "mail/mailalias.el" (20707 18685 911514 0)) +;;;;;; "mailalias" "mail/mailalias.el" (20577 33959 40183 0)) ;;; Generated autoloads from mail/mailalias.el (defvar mail-complete-style 'angles "\ @@ -17471,7 +17453,7 @@ current header, calls `mail-complete-function' and passes prefix ARG if any. ;;;*** ;;;### (autoloads (mailclient-send-it) "mailclient" "mail/mailclient.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from mail/mailclient.el (autoload 'mailclient-send-it "mailclient" "\ @@ -17485,7 +17467,7 @@ The mail client is taken to be the handler of mailto URLs. ;;;### (autoloads (makefile-imake-mode makefile-bsdmake-mode makefile-makepp-mode ;;;;;; makefile-gmake-mode makefile-automake-mode makefile-mode) -;;;;;; "make-mode" "progmodes/make-mode.el" (20707 18685 911514 +;;;;;; "make-mode" "progmodes/make-mode.el" (20665 59189 799105 ;;;;;; 0)) ;;; Generated autoloads from progmodes/make-mode.el @@ -17603,8 +17585,8 @@ An adapted `makefile-mode' that knows about imake. ;;;*** -;;;### (autoloads (make-command-summary) "makesum" "makesum.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (make-command-summary) "makesum" "makesum.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from makesum.el (autoload 'make-command-summary "makesum" "\ @@ -17616,7 +17598,7 @@ Previous contents of that buffer are killed first. ;;;*** ;;;### (autoloads (Man-bookmark-jump man-follow man) "man" "man.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20523 62082 997685 0)) ;;; Generated autoloads from man.el (defalias 'manual-entry 'man) @@ -17670,8 +17652,8 @@ Default bookmark handler for Man buffers. ;;;*** -;;;### (autoloads (master-mode) "master" "master.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (master-mode) "master" "master.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from master.el (autoload 'master-mode "master" "\ @@ -17694,7 +17676,7 @@ yourself the value of `master-of' by calling `master-show-slave'. ;;;*** ;;;### (autoloads (minibuffer-depth-indicate-mode) "mb-depth" "mb-depth.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from mb-depth.el (defvar minibuffer-depth-indicate-mode nil "\ @@ -17727,7 +17709,7 @@ recursion depth in the minibuffer prompt. This is only useful if ;;;;;; message-forward-make-body message-forward message-recover ;;;;;; message-supersede message-cancel-news message-followup message-wide-reply ;;;;;; message-reply message-news message-mail message-mode) "message" -;;;;;; "gnus/message.el" (20707 18685 911514 0)) +;;;;;; "gnus/message.el" (20698 56506 332830 0)) ;;; Generated autoloads from gnus/message.el (define-mail-user-agent 'message-user-agent 'message-mail 'message-send-and-exit 'message-kill-buffer 'message-send-hook) @@ -17893,7 +17875,7 @@ which specify the range to operate on. ;;;*** ;;;### (autoloads (metapost-mode metafont-mode) "meta-mode" "progmodes/meta-mode.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20399 35365 4050 0)) ;;; Generated autoloads from progmodes/meta-mode.el (autoload 'metafont-mode "meta-mode" "\ @@ -17910,7 +17892,7 @@ Major mode for editing MetaPost sources. ;;;### (autoloads (metamail-region metamail-buffer metamail-interpret-body ;;;;;; metamail-interpret-header) "metamail" "mail/metamail.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from mail/metamail.el (autoload 'metamail-interpret-header "metamail" "\ @@ -17955,7 +17937,7 @@ redisplayed as output is inserted. ;;;### (autoloads (mh-fully-kill-draft mh-send-letter mh-user-agent-compose ;;;;;; mh-smail-batch mh-smail-other-window mh-smail) "mh-comp" -;;;;;; "mh-e/mh-comp.el" (20707 18685 911514 0)) +;;;;;; "mh-e/mh-comp.el" (20659 20411 59719 0)) ;;; Generated autoloads from mh-e/mh-comp.el (autoload 'mh-smail "mh-comp" "\ @@ -18045,8 +18027,8 @@ delete the draft message. ;;;*** -;;;### (autoloads (mh-version) "mh-e" "mh-e/mh-e.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (mh-version) "mh-e" "mh-e/mh-e.el" (20673 53308 +;;;;;; 39372 0)) ;;; Generated autoloads from mh-e/mh-e.el (put 'mh-progs 'risky-local-variable t) @@ -18063,7 +18045,7 @@ Display version information about MH-E and the MH mail handling system. ;;;*** ;;;### (autoloads (mh-folder-mode mh-nmail mh-rmail) "mh-folder" -;;;;;; "mh-e/mh-folder.el" (20707 18685 911514 0)) +;;;;;; "mh-e/mh-folder.el" (20659 20411 59719 0)) ;;; Generated autoloads from mh-e/mh-folder.el (autoload 'mh-rmail "mh-folder" "\ @@ -18145,7 +18127,7 @@ perform the operation on all messages in that region. ;;;*** ;;;### (autoloads (midnight-delay-set clean-buffer-list) "midnight" -;;;;;; "midnight.el" (20707 18685 911514 0)) +;;;;;; "midnight.el" (20478 3673 653810 0)) ;;; Generated autoloads from midnight.el (autoload 'clean-buffer-list "midnight" "\ @@ -18172,7 +18154,7 @@ to its second argument TM. ;;;*** ;;;### (autoloads (minibuffer-electric-default-mode) "minibuf-eldef" -;;;;;; "minibuf-eldef.el" (20707 18685 911514 0)) +;;;;;; "minibuf-eldef.el" (20672 32446 100992 0)) ;;; Generated autoloads from minibuf-eldef.el (defvar minibuffer-electric-default-mode nil "\ @@ -18202,7 +18184,7 @@ is modified to remove the default indication. ;;;*** ;;;### (autoloads (list-dynamic-libraries butterfly) "misc" "misc.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20533 5993 500881 0)) ;;; Generated autoloads from misc.el (autoload 'butterfly "misc" "\ @@ -18232,7 +18214,7 @@ The return value is always nil. ;;;### (autoloads (multi-isearch-files-regexp multi-isearch-files ;;;;;; multi-isearch-buffers-regexp multi-isearch-buffers multi-isearch-setup) -;;;;;; "misearch" "misearch.el" (20707 18685 911514 0)) +;;;;;; "misearch" "misearch.el" (20490 33188 850375 0)) ;;; Generated autoloads from misearch.el (add-hook 'isearch-mode-hook 'multi-isearch-setup) @@ -18314,7 +18296,7 @@ whose file names match the specified wildcard. ;;;*** ;;;### (autoloads (mixal-mode) "mixal-mode" "progmodes/mixal-mode.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20566 63671 243798 0)) ;;; Generated autoloads from progmodes/mixal-mode.el (autoload 'mixal-mode "mixal-mode" "\ @@ -18325,7 +18307,7 @@ Major mode for the mixal asm language. ;;;*** ;;;### (autoloads (mm-default-file-encoding) "mm-encode" "gnus/mm-encode.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from gnus/mm-encode.el (autoload 'mm-default-file-encoding "mm-encode" "\ @@ -18336,7 +18318,7 @@ Return a default encoding for FILE. ;;;*** ;;;### (autoloads (mm-inline-external-body mm-extern-cache-contents) -;;;;;; "mm-extern" "gnus/mm-extern.el" (20707 18685 911514 0)) +;;;;;; "mm-extern" "gnus/mm-extern.el" (20355 10021 546955 0)) ;;; Generated autoloads from gnus/mm-extern.el (autoload 'mm-extern-cache-contents "mm-extern" "\ @@ -18355,7 +18337,7 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing. ;;;*** ;;;### (autoloads (mm-inline-partial) "mm-partial" "gnus/mm-partial.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from gnus/mm-partial.el (autoload 'mm-inline-partial "mm-partial" "\ @@ -18369,7 +18351,7 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing. ;;;*** ;;;### (autoloads (mm-url-insert-file-contents-external mm-url-insert-file-contents) -;;;;;; "mm-url" "gnus/mm-url.el" (20707 18685 911514 0)) +;;;;;; "mm-url" "gnus/mm-url.el" (20495 51111 757560 0)) ;;; Generated autoloads from gnus/mm-url.el (autoload 'mm-url-insert-file-contents "mm-url" "\ @@ -18386,7 +18368,7 @@ Insert file contents of URL using `mm-url-program'. ;;;*** ;;;### (autoloads (mm-uu-dissect-text-parts mm-uu-dissect) "mm-uu" -;;;;;; "gnus/mm-uu.el" (20707 18685 911514 0)) +;;;;;; "gnus/mm-uu.el" (20355 10021 546955 0)) ;;; Generated autoloads from gnus/mm-uu.el (autoload 'mm-uu-dissect "mm-uu" "\ @@ -18406,7 +18388,7 @@ Assume text has been decoded if DECODED is non-nil. ;;;*** ;;;### (autoloads (mml-attach-file mml-to-mime) "mml" "gnus/mml.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20567 23165 75548 0)) ;;; Generated autoloads from gnus/mml.el (autoload 'mml-to-mime "mml" "\ @@ -18432,7 +18414,7 @@ body) or \"attachment\" (separate from the body). ;;;*** ;;;### (autoloads (mml1991-sign mml1991-encrypt) "mml1991" "gnus/mml1991.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from gnus/mml1991.el (autoload 'mml1991-encrypt "mml1991" "\ @@ -18449,7 +18431,7 @@ body) or \"attachment\" (separate from the body). ;;;### (autoloads (mml2015-self-encrypt mml2015-sign mml2015-encrypt ;;;;;; mml2015-verify-test mml2015-verify mml2015-decrypt-test mml2015-decrypt) -;;;;;; "mml2015" "gnus/mml2015.el" (20707 18685 911514 0)) +;;;;;; "mml2015" "gnus/mml2015.el" (20701 32695 861936 0)) ;;; Generated autoloads from gnus/mml2015.el (autoload 'mml2015-decrypt "mml2015" "\ @@ -18489,16 +18471,16 @@ body) or \"attachment\" (separate from the body). ;;;*** -;;;### (autoloads nil "mode-local" "cedet/mode-local.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads nil "mode-local" "cedet/mode-local.el" (20406 8611 +;;;;;; 875037 0)) ;;; Generated autoloads from cedet/mode-local.el (put 'define-overloadable-function 'doc-string-elt 3) ;;;*** -;;;### (autoloads (m2-mode) "modula2" "progmodes/modula2.el" (20627 -;;;;;; 28531 447943 0)) +;;;### (autoloads (m2-mode) "modula2" "progmodes/modula2.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from progmodes/modula2.el (defalias 'modula-2-mode 'm2-mode) @@ -18532,7 +18514,7 @@ followed by the first character of the construct. ;;;*** ;;;### (autoloads (denato-region nato-region unmorse-region morse-region) -;;;;;; "morse" "play/morse.el" (20707 18685 911514 0)) +;;;;;; "morse" "play/morse.el" (20355 10021 546955 0)) ;;; Generated autoloads from play/morse.el (autoload 'morse-region "morse" "\ @@ -18558,7 +18540,7 @@ Convert NATO phonetic alphabet in region to ordinary ASCII text. ;;;*** ;;;### (autoloads (mouse-drag-drag mouse-drag-throw) "mouse-drag" -;;;;;; "mouse-drag.el" (20707 18685 911514 0)) +;;;;;; "mouse-drag.el" (20566 63671 243798 0)) ;;; Generated autoloads from mouse-drag.el (autoload 'mouse-drag-throw "mouse-drag" "\ @@ -18605,7 +18587,7 @@ To test this function, evaluate: ;;;*** -;;;### (autoloads (mpc) "mpc" "mpc.el" (20707 18685 911514 0)) +;;;### (autoloads (mpc) "mpc" "mpc.el" (20681 1859 197031 0)) ;;; Generated autoloads from mpc.el (autoload 'mpc "mpc" "\ @@ -18615,7 +18597,7 @@ Main entry point for MPC. ;;;*** -;;;### (autoloads (mpuz) "mpuz" "play/mpuz.el" (20707 18685 911514 +;;;### (autoloads (mpuz) "mpuz" "play/mpuz.el" (20545 57511 257469 ;;;;;; 0)) ;;; Generated autoloads from play/mpuz.el @@ -18626,7 +18608,7 @@ Multiplication puzzle with GNU Emacs. ;;;*** -;;;### (autoloads (msb-mode) "msb" "msb.el" (20707 18685 911514 0)) +;;;### (autoloads (msb-mode) "msb" "msb.el" (20476 31768 298871 0)) ;;; Generated autoloads from msb.el (defvar msb-mode nil "\ @@ -18656,7 +18638,7 @@ different buffer menu using the function `msb'. ;;;;;; describe-current-coding-system describe-current-coding-system-briefly ;;;;;; describe-coding-system describe-character-set list-charset-chars ;;;;;; read-charset list-character-sets) "mule-diag" "international/mule-diag.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20577 33959 40183 0)) ;;; Generated autoloads from international/mule-diag.el (autoload 'list-character-sets "mule-diag" "\ @@ -18793,7 +18775,7 @@ The default is 20. If LIMIT is negative, do not limit the listing. ;;;;;; coding-system-translation-table-for-decode coding-system-pre-write-conversion ;;;;;; coding-system-post-read-conversion lookup-nested-alist set-nested-alist ;;;;;; truncate-string-to-width store-substring) "mule-util" "international/mule-util.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20577 33959 40183 0)) ;;; Generated autoloads from international/mule-util.el (defsubst string-to-list (string) "\ @@ -18924,11 +18906,88 @@ per-character basis, this may not be accurate. ;;;*** +;;;### (autoloads (advice-member-p advice-remove advice-add advice--add-function +;;;;;; add-function advice--buffer-local advice--remove-function) +;;;;;; "nadvice" "emacs-lisp/nadvice.el" (20651 26294 774003 0)) +;;; Generated autoloads from emacs-lisp/nadvice.el + +(autoload 'advice--remove-function "nadvice" "\ + + +\(fn FLIST FUNCTION)" nil nil) + +(autoload 'advice--buffer-local "nadvice" "\ +Buffer-local value of VAR, presumed to contain a function. + +\(fn VAR)" nil nil) + +(autoload 'add-function "nadvice" "\ +Add a piece of advice on the function stored at PLACE. +FUNCTION describes the code to add. WHERE describes where to add it. +WHERE can be explained by showing the resulting new function, as the +result of combining FUNCTION and the previous value of PLACE, which we +call OLDFUN here: +`:before' (lambda (&rest r) (apply FUNCTION r) (apply OLDFUN r)) +`:after' (lambda (&rest r) (prog1 (apply OLDFUN r) (apply FUNCTION r))) +`:around' (lambda (&rest r) (apply FUNCTION OLDFUN r)) +`:before-while' (lambda (&rest r) (and (apply FUNCTION r) (apply OLDFUN r))) +`:before-until' (lambda (&rest r) (or (apply FUNCTION r) (apply OLDFUN r))) +`:after-while' (lambda (&rest r) (and (apply OLDFUN r) (apply FUNCTION r))) +`:after-until' (lambda (&rest r) (or (apply OLDFUN r) (apply FUNCTION r))) +If FUNCTION was already added, do nothing. +PROPS is an alist of additional properties, among which the following have +a special meaning: +- `name': a string or symbol. It can be used to refer to this piece of advice. + +PLACE cannot be a simple variable. Instead it should either be +\(default-value 'VAR) or (local 'VAR) depending on whether FUNCTION +should be applied to VAR buffer-locally or globally. + +If one of FUNCTION or OLDFUN is interactive, then the resulting function +is also interactive. There are 3 cases: +- FUNCTION is not interactive: the interactive spec of OLDFUN is used. +- The interactive spec of FUNCTION is itself a function: it should take one + argument (the interactive spec of OLDFUN, which it can pass to + `advice-eval-interactive-spec') and return the list of arguments to use. +- Else, use the interactive spec of FUNCTION and ignore the one of OLDFUN. + +\(fn WHERE PLACE FUNCTION &optional PROPS)" nil t) + +(autoload 'advice--add-function "nadvice" "\ + + +\(fn WHERE REF FUNCTION PROPS)" nil nil) + +(autoload 'advice-add "nadvice" "\ +Like `add-function' but for the function named SYMBOL. +Contrary to `add-function', this will properly handle the cases where SYMBOL +is defined as a macro, alias, command, ... + +\(fn SYMBOL WHERE FUNCTION &optional PROPS)" nil nil) + +(autoload 'advice-remove "nadvice" "\ +Like `remove-function' but for the function named SYMBOL. +Contrary to `remove-function', this will work also when SYMBOL is a macro +and it will not signal an error if SYMBOL is not `fboundp'. +Instead of the actual function to remove, FUNCTION can also be the `name' +of the piece of advice. + +\(fn SYMBOL FUNCTION)" nil nil) + +(autoload 'advice-member-p "nadvice" "\ +Return non-nil if ADVICE has been added to FUNCTION-NAME. +Instead of ADVICE being the actual function, it can also be the `name' +of the piece of advice. + +\(fn ADVICE FUNCTION-NAME)" nil nil) + +;;;*** + ;;;### (autoloads (network-connection network-connection-to-service ;;;;;; whois-reverse-lookup whois finger ftp run-dig dns-lookup-host ;;;;;; nslookup nslookup-host ping traceroute route arp netstat -;;;;;; iwconfig ifconfig) "net-utils" "net/net-utils.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; iwconfig ifconfig) "net-utils" "net/net-utils.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from net/net-utils.el (autoload 'ifconfig "net-utils" "\ @@ -19022,8 +19081,8 @@ Open a network connection to HOST on PORT. ;;;*** -;;;### (autoloads (netrc-credentials) "netrc" "net/netrc.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (netrc-credentials) "netrc" "net/netrc.el" (20495 +;;;;;; 51111 757560 0)) ;;; Generated autoloads from net/netrc.el (autoload 'netrc-credentials "netrc" "\ @@ -19036,7 +19095,7 @@ listed in the PORTS list. ;;;*** ;;;### (autoloads (open-network-stream) "network-stream" "net/network-stream.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20369 14251 85829 0)) ;;; Generated autoloads from net/network-stream.el (autoload 'open-network-stream "network-stream" "\ @@ -19127,7 +19186,7 @@ STARTTLS upgrades even if Emacs doesn't have built-in TLS functionality. ;;;*** ;;;### (autoloads (newsticker-start newsticker-running-p) "newst-backend" -;;;;;; "net/newst-backend.el" (20707 18685 911514 0)) +;;;;;; "net/newst-backend.el" (20577 33959 40183 0)) ;;; Generated autoloads from net/newst-backend.el (autoload 'newsticker-running-p "newst-backend" "\ @@ -19149,7 +19208,7 @@ Run `newsticker-start-hook' if newsticker was not running already. ;;;*** ;;;### (autoloads (newsticker-plainview) "newst-plainview" "net/newst-plainview.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20434 17809 692608 0)) ;;; Generated autoloads from net/newst-plainview.el (autoload 'newsticker-plainview "newst-plainview" "\ @@ -19160,7 +19219,7 @@ Start newsticker plainview. ;;;*** ;;;### (autoloads (newsticker-show-news) "newst-reader" "net/newst-reader.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20434 17809 692608 0)) ;;; Generated autoloads from net/newst-reader.el (autoload 'newsticker-show-news "newst-reader" "\ @@ -19171,7 +19230,7 @@ Start reading news. You may want to bind this to a key. ;;;*** ;;;### (autoloads (newsticker-start-ticker newsticker-ticker-running-p) -;;;;;; "newst-ticker" "net/newst-ticker.el" (20707 18685 911514 +;;;;;; "newst-ticker" "net/newst-ticker.el" (20427 14766 970343 ;;;;;; 0)) ;;; Generated autoloads from net/newst-ticker.el @@ -19193,7 +19252,7 @@ running already. ;;;*** ;;;### (autoloads (newsticker-treeview) "newst-treeview" "net/newst-treeview.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20590 45996 129575 0)) ;;; Generated autoloads from net/newst-treeview.el (autoload 'newsticker-treeview "newst-treeview" "\ @@ -19204,7 +19263,7 @@ Start newsticker treeview. ;;;*** ;;;### (autoloads (nndiary-generate-nov-databases) "nndiary" "gnus/nndiary.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20614 54428 654267 0)) ;;; Generated autoloads from gnus/nndiary.el (autoload 'nndiary-generate-nov-databases "nndiary" "\ @@ -19214,8 +19273,8 @@ Generate NOV databases in all nndiary directories. ;;;*** -;;;### (autoloads (nndoc-add-type) "nndoc" "gnus/nndoc.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (nndoc-add-type) "nndoc" "gnus/nndoc.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from gnus/nndoc.el (autoload 'nndoc-add-type "nndoc" "\ @@ -19230,7 +19289,7 @@ symbol in the alist. ;;;*** ;;;### (autoloads (nnfolder-generate-active-file) "nnfolder" "gnus/nnfolder.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20704 8885 590749 0)) ;;; Generated autoloads from gnus/nnfolder.el (autoload 'nnfolder-generate-active-file "nnfolder" "\ @@ -19242,7 +19301,7 @@ This command does not work if you use short group names. ;;;*** ;;;### (autoloads (nnml-generate-nov-databases) "nnml" "gnus/nnml.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20458 56750 651721 0)) ;;; Generated autoloads from gnus/nnml.el (autoload 'nnml-generate-nov-databases "nnml" "\ @@ -19253,7 +19312,7 @@ Generate NOV databases in all nnml directories. ;;;*** ;;;### (autoloads (disable-command enable-command disabled-command-function) -;;;;;; "novice" "novice.el" (20707 18685 911514 0)) +;;;;;; "novice" "novice.el" (20675 8629 685250 0)) ;;; Generated autoloads from novice.el (define-obsolete-variable-alias 'disabled-command-hook 'disabled-command-function "22.1") @@ -19286,7 +19345,7 @@ future sessions. ;;;*** ;;;### (autoloads (nroff-mode) "nroff-mode" "textmodes/nroff-mode.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from textmodes/nroff-mode.el (autoload 'nroff-mode "nroff-mode" "\ @@ -19301,7 +19360,7 @@ closing requests for requests that are used in matched pairs. ;;;*** ;;;### (autoloads (nxml-glyph-display-string) "nxml-glyph" "nxml/nxml-glyph.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20523 62082 997685 0)) ;;; Generated autoloads from nxml/nxml-glyph.el (autoload 'nxml-glyph-display-string "nxml-glyph" "\ @@ -19313,8 +19372,8 @@ Return nil if the face cannot display a glyph for N. ;;;*** -;;;### (autoloads (nxml-mode) "nxml-mode" "nxml/nxml-mode.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (nxml-mode) "nxml-mode" "nxml/nxml-mode.el" (20478 +;;;;;; 3673 653810 0)) ;;; Generated autoloads from nxml/nxml-mode.el (autoload 'nxml-mode "nxml-mode" "\ @@ -19376,7 +19435,7 @@ Many aspects this mode can be customized using ;;;*** ;;;### (autoloads (nxml-enable-unicode-char-name-sets) "nxml-uchnm" -;;;;;; "nxml/nxml-uchnm.el" (20707 18685 911514 0)) +;;;;;; "nxml/nxml-uchnm.el" (20355 10021 546955 0)) ;;; Generated autoloads from nxml/nxml-uchnm.el (autoload 'nxml-enable-unicode-char-name-sets "nxml-uchnm" "\ @@ -19389,7 +19448,7 @@ the variable `nxml-enabled-unicode-blocks'. ;;;*** ;;;### (autoloads (inferior-octave) "octave-inf" "progmodes/octave-inf.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from progmodes/octave-inf.el (autoload 'inferior-octave "octave-inf" "\ @@ -19412,7 +19471,7 @@ startup file, `~/.emacs-octave'. ;;;*** ;;;### (autoloads (octave-mode) "octave-mod" "progmodes/octave-mod.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20672 32446 100992 0)) ;;; Generated autoloads from progmodes/octave-mod.el (autoload 'octave-mode "octave-mod" "\ @@ -19500,7 +19559,7 @@ including a reproducible test case and send the message. ;;;;;; org-run-like-in-org-mode turn-on-orgstruct++ turn-on-orgstruct ;;;;;; orgstruct-mode org-global-cycle org-cycle org-mode org-clock-persistence-insinuate ;;;;;; turn-on-orgtbl org-version org-babel-do-load-languages) "org" -;;;;;; "org/org.el" (20716 21904 19206 0)) +;;;;;; "org/org.el" (20681 47415 473102 0)) ;;; Generated autoloads from org/org.el (autoload 'org-babel-do-load-languages "org" "\ @@ -19726,7 +19785,7 @@ Call the customize function with org as argument. ;;;;;; org-search-view org-agenda-list org-batch-store-agenda-views ;;;;;; org-store-agenda-views org-batch-agenda-csv org-batch-agenda ;;;;;; org-agenda org-toggle-sticky-agenda) "org-agenda" "org/org-agenda.el" -;;;;;; (20716 59992 836492 0)) +;;;;;; (20681 47415 473102 0)) ;;; Generated autoloads from org/org-agenda.el (autoload 'org-toggle-sticky-agenda "org-agenda" "\ @@ -19983,7 +20042,7 @@ to override `appt-message-warning-time'. ;;;*** ;;;### (autoloads (org-beamer-mode org-beamer-sectioning) "org-beamer" -;;;;;; "org/org-beamer.el" (20707 18685 911514 0)) +;;;;;; "org/org-beamer.el" (20618 55210 422086 0)) ;;; Generated autoloads from org/org-beamer.el (autoload 'org-beamer-sectioning "org-beamer" "\ @@ -20005,8 +20064,8 @@ Special support for editing Org-mode files made to export to beamer. ;;;*** ;;;### (autoloads (org-capture-import-remember-templates org-capture -;;;;;; org-capture-string) "org-capture" "org/org-capture.el" (20716 -;;;;;; 21904 19206 0)) +;;;;;; org-capture-string) "org-capture" "org/org-capture.el" (20618 +;;;;;; 55210 422086 0)) ;;; Generated autoloads from org/org-capture.el (autoload 'org-capture-string "org-capture" "\ @@ -20047,8 +20106,8 @@ Set org-capture-templates to be similar to `org-remember-templates'. ;;;*** ;;;### (autoloads (org-agenda-columns org-insert-columns-dblock org-dblock-write:columnview -;;;;;; org-columns) "org-colview" "org/org-colview.el" (20716 21904 -;;;;;; 19206 0)) +;;;;;; org-columns) "org-colview" "org/org-colview.el" (20618 55210 +;;;;;; 422086 0)) ;;; Generated autoloads from org/org-colview.el (autoload 'org-columns "org-colview" "\ @@ -20092,7 +20151,7 @@ Turn on or update column view in the agenda. ;;;*** ;;;### (autoloads (org-check-version) "org-compat" "org/org-compat.el" -;;;;;; (20716 21904 19206 0)) +;;;;;; (20618 55210 422086 0)) ;;; Generated autoloads from org/org-compat.el (autoload 'org-check-version "org-compat" "\ @@ -20103,7 +20162,7 @@ Try very hard to provide sensible version strings. ;;;*** ;;;### (autoloads (org-git-version org-release) "org-version" "org/org-version.el" -;;;;;; (20716 59992 836492 0)) +;;;;;; (20681 47415 473102 0)) ;;; Generated autoloads from org/org-version.el (autoload 'org-release "org-version" "\ @@ -20124,7 +20183,7 @@ The location of ODT styles.") ;;;*** ;;;### (autoloads (outline-minor-mode outline-mode) "outline" "outline.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from outline.el (put 'outline-regexp 'safe-local-variable 'stringp) (put 'outline-heading-end-regexp 'safe-local-variable 'stringp) @@ -20188,7 +20247,7 @@ See the command `outline-mode' for more information on this mode. ;;;### (autoloads (list-packages describe-package package-initialize ;;;;;; package-refresh-contents package-install-file package-install-from-buffer ;;;;;; package-install package-enable-at-startup) "package" "emacs-lisp/package.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20705 29751 556330 0)) ;;; Generated autoloads from emacs-lisp/package.el (defvar package-enable-at-startup t "\ @@ -20258,8 +20317,8 @@ The list is displayed in a buffer named `*Packages*'. ;;;*** -;;;### (autoloads (show-paren-mode) "paren" "paren.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (show-paren-mode) "paren" "paren.el" (20542 50478 +;;;;;; 439878 507000)) ;;; Generated autoloads from paren.el (defvar show-paren-mode nil "\ @@ -20286,7 +20345,7 @@ matching parenthesis is highlighted in `show-paren-style' after ;;;*** ;;;### (autoloads (parse-time-string) "parse-time" "calendar/parse-time.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20478 3673 653810 0)) ;;; Generated autoloads from calendar/parse-time.el (put 'parse-time-rules 'risky-local-variable t) @@ -20299,8 +20358,8 @@ unknown are returned as nil. ;;;*** -;;;### (autoloads (pascal-mode) "pascal" "progmodes/pascal.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (pascal-mode) "pascal" "progmodes/pascal.el" (20478 +;;;;;; 3673 653810 0)) ;;; Generated autoloads from progmodes/pascal.el (autoload 'pascal-mode "pascal" "\ @@ -20353,8 +20412,7 @@ no args, if that value is non-nil. ;;;*** ;;;### (autoloads (password-in-cache-p password-cache-expiry password-cache) -;;;;;; "password-cache" "password-cache.el" (20707 18685 911514 -;;;;;; 0)) +;;;;;; "password-cache" "password-cache.el" (20577 33959 40183 0)) ;;; Generated autoloads from password-cache.el (defvar password-cache t "\ @@ -20376,7 +20434,7 @@ Check if KEY is in the cache. ;;;*** ;;;### (autoloads (pcase-let pcase-let* pcase) "pcase" "emacs-lisp/pcase.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20582 12914 894781 0)) ;;; Generated autoloads from emacs-lisp/pcase.el (autoload 'pcase "pcase" "\ @@ -20437,8 +20495,8 @@ of the form (UPAT EXP). ;;;*** -;;;### (autoloads (pcomplete/cvs) "pcmpl-cvs" "pcmpl-cvs.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (pcomplete/cvs) "pcmpl-cvs" "pcmpl-cvs.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from pcmpl-cvs.el (autoload 'pcomplete/cvs "pcmpl-cvs" "\ @@ -20449,7 +20507,7 @@ Completion rules for the `cvs' command. ;;;*** ;;;### (autoloads (pcomplete/tar pcomplete/make pcomplete/bzip2 pcomplete/gzip) -;;;;;; "pcmpl-gnu" "pcmpl-gnu.el" (20707 18685 911514 0)) +;;;;;; "pcmpl-gnu" "pcmpl-gnu.el" (20572 16038 402143 0)) ;;; Generated autoloads from pcmpl-gnu.el (autoload 'pcomplete/gzip "pcmpl-gnu" "\ @@ -20477,7 +20535,7 @@ Completion for the GNU tar utility. ;;;*** ;;;### (autoloads (pcomplete/mount pcomplete/umount pcomplete/kill) -;;;;;; "pcmpl-linux" "pcmpl-linux.el" (20707 18685 911514 0)) +;;;;;; "pcmpl-linux" "pcmpl-linux.el" (20355 10021 546955 0)) ;;; Generated autoloads from pcmpl-linux.el (autoload 'pcomplete/kill "pcmpl-linux" "\ @@ -20497,8 +20555,8 @@ Completion for GNU/Linux `mount'. ;;;*** -;;;### (autoloads (pcomplete/rpm) "pcmpl-rpm" "pcmpl-rpm.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (pcomplete/rpm) "pcmpl-rpm" "pcmpl-rpm.el" (20523 +;;;;;; 62082 997685 0)) ;;; Generated autoloads from pcmpl-rpm.el (autoload 'pcomplete/rpm "pcmpl-rpm" "\ @@ -20510,7 +20568,7 @@ Completion for the `rpm' command. ;;;### (autoloads (pcomplete/scp pcomplete/ssh pcomplete/chgrp pcomplete/chown ;;;;;; pcomplete/which pcomplete/xargs pcomplete/rm pcomplete/rmdir -;;;;;; pcomplete/cd) "pcmpl-unix" "pcmpl-unix.el" (20707 18685 911514 +;;;;;; pcomplete/cd) "pcmpl-unix" "pcmpl-unix.el" (20376 40834 914217 ;;;;;; 0)) ;;; Generated autoloads from pcmpl-unix.el @@ -20568,8 +20626,8 @@ Includes files as well as host names followed by a colon. ;;;### (autoloads (pcomplete-shell-setup pcomplete-comint-setup pcomplete-list ;;;;;; pcomplete-help pcomplete-expand pcomplete-continue pcomplete-expand-and-complete -;;;;;; pcomplete-reverse pcomplete) "pcomplete" "pcomplete.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; pcomplete-reverse pcomplete) "pcomplete" "pcomplete.el" (20652 +;;;;;; 47164 970964 0)) ;;; Generated autoloads from pcomplete.el (autoload 'pcomplete "pcomplete" "\ @@ -20628,7 +20686,7 @@ Setup `shell-mode' to use pcomplete. ;;;### (autoloads (cvs-dired-use-hook cvs-dired-action cvs-status ;;;;;; cvs-update cvs-examine cvs-quickdir cvs-checkout) "pcvs" -;;;;;; "vc/pcvs.el" (20707 18685 911514 0)) +;;;;;; "vc/pcvs.el" (20584 7212 455152 0)) ;;; Generated autoloads from vc/pcvs.el (autoload 'cvs-checkout "pcvs" "\ @@ -20703,8 +20761,8 @@ The exact behavior is determined also by `cvs-dired-use-hook'." (when (stringp d ;;;*** -;;;### (autoloads nil "pcvs-defs" "vc/pcvs-defs.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads nil "pcvs-defs" "vc/pcvs-defs.el" (20576 42138 +;;;;;; 697312 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)) "\ @@ -20713,7 +20771,7 @@ Global menu used by PCL-CVS.") ;;;*** ;;;### (autoloads (perl-mode) "perl-mode" "progmodes/perl-mode.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20665 59189 799105 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) @@ -20775,7 +20833,7 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'. ;;;*** ;;;### (autoloads (picture-mode) "picture" "textmodes/picture.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20551 9899 283417 0)) ;;; Generated autoloads from textmodes/picture.el (autoload 'picture-mode "picture" "\ @@ -20856,7 +20914,7 @@ they are not by default assigned to keys. ;;;*** ;;;### (autoloads (plstore-mode plstore-open) "plstore" "gnus/plstore.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20700 11832 779612 0)) ;;; Generated autoloads from gnus/plstore.el (autoload 'plstore-open "plstore" "\ @@ -20872,7 +20930,7 @@ Major mode for editing PLSTORE files. ;;;*** ;;;### (autoloads (po-find-file-coding-system) "po" "textmodes/po.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from textmodes/po.el (autoload 'po-find-file-coding-system "po" "\ @@ -20883,7 +20941,7 @@ Called through `file-coding-system-alist', before the file is visited for real. ;;;*** -;;;### (autoloads (pong) "pong" "play/pong.el" (20707 18685 911514 +;;;### (autoloads (pong) "pong" "play/pong.el" (20478 3673 653810 ;;;;;; 0)) ;;; Generated autoloads from play/pong.el @@ -20900,8 +20958,8 @@ pong-mode keybindings:\\<pong-mode-map> ;;;*** -;;;### (autoloads (pop3-movemail) "pop3" "gnus/pop3.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (pop3-movemail) "pop3" "gnus/pop3.el" (20643 32183 +;;;;;; 554981 0)) ;;; Generated autoloads from gnus/pop3.el (autoload 'pop3-movemail "pop3" "\ @@ -20914,7 +20972,7 @@ Use streaming commands. ;;;### (autoloads (pp-macroexpand-last-sexp pp-eval-last-sexp pp-macroexpand-expression ;;;;;; pp-eval-expression pp pp-buffer pp-to-string) "pp" "emacs-lisp/pp.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20495 51111 757560 0)) ;;; Generated autoloads from emacs-lisp/pp.el (autoload 'pp-to-string "pp" "\ @@ -20982,7 +21040,7 @@ Ignores leading comment characters. ;;;;;; pr-ps-buffer-print pr-ps-buffer-using-ghostscript pr-ps-buffer-preview ;;;;;; pr-ps-directory-ps-print pr-ps-directory-print pr-ps-directory-using-ghostscript ;;;;;; pr-ps-directory-preview pr-interface) "printing" "printing.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20648 50109 802321 0)) ;;; Generated autoloads from printing.el (autoload 'pr-interface "printing" "\ @@ -21569,7 +21627,7 @@ are both set to t. ;;;*** -;;;### (autoloads (proced) "proced" "proced.el" (20707 18685 911514 +;;;### (autoloads (proced) "proced" "proced.el" (20593 22184 581574 ;;;;;; 0)) ;;; Generated autoloads from proced.el @@ -21590,7 +21648,7 @@ Proced buffers. ;;;### (autoloads (profiler-find-profile-other-frame profiler-find-profile-other-window ;;;;;; profiler-find-profile profiler-start) "profiler" "profiler.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20650 54468 205452 950000)) ;;; Generated autoloads from profiler.el (autoload 'profiler-start "profiler" "\ @@ -21619,7 +21677,7 @@ Open profile FILENAME. ;;;*** ;;;### (autoloads (run-prolog mercury-mode prolog-mode) "prolog" -;;;;;; "progmodes/prolog.el" (20707 18685 911514 0)) +;;;;;; "progmodes/prolog.el" (20576 42138 697312 0)) ;;; Generated autoloads from progmodes/prolog.el (autoload 'prolog-mode "prolog" "\ @@ -21654,8 +21712,8 @@ With prefix argument ARG, restart the Prolog process if running before. ;;;*** -;;;### (autoloads (bdf-directory-list) "ps-bdf" "ps-bdf.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (bdf-directory-list) "ps-bdf" "ps-bdf.el" (20652 +;;;;;; 47164 970964 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")) "\ @@ -21666,8 +21724,8 @@ The default value is '(\"/usr/local/share/emacs/fonts/bdf\").") ;;;*** -;;;### (autoloads (ps-mode) "ps-mode" "progmodes/ps-mode.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (ps-mode) "ps-mode" "progmodes/ps-mode.el" (20576 +;;;;;; 42138 697312 0)) ;;; Generated autoloads from progmodes/ps-mode.el (autoload 'ps-mode "ps-mode" "\ @@ -21718,8 +21776,8 @@ Typing \\<ps-run-mode-map>\\[ps-run-goto-error] when the cursor is at the number ;;;;;; ps-spool-region ps-spool-buffer-with-faces ps-spool-buffer ;;;;;; ps-print-region-with-faces ps-print-region ps-print-buffer-with-faces ;;;;;; ps-print-buffer ps-print-customize ps-print-color-p ps-paper-type -;;;;;; ps-page-dimensions-database) "ps-print" "ps-print.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; ps-page-dimensions-database) "ps-print" "ps-print.el" (20566 +;;;;;; 63671 243798 0)) ;;; Generated autoloads from ps-print.el (defvar ps-page-dimensions-database (purecopy (list (list 'a4 (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54) "A4") (list 'a3 (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54) "A3") (list 'letter (* 72 8.5) (* 72 11.0) "Letter") (list 'legal (* 72 8.5) (* 72 14.0) "Legal") (list 'letter-small (* 72 7.68) (* 72 10.16) "LetterSmall") (list 'tabloid (* 72 11.0) (* 72 17.0) "Tabloid") (list 'ledger (* 72 17.0) (* 72 11.0) "Ledger") (list 'statement (* 72 5.5) (* 72 8.5) "Statement") (list 'executive (* 72 7.5) (* 72 10.0) "Executive") (list 'a4small (* 72 7.47) (* 72 10.85) "A4Small") (list 'b4 (* 72 10.125) (* 72 14.33) "B4") (list 'b5 (* 72 7.16) (* 72 10.125) "B5") '(addresslarge 236.0 99.0 "AddressLarge") '(addresssmall 236.0 68.0 "AddressSmall") '(cuthanging13 90.0 222.0 "CutHanging13") '(cuthanging15 90.0 114.0 "CutHanging15") '(diskette 181.0 136.0 "Diskette") '(eurofilefolder 139.0 112.0 "EuropeanFilefolder") '(eurofoldernarrow 526.0 107.0 "EuroFolderNarrow") '(eurofolderwide 526.0 136.0 "EuroFolderWide") '(euronamebadge 189.0 108.0 "EuroNameBadge") '(euronamebadgelarge 223.0 136.0 "EuroNameBadgeLarge") '(filefolder 230.0 37.0 "FileFolder") '(jewelry 76.0 136.0 "Jewelry") '(mediabadge 180.0 136.0 "MediaBadge") '(multipurpose 126.0 68.0 "MultiPurpose") '(retaillabel 90.0 104.0 "RetailLabel") '(shipping 271.0 136.0 "Shipping") '(slide35mm 26.0 104.0 "Slide35mm") '(spine8mm 187.0 26.0 "Spine8mm") '(topcoated 425.19685 136.0 "TopCoatedPaper") '(topcoatedpaper 396.0 136.0 "TopcoatedPaper150") '(vhsface 205.0 127.0 "VHSFace") '(vhsspine 400.0 50.0 "VHSSpine") '(zipdisk 156.0 136.0 "ZipDisk"))) "\ @@ -21916,7 +21974,7 @@ If EXTENSION is any other symbol, it is ignored. ;;;*** ;;;### (autoloads (python-mode run-python) "python" "progmodes/python.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20704 8885 590749 0)) ;;; Generated autoloads from progmodes/python.el (add-to-list 'auto-mode-alist (cons (purecopy "\\.py\\'") 'python-mode)) @@ -21952,7 +22010,7 @@ if that value is non-nil. ;;;*** ;;;### (autoloads (quoted-printable-decode-region) "qp" "gnus/qp.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20557 48712 315579 0)) ;;; Generated autoloads from gnus/qp.el (autoload 'quoted-printable-decode-region "qp" "\ @@ -21975,7 +22033,7 @@ them into characters should be done separately. ;;;;;; quail-defrule quail-install-decode-map quail-install-map ;;;;;; quail-define-rules quail-show-keyboard-layout quail-set-keyboard-layout ;;;;;; quail-define-package quail-use-package quail-title) "quail" -;;;;;; "international/quail.el" (20707 18685 911514 0)) +;;;;;; "international/quail.el" (20523 62082 997685 0)) ;;; Generated autoloads from international/quail.el (autoload 'quail-title "quail" "\ @@ -22206,8 +22264,8 @@ of each directory. ;;;### (autoloads (quickurl-list quickurl-list-mode quickurl-edit-urls ;;;;;; quickurl-browse-url-ask quickurl-browse-url quickurl-add-url -;;;;;; quickurl-ask quickurl) "quickurl" "net/quickurl.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; quickurl-ask quickurl) "quickurl" "net/quickurl.el" (20566 +;;;;;; 63671 243798 0)) ;;; Generated autoloads from net/quickurl.el (defconst quickurl-reread-hook-postfix "\n;; Local Variables:\n;; eval: (progn (require 'quickurl) (add-hook 'local-write-file-hooks (lambda () (quickurl-read) nil)))\n;; End:\n" "\ @@ -22279,7 +22337,7 @@ Display `quickurl-list' as a formatted list using `quickurl-list-mode'. ;;;*** ;;;### (autoloads (rcirc-track-minor-mode rcirc-connect rcirc) "rcirc" -;;;;;; "net/rcirc.el" (20707 18685 911514 0)) +;;;;;; "net/rcirc.el" (20679 5689 779225 0)) ;;; Generated autoloads from net/rcirc.el (autoload 'rcirc "rcirc" "\ @@ -22317,8 +22375,8 @@ if ARG is omitted or nil. ;;;*** -;;;### (autoloads (remote-compile) "rcompile" "net/rcompile.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (remote-compile) "rcompile" "net/rcompile.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from net/rcompile.el (autoload 'remote-compile "rcompile" "\ @@ -22330,7 +22388,7 @@ See \\[compile]. ;;;*** ;;;### (autoloads (re-builder) "re-builder" "emacs-lisp/re-builder.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20427 14766 970343 0)) ;;; Generated autoloads from emacs-lisp/re-builder.el (defalias 'regexp-builder 're-builder) @@ -22348,8 +22406,8 @@ matching parts of the target buffer will be highlighted. ;;;*** -;;;### (autoloads (recentf-mode) "recentf" "recentf.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (recentf-mode) "recentf" "recentf.el" (20356 2211 +;;;;;; 532900 0)) ;;; Generated autoloads from recentf.el (defvar recentf-mode nil "\ @@ -22379,7 +22437,7 @@ were operated on recently. ;;;;;; string-rectangle delete-whitespace-rectangle open-rectangle ;;;;;; insert-rectangle yank-rectangle copy-rectangle-as-kill kill-rectangle ;;;;;; extract-rectangle delete-extract-rectangle delete-rectangle) -;;;;;; "rect" "rect.el" (20707 18685 911514 0)) +;;;;;; "rect" "rect.el" (20501 3499 284800 0)) ;;; Generated autoloads from rect.el (autoload 'delete-rectangle "rect" "\ @@ -22513,8 +22571,8 @@ with a prefix argument, prompt for START-AT and FORMAT. ;;;*** -;;;### (autoloads (refill-mode) "refill" "textmodes/refill.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (refill-mode) "refill" "textmodes/refill.el" (20478 +;;;;;; 3673 653810 0)) ;;; Generated autoloads from textmodes/refill.el (autoload 'refill-mode "refill" "\ @@ -22535,8 +22593,8 @@ For true \"word wrap\" behavior, use `visual-line-mode' instead. ;;;*** ;;;### (autoloads (reftex-reset-scanning-information reftex-mode -;;;;;; turn-on-reftex) "reftex" "textmodes/reftex.el" (20707 18685 -;;;;;; 911514 0)) +;;;;;; turn-on-reftex) "reftex" "textmodes/reftex.el" (20657 65077 +;;;;;; 880084 0)) ;;; Generated autoloads from textmodes/reftex.el (autoload 'turn-on-reftex "reftex" "\ @@ -22586,7 +22644,7 @@ This enforces rescanning the buffer on next use. ;;;*** ;;;### (autoloads (reftex-citation) "reftex-cite" "textmodes/reftex-cite.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20585 28088 480237 0)) ;;; Generated autoloads from textmodes/reftex-cite.el (autoload 'reftex-citation "reftex-cite" "\ @@ -22616,7 +22674,7 @@ While entering the regexp, completion on knows citation keys is possible. ;;;*** ;;;### (autoloads (reftex-isearch-minor-mode) "reftex-global" "textmodes/reftex-global.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20585 28088 480237 0)) ;;; Generated autoloads from textmodes/reftex-global.el (autoload 'reftex-isearch-minor-mode "reftex-global" "\ @@ -22633,7 +22691,7 @@ With no argument, this command toggles ;;;*** ;;;### (autoloads (reftex-index-phrases-mode) "reftex-index" "textmodes/reftex-index.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20585 28088 480237 0)) ;;; Generated autoloads from textmodes/reftex-index.el (autoload 'reftex-index-phrases-mode "reftex-index" "\ @@ -22666,7 +22724,7 @@ Here are all local bindings. ;;;*** ;;;### (autoloads (reftex-all-document-files) "reftex-parse" "textmodes/reftex-parse.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20657 65077 880084 0)) ;;; Generated autoloads from textmodes/reftex-parse.el (autoload 'reftex-all-document-files "reftex-parse" "\ @@ -22678,8 +22736,8 @@ of master file. ;;;*** -;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (20593 +;;;;;; 22184 581574 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)))) @@ -22689,7 +22747,7 @@ of master file. ;;;*** ;;;### (autoloads (regexp-opt-depth regexp-opt) "regexp-opt" "emacs-lisp/regexp-opt.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20522 38650 757441 0)) ;;; Generated autoloads from emacs-lisp/regexp-opt.el (autoload 'regexp-opt "regexp-opt" "\ @@ -22720,7 +22778,7 @@ This means the number of non-shy regexp grouping constructs ;;;### (autoloads (remember-diary-extract-entries remember-clipboard ;;;;;; remember-other-frame remember) "remember" "textmodes/remember.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from textmodes/remember.el (autoload 'remember "remember" "\ @@ -22751,7 +22809,7 @@ Extract diary entries from the region. ;;;*** -;;;### (autoloads (repeat) "repeat" "repeat.el" (20707 18685 911514 +;;;### (autoloads (repeat) "repeat" "repeat.el" (20614 54428 654267 ;;;;;; 0)) ;;; Generated autoloads from repeat.el @@ -22775,7 +22833,7 @@ recently executed command not bound to an input event\". ;;;*** ;;;### (autoloads (reporter-submit-bug-report) "reporter" "mail/reporter.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from mail/reporter.el (autoload 'reporter-submit-bug-report "reporter" "\ @@ -22807,7 +22865,7 @@ mail-sending package is used for editing and sending the message. ;;;*** ;;;### (autoloads (reposition-window) "reposition" "reposition.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from reposition.el (autoload 'reposition-window "reposition" "\ @@ -22834,7 +22892,7 @@ first comment line visible (if point is in a comment). ;;;*** ;;;### (autoloads (global-reveal-mode reveal-mode) "reveal" "reveal.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from reveal.el (autoload 'reveal-mode "reveal" "\ @@ -22870,7 +22928,7 @@ the mode if ARG is omitted or nil. ;;;*** ;;;### (autoloads (make-ring ring-p) "ring" "emacs-lisp/ring.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from emacs-lisp/ring.el (autoload 'ring-p "ring" "\ @@ -22885,8 +22943,8 @@ Make a ring that can contain SIZE elements. ;;;*** -;;;### (autoloads (rlogin) "rlogin" "net/rlogin.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (rlogin) "rlogin" "net/rlogin.el" (20402 11562 +;;;;;; 85788 0)) ;;; Generated autoloads from net/rlogin.el (autoload 'rlogin "rlogin" "\ @@ -22935,7 +22993,7 @@ variable. ;;;;;; rmail-secondary-file-directory rmail-primary-inbox-list rmail-highlighted-headers ;;;;;; rmail-retry-ignored-headers rmail-displayed-headers rmail-ignored-headers ;;;;;; rmail-user-mail-address-regexp rmail-movemail-variant-p rmail-spool-directory -;;;;;; rmail-file-name) "rmail" "mail/rmail.el" (20709 57006 458286 +;;;;;; rmail-file-name) "rmail" "mail/rmail.el" (20706 50624 612201 ;;;;;; 0)) ;;; Generated autoloads from mail/rmail.el @@ -23134,8 +23192,8 @@ Set PASSWORD to be used for retrieving mail from a POP or IMAP server. ;;;*** ;;;### (autoloads (rmail-output-body-to-file rmail-output-as-seen -;;;;;; rmail-output) "rmailout" "mail/rmailout.el" (20707 18685 -;;;;;; 911514 0)) +;;;;;; rmail-output) "rmailout" "mail/rmailout.el" (20530 3765 184907 +;;;;;; 0)) ;;; Generated autoloads from mail/rmailout.el (put 'rmail-output-file-alist 'risky-local-variable t) @@ -23200,7 +23258,7 @@ than appending to it. Deletes the message after writing if ;;;*** ;;;### (autoloads (rng-c-load-schema) "rng-cmpct" "nxml/rng-cmpct.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from nxml/rng-cmpct.el (autoload 'rng-c-load-schema "rng-cmpct" "\ @@ -23212,7 +23270,7 @@ Return a pattern. ;;;*** ;;;### (autoloads (rng-nxml-mode-init) "rng-nxml" "nxml/rng-nxml.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from nxml/rng-nxml.el (autoload 'rng-nxml-mode-init "rng-nxml" "\ @@ -23225,7 +23283,7 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil. ;;;*** ;;;### (autoloads (rng-validate-mode) "rng-valid" "nxml/rng-valid.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from nxml/rng-valid.el (autoload 'rng-validate-mode "rng-valid" "\ @@ -23255,8 +23313,8 @@ to use for finding the schema. ;;;*** -;;;### (autoloads (rng-xsd-compile) "rng-xsd" "nxml/rng-xsd.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (rng-xsd-compile) "rng-xsd" "nxml/rng-xsd.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from nxml/rng-xsd.el (put 'http://www\.w3\.org/2001/XMLSchema-datatypes 'rng-dt-compile 'rng-xsd-compile) @@ -23284,7 +23342,7 @@ must be equal. ;;;*** ;;;### (autoloads (robin-use-package robin-modify-package robin-define-package) -;;;;;; "robin" "international/robin.el" (20627 28531 447943 0)) +;;;;;; "robin" "international/robin.el" (20523 62082 997685 0)) ;;; Generated autoloads from international/robin.el (autoload 'robin-define-package "robin" "\ @@ -23317,7 +23375,7 @@ Start using robin package NAME, which is a string. ;;;*** ;;;### (autoloads (toggle-rot13-mode rot13-other-window rot13-region -;;;;;; rot13-string rot13) "rot13" "rot13.el" (20707 18685 911514 +;;;;;; rot13-string rot13) "rot13" "rot13.el" (20355 10021 546955 ;;;;;; 0)) ;;; Generated autoloads from rot13.el @@ -23356,7 +23414,7 @@ Toggle the use of ROT13 encoding for the current window. ;;;*** ;;;### (autoloads (rst-minor-mode rst-mode) "rst" "textmodes/rst.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20594 43050 277913 0)) ;;; Generated autoloads from textmodes/rst.el (add-to-list 'auto-mode-alist (purecopy '("\\.re?st\\'" . rst-mode))) @@ -23387,7 +23445,7 @@ for modes derived from Text mode, like Mail mode. ;;;*** ;;;### (autoloads (ruby-mode) "ruby-mode" "progmodes/ruby-mode.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20700 11832 779612 0)) ;;; Generated autoloads from progmodes/ruby-mode.el (autoload 'ruby-mode "ruby-mode" "\ @@ -23404,12 +23462,16 @@ The variable `ruby-indent-level' controls the amount of indentation. (add-to-list 'auto-mode-alist (cons (purecopy "\\.rb\\'") 'ruby-mode)) +(add-to-list 'auto-mode-alist (cons (purecopy "Rakefile\\'") 'ruby-mode)) + +(add-to-list 'auto-mode-alist (cons (purecopy "\\.gemspec\\'") 'ruby-mode)) + (dolist (name (list "ruby" "rbx" "jruby" "ruby1.9" "ruby1.8")) (add-to-list 'interpreter-mode-alist (cons (purecopy name) 'ruby-mode))) ;;;*** -;;;### (autoloads (ruler-mode) "ruler-mode" "ruler-mode.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (ruler-mode) "ruler-mode" "ruler-mode.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from ruler-mode.el (defvar ruler-mode nil "\ @@ -23426,8 +23488,8 @@ if ARG is omitted or nil. ;;;*** -;;;### (autoloads (rx rx-to-string) "rx" "emacs-lisp/rx.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (rx rx-to-string) "rx" "emacs-lisp/rx.el" (20518 +;;;;;; 12580 46478 0)) ;;; Generated autoloads from emacs-lisp/rx.el (autoload 'rx-to-string "rx" "\ @@ -23738,8 +23800,8 @@ enclosed in `(and ...)'. ;;;*** -;;;### (autoloads (savehist-mode) "savehist" "savehist.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (savehist-mode) "savehist" "savehist.el" (20577 +;;;;;; 33959 40183 0)) ;;; Generated autoloads from savehist.el (defvar savehist-mode nil "\ @@ -23771,7 +23833,7 @@ histories, which is probably undesirable. ;;;*** ;;;### (autoloads (dsssl-mode scheme-mode) "scheme" "progmodes/scheme.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20665 59189 799105 0)) ;;; Generated autoloads from progmodes/scheme.el (autoload 'scheme-mode "scheme" "\ @@ -23813,7 +23875,7 @@ that variable's value is a string. ;;;*** ;;;### (autoloads (gnus-score-mode) "score-mode" "gnus/score-mode.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from gnus/score-mode.el (autoload 'gnus-score-mode "score-mode" "\ @@ -23827,7 +23889,7 @@ This mode is an extended emacs-lisp mode. ;;;*** ;;;### (autoloads (scroll-all-mode) "scroll-all" "scroll-all.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20363 61861 222722 0)) ;;; Generated autoloads from scroll-all.el (defvar scroll-all-mode nil "\ @@ -23853,7 +23915,7 @@ one window apply to all visible windows in the same frame. ;;;*** ;;;### (autoloads (scroll-lock-mode) "scroll-lock" "scroll-lock.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from scroll-lock.el (autoload 'scroll-lock-mode "scroll-lock" "\ @@ -23869,7 +23931,7 @@ vertically fixed relative to window boundaries during scrolling. ;;;*** -;;;### (autoloads nil "secrets" "net/secrets.el" (20707 18685 911514 +;;;### (autoloads nil "secrets" "net/secrets.el" (20478 3673 653810 ;;;;;; 0)) ;;; Generated autoloads from net/secrets.el (when (featurep 'dbusbind) @@ -23878,7 +23940,7 @@ vertically fixed relative to window boundaries during scrolling. ;;;*** ;;;### (autoloads (semantic-mode semantic-default-submodes) "semantic" -;;;;;; "cedet/semantic.el" (20707 18685 911514 0)) +;;;;;; "cedet/semantic.el" (20617 41641 89638 0)) ;;; Generated autoloads from cedet/semantic.el (defvar semantic-default-submodes '(global-semantic-idle-scheduler-mode global-semanticdb-minor-mode) "\ @@ -23935,7 +23997,7 @@ Semantic mode. ;;;*** ;;;### (autoloads (bovine-grammar-mode) "semantic/bovine/grammar" -;;;;;; "cedet/semantic/bovine/grammar.el" (20707 18685 911514 0)) +;;;;;; "cedet/semantic/bovine/grammar.el" (20593 22184 581574 0)) ;;; Generated autoloads from cedet/semantic/bovine/grammar.el (autoload 'bovine-grammar-mode "semantic/bovine/grammar" "\ @@ -23946,7 +24008,7 @@ Major mode for editing Bovine grammars. ;;;*** ;;;### (autoloads (wisent-grammar-mode) "semantic/wisent/grammar" -;;;;;; "cedet/semantic/wisent/grammar.el" (20707 18685 911514 0)) +;;;;;; "cedet/semantic/wisent/grammar.el" (20593 22184 581574 0)) ;;; Generated autoloads from cedet/semantic/wisent/grammar.el (autoload 'wisent-grammar-mode "semantic/wisent/grammar" "\ @@ -23964,7 +24026,7 @@ Major mode for editing Wisent grammars. ;;;;;; mail-personal-alias-file mail-default-reply-to mail-archive-file-name ;;;;;; mail-header-separator send-mail-function mail-interactive ;;;;;; mail-self-blind mail-specify-envelope-from mail-from-style) -;;;;;; "sendmail" "mail/sendmail.el" (20707 18685 911514 0)) +;;;;;; "sendmail" "mail/sendmail.el" (20614 54428 654267 0)) ;;; Generated autoloads from mail/sendmail.el (defvar mail-from-style 'default "\ @@ -24246,8 +24308,8 @@ Like `mail' command, but display mail buffer in another frame. ;;;*** ;;;### (autoloads (server-save-buffers-kill-terminal server-mode -;;;;;; server-force-delete server-start) "server" "server.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; server-force-delete server-start) "server" "server.el" (20697 +;;;;;; 35643 276642 0)) ;;; Generated autoloads from server.el (put 'server-host 'risky-local-variable t) @@ -24314,7 +24376,7 @@ only these files will be asked to be saved. ;;;*** -;;;### (autoloads (ses-mode) "ses" "ses.el" (20707 18685 911514 0)) +;;;### (autoloads (ses-mode) "ses" "ses.el" (20673 53308 39372 0)) ;;; Generated autoloads from ses.el (autoload 'ses-mode "ses" "\ @@ -24333,7 +24395,7 @@ These are active only in the minibuffer, when entering or editing a formula: ;;;*** ;;;### (autoloads (html-mode sgml-mode) "sgml-mode" "textmodes/sgml-mode.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20665 59189 799105 0)) ;;; Generated autoloads from textmodes/sgml-mode.el (autoload 'sgml-mode "sgml-mode" "\ @@ -24399,7 +24461,7 @@ To work around that, do: ;;;*** ;;;### (autoloads (sh-mode) "sh-script" "progmodes/sh-script.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20665 59189 799105 0)) ;;; Generated autoloads from progmodes/sh-script.el (put 'sh-shell 'safe-local-variable 'symbolp) @@ -24463,7 +24525,7 @@ with your script for an edit-interpret-debug cycle. ;;;*** ;;;### (autoloads (list-load-path-shadows) "shadow" "emacs-lisp/shadow.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20572 16038 402143 0)) ;;; Generated autoloads from emacs-lisp/shadow.el (autoload 'list-load-path-shadows "shadow" "\ @@ -24513,8 +24575,8 @@ function, `load-path-shadows-find'. ;;;*** ;;;### (autoloads (shadow-initialize shadow-define-regexp-group shadow-define-literal-group -;;;;;; shadow-define-cluster) "shadowfile" "shadowfile.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; shadow-define-cluster) "shadowfile" "shadowfile.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from shadowfile.el (autoload 'shadow-define-cluster "shadowfile" "\ @@ -24553,7 +24615,7 @@ Set up file shadowing. ;;;*** ;;;### (autoloads (shell shell-dumb-shell-regexp) "shell" "shell.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20664 38325 385623 0)) ;;; Generated autoloads from shell.el (defvar shell-dumb-shell-regexp (purecopy "cmd\\(proxy\\)?\\.exe") "\ @@ -24601,8 +24663,8 @@ Otherwise, one argument `-i' is passed to the shell. ;;;*** -;;;### (autoloads (shr-insert-document) "shr" "gnus/shr.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (shr-insert-document) "shr" "gnus/shr.el" (20698 +;;;;;; 56506 332830 0)) ;;; Generated autoloads from gnus/shr.el (autoload 'shr-insert-document "shr" "\ @@ -24615,7 +24677,7 @@ DOM should be a parse tree as generated by ;;;*** ;;;### (autoloads (sieve-upload-and-kill sieve-upload-and-bury sieve-upload -;;;;;; sieve-manage) "sieve" "gnus/sieve.el" (20707 18685 911514 +;;;;;; sieve-manage) "sieve" "gnus/sieve.el" (20487 57003 603251 ;;;;;; 0)) ;;; Generated autoloads from gnus/sieve.el @@ -24642,7 +24704,7 @@ DOM should be a parse tree as generated by ;;;*** ;;;### (autoloads (sieve-mode) "sieve-mode" "gnus/sieve-mode.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20683 2742 588278 0)) ;;; Generated autoloads from gnus/sieve-mode.el (autoload 'sieve-mode "sieve-mode" "\ @@ -24657,8 +24719,8 @@ Turning on Sieve mode runs `sieve-mode-hook'. ;;;*** -;;;### (autoloads (simula-mode) "simula" "progmodes/simula.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (simula-mode) "simula" "progmodes/simula.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from progmodes/simula.el (autoload 'simula-mode "simula" "\ @@ -24707,7 +24769,7 @@ with no arguments, if that value is non-nil. ;;;*** ;;;### (autoloads (skeleton-pair-insert-maybe skeleton-insert skeleton-proxy-new -;;;;;; define-skeleton) "skeleton" "skeleton.el" (20707 18685 911514 +;;;;;; define-skeleton) "skeleton" "skeleton.el" (20541 6907 775259 ;;;;;; 0)) ;;; Generated autoloads from skeleton.el @@ -24820,7 +24882,7 @@ symmetrical ones, and the same character twice for the others. ;;;*** ;;;### (autoloads (smerge-start-session smerge-mode smerge-ediff) -;;;;;; "smerge-mode" "vc/smerge-mode.el" (20707 18685 911514 0)) +;;;;;; "smerge-mode" "vc/smerge-mode.el" (20585 28088 480237 0)) ;;; Generated autoloads from vc/smerge-mode.el (autoload 'smerge-ediff "smerge-mode" "\ @@ -24848,7 +24910,7 @@ If no conflict maker is found, turn off `smerge-mode'. ;;;*** ;;;### (autoloads (smiley-buffer smiley-region) "smiley" "gnus/smiley.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from gnus/smiley.el (autoload 'smiley-region "smiley" "\ @@ -24866,7 +24928,7 @@ interactively. If there's no argument, do it at the current buffer. ;;;*** ;;;### (autoloads (smtpmail-send-queued-mail smtpmail-send-it) "smtpmail" -;;;;;; "mail/smtpmail.el" (20707 18685 911514 0)) +;;;;;; "mail/smtpmail.el" (20697 35643 276642 0)) ;;; Generated autoloads from mail/smtpmail.el (autoload 'smtpmail-send-it "smtpmail" "\ @@ -24881,7 +24943,7 @@ Send mail that was queued as a result of setting `smtpmail-queue-mail'. ;;;*** -;;;### (autoloads (snake) "snake" "play/snake.el" (20707 18685 911514 +;;;### (autoloads (snake) "snake" "play/snake.el" (20478 3673 653810 ;;;;;; 0)) ;;; Generated autoloads from play/snake.el @@ -24906,7 +24968,7 @@ Snake mode keybindings: ;;;*** ;;;### (autoloads (snmpv2-mode snmp-mode) "snmp-mode" "net/snmp-mode.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20577 33959 40183 0)) ;;; Generated autoloads from net/snmp-mode.el (autoload 'snmp-mode "snmp-mode" "\ @@ -24935,8 +24997,8 @@ then `snmpv2-mode-hook'. ;;;*** -;;;### (autoloads (sunrise-sunset) "solar" "calendar/solar.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (sunrise-sunset) "solar" "calendar/solar.el" (20566 +;;;;;; 63671 243798 0)) ;;; Generated autoloads from calendar/solar.el (autoload 'sunrise-sunset "solar" "\ @@ -24951,8 +25013,8 @@ This function is suitable for execution in an init file. ;;;*** -;;;### (autoloads (solitaire) "solitaire" "play/solitaire.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (solitaire) "solitaire" "play/solitaire.el" (20427 +;;;;;; 14766 970343 0)) ;;; Generated autoloads from play/solitaire.el (autoload 'solitaire "solitaire" "\ @@ -25027,10 +25089,10 @@ Pick your favorite shortcuts: ;;;*** -;;;### (autoloads (reverse-region sort-columns sort-regexp-fields -;;;;;; sort-fields sort-numeric-fields sort-pages sort-paragraphs -;;;;;; sort-lines sort-subr) "sort" "sort.el" (20707 18685 911514 -;;;;;; 0)) +;;;### (autoloads (delete-duplicate-lines reverse-region sort-columns +;;;;;; sort-regexp-fields sort-fields sort-numeric-fields sort-pages +;;;;;; sort-paragraphs sort-lines sort-subr) "sort" "sort.el" (20693 +;;;;;; 38586 665915 0)) ;;; Generated autoloads from sort.el (put 'sort-fold-case 'safe-local-variable 'booleanp) @@ -25182,10 +25244,30 @@ From a program takes two point or marker arguments, BEG and END. \(fn BEG END)" t nil) +(autoload 'delete-duplicate-lines "sort" "\ +Delete duplicate lines in the region between BEG and END. + +If REVERSE is nil, search and delete duplicates forward keeping the first +occurrence of duplicate lines. If REVERSE is non-nil (when called +interactively with C-u prefix), search and delete duplicates backward +keeping the last occurrence of duplicate lines. + +If ADJACENT is non-nil (when called interactively with two C-u prefixes), +delete repeated lines only if they are adjacent. It works like the utility +`uniq' and is useful when lines are already sorted in a large file since +this is more efficient in performance and memory usage than when ADJACENT +is nil that uses additional memory to remember previous lines. + +When called from Lisp and INTERACTIVE is omitted or nil, return the number +of deleted duplicate lines, do not print it; if INTERACTIVE is t, the +function behaves in all respects as if it had been called interactively. + +\(fn BEG END &optional REVERSE ADJACENT INTERACTIVE)" t nil) + ;;;*** -;;;### (autoloads (spam-initialize) "spam" "gnus/spam.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (spam-initialize) "spam" "gnus/spam.el" (20672 +;;;;;; 32446 100992 0)) ;;; Generated autoloads from gnus/spam.el (autoload 'spam-initialize "spam" "\ @@ -25201,7 +25283,7 @@ installed through `spam-necessary-extra-headers'. ;;;### (autoloads (spam-report-deagentize spam-report-agentize spam-report-url-to-file ;;;;;; spam-report-url-ping-mm-url spam-report-process-queue) "spam-report" -;;;;;; "gnus/spam-report.el" (20707 18685 911514 0)) +;;;;;; "gnus/spam-report.el" (20355 10021 546955 0)) ;;; Generated autoloads from gnus/spam-report.el (autoload 'spam-report-process-queue "spam-report" "\ @@ -25244,7 +25326,7 @@ Spam reports will be queued with the method used when ;;;*** ;;;### (autoloads (speedbar-get-focus speedbar-frame-mode) "speedbar" -;;;;;; "speedbar.el" (20707 18685 911514 0)) +;;;;;; "speedbar.el" (20648 50109 802321 0)) ;;; Generated autoloads from speedbar.el (defalias 'speedbar 'speedbar-frame-mode) @@ -25268,8 +25350,8 @@ selected. If the speedbar frame is active, then select the attached frame. ;;;*** -;;;### (autoloads (snarf-spooks spook) "spook" "play/spook.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (snarf-spooks spook) "spook" "play/spook.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from play/spook.el (autoload 'spook "spook" "\ @@ -25287,8 +25369,8 @@ Return a vector containing the lines from `spook-phrases-file'. ;;;### (autoloads (sql-linter sql-db2 sql-interbase sql-postgres ;;;;;; sql-ms sql-ingres sql-solid sql-mysql sql-sqlite sql-informix ;;;;;; sql-sybase sql-oracle sql-product-interactive sql-connect -;;;;;; sql-mode sql-help sql-add-product-keywords) "sql" "progmodes/sql.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; sql-mode sql-add-product-keywords) "sql" "progmodes/sql.el" +;;;;;; (20683 39246 740032 0)) ;;; Generated autoloads from progmodes/sql.el (autoload 'sql-add-product-keywords "sql" "\ @@ -25312,40 +25394,7 @@ adds a fontification pattern to fontify identifiers ending in \(fn PRODUCT KEYWORDS &optional APPEND)" nil nil) -(autoload 'sql-help "sql" "\ -Show short help for the SQL modes. - -Use an entry function to open an interactive SQL buffer. This buffer is -usually named `*SQL*'. The name of the major mode is SQLi. - -Use the following commands to start a specific SQL interpreter: - - \\\\FREE - -Other non-free SQL implementations are also supported: - - \\\\NONFREE - -But we urge you to choose a free implementation instead of these. - -You can also use \\[sql-product-interactive] to invoke the -interpreter for the current `sql-product'. - -Once you have the SQLi buffer, you can enter SQL statements in the -buffer. The output generated is appended to the buffer and a new prompt -is generated. See the In/Out menu in the SQLi buffer for some functions -that help you navigate through the buffer, the input history, etc. - -If you have a really complex SQL statement or if you are writing a -procedure, you can do this in a separate buffer. Put the new buffer in -`sql-mode' by calling \\[sql-mode]. The name of this buffer can be -anything. The name of the major mode is SQL. - -In this SQL buffer (SQL mode), you can send the region or the entire -buffer to the interactive SQL buffer (SQLi mode). The results are -appended to the SQLi buffer without disturbing your SQL buffer. - -\(fn)" t nil) +(eval '(defun sql-help nil #("Show short help for the SQL modes.\n\nUse an entry function to open an interactive SQL buffer. This buffer is\nusually named `*SQL*'. The name of the major mode is SQLi.\n\nUse the following commands to start a specific SQL interpreter:\n\n \\\\FREE\n\nOther non-free SQL implementations are also supported:\n\n \\\\NONFREE\n\nBut we urge you to choose a free implementation instead of these.\n\nYou can also use \\[sql-product-interactive] to invoke the\ninterpreter for the current `sql-product'.\n\nOnce you have the SQLi buffer, you can enter SQL statements in the\nbuffer. The output generated is appended to the buffer and a new prompt\nis generated. See the In/Out menu in the SQLi buffer for some functions\nthat help you navigate through the buffer, the input history, etc.\n\nIf you have a really complex SQL statement or if you are writing a\nprocedure, you can do this in a separate buffer. Put the new buffer in\n`sql-mode' by calling \\[sql-mode]. The name of this buffer can be\nanything. The name of the major mode is SQL.\n\nIn this SQL buffer (SQL mode), you can send the region or the entire\nbuffer to the interactive SQL buffer (SQLi mode). The results are\nappended to the SQLi buffer without disturbing your SQL buffer." 0 1 (dynamic-docstring-function sql--make-help-docstring)) (interactive) (describe-function 'sql-help))) (autoload 'sql-mode "sql" "\ Major mode to edit SQL. @@ -25784,7 +25833,7 @@ buffer. ;;;*** ;;;### (autoloads (srecode-template-mode) "srecode/srt-mode" "cedet/srecode/srt-mode.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20642 11326 759953 0)) ;;; Generated autoloads from cedet/srecode/srt-mode.el (autoload 'srecode-template-mode "srecode/srt-mode" "\ @@ -25797,7 +25846,7 @@ Major-mode for writing SRecode macros. ;;;*** ;;;### (autoloads (starttls-open-stream) "starttls" "gnus/starttls.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20606 34222 123795 0)) ;;; Generated autoloads from gnus/starttls.el (autoload 'starttls-open-stream "starttls" "\ @@ -25824,8 +25873,8 @@ GnuTLS requires a port number. ;;;;;; strokes-mode strokes-list-strokes strokes-load-user-strokes ;;;;;; strokes-help strokes-describe-stroke strokes-do-complex-stroke ;;;;;; strokes-do-stroke strokes-read-complex-stroke strokes-read-stroke -;;;;;; strokes-global-set-stroke) "strokes" "strokes.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; strokes-global-set-stroke) "strokes" "strokes.el" (20593 +;;;;;; 22184 581574 0)) ;;; Generated autoloads from strokes.el (autoload 'strokes-global-set-stroke "strokes" "\ @@ -25939,7 +25988,7 @@ Read a complex stroke and insert its glyph into the current buffer. ;;;*** ;;;### (autoloads (studlify-buffer studlify-word studlify-region) -;;;;;; "studly" "play/studly.el" (20360 54279 565993 0)) +;;;;;; "studly" "play/studly.el" (20355 10021 546955 0)) ;;; Generated autoloads from play/studly.el (autoload 'studlify-region "studly" "\ @@ -25960,7 +26009,7 @@ Studlify-case the current buffer. ;;;*** ;;;### (autoloads (global-subword-mode subword-mode) "subword" "progmodes/subword.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20524 51365 2559 0)) ;;; Generated autoloads from progmodes/subword.el (autoload 'subword-mode "subword" "\ @@ -26016,7 +26065,7 @@ See `subword-mode' for more information on Subword mode. ;;;*** ;;;### (autoloads (sc-cite-original) "supercite" "mail/supercite.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20576 42138 697312 0)) ;;; Generated autoloads from mail/supercite.el (autoload 'sc-cite-original "supercite" "\ @@ -26048,8 +26097,8 @@ and `sc-post-hook' is run after the guts of this function. ;;;*** -;;;### (autoloads (gpm-mouse-mode) "t-mouse" "t-mouse.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (gpm-mouse-mode) "t-mouse" "t-mouse.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from t-mouse.el (define-obsolete-function-alias 't-mouse-mode 'gpm-mouse-mode "23.1") @@ -26077,8 +26126,8 @@ It relies on the `gpm' daemon being activated. ;;;*** -;;;### (autoloads (tabify untabify) "tabify" "tabify.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (tabify untabify) "tabify" "tabify.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from tabify.el (autoload 'untabify "tabify" "\ @@ -26113,7 +26162,7 @@ The variable `tab-width' controls the spacing of tab stops. ;;;;;; table-recognize table-insert-row-column table-insert-column ;;;;;; table-insert-row table-insert table-point-left-cell-hook ;;;;;; table-point-entered-cell-hook table-load-hook table-cell-map-hook) -;;;;;; "table" "textmodes/table.el" (20707 18685 911514 0)) +;;;;;; "table" "textmodes/table.el" (20660 41272 835092 0)) ;;; Generated autoloads from textmodes/table.el (defvar table-cell-map-hook nil "\ @@ -26705,8 +26754,8 @@ converts a table into plain text without frames. It is a companion to ;;;*** -;;;### (autoloads (talk talk-connect) "talk" "talk.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (talk talk-connect) "talk" "talk.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from talk.el (autoload 'talk-connect "talk" "\ @@ -26721,8 +26770,8 @@ Connect to the Emacs talk group from the current X display or tty frame. ;;;*** -;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (20585 28088 +;;;;;; 480237 0)) ;;; Generated autoloads from tar-mode.el (autoload 'tar-mode "tar-mode" "\ @@ -26746,7 +26795,7 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. ;;;*** ;;;### (autoloads (tcl-help-on-word inferior-tcl tcl-mode) "tcl" -;;;;;; "progmodes/tcl.el" (20707 18685 911514 0)) +;;;;;; "progmodes/tcl.el" (20580 10161 446444 0)) ;;; Generated autoloads from progmodes/tcl.el (autoload 'tcl-mode "tcl" "\ @@ -26794,8 +26843,8 @@ Prefix argument means invert sense of `tcl-use-smart-word-finder'. ;;;*** -;;;### (autoloads (rsh telnet) "telnet" "net/telnet.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (rsh telnet) "telnet" "net/telnet.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from net/telnet.el (autoload 'telnet "telnet" "\ @@ -26821,7 +26870,7 @@ Normally input is edited in Emacs and sent a line at a time. ;;;*** ;;;### (autoloads (serial-term ansi-term term make-term) "term" "term.el" -;;;;;; (20709 10021 126382 806000)) +;;;;;; (20648 50109 802321 0)) ;;; Generated autoloads from term.el (autoload 'make-term "term" "\ @@ -26863,45 +26912,8 @@ use in that buffer. ;;;*** -;;;### (autoloads (terminal-emulator) "terminal" "terminal.el" (20707 -;;;;;; 18685 911514 0)) -;;; Generated autoloads from terminal.el - -(autoload 'terminal-emulator "terminal" "\ -Under a display-terminal emulator in BUFFER, run PROGRAM on arguments ARGS. -ARGS is a list of argument-strings. Remaining arguments are WIDTH and HEIGHT. -BUFFER's contents are made an image of the display generated by that program, -and any input typed when BUFFER is the current Emacs buffer is sent to that -program as keyboard input. - -Interactively, BUFFER defaults to \"*terminal*\" and PROGRAM and ARGS -are parsed from an input-string using your usual shell. -WIDTH and HEIGHT are determined from the size of the current window --- WIDTH will be one less than the window's width, HEIGHT will be its height. - -To switch buffers and leave the emulator, or to give commands -to the emulator itself (as opposed to the program running under it), -type Control-^. The following character is an emulator command. -Type Control-^ twice to send it to the subprogram. -This escape character may be changed using the variable `terminal-escape-char'. - -`Meta' characters may not currently be sent through the terminal emulator. - -Here is a list of some of the variables which control the behavior -of the emulator -- see their documentation for more information: -terminal-escape-char, terminal-scrolling, terminal-more-processing, -terminal-redisplay-interval. - -This function calls the value of terminal-mode-hook if that exists -and is non-nil after the terminal buffer has been set up and the -subprocess started. - -\(fn BUFFER PROGRAM ARGS &optional WIDTH HEIGHT)" t nil) - -;;;*** - ;;;### (autoloads (testcover-this-defun) "testcover" "emacs-lisp/testcover.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20580 10161 446444 0)) ;;; Generated autoloads from emacs-lisp/testcover.el (autoload 'testcover-this-defun "testcover" "\ @@ -26911,8 +26923,8 @@ Start coverage on function under point. ;;;*** -;;;### (autoloads (tetris) "tetris" "play/tetris.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (tetris) "tetris" "play/tetris.el" (20545 57511 +;;;;;; 257469 0)) ;;; Generated autoloads from play/tetris.el (autoload 'tetris "tetris" "\ @@ -26943,7 +26955,7 @@ tetris-mode keybindings: ;;;;;; tex-start-commands tex-start-options slitex-run-command latex-run-command ;;;;;; tex-run-command tex-offer-save tex-main-file tex-first-line-header-regexp ;;;;;; tex-directory tex-shell-file-name) "tex-mode" "textmodes/tex-mode.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20665 59189 799105 0)) ;;; Generated autoloads from textmodes/tex-mode.el (defvar tex-shell-file-name nil "\ @@ -27245,7 +27257,7 @@ Major mode to edit DocTeX files. ;;;*** ;;;### (autoloads (texi2info texinfo-format-region texinfo-format-buffer) -;;;;;; "texinfmt" "textmodes/texinfmt.el" (20707 18685 911514 0)) +;;;;;; "texinfmt" "textmodes/texinfmt.el" (20434 17809 692608 0)) ;;; Generated autoloads from textmodes/texinfmt.el (autoload 'texinfo-format-buffer "texinfmt" "\ @@ -27285,7 +27297,7 @@ if large. You can use `Info-split' to do this manually. ;;;*** ;;;### (autoloads (texinfo-mode texinfo-close-quote texinfo-open-quote) -;;;;;; "texinfo" "textmodes/texinfo.el" (20707 18685 911514 0)) +;;;;;; "texinfo" "textmodes/texinfo.el" (20677 50357 68628 0)) ;;; Generated autoloads from textmodes/texinfo.el (defvar texinfo-open-quote (purecopy "``") "\ @@ -27371,7 +27383,7 @@ value of `texinfo-mode-hook'. ;;;### (autoloads (thai-composition-function thai-compose-buffer ;;;;;; thai-compose-string thai-compose-region) "thai-util" "language/thai-util.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from language/thai-util.el (autoload 'thai-compose-region "thai-util" "\ @@ -27400,7 +27412,7 @@ Compose Thai characters in the current buffer. ;;;### (autoloads (list-at-point number-at-point symbol-at-point ;;;;;; sexp-at-point thing-at-point bounds-of-thing-at-point forward-thing) -;;;;;; "thingatpt" "thingatpt.el" (20707 18685 911514 0)) +;;;;;; "thingatpt" "thingatpt.el" (20623 43301 870757 0)) ;;; Generated autoloads from thingatpt.el (autoload 'forward-thing "thingatpt" "\ @@ -27463,7 +27475,7 @@ Return the Lisp list at point, or nil if none is found. ;;;### (autoloads (thumbs-dired-setroot thumbs-dired-show thumbs-dired-show-marked ;;;;;; thumbs-show-from-dir thumbs-find-thumb) "thumbs" "thumbs.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from thumbs.el (autoload 'thumbs-find-thumb "thumbs" "\ @@ -27501,8 +27513,8 @@ In dired, call the setroot program on the image at point. ;;;;;; tibetan-post-read-conversion tibetan-compose-buffer tibetan-decompose-buffer ;;;;;; tibetan-decompose-string tibetan-decompose-region tibetan-compose-region ;;;;;; tibetan-compose-string tibetan-transcription-to-tibetan tibetan-tibetan-to-transcription -;;;;;; tibetan-char-p) "tibet-util" "language/tibet-util.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; tibetan-char-p) "tibet-util" "language/tibet-util.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from language/tibet-util.el (autoload 'tibetan-char-p "tibet-util" "\ @@ -27576,7 +27588,7 @@ See also docstring of the function tibetan-compose-region. ;;;*** ;;;### (autoloads (tildify-buffer tildify-region) "tildify" "textmodes/tildify.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20373 11301 906925 0)) ;;; Generated autoloads from textmodes/tildify.el (autoload 'tildify-region "tildify" "\ @@ -27601,7 +27613,7 @@ This function performs no refilling of the changed text. ;;;### (autoloads (emacs-init-time emacs-uptime display-time-world ;;;;;; display-time-mode display-time display-time-day-and-date) -;;;;;; "time" "time.el" (20707 18685 911514 0)) +;;;;;; "time" "time.el" (20619 46245 806932 0)) ;;; Generated autoloads from time.el (defvar display-time-day-and-date nil "\ @@ -27667,7 +27679,7 @@ Return a string giving the duration of the Emacs initialization. ;;;;;; time-to-day-in-year date-leap-year-p days-between date-to-day ;;;;;; time-add time-subtract time-since days-to-time time-less-p ;;;;;; seconds-to-time date-to-time) "time-date" "calendar/time-date.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20652 47164 970964 0)) ;;; Generated autoloads from calendar/time-date.el (autoload 'date-to-time "time-date" "\ @@ -27678,9 +27690,7 @@ If DATE lacks timezone information, GMT is assumed. (if (or (featurep 'emacs) (and (fboundp 'float-time) (subrp (symbol-function 'float-time)))) - (progn - (defalias 'time-to-seconds 'float-time) - (make-obsolete 'time-to-seconds 'float-time "21.1")) + (defalias 'time-to-seconds 'float-time) (autoload 'time-to-seconds "time-date")) (autoload 'seconds-to-time "time-date" "\ @@ -27781,7 +27791,7 @@ This function does not work for SECONDS greater than `most-positive-fixnum'. ;;;*** ;;;### (autoloads (time-stamp-toggle-active time-stamp) "time-stamp" -;;;;;; "time-stamp.el" (20707 18685 911514 0)) +;;;;;; "time-stamp.el" (20566 63671 243798 0)) ;;; Generated autoloads from time-stamp.el (put 'time-stamp-format 'safe-local-variable 'stringp) (put 'time-stamp-time-zone 'safe-local-variable 'string-or-null-p) @@ -27825,7 +27835,7 @@ With ARG, turn time stamping on if and only if arg is positive. ;;;;;; timeclock-workday-remaining-string timeclock-reread-log timeclock-query-out ;;;;;; timeclock-change timeclock-status-string timeclock-out timeclock-in ;;;;;; timeclock-mode-line-display) "timeclock" "calendar/timeclock.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20593 22184 581574 0)) ;;; Generated autoloads from calendar/timeclock.el (autoload 'timeclock-mode-line-display "timeclock" "\ @@ -27925,7 +27935,7 @@ relative only to the time worked today, and not to past time. ;;;*** ;;;### (autoloads (batch-titdic-convert titdic-convert) "titdic-cnv" -;;;;;; "international/titdic-cnv.el" (20707 18685 911514 0)) +;;;;;; "international/titdic-cnv.el" (20355 10021 546955 0)) ;;; Generated autoloads from international/titdic-cnv.el (autoload 'titdic-convert "titdic-cnv" "\ @@ -27948,7 +27958,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\". ;;;*** ;;;### (autoloads (tmm-prompt tmm-menubar-mouse tmm-menubar) "tmm" -;;;;;; "tmm.el" (20707 18685 911514 0)) +;;;;;; "tmm.el" (20622 22438 32851 0)) ;;; Generated autoloads from tmm.el (define-key global-map "\M-`" 'tmm-menubar) (define-key global-map [menu-bar mouse-1] 'tmm-menubar-mouse) @@ -27988,7 +27998,7 @@ Its value should be an event that has a binding in MENU. ;;;### (autoloads (todo-show todo-cp todo-mode todo-print todo-top-priorities ;;;;;; todo-insert-item todo-add-item-non-interactively todo-add-category) -;;;;;; "todo-mode" "calendar/todo-mode.el" (20707 18685 911514 0)) +;;;;;; "todo-mode" "calendar/todo-mode.el" (20355 10021 546955 0)) ;;; Generated autoloads from calendar/todo-mode.el (autoload 'todo-add-category "todo-mode" "\ @@ -28048,7 +28058,7 @@ Show TODO list. ;;;### (autoloads (tool-bar-local-item-from-menu tool-bar-add-item-from-menu ;;;;;; tool-bar-local-item tool-bar-add-item toggle-tool-bar-mode-from-frame) -;;;;;; "tool-bar" "tool-bar.el" (20707 18685 911514 0)) +;;;;;; "tool-bar" "tool-bar.el" (20355 10021 546955 0)) ;;; Generated autoloads from tool-bar.el (autoload 'toggle-tool-bar-mode-from-frame "tool-bar" "\ @@ -28119,7 +28129,7 @@ holds a keymap. ;;;*** ;;;### (autoloads (tpu-edt-on tpu-edt-mode) "tpu-edt" "emulation/tpu-edt.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20566 63671 243798 0)) ;;; Generated autoloads from emulation/tpu-edt.el (defvar tpu-edt-mode nil "\ @@ -28149,7 +28159,7 @@ Turn on TPU/edt emulation. ;;;*** ;;;### (autoloads (tpu-mapper) "tpu-mapper" "emulation/tpu-mapper.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20566 63671 243798 0)) ;;; Generated autoloads from emulation/tpu-mapper.el (autoload 'tpu-mapper "tpu-mapper" "\ @@ -28183,8 +28193,8 @@ your local X guru can try to figure out why the key is being ignored. ;;;*** -;;;### (autoloads (tq-create) "tq" "emacs-lisp/tq.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (tq-create) "tq" "emacs-lisp/tq.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from emacs-lisp/tq.el (autoload 'tq-create "tq" "\ @@ -28197,16 +28207,17 @@ to a tcp server on another machine. ;;;*** -;;;### (autoloads (trace-function-background trace-function trace-buffer) -;;;;;; "trace" "emacs-lisp/trace.el" (20716 60089 50197 777000)) +;;;### (autoloads (trace-function-background trace-function-foreground +;;;;;; trace-buffer) "trace" "emacs-lisp/trace.el" (20652 47164 +;;;;;; 970964 0)) ;;; Generated autoloads from emacs-lisp/trace.el -(defvar trace-buffer (purecopy "*trace-output*") "\ +(defvar trace-buffer "*trace-output*" "\ Trace output will by default go to that buffer.") (custom-autoload 'trace-buffer "trace" t) -(autoload 'trace-function "trace" "\ +(autoload 'trace-function-foreground "trace" "\ Traces FUNCTION with trace output going to BUFFER. For every call of FUNCTION Lisp-style trace messages that display argument and return values will be inserted into BUFFER. This function generates the @@ -28215,9 +28226,7 @@ there might be!! The trace BUFFER will popup whenever FUNCTION is called. Do not use this to trace functions that switch buffers or do any other display oriented stuff, use `trace-function-background' instead. -To untrace a function, use `untrace-function' or `untrace-all'. - -\(fn FUNCTION &optional BUFFER)" t nil) +\(fn FUNCTION &optional BUFFER CONTEXT)" t nil) (autoload 'trace-function-background "trace" "\ Traces FUNCTION with trace output going quietly to BUFFER. @@ -28230,16 +28239,16 @@ the window or buffer configuration. BUFFER defaults to `trace-buffer'. -To untrace a function, use `untrace-function' or `untrace-all'. +\(fn FUNCTION &optional BUFFER CONTEXT)" t nil) -\(fn FUNCTION &optional BUFFER)" t nil) +(defalias 'trace-function 'trace-function-foreground) ;;;*** ;;;### (autoloads (tramp-unload-tramp tramp-completion-handle-file-name-completion ;;;;;; tramp-completion-handle-file-name-all-completions tramp-unload-file-name-handlers ;;;;;; tramp-file-name-handler tramp-syntax tramp-mode) "tramp" -;;;;;; "net/tramp.el" (20707 18685 911514 0)) +;;;;;; "net/tramp.el" (20701 32695 861936 0)) ;;; Generated autoloads from net/tramp.el (defvar tramp-mode t "\ @@ -28372,7 +28381,7 @@ Discard Tramp from loading remote files. ;;;*** ;;;### (autoloads (tramp-ftp-enable-ange-ftp) "tramp-ftp" "net/tramp-ftp.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20683 2742 588278 0)) ;;; Generated autoloads from net/tramp-ftp.el (autoload 'tramp-ftp-enable-ange-ftp "tramp-ftp" "\ @@ -28382,8 +28391,8 @@ Discard Tramp from loading remote files. ;;;*** -;;;### (autoloads (help-with-tutorial) "tutorial" "tutorial.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (help-with-tutorial) "tutorial" "tutorial.el" (20584 +;;;;;; 7212 455152 0)) ;;; Generated autoloads from tutorial.el (autoload 'help-with-tutorial "tutorial" "\ @@ -28408,7 +28417,7 @@ resumed later. ;;;*** ;;;### (autoloads (tai-viet-composition-function) "tv-util" "language/tv-util.el" -;;;;;; (20360 54279 565993 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from language/tv-util.el (autoload 'tai-viet-composition-function "tv-util" "\ @@ -28419,7 +28428,7 @@ resumed later. ;;;*** ;;;### (autoloads (2C-split 2C-associate-buffer 2C-two-columns) "two-column" -;;;;;; "textmodes/two-column.el" (20707 18685 911514 0)) +;;;;;; "textmodes/two-column.el" (20566 63671 243798 0)) ;;; Generated autoloads from textmodes/two-column.el (autoload '2C-command "two-column" () t 'keymap) (global-set-key "\C-x6" '2C-command) @@ -28468,7 +28477,7 @@ First column's text sSs Second column's text ;;;### (autoloads (type-break-guesstimate-keystroke-threshold type-break-statistics ;;;;;; type-break type-break-mode) "type-break" "type-break.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20582 12914 894781 0)) ;;; Generated autoloads from type-break.el (defvar type-break-mode nil "\ @@ -28600,8 +28609,8 @@ FRAC should be the inverse of the fractional value; for example, a value of ;;;*** -;;;### (autoloads (uce-reply-to-uce) "uce" "mail/uce.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (uce-reply-to-uce) "uce" "mail/uce.el" (20566 63671 +;;;;;; 243798 0)) ;;; Generated autoloads from mail/uce.el (autoload 'uce-reply-to-uce "uce" "\ @@ -28619,7 +28628,7 @@ You might need to set `uce-mail-reader' before using this. ;;;;;; ucs-normalize-NFKC-string ucs-normalize-NFKC-region ucs-normalize-NFKD-string ;;;;;; ucs-normalize-NFKD-region ucs-normalize-NFC-string ucs-normalize-NFC-region ;;;;;; ucs-normalize-NFD-string ucs-normalize-NFD-region) "ucs-normalize" -;;;;;; "international/ucs-normalize.el" (20707 18685 911514 0)) +;;;;;; "international/ucs-normalize.el" (20476 31768 298871 0)) ;;; Generated autoloads from international/ucs-normalize.el (autoload 'ucs-normalize-NFD-region "ucs-normalize" "\ @@ -28685,7 +28694,7 @@ Normalize the string STR by the Unicode NFC and Mac OS's HFS Plus. ;;;*** ;;;### (autoloads (ununderline-region underline-region) "underline" -;;;;;; "textmodes/underline.el" (20707 18685 911514 0)) +;;;;;; "textmodes/underline.el" (20355 10021 546955 0)) ;;; Generated autoloads from textmodes/underline.el (autoload 'underline-region "underline" "\ @@ -28706,11 +28715,11 @@ which specify the range to operate on. ;;;*** ;;;### (autoloads (unrmail batch-unrmail) "unrmail" "mail/unrmail.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20673 53308 39372 0)) ;;; Generated autoloads from mail/unrmail.el (autoload 'batch-unrmail "unrmail" "\ -Convert old-style Rmail Babyl files to system inbox format. +Convert old-style Rmail Babyl files to mbox format. Specify the input Rmail Babyl file names as command line arguments. For each Rmail file, the corresponding output file name is made by adding `.mail' at the end. @@ -28719,14 +28728,15 @@ For example, invoke `emacs -batch -f batch-unrmail RMAIL'. \(fn)" nil nil) (autoload 'unrmail "unrmail" "\ -Convert old-style Rmail Babyl file FILE to system inbox format file TO-FILE. +Convert old-style Rmail Babyl file FILE to mbox format file TO-FILE. +The variable `unrmail-mbox-format' controls which mbox format to use. \(fn FILE TO-FILE)" t nil) ;;;*** -;;;### (autoloads (unsafep) "unsafep" "emacs-lisp/unsafep.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (unsafep) "unsafep" "emacs-lisp/unsafep.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from emacs-lisp/unsafep.el (autoload 'unsafep "unsafep" "\ @@ -28739,7 +28749,7 @@ UNSAFEP-VARS is a list of symbols with local bindings. ;;;*** ;;;### (autoloads (url-retrieve-synchronously url-retrieve) "url" -;;;;;; "url/url.el" (20707 18685 911514 0)) +;;;;;; "url/url.el" (20601 16294 451653 0)) ;;; Generated autoloads from url/url.el (autoload 'url-retrieve "url" "\ @@ -28787,7 +28797,7 @@ no further processing). URL is either a string or a parsed URL. ;;;*** ;;;### (autoloads (url-register-auth-scheme url-get-authentication) -;;;;;; "url-auth" "url/url-auth.el" (20707 18685 911514 0)) +;;;;;; "url-auth" "url/url-auth.el" (20355 10021 546955 0)) ;;; Generated autoloads from url/url-auth.el (autoload 'url-get-authentication "url-auth" "\ @@ -28829,7 +28839,7 @@ RATING a rating between 1 and 10 of the strength of the authentication. ;;;*** ;;;### (autoloads (url-cache-extract url-is-cached url-store-in-cache) -;;;;;; "url-cache" "url/url-cache.el" (20707 18685 911514 0)) +;;;;;; "url-cache" "url/url-cache.el" (20355 10021 546955 0)) ;;; Generated autoloads from url/url-cache.el (autoload 'url-store-in-cache "url-cache" "\ @@ -28850,8 +28860,8 @@ Extract FNAM from the local disk cache. ;;;*** -;;;### (autoloads (url-cid) "url-cid" "url/url-cid.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (url-cid) "url-cid" "url/url-cid.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from url/url-cid.el (autoload 'url-cid "url-cid" "\ @@ -28862,7 +28872,7 @@ Extract FNAM from the local disk cache. ;;;*** ;;;### (autoloads (url-dav-vc-registered url-dav-request url-dav-supported-p) -;;;;;; "url-dav" "url/url-dav.el" (20707 18685 911514 0)) +;;;;;; "url-dav" "url/url-dav.el" (20501 3499 284800 0)) ;;; Generated autoloads from url/url-dav.el (autoload 'url-dav-supported-p "url-dav" "\ @@ -28896,8 +28906,8 @@ added to this list, so most requests can just pass in nil. ;;;*** -;;;### (autoloads (url-file) "url-file" "url/url-file.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (url-file) "url-file" "url/url-file.el" (20602 +;;;;;; 37158 321420 0)) ;;; Generated autoloads from url/url-file.el (autoload 'url-file "url-file" "\ @@ -28908,7 +28918,7 @@ Handle file: and ftp: URLs. ;;;*** ;;;### (autoloads (url-open-stream url-gateway-nslookup-host) "url-gw" -;;;;;; "url/url-gw.el" (20707 18685 911514 0)) +;;;;;; "url/url-gw.el" (20478 3673 653810 0)) ;;; Generated autoloads from url/url-gw.el (autoload 'url-gateway-nslookup-host "url-gw" "\ @@ -28928,7 +28938,7 @@ Might do a non-blocking connection; use `process-status' to check. ;;;### (autoloads (url-insert-file-contents url-file-local-copy url-copy-file ;;;;;; url-file-handler url-handler-mode) "url-handlers" "url/url-handlers.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20584 7212 455152 0)) ;;; Generated autoloads from url/url-handlers.el (defvar url-handler-mode nil "\ @@ -28982,7 +28992,7 @@ accessible. ;;;*** -;;;### (autoloads nil "url-http" "url/url-http.el" (20707 18685 911514 +;;;### (autoloads nil "url-http" "url/url-http.el" (20693 38586 665915 ;;;;;; 0)) ;;; Generated autoloads from url/url-http.el (autoload 'url-default-expander "url-expand") @@ -28995,8 +29005,8 @@ accessible. ;;;*** -;;;### (autoloads (url-irc) "url-irc" "url/url-irc.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (url-irc) "url-irc" "url/url-irc.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from url/url-irc.el (autoload 'url-irc "url-irc" "\ @@ -29006,8 +29016,8 @@ accessible. ;;;*** -;;;### (autoloads (url-ldap) "url-ldap" "url/url-ldap.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (url-ldap) "url-ldap" "url/url-ldap.el" (20355 +;;;;;; 10021 546955 0)) ;;; Generated autoloads from url/url-ldap.el (autoload 'url-ldap "url-ldap" "\ @@ -29021,7 +29031,7 @@ URL can be a URL string, or a URL vector of the type returned by ;;;*** ;;;### (autoloads (url-mailto url-mail) "url-mailto" "url/url-mailto.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from url/url-mailto.el (autoload 'url-mail "url-mailto" "\ @@ -29037,7 +29047,7 @@ Handle the mailto: URL syntax. ;;;*** ;;;### (autoloads (url-data url-generic-emulator-loader url-info -;;;;;; url-man) "url-misc" "url/url-misc.el" (20707 18685 911514 +;;;;;; url-man) "url-misc" "url/url-misc.el" (20668 35382 940599 ;;;;;; 0)) ;;; Generated autoloads from url/url-misc.el @@ -29070,7 +29080,7 @@ Fetch a data URL (RFC 2397). ;;;*** ;;;### (autoloads (url-snews url-news) "url-news" "url/url-news.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from url/url-news.el (autoload 'url-news "url-news" "\ @@ -29087,7 +29097,7 @@ Fetch a data URL (RFC 2397). ;;;### (autoloads (url-ns-user-pref url-ns-prefs isInNet isResolvable ;;;;;; dnsResolve dnsDomainIs isPlainHostName) "url-ns" "url/url-ns.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from url/url-ns.el (autoload 'isPlainHostName "url-ns" "\ @@ -29128,7 +29138,7 @@ Fetch a data URL (RFC 2397). ;;;*** ;;;### (autoloads (url-generic-parse-url url-recreate-url) "url-parse" -;;;;;; "url/url-parse.el" (20707 18685 911514 0)) +;;;;;; "url/url-parse.el" (20693 38586 665915 0)) ;;; Generated autoloads from url/url-parse.el (autoload 'url-recreate-url "url-parse" "\ @@ -29180,7 +29190,7 @@ parses to ;;;*** ;;;### (autoloads (url-setup-privacy-info) "url-privacy" "url/url-privacy.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20478 3673 653810 0)) ;;; Generated autoloads from url/url-privacy.el (autoload 'url-setup-privacy-info "url-privacy" "\ @@ -29191,7 +29201,7 @@ Setup variables that expose info about you and your system. ;;;*** ;;;### (autoloads (url-queue-retrieve) "url-queue" "url/url-queue.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20478 3673 653810 0)) ;;; Generated autoloads from url/url-queue.el (autoload 'url-queue-retrieve "url-queue" "\ @@ -29211,8 +29221,8 @@ The variable `url-queue-timeout' sets a timeout. ;;;;;; url-percentage url-display-percentage url-pretty-length url-strip-leading-spaces ;;;;;; url-eat-trailing-space url-get-normalized-date url-lazy-message ;;;;;; url-normalize-url url-insert-entities-in-string url-parse-args -;;;;;; url-debug url-debug) "url-util" "url/url-util.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; url-debug url-debug) "url-util" "url/url-util.el" (20584 +;;;;;; 7212 455152 0)) ;;; Generated autoloads from url/url-util.el (defvar url-debug nil "\ @@ -29386,7 +29396,7 @@ This uses `url-current-object', set locally to the buffer. ;;;*** ;;;### (autoloads (ask-user-about-supersession-threat ask-user-about-lock) -;;;;;; "userlock" "userlock.el" (20707 18685 911514 0)) +;;;;;; "userlock" "userlock.el" (20555 6946 859539 0)) ;;; Generated autoloads from userlock.el (autoload 'ask-user-about-lock "userlock" "\ @@ -29416,7 +29426,7 @@ The buffer in question is current when this function is called. ;;;### (autoloads (utf-7-imap-pre-write-conversion utf-7-pre-write-conversion ;;;;;; utf-7-imap-post-read-conversion utf-7-post-read-conversion) -;;;;;; "utf-7" "international/utf-7.el" (20707 18685 911514 0)) +;;;;;; "utf-7" "international/utf-7.el" (20355 10021 546955 0)) ;;; Generated autoloads from international/utf-7.el (autoload 'utf-7-post-read-conversion "utf-7" "\ @@ -29441,8 +29451,8 @@ The buffer in question is current when this function is called. ;;;*** -;;;### (autoloads (utf7-encode) "utf7" "gnus/utf7.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (utf7-encode) "utf7" "gnus/utf7.el" (20355 10021 +;;;;;; 546955 0)) ;;; Generated autoloads from gnus/utf7.el (autoload 'utf7-encode "utf7" "\ @@ -29454,7 +29464,7 @@ Encode UTF-7 STRING. Use IMAP modification if FOR-IMAP is non-nil. ;;;### (autoloads (uudecode-decode-region uudecode-decode-region-internal ;;;;;; uudecode-decode-region-external) "uudecode" "mail/uudecode.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from mail/uudecode.el (autoload 'uudecode-decode-region-external "uudecode" "\ @@ -29484,8 +29494,8 @@ If FILE-NAME is non-nil, save the result to FILE-NAME. ;;;;;; vc-print-log vc-retrieve-tag vc-create-tag vc-merge vc-insert-headers ;;;;;; vc-revision-other-window vc-root-diff vc-ediff vc-version-ediff ;;;;;; vc-diff vc-version-diff vc-register vc-next-action vc-before-checkin-hook -;;;;;; vc-checkin-hook vc-checkout-hook) "vc" "vc/vc.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; vc-checkin-hook vc-checkout-hook) "vc" "vc/vc.el" (20668 +;;;;;; 35382 940599 0)) ;;; Generated autoloads from vc/vc.el (defvar vc-checkout-hook nil "\ @@ -29731,11 +29741,15 @@ backend to NEW-BACKEND, and unregister FILE from the current backend. (autoload 'vc-delete-file "vc" "\ Delete file and mark it as such in the version control system. +If called interactively, read FILE, defaulting to the current +buffer's file name if it's under version control. \(fn FILE)" t nil) (autoload 'vc-rename-file "vc" "\ Rename file OLD to NEW in both work area and repository. +If called interactively, read OLD and NEW, defaulting OLD to the +current buffer's file name if it's under version control. \(fn OLD NEW)" t nil) @@ -29763,7 +29777,7 @@ Return the branch part of a revision number REV. ;;;*** ;;;### (autoloads (vc-annotate) "vc-annotate" "vc/vc-annotate.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20478 3673 653810 0)) ;;; Generated autoloads from vc/vc-annotate.el (autoload 'vc-annotate "vc-annotate" "\ @@ -29800,7 +29814,7 @@ mode-specific menu. `vc-annotate-color-map' and ;;;*** -;;;### (autoloads nil "vc-arch" "vc/vc-arch.el" (20707 18685 911514 +;;;### (autoloads nil "vc-arch" "vc/vc-arch.el" (20478 3673 653810 ;;;;;; 0)) ;;; Generated autoloads from vc/vc-arch.el (defun vc-arch-registered (file) @@ -29811,7 +29825,7 @@ mode-specific menu. `vc-annotate-color-map' and ;;;*** -;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (20707 18685 911514 +;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (20584 7212 455152 ;;;;;; 0)) ;;; Generated autoloads from vc/vc-bzr.el @@ -29828,7 +29842,7 @@ Name of the format file in a .bzr directory.") ;;;*** -;;;### (autoloads nil "vc-cvs" "vc/vc-cvs.el" (20707 18685 911514 +;;;### (autoloads nil "vc-cvs" "vc/vc-cvs.el" (20542 46798 773957 ;;;;;; 0)) ;;; Generated autoloads from vc/vc-cvs.el (defun vc-cvs-registered (f) @@ -29840,10 +29854,49 @@ Name of the format file in a .bzr directory.") ;;;*** -;;;### (autoloads (vc-dir) "vc-dir" "vc/vc-dir.el" (20707 18685 911514 -;;;;;; 0)) +;;;### (autoloads (vc-dir vc-dir-mode) "vc-dir" "vc/vc-dir.el" (20662 +;;;;;; 46799 394737 457000)) ;;; Generated autoloads from vc/vc-dir.el +(autoload 'vc-dir-mode "vc-dir" "\ +Major mode for VC directory buffers. +Marking/Unmarking key bindings and actions: +m - mark a file/directory + - if the region is active, mark all the files in region. + Restrictions: - a file cannot be marked if any parent directory is marked + - a directory cannot be marked if any child file or + directory is marked +u - unmark a file/directory + - if the region is active, unmark all the files in region. +M - if the cursor is on a file: mark all the files with the same state as + the current file + - if the cursor is on a directory: mark all child files + - with a prefix argument: mark all files +U - if the cursor is on a file: unmark all the files with the same state + as the current file + - if the cursor is on a directory: unmark all child files + - with a prefix argument: unmark all files +mouse-2 - toggles the mark state + +VC commands +VC commands in the `C-x v' prefix can be used. +VC commands act on the marked entries. If nothing is marked, VC +commands act on the current entry. + +Search & Replace +S - searches the marked files +Q - does a query replace on the marked files +M-s a C-s - does an isearch on the marked files +M-s a C-M-s - does a regexp isearch on the marked files +If nothing is marked, these commands act on the current entry. +When a directory is current or marked, the Search & Replace +commands act on the child files of that directory that are displayed in +the *vc-dir* buffer. + +\\{vc-dir-mode-map} + +\(fn)" t nil) + (autoload 'vc-dir "vc-dir" "\ Show the VC status for \"interesting\" files in and below DIR. This allows you to mark files and perform VC operations on them. @@ -29866,7 +29919,7 @@ These are the commands available for use in the file status buffer: ;;;*** ;;;### (autoloads (vc-do-command) "vc-dispatcher" "vc/vc-dispatcher.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20489 12324 656827 0)) ;;; Generated autoloads from vc/vc-dispatcher.el (autoload 'vc-do-command "vc-dispatcher" "\ @@ -29889,7 +29942,7 @@ case, and the process object in the asynchronous case. ;;;*** -;;;### (autoloads nil "vc-git" "vc/vc-git.el" (20707 18685 911514 +;;;### (autoloads nil "vc-git" "vc/vc-git.el" (20664 38325 385623 ;;;;;; 0)) ;;; Generated autoloads from vc/vc-git.el (defun vc-git-registered (file) @@ -29901,7 +29954,7 @@ case, and the process object in the asynchronous case. ;;;*** -;;;### (autoloads nil "vc-hg" "vc/vc-hg.el" (20707 18685 911514 0)) +;;;### (autoloads nil "vc-hg" "vc/vc-hg.el" (20670 42926 924735 782000)) ;;; Generated autoloads from vc/vc-hg.el (defun vc-hg-registered (file) "Return non-nil if FILE is registered with hg." @@ -29912,8 +29965,7 @@ case, and the process object in the asynchronous case. ;;;*** -;;;### (autoloads nil "vc-mtn" "vc/vc-mtn.el" (20707 18685 911514 -;;;;;; 0)) +;;;### (autoloads nil "vc-mtn" "vc/vc-mtn.el" (20524 51365 2559 0)) ;;; Generated autoloads from vc/vc-mtn.el (defconst vc-mtn-admin-dir "_MTN" "\ @@ -29930,7 +29982,7 @@ Name of the monotone directory's format file.") ;;;*** ;;;### (autoloads (vc-rcs-master-templates) "vc-rcs" "vc/vc-rcs.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20584 7212 455152 0)) ;;; Generated autoloads from vc/vc-rcs.el (defvar vc-rcs-master-templates (purecopy '("%sRCS/%s,v" "%s%s,v" "%sRCS/%s")) "\ @@ -29944,7 +29996,7 @@ For a description of possible values, see `vc-check-master-templates'.") ;;;*** ;;;### (autoloads (vc-sccs-master-templates) "vc-sccs" "vc/vc-sccs.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20584 7212 455152 0)) ;;; Generated autoloads from vc/vc-sccs.el (defvar vc-sccs-master-templates (purecopy '("%sSCCS/s.%s" "%ss.%s" vc-sccs-search-project-dir)) "\ @@ -29962,7 +30014,7 @@ find any project directory." (let ((project-dir (getenv "PROJECTDIR")) dirs dir) ;;;*** -;;;### (autoloads nil "vc-svn" "vc/vc-svn.el" (20707 18685 911514 +;;;### (autoloads nil "vc-svn" "vc/vc-svn.el" (20648 50109 802321 ;;;;;; 0)) ;;; Generated autoloads from vc/vc-svn.el (defun vc-svn-registered (f) @@ -29977,7 +30029,7 @@ find any project directory." (let ((project-dir (getenv "PROJECTDIR")) dirs dir) ;;;*** ;;;### (autoloads (vera-mode) "vera-mode" "progmodes/vera-mode.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20577 33959 40183 0)) ;;; Generated autoloads from progmodes/vera-mode.el (add-to-list 'auto-mode-alist (cons (purecopy "\\.vr[hi]?\\'") 'vera-mode)) @@ -30035,7 +30087,7 @@ Key bindings: ;;;*** ;;;### (autoloads (verilog-mode) "verilog-mode" "progmodes/verilog-mode.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20593 22184 581574 0)) ;;; Generated autoloads from progmodes/verilog-mode.el (autoload 'verilog-mode "verilog-mode" "\ @@ -30174,7 +30226,7 @@ Key bindings specific to `verilog-mode-map' are: ;;;*** ;;;### (autoloads (vhdl-mode) "vhdl-mode" "progmodes/vhdl-mode.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20593 22184 581574 0)) ;;; Generated autoloads from progmodes/vhdl-mode.el (autoload 'vhdl-mode "vhdl-mode" "\ @@ -30728,7 +30780,7 @@ Key bindings: ;;;*** -;;;### (autoloads (vi-mode) "vi" "emulation/vi.el" (20627 28531 447943 +;;;### (autoloads (vi-mode) "vi" "emulation/vi.el" (20566 63671 243798 ;;;;;; 0)) ;;; Generated autoloads from emulation/vi.el @@ -30784,7 +30836,7 @@ Syntax table and abbrevs while in vi mode remain as they were in Emacs. ;;;### (autoloads (viqr-pre-write-conversion viqr-post-read-conversion ;;;;;; viet-encode-viqr-buffer viet-encode-viqr-region viet-decode-viqr-buffer ;;;;;; viet-decode-viqr-region viet-encode-viscii-char) "viet-util" -;;;;;; "language/viet-util.el" (20707 18685 911514 0)) +;;;;;; "language/viet-util.el" (20355 10021 546955 0)) ;;; Generated autoloads from language/viet-util.el (autoload 'viet-encode-viscii-char "viet-util" "\ @@ -30832,7 +30884,7 @@ Convert Vietnamese characters of the current buffer to `VIQR' mnemonics. ;;;;;; view-mode view-buffer-other-frame view-buffer-other-window ;;;;;; view-buffer view-file-other-frame view-file-other-window ;;;;;; view-file kill-buffer-if-not-modified view-remove-frame-by-deleting) -;;;;;; "view" "view.el" (20707 18685 911514 0)) +;;;;;; "view" "view.el" (20706 50624 612201 0)) ;;; Generated autoloads from view.el (defvar view-remove-frame-by-deleting t "\ @@ -31088,8 +31140,8 @@ Exit View mode and make the current buffer editable. ;;;*** -;;;### (autoloads (vip-mode vip-setup) "vip" "emulation/vip.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (vip-mode vip-setup) "vip" "emulation/vip.el" (20513 +;;;;;; 18948 537867 0)) ;;; Generated autoloads from emulation/vip.el (autoload 'vip-setup "vip" "\ @@ -31105,7 +31157,7 @@ Turn on VIP emulation of VI. ;;;*** ;;;### (autoloads (viper-mode toggle-viper-mode) "viper" "emulation/viper.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20566 63671 243798 0)) ;;; Generated autoloads from emulation/viper.el (autoload 'toggle-viper-mode "viper" "\ @@ -31122,7 +31174,7 @@ Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'. ;;;*** ;;;### (autoloads (warn lwarn display-warning) "warnings" "emacs-lisp/warnings.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from emacs-lisp/warnings.el (defvar warning-prefix-function nil "\ @@ -31212,7 +31264,7 @@ this is equivalent to `display-warning', using ;;;*** ;;;### (autoloads (wdired-change-to-wdired-mode) "wdired" "wdired.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20656 44218 805102 0)) ;;; Generated autoloads from wdired.el (autoload 'wdired-change-to-wdired-mode "wdired" "\ @@ -31229,8 +31281,8 @@ See `wdired-mode'. ;;;*** -;;;### (autoloads (webjump) "webjump" "net/webjump.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (webjump) "webjump" "net/webjump.el" (20566 63671 +;;;;;; 243798 0)) ;;; Generated autoloads from net/webjump.el (autoload 'webjump "webjump" "\ @@ -31247,7 +31299,7 @@ Please submit bug reports and other feedback to the author, Neil W. Van Dyke ;;;*** ;;;### (autoloads (which-function-mode) "which-func" "progmodes/which-func.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20613 49078 764749 0)) ;;; Generated autoloads from progmodes/which-func.el (put 'which-func-format 'risky-local-variable t) (put 'which-func-current 'risky-local-variable t) @@ -31280,8 +31332,8 @@ in certain major modes. ;;;### (autoloads (whitespace-report-region whitespace-report whitespace-cleanup-region ;;;;;; whitespace-cleanup global-whitespace-toggle-options whitespace-toggle-options ;;;;;; global-whitespace-newline-mode global-whitespace-mode whitespace-newline-mode -;;;;;; whitespace-mode) "whitespace" "whitespace.el" (20707 18685 -;;;;;; 911514 0)) +;;;;;; whitespace-mode) "whitespace" "whitespace.el" (20508 13724 +;;;;;; 260761 0)) ;;; Generated autoloads from whitespace.el (autoload 'whitespace-mode "whitespace" "\ @@ -31680,8 +31732,8 @@ cleaning up these problems. ;;;*** ;;;### (autoloads (widget-minor-mode widget-browse-other-window widget-browse -;;;;;; widget-browse-at) "wid-browse" "wid-browse.el" (20707 18685 -;;;;;; 911514 0)) +;;;;;; widget-browse-at) "wid-browse" "wid-browse.el" (20478 3673 +;;;;;; 653810 0)) ;;; Generated autoloads from wid-browse.el (autoload 'widget-browse-at "wid-browse" "\ @@ -31710,8 +31762,8 @@ if ARG is omitted or nil. ;;;*** ;;;### (autoloads (widget-setup widget-insert widget-delete widget-create -;;;;;; widget-prompt-value widgetp) "wid-edit" "wid-edit.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; widget-prompt-value widgetp) "wid-edit" "wid-edit.el" (20373 +;;;;;; 11301 906925 0)) ;;; Generated autoloads from wid-edit.el (autoload 'widgetp "wid-edit" "\ @@ -31754,8 +31806,8 @@ Setup current buffer so editing string widgets works. ;;;*** ;;;### (autoloads (windmove-default-keybindings windmove-down windmove-right -;;;;;; windmove-up windmove-left) "windmove" "windmove.el" (20707 -;;;;;; 18685 911514 0)) +;;;;;; windmove-up windmove-left) "windmove" "windmove.el" (20566 +;;;;;; 63671 243798 0)) ;;; Generated autoloads from windmove.el (autoload 'windmove-left "windmove" "\ @@ -31807,8 +31859,8 @@ Default MODIFIER is 'shift. ;;;*** -;;;### (autoloads (winner-mode) "winner" "winner.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (winner-mode) "winner" "winner.el" (20584 7212 +;;;;;; 455152 0)) ;;; Generated autoloads from winner.el (defvar winner-mode nil "\ @@ -31832,7 +31884,7 @@ the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. ;;;*** ;;;### (autoloads (woman-bookmark-jump woman-find-file woman-dired-find-file -;;;;;; woman woman-locale) "woman" "woman.el" (20707 18685 911514 +;;;;;; woman woman-locale) "woman" "woman.el" (20657 65077 880084 ;;;;;; 0)) ;;; Generated autoloads from woman.el @@ -31882,7 +31934,7 @@ Default bookmark handler for Woman buffers. ;;;*** ;;;### (autoloads (wordstar-mode) "ws-mode" "emulation/ws-mode.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20355 10021 546955 0)) ;;; Generated autoloads from emulation/ws-mode.el (autoload 'wordstar-mode "ws-mode" "\ @@ -31994,8 +32046,8 @@ The key bindings are: ;;;*** -;;;### (autoloads (xesam-search) "xesam" "net/xesam.el" (20707 18685 -;;;;;; 911514 0)) +;;;### (autoloads (xesam-search) "xesam" "net/xesam.el" (20478 3673 +;;;;;; 653810 0)) ;;; Generated autoloads from net/xesam.el (autoload 'xesam-search "xesam" "\ @@ -32015,7 +32067,7 @@ Example: ;;;*** ;;;### (autoloads (xml-parse-region xml-parse-file) "xml" "xml.el" -;;;;;; (20707 18685 911514 0)) +;;;;;; (20528 48420 241677 0)) ;;; Generated autoloads from xml.el (autoload 'xml-parse-file "xml" "\ @@ -32072,7 +32124,7 @@ Both features can be combined by providing a cons cell ;;;*** ;;;### (autoloads (xmltok-get-declared-encoding-position) "xmltok" -;;;;;; "nxml/xmltok.el" (20707 18685 911514 0)) +;;;;;; "nxml/xmltok.el" (20355 10021 546955 0)) ;;; Generated autoloads from nxml/xmltok.el (autoload 'xmltok-get-declared-encoding-position "xmltok" "\ @@ -32090,8 +32142,8 @@ If LIMIT is non-nil, then do not consider characters beyond LIMIT. ;;;*** -;;;### (autoloads (xterm-mouse-mode) "xt-mouse" "xt-mouse.el" (20707 -;;;;;; 18685 911514 0)) +;;;### (autoloads (xterm-mouse-mode) "xt-mouse" "xt-mouse.el" (20485 +;;;;;; 15269 390836 0)) ;;; Generated autoloads from xt-mouse.el (defvar xterm-mouse-mode nil "\ @@ -32121,7 +32173,7 @@ down the SHIFT key while pressing the mouse button. ;;;*** ;;;### (autoloads (yenc-extract-filename yenc-decode-region) "yenc" -;;;;;; "gnus/yenc.el" (20707 18685 911514 0)) +;;;;;; "gnus/yenc.el" (20355 10021 546955 0)) ;;; Generated autoloads from gnus/yenc.el (autoload 'yenc-decode-region "yenc" "\ @@ -32137,7 +32189,7 @@ Extract file name from an yenc header. ;;;*** ;;;### (autoloads (psychoanalyze-pinhead apropos-zippy insert-zippyism -;;;;;; yow) "yow" "play/yow.el" (20707 18685 911514 0)) +;;;;;; yow) "yow" "play/yow.el" (20364 42504 244840 586000)) ;;; Generated autoloads from play/yow.el (autoload 'yow "yow" "\ @@ -32163,7 +32215,7 @@ Zippy goes to the analyst. ;;;*** -;;;### (autoloads (zone) "zone" "play/zone.el" (20707 18685 911514 +;;;### (autoloads (zone) "zone" "play/zone.el" (20545 57511 257469 ;;;;;; 0)) ;;; Generated autoloads from play/zone.el @@ -32180,46 +32232,46 @@ Zone out, completely. ;;;;;; "calc/calc-fin.el" "calc/calc-forms.el" "calc/calc-frac.el" ;;;;;; "calc/calc-funcs.el" "calc/calc-graph.el" "calc/calc-help.el" ;;;;;; "calc/calc-incom.el" "calc/calc-keypd.el" "calc/calc-lang.el" -;;;;;; "calc/calc-macs.el" "calc/calc-map.el" "calc/calc-math.el" -;;;;;; "calc/calc-menu.el" "calc/calc-misc.el" "calc/calc-mode.el" -;;;;;; "calc/calc-mtx.el" "calc/calc-nlfit.el" "calc/calc-poly.el" -;;;;;; "calc/calc-prog.el" "calc/calc-rewr.el" "calc/calc-rules.el" -;;;;;; "calc/calc-sel.el" "calc/calc-stat.el" "calc/calc-store.el" -;;;;;; "calc/calc-stuff.el" "calc/calc-trail.el" "calc/calc-units.el" -;;;;;; "calc/calc-vec.el" "calc/calc-yank.el" "calc/calcalg2.el" -;;;;;; "calc/calcalg3.el" "calc/calccomp.el" "calc/calcsel2.el" -;;;;;; "calendar/cal-bahai.el" "calendar/cal-coptic.el" "calendar/cal-french.el" -;;;;;; "calendar/cal-html.el" "calendar/cal-islam.el" "calendar/cal-iso.el" -;;;;;; "calendar/cal-julian.el" "calendar/cal-loaddefs.el" "calendar/cal-mayan.el" -;;;;;; "calendar/cal-menu.el" "calendar/cal-move.el" "calendar/cal-persia.el" -;;;;;; "calendar/cal-tex.el" "calendar/cal-x.el" "calendar/diary-loaddefs.el" -;;;;;; "calendar/hol-loaddefs.el" "cdl.el" "cedet/cedet-cscope.el" -;;;;;; "cedet/cedet-files.el" "cedet/cedet-global.el" "cedet/cedet-idutils.el" -;;;;;; "cedet/cedet.el" "cedet/ede/auto.el" "cedet/ede/autoconf-edit.el" -;;;;;; "cedet/ede/base.el" "cedet/ede/cpp-root.el" "cedet/ede/custom.el" -;;;;;; "cedet/ede/dired.el" "cedet/ede/emacs.el" "cedet/ede/files.el" -;;;;;; "cedet/ede/generic.el" "cedet/ede/linux.el" "cedet/ede/locate.el" -;;;;;; "cedet/ede/make.el" "cedet/ede/makefile-edit.el" "cedet/ede/pconf.el" -;;;;;; "cedet/ede/pmake.el" "cedet/ede/proj-archive.el" "cedet/ede/proj-aux.el" -;;;;;; "cedet/ede/proj-comp.el" "cedet/ede/proj-elisp.el" "cedet/ede/proj-info.el" -;;;;;; "cedet/ede/proj-misc.el" "cedet/ede/proj-obj.el" "cedet/ede/proj-prog.el" -;;;;;; "cedet/ede/proj-scheme.el" "cedet/ede/proj-shared.el" "cedet/ede/proj.el" -;;;;;; "cedet/ede/project-am.el" "cedet/ede/shell.el" "cedet/ede/simple.el" -;;;;;; "cedet/ede/source.el" "cedet/ede/speedbar.el" "cedet/ede/srecode.el" -;;;;;; "cedet/ede/system.el" "cedet/ede/util.el" "cedet/pulse.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" +;;;;;; "calc/calc-loaddefs.el" "calc/calc-macs.el" "calc/calc-map.el" +;;;;;; "calc/calc-math.el" "calc/calc-menu.el" "calc/calc-misc.el" +;;;;;; "calc/calc-mode.el" "calc/calc-mtx.el" "calc/calc-nlfit.el" +;;;;;; "calc/calc-poly.el" "calc/calc-prog.el" "calc/calc-rewr.el" +;;;;;; "calc/calc-rules.el" "calc/calc-sel.el" "calc/calc-stat.el" +;;;;;; "calc/calc-store.el" "calc/calc-stuff.el" "calc/calc-trail.el" +;;;;;; "calc/calc-units.el" "calc/calc-vec.el" "calc/calc-yank.el" +;;;;;; "calc/calcalg2.el" "calc/calcalg3.el" "calc/calccomp.el" +;;;;;; "calc/calcsel2.el" "calendar/cal-bahai.el" "calendar/cal-coptic.el" +;;;;;; "calendar/cal-french.el" "calendar/cal-html.el" "calendar/cal-islam.el" +;;;;;; "calendar/cal-iso.el" "calendar/cal-julian.el" "calendar/cal-loaddefs.el" +;;;;;; "calendar/cal-mayan.el" "calendar/cal-menu.el" "calendar/cal-move.el" +;;;;;; "calendar/cal-persia.el" "calendar/cal-tex.el" "calendar/cal-x.el" +;;;;;; "calendar/diary-loaddefs.el" "calendar/hol-loaddefs.el" "cdl.el" +;;;;;; "cedet/cedet-cscope.el" "cedet/cedet-files.el" "cedet/cedet-global.el" +;;;;;; "cedet/cedet-idutils.el" "cedet/cedet.el" "cedet/ede/auto.el" +;;;;;; "cedet/ede/autoconf-edit.el" "cedet/ede/base.el" "cedet/ede/cpp-root.el" +;;;;;; "cedet/ede/custom.el" "cedet/ede/dired.el" "cedet/ede/emacs.el" +;;;;;; "cedet/ede/files.el" "cedet/ede/generic.el" "cedet/ede/linux.el" +;;;;;; "cedet/ede/loaddefs.el" "cedet/ede/locate.el" "cedet/ede/make.el" +;;;;;; "cedet/ede/makefile-edit.el" "cedet/ede/pconf.el" "cedet/ede/pmake.el" +;;;;;; "cedet/ede/proj-archive.el" "cedet/ede/proj-aux.el" "cedet/ede/proj-comp.el" +;;;;;; "cedet/ede/proj-elisp.el" "cedet/ede/proj-info.el" "cedet/ede/proj-misc.el" +;;;;;; "cedet/ede/proj-obj.el" "cedet/ede/proj-prog.el" "cedet/ede/proj-scheme.el" +;;;;;; "cedet/ede/proj-shared.el" "cedet/ede/proj.el" "cedet/ede/project-am.el" +;;;;;; "cedet/ede/shell.el" "cedet/ede/simple.el" "cedet/ede/source.el" +;;;;;; "cedet/ede/speedbar.el" "cedet/ede/srecode.el" "cedet/ede/system.el" +;;;;;; "cedet/ede/util.el" "cedet/pulse.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/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" @@ -32227,13 +32279,13 @@ Zone out, completely. ;;;;;; "cedet/semantic/fw.el" "cedet/semantic/grammar-wy.el" "cedet/semantic/grammar.el" ;;;;;; "cedet/semantic/html.el" "cedet/semantic/ia-sb.el" "cedet/semantic/ia.el" ;;;;;; "cedet/semantic/idle.el" "cedet/semantic/imenu.el" "cedet/semantic/java.el" -;;;;;; "cedet/semantic/lex-spp.el" "cedet/semantic/lex.el" "cedet/semantic/mru-bookmark.el" -;;;;;; "cedet/semantic/sb.el" "cedet/semantic/scope.el" "cedet/semantic/senator.el" -;;;;;; "cedet/semantic/sort.el" "cedet/semantic/symref.el" "cedet/semantic/symref/cscope.el" -;;;;;; "cedet/semantic/symref/filter.el" "cedet/semantic/symref/global.el" -;;;;;; "cedet/semantic/symref/grep.el" "cedet/semantic/symref/idutils.el" -;;;;;; "cedet/semantic/symref/list.el" "cedet/semantic/tag-file.el" -;;;;;; "cedet/semantic/tag-ls.el" "cedet/semantic/tag-write.el" +;;;;;; "cedet/semantic/lex-spp.el" "cedet/semantic/lex.el" "cedet/semantic/loaddefs.el" +;;;;;; "cedet/semantic/mru-bookmark.el" "cedet/semantic/sb.el" "cedet/semantic/scope.el" +;;;;;; "cedet/semantic/senator.el" "cedet/semantic/sort.el" "cedet/semantic/symref.el" +;;;;;; "cedet/semantic/symref/cscope.el" "cedet/semantic/symref/filter.el" +;;;;;; "cedet/semantic/symref/global.el" "cedet/semantic/symref/grep.el" +;;;;;; "cedet/semantic/symref/idutils.el" "cedet/semantic/symref/list.el" +;;;;;; "cedet/semantic/tag-file.el" "cedet/semantic/tag-ls.el" "cedet/semantic/tag-write.el" ;;;;;; "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" @@ -32245,11 +32297,11 @@ Zone out, completely. ;;;;;; "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" +;;;;;; "cedet/srecode/loaddefs.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/chart.el" "emacs-lisp/cl-extra.el" "emacs-lisp/cl-loaddefs.el" ;;;;;; "emacs-lisp/cl-macs.el" "emacs-lisp/cl-seq.el" "emacs-lisp/cl.el" @@ -32269,32 +32321,33 @@ Zone out, completely. ;;;;;; "eshell/em-pred.el" "eshell/em-prompt.el" "eshell/em-rebind.el" ;;;;;; "eshell/em-script.el" "eshell/em-smart.el" "eshell/em-term.el" ;;;;;; "eshell/em-unix.el" "eshell/em-xtra.el" "eshell/esh-arg.el" -;;;;;; "eshell/esh-cmd.el" "eshell/esh-ext.el" "eshell/esh-io.el" -;;;;;; "eshell/esh-module.el" "eshell/esh-opt.el" "eshell/esh-proc.el" -;;;;;; "eshell/esh-util.el" "eshell/esh-var.el" "ezimage.el" "foldout.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-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-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" "gnus/mailcap.el" "gnus/messcompat.el" -;;;;;; "gnus/mm-archive.el" "gnus/mm-bodies.el" "gnus/mm-decode.el" -;;;;;; "gnus/mm-util.el" "gnus/mm-view.el" "gnus/mml-sec.el" "gnus/mml-smime.el" -;;;;;; "gnus/nnagent.el" "gnus/nnbabyl.el" "gnus/nndir.el" "gnus/nndraft.el" -;;;;;; "gnus/nneething.el" "gnus/nngateway.el" "gnus/nnheader.el" -;;;;;; "gnus/nnimap.el" "gnus/nnir.el" "gnus/nnmail.el" "gnus/nnmaildir.el" -;;;;;; "gnus/nnmairix.el" "gnus/nnmbox.el" "gnus/nnmh.el" "gnus/nnnil.el" -;;;;;; "gnus/nnoo.el" "gnus/nnregistry.el" "gnus/nnrss.el" "gnus/nnspool.el" -;;;;;; "gnus/nntp.el" "gnus/nnvirtual.el" "gnus/nnweb.el" "gnus/registry.el" -;;;;;; "gnus/rfc1843.el" "gnus/rfc2045.el" "gnus/rfc2047.el" "gnus/rfc2104.el" -;;;;;; "gnus/rfc2231.el" "gnus/rtree.el" "gnus/shr-color.el" "gnus/sieve-manage.el" -;;;;;; "gnus/smime.el" "gnus/spam-stat.el" "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" +;;;;;; "eshell/esh-cmd.el" "eshell/esh-ext.el" "eshell/esh-groups.el" +;;;;;; "eshell/esh-io.el" "eshell/esh-module.el" "eshell/esh-opt.el" +;;;;;; "eshell/esh-proc.el" "eshell/esh-util.el" "eshell/esh-var.el" +;;;;;; "ezimage.el" "foldout.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-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-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" "gnus/mailcap.el" +;;;;;; "gnus/messcompat.el" "gnus/mm-archive.el" "gnus/mm-bodies.el" +;;;;;; "gnus/mm-decode.el" "gnus/mm-util.el" "gnus/mm-view.el" "gnus/mml-sec.el" +;;;;;; "gnus/mml-smime.el" "gnus/nnagent.el" "gnus/nnbabyl.el" "gnus/nndir.el" +;;;;;; "gnus/nndraft.el" "gnus/nneething.el" "gnus/nngateway.el" +;;;;;; "gnus/nnheader.el" "gnus/nnimap.el" "gnus/nnir.el" "gnus/nnmail.el" +;;;;;; "gnus/nnmaildir.el" "gnus/nnmairix.el" "gnus/nnmbox.el" "gnus/nnmh.el" +;;;;;; "gnus/nnnil.el" "gnus/nnoo.el" "gnus/nnregistry.el" "gnus/nnrss.el" +;;;;;; "gnus/nnspool.el" "gnus/nntp.el" "gnus/nnvirtual.el" "gnus/nnweb.el" +;;;;;; "gnus/registry.el" "gnus/rfc1843.el" "gnus/rfc2045.el" "gnus/rfc2047.el" +;;;;;; "gnus/rfc2104.el" "gnus/rfc2231.el" "gnus/rtree.el" "gnus/shr-color.el" +;;;;;; "gnus/sieve-manage.el" "gnus/smime.el" "gnus/spam-stat.el" +;;;;;; "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" @@ -32320,11 +32373,11 @@ Zone out, completely. ;;;;;; "net/hmac-def.el" "net/hmac-md5.el" "net/imap.el" "net/ldap.el" ;;;;;; "net/mairix.el" "net/newsticker.el" "net/ntlm.el" "net/sasl-cram.el" ;;;;;; "net/sasl-digest.el" "net/sasl-ntlm.el" "net/sasl.el" "net/soap-client.el" -;;;;;; "net/soap-inspect.el" "net/socks.el" "net/tls.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" +;;;;;; "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" @@ -32382,8 +32435,8 @@ Zone out, completely. ;;;;;; "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") (20718 10765 940268 -;;;;;; 335000)) +;;;;;; "w32-fns.el" "w32-vars.el" "x-dnd.el") (20706 50646 12288 +;;;;;; 733000)) ;;;*** diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index f0b671ec386..c35809ef648 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -60,10 +60,6 @@ ;; User options end here. -(defvar report-emacs-bug-tracker-url "http://debbugs.gnu.org/cgi/" - "Base URL of the GNU bugtracker. -Used for querying duplicates and linking to existing bugs.") - (defvar report-emacs-bug-orig-text nil "The automatically-created initial text of the bug report.") @@ -160,11 +156,6 @@ Prompts for bug subject. Leaves you in a mail buffer." (when (string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version) (setq topic (concat (match-string 1 emacs-version) "; " topic)))) (let ((from-buffer (current-buffer)) - ;; Put these properties on semantically-void text. - ;; report-emacs-bug-hook deletes these regions before sending. - (prompt-properties '(field emacsbug-prompt - intangible but-helpful - rear-nonsticky t)) (can-insert-mail (or (report-emacs-bug-can-use-xdg-email) (report-emacs-bug-can-use-osx-open))) user-point message-end-point) @@ -194,7 +185,7 @@ Prompts for bug subject. Leaves you in a mail buffer." (insert (format "The report will be sent to %s.\n\n" report-emacs-bug-address)) (insert "This bug report will be sent to the ") - (insert-button + (insert-text-button "Bug-GNU-Emacs" 'face 'link 'help-echo (concat "mouse-2, RET: Follow this link") @@ -202,7 +193,7 @@ Prompts for bug subject. Leaves you in a mail buffer." (browse-url "http://lists.gnu.org/archive/html/bug-gnu-emacs/")) 'follow-link t) (insert " mailing list\nand the GNU bug tracker at ") - (insert-button + (insert-text-button "debbugs.gnu.org" 'face 'link 'help-echo (concat "mouse-2, RET: Follow this link") @@ -220,11 +211,10 @@ usually do not have translators for other languages.\n\n"))) (insert "Please describe exactly what actions triggered the bug, and\n" "the precise symptoms of the bug. If you can, give a recipe\n" "starting from `emacs -Q':\n\n") - (add-text-properties (save-excursion - (rfc822-goto-eoh) - (line-beginning-position 2)) - (point) - prompt-properties) + (let ((txt (delete-and-extract-region + (save-excursion (rfc822-goto-eoh) (line-beginning-position 2)) + (point)))) + (insert (propertize "\n" 'display txt))) (setq user-point (point)) (insert "\n\n") @@ -236,7 +226,8 @@ usually do not have translators for other languages.\n\n"))) (if (file-readable-p debug-file) (insert "For information about debugging Emacs, please read the file\n" debug-file ".\n"))) - (add-text-properties (1+ user-point) (point) prompt-properties) + (let ((txt (delete-and-extract-region (1+ user-point) (point)))) + (insert (propertize "\n" 'display txt))) (insert "\n\nIn " (emacs-version) "\n") (if (stringp emacs-bzr-version) @@ -434,100 +425,8 @@ and send the mail again%s." from)) (not (yes-or-no-p (format "Is `%s' really your email address? " from))) - (error "Please edit the From address and try again")))) - ;; Delete the uninteresting text that was just to help fill out the report. - (rfc822-goto-eoh) - (forward-line 1) - (let ((pos (1- (point)))) - (while (setq pos (text-property-any pos (point-max) - 'field 'emacsbug-prompt)) - (delete-region pos (field-end (1+ pos))))))) - - -;; Querying the bug database - -(defvar report-emacs-bug-bug-alist nil) -(make-variable-buffer-local 'report-emacs-bug-bug-alist) -(defvar report-emacs-bug-choice-widget nil) -(make-variable-buffer-local 'report-emacs-bug-choice-widget) - -(defun report-emacs-bug-create-existing-bugs-buffer (bugs keywords) - (switch-to-buffer (get-buffer-create "*Existing Emacs Bugs*")) - (setq buffer-read-only t) - (let ((inhibit-read-only t)) - (erase-buffer) - (setq report-emacs-bug-bug-alist bugs) - (widget-insert (propertize (concat "Already known bugs (" - keywords "):\n\n") - 'face 'bold)) - (if bugs - (setq report-emacs-bug-choice-widget - (apply 'widget-create 'radio-button-choice - :value (caar bugs) - (let (items) - (dolist (bug bugs) - (push (list - 'url-link - :format (concat "Bug#" (number-to-string (nth 2 bug)) - ": " (cadr bug) "\n %[%v%]\n") - ;; FIXME: Why is only the link of the - ;; active item clickable? - (car bug)) - items)) - (nreverse items)))) - (widget-insert "No bugs matching your keywords found.\n")) - (widget-insert "\n") - (widget-create 'push-button - :notify (lambda (&rest ignore) - ;; TODO: Do something! - (message "Reporting new bug!")) - "Report new bug") - (when bugs - (widget-insert " ") - (widget-create 'push-button - :notify (lambda (&rest ignore) - (let ((val (widget-value report-emacs-bug-choice-widget))) - ;; TODO: Do something! - (message "Appending to bug %s!" - (nth 2 (assoc val report-emacs-bug-bug-alist))))) - "Append to chosen bug")) - (widget-insert " ") - (widget-create 'push-button - :notify (lambda (&rest ignore) - (kill-buffer)) - "Quit reporting bug") - (widget-insert "\n")) - (use-local-map widget-keymap) - (widget-setup) - (goto-char (point-min))) - -(defun report-emacs-bug-parse-query-results (status keywords) - (goto-char (point-min)) - (let (buglist) - (while (re-search-forward "<a href=\"bugreport\\.cgi\\?bug=\\([[:digit:]]+\\)\">\\([^<]+\\)</a>" nil t) - (let ((number (match-string 1)) - (subject (match-string 2))) - (when (not (string-match "^#" subject)) - (push (list - ;; first the bug URL - (concat report-emacs-bug-tracker-url - "bugreport.cgi?bug=" number) - ;; then the subject and number - subject (string-to-number number)) - buglist)))) - (report-emacs-bug-create-existing-bugs-buffer (nreverse buglist) keywords))) - -(defun report-emacs-bug-query-existing-bugs (keywords) - "Query for KEYWORDS at `report-emacs-bug-tracker-url', and return the result. -The result is an alist with items of the form (URL SUBJECT NO)." - (interactive "sBug keywords (comma separated): ") - (url-retrieve (concat report-emacs-bug-tracker-url - "pkgreport.cgi?include=subject%3A" - (replace-regexp-in-string "[[:space:]]+" "+" keywords) - ";package=emacs") - 'report-emacs-bug-parse-query-results (list keywords))) -(make-obsolete 'report-emacs-bug-query-existing-bugs - "use the `debbugs' package from GNU ELPA instead." "24.3") + (error "Please edit the From address and try again")))))) + (provide 'emacsbug) diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el index 271875e340c..3308e6416e3 100644 --- a/lisp/mail/mailabbrev.el +++ b/lisp/mail/mailabbrev.el @@ -472,10 +472,12 @@ of a mail alias. The value is set up, buffer-local, when first needed.") (defun mail-abbrev-expand-wrapper (expand) (if (and mail-abbrevs (not (eq mail-abbrevs t))) - (if (mail-abbrev-in-expansion-header-p) + (if (or (mail-abbrev-in-expansion-header-p) + ;; Necessary for `message-read-from-minibuffer' to work. + (window-minibuffer-p)) - ;; We are in a To: (or CC:, or whatever) header, and - ;; should use word-abbrevs to expand mail aliases. + ;; We are in a To: (or CC:, or whatever) header or a minibuffer, + ;; and should use word-abbrevs to expand mail aliases. (let ((local-abbrev-table mail-abbrevs)) ;; Before anything else, resolve aliases if they need it. diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index da19b367f1f..c6385498dcd 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -100,6 +100,10 @@ its character representation and its display representation.") "The current header display style choice, one of 'normal (selected headers) or 'full (all headers).") +(defvar rmail-mime-decoded nil + "Non-nil if message has been processed by `rmail-show-mime-function'.") +(put 'rmail-mime-decoded 'permanent-local t) ; for rmail-edit + (defgroup rmail nil "Mail reader for Emacs." :group 'mail) @@ -2169,20 +2173,35 @@ If MSGNUM is nil, use the current message." (defun rmail-set-header-1 (name value) "Subroutine of `rmail-set-header'. -Narrow to header, set header NAME to VALUE, replacing existing if present. -VALUE nil means to remove NAME altogether." +Narrow to headers, set header NAME to VALUE, replacing existing if present. +VALUE nil means to remove NAME altogether. + +Only changes the first instance of NAME. If VALUE is multi-line, +continuation lines should already be indented. VALUE should not +end in a newline." (if (search-forward "\n\n" nil t) (progn (forward-char -1) (narrow-to-region (point-min) (point)) + ;; cf mail-fetch-field. (goto-char (point-min)) - (if (re-search-forward (concat "^" (regexp-quote name) ":") nil 'move) + (if (let ((case-fold-search t)) + (re-search-forward (concat "^" (regexp-quote name) "[ \t]*:") + nil 'move)) + (let ((start (point)) + end) + (while (and (zerop (forward-line 1)) + (looking-at "[ \t]"))) + ;; Back up over newline. + (forward-char -1) + (setq end (point)) + (goto-char start) (if value (progn - (delete-region (point) (line-end-position)) + (delete-region start end) (insert " " value)) - (delete-region (line-beginning-position) - (line-beginning-position 2))) + (delete-region (line-beginning-position) (1+ end)))) + ;; Not already present: insert at end of headers. (if value (insert name ": " value "\n")))) (rmail-error-bad-format))) @@ -2699,6 +2718,27 @@ N defaults to the current message." :group 'rmail :version "23.1") +;; FIXME? +;; rmail-show-mime-function does not unquote >From lines. Should it? +(defcustom rmail-mbox-format 'mboxrd + "The mbox format that your system uses. +There is no way to determine this, so you should set the appropriate value. +The formats quote lines containing \"From \" differently. +The choices are: + `mboxo' : lines that start with \"From \" quoted as \">From \" + `mboxrd': lines that start with \">*From \" quoted with another \">\" +The `mboxo' format is ambiguous, in that one cannot know whether +a line starting with \">From \" originally had a \">\" or not. + +It is not critical to set this to the correct value; it only affects +how Rmail displays lines starting with \">*From \" in non-MIME messages. + +See also `unrmail-mbox-format'." + :type '(choice (const mboxrd) + (const mboxro)) + :version "24.4" + :group 'rmail-files) + (defun rmail-show-message-1 (&optional msg) "Show message MSG (default: current message) using `rmail-view-buffer'. Return text to display in the minibuffer if MSG is out of @@ -2747,6 +2787,7 @@ The current mail message becomes the message displayed." (re-search-forward "mime-version: 1.0" nil t)) (let ((rmail-buffer mbox-buf) (rmail-view-buffer view-buf)) + (set (make-local-variable 'rmail-mime-decoded) t) (funcall rmail-show-mime-function)) (setq body-start (search-forward "\n\n" nil t)) (narrow-to-region beg (point)) @@ -2791,11 +2832,15 @@ The current mail message becomes the message displayed." ;; Prepare the separator (blank line) before the body. (goto-char (point-min)) (insert "\n") - ;; Unquote quoted From lines - (while (re-search-forward "^>+From " nil t) - (beginning-of-line) - (delete-char 1) - (forward-line)) + ;; Unquote quoted From lines. + (let ((fromline (if (eq 'mboxrd rmail-mbox-format) + "^>+From " + "^>From ")) + case-fold-search) + (while (re-search-forward fromline nil t) + (beginning-of-line) + (delete-char 1) + (forward-line))) (goto-char (point-min))) ;; Copy the headers to the front of the message view buffer. (rmail-copy-headers beg end) @@ -3869,6 +3914,7 @@ see the documentation of `rmail-resend'." (msgnum rmail-current-message) (subject (concat "[" (let ((from (or (mail-fetch-field "From") + ;; FIXME - huh? (mail-fetch-field ">From")))) (if from (concat (mail-strip-quoted-names from) ": ") @@ -4193,31 +4239,25 @@ This has an effect only if a summary buffer exists." ;; Put the summary buffer back on the screen, if user wants that. (defun rmail-maybe-display-summary () - (let ((selected (selected-window)) - (buffer (current-buffer)) - window) - ;; If requested, make sure the summary is displayed. - (and rmail-summary-buffer (buffer-name rmail-summary-buffer) - rmail-redisplay-summary - (if (get-buffer-window rmail-summary-buffer 0) - ;; It's already in some frame; show that one. - (let ((frame (window-frame - (get-buffer-window rmail-summary-buffer 0)))) - (make-frame-visible frame) - (raise-frame frame)) - (display-buffer rmail-summary-buffer))) - ;; If requested, set the height of the summary window. - (and rmail-summary-buffer (buffer-name rmail-summary-buffer) - rmail-summary-window-size - (setq window (get-buffer-window rmail-summary-buffer)) - ;; Don't try to change the size if just one window in frame. - (not (eq window (frame-root-window (window-frame window)))) - (unwind-protect - (progn - (select-window window) - (enlarge-window (- rmail-summary-window-size (window-height)))) - (select-window selected) - (set-buffer buffer))))) + (cond + ((or (not rmail-summary-buffer) + (not (buffer-name rmail-summary-buffer)))) + (rmail-redisplay-summary + ;; If `rmail-redisplay-summary' is non-nil, make sure the summary + ;; buffer is displayed. + (display-buffer + rmail-summary-buffer + `(nil + (reusable-frames . 0) + ,(when rmail-summary-window-size + `(window-height . ,rmail-summary-window-size))))) + (rmail-summary-window-size + ;; If `rmail-summary-window-size' is non-nil and the summary buffer + ;; is displayed, make sure it gets resized. + (let ((window (get-buffer-window rmail-summary-buffer 0))) + (when window + (window-resize-no-error + window (- rmail-summary-window-size (window-height window)))))))) ;;;; *** Rmail Local Fontification *** @@ -4552,7 +4592,7 @@ encoded string (and the same mask) will decode the string." ;;; Start of automatically extracted autoloads. ;;;### (autoloads (rmail-edit-current-message) "rmailedit" "rmailedit.el" -;;;;;; "1aec1d54f9767ee0fea557bbfb1d547b") +;;;;;; "0b056146d4775080a1847b8ce7527bc5") ;;; Generated autoloads from rmailedit.el (autoload 'rmail-edit-current-message "rmailedit" "\ @@ -4607,7 +4647,7 @@ With prefix argument N moves forward N messages with these labels. ;;;*** -;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "da37981a8295ba2411fdfb77488b1cc3") +;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "93951f748e43e1015da1b485088970ca") ;;; Generated autoloads from rmailmm.el (autoload 'rmail-mime "rmailmm" "\ diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el index b880e21b8ca..68fc35e0e2a 100644 --- a/lisp/mail/rmailedit.el +++ b/lisp/mail/rmailedit.el @@ -167,10 +167,25 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'. (if (or rmail-old-mime-state (not rmail-old-pruned)) (forward-line 1)) - (while (re-search-forward "^>*From " nil t) - (beginning-of-line) - (insert ">") - (forward-line)) + ;; When editing a non-MIME message, rmail-show-message-1 has unescaped + ;; ^>*From lines according to rmail-mbox-format. We are editing + ;; the message as it was displayed, and need to put the escapes when done. + ;; When editing a MIME message, we are editing the "raw" message. + ;; ^>*From lines have not been escaped, but we still need to ensure + ;; a "^From " line is escaped so as not to break later parsing (?). + ;; With ^>+From lines, we have no way of knowing whether the person + ;; doing the editing escaped them or not, so it seems best to leave + ;; them alone. (This all assumes you are using rmailmm rather than + ;; something else that behaves differently.) + (let ((fromline (if (or (eq 'mboxo rmail-mbox-format) + rmail-mime-decoded) + "^From " + "^>*From ")) + case-fold-search) + (while (re-search-forward fromline nil t) + (beginning-of-line) + (insert ">") + (forward-line))) ;; Make sure buffer ends with a blank line so as not to run this ;; message together with the following one. (goto-char (point-max)) @@ -201,6 +216,7 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'. (setq buffer-undo-list t) (rmail-variables)) ;; If text has really changed, mark message as edited. + ;; FIXME we should do the comparison before escaping From lines. (unless (and (= (length old) (- (point-max) (point-min))) (string= old (buffer-substring (point-min) (point-max)))) (setq old nil) diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el index 71590f51dcb..350e3dacbcf 100644 --- a/lisp/mail/rmailmm.el +++ b/lisp/mail/rmailmm.el @@ -1365,14 +1365,15 @@ The arguments ARG and STATE have no effect in this case." (defun rmail-insert-mime-forwarded-message (forward-buffer) "Insert the message in FORWARD-BUFFER as a forwarded message. This is the usual value of `rmail-insert-mime-forwarded-message-function'." - (let ((message-buffer - (with-current-buffer forward-buffer - (if rmail-buffer-swapped - forward-buffer - rmail-view-buffer)))) - (save-restriction - (narrow-to-region (point) (point)) - (message-forward-make-body-mime message-buffer)))) + (let (contents-buffer start end) + (with-current-buffer forward-buffer + (setq contents-buffer + (if rmail-buffer-swapped + rmail-view-buffer + forward-buffer) + start (rmail-msgbeg rmail-current-message) + end (rmail-msgend rmail-current-message))) + (message-forward-make-body-mime contents-buffer start end))) (setq rmail-insert-mime-forwarded-message-function 'rmail-insert-mime-forwarded-message) diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index e86229a5cfb..e1dee3295f2 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -1493,6 +1493,9 @@ just append to the file, in Babyl format if necessary." (insert "\nMail-Followup-To: ")))) (defun mail-position-on-field (field &optional soft) + "Move to the start of the contents of header field FIELD. +If there is none, insert one, unless SOFT is non-nil. +If there are multiple FIELD fields, this goes to the first." (let (end (case-fold-search t)) (setq end (mail-header-end)) diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index 534c5fcb523..5bfa29a0175 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -529,6 +529,18 @@ The list is in preference order.") password (plist-get auth-info :secret))) (when (functionp password) (setq password (funcall password))) + (let ((result (catch 'done + (smtpmail-try-auth-method process mech user password)))) + (if (stringp result) + (progn + (auth-source-forget+ :host host :port port) + (throw 'done result)) + (when save-function + (funcall save-function)) + result)))) + +(defun smtpmail-try-auth-method (process mech user password) + (let (ret) (cond ((or (not mech) (not user) @@ -554,16 +566,11 @@ The list is in preference order.") ;; are taken as a response to the server, and the ;; authentication fails. (encoded (base64-encode-string response t))) - (smtpmail-command-or-throw process encoded) - (when save-function - (funcall save-function))))) + (smtpmail-command-or-throw process encoded)))) ((eq mech 'login) (smtpmail-command-or-throw process "AUTH LOGIN") - (smtpmail-command-or-throw - process (base64-encode-string user t)) - (smtpmail-command-or-throw process (base64-encode-string password t)) - (when save-function - (funcall save-function))) + (smtpmail-command-or-throw process (base64-encode-string user t)) + (smtpmail-command-or-throw process (base64-encode-string password t))) ((eq mech 'plain) ;; We used to send an empty initial request, and wait for an ;; empty response, and then send the password, but this @@ -574,9 +581,7 @@ The list is in preference order.") process (concat "AUTH PLAIN " (base64-encode-string (concat "\0" user "\0" password) t)) - 235) - (when save-function - (funcall save-function))) + 235)) (t (error "Mechanism %s not implemented" mech))))) diff --git a/lisp/mail/unrmail.el b/lisp/mail/unrmail.el index f6347d11051..698e9b0e0a0 100644 --- a/lisp/mail/unrmail.el +++ b/lisp/mail/unrmail.el @@ -1,4 +1,4 @@ -;;; unrmail.el --- convert Rmail Babyl files to mailbox files +;;; unrmail.el --- convert Rmail Babyl files to mbox files ;; Copyright (C) 1992, 2001-2013 Free Software Foundation, Inc. @@ -26,7 +26,7 @@ ;;;###autoload (defun batch-unrmail () - "Convert old-style Rmail Babyl files to system inbox format. + "Convert old-style Rmail Babyl files to mbox format. Specify the input Rmail Babyl file names as command line arguments. For each Rmail file, the corresponding output file name is made by adding `.mail' at the end. @@ -45,9 +45,26 @@ For example, invoke `emacs -batch -f batch-unrmail RMAIL'." (declare-function mail-mbox-from "mail-utils" ()) (defvar rmime-magic-string) ; in rmime.el, if you have it +(defcustom unrmail-mbox-format 'mboxrd + "The mbox format that `unrmail' should produce. +These formats separate messages using lines that start with \"From \". +Therefore any lines in the message bodies that start with \"From \" +must be quoted. The `mboxo' format just prepends a \">\" to such lines. +This is not reversible, because given a line starting with \">From \" in +an mboxo file, it is not possible to know whether the original had a \">\" +or not. The `mxbord' format avoids this by also quoting \">From \" as +\">>From \", and so on. For this reason, mboxrd is recommended. + +See also `rmail-mbox-format'." + :type '(choice (const mboxrd) + (const mboxro)) + :version "24.4" + :group 'rmail-files) + ;;;###autoload (defun unrmail (file to-file) - "Convert old-style Rmail Babyl file FILE to system inbox format file TO-FILE." + "Convert old-style Rmail Babyl file FILE to mbox format file TO-FILE. +The variable `unrmail-mbox-format' controls which mbox format to use." (interactive "fUnrmail (babyl file): \nFUnrmail into (new mailbox file): ") (with-temp-buffer ;; Read in the old Rmail file with no decoding. @@ -223,14 +240,15 @@ For example, invoke `emacs -batch -f batch-unrmail RMAIL'." (insert "X-RMAIL-ATTRIBUTES: " (apply 'string attrs) "\n") (when keywords (insert "X-RMAIL-KEYWORDS: " keywords "\n")) - (goto-char (point-min)) - ;; ``Quote'' "\nFrom " as "\n>From " - ;; (note that this isn't really quoting, as there is no requirement - ;; that "\n[>]+From " be quoted in the same transparent way.) - (let ((case-fold-search nil)) - (while (search-forward "\nFrom " nil t) - (forward-char -5) - (insert ?>))) + ;; Convert From to >From, etc. + (let ((case-fold-search nil) + (fromline (if (eq 'mboxrd unrmail-mbox-format) + "^>*From " + "^From "))) + (while (re-search-forward fromline nil t) + (beginning-of-line) + (insert ?>) + (forward-line 1))) (goto-char (point-max)) ;; Add terminator blank line to message. (insert "\n") diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in index 2c905fcb9eb..f4bbaf38040 100644 --- a/lisp/makefile.w32-in +++ b/lisp/makefile.w32-in @@ -104,27 +104,39 @@ WINS_CEDET=\ cedet/semantic/symref \ cedet/semantic/wisent -WINS_BASIC=\ +# The list of subdirectories is subdivided into 4 more or less equal +# parts so that we could have 4-way parallelism while compiling Lisp +# files, which helps to slash bootstrap times. See the 'compile' +# target below. +WINS_BASIC1=\ calc \ calendar \ emacs-lisp \ - emulation \ erc \ - eshell \ + net \ + url + +WINS_BASIC2=\ gnus \ international \ language \ - mail \ + mail + +WINS_BASIC3=\ + emulation \ mh-e \ - net \ nxml \ org \ play \ - progmodes \ textmodes \ - url \ vc +WINS_BASIC4=\ + eshell \ + progmodes + +WINS_BASIC= $(WINS_BASIC1) $(WINS_BASIC2) $(WINS_BASIC3) $(WINS_BASIC4) + # Directories with lisp files to compile, and to extract data from # (customs, autoloads, etc.) WINS_UPDATES=$(WINS_BASIC) \ @@ -311,22 +323,71 @@ TAGS-LISP-CMD: $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptagsf # compiled find the right files. # Need separate version for sh and native cmd.exe -compile: $(lisp)/subdirs.el compile-$(SHELLTYPE) doit +compile: $(lisp)/subdirs.el compile0-$(SHELLTYPE) compile1-$(SHELLTYPE) compile2-$(SHELLTYPE) compile3-$(SHELLTYPE) compile4-$(SHELLTYPE) doit -compile-CMD: autoloads +compile0-CMD: autoloads # -for %%f in ($(lisp) $(WINS)) do for %%g in (%%f\*.elc) do @attrib -r %%g for %%f in ($(COMPILE_FIRST)) do \ $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done %%f - for %%f in (. $(WINS)) do for %%g in (%%f/*.el) do \ + +compile1-CMD: autoloads compile0-CMD + for %%f in (. $(WINS_BASIC1)) do for %%g in (%%f/*.el) do \ $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done %%f/%%g -compile-SH: autoloads +compile2-CMD: autoloads compile0-CMD + for %%f in ($(WINS_BASIC2)) do for %%g in (%%f/*.el) do \ + $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done %%f/%%g + +compile3-CMD: autoloads compile0-CMD + for %%f in ($(WINS_BASIC3)) do for %%g in (%%f/*.el) do \ + $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done %%f/%%g + +compile4-CMD: autoloads compile0-CMD + for %%f in ($(WINS_BASIC4) $(WINS_CEDET) term obsolete) do for %%g in (%%f/*.el) do \ + $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done %%f/%%g + +compile0-SH: autoloads # for elc in $(lisp)/*.elc $(lisp)/*/*.elc; do attrib -r $$elc; done for el in $(COMPILE_FIRST); do \ echo Compiling $$el; \ $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done $$el; \ done - for dir in $(lisp) $(WINS); do \ + +compile1-SH: autoloads compile0-SH + for dir in $(lisp) $(WINS_BASIC1); do \ + for el in $$dir/*.el; do \ + if test -f $$el; \ + then \ + echo Compiling $$el; \ + $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done $$el; \ + fi \ + done; \ + done + +compile2-SH: autoloads compile0-SH + for dir in $(WINS_BASIC2); do \ + for el in $$dir/*.el; do \ + if test -f $$el; \ + then \ + echo Compiling $$el; \ + $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done $$el; \ + fi \ + done; \ + done + +compile3-SH: autoloads compile0-SH + for dir in $(WINS_BASIC3); do \ + for el in $$dir/*.el; do \ + if test -f $$el; \ + then \ + echo Compiling $$el; \ + $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done $$el; \ + fi \ + done; \ + done + +compile4-SH: autoloads compile0-SH + for dir in $(WINS_BASIC4) $(WINS_CEDET) term obsolete; do \ for el in $$dir/*.el; do \ if test -f $$el; \ then \ @@ -447,23 +508,24 @@ $(lisp)/mh-e/mh-loaddefs.el: $(MH_E_SRC) $(lisp)/subdirs.el $(ARGQUOTE)$(lisp)/mh-e/mh-loaddefs.el$(ARGQUOTE) $(MAKE) ./mh-e # Update TRAMP internal autoloads. Maybe we could move tramp*.el into -# its own subdirectory. OTOH, it does not hurt to keep them in +# an own subdirectory. OTOH, it does not hurt to keep them in # lisp/net. -TRAMP_SRC = $(lisp)/net/tramp.el $(lisp)/net/tramp-cache.el \ - $(lisp)/net/tramp-cmds.el $(lisp)/net/tramp-compat.el \ - $(lisp)/net/tramp-ftp.el $(lisp)/net/tramp-gvfs.el \ - $(lisp)/net/tramp-gw.el $(lisp)/net/tramp-sh.el \ - $(lisp)/net/tramp-smb.el $(lisp)/net/tramp-uu.el \ - $(lisp)/net/trampver.el - -$(lisp)/net/tramp-loaddefs.el: $(TRAMP_SRC) $(lisp)/subdirs.el +TRAMP_DIR = $(lisp)/net +TRAMP_SRC = $(TRAMP_DIR)/tramp.el $(TRAMP_DIR)/tramp-adb.el \ + $(TRAMP_DIR)/tramp-cache.el $(TRAMP_DIR)/tramp-cmds.el \ + $(TRAMP_DIR)/tramp-compat.el $(TRAMP_DIR)/tramp-ftp.el \ + $(TRAMP_DIR)/tramp-gvfs.el $(TRAMP_DIR)/tramp-gw.el \ + $(TRAMP_DIR)/tramp-sh.el $(TRAMP_DIR)/tramp-smb.el \ + $(TRAMP_DIR)/tramp-uu.el $(TRAMP_DIR)/trampver.el + +$(TRAMP_DIR)/tramp-loaddefs.el: $(TRAMP_SRC) $(lisp)/subdirs.el "$(EMACS)" $(EMACSOPT) \ -l autoload \ --eval $(ARGQUOTE)(setq generate-autoload-cookie $(DQUOTE);;;###tramp-autoload$(DQUOTE))$(ARGQUOTE) \ --eval $(ARGQUOTE)(setq find-file-suppress-same-file-warnings t)$(ARGQUOTE) \ --eval $(ARGQUOTE)(setq make-backup-files nil)$(ARGQUOTE) \ -f w32-batch-update-autoloads \ - $(ARGQUOTE)$(lisp)/net/tramp-loaddefs.el$(ARGQUOTE) $(MAKE) ./net + $(ARGQUOTE)$(TRAMP_DIR)/tramp-loaddefs.el$(ARGQUOTE) $(MAKE) ./net # Prepare a bootstrap in the lisp subdirectory. # diff --git a/lisp/man.el b/lisp/man.el index b6a6c179374..93a67128de4 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -1,4 +1,4 @@ -;;; man.el --- browse UNIX manual pages -*- coding: iso-8859-1 -*- +;;; man.el --- browse UNIX manual pages -*- coding: utf-8 -*- ;; Copyright (C) 1993-1994, 1996-1997, 2001-2013 Free Software ;; Foundation, Inc. @@ -276,7 +276,7 @@ Used in `bookmark-set' to get the default bookmark name." :type 'hook :group 'man) -(defvar Man-name-regexp "[-a-zA-Z0-9_+][-a-zA-Z0-9_.:+]*" +(defvar Man-name-regexp "[-a-zA-Z0-9_Â+][-a-zA-Z0-9_.:Â+]*" "Regular expression describing the name of a manpage (without section).") (defvar Man-section-regexp "[0-9][a-zA-Z0-9+]*\\|[LNln]" @@ -780,6 +780,59 @@ POS defaults to `point'." ;; but apparently that's not the case in all cases, so let's add a cache. "Cache of completion table of the form (PREFIX . TABLE).") +(defvar Man-man-k-use-anchor + ;; man-db or man-1.* + (memq system-type '(gnu gnu/linux gnu/kfreebsd)) + "If non-nil prepend ^ to the prefix passed to \"man -k\" for completion. +The value should be nil if \"man -k ^PREFIX\" may omit some man +pages whose names start with PREFIX. + +Currently, the default value depends on `system-type' and is +non-nil where the standard man programs are known to behave +properly. Setting the value to nil always gives correct results +but computing the list of completions may take a bit longer.") + +(defun Man-parse-man-k () + "Parse \"man -k\" output and return the list of page names. + +The current buffer should contain the output of a command of the +form \"man -k keyword\", which is traditionally also available with +apropos(1). + +While POSIX man(1p) is a bit vague about what to expect here, +this function tries to parse some commonly used formats, which +can be described in the following informal way, with square brackets +indicating optional parts and whitespace being interpreted +somewhat loosely. + +foo[, bar [, ...]] [other stuff] (sec) - description +foo(sec)[, bar(sec) [, ...]] [other stuff] - description + +For more details and some regression tests, please see +test/automated/man-tests.el in the emacs bzr repository." + (goto-char (point-min)) + ;; See man-tests for data about which systems use which format (hopefully we + ;; will be able to simplify the code if/when some of those formats aren't + ;; used any more). + (let (table) + (while (search-forward-regexp "^\\([^ \t,\n]+\\)\\(.*?\\)\ +\\(?:[ \t]\\(([^ \t,\n]+?)\\)\\)?\\(?:[ \t]+- ?\\(.*\\)\\)?$" nil t) + (let ((section (match-string 3)) + (description (match-string 4)) + (bound (match-end 2))) + (goto-char (match-end 1)) + (while + (progn + ;; The first regexp grouping may already match the section + ;; tacked on to the name, which is ok since for the formats we + ;; claim to support the third (non-shy) grouping does not + ;; match in this case, i.e., section is nil. + (push (propertize (concat (match-string 1) section) + 'help-echo description) + table) + (search-forward-regexp "\\=, *\\([^ \t,]+\\)" bound t))))) + (nreverse table))) + (defun Man-completion-table (string pred action) (cond ;; This ends up returning t for pretty much any string, and hence leads to @@ -811,16 +864,15 @@ POS defaults to `point'." ;; run differently in Man-getpage-in-background, an error ;; here may not necessarily mean that we'll also get an ;; error later. - (ignore-errors - (call-process manual-program nil '(t nil) nil - "-k" (concat "^" prefix)))) - (goto-char (point-min)) - (while (re-search-forward "^\\([^ \t\n]+\\)\\(?: ?\\((.+?)\\)\\(?:[ \t]+- \\(.*\\)\\)?\\)?" nil t) - (push (propertize (concat (match-string 1) (match-string 2)) - 'help-echo (match-string 3)) - table))) - ;; Cache the table for later reuse. - (setq Man-completion-cache (cons prefix table))) + (ignore-errors + (call-process manual-program nil '(t nil) nil + "-k" (concat (when (or Man-man-k-use-anchor + (string-equal prefix "")) + "^") + prefix)))) + (setq table (Man-parse-man-k))) + ;; Cache the table for later reuse. + (setq Man-completion-cache (cons prefix table))) ;; The table may contain false positives since the match is made ;; by "man -k" not just on the manpage's name. (if section @@ -891,6 +943,7 @@ names or descriptions. The pattern argument is usually an ;; ("man -k" is case-insensitive similarly, so the ;; table has everything available to complete) (completion-ignore-case t) + Man-completion-cache ;Don't cache across calls. (input (completing-read (format "Manual entry%s" (if (string= default-entry "") @@ -1395,7 +1448,7 @@ The following key bindings are currently in effect in the buffer: ;; Update len, in case a reference spans ;; more than two lines (paranoia). len (1- (length word)))) - (if (memq (aref word len) '(?- ?)) + (if (memq (aref word len) '(?- ?Â)) (setq hyphenated (substring word 0 len))) (and (string-match Man-reference-regexp word) (not (member word Man--refpages)) diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 024e2237cae..60f2bc2999f 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -1637,8 +1637,8 @@ key, a click, or a menu-item")) '(menu-item "Find Options by Value..." apropos-value :help "Find variables whose values match a regexp")) (bindings--define-key menu [find-options-by-name] - '(menu-item "Find Options by Name..." apropos-variable - :help "Find variables whose names match a regexp")) + '(menu-item "Find Options by Name..." apropos-user-option + :help "Find user options whose names match a regexp")) (bindings--define-key menu [find-commands-by-name] '(menu-item "Find Commands by Name..." apropos-command :help "Find commands whose names match a regexp")) diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog index 6794ff8bbfb..0854010e60f 100644 --- a/lisp/mh-e/ChangeLog +++ b/lisp/mh-e/ChangeLog @@ -1,3 +1,142 @@ +2013-01-23 Dmitry Antipov <dmantipov@yandex.ru> + + * mh-acros.el (mh-do-at-event-location): Use point-marker. + * mh-search.el (mh-index-create-imenu-index): Likewise. + * mh-xface.el (mh-x-image-url-display): Likewise. + +2012-11-25 Bill Wohler <wohler@newt.com> + + Release MH-E version 8.4. + + * mh-e.el (Version, mh-version): Update for release 8.4. + + * mh-comp.el (mh-regexp-in-field-syntax-table): Fix docstring. + (mh-edit-again): Format. + (mh-components-to-list): Fix docstring. + (mh-regexp-in-field-p): Remove unused variable `field'. + + * mh-compat.el (mh-define-obsolete-variable-alias) + (mh-make-obsolete-variable): New macros to fix XEmacs compiler + warnings. + + * mh-letter.el (mh-yank-hooks): Use new mh-make-obsolete-variable + macro. + + * mh-e.el (mh-kill-folder-suppress-prompt-hooks): Use + new mh-define-obsolete-variable-alias macro. + + * mh-compat.el (mh-cl-flet): New alias for cl-flet on Emacs 24 and + flet elsewhere. + + * mh-thread.el (mh-thread-set-tables): Replace flet with new alias + mh-cl-flet. + + * mh-show.el (mh-gnus-article-highlight-citation): + Replace flet with new alias mh-cl-flet. + + * mh-mime.el (mh-display-with-external-viewer, mh-mime-display) + (mh-press-button, mh-push-button, mh-display-emphasis): Replace + flet with new alias mh-cl-flet. + + * mh-e.el (mh-invisible-header-fields-internal): + Remove trailing whitespace. + +2012-11-25 Jeffrey C Honig <jch@honig.net> + + * mh-comp.el: (mh-edit-again): Use the components file to specify + default values for missing headers in the draft. + (mh-regexp-in-field-syntax-table, mh-fcc-syntax-table) + (mh-addr-syntax-table, mh-regexp-in-field-p): Use a syntax table + so we'll properly parse non-address fields. + (mh-components-to-list, mh-extract-header-field): New functions to + read components file. + (mh-find-components, mh-send-sub): Move code to locate components + file into a new function. + (mh-insert-auto-fields, mh-modify-header-field): New syntax for + calling mh-regexp-in-field-p (closes SF #1708292). + + * mh-e.el (mh-invisible-header-fields-internal): Added: X-xsi. + (addresses SF #1916032). + + * mh-folder.el (mh-inc-folder): Call mh-process-or-undo-commands + before running to insure we do not lose any pending changes. + (closes SF #2321115). + +2012-11-25 Ted Phelps <phelps@gnusto.com> + + Postpone junk processing (closes SF #2945712). Patch submitted by + Ted Phelps and refined by Bill Wohler. + + * mh-e.el (mh-blacklist, mh-whitelist): New variables. + (mh-whitelist-preserves-sequences-flag): New option. + (mh-before-commands-processed-hook): Update documentation. + (mh-blacklist-msg-hook, mh-whitelist-msg-hook): New hooks. + (mh-folder-blacklisted, mh-folder-whitelisted): New faces. + * mh-folder.el (mh-folder-message-menu): Add "Junk" to "Undo." + (mh-folder-font-lock-keywords): Add regexps for blacklisted and + whitelisted messages. + (mh-folder-mode): Add mh-blacklist and mh-whitelist variables. + (mh-execute-commands): Update documentation. + (mh-undo, mh-outstanding-commands-p, mh-process-commands) + (mh-delete-a-msg, mh-refile-a-msg, mh-undo-msg): Handle + blacklisted and whitelisted messages. + * mh-junk.el (mh-junk-blacklist, mh-junk-whitelist): Update to put + messages in blacklist and whitelist respectively for latter + processing. + (mh-blacklist-a-msg, mh-junk-whitelist-a-msg): New function to + support previous functions. + (mh-junk-blacklist-disposition): New function. + (mh-junk-process-blacklist, mh-junk-process-whitelist): New + functions that perform the blacklisting and whitelisting + respectively that used to be performed by mh-junk-blacklist and + mh-junk-whitelist. + * mh-scan.el (mh-scan-blacklisted-msg-regexp) + (mh-scan-whitelisted-msg-regexp): New scan line regexps. + (mh-scan-good-msg-regexp): Add B and W characters to regexp. + (mh-scan-cmd-note-width): Update documentation. + (mh-note-blacklisted, mh-note-whitelisted): New scan line + characters. + * mh-search.el (mh-index-execute-commands): Handle blacklisted and + whitelisted messages. + +2012-11-25 Jeffrey C Honig <jch@honig.net> + + * mh-e.el (mh-invisible-header-fields-internal): Added: + Bounces-To:, Bounces_to:, X-ACL-Warn:, X-BFI:, X-BPS1:, X-BPS2:, + X-Campaign-Id:, X-Campaign:, X-Cloudmark-SP-, X-Destination-ID:, + X-detected-operating-system:, X-DocGen-Version:, X-EM-, + X-Email-Type-Id:, X-FB-SS:, X-FuHaFi:, X-MailFlowPolicy:, + X-mail_abuse-inquires, X-MailingID:, X-Match:, + X-MaxCode-Template:, X-ME-Bayesian:, X-Sendergroup:, X-SFDC-, + X-SMFBL:, X-SMHeaderMap:, X-VGI-OESCD:, X-VirtualServer:, + X-VirtualServerGroup:, X-XPT-XSL-Name:, X-Y-GMX-Trusted:, + X-XWALL-, X-ZixNet:. Changed X-Habeas-SWE- to X-Habeas-. Updated + the comment. (addresses SF #1916032). + +2012-11-25 Bill Wohler <wohler@newt.com> + + * mh-e.el (mh-invisible-header-fields-internal): Add + X-AnalysisOut, X-Authentication-Info, X-Auto-Response-Suppress, + X-Bayes-Prob, X-Cam-, X-CanIt-Geo, X-Completed, X-Facebook, + X-Forwarded-, X-Generated-By, X-Headers-End, X-IEEE-UCE, + X-Jira-Fingerprint, X-Junkmail-, X-Launchpad-, X-MXL-Hash, + X-Notification-, X-Notifications, X-Oracle-Calendar. Replace + X-DCC-Usenix-Metrics with X-DCC- (addresses SF #1916032). + +2012-11-25 Jeffrey C Honig <jch@honig.net> + + * mh-letter.el (mh-yank-cur-msg): Replace usage of set-buffer with + with-current-buffer in mh-yang-cur-msg, semantics changed in emacs + 23 and we do not want to use set-buffer unless we actually want to + change the buffer the user is looking at (closes SF #2830504). + + * mh-show.el (mh-show-folder-map): Add missing key binding for + mh-show-pack-folder (closes SF #3466086). + +2012-11-25 Bill Wohler <wohler@newt.com> + + * mh-e.el (Version, mh-version): Add +bzr to version. + 2012-10-23 Stefan Monnier <monnier@iro.umontreal.ca> * mh-letter.el (mh-yank-hooks): Use make-obsolete-variable. diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el index 9f7fc0df68b..7d6279e4eca 100644 --- a/lisp/mh-e/mh-acros.el +++ b/lisp/mh-e/mh-acros.el @@ -233,7 +233,7 @@ preserved." (,original-window (selected-window)) (,original-position (progn (set-buffer (window-buffer ,event-window)) - (set-marker (make-marker) (point)))) + (point-marker))) (,modified-flag (buffer-modified-p)) (buffer-read-only nil)) (unwind-protect (progn diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el index f5aa0db7d7f..fbfc1207a5a 100644 --- a/lisp/mh-e/mh-comp.el +++ b/lisp/mh-e/mh-comp.el @@ -122,6 +122,42 @@ Used by the \\[mh-edit-again] and \\[mh-extract-rejected-mail] commands.") syntax-table) "Syntax table used by MH-E while in MH-Letter mode.") +(defvar mh-regexp-in-field-syntax-table nil + "Specify a syntax table for `mh-regexp-in-field-p' to use.") + +(defvar mh-fcc-syntax-table + (let ((syntax-table (make-syntax-table text-mode-syntax-table))) + (modify-syntax-entry ?+ "w" syntax-table) + (modify-syntax-entry ?/ "w" syntax-table) + syntax-table) + "Syntax table used by MH-E while searching an Fcc field.") + +(defvar mh-addr-syntax-table + (let ((syntax-table (make-syntax-table text-mode-syntax-table))) + (modify-syntax-entry ?! "w" syntax-table) + (modify-syntax-entry ?# "w" syntax-table) + (modify-syntax-entry ?$ "w" syntax-table) + (modify-syntax-entry ?% "w" syntax-table) + (modify-syntax-entry ?& "w" syntax-table) + (modify-syntax-entry ?' "w" syntax-table) + (modify-syntax-entry ?* "w" syntax-table) + (modify-syntax-entry ?+ "w" syntax-table) + (modify-syntax-entry ?- "w" syntax-table) + (modify-syntax-entry ?/ "w" syntax-table) + (modify-syntax-entry ?= "w" syntax-table) + (modify-syntax-entry ?? "w" syntax-table) + (modify-syntax-entry ?^ "w" syntax-table) + (modify-syntax-entry ?_ "w" syntax-table) + (modify-syntax-entry ?` "w" syntax-table) + (modify-syntax-entry ?{ "w" syntax-table) + (modify-syntax-entry ?| "w" syntax-table) + (modify-syntax-entry ?} "w" syntax-table) + (modify-syntax-entry ?~ "w" syntax-table) + (modify-syntax-entry ?. "w" syntax-table) + (modify-syntax-entry ?@ "w" syntax-table) + syntax-table) + "Syntax table used by MH-E while searching an address field.") + (defvar mh-send-args "" "Extra args to pass to \"send\" command.") @@ -392,13 +428,81 @@ See also `mh-send'." (mh-read-draft "clean-up" (mh-msg-filename message) nil))))) (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil) (mh-insert-header-separator) + ;; Merge in components + (mh-mapc + (function + (lambda (header-field) + (let ((field (car header-field)) + (value (cdr header-field)) + (case-fold-search t)) + (cond + ;; Address field + ((string-match field "^To$\\|^Cc$\\|^From$") + (cond + ((not (mh-goto-header-field (concat field ":"))) + ;; Header field does not exist, add it + (mh-goto-header-end 0) + (insert field ": " value "\n")) + ((string-equal value "") + ;; Header field already exists and no value + ) + (t + ;; Header field exists and we have a value + (let (address mailbox (alias (mh-alias-expand value))) + (and alias + (setq address (ietf-drums-parse-address alias)) + (setq mailbox (car address))) + ;; XXX - Need to parse all addresses out of field + (if (and + (not (mh-regexp-in-field-p + (concat "\\b" (regexp-quote value) "\\b") field)) + mailbox + (not (mh-regexp-in-field-p + (concat "\\b" (regexp-quote mailbox) "\\b") field))) + (insert " " value ",")) + )))) + ((string-match field "^Fcc$") + ;; Folder reference + (mh-modify-header-field field value)) + ;; Text field, that's an easy case + (t + (mh-modify-header-field field value)))))) + (mh-components-to-list (mh-find-components))) (goto-char (point-min)) (save-buffer) - (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil - config) + (mh-compose-and-send-mail + draft "" from-folder nil nil nil nil nil nil config) (mh-letter-mode-message) (mh-letter-adjust-point))) +(defun mh-extract-header-field () + "Extract field name and field value from the field at point. +Returns a list of field name and value (which may be null)." + (let ((end (save-excursion (mh-header-field-end) + (point)))) + (if (looking-at mh-letter-header-field-regexp) + (save-excursion + (goto-char (match-end 1)) + (forward-char 1) + (skip-chars-forward " \t") + (cons (match-string-no-properties 1) (buffer-substring-no-properties (point) end)))))) + + +(defun mh-components-to-list (components) + "Convert the COMPONENTS file to a list of field names and values." + (with-current-buffer (get-buffer-create mh-temp-buffer) + (erase-buffer) + (insert-file-contents components) + (goto-char (point-min)) + (let + ((header-fields nil)) + (while (mh-in-header-p) + (setq header-fields (append header-fields (list (mh-extract-header-field)))) + (mh-header-field-end) + (forward-char 1) + ) + header-fields))) + ;;;###mh-autoload (defun mh-extract-rejected-mail (message) "Edit a MESSAGE that was returned by the mail system. @@ -774,6 +878,22 @@ Optional argument BUFFER can be used to specify the buffer." (t nil)))) +(defun mh-find-components () + "Return the path to the components file." + (let (components) + (cond + ((file-exists-p + (setq components + (expand-file-name mh-comp-formfile mh-user-path))) + components) + ((file-exists-p + (setq components + (expand-file-name mh-comp-formfile mh-lib))) + components) + (t + (error "Can't find %s in %s or %s" + mh-comp-formfile mh-user-path mh-lib))))) + (defun mh-send-sub (to cc subject config) "Do the real work of composing and sending a letter. Expects the TO, CC, and SUBJECT fields as arguments. @@ -783,19 +903,7 @@ CONFIG is the window configuration before sending mail." (message "Composing a message...") (let ((draft (mh-read-draft "message" - (let (components) - (cond - ((file-exists-p - (setq components - (expand-file-name mh-comp-formfile mh-user-path))) - components) - ((file-exists-p - (setq components - (expand-file-name mh-comp-formfile mh-lib))) - components) - (t - (error "Can't find %s in %s or %s" - mh-comp-formfile mh-user-path mh-lib)))) + (mh-find-components) nil))) (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc) (goto-char (point-max)) @@ -1072,7 +1180,7 @@ discarded." (insert " " value) (delete-region (point) (mh-line-end-position))) ((and (not overwrite-flag) - (mh-regexp-in-field-p (concat "\\b" value "\\b") field)) + (mh-regexp-in-field-p (concat "\\b" (regexp-quote value) "\\b") field)) ;; Already there, do nothing. ) ((and (not overwrite-flag) @@ -1084,18 +1192,33 @@ discarded." (defun mh-regexp-in-field-p (regexp &rest fields) "Non-nil means REGEXP was found in FIELDS." - (save-excursion - (let ((search-result nil) - (field)) - (while fields - (setq field (car fields)) - (if (and (mh-goto-header-field field) - (re-search-forward - regexp (save-excursion (mh-header-field-end)(point)) t)) - (setq fields nil - search-result t) - (setq fields (cdr fields)))) - search-result))) + (let ((old-syntax-table (syntax-table))) + (unwind-protect + (save-excursion + (let ((search-result nil)) + (while fields + (let ((field (car fields)) + (syntax-table mh-regexp-in-field-syntax-table)) + (if (null syntax-table) + (let ((case-fold-search t)) + (cond + ((string-match field "^To$\\|^[BD]?cc$\\|^From$") + (setq syntax-table mh-addr-syntax-table)) + ((string-match field "^Fcc$") + (setq syntax-table mh-fcc-syntax-table)) + (t + (setq syntax-table (syntax-table))) + ))) + (if (and (mh-goto-header-field field) + (set-syntax-table syntax-table) + (re-search-forward + regexp (save-excursion (mh-header-field-end)(point)) t)) + (setq fields nil + search-result t) + (setq fields (cdr fields))) + (set-syntax-table old-syntax-table))) + search-result)) + (set-syntax-table old-syntax-table)))) (defun mh-ascii-buffer-p () "Check if current buffer is entirely composed of ASCII. diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el index 2ebe370205f..b755572c957 100644 --- a/lisp/mh-e/mh-compat.el +++ b/lisp/mh-e/mh-compat.el @@ -75,6 +75,12 @@ introduced in Emacs 22." 'cancel-timer 'delete-itimer)) +;; Emacs 24 renamed flet to cl-flet. +(defalias 'mh-cl-flet + (if (fboundp 'cl-flet) + 'cl-flet + 'flet)) + (defun mh-display-color-cells (&optional display) "Return the number of color cells supported by DISPLAY. This function is used by XEmacs to return 2 when `device-color-cells' @@ -242,6 +248,40 @@ This function returns nil on those systems." This function returns nil on those systems." nil) +(defmacro mh-define-obsolete-variable-alias + (obsolete-name current-name &optional when docstring) + "Make OBSOLETE-NAME a variable alias for CURRENT-NAME and mark it obsolete. +See documentation for `define-obsolete-variable-alias' for a description +of the arguments OBSOLETE-NAME, CURRENT-NAME, and perhaps WHEN +and DOCSTRING. This macro is used by XEmacs that lacks WHEN and +DOCSTRING arguments." + (if (featurep 'xemacs) + `(define-obsolete-variable-alias ,obsolete-name ,current-name) + `(define-obsolete-variable-alias ,obsolete-name ,current-name ,when ,docstring))) + +(defmacro mh-make-obsolete-variable (obsolete-name current-name &optional when access-type) + "Make the byte-compiler warn that OBSOLETE-NAME is obsolete. +See documentation for `make-obsolete-variable' for a description +of the arguments OBSOLETE-NAME, CURRENT-NAME, and perhaps WHEN +and ACCESS-TYPE. This macro is used by XEmacs that lacks WHEN and +ACCESS-TYPE arguments." + (if (featurep 'xemacs) + `(make-obsolete-variable ,obsolete-name ,current-name) + `(make-obsolete-variable ,obsolete-name ,current-name ,when ,access-type))) + +(defmacro mh-make-obsolete-variable (obsolete-name current-name &optional when access-type) + "Make the byte-compiler warn that OBSOLETE-NAME is obsolete. +See documentation for `make-obsolete-variable' for a description +of the arguments OBSOLETE-NAME, CURRENT-NAME, and perhaps WHEN +and ACCESS-TYPE. This macro is used by XEmacs that lacks WHEN and +ACCESS-TYPE arguments and by Emacs versions that lack ACCESS-TYPE, +introduced in Emacs 24." + (if (featurep 'xemacs) + `(make-obsolete-variable ,obsolete-name ,current-name) + (if (< emacs-major-version 24) + `(make-obsolete-variable ,obsolete-name ,current-name ,when) + `(make-obsolete-variable ,obsolete-name ,current-name ,when ,access-type)))) + (defun-mh mh-match-string-no-properties match-string-no-properties (num &optional string) "Return string of text matched by last search, without text properties. diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index 4f42242c288..334f73ff7ed 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -5,7 +5,7 @@ ;; Author: Bill Wohler <wohler@newt.com> ;; Maintainer: Bill Wohler <wohler@newt.com> -;; Version: 8.3.1 +;; Version: 8.4 ;; Keywords: mail ;; This file is part of GNU Emacs. @@ -127,7 +127,7 @@ ;; Try to keep variables local to a single file. Provide accessors if ;; variables are shared. Use this section as a last resort. -(defconst mh-version "8.3.1" "Version number of MH-E.") +(defconst mh-version "8.4" "Version number of MH-E.") ;; Variants @@ -230,6 +230,11 @@ User's mail folder directory.") (defvar mh-arrow-marker nil "Marker for arrow display in fringe.") +(defvar mh-blacklist nil + "List of messages to use to train the junk filter. +This variable can be used by +`mh-before-commands-processed-hook'.") + (defvar mh-colors-available-flag nil "Non-nil means colors are available.") @@ -291,6 +296,11 @@ Elements have the form (SEQUENCE . MESSAGES).") "Stack of operations that change the folder view. These operations include narrowing or threading.") +(defvar mh-whitelist nil + "List of messages to use to train the junk filter. +This variable can be used by +`mh-before-commands-processed-hook'.") + ;; MH-Show Locals (alphabetical) (defvar mh-globals-hash (make-hash-table) @@ -2215,6 +2225,17 @@ commands." :group 'mh-sequences :package-version '(MH-E . "7.0")) +(defcustom-mh mh-whitelist-preserves-sequences-flag t + "*Non-nil means that sequences are preserved when messages are whitelisted. + +If a message is in any sequence (except \"Previous-Sequence:\" +and \"cur\") when it is whitelisted, then it will still be in +those sequences in the destination folder. If this behavior is +not desired, then turn off this option." + :type 'boolean + :group 'mh-sequences + :package-version '(MH-E . "8.4")) + ;;; Reading Your Mail (:group 'mh-show) (defcustom-mh mh-bury-show-buffer-flag t @@ -2400,7 +2421,8 @@ of citations entirely, choose \"None\"." ;; "X-Mailer:" ; ;; "X-Operator:" ; Similar to X-Mailer, so display it -;; Keep fields alphabetized (set sort-fold-case to t first). +;; Keep fields alphabetized with case folding. Use M-:(setq +;; sort-fold-case t) from the minibuffer to accomplish this. ;; Mention source, if known. (defvar mh-invisible-header-fields-internal '( @@ -2418,6 +2440,8 @@ of citations entirely, choose \"None\"." "Auto-forwarded:" ; RFC 2156 "Autoforwarded:" ; RFC 2156 "Bestservhost:" + "Bounces-To:" + "Bounces_to:" "Bytes:" "Cancel-Key:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "Cancel-Lock:" ; NNTP posts @@ -2523,9 +2547,11 @@ of citations entirely, choose \"None\"." "X-Abuse-Info:" "X-Accept-Language:" ; Netscape/Mozilla "X-Ack:" + "X-ACL-Warn:" ; http://www.exim.org "X-Admin:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Administrivia-To:" "X-AMAZON" ; Amazon.com + "X-AnalysisOut:" ; Exchange "X-AntiAbuse:" ; cPanel "X-Antivirus-Scanner:" "X-AOL-IP:" ; AOL WebMail @@ -2535,18 +2561,30 @@ of citations entirely, choose \"None\"." "X-AuditID:" "X-Authenticated-Info:" ; Verizon.net? "X-Authenticated-Sender:" ; AT&T Message Center (webmail) + "X-Authentication-Info:" ; verizon.net? "X-Authentication-Warning:" ; sendmail "X-Authority-Analysis:" + "X-Auto-Response-Suppress:" ; Exchange "X-Barracuda-" ; Barracuda spam scores + "X-Bayes-Prob:" ; IEEE spam filter "X-Beenthere:" ; Mailman mailing list manager + "X-BFI:" "X-Bigfish:" "X-Bogosity:" ; bogofilter + "X-BPS1:" ; http://www.boggletools.com + "X-BPS2:" ; http://www.boggletools.com "X-Brightmail-Tracker:" ; Brightmail "X-BrightmailFiltered:" ; Brightmail "X-Bugzilla-" ; Bugzilla + "X-Cam-" ; Cambridge scanners + "X-Campaign-Id:" + "X-Campaign:" "X-Campaignid:" + "X-CanIt-Geo:" ; IEEE spam filter + "X-Cloudmark-SP-" ; Cloudmark (www.cloudmark.com) "X-Comment:" ; AT&T Mailennium "X-Complaints-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-Completed:" "X-Confirm-Reading-To:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Content-Filtered-By:" "X-ContentStamp:" ; NetZero @@ -2554,18 +2592,23 @@ of citations entirely, choose \"None\"." "X-Cr-Hashedpuzzle:" "X-Cr-Puzzleid:" "X-Cron-Env:" - "X-DCC-Usenix-Metrics:" + "X-DCC-" ; SpamAssassin "X-Declude-" ; http://www.declude.com/x-note.htm "X-Dedicated:" "X-Delivered" + "X-Destination-ID:" + "X-detected-operating-system:" ; GNU.ORG? "X-DH-Virus-" "X-DMCA" + "X-DocGen-Version:" ; DocGen "X-Domain:" "X-Echelon-Distraction" "X-EFL-Spamscore:" ; MIT alumni spam filtering "X-eGroups-" ; Egroups/yahoogroups mailing list manager "X-EID:" "X-ELNK-Trace:" ; Earthlink mailer + "X-EM-" ; Some ecommerce software + "X-Email-Type-Id:" ; Paypal http://www.paypal.com "X-Enigmail-Version:" "X-Envelope-Date:" ; GNU mailutils "X-Envelope-From:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ @@ -2575,29 +2618,39 @@ of citations entirely, choose \"None\"." "X-Evolution:" ; Evolution mail client "X-ExtLoop" "X-Face:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-Facebook" ; Facebook + "X-FB-SS:" "X-fmx-" "X-Folder:" ; Spam + "X-Forwarded-" ; Google+ "X-From-Line" + "X-FuHaFi:" ; http://www.gmx.net/ + "X-Generated-By:" ; launchpad.net "X-Gmail-" ; Gmail "X-Gnus-Mail-Source:" ; gnus "X-Google-" ; Google mail "X-Google-Sender-Auth:" "X-Greylist:" ; milter-greylist-1.2.1 - "X-Habeas-SWE-" ; Spam + "X-Habeas-" ; http://www.returnpath.net "X-Hashcash:" ; hashcash + "X-Headers-End:" ; SpamCop "X-HPL-" "X-HR-" "X-HTTP-UserAgent:" "X-Hz" ; Hertz "X-Identity:" ; http://www.declude.com/x-note.htm + "X-IEEE-UCE-" ; IEEE spam filter "X-Image-URL:" "X-IMAP:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Info:" ; NTMail "X-IronPort-" ; IronPort AV "X-ISI-4-30-3-MailScanner:" "X-J2-" + "X-Jira-Fingerprint:" ; JIRA + "X-Junkmail-" ; RCN? "X-Juno-" ; Juno "X-Key:" + "X-Launchpad-" ; plaunchpad.net "X-List-Host:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-List-Subscribe:" ; Unknown mailing list managers "X-List-Unsubscribe:" ; Unknown mailing list managers @@ -2606,18 +2659,24 @@ of citations entirely, choose \"None\"." "X-Loop:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Lrde-Mailscanner:" "X-Lumos-SenderID:" ; Roving ConstantContact + "X-mail_abuse_inquiries:" ; http://www.salesforce.com "X-Mail-from:" ; fastmail.fm "X-MAIL-INFO:" ; NetZero "X-Mailer_" + "X-MailFlowPolicy:" ; Cisco Email Security (formerly IronPort; http://www.ironport.com) "X-Mailing-List:" ; Unknown mailing list managers + "X-MailingID:" "X-Mailman-Approved-At:" ; Mailman mailing list manager "X-Mailman-Version:" ; Mailman mailing list manager "X-MailScanner" ; ListProc(tm) by CREN "X-Mailutils-Message-Id" ; GNU Mailutils "X-Majordomo:" ; Majordomo mailing list manager + "X-Match:" + "X-MaxCode-Template:" ; Paypal http://www.paypal.com "X-MB-Message-" ; AOL WebMail "X-MDaemon-Deliver-To:" "X-MDRemoteIP:" + "X-ME-Bayesian:" ; http://www.newmediadevelopment.net/page.cfm/parent/Client-Area/content/Managing-spam/ "X-Message-Id" "X-Message-Type:" "X-MessageWall-Score:" ; Unknown mailing list manager, AUC TeX @@ -2630,12 +2689,16 @@ of citations entirely, choose \"None\"." "X-MS-" ; MS Outlook "X-Msmail-" ; MS Outlook "X-MSMail-Priority" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-MXL-Hash:" "X-NAI-Spam-" ; Network Associates Inc. SpamKiller "X-News:" ; News "X-Newsreader:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-No-Archive:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ "X-Notes-Item:" ; Lotus Notes Domino structured header + "X-Notification-" ; Google+ + "X-Notifications:" ; Google+ "X-OperatingSystem:" + "X-Oracle-Calendar:" ; Oracle calendar invitations "X-ORBL:" "X-Orcl-Content-Type:" "X-Organization:" @@ -2652,6 +2715,7 @@ of citations entirely, choose \"None\"." "X-PID:" "X-PMG-" "X-PMX-Version:" + "X-Policyd-Weight:" ; policyd-weight (Postfix) "X-Postfilter:" "X-Priority:" ; MS Outlook "X-Proofpoint-" ; Proofpoint mail filter @@ -2677,14 +2741,20 @@ of citations entirely, choose \"None\"." "X-SBRS:" "X-SBRule:" ; Spam "X-Scanned-By:" + "X-Sender-ID:" ; Google+ "X-Sender:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-Sendergroup:" ; Cisco Email Security (formerly IronPort; http://www.ironport.com) "X-Server-Date:" "X-Server-Uuid:" "X-Service-Code:" + "X-SFDC-" ; http://www.salesforce.com "X-Sieve:" ; Sieve filtering + "X-SMFBL:" + "X-SMHeaderMap:" "X-SMTP-" "X-Source" - "X-Spam-" ; Spamassassin + "X-Spam-" ; SpamAssassin + "X-Spam:" ; Exchange "X-SpamBouncer:" ; Spam "X-SPF-" "X-Status" @@ -2692,6 +2762,7 @@ of citations entirely, choose \"None\"." "X-Submissions-To:" "X-Sun-Charset:" "X-Telecom-Digest" + "X-TM-IMSS-Message-ID:" ; http://www.trendmicro.com "X-Trace:" "X-UID" "X-UIDL:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ @@ -2702,15 +2773,23 @@ of citations entirely, choose \"None\"." "X-USANET-" ; usa.net "X-Usenet-Provider" "X-UserInfo1:" + "X-VGI-OESCD:" + "X-VirtualServer:" + "X-VirtualServerGroup:" "X-Virus-" ; "X-Vms-To:" "X-VSMLoop:" ; NTMail "X-WebTV-Signature:" "X-Wss-Id:" ; Worldtalk gateways "X-X-Sender:" ; http://people.dsv.su.se/~jpalme/ietf/mail-headers/ + "X-XPT-XSL-Name:" ; Paypal http://www.paypal.com + "X-xsi-" + "X-XWALL-" ; http://www.dataenter.co.at/doc/xwall_undocumented_config.htm + "X-Y-GMX-Trusted:" ; http://www.gmx.net/ "X-Yahoo" "X-Yahoo-Newman-" "X-YMail-" + "X-ZixNet:" "X400-" ; X400 "Xref:" ; RFC 1036 ) @@ -3104,9 +3183,10 @@ annotated messages with `mh-annotate-list'." (defcustom-mh mh-before-commands-processed-hook nil "Hook run by \\<mh-folder-mode-map>\\[mh-execute-commands] before performing outstanding refile and delete requests. -Variables that are useful in this hook include `mh-delete-list' -and `mh-refile-list' which can be used to see which changes will -be made to the current folder, `mh-current-folder'." +Variables that are useful in this hook include `mh-delete-list', +`mh-refile-list', `mh-blacklist', and `mh-whitelist' which can be +used to see which changes will be made to the current folder, +`mh-current-folder'." :type 'hook :group 'mh-hooks :group 'mh-folder @@ -3136,6 +3216,13 @@ before sending, add the `ispell-message' function." :group 'mh-letter :package-version '(MH-E . "6.0")) +(defcustom-mh mh-blacklist-msg-hook nil + "Hook run by \\<mh-letter-mode-map>\\[mh-junk-blacklist] after marking each message for blacklisting." + :type 'hook + :group 'mh-hooks + :group 'mh-show + :package-version '(MH-E . "8.4")) + (defcustom-mh mh-delete-msg-hook nil "Hook run by \\<mh-letter-mode-map>\\[mh-delete-msg] after marking each message for deletion. @@ -3189,7 +3276,7 @@ function used to insert the signature with :group 'mh-letter :package-version '(MH-E . "8.0")) -(define-obsolete-variable-alias 'mh-kill-folder-suppress-prompt-hooks +(mh-define-obsolete-variable-alias 'mh-kill-folder-suppress-prompt-hooks 'mh-kill-folder-suppress-prompt-functions "24.3") (defcustom-mh mh-kill-folder-suppress-prompt-functions '(mh-search-p) "Abnormal hook run at the beginning of \\<mh-folder-mode-map>\\[mh-kill-folder]. @@ -3301,6 +3388,13 @@ sequence." :group 'mh-sequences :package-version '(MH-E . "6.0")) +(defcustom-mh mh-whitelist-msg-hook nil + "Hook run by \\<mh-letter-mode-map>\\[mh-junk-whitelist] after marking each message for whitelisting." + :type 'hook + :group 'mh-hooks + :group 'mh-show + :package-version '(MH-E . "8.4")) + ;;; Faces (:group 'mh-faces + group where faces described) @@ -3519,6 +3613,13 @@ specified colors." :group 'mh-folder :package-version '(MH-E . "8.0")) +(defface-mh mh-folder-blacklisted + (mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-msg-number)))) + "Blacklisted message face." + :group 'mh-faces + :group 'mh-folder + :package-version '(MH-E . "8.4")) + (defface-mh mh-folder-body (mh-face-data 'mh-folder-msg-number '((((class color)) @@ -3608,6 +3709,13 @@ format `mh-scan-format-nmh' and the regular expression :group 'mh-folder :package-version '(MH-E . "8.0")) +(defface-mh mh-folder-whitelisted + (mh-face-data 'mh-folder-refiled '((t (:inherit mh-folder-refiled)))) + "Whitelisted message face." + :group 'mh-faces + :group 'mh-folder + :package-version '(MH-E . "8.4")) + (defface-mh mh-letter-header-field (mh-face-data 'mh-letter-header-field) "Editable header field value face in draft buffers." :group 'mh-faces diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el index f891997d7bc..f3ea8003ed0 100644 --- a/lisp/mh-e/mh-folder.el +++ b/lisp/mh-e/mh-folder.el @@ -162,9 +162,9 @@ annotation.") ["Go to Last Message" mh-last-msg t] ["Go to Message by Number..." mh-goto-msg t] ["Modify Message" mh-modify t] - ["Delete Message" mh-delete-msg (mh-get-msg-num nil)] ["Refile Message" mh-refile-msg (mh-get-msg-num nil)] - ["Undo Delete/Refile" mh-undo (mh-outstanding-commands-p)] + ["Delete Message" mh-delete-msg (mh-get-msg-num nil)] + ["Undo Delete/Refile/Junk" mh-undo (mh-outstanding-commands-p)] ["Execute Delete/Refile" mh-execute-commands (mh-outstanding-commands-p)] "--" @@ -405,12 +405,18 @@ See `mh-set-help'.") ;; Folders when displaying index buffer (list "^\\+.*" '(0 'mh-search-folder)) - ;; Marked for deletion - (list (concat mh-scan-deleted-msg-regexp ".*") - '(0 'mh-folder-deleted)) ;; Marked for refile (list (concat mh-scan-refiled-msg-regexp ".*") '(0 'mh-folder-refiled)) + ;; Marked for deletion + (list (concat mh-scan-deleted-msg-regexp ".*") + '(0 'mh-folder-deleted)) + ;; Marked for blacklisting + (list (concat mh-scan-blacklisted-msg-regexp ".*") + '(0 'mh-folder-blacklisted)) + ;; Marked for whitelisting + (list (concat mh-scan-whitelisted-msg-regexp ".*") + '(0 'mh-folder-whitelisted)) ;; After subject (list mh-scan-body-regexp '(1 'mh-folder-body nil t)) @@ -614,8 +620,10 @@ perform the operation on all messages in that region. 'overlay-arrow-position nil ; Allow for simultaneous display in 'overlay-arrow-string ">" ; different MH-E buffers. 'mh-showing-mode nil ; Show message also? - 'mh-delete-list nil ; List of msgs nums to delete 'mh-refile-list nil ; List of folder names in mh-seq-list + 'mh-delete-list nil ; List of msgs nums to delete + 'mh-blacklist nil ; List of messages to process as spam + 'mh-whitelist nil ; List of messages to process as ham 'mh-seq-list nil ; Alist of (seq . msgs) nums 'mh-seen-list nil ; List of displayed messages 'mh-next-direction 'forward ; Direction to move to next message @@ -709,15 +717,15 @@ RANGE is read in interactive use." ;;;###mh-autoload (defun mh-execute-commands () - "Process outstanding delete and refile requests\\<mh-folder-mode-map>. + "Perform outstanding operations\\<mh-folder-mode-map>. -If you've marked messages to be deleted or refiled and you want -to go ahead and delete or refile the messages, use this command. -Many MH-E commands that may affect the numbering of the -messages (such as \\[mh-rescan-folder] or \\[mh-pack-folder]) -will ask if you want to process refiles or deletes first and then -either run this command for you or undo the pending refiles and -deletes. +If you've marked messages to be refiled, deleted, blacklisted, or +whitelisted and you want to go ahead and perform these operations +on these messages, use this command. Many MH-E commands that may +affect the numbering of the messages (such as +\\[mh-rescan-folder] or \\[mh-pack-folder]) will ask if you want +to perform these operations first and then either run this +command for you or undo the pending operations. This function runs `mh-before-commands-processed-hook' before the commands are processed and `mh-after-commands-processed-hook' @@ -766,7 +774,7 @@ the message." return-value)) ;;;###mh-autoload -(defun mh-inc-folder (&optional file folder) +(defun mh-inc-folder (&optional file folder dont-exec-pending) "Incorporate new mail into a folder. You can incorporate mail from any file into the current folder by @@ -777,7 +785,10 @@ The hook `mh-inc-folder-hook' is run after incorporating new mail. Do not call this function from outside MH-E; use \\[mh-rmail] -instead." +instead. + +In a program, the processing of outstanding commands is not performed +if DONT-EXEC-PENDING is non-nil." (interactive (list (if current-prefix-arg (expand-file-name (read-file-name "inc mail from file: " @@ -786,6 +797,8 @@ instead." (mh-prompt-for-folder "inc mail into" mh-inbox t)))) (if (not folder) (setq folder mh-inbox)) + (unless dont-exec-pending + (mh-process-or-undo-commands folder)) (let ((threading-needed-flag nil)) (let ((config (current-window-configuration))) (when (and mh-show-buffer (get-buffer mh-show-buffer)) @@ -1181,14 +1194,18 @@ RANGE is read in interactive use." (cond ((numberp range) (let ((original-position (point))) (beginning-of-line) - (while (not (or (looking-at mh-scan-deleted-msg-regexp) - (looking-at mh-scan-refiled-msg-regexp) + (while (not (or (looking-at mh-scan-refiled-msg-regexp) + (looking-at mh-scan-deleted-msg-regexp) + (looking-at mh-scan-blacklisted-msg-regexp) + (looking-at mh-scan-whitelisted-msg-regexp) (and (eq mh-next-direction 'forward) (bobp)) (and (eq mh-next-direction 'backward) (save-excursion (forward-line) (eobp))))) (forward-line (if (eq mh-next-direction 'forward) -1 1))) - (if (or (looking-at mh-scan-deleted-msg-regexp) - (looking-at mh-scan-refiled-msg-regexp)) + (if (or (looking-at mh-scan-refiled-msg-regexp) + (looking-at mh-scan-deleted-msg-regexp) + (looking-at mh-scan-blacklisted-msg-regexp) + (looking-at mh-scan-whitelisted-msg-regexp)) (progn (mh-undo-msg (mh-get-msg-num t)) (mh-maybe-show)) @@ -1520,7 +1537,7 @@ is updated." (save-excursion (when (eq major-mode 'mh-show-mode) (set-buffer mh-show-folder-buffer)) - (or mh-delete-list mh-refile-list))) + (or mh-delete-list mh-refile-list mh-blacklist mh-whitelist))) ;;;###mh-autoload (defun mh-set-folder-modified-p (flag) @@ -1544,10 +1561,15 @@ after the commands are processed." (let ((redraw-needed-flag mh-index-data) (folders-changed (list mh-current-folder)) - (seq-map (and mh-refile-list mh-refile-preserves-sequences-flag - (mh-create-sequence-map mh-seq-list))) + (seq-map (and + (or (and mh-refile-list mh-refile-preserves-sequences-flag) + (and mh-whitelist + mh-whitelist-preserves-sequences-flag)) + (mh-create-sequence-map mh-seq-list))) (dest-map (and mh-refile-list mh-refile-preserves-sequences-flag - (make-hash-table)))) + (make-hash-table))) + (white-map (and mh-whitelist mh-whitelist-preserves-sequences-flag + (make-hash-table)))) ;; Remove invalid scan lines if we are in an index folder and then remove ;; the real messages (when mh-index-data @@ -1594,6 +1616,49 @@ after the commands are processed." (mh-delete-scan-msgs mh-delete-list) (setq mh-delete-list nil))) + ;; Blacklist messages. + (when mh-blacklist + (let ((msg-list (mh-coalesce-msg-list mh-blacklist)) + (dest (mh-junk-blacklist-disposition))) + (mh-junk-process-blacklist mh-blacklist) + ;; TODO I wonder why mh-exec-cmd is used instead of the following: + ;; (mh-refile-a-msg nil (intern dest)) + ;; (mh-delete-a-msg nil))) + (if (null dest) + (apply 'mh-exec-cmd "rmm" folder msg-list) + (apply 'mh-exec-cmd "refile" "-src" folder dest msg-list) + (push dest folders-changed)) + (setq redraw-needed-flag t) + (mh-delete-scan-msgs mh-blacklist) + (setq mh-blacklist nil))) + + ;; Whitelist messages. + (when mh-whitelist + (let ((msg-list (mh-coalesce-msg-list mh-whitelist)) + (last (car (mh-translate-range mh-inbox "last")))) + (mh-junk-process-whitelist mh-whitelist) + (apply #'mh-exec-cmd "refile" "-src" folder mh-inbox msg-list) + (push mh-inbox folders-changed) + (setq redraw-needed-flag t) + (mh-delete-scan-msgs mh-whitelist) + (when mh-whitelist-preserves-sequences-flag + (clrhash white-map) + (loop for i from (1+ (or last 0)) + for msg in (sort (copy-sequence mh-whitelist) #'<) + do (loop for seq-name in (gethash msg seq-map) + do (push i (gethash seq-name white-map)))) + (maphash + #'(lambda (seq msgs) + ;; Can't be run in background, since the current + ;; folder is changed by mark this could lead to a + ;; race condition with the next refile/whitelist. + (apply #'mh-exec-cmd "mark" + "-sequence" (symbol-name seq) mh-inbox + "-add" (mapcar #'(lambda(x) (format "%s" x)) + (mh-coalesce-msg-list msgs)))) + white-map)) + (setq mh-whitelist nil))) + ;; Don't need to remove sequences since delete and refile do so. ;; Mark cur message (if (> (buffer-size) 0) @@ -1904,6 +1969,10 @@ once when he kept statistics on his mail usage." (setq message (mh-get-msg-num t))) (if (looking-at mh-scan-refiled-msg-regexp) (error "Message %d is refiled; undo refile before deleting" message)) + (if (looking-at mh-scan-blacklisted-msg-regexp) + (error "Message %d is blacklisted; undo before deleting" message)) + (if (looking-at mh-scan-whitelisted-msg-regexp) + (error "Message %d is whitelisted; undo before deleting" message)) (if (looking-at mh-scan-deleted-msg-regexp) nil (mh-set-folder-modified-p t) @@ -1925,6 +1994,10 @@ be refiled." (setq message (mh-get-msg-num t))) (cond ((looking-at mh-scan-deleted-msg-regexp) (error "Message %d is deleted; undo delete before moving" message)) + ((looking-at mh-scan-blacklisted-msg-regexp) + (error "Message %d is blacklisted; undo before moving" message)) + ((looking-at mh-scan-whitelisted-msg-regexp) + (error "Message %d is whitelisted; undo before moving" message)) ((looking-at mh-scan-refiled-msg-regexp) (if (y-or-n-p (format "Message %d already refiled; copy to %s as well? " @@ -1943,7 +2016,7 @@ be refiled." (run-hooks 'mh-refile-msg-hook))))) (defun mh-undo-msg (msg) - "Undo the deletion or refile of one MSG. + "Undo the deletion, refile, black- or whitelisting of one MSG. If MSG is nil then act on the message at point" (save-excursion (if (numberp msg) @@ -1952,6 +2025,10 @@ If MSG is nil then act on the message at point" (setq msg (mh-get-msg-num t))) (cond ((memq msg mh-delete-list) (setq mh-delete-list (delq msg mh-delete-list))) + ((memq msg mh-blacklist) + (setq mh-blacklist (delq msg mh-blacklist))) + ((memq msg mh-whitelist) + (setq mh-whitelist (delq msg mh-whitelist))) (t (dolist (folder-msg-list mh-refile-list) (setf (cdr folder-msg-list) (remove msg (cdr folder-msg-list)))) diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el index 9f42d2581d0..d7632ffc729 100644 --- a/lisp/mh-e/mh-junk.el +++ b/lisp/mh-e/mh-junk.el @@ -52,27 +52,64 @@ program, see: - `mh-bogofilter-blacklist' - `mh-spamprobe-blacklist'" (interactive (list (mh-interactive-range "Blacklist"))) + (mh-iterate-on-range () range (mh-blacklist-a-msg nil)) + (if (looking-at mh-scan-blacklisted-msg-regexp) + (mh-next-msg))) + +(defun mh-blacklist-a-msg (message) + "Blacklist MESSAGE. +If MESSAGE is nil then the message at point is blacklisted. +The hook `mh-blacklisted-msg-hook' is called after you mark a message +for blacklisting." + (save-excursion + (if (numberp message) + (mh-goto-msg message nil t) + (beginning-of-line) + (setq message (mh-get-msg-num t))) + (cond ((looking-at mh-scan-refiled-msg-regexp) + (error "Message %d is refiled; undo refile before blacklisting" + message)) + ((looking-at mh-scan-deleted-msg-regexp) + (error "Message %d is deleted; undo delete before blacklisting" + message)) + ((looking-at mh-scan-whitelisted-msg-regexp) + (error "Message %d is whitelisted; undo before blacklisting" + message)) + ((looking-at mh-scan-blacklisted-msg-regexp) nil) + (t + (mh-set-folder-modified-p t) + (setq mh-blacklist (cons message mh-blacklist)) + (if (not (memq message mh-seen-list)) + (setq mh-seen-list (cons message mh-seen-list))) + (mh-notate nil mh-note-blacklisted mh-cmd-note) + (run-hooks 'mh-blacklist-msg-hook))))) + +;;;###mh-autoload +(defun mh-junk-blacklist-disposition () + "Determines the fate of the selected spam." + (cond ((null mh-junk-disposition) nil) + ((equal mh-junk-disposition "") "+") + ((eq (aref mh-junk-disposition 0) ?+) + mh-junk-disposition) + ((eq (aref mh-junk-disposition 0) ?@) + (concat mh-current-folder "/" + (substring mh-junk-disposition 1))) + (t (concat "+" mh-junk-disposition)))) + +;;;###mh-autoload +(defun mh-junk-process-blacklist (range) + "Blacklist RANGE as spam. +This command trains the spam program in use (see the option +`mh-junk-program') with the content of RANGE and then handles the +message(s) as specified by the option `mh-junk-disposition'." (let ((blacklist-func (nth 1 (assoc mh-junk-choice mh-junk-function-alist)))) (unless blacklist-func (error "Customize `mh-junk-program' appropriately")) - (let ((dest (cond ((null mh-junk-disposition) nil) - ((equal mh-junk-disposition "") "+") - ((eq (aref mh-junk-disposition 0) ?+) - mh-junk-disposition) - ((eq (aref mh-junk-disposition 0) ?@) - (concat mh-current-folder "/" - (substring mh-junk-disposition 1))) - (t (concat "+" mh-junk-disposition))))) - (mh-iterate-on-range msg range - (message "Blacklisting message %d..." msg) - (funcall (symbol-function blacklist-func) msg) - (message "Blacklisting message %d...done" msg) - (if (not (memq msg mh-seen-list)) - (setq mh-seen-list (cons msg mh-seen-list))) - (if dest - (mh-refile-a-msg nil (intern dest)) - (mh-delete-a-msg nil))) - (mh-next-msg)))) + (mh-iterate-on-range msg range + (message "Blacklisting message %d..." msg) + (funcall (symbol-function blacklist-func) msg) + (message "Blacklisting message %d...done" msg)) + (mh-next-msg))) ;;;###mh-autoload (defun mh-junk-whitelist (range) @@ -85,14 +122,49 @@ refiles the message into the \"+inbox\" folder. Check the documentation of `mh-interactive-range' to see how RANGE is read in interactive use." (interactive (list (mh-interactive-range "Whitelist"))) + (mh-iterate-on-range () range (mh-junk-whitelist-a-msg nil)) + (if (looking-at mh-scan-whitelisted-msg-regexp) + (mh-next-msg))) + +(defun mh-junk-whitelist-a-msg (message) + "Whitelist MESSAGE. +If MESSAGE is nil then the message at point is whitelisted. The +hook `mh-whitelist-msg-hook' is called after you mark a message +for whitelisting." + (save-excursion + (if (numberp message) + (mh-goto-msg message nil t) + (beginning-of-line) + (setq message (mh-get-msg-num t))) + (cond ((looking-at mh-scan-refiled-msg-regexp) + (error "Message %d is refiled; undo refile before whitelisting" + message)) + ((looking-at mh-scan-deleted-msg-regexp) + (error "Message %d is deleted; undo delete before whitelisting" + message)) + ((looking-at mh-scan-blacklisted-msg-regexp) + (error "Message %d is blacklisted; undo before whitelisting" + message)) + ((looking-at mh-scan-whitelisted-msg-regexp) nil) + (t + (mh-set-folder-modified-p t) + (setq mh-whitelist (cons message mh-whitelist)) + (mh-notate nil mh-note-whitelisted mh-cmd-note) + (run-hooks 'mh-whitelist-msg-hook))))) + +;;;###mh-autoload +(defun mh-junk-process-whitelist (range) + "Whitelist RANGE as ham. + +This command reclassifies the RANGE as ham if it were incorrectly +classified as spam (see the option `mh-junk-program')." (let ((whitelist-func (nth 2 (assoc mh-junk-choice mh-junk-function-alist)))) (unless whitelist-func (error "Customize `mh-junk-program' appropriately")) (mh-iterate-on-range msg range (message "Whitelisting message %d..." msg) (funcall (symbol-function whitelist-func) msg) - (message "Whitelisting message %d...done" msg) - (mh-refile-a-msg nil (intern mh-inbox))) + (message "Whitelisting message %d...done" msg)) (mh-next-msg))) diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el index b2db25f674a..b4d8b625586 100644 --- a/lisp/mh-e/mh-letter.el +++ b/lisp/mh-e/mh-letter.el @@ -69,7 +69,7 @@ citation text as modified. This is a normal hook, misnamed for historical reasons. It is obsolete and is only used if `mail-citation-hook' is nil.") -(make-obsolete-variable 'mh-yank-hooks 'mail-citation-hook "19.34") +(mh-make-obsolete-variable 'mh-yank-hooks 'mail-citation-hook "19.34") @@ -725,69 +725,71 @@ not inserted. If the option `mh-yank-behavior' is set to one of the supercite flavors, the hook `mail-citation-hook' is ignored and `mh-ins-buf-prefix' is not inserted." (interactive) - (if (and mh-sent-from-folder - (with-current-buffer mh-sent-from-folder mh-show-buffer) - (with-current-buffer mh-sent-from-folder - (get-buffer mh-show-buffer)) - mh-sent-from-msg) - (let ((to-point (point)) - (to-buffer (current-buffer))) - (set-buffer mh-sent-from-folder) - (if mh-delete-yanked-msg-window-flag - (delete-windows-on mh-show-buffer)) - (set-buffer mh-show-buffer) ; Find displayed message - (let* ((from-attr (mh-extract-from-attribution)) - (yank-region (mh-mark-active-p nil)) - (mh-ins-str - (cond ((and yank-region - (or (eq 'supercite mh-yank-behavior) - (eq 'autosupercite mh-yank-behavior) - (eq t mh-yank-behavior))) - ;; supercite needs the full header - (concat - (buffer-substring (point-min) (mh-mail-header-end)) - "\n" - (buffer-substring (region-beginning) (region-end)))) - (yank-region - (buffer-substring (region-beginning) (region-end))) - ((or (eq 'body mh-yank-behavior) - (eq 'attribution mh-yank-behavior) - (eq 'autoattrib mh-yank-behavior)) - (buffer-substring - (save-excursion - (goto-char (point-min)) - (mh-goto-header-end 1) - (point)) - (point-max))) - ((or (eq 'supercite mh-yank-behavior) - (eq 'autosupercite mh-yank-behavior) - (eq t mh-yank-behavior)) - (buffer-substring (point-min) (point-max))) - (t - (buffer-substring (point) (point-max)))))) - (set-buffer to-buffer) - (save-restriction - (narrow-to-region to-point to-point) - (insert (mh-filter-out-non-text mh-ins-str)) - (goto-char (point-max)) ;Needed for sc-cite-original - (push-mark) ;Needed for sc-cite-original - (goto-char (point-min)) ;Needed for sc-cite-original - (mh-insert-prefix-string mh-ins-buf-prefix) - (when (or (eq 'attribution mh-yank-behavior) - (eq 'autoattrib mh-yank-behavior)) - (insert from-attr) - (mh-identity-insert-attribution-verb nil) - (insert "\n\n")) - ;; If the user has selected a region, he has already "edited" the - ;; text, so leave the cursor at the end of the yanked text. In - ;; either case, leave a mark at the opposite end of the included - ;; text to make it easy to jump or delete to the other end of the - ;; text. - (push-mark) - (goto-char (point-max)) - (if (null yank-region) - (mh-exchange-point-and-mark-preserving-active-mark))))) - (error "There is no current message"))) + (let ((show-buffer)) + (if (and mh-sent-from-folder + (with-current-buffer mh-sent-from-folder mh-show-buffer) + (setq show-buffer (with-current-buffer mh-sent-from-folder + (get-buffer mh-show-buffer))) + mh-sent-from-msg) + (let ((to-point (point)) + (to-buffer (current-buffer))) + (if mh-delete-yanked-msg-window-flag + (with-current-buffer mh-sent-from-folder + (delete-windows-on show-buffer))) + ;; Find displayed message + (with-current-buffer show-buffer + (let* ((from-attr (mh-extract-from-attribution)) + (yank-region (mh-mark-active-p nil)) + (mh-ins-str + (cond ((and yank-region + (or (eq 'supercite mh-yank-behavior) + (eq 'autosupercite mh-yank-behavior) + (eq t mh-yank-behavior))) + ;; supercite needs the full header + (concat + (buffer-substring (point-min) (mh-mail-header-end)) + "\n" + (buffer-substring (region-beginning) (region-end)))) + (yank-region + (buffer-substring (region-beginning) (region-end))) + ((or (eq 'body mh-yank-behavior) + (eq 'attribution mh-yank-behavior) + (eq 'autoattrib mh-yank-behavior)) + (buffer-substring + (save-excursion + (goto-char (point-min)) + (mh-goto-header-end 1) + (point)) + (point-max))) + ((or (eq 'supercite mh-yank-behavior) + (eq 'autosupercite mh-yank-behavior) + (eq t mh-yank-behavior)) + (buffer-substring (point-min) (point-max))) + (t + (buffer-substring (point) (point-max)))))) + (with-current-buffer to-buffer + (save-restriction + (narrow-to-region to-point to-point) + (insert (mh-filter-out-non-text mh-ins-str)) + (goto-char (point-max)) ;Needed for sc-cite-original + (push-mark) ;Needed for sc-cite-original + (goto-char (point-min)) ;Needed for sc-cite-original + (mh-insert-prefix-string mh-ins-buf-prefix) + (when (or (eq 'attribution mh-yank-behavior) + (eq 'autoattrib mh-yank-behavior)) + (insert from-attr) + (mh-identity-insert-attribution-verb nil) + (insert "\n\n")) + ;; If the user has selected a region, he has already "edited" the + ;; text, so leave the cursor at the end of the yanked text. In + ;; either case, leave a mark at the opposite end of the included + ;; text to make it easy to jump or delete to the other end of the + ;; text. + (push-mark) + (goto-char (point-max)) + (if (null yank-region) + (mh-exchange-point-and-mark-preserving-active-mark))))))) + (error "There is no current message")))) diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index 4af3c452cc0..046f03d5255 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -268,10 +268,12 @@ usually reads the file \"/etc/mailcap\"." (buffer-read-only nil)) (when (string-match "^[^% \t]+$" method) (setq method (concat method " %s"))) - (flet ((mm-handle-set-external-undisplayer (handle function) - (mh-handle-set-external-undisplayer folder handle function))) - (unwind-protect (mm-display-external part method) - (set-buffer-modified-p nil))))) + (mh-cl-flet + ((mm-handle-set-external-undisplayer + (handle function) + (mh-handle-set-external-undisplayer folder handle function))) + (unwind-protect (mm-display-external part method) + (set-buffer-modified-p nil))))) nil)) ;;;###mh-autoload @@ -523,47 +525,48 @@ parsed and then displayed." (let ((handles ()) (folder mh-show-folder-buffer) (raw-message-data (buffer-string))) - (flet ((mm-handle-set-external-undisplayer - (handle function) - (mh-handle-set-external-undisplayer folder handle function))) - (goto-char (point-min)) - (unless (search-forward "\n\n" nil t) - (goto-char (point-max)) - (insert "\n\n")) - - (condition-case err - (progn - ;; If needed dissect the current buffer - (if pre-dissected-handles - (setq handles pre-dissected-handles) - (if (setq handles (mm-dissect-buffer nil)) - (mh-mm-uu-dissect-text-parts handles) - (setq handles (mm-uu-dissect))) - (setf (mh-mime-handles (mh-buffer-data)) - (mh-mm-merge-handles handles - (mh-mime-handles (mh-buffer-data)))) - (unless handles - (mh-decode-message-body))) - - (cond ((and handles - (or (not (stringp (car handles))) - (cdr handles))) - ;; Go to start of message body - (goto-char (point-min)) - (or (search-forward "\n\n" nil t) - (goto-char (point-max))) - - ;; Delete the body - (delete-region (point) (point-max)) - - ;; Display the MIME handles - (mh-mime-display-part handles)) - (t - (mh-signature-highlight)))) - (error - (message "Could not display body: %s" (error-message-string err)) - (delete-region (point-min) (point-max)) - (insert raw-message-data)))))) + (mh-cl-flet + ((mm-handle-set-external-undisplayer + (handle function) + (mh-handle-set-external-undisplayer folder handle function))) + (goto-char (point-min)) + (unless (search-forward "\n\n" nil t) + (goto-char (point-max)) + (insert "\n\n")) + + (condition-case err + (progn + ;; If needed dissect the current buffer + (if pre-dissected-handles + (setq handles pre-dissected-handles) + (if (setq handles (mm-dissect-buffer nil)) + (mh-mm-uu-dissect-text-parts handles) + (setq handles (mm-uu-dissect))) + (setf (mh-mime-handles (mh-buffer-data)) + (mh-mm-merge-handles handles + (mh-mime-handles (mh-buffer-data)))) + (unless handles + (mh-decode-message-body))) + + (cond ((and handles + (or (not (stringp (car handles))) + (cdr handles))) + ;; Go to start of message body + (goto-char (point-min)) + (or (search-forward "\n\n" nil t) + (goto-char (point-max))) + + ;; Delete the body + (delete-region (point) (point-max)) + + ;; Display the MIME handles + (mh-mime-display-part handles)) + (t + (mh-signature-highlight)))) + (error + (message "Could not display body: %s" (error-message-string err)) + (delete-region (point-min) (point-max)) + (insert raw-message-data)))))) (defun mh-decode-message-body () "Decode message based on charset. @@ -1046,13 +1049,14 @@ attachment, the attachment is hidden." (function (get-text-property (point) 'mh-callback)) (buffer-read-only nil) (folder mh-show-folder-buffer)) - (flet ((mm-handle-set-external-undisplayer - (handle function) - (mh-handle-set-external-undisplayer folder handle function))) - (when (and function (eolp)) - (backward-char)) - (unwind-protect (and function (funcall function data)) - (set-buffer-modified-p nil))))) + (mh-cl-flet + ((mm-handle-set-external-undisplayer + (handle function) + (mh-handle-set-external-undisplayer folder handle function))) + (when (and function (eolp)) + (backward-char)) + (unwind-protect (and function (funcall function data)) + (set-buffer-modified-p nil))))) (defun mh-push-button (event) "Click MIME button for EVENT. @@ -1066,9 +1070,11 @@ to click the MIME button." (mm-inline-media-tests mh-mm-inline-media-tests) (data (get-text-property (point) 'mh-data)) (function (get-text-property (point) 'mh-callback))) - (flet ((mm-handle-set-external-undisplayer (handle func) - (mh-handle-set-external-undisplayer folder handle func))) - (and function (funcall function data)))))) + (mh-cl-flet + ((mm-handle-set-external-undisplayer + (handle func) + (mh-handle-set-external-undisplayer folder handle func))) + (and function (funcall function data)))))) (defun mh-handle-set-external-undisplayer (folder handle function) "Replacement for `mm-handle-set-external-undisplayer'. @@ -1160,10 +1166,11 @@ this ;-)" (defun mh-display-emphasis () "Display graphical emphasis." (when (and mh-graphical-emphasis-flag (mh-small-show-buffer-p)) - (flet ((article-goto-body ())) ; shadow this function to do nothing - (save-excursion - (goto-char (point-min)) - (article-emphasize))))) + (mh-cl-flet + ((article-goto-body ())) ; shadow this function to do nothing + (save-excursion + (goto-char (point-min)) + (article-emphasize))))) (defun mh-small-show-buffer-p () "Check if show buffer is small. diff --git a/lisp/mh-e/mh-scan.el b/lisp/mh-e/mh-scan.el index 1f46c63b14c..e06c02b92b8 100644 --- a/lisp/mh-e/mh-scan.el +++ b/lisp/mh-e/mh-scan.el @@ -112,6 +112,22 @@ expression which matches the body text as in the default of not correct, the body fragment will not be highlighted with the face `mh-folder-body'.") +(defvar mh-scan-blacklisted-msg-regexp "^\\( *[0-9]+\\)B" + "This regular expression matches blacklisted (spam) messages. + +It must match from the beginning of the line. Note that the +default setting of `mh-folder-font-lock-keywords' expects this +expression to contain at least one parenthesized expression which +matches the message number as in the default of + + \"^\\\\( *[0-9]+\\\\)B\". + +This expression includes the leading space within parenthesis +since it looks better to highlight it as well. The highlighting +is done with the face `mh-folder-blacklisted'. This regular +expression should be correct as it is needed by non-fontification +functions. See also `mh-note-blacklisted'.") + (defvar mh-scan-cur-msg-number-regexp "^\\( *[0-9]+\\+\\).*" "This regular expression matches the current message. @@ -156,7 +172,7 @@ is done with the face `mh-folder-deleted'. This regular expression should be correct as it is needed by non-fontification functions. See also `mh-note-deleted'.") -(defvar mh-scan-good-msg-regexp "^\\( *[0-9]+\\)[^D^0-9]" +(defvar mh-scan-good-msg-regexp "^\\( *[0-9]+\\)[^^DBW0-9]" "This regular expression matches \"good\" messages. It must match from the beginning of the line. Note that the @@ -164,7 +180,7 @@ default setting of `mh-folder-font-lock-keywords' expects this expression to contain at least one parenthesized expression which matches the message number as in the default of - \"^\\\\( *[0-9]+\\\\)[^D^0-9]\". + \"^\\\\( *[0-9]+\\\\)[^^DBW0-9]\". This expression includes the leading space within the parenthesis since it looks better to highlight it as well. The highlighting @@ -278,6 +294,22 @@ non-fontification functions.") This is used to eliminate error messages that are occasionally produced by \"inc\".") +(defvar mh-scan-whitelisted-msg-regexp "^\\( *[0-9]+\\)W" + "This regular expression matches whitelisted (non-spam) messages. + +It must match from the beginning of the line. Note that the +default setting of `mh-folder-font-lock-keywords' expects this +expression to contain at least one parenthesized expression which +matches the message number as in the default of + + \"^\\\\( *[0-9]+\\\\)W\". + +This expression includes the leading space within parenthesis +since it looks better to highlight it as well. The highlighting +is done with the face `mh-folder-whitelisted'. This regular +expression should be correct as it is needed by non-fontification +functions. See also `mh-note-whitelisted'.") + ;;; Widths, Offsets and Columns @@ -295,11 +327,13 @@ Note that columns in Emacs start with 0.") (defvar mh-scan-cmd-note-width 1 "Number of columns consumed by the cmd-note field in `mh-scan-format'. -This column will have one of the values: \" \", \"D\", \"^\", \"+\", where +This column will have one of the values: \" \", \"^\", \"D\", \"B\", \"W\", \"+\", where \" \" is the default value, + \"^\" is the `mh-note-refiled' character, \"D\" is the `mh-note-deleted' character, - \"^\" is the `mh-note-refiled' character, and + \"B\" is the `mh-note-blacklisted' character, + \"W\" is the `mh-note-whitelisted' character, and \"+\" is the `mh-note-cur' character.") (defvar mh-scan-destination-width 1 @@ -364,6 +398,10 @@ This column will only ever have spaces in it.") ;; Alphabetical. +(defvar mh-note-blacklisted ?B + "Messages that have been blacklisted are marked by this character. +See also `mh-scan-blacklisted-msg-regexp'.") + (defvar mh-note-cur ?+ "The current message (in MH, not in MH-E) is marked by this character. See also `mh-scan-cur-msg-number-regexp'.") @@ -397,6 +435,10 @@ See also `mh-scan-refiled-msg-regexp'.") Messages in the \"search\" sequence are marked by this character as well.") +(defvar mh-note-whitelisted ?W + "Messages that have been whitelisted are marked by this character. +See also `mh-scan-whitelisted-msg-regexp'.") + ;;; Utilities diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el index d4fa0df3140..d31d0ca495a 100644 --- a/lisp/mh-e/mh-search.el +++ b/lisp/mh-e/mh-search.el @@ -1434,7 +1434,7 @@ being the list of messages originally from that folder." (beginning-of-line) (push (cons (buffer-substring-no-properties (point) (mh-line-end-position)) - (set-marker (make-marker) (point))) + (point-marker)) alist))) (setq imenu--index-alist (nreverse alist))))) @@ -1449,11 +1449,12 @@ being the list of messages originally from that folder." ;;;###mh-autoload (defun mh-index-execute-commands () - "Delete/refile the actual messages. -The copies in the searched folder are then deleted/refiled to get -the desired result. Before deleting the messages we make sure -that the message being deleted is identical to the one that the -user has marked in the index buffer." + "Perform the outstanding operations on the actual messages. +The copies in the searched folder are then deleted, refiled, +blacklisted and whitelisted to get the desired result. Before +processing the messages we make sure that the message is +identical to the one that the user has marked in the index +buffer." (save-excursion (let ((folders ()) (mh-speed-flists-inhibit-flag t)) @@ -1466,9 +1467,13 @@ user has marked in the index buffer." ;; Otherwise delete the messages in the source buffer... (with-current-buffer folder (let ((old-refile-list mh-refile-list) - (old-delete-list mh-delete-list)) + (old-delete-list mh-delete-list) + (old-blacklist mh-blacklist) + (old-whitelist mh-whitelist)) (setq mh-refile-list nil - mh-delete-list msgs) + mh-delete-list msgs + mh-blacklist nil + mh-whitelist nil) (unwind-protect (mh-execute-commands) (setq mh-refile-list (mapcar (lambda (x) @@ -1478,13 +1483,21 @@ user has marked in the index buffer." old-refile-list) mh-delete-list (loop for x in old-delete-list + unless (memq x msgs) collect x) + mh-blacklist + (loop for x in old-blacklist + unless (memq x msgs) collect x) + mh-whitelist + (loop for x in old-whitelist unless (memq x msgs) collect x)) (mh-set-folder-modified-p (mh-outstanding-commands-p)) (when (mh-outstanding-commands-p) (mh-notate-deleted-and-refiled))))))) (mh-index-matching-source-msgs (append (loop for x in mh-refile-list append (cdr x)) - mh-delete-list) + mh-delete-list + mh-blacklist + mh-whitelist) t)) folders))) diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el index 92b9625fc43..87b048dbd60 100644 --- a/lisp/mh-e/mh-show.el +++ b/lisp/mh-e/mh-show.el @@ -612,6 +612,7 @@ still visible.\n") "l" mh-show-list-folders "n" mh-index-new-messages "o" mh-show-visit-folder + "p" mh-show-pack-folder "q" mh-show-index-sequenced-messages "r" mh-show-rescan-folder "s" mh-search @@ -899,13 +900,14 @@ See also `mh-folder-mode'. (interactive) ;; Don't allow Gnus to create buttons while highlighting, maybe this is bad ;; style? - (flet ((gnus-article-add-button (&rest args) nil)) - (let* ((modified (buffer-modified-p)) - (gnus-article-buffer (buffer-name)) - (gnus-cite-face-list `(,@(cdr gnus-cite-face-list) - ,(car gnus-cite-face-list)))) - (gnus-article-highlight-citation t) - (set-buffer-modified-p modified)))) + (mh-cl-flet + ((gnus-article-add-button (&rest args) nil)) + (let* ((modified (buffer-modified-p)) + (gnus-article-buffer (buffer-name)) + (gnus-cite-face-list `(,@(cdr gnus-cite-face-list) + ,(car gnus-cite-face-list)))) + (gnus-article-highlight-citation t) + (set-buffer-modified-p modified)))) (provide 'mh-show) diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el index bb9ea94732a..d80e9f3ae53 100644 --- a/lisp/mh-e/mh-thread.el +++ b/lisp/mh-e/mh-thread.el @@ -645,19 +645,20 @@ Only information about messages in MSG-LIST are added to the tree." (defun mh-thread-set-tables (folder) "Use the tables of FOLDER in current buffer." - (flet ((mh-get-table (symbol) - (with-current-buffer folder - (symbol-value symbol)))) - (setq mh-thread-id-hash (mh-get-table 'mh-thread-id-hash)) - (setq mh-thread-subject-hash (mh-get-table 'mh-thread-subject-hash)) - (setq mh-thread-id-table (mh-get-table 'mh-thread-id-table)) - (setq mh-thread-id-index-map (mh-get-table 'mh-thread-id-index-map)) - (setq mh-thread-index-id-map (mh-get-table 'mh-thread-index-id-map)) - (setq mh-thread-scan-line-map (mh-get-table 'mh-thread-scan-line-map)) - (setq mh-thread-subject-container-hash - (mh-get-table 'mh-thread-subject-container-hash)) - (setq mh-thread-duplicates (mh-get-table 'mh-thread-duplicates)) - (setq mh-thread-history (mh-get-table 'mh-thread-history)))) + (mh-cl-flet + ((mh-get-table (symbol) + (with-current-buffer folder + (symbol-value symbol)))) + (setq mh-thread-id-hash (mh-get-table 'mh-thread-id-hash)) + (setq mh-thread-subject-hash (mh-get-table 'mh-thread-subject-hash)) + (setq mh-thread-id-table (mh-get-table 'mh-thread-id-table)) + (setq mh-thread-id-index-map (mh-get-table 'mh-thread-id-index-map)) + (setq mh-thread-index-id-map (mh-get-table 'mh-thread-index-id-map)) + (setq mh-thread-scan-line-map (mh-get-table 'mh-thread-scan-line-map)) + (setq mh-thread-subject-container-hash + (mh-get-table 'mh-thread-subject-container-hash)) + (setq mh-thread-duplicates (mh-get-table 'mh-thread-duplicates)) + (setq mh-thread-history (mh-get-table 'mh-thread-history)))) (defun mh-thread-process-in-reply-to (reply-to-header) "Extract message id's from REPLY-TO-HEADER. diff --git a/lisp/mh-e/mh-xface.el b/lisp/mh-e/mh-xface.el index 7582158fefd..4340373f5c4 100644 --- a/lisp/mh-e/mh-xface.el +++ b/lisp/mh-e/mh-xface.el @@ -323,7 +323,7 @@ elements of the list are nil." If the URL isn't present in the cache then it is fetched with wget." (let* ((cache-filename (mh-x-image-url-cache-canonicalize url)) (state (mh-x-image-get-download-state cache-filename)) - (marker (set-marker (make-marker) (point)))) + (marker (point-marker))) (set (make-local-variable 'mh-x-image-marker) marker) (cond ((not (mh-x-image-url-sane-p url))) ((eq state 'ok) diff --git a/lisp/minibuf-eldef.el b/lisp/minibuf-eldef.el index a36df99d4a9..3826a91f0e0 100644 --- a/lisp/minibuf-eldef.el +++ b/lisp/minibuf-eldef.el @@ -152,15 +152,11 @@ been set up by `minibuf-eldef-setup-minibuffer'." (and (= (point-max) minibuf-eldef-initial-buffer-length) (string-equal (minibuffer-contents-no-properties) minibuf-eldef-initial-input))) - ;; swap state + ;; Swap state. (setq minibuf-eldef-showing-default-in-prompt (not minibuf-eldef-showing-default-in-prompt)) - (cond (minibuf-eldef-showing-default-in-prompt - (overlay-put minibuf-eldef-overlay 'invisible nil) - (overlay-put minibuf-eldef-overlay 'intangible nil)) - (t - (overlay-put minibuf-eldef-overlay 'invisible t) - (overlay-put minibuf-eldef-overlay 'intangible t))))) + (overlay-put minibuf-eldef-overlay 'invisible + (not minibuf-eldef-showing-default-in-prompt)))) ;;;###autoload diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 44ce0b78a3e..0d2815e535e 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -51,6 +51,9 @@ ;;; Todo: +;; - Make *Completions* readable even if some of the completion +;; entries have LF chars or spaces in them (including at +;; beginning/end) or are very long. ;; - for M-x, cycle-sort commands that have no key binding first. ;; - Make things like icomplete-mode or lightning-completion work with ;; completion-in-region-mode. @@ -74,6 +77,9 @@ ;; - whether the user wants completion to pay attention to case. ;; e.g. we may want to make it possible for the user to say "first try ;; completion case-sensitively, and if that fails, try to ignore case". +;; Maybe the trick is that we should distinguish completion-ignore-case in +;; try/all-completions (obey user's preference) from its use in +;; test-completion (obey the underlying object's semantics). ;; - add support for ** to pcm. ;; - Add vc-file-name-completion-table to read-file-name-internal. @@ -1100,6 +1106,13 @@ scroll the window of possible completions." (sort-fun (completion-metadata-get all-md 'cycle-sort-function))) (when last (setcdr last nil) + + ;; Delete duplicates: do it after setting last's cdr to nil (so + ;; it's a proper list), and be careful to reset `last' since it + ;; may be a different cons-cell. + (setq all (delete-dups all)) + (setq last (last all)) + (setq all (if sort-fun (funcall sort-fun all) ;; Prefer shorter completions, by default. (sort all (lambda (c1 c2) (< (length c1) (length c2)))))) @@ -1114,6 +1127,15 @@ scroll the window of possible completions." ;; all possibilities. (completion--cache-all-sorted-completions (nconc all base-size)))))) +(defun minibuffer-force-complete-and-exit () + "Complete the minibuffer with first of the matches and exit." + (interactive) + (minibuffer-force-complete) + (minibuffer--complete-and-exit + ;; If the previous completion completed to an element which fails + ;; test-completion, then we shouldn't exit, but that should be rare. + (lambda () (minibuffer-message "Incomplete")))) + (defun minibuffer-force-complete () "Complete the minibuffer to an exact match. Repeated uses step through the possible completions." @@ -1186,6 +1208,22 @@ If `minibuffer-completion-confirm' is `confirm-after-completion', `minibuffer-confirm-exit-commands', and accept the input otherwise." (interactive) + (minibuffer--complete-and-exit + (lambda () + (pcase (condition-case nil + (completion--do-completion nil 'expect-exact) + (error 1)) + ((or #b001 #b011) (exit-minibuffer)) + (#b111 (if (not minibuffer-completion-confirm) + (exit-minibuffer) + (minibuffer-message "Confirm") + nil)) + (_ nil))))) + +(defun minibuffer--complete-and-exit (completion-function) + "Exit from `require-match' minibuffer. +COMPLETION-FUNCTION is called if the current buffer's content does not +appear to be a match." (let ((beg (field-beginning)) (end (field-end))) (cond @@ -1233,15 +1271,7 @@ If `minibuffer-completion-confirm' is `confirm-after-completion', (t ;; Call do-completion, but ignore errors. - (pcase (condition-case nil - (completion--do-completion nil 'expect-exact) - (error 1)) - ((or #b001 #b011) (exit-minibuffer)) - (#b111 (if (not minibuffer-completion-confirm) - (exit-minibuffer) - (minibuffer-message "Confirm") - nil)) - (_ nil)))))) + (funcall completion-function))))) (defun completion--try-word-completion (string table predicate point md) (let ((comp (completion-try-completion string table predicate point md))) @@ -2048,6 +2078,8 @@ This is only used when the minibuffer area has no active minibuffer.") process-environment)) (defconst completion--embedded-envvar-re + ;; We can't reuse env--substitute-vars-regexp because we need to match only + ;; potentially-unfinished envvars at end of string. (concat "\\(?:^\\|[^$]\\(?:\\$\\$\\)*\\)" "$\\([[:alnum:]_]*\\|{\\([^}]*\\)\\)\\'")) diff --git a/lisp/misearch.el b/lisp/misearch.el index 2584f8df77b..0c4cd4ea323 100644 --- a/lisp/misearch.el +++ b/lisp/misearch.el @@ -73,7 +73,7 @@ end of the search space). The first argument of this function is the current buffer where the search is currently searching. It defines the base buffer relative to which this function should find the next buffer. When the isearch -direction is backward (when `isearch-forward' is nil), this function +direction is backward (when option `isearch-forward' is nil), this function should return the previous buffer to search. If the second argument of this function WRAP is non-nil, then it diff --git a/lisp/mpc.el b/lisp/mpc.el index a2e13dcfd58..a6494575a43 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -1034,11 +1034,8 @@ If PLAYLIST is t or nil or missing, use the main playlist." (let ((display (if (and size (> (+ postwidth textwidth) size)) - ;; This doesn't even obey double-width chars :-( (propertize - (if (zerop (- size postwidth 1)) - (substring text 0 1) - (concat (substring text 0 (- size postwidth textwidth 1)) "…")) + (truncate-string-to-width text size nil nil "…") 'help-echo text) text))) (when (memq tag '(Artist Album Composer)) ;FIXME: wrong list. diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index bf6afae45da..4f7d8092891 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -720,6 +720,7 @@ parenthesized expressions in REGEXP for the components (in that order)." "^Data connection \\|" "^local:\\|^Trying\\|^125 \\|^550-\\|^221 .*oodbye\\|" "^500 .*AUTH\\|^KERBEROS\\|" + "^500 This security scheme is not implemented\\|" "^504 Unknown security mechanism\\|" "^530 Please login with USER and PASS\\|" ; non kerberized vsFTPd "^534 Kerberos Authentication not enabled\\|" diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 3afd3aefc96..086043c2b4a 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -406,7 +406,7 @@ will be killed." "The channel or user associated with this buffer.") (defvar rcirc-urls nil - "List of urls seen in the current buffer.") + "List of URLs seen in the current buffer and their start positions.") (put 'rcirc-urls 'permanent-local t) (defvar rcirc-timeout-seconds 600 @@ -2392,12 +2392,25 @@ keywords when no KEYWORD is given." "\\)") "Regexp matching URLs. Set to nil to disable URL features in rcirc.") +;; cf cl-remove-if-not +(defun rcirc-condition-filter (condp lst) + "Remove all items not satisfying condition CONDP in list LST. +CONDP is a function that takes a list element as argument and returns +non-nil if that element should be included. Returns a new list." + (delq nil (mapcar (lambda (x) (and (funcall condp x) x)) lst))) + (defun rcirc-browse-url (&optional arg) - "Prompt for URL to browse based on URLs in buffer." + "Prompt for URL to browse based on URLs in buffer before point. + +If ARG is given, opens the URL in a new browser window." (interactive "P") - (let ((completions (mapcar (lambda (x) (cons x nil)) rcirc-urls)) - (initial-input (car rcirc-urls)) - (history (cdr rcirc-urls))) + (let* ((point (point)) + (filtered (rcirc-condition-filter + (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) arg))) @@ -2441,17 +2454,19 @@ keywords when no KEYWORD is given." (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)) - (end (match-end 0)) - (url (match-string-no-properties 0))) + (let* ((start (match-beginning 0)) + (end (match-end 0)) + (url (match-string-no-properties 0)) + (link-text (buffer-substring-no-properties start end))) (make-button start end 'face 'rcirc-url 'follow-link t 'rcirc-url url 'action (lambda (button) (browse-url (button-get button 'rcirc-url)))) - ;; record the url - (push url rcirc-urls)))) + ;; record the url if it is not already the latest stored url + (when (not (string= link-text (caar rcirc-urls))) + (push (cons link-text start) rcirc-urls))))) (defun rcirc-markup-keywords (sender response) (when (and (string= response "PRIVMSG") diff --git a/lisp/net/socks.el b/lisp/net/socks.el index 75b0ebe55ff..415397c4171 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -648,7 +648,7 @@ version.") (progn (setq res (buffer-substring (match-beginning 2) (match-end 2)) - res (mapcar 'string-to-int (split-string res "\\."))))) + res (mapcar 'string-to-number (split-string res "\\."))))) (kill-buffer (current-buffer))) res) host)) diff --git a/lisp/net/tls.el b/lisp/net/tls.el index ed61d62182f..7fc314ef088 100644 --- a/lisp/net/tls.el +++ b/lisp/net/tls.el @@ -89,10 +89,14 @@ Also see `tls-success' for what the program should output after successful negotiation." :type '(choice + (const :tag "Default list of commands" + ("gnutls-cli --insecure -p %p %h" + "gnutls-cli --insecure -p %p %h --protocols ssl3" + "openssl s_client -connect %h:%p -no_ssl2 -ign_eof")) (list :tag "Choose commands" :value - ("gnutls-cli -p %p %h" - "gnutls-cli -p %p %h --protocols ssl3" + ("gnutls-cli --insecure -p %p %h" + "gnutls-cli --insecure -p %p %h --protocols ssl3" "openssl s_client -connect %h:%p -no_ssl2 -ign_eof") (set :inline t ;; FIXME: add brief `:tag "..."' descriptions. @@ -102,14 +106,10 @@ successful negotiation." (const "gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h --protocols ssl3") (const "openssl s_client -connect %h:%p -CAfile /etc/ssl/certs/ca-certificates.crt -no_ssl2 -ign_eof") ;; No trust check: - (const "gnutls-cli -p %p %h") - (const "gnutls-cli -p %p %h --protocols ssl3") + (const "gnutls-cli --insecure -p %p %h") + (const "gnutls-cli --insecure -p %p %h --protocols ssl3") (const "openssl s_client -connect %h:%p -no_ssl2 -ign_eof")) (repeat :inline t :tag "Other" (string))) - (const :tag "Default list of commands" - ("gnutls-cli -p %p %h" - "gnutls-cli -p %p %h --protocols ssl3" - "openssl s_client -connect %h:%p -no_ssl2 -ign_eof")) (list :tag "List of commands" (repeat :tag "Command" (string)))) :version "22.1" diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el new file mode 100644 index 00000000000..17802d39fa4 --- /dev/null +++ b/lisp/net/tramp-adb.el @@ -0,0 +1,1117 @@ +;;; tramp-adb.el --- Functions for calling Android Debug Bridge from Tramp + +;; Copyright (C) 2011-2013 Free Software Foundation, Inc. + +;; Author: Juergen Hoetzel <juergen@archlinux.org> +;; Keywords: comm, processes +;; Package: tramp + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; The Android Debug Bridge must be installed on your local machine. +;; Add the following form into your .emacs: +;; +;; (setq tramp-adb-sdk-dir "/path/to/android/sdk") +;; +;; Due to security it is not possible to access non-root devices. + +;;; Code: + +(require 'tramp) +(require 'time-date) + +(defvar dired-move-to-filename-regexp) + +(defcustom tramp-adb-sdk-dir "~/Android/sdk" + "Set to the directory containing the Android SDK." + :type 'string + :version "24.4" + :group 'tramp) + +;;;###tramp-autoload +(defconst tramp-adb-method "adb" + "*When this method name is used, forward all calls to Android Debug Bridge.") + +(defcustom tramp-adb-prompt + "^\\(?:[[:alnum:]]*@[[:alnum:]]*[^#\\$]*\\)?[#\\$][[:space:]]" + "Regexp used as prompt in almquist shell." + :type 'string + :version "24.4" + :group 'tramp) + +(defconst tramp-adb-ls-date-regexp + "[[:space:]][0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9][[:space:]][0-9][0-9]:[0-9][0-9][[:space:]]") + +(defconst tramp-adb-ls-toolbox-regexp + (concat + "^[[:space:]]*\\([-[:alpha:]]+\\)" ; \1 permissions + "[[:space:]]*\\([^[:space:]]+\\)" ; \2 username + "[[:space:]]+\\([^[:space:]]+\\)" ; \3 group + "[[:space:]]+\\([[:digit:]]+\\)" ; \4 size + "[[:space:]]+\\([-[:digit:]]+[[:space:]][:[:digit:]]+\\)" ; \5 date + "[[:space:]]+\\(.*\\)$")) ; \6 filename + +;;;###tramp-autoload +(add-to-list 'tramp-methods + `(,tramp-adb-method + (tramp-tmpdir "/data/local/tmp"))) + +;;;###tramp-autoload +(add-to-list 'tramp-default-host-alist `(,tramp-adb-method nil "")) + +;;;###tramp-autoload +(eval-after-load 'tramp + '(tramp-set-completion-function + tramp-adb-method '((tramp-adb-parse-device-names "")))) + +;;;###tramp-autoload +(add-to-list 'tramp-foreign-file-name-handler-alist + (cons 'tramp-adb-file-name-p 'tramp-adb-file-name-handler)) + +(defconst tramp-adb-file-name-handler-alist + '((directory-file-name . tramp-handle-directory-file-name) + (dired-uncache . tramp-handle-dired-uncache) + (file-name-as-directory . tramp-handle-file-name-as-directory) + (file-name-completion . tramp-handle-file-name-completion) + (file-name-all-completions . tramp-adb-handle-file-name-all-completions) + (file-attributes . tramp-adb-handle-file-attributes) + (file-name-directory . tramp-handle-file-name-directory) + (file-name-nondirectory . tramp-handle-file-name-nondirectory) + (file-truename . tramp-adb-handle-file-truename) + (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) + (file-name-as-directory . tramp-handle-file-name-as-directory) + (file-regular-p . tramp-handle-file-regular-p) + (file-remote-p . tramp-handle-file-remote-p) + (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) + (file-directory-p . tramp-adb-handle-file-directory-p) + (file-symlink-p . tramp-handle-file-symlink-p) + ;; FIXME: This is too sloppy. + (file-executable-p . tramp-handle-file-exists-p) + (file-exists-p . tramp-handle-file-exists-p) + (file-readable-p . tramp-handle-file-exists-p) + (file-writable-p . tramp-adb-handle-file-writable-p) + (file-local-copy . tramp-adb-handle-file-local-copy) + (file-modes . tramp-handle-file-modes) + (expand-file-name . tramp-adb-handle-expand-file-name) + (find-backup-file-name . tramp-handle-find-backup-file-name) + (directory-files . tramp-handle-directory-files) + (directory-files-and-attributes + . tramp-adb-handle-directory-files-and-attributes) + (make-directory . tramp-adb-handle-make-directory) + (delete-directory . tramp-adb-handle-delete-directory) + (delete-file . tramp-adb-handle-delete-file) + (load . tramp-handle-load) + (insert-directory . tramp-adb-handle-insert-directory) + (insert-file-contents . tramp-handle-insert-file-contents) + (substitute-in-file-name . tramp-handle-substitute-in-file-name) + (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) + (vc-registered . ignore) ;no vc control files on Android devices + (write-region . tramp-adb-handle-write-region) + (set-file-modes . tramp-adb-handle-set-file-modes) + (set-file-times . tramp-adb-handle-set-file-times) + (copy-file . tramp-adb-handle-copy-file) + (rename-file . tramp-adb-handle-rename-file) + (process-file . tramp-adb-handle-process-file) + (shell-command . tramp-adb-handle-shell-command) + (start-file-process . tramp-adb-handle-start-file-process)) + "Alist of handler functions for Tramp ADB method.") + +;; It must be a `defsubst' in order to push the whole code into +;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading. +;;;###tramp-autoload +(defsubst tramp-adb-file-name-p (filename) + "Check if it's a filename for ADB." + (let ((v (tramp-dissect-file-name filename))) + (string= (tramp-file-name-method v) tramp-adb-method))) + +;;;###tramp-autoload +(defun tramp-adb-file-name-handler (operation &rest args) + "Invoke the ADB handler for OPERATION. +First arg specifies the OPERATION, second arg is a list of arguments to +pass to the OPERATION." + (let ((fn (assoc operation tramp-adb-file-name-handler-alist))) + (if fn + (save-match-data (apply (cdr fn) args)) + (tramp-run-real-handler operation args)))) + +;; This cannot be a constant, because `tramp-adb-sdk-dir' is customizable. +(defun tramp-adb-program () + "The Android Debug Bridge." + (expand-file-name "platform-tools/adb" tramp-adb-sdk-dir)) + +;;;###tramp-autoload +(defun tramp-adb-parse-device-names (ignore) + "Return a list of (nil host) tuples allowed to access." + (with-temp-buffer + (when (zerop (call-process (tramp-adb-program) nil t nil "devices")) + (let (result) + (goto-char (point-min)) + (while (search-forward-regexp "^\\(\\S-+\\)[[:space:]]+device$" nil t) + (add-to-list 'result (list nil (match-string 1)))) + result)))) + +(defun tramp-adb-handle-expand-file-name (name &optional dir) + "Like `expand-file-name' for Tramp files." + ;; 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) + (setq name (concat (file-name-as-directory dir) name))) + ;; If NAME is not a Tramp file, run the real handler. + (if (not (tramp-tramp-file-p name)) + (tramp-run-real-handler 'expand-file-name (list name nil)) + ;; Dissect NAME. + (with-parsed-tramp-file-name name nil + (unless (tramp-run-real-handler 'file-name-absolute-p (list localname)) + (setq localname (concat "/" localname))) + ;; Do normal `expand-file-name' (this does "/./" and "/../"). + ;; We bind `directory-sep-char' here for XEmacs on Windows, + ;; which would otherwise use backslash. `default-directory' is + ;; bound, because on Windows there would be problems with UNC + ;; shares or Cygwin mounts. + (let ((directory-sep-char ?/) + (default-directory (tramp-compat-temporary-file-directory))) + (tramp-make-tramp-file-name + method user host + (tramp-drop-volume-letter + (tramp-run-real-handler + 'expand-file-name (list localname)))))))) + +(defun tramp-adb-handle-file-directory-p (filename) + "Like `file-directory-p' for Tramp files." + (car (file-attributes (file-truename filename)))) + +;; This is derived from `tramp-sh-handle-file-truename'. Maybe the +;; code could be shared? +(defun tramp-adb-handle-file-truename (filename &optional counter prev-dirs) + "Like `file-truename' for Tramp files." + (with-parsed-tramp-file-name (expand-file-name filename) nil + (with-tramp-file-property v localname "file-truename" + (let ((result nil)) ; result steps in reverse order + (tramp-message v 4 "Finding true name for `%s'" filename) + (let* ((directory-sep-char ?/) + (steps (tramp-compat-split-string localname "/")) + (localnamedir (tramp-run-real-handler + 'file-name-as-directory (list localname))) + (is-dir (string= localname localnamedir)) + (thisstep nil) + (numchase 0) + ;; Don't make the following value larger than + ;; necessary. People expect an error message in a + ;; timely fashion when something is wrong; otherwise + ;; they might think that Emacs is hung. Of course, + ;; correctness has to come first. + (numchase-limit 20) + symlink-target) + (while (and steps (< numchase numchase-limit)) + (setq thisstep (pop steps)) + (tramp-message + v 5 "Check %s" + (mapconcat 'identity + (append '("") (reverse result) (list thisstep)) + "/")) + (setq symlink-target + (nth 0 (file-attributes + (tramp-make-tramp-file-name + method user host + (mapconcat 'identity + (append '("") + (reverse result) + (list thisstep)) + "/"))))) + (cond ((string= "." thisstep) + (tramp-message v 5 "Ignoring step `.'")) + ((string= ".." thisstep) + (tramp-message v 5 "Processing step `..'") + (pop result)) + ((stringp symlink-target) + ;; It's a symlink, follow it. + (tramp-message v 5 "Follow symlink to %s" symlink-target) + (setq numchase (1+ numchase)) + (when (file-name-absolute-p symlink-target) + (setq result nil)) + ;; If the symlink was absolute, we'll get a string + ;; like "/user@host:/some/target"; extract the + ;; "/some/target" part from it. + (when (tramp-tramp-file-p symlink-target) + (unless (tramp-equal-remote filename symlink-target) + (tramp-error + v 'file-error + "Symlink target `%s' on wrong host" symlink-target)) + (setq symlink-target localname)) + (setq steps + (append (tramp-compat-split-string + symlink-target "/") + steps))) + (t + ;; It's a file. + (setq result (cons thisstep result))))) + (when (>= numchase numchase-limit) + (tramp-error + v 'file-error + "Maximum number (%d) of symlinks exceeded" numchase-limit)) + (setq result (reverse result)) + ;; Combine list to form string. + (setq result + (if result + (mapconcat 'identity (cons "" result) "/") + "/")) + (when (and is-dir (or (string= "" result) + (not (string= (substring result -1) "/")))) + (setq result (concat result "/")))) + + (tramp-message v 4 "True name of `%s' is `%s'" filename result) + (tramp-make-tramp-file-name method user host result))))) + +(defun tramp-adb-handle-file-attributes (filename &optional id-format) + "Like `file-attributes' for Tramp files." + (unless id-format (setq id-format 'integer)) + (ignore-errors + (with-parsed-tramp-file-name filename nil + (with-tramp-file-property + v localname (format "file-attributes-%s" id-format) + (tramp-adb-barf-unless-okay + v (format "%s -d -l %s" + (tramp-adb-get-ls-command v) + (tramp-shell-quote-argument localname)) "") + (with-current-buffer (tramp-get-buffer v) + (tramp-adb-sh-fix-ls-output) + (cdar (tramp-do-parse-file-attributes-with-ls v id-format))))))) + +(defun tramp-do-parse-file-attributes-with-ls (vec &optional id-format) + "Parse `file-attributes' for Tramp files using the ls(1) command." + (with-current-buffer (tramp-get-buffer vec) + (goto-char (point-min)) + (let ((file-properties nil)) + (while (re-search-forward tramp-adb-ls-toolbox-regexp nil t) + (let* ((mod-string (match-string 1)) + (is-dir (eq ?d (aref mod-string 0))) + (is-symlink (eq ?l (aref mod-string 0))) + (uid (match-string 2)) + (gid (match-string 3)) + (size (string-to-number (match-string 4))) + (date (match-string 5)) + (name (match-string 6)) + (symlink-target + (and is-symlink + (cadr (split-string name "\\( -> \\|\n\\)"))))) + (push (list + (if is-symlink + (car (split-string name "\\( -> \\|\n\\)")) + name) + (or is-dir symlink-target) + 1 ;link-count + ;; no way to handle numeric ids in Androids ash + (if (eq id-format 'integer) 0 uid) + (if (eq id-format 'integer) 0 gid) + '(0 0) ; atime + (date-to-time date) ; mtime + '(0 0) ; ctime + size + mod-string + ;; fake + t 1 + (tramp-get-device vec)) + file-properties))) + file-properties))) + +(defun tramp-adb-handle-directory-files-and-attributes + (directory &optional full match nosort id-format) + "Like `directory-files-and-attributes' for Tramp files." + (when (file-directory-p directory) + (with-parsed-tramp-file-name (expand-file-name directory) nil + (with-tramp-file-property + v localname (format "directory-files-attributes-%s-%s-%s-%s" + full match id-format nosort) + (tramp-adb-barf-unless-okay + v (format "%s -a -l %s" + (tramp-adb-get-ls-command v) + (tramp-shell-quote-argument localname)) "") + (with-current-buffer (tramp-get-buffer v) + (tramp-adb-sh-fix-ls-output) + (let ((result (tramp-do-parse-file-attributes-with-ls + v (or id-format 'integer)))) + (when full + (setq result + (mapcar + (lambda (x) + (cons (expand-file-name (car x) directory) (cdr x))) + result))) + (unless nosort + (setq result + (sort result (lambda (x y) (string< (car x) (car y)))))) + (delq nil + (mapcar (lambda (x) + (if (or (not match) (string-match match (car x))) + x)) + result)))))))) + +(defun tramp-adb-get-ls-command (vec) + (with-tramp-connection-property vec "ls" + (tramp-message vec 5 "Finding a suitable `ls' command") + (if (zerop (tramp-adb-command-exit-status + vec "ls --color=never -al /dev/null")) + ;; On CyanogenMod based system BusyBox is used and "ls" output + ;; coloring is enabled by default. So we try to disable it + ;; when possible. + "ls --color=never" + "ls"))) + +(defun tramp-adb-get-toolbox (vec) + "Get shell toolbox implementation: `toolbox' for original distributions +or `busybox' for CyanogenMod based distributions" + (with-tramp-connection-property vec "toolbox" + (tramp-message vec 5 "Checking shell toolbox implementation") + (cond + ((zerop (tramp-adb-command-exit-status vec "busybox")) 'busybox) + ((zerop (tramp-adb-command-exit-status vec "toolbox")) 'toolbox) + (t 'unknown)))) + +(defun tramp-adb--gnu-switches-to-ash + (switches) + "Almquist shell can't handle multiple arguments. +Convert (\"-al\") to (\"-a\" \"-l\"). Remove arguments like \"--dired\"." + (split-string + (apply 'concat + (mapcar (lambda (s) + (replace-regexp-in-string + "\\(.\\)" " -\\1" + (replace-regexp-in-string "^-" "" s))) + ;; FIXME: Warning about removed switches (long and non-dash). + (delq nil + (mapcar + (lambda (s) + (and (not (string-match "\\(^--\\|^[^-]\\)" s)) s)) + switches)))))) + +(defun tramp-adb-handle-insert-directory + (filename switches &optional wildcard full-directory-p) + "Like `insert-directory' for Tramp files." + (when (stringp switches) + (setq switches (tramp-adb--gnu-switches-to-ash (split-string switches)))) + (with-parsed-tramp-file-name (file-truename filename) nil + (with-current-buffer (tramp-get-buffer v) + (let ((name (tramp-shell-quote-argument (directory-file-name localname))) + (switch-d (member "-d" switches)) + (switch-t (member "-t" switches)) + (switches (mapconcat 'identity (remove "-t" switches) " "))) + (tramp-adb-barf-unless-okay + v (format "%s %s %s" (tramp-adb-get-ls-command v) switches name) + "Cannot insert directory listing: %s" filename) + (unless switch-d + ;; We insert also filename/. and filename/.., because "ls" doesn't. + (narrow-to-region (point) (point)) + (ignore-errors + (tramp-adb-barf-unless-okay + v (format "%s -d %s %s %s" + (tramp-adb-get-ls-command v) + switches + (concat (file-name-as-directory name) ".") + (concat (file-name-as-directory name) "..")) + "Cannot insert directory listing: %s" filename)) + (widen)) + (tramp-adb-sh-fix-ls-output switch-t))) + (insert-buffer-substring (tramp-get-buffer v)))) + +(defun tramp-adb-sh-fix-ls-output (&optional sort-by-time) + "Insert dummy 0 in empty size columns. +Androids \"ls\" command doesn't insert size column for directories: +Emacs dired can't find files." + (save-excursion + ;; Insert missing size. + (goto-char (point-min)) + (while + (search-forward-regexp + "[[:space:]]\\([[:space:]][0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9][[:space:]]\\)" nil t) + (replace-match "0\\1" "\\1" nil) + ;; Insert missing "/". + (when (looking-at "[0-9][0-9]:[0-9][0-9][[:space:]]+$") + (end-of-line) + (insert "/"))) + ;; Sort entries. + (let* ((lines (split-string (buffer-string) "\n" t)) + (sorted-lines + (sort + lines + (if sort-by-time + 'tramp-adb-ls-output-time-less-p + 'tramp-adb-ls-output-name-less-p)))) + (delete-region (point-min) (point-max)) + (insert " " (mapconcat 'identity sorted-lines "\n "))) + ;; Add final newline. + (goto-char (point-max)) + (unless (= (point) (line-beginning-position)) + (insert "\n")))) + + +(defun tramp-adb-ls-output-time-less-p (a b) + "Sort \"ls\" output by time, descending." + (let (time-a time-b) + (string-match tramp-adb-ls-date-regexp a) + (setq time-a (apply 'encode-time (parse-time-string (match-string 0 a)))) + (string-match tramp-adb-ls-date-regexp b) + (setq time-b (apply 'encode-time (parse-time-string (match-string 0 b)))) + (tramp-time-less-p time-b time-a))) + +(defun tramp-adb-ls-output-name-less-p (a b) + "Sort \"ls\" output by name, ascending." + (let (posa posb) + (string-match dired-move-to-filename-regexp a) + (setq posa (match-end 0)) + (string-match dired-move-to-filename-regexp b) + (setq posb (match-end 0)) + (string-lessp (substring a posa) (substring b posb)))) + +(defun tramp-adb-handle-make-directory (dir &optional parents) + "Like `make-directory' for Tramp files." + (setq dir (expand-file-name dir)) + (with-parsed-tramp-file-name dir nil + (when parents + (let ((par (expand-file-name ".." dir))) + (unless (file-directory-p par) + (make-directory par parents)))) + (tramp-adb-barf-unless-okay + v (format "mkdir %s" (tramp-shell-quote-argument localname)) + "Couldn't make directory %s" dir) + (tramp-flush-directory-property v (file-name-directory localname)))) + +(defun tramp-adb-handle-delete-directory (directory &optional recursive) + "Like `delete-directory' for Tramp files." + (setq directory (expand-file-name directory)) + (with-parsed-tramp-file-name directory nil + (tramp-flush-file-property v (file-name-directory localname)) + (tramp-flush-directory-property v localname) + (tramp-adb-barf-unless-okay + v (format "%s %s" + (if recursive "rm -r" "rmdir") + (tramp-shell-quote-argument localname)) + "Couldn't delete %s" directory))) + +(defun tramp-adb-handle-delete-file (filename &optional trash) + "Like `delete-file' for Tramp files." + (setq filename (expand-file-name filename)) + (with-parsed-tramp-file-name filename nil + (tramp-flush-file-property v (file-name-directory localname)) + (tramp-flush-file-property v localname) + (tramp-adb-barf-unless-okay + v (format "rm %s" (tramp-shell-quote-argument localname)) + "Couldn't delete %s" filename))) + +(defun tramp-adb-handle-file-name-all-completions (filename directory) + "Like `file-name-all-completions' for Tramp files." + (all-completions + filename + (with-parsed-tramp-file-name directory nil + (with-tramp-file-property v localname "file-name-all-completions" + (save-match-data + (tramp-adb-send-command + v (format "%s %s" + (tramp-adb-get-ls-command v) + (tramp-shell-quote-argument localname))) + (mapcar + (lambda (f) + (if (file-directory-p f) + (file-name-as-directory f) + f)) + (with-current-buffer (tramp-get-buffer v) + (delq + nil + (mapcar + (lambda (l) (and (not (string-match "^[[:space:]]*$" l)) l)) + (split-string (buffer-string) "\n")))))))))) + +(defun tramp-adb-handle-file-local-copy (filename) + "Like `file-local-copy' for Tramp files." + (with-parsed-tramp-file-name filename nil + (unless (file-exists-p (file-truename filename)) + (tramp-error + v 'file-error + "Cannot make local copy of non-existing file `%s'" filename)) + (let ((tmpfile (tramp-compat-make-temp-file filename))) + (with-tramp-progress-reporter + v 3 (format "Fetching %s to tmp file %s" filename tmpfile) + (when (tramp-adb-execute-adb-command v "pull" localname tmpfile) + (delete-file tmpfile) + (tramp-error + v 'file-error "Cannot make local copy of file `%s'" filename)) + (set-file-modes tmpfile (file-modes filename))) + tmpfile))) + +(defun tramp-adb-handle-file-writable-p (filename) + "Like `tramp-sh-handle-file-writable-p'. +But handle the case, if the \"test\" command is not available." + (with-parsed-tramp-file-name filename nil + (with-tramp-file-property v localname "file-writable-p" + (if (tramp-adb-find-test-command v) + (if (file-exists-p filename) + (zerop + (tramp-adb-command-exit-status + v (format "test -w %s" (tramp-shell-quote-argument localname)))) + (and + (file-directory-p (file-name-directory filename)) + (file-writable-p (file-name-directory filename)))) + + ;; Missing "test" command on Android < 4. + (let ((rw-path "/data/data")) + (tramp-message + v 5 + "Not implemented yet (assuming \"/data/data\" is writable): %s" + localname) + (and (>= (length localname) (length rw-path)) + (string= (substring localname 0 (length rw-path)) + rw-path))))))) + +(defun tramp-adb-handle-write-region + (start end filename &optional append visit lockname confirm) + "Like `write-region' for Tramp files." + (setq filename (expand-file-name filename)) + (with-parsed-tramp-file-name filename nil + (when append + (tramp-error + v 'file-error "Cannot append to file using Tramp (`%s')" filename)) + (when (and confirm (file-exists-p filename)) + (unless (y-or-n-p (format "File %s exists; overwrite anyway? " + filename)) + (tramp-error v 'file-error "File not overwritten"))) + ;; We must also flush the cache of the directory, because + ;; `file-attributes' reads the values from there. + (tramp-flush-file-property v (file-name-directory localname)) + (tramp-flush-file-property v localname) + (let* ((curbuf (current-buffer)) + (tmpfile (tramp-compat-make-temp-file filename))) + (tramp-run-real-handler + '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) + (unwind-protect + (when (tramp-adb-execute-adb-command v "push" tmpfile localname) + (tramp-error v 'file-error "Cannot write: `%s' filename")) + (delete-file tmpfile))) + + (unless (equal curbuf (current-buffer)) + (tramp-error + v 'file-error + "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))))) + +(defun tramp-adb-handle-set-file-modes (filename mode) + "Like `set-file-modes' for Tramp files." + (with-parsed-tramp-file-name filename nil + (tramp-flush-file-property v localname) + (tramp-adb-barf-unless-okay + v (format "chmod %s %s" (tramp-compat-decimal-to-octal mode) localname) + "Error while changing file's mode %s" filename))) + +(defun tramp-adb-handle-set-file-times (filename &optional time) + "Like `set-file-times' for Tramp files." + (with-parsed-tramp-file-name filename nil + (tramp-flush-file-property v localname) + (let ((time (if (or (null time) (equal time '(0 0))) + (current-time) + time))) + (tramp-adb-command-exit-status + ;; use shell arithmetic because of Emacs integer size limit + v (format "touch -t $(( %d * 65536 + %d )) %s" + (car time) (cadr time) + (tramp-shell-quote-argument localname)))))) + +(defun tramp-adb-handle-copy-file + (filename newname &optional ok-if-already-exists keep-date + preserve-uid-gid preserve-extended-attributes) + "Like `copy-file' for Tramp files. +PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." + (setq filename (expand-file-name filename) + newname (expand-file-name newname)) + + (if (file-directory-p filename) + (tramp-file-name-handler 'copy-directory filename newname keep-date t) + (with-tramp-progress-reporter + (tramp-dissect-file-name (if (file-remote-p filename) filename newname)) + 0 (format "Copying %s to %s" filename newname) + + (let ((tmpfile (file-local-copy filename))) + + (if tmpfile + ;; Remote filename. + (condition-case err + (rename-file tmpfile newname ok-if-already-exists) + ((error quit) + (delete-file tmpfile) + (signal (car err) (cdr err)))) + + ;; Remote newname. + (when (file-directory-p newname) + (setq newname + (expand-file-name (file-name-nondirectory filename) newname))) + + (with-parsed-tramp-file-name newname nil + (when (and (not ok-if-already-exists) + (file-exists-p newname)) + (tramp-error v 'file-already-exists newname)) + + ;; We must also flush the cache of the directory, because + ;; `file-attributes' reads the values from there. + (tramp-flush-file-property v (file-name-directory localname)) + (tramp-flush-file-property v localname) + (when (tramp-adb-execute-adb-command v "push" filename localname) + (tramp-error + v 'file-error "Cannot copy `%s' `%s'" filename newname)))))) + + ;; KEEP-DATE handling. + (when keep-date + (set-file-times newname (nth 5 (file-attributes filename)))))) + +(defun tramp-adb-handle-rename-file + (filename newname &optional ok-if-already-exists) + "Like `rename-file' for Tramp files." + (setq filename (expand-file-name filename) + newname (expand-file-name newname)) + + (with-parsed-tramp-file-name + (if (file-remote-p filename) filename newname) nil + (with-tramp-progress-reporter + v 0 (format "Renaming %s to %s" newname filename) + + (if (and (tramp-equal-remote filename newname) + (not (file-directory-p filename))) + (progn + (when (and (not ok-if-already-exists) + (file-exists-p newname)) + (tramp-error v 'file-already-exists newname)) + ;; We must also flush the cache of the directory, because + ;; `file-attributes' reads the values from there. + (tramp-flush-file-property v (file-name-directory localname)) + (tramp-flush-file-property v localname) + ;; Short track. + (tramp-adb-barf-unless-okay + v (format + "mv %s %s" + (tramp-file-name-handler 'file-remote-p filename 'localname) + localname) + "Error renaming %s to %s" filename newname)) + + ;; Rename by copy. + (copy-file filename newname ok-if-already-exists t t) + (delete-file filename))))) + +(defun tramp-adb-handle-process-file + (program &optional infile destination display &rest args) + "Like `process-file' for Tramp files." + ;; The implementation is not complete yet. + (when (and (numberp destination) (zerop destination)) + (error "Implementation does not handle immediate return")) + + (with-parsed-tramp-file-name default-directory nil + (let (command input tmpinput stderr tmpstderr outbuf ret) + ;; Compute command. + (setq command (mapconcat 'tramp-shell-quote-argument + (cons program args) " ")) + ;; Determine input. + (if (null infile) + (setq input "/dev/null") + (setq infile (expand-file-name infile)) + (if (tramp-equal-remote default-directory infile) + ;; INFILE is on the same remote host. + (setq input (with-parsed-tramp-file-name infile nil localname)) + ;; INFILE must be copied to remote host. + (setq input (tramp-make-tramp-temp-file v) + tmpinput (tramp-make-tramp-file-name method user host input)) + (copy-file infile tmpinput t))) + (when input (setq command (format "%s <%s" command input))) + + ;; Determine output. + (cond + ;; Just a buffer. + ((bufferp destination) + (setq outbuf destination)) + ;; A buffer name. + ((stringp destination) + (setq outbuf (get-buffer-create destination))) + ;; (REAL-DESTINATION ERROR-DESTINATION) + ((consp destination) + ;; output. + (cond + ((bufferp (car destination)) + (setq outbuf (car destination))) + ((stringp (car destination)) + (setq outbuf (get-buffer-create (car destination)))) + ((car destination) + (setq outbuf (current-buffer)))) + ;; stderr. + (cond + ((stringp (cadr destination)) + (setcar (cdr destination) (expand-file-name (cadr destination))) + (if (tramp-equal-remote default-directory (cadr destination)) + ;; stderr is on the same remote host. + (setq stderr (with-parsed-tramp-file-name + (cadr destination) nil localname)) + ;; stderr must be copied to remote host. The temporary + ;; file must be deleted after execution. + (setq stderr (tramp-make-tramp-temp-file v) + tmpstderr (tramp-make-tramp-file-name + method user host stderr)))) + ;; stderr to be discarded. + ((null (cadr destination)) + (setq stderr "/dev/null")))) + ;; 't + (destination + (setq outbuf (current-buffer)))) + (when stderr (setq command (format "%s 2>%s" command stderr))) + + ;; Send the command. It might not return in time, so we protect + ;; it. Call it in a subshell, in order to preserve working + ;; directory. + (condition-case nil + (progn + (setq ret 0 + ret + (tramp-adb-barf-unless-okay + v (format "(cd %s; %s)" + (tramp-shell-quote-argument localname) + command) + "")) + ;; We should show the output anyway. + (when outbuf + (with-current-buffer outbuf + (insert-buffer-substring (tramp-get-connection-buffer v))) + (when display (display-buffer outbuf)))) + ;; When the user did interrupt, we should do it also. We use + ;; return code -1 as marker. + (quit + (kill-buffer (tramp-get-connection-buffer v)) + (setq ret -1)) + ;; Handle errors. + (error + (kill-buffer (tramp-get-connection-buffer v)) + (setq ret 1))) + + ;; Provide error file. + (when tmpstderr (rename-file tmpstderr (cadr destination) t)) + + ;; Cleanup. We remove all file cache values for the connection, + ;; because the remote process could have changed them. + (when tmpinput (delete-file tmpinput)) + + ;; `process-file-side-effects' has been introduced with GNU + ;; Emacs 23.2. If set to `nil', no remote file will be changed + ;; by `program'. If it doesn't exist, we assume its default + ;; value 't'. + (unless (and (boundp 'process-file-side-effects) + (not (symbol-value 'process-file-side-effects))) + (tramp-flush-directory-property v "")) + + ;; Return exit status. + (if (equal ret -1) + (keyboard-quit) + ret)))) + +(defun tramp-adb-handle-shell-command + (command &optional output-buffer error-buffer) + "Like `shell-command' for Tramp files." + (let* ((asynchronous (string-match "[ \t]*&[ \t]*\\'" command)) + ;; We cannot use `shell-file-name' and `shell-command-switch', + ;; they are variables of the local host. + (args (list "sh" "-c" (substring command 0 asynchronous))) + current-buffer-p + (output-buffer + (cond + ((bufferp output-buffer) output-buffer) + ((stringp output-buffer) (get-buffer-create output-buffer)) + (output-buffer + (setq current-buffer-p t) + (current-buffer)) + (t (get-buffer-create + (if asynchronous + "*Async Shell Command*" + "*Shell Command Output*"))))) + (error-buffer + (cond + ((bufferp error-buffer) error-buffer) + ((stringp error-buffer) (get-buffer-create error-buffer)))) + (buffer + (if (and (not asynchronous) error-buffer) + (with-parsed-tramp-file-name default-directory nil + (list output-buffer (tramp-make-tramp-temp-file v))) + output-buffer)) + (p (get-buffer-process output-buffer))) + + ;; Check whether there is another process running. Tramp does not + ;; support 2 (asynchronous) processes in parallel. + (when p + (if (yes-or-no-p "A command is running. Kill it? ") + (ignore-errors (kill-process p)) + (error "Shell command in progress"))) + + (if current-buffer-p + (progn + (barf-if-buffer-read-only) + (push-mark nil t)) + (with-current-buffer output-buffer + (setq buffer-read-only nil) + (erase-buffer))) + + (if (and (not current-buffer-p) (integerp asynchronous)) + (prog1 + ;; Run the process. + (apply 'start-file-process "*Async Shell*" buffer args) + ;; Display output. + (pop-to-buffer output-buffer) + (setq mode-line-process '(":%s")) + (shell-mode)) + + (prog1 + ;; Run the process. + (apply 'process-file (car args) nil buffer nil (cdr args)) + ;; Insert error messages if they were separated. + (when (listp buffer) + (with-current-buffer error-buffer + (insert-file-contents (cadr buffer))) + (delete-file (cadr buffer))) + (if current-buffer-p + ;; This is like exchange-point-and-mark, but doesn't + ;; activate the mark. It is cleaner to avoid activation, + ;; even though the command loop would deactivate the mark + ;; because we inserted text. + (goto-char (prog1 (mark t) + (set-marker (mark-marker) (point) + (current-buffer)))) + ;; There's some output, display it. + (when (with-current-buffer output-buffer (> (point-max) (point-min))) + (if (functionp 'display-message-or-buffer) + (tramp-compat-funcall 'display-message-or-buffer output-buffer) + (pop-to-buffer output-buffer)))))))) + +;; We use BUFFER also as connection buffer during setup. Because of +;; this, its original contents must be saved, and restored once +;; connection has been setup. +(defun tramp-adb-handle-start-file-process (name buffer program &rest args) + "Like `start-file-process' for Tramp files." + (with-parsed-tramp-file-name default-directory nil + ;; When PROGRAM is nil, we just provide a tty. + (let ((command + (when (stringp program) + (format "cd %s; %s" + (tramp-shell-quote-argument localname) + (mapconcat 'tramp-shell-quote-argument + (cons program args) " ")))) + (tramp-process-connection-type + (or (null program) tramp-process-connection-type)) + (name1 name) + (i 0)) + (unwind-protect + (save-excursion + (save-restriction + (while (get-process name1) + ;; NAME must be unique as process name. + (setq i (1+ i) + name1 (format "%s<%d>" name i))) + (setq name name1) + ;; Set the new process properties. + (tramp-set-connection-property v "process-name" name) + (when command + (let* ((host (tramp-file-name-host v)) + (devices (mapcar 'cadr (tramp-adb-parse-device-names nil))) + (args (if (> (length host) 0) + (list "-s" host "shell" command) + (list "shell" command))) + (p (apply 'start-process (tramp-get-connection-name v) buffer + (tramp-adb-program) args))) + ;; Set sentinel and query flag for this process. + (tramp-set-connection-property p "vector" v) + (set-process-sentinel p 'tramp-process-sentinel) + (tramp-compat-set-process-query-on-exit-flag p t) + ;; Return process. + p)))) + (tramp-set-connection-property v "process-name" nil))))) + +;; Helper functions. + +(defun tramp-adb-execute-adb-command (vec &rest args) + "Returns nil on success error-output on failure." + (when (> (length (tramp-file-name-host vec)) 0) + (setq args (append (list "-s" (tramp-file-name-host vec)) args))) + (with-temp-buffer + (prog1 + (unless (zerop (apply 'call-process (tramp-adb-program) nil t nil args)) + (buffer-string)) + (tramp-message + vec 6 "%s %s\n%s" + (tramp-adb-program) (mapconcat 'identity args " ") (buffer-string))))) + +(defun tramp-adb-find-test-command (vec) + "Checks, whether the ash has a builtin \"test\" command. +This happens for Android >= 4.0." + (with-tramp-connection-property vec "test" + (zerop (tramp-adb-command-exit-status vec "type test")))) + +;; Connection functions + +(defun tramp-adb-send-command (vec command) + "Send the COMMAND to connection VEC." + (tramp-adb-maybe-open-connection vec) + (tramp-message vec 6 "%s" command) + (tramp-send-string vec command) + ;; fixme: Race condition + (tramp-adb-wait-for-output (tramp-get-connection-process vec)) + (with-current-buffer (tramp-get-connection-buffer vec) + (save-excursion + (goto-char (point-min)) + ;; We can't use stty to disable echo of command. + (delete-matching-lines (regexp-quote command)) + ;; When the local machine is W32, there are still trailing ^M. + ;; There must be a better solution by setting the correct coding + ;; system, but this requires changes in core Tramp. + (goto-char (point-min)) + (while (re-search-forward "\r+$" nil t) + (replace-match "" nil nil))))) + +(defun tramp-adb-barf-unless-okay (vec command fmt &rest args) + "Run COMMAND, check exit status, throw error if exit status not okay. +FMT and ARGS are passed to `error'." + (tramp-adb-send-command vec (format "%s; echo tramp_exit_status $?" command)) + (with-current-buffer (tramp-get-connection-buffer vec) + (goto-char (point-max)) + (unless (re-search-backward "tramp_exit_status [0-9]+" nil t) + (tramp-error + vec 'file-error "Couldn't find exit status of `%s'" command)) + (skip-chars-forward "^ ") + (unless (zerop (read (current-buffer))) + (apply 'tramp-error vec 'file-error fmt args)) + (let (buffer-read-only) + (delete-region (match-beginning 0) (point-max))))) + +(defun tramp-adb-command-exit-status + (vec command) + "Run COMMAND and return its exit status. +Sends `echo $?' along with the COMMAND for checking the exit status. If +COMMAND is nil, just sends `echo $?'. Returns the exit status found." + (tramp-adb-send-command vec (format "%s; echo tramp_exit_status $?" command)) + (with-current-buffer (tramp-get-connection-buffer vec) + (goto-char (point-max)) + (unless (re-search-backward "tramp_exit_status [0-9]+" nil t) + (tramp-error + vec 'file-error "Couldn't find exit status of `%s'" command)) + (skip-chars-forward "^ ") + (read (current-buffer)))) + +(defun tramp-adb-wait-for-output (proc &optional timeout) + "Wait for output from remote command." + (unless (buffer-live-p (process-buffer proc)) + (delete-process proc) + (tramp-error proc 'file-error "Process `%s' not available, try again" proc)) + (with-current-buffer (process-buffer proc) + (if (tramp-wait-for-regexp proc timeout tramp-adb-prompt) + (let (buffer-read-only) + (goto-char (point-min)) + ;; ADB terminal sends "^H" sequences. + (when (re-search-forward "<\b+" (point-at-eol) t) + (forward-line 1) + (delete-region (point-min) (point))) + ;; Delete the prompt. + (goto-char (point-min)) + (when (re-search-forward tramp-adb-prompt (point-at-eol) t) + (forward-line 1) + (delete-region (point-min) (point))) + (goto-char (point-max)) + (re-search-backward tramp-adb-prompt nil t) + (delete-region (point) (point-max))) + (if timeout + (tramp-error + proc 'file-error + "[[Remote adb prompt `%s' not found in %d secs]]" + tramp-adb-prompt timeout) + (tramp-error + proc 'file-error + "[[Remote prompt `%s' not found]]" tramp-adb-prompt))))) + +(defun tramp-adb-maybe-open-connection (vec) + "Maybe open a connection VEC. +Does not do anything if a connection is already open, but re-opens the +connection if a previous connection has died for some reason." + (let* ((buf (tramp-get-connection-buffer vec)) + (p (get-buffer-process buf)) + (host (tramp-file-name-host vec)) + (devices (mapcar 'cadr (tramp-adb-parse-device-names nil)))) + (unless + (and p (processp p) (memq (process-status p) '(run open))) + (save-match-data + (when (and p (processp p)) (delete-process p)) + (if (not devices) + (tramp-error vec 'file-error "No device connected")) + (if (and (> (length host) 0) (not (member host devices))) + (tramp-error vec 'file-error "Device %s not connected" host)) + (if (and (> (length devices) 1) (zerop (length host))) + (tramp-error + vec 'file-error + "Multiple Devices connected: No Host/Device specified")) + (with-tramp-progress-reporter vec 3 "Opening adb shell connection" + (let* ((coding-system-for-read 'utf-8-dos) ;is this correct? + (process-connection-type tramp-process-connection-type) + (args (if (> (length host) 0) + (list "-s" host "shell") + (list "shell"))) + (p (let ((default-directory + (tramp-compat-temporary-file-directory))) + (apply 'start-process (tramp-get-connection-name vec) buf + (tramp-adb-program) args)))) + (tramp-message + vec 6 "%s" (mapconcat 'identity (process-command p) " ")) + ;; Wait for initial prompt. + (tramp-adb-wait-for-output p) + (unless (eq 'run (process-status p)) + (tramp-error vec 'file-error "Terminated!")) + (tramp-compat-set-process-query-on-exit-flag p nil) + + ;; Check whether the properties have been changed. If + ;; yes, this is a strong indication that we must expire all + ;; connection properties. We start again. + (tramp-message vec 5 "Checking system information") + (tramp-adb-send-command + vec "echo \\\"`getprop ro.product.model` `getprop ro.product.version` `getprop ro.build.version.release`\\\"") + (let ((old-getprop + (tramp-get-connection-property vec "getprop" nil)) + (new-getprop + (tramp-set-connection-property + vec "getprop" + (with-current-buffer (tramp-get-connection-buffer vec) + ;; Read the expression. + (goto-char (point-min)) + (read (current-buffer)))))) + (when (and (stringp old-getprop) + (not (string-equal old-getprop new-getprop))) + (tramp-cleanup vec) + (tramp-message + vec 3 + "Connection reset, because remote host changed from `%s' to `%s'" + old-getprop new-getprop) + (tramp-adb-maybe-open-connection vec))) + + ;; Set "remote-path" connection property. This is needed + ;; for eshell. + (tramp-adb-send-command vec "echo \\\"$PATH\\\"") + (tramp-set-connection-property + vec "remote-path" + (split-string + (with-current-buffer (tramp-get-connection-buffer vec) + ;; Read the expression. + (goto-char (point-min)) + (read (current-buffer))) + ":" 'omit-nulls)))))))) + +(provide 'tramp-adb) +;;; tramp-adb.el ends here diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 58469b22447..462f0d88367 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -186,7 +186,7 @@ This includes password cache, file cache, connection cache, buffers." 'tramp-load-report-modules ; pre-hook 'tramp-append-tramp-buffers ; post-hook - "\ + (propertize "\n" 'display "\ Enter your bug report in this message, including as much detail as you possibly can about the problem, what you did to cause it and what the local and remote machines are. @@ -209,7 +209,7 @@ contents of the *tramp/foo* buffer and the *debug tramp/foo* buffer in your bug report. --bug report follows this line-- -")))) +"))))) (defun tramp-reporter-dump-variable (varsym mailbuf) "Pretty-print the value of the variable in symbol VARSYM." @@ -348,10 +348,10 @@ the debug buffer(s).") (kill-buffer nil) (switch-to-buffer curbuf) (goto-char (point-max)) - (insert "\n\ + (insert (propertize "\n" 'display "\n\ This is a special notion of the `gnus/message' package. If you use another mail agent (by copying the contents of this buffer) -please ensure that the buffers are attached to your email.\n\n") +please ensure that the buffers are attached to your email.\n\n")) (dolist (buffer buffer-list) (tramp-compat-funcall 'mml-insert-empty-tag 'part 'type "text/plain" diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index ae91dc35b71..00ef43b1a66 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -71,22 +71,6 @@ (require 'timer-funcs) (require 'timer)) - ;; We check whether `start-file-process' is bound. - ;; Note: we deactivate this. There are problems, at least in SXEmacs. - (unless t;(fboundp 'start-file-process) - - ;; tramp-util offers integration into other (X)Emacs packages like - ;; compile.el, gud.el etc. Not necessary in Emacs 23. - (eval-after-load "tramp" - '(require 'tramp-util)) - - ;; Make sure that we get integration with the VC package. When it - ;; is loaded, we need to pull in the integration module. Not - ;; necessary in Emacs 23. - (eval-after-load "vc" - (eval-after-load "tramp" - '(require 'tramp-vc)))) - ;; Avoid byte-compiler warnings if the byte-compiler supports this. ;; Currently, XEmacs supports this. (when (featurep 'xemacs) @@ -132,9 +116,7 @@ ;; mechanism. ;; `file-remote-p' has been introduced with Emacs 22. The version - ;; of XEmacs is not a magic file name function (yet); this is - ;; corrected in tramp-util.el. Here it is sufficient if the - ;; function exists. + ;; of XEmacs is not a magic file name function (yet). (unless (fboundp 'file-remote-p) (defalias 'file-remote-p (lambda (file &optional identification connected) @@ -322,16 +304,17 @@ Not actually used. Use `(format \"%o\" i)' instead?" (wrong-number-of-arguments (file-attributes filename)))))) ;; PRESERVE-UID-GID does not exist in XEmacs. -;; PRESERVE-SELINUX-CONTEXT has been introduced with Emacs 24.1. +;; PRESERVE-EXTENDED-ATTRIBUTES has been introduced with Emacs 24.1 +;; (as PRESERVE-SELINUX-CONTEXT), and renamed in Emacs 24.3. (defun tramp-compat-copy-file (filename newname &optional ok-if-already-exists keep-date - preserve-uid-gid preserve-selinux-context) + preserve-uid-gid preserve-extended-attributes) "Like `copy-file' for Tramp files (compat function)." (cond - (preserve-selinux-context + (preserve-extended-attributes (tramp-compat-funcall 'copy-file filename newname ok-if-already-exists keep-date - preserve-uid-gid preserve-selinux-context)) + preserve-uid-gid preserve-extended-attributes)) (preserve-uid-gid (tramp-compat-funcall 'copy-file filename newname ok-if-already-exists keep-date diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el index d4e246da2f0..7d266d4d172 100644 --- a/lisp/net/tramp-ftp.el +++ b/lisp/net/tramp-ftp.el @@ -200,6 +200,8 @@ pass to the OPERATION." (inhibit-file-name-operation operation)) (apply 'ange-ftp-hook-function operation args))))))) +;; It must be a `defsubst' in order to push the whole code into +;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading. ;;;###tramp-autoload (defsubst tramp-ftp-file-name-p (filename) "Check if it's a filename that should be forwarded to Ange-FTP." diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 7dbd073a8f9..7473871e564 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -384,7 +384,8 @@ Every entry is a list (NAME ADDRESS).") (dired-uncache . tramp-handle-dired-uncache) ;; `executable-find' is not official yet. performed by default handler. (expand-file-name . tramp-gvfs-handle-expand-file-name) - ;; `file-accessible-directory-p' performed by default handler. + (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) + (file-acl . tramp-gvfs-handle-file-acl) (file-attributes . tramp-gvfs-handle-file-attributes) (file-directory-p . tramp-gvfs-handle-file-directory-p) (file-executable-p . tramp-gvfs-handle-file-executable-p) @@ -417,6 +418,7 @@ Every entry is a list (NAME ADDRESS).") (make-symbolic-link . ignore) (process-file . tramp-gvfs-handle-process-file) (rename-file . tramp-gvfs-handle-rename-file) + (set-file-acl . tramp-gvfs-handle-set-file-acl) (set-file-modes . tramp-gvfs-handle-set-file-modes) (set-file-selinux-context . tramp-gvfs-handle-set-file-selinux-context) (set-visited-file-modtime . tramp-gvfs-handle-set-visited-file-modtime) @@ -432,6 +434,8 @@ Every entry is a list (NAME ADDRESS).") "Alist of handler functions for Tramp GVFS method. Operations not mentioned here will be handled by the default Emacs primitives.") +;; It must be a `defsubst' in order to push the whole code into +;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading. ;;;###tramp-autoload (defsubst tramp-gvfs-file-name-p (filename) "Check if it's a filename handled by the GVFS daemon." @@ -526,14 +530,18 @@ is no information where to trace the message.") (tramp-message tramp-gvfs-dbus-event-vector 10 "%S" event) (tramp-error tramp-gvfs-dbus-event-vector 'file-error "%s" (cadr err)))) -(add-hook 'dbus-event-error-functions 'tramp-gvfs-dbus-event-error) +;; `dbus-event-error-hooks' has been renamed to `dbus-event-error-functions'. +(add-hook + (if (boundp 'dbus-event-error-functions) + 'dbus-event-error-functions 'dbus-event-error-hooks) + 'tramp-gvfs-dbus-event-error) ;; File name primitives. (defun tramp-gvfs-handle-copy-file (filename newname &optional ok-if-already-exists keep-date - preserve-uid-gid preserve-selinux-context) + preserve-uid-gid preserve-extended-attributes) "Like `copy-file' for Tramp files." (with-parsed-tramp-file-name (if (tramp-tramp-file-p filename) filename newname) nil @@ -549,8 +557,8 @@ is no information where to trace the message.") (tramp-gvfs-fuse-file-name newname) newname) ok-if-already-exists keep-date preserve-uid-gid))) - (when preserve-selinux-context - (setq args (append args (list preserve-selinux-context)))) + (when preserve-extended-attributes + (setq args (append args (list preserve-extended-attributes)))) (apply 'copy-file args)) ;; Error case. Let's try it with the GVFS utilities. @@ -649,6 +657,10 @@ is no information where to trace the message.") (tramp-run-real-handler 'expand-file-name (list localname)))))) +(defun tramp-gvfs-handle-file-acl (filename) + "Like `file-acl' for Tramp files." + (tramp-compat-funcall 'file-acl (tramp-gvfs-fuse-file-name filename))) + (defun tramp-gvfs-handle-file-attributes (filename &optional id-format) "Like `file-attributes' for Tramp files." (file-attributes (tramp-gvfs-fuse-file-name filename) id-format)) @@ -775,6 +787,11 @@ is no information where to trace the message.") (tramp-flush-file-property v (file-name-directory localname)) (tramp-flush-file-property v localname)))) +(defun tramp-gvfs-handle-set-file-acl (filename acl-string) + "Like `set-file-acl' for Tramp files." + (with-tramp-gvfs-error-message filename 'set-file-acl + (tramp-gvfs-fuse-file-name filename) acl-string)) + (defun tramp-gvfs-handle-set-file-modes (filename mode) "Like `set-file-modes' for Tramp files." (with-tramp-gvfs-error-message filename 'set-file-modes diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 2152ba1e270..63e966b91b2 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -935,6 +935,7 @@ This is used to map a mode number to a permission string.") (file-name-nondirectory . tramp-handle-file-name-nondirectory) (file-truename . tramp-sh-handle-file-truename) (file-exists-p . tramp-sh-handle-file-exists-p) + (file-accessible-directory-p . tramp-handle-file-accessible-directory-p) (file-directory-p . tramp-sh-handle-file-directory-p) (file-executable-p . tramp-sh-handle-file-executable-p) (file-readable-p . tramp-sh-handle-file-readable-p) @@ -985,6 +986,8 @@ This is used to map a mode number to a permission string.") (verify-visited-file-modtime . tramp-sh-handle-verify-visited-file-modtime) (file-selinux-context . tramp-sh-handle-file-selinux-context) (set-file-selinux-context . tramp-sh-handle-set-file-selinux-context) + (file-acl . tramp-sh-handle-file-acl) + (set-file-acl . tramp-sh-handle-set-file-acl) (vc-registered . tramp-sh-handle-vc-registered)) "Alist of handler functions. Operations not mentioned here will be handled by the normal Emacs functions.") @@ -1528,10 +1531,49 @@ be non-negative integers." (if (stringp (nth 3 context)) (format "--range=%s" (nth 3 context)) "") (tramp-shell-quote-argument localname)))) - (tramp-set-file-property v localname "file-selinux-context" context) - (tramp-set-file-property v localname "file-selinux-context" 'undef))) - ;; We always return nil. - nil) + (progn + (tramp-set-file-property v localname "file-selinux-context" context) + t) + (tramp-set-file-property v localname "file-selinux-context" 'undef) + nil))) + +(defun tramp-remote-acl-p (vec) + "Check, whether ACL is enabled on the remote host." + (with-tramp-connection-property (tramp-get-connection-process vec) "acl-p" + (tramp-send-command-and-check vec "getfacl /"))) + +(defun tramp-sh-handle-file-acl (filename) + "Like `file-acl' for Tramp files." + (with-parsed-tramp-file-name filename nil + (with-tramp-file-property v localname "file-acl" + (when (and (tramp-remote-acl-p v) + (tramp-send-command-and-check + v (format + "getfacl -ac %s 2>/dev/null" + (tramp-shell-quote-argument localname)))) + (with-current-buffer (tramp-get-connection-buffer v) + (goto-char (point-max)) + (delete-blank-lines) + (when (> (point-max) (point-min)) + (tramp-compat-funcall + 'substring-no-properties (buffer-string)))))))) + +(defun tramp-sh-handle-set-file-acl (filename acl-string) + "Like `set-file-acl' for Tramp files." + (with-parsed-tramp-file-name (expand-file-name filename) nil + (if (and (stringp acl-string) (tramp-remote-acl-p v) + (progn + (tramp-send-command + v (format "setfacl --set-file=- %s <<'EOF'\n%s\nEOF\n" + (tramp-shell-quote-argument localname) acl-string)) + (tramp-send-command-and-check v nil))) + ;; Success. + (progn + (tramp-set-file-property v localname "file-acl" acl-string) + t) + ;; In case of errors, we return `nil'. + (tramp-set-file-property v localname "file-acl-string" 'undef) + nil))) ;; Simple functions using the `test' command. @@ -1617,7 +1659,7 @@ be non-negative integers." (and (tramp-run-test "-d" (file-name-directory filename)) (tramp-run-test "-w" (file-name-directory filename))))))) -(defun tramp-sh-handle-file-ownership-preserved-p (filename) +(defun tramp-sh-handle-file-ownership-preserved-p (filename &optional group) "Like `file-ownership-preserved-p' for Tramp files." (with-parsed-tramp-file-name filename nil (with-tramp-file-property v localname "file-ownership-preserved-p" @@ -1625,7 +1667,10 @@ be non-negative integers." ;; Return t if the file doesn't exist, since it's true that no ;; information would be lost by an (attempted) delete and create. (or (null attributes) - (= (nth 2 attributes) (tramp-get-remote-uid v 'integer))))))) + (and + (= (nth 2 attributes) (tramp-get-remote-uid v 'integer)) + (or (not group) + (= (nth 3 attributes) (tramp-get-remote-gid v 'integer))))))))) ;; Directory listings. @@ -1881,7 +1926,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" (defun tramp-sh-handle-copy-file (filename newname &optional ok-if-already-exists keep-date - preserve-uid-gid preserve-selinux-context) + preserve-uid-gid preserve-extended-attributes) "Like `copy-file' for Tramp files." (setq filename (expand-file-name filename)) (setq newname (expand-file-name newname)) @@ -1891,13 +1936,13 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" (tramp-tramp-file-p newname)) (tramp-do-copy-or-rename-file 'copy filename newname ok-if-already-exists keep-date - preserve-uid-gid preserve-selinux-context)) + preserve-uid-gid preserve-extended-attributes)) ;; Compat section. - (preserve-selinux-context + (preserve-extended-attributes (tramp-run-real-handler 'copy-file (list filename newname ok-if-already-exists keep-date - preserve-uid-gid preserve-selinux-context))) + preserve-uid-gid preserve-extended-attributes))) (preserve-uid-gid (tramp-run-real-handler 'copy-file @@ -1960,7 +2005,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" (defun tramp-do-copy-or-rename-file (op filename newname &optional ok-if-already-exists keep-date - preserve-uid-gid preserve-selinux-context) + preserve-uid-gid preserve-extended-attributes) "Copy or rename a remote file. OP must be `copy' or `rename' and indicates the operation to perform. FILENAME specifies the file to copy or rename, NEWNAME is the name of @@ -1969,7 +2014,7 @@ OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already. KEEP-DATE means to make sure that NEWNAME has the same timestamp as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep the uid and gid if both files are on the same host. -PRESERVE-SELINUX-CONTEXT activates selinux commands. +PRESERVE-EXTENDED-ATTRIBUTES activates selinux and acl commands. This function is invoked by `tramp-sh-handle-copy-file' and `tramp-sh-handle-rename-file'. It is an error if OP is neither @@ -1980,8 +2025,8 @@ file names." (let ((t1 (tramp-tramp-file-p filename)) (t2 (tramp-tramp-file-p newname)) (length (nth 7 (file-attributes (file-truename filename)))) - (context (and preserve-selinux-context - (apply 'file-selinux-context (list filename)))) + (attributes (and preserve-extended-attributes + (apply 'file-extended-attributes (list filename)))) pr tm) (with-parsed-tramp-file-name (if t1 filename newname) nil @@ -2051,8 +2096,11 @@ file names." ;; One of them must be a Tramp file. (error "Tramp implementation says this cannot happen"))) - ;; Handle `preserve-selinux-context'. - (when context (apply 'set-file-selinux-context (list newname context))) + ;; Handle `preserve-extended-attributes'. We ignore possible + ;; errors, because ACL strings could be incompatible. + (when attributes + (ignore-errors + (apply 'set-file-extended-attributes (list newname attributes)))) ;; In case of `rename', we must flush the cache of the source file. (when (and t1 (eq op 'rename)) @@ -2380,17 +2428,38 @@ The method used must be an out-of-band method." ;; last longer than 60 secs. (let ((p (let ((default-directory (tramp-compat-temporary-file-directory))) - (apply 'start-process + (apply 'start-process-shell-command (tramp-get-connection-name v) (tramp-get-connection-buffer v) copy-program - (append copy-args (list source target)))))) + (append + copy-args + (list + (shell-quote-argument source) + (shell-quote-argument target) + "&&" "echo" "tramp_exit_status" "0" + "||" "echo" "tramp_exit_status" "1")))))) (tramp-message orig-vec 6 "%s" (mapconcat 'identity (process-command p) " ")) (tramp-compat-set-process-query-on-exit-flag p nil) (tramp-process-actions - p v nil tramp-actions-copy-out-of-band))) + p v nil tramp-actions-copy-out-of-band) + + ;; Check the return code. + (goto-char (point-max)) + (unless + (re-search-backward "tramp_exit_status [0-9]+" nil t) + (tramp-error + orig-vec 'file-error + "Couldn't find exit status of `%s'" (process-command p))) + (skip-chars-forward "^ ") + (unless (zerop (read (current-buffer))) + (forward-line -1) + (tramp-error + orig-vec 'file-error + "Error copying: `%s'" + (buffer-substring (point-min) (point-at-eol)))))) ;; Reset the transfer process properties. (tramp-message orig-vec 6 "\n%s" (buffer-string)) @@ -2755,6 +2824,8 @@ the result will be a local, non-Tramp, filename." (with-current-buffer (tramp-get-connection-buffer v) (unwind-protect + ;; We catch this event. Otherwise, `start-process' could + ;; be called on the local host. (save-excursion (save-restriction ;; Activate narrowing in order to save BUFFER @@ -2768,31 +2839,32 @@ the result will be a local, non-Tramp, filename." (narrow-to-region (point-max) (point-max)) ;; We call `tramp-maybe-open-connection', in order ;; to cleanup the prompt afterwards. - (tramp-maybe-open-connection v) - (widen) - (delete-region mark (point)) - (narrow-to-region (point-max) (point-max)) - ;; Now do it. - (if command - ;; Send the command. - (tramp-send-command v command nil t) ; nooutput - ;; Check, whether a pty is associated. - (unless (tramp-compat-process-get - (tramp-get-connection-process v) 'remote-tty) - (tramp-error - v 'file-error - "pty association is not supported for `%s'" name)))) - (let ((p (tramp-get-connection-process v))) - ;; Set query flag for this process. We ignore errors, - ;; because the process could have finished already. - (ignore-errors - (tramp-compat-set-process-query-on-exit-flag p t)) - ;; Return process. - p))) + (catch 'suppress + (tramp-maybe-open-connection v) + (widen) + (delete-region mark (point)) + (narrow-to-region (point-max) (point-max)) + ;; Now do it. + (if command + ;; Send the command. + (tramp-send-command v command nil t) ; nooutput + ;; Check, whether a pty is associated. + (unless (tramp-compat-process-get + (tramp-get-connection-process v) 'remote-tty) + (tramp-error + v 'file-error + "pty association is not supported for `%s'" name)))) + (let ((p (tramp-get-connection-process v))) + ;; Set query flag for this process. We ignore errors, + ;; because the process could have finished already. + (ignore-errors + (tramp-compat-set-process-query-on-exit-flag p t)) + ;; Return process. + p)))) ;; Save exit. (if (string-match tramp-temp-buffer-name (buffer-name)) - (progn + (ignore-errors (set-process-buffer (tramp-get-connection-process v) nil) (kill-buffer (current-buffer))) (set-buffer-modified-p bmp)) @@ -2912,16 +2984,6 @@ the result will be a local, non-Tramp, filename." (keyboard-quit) ret)))) -(defun tramp-sh-handle-call-process-region - (start end program &optional delete buffer display &rest args) - "Like `call-process-region' for Tramp files." - (let ((tmpfile (tramp-compat-make-temp-file ""))) - (write-region start end tmpfile) - (when delete (delete-region start end)) - (unwind-protect - (apply 'call-process program tmpfile buffer display args) - (delete-file tmpfile)))) - (defun tramp-sh-handle-file-local-copy (filename) "Like `file-local-copy' for Tramp files." (with-parsed-tramp-file-name filename nil @@ -4147,6 +4209,9 @@ Goes through the list `tramp-inline-compress-commands'." (tramp-message vec 2 "Couldn't find an inline transfer compress command"))))) +(defvar tramp-gw-tunnel-method) +(defvar tramp-gw-socks-method) + (defun tramp-compute-multi-hops (vec) "Expands VEC according to `tramp-default-proxies-alist'. Gateway hops are already opened." @@ -4207,10 +4272,11 @@ Gateway hops are already opened." (setq choices tramp-default-proxies-alist))))) ;; Handle gateways. - (when (string-match - (format - "^\\(%s\\|%s\\)$" tramp-gw-tunnel-method tramp-gw-socks-method) - (tramp-file-name-method (car target-alist))) + (when (and tramp-gw-tunnel-method tramp-gw-socks-method + (string-match + (format + "^\\(%s\\|%s\\)$" tramp-gw-tunnel-method tramp-gw-socks-method) + (tramp-file-name-method (car target-alist)))) (let ((gw (pop target-alist)) (hop (pop target-alist))) ;; Is the method prepared for gateways? @@ -5022,7 +5088,9 @@ This is used internally by `tramp-file-mode-from-int'." (if (equal id-format 'integer) (user-uid) (user-login-name))) (defun tramp-get-local-gid (id-format) - (nth 3 (tramp-compat-file-attributes "~/" id-format))) + (if (and (fboundp 'group-gid) (equal id-format 'integer)) + (tramp-compat-funcall 'group-gid) + (nth 3 (tramp-compat-file-attributes "~/" id-format)))) ;; Some predefined connection properties. (defun tramp-get-inline-compress (vec prop size) @@ -5120,34 +5188,6 @@ function cell is returned to be applied on a buffer." (t (format "%s <%%s" coding))))))) -;;; Integration of eshell.el: - -(eval-when-compile - (defvar eshell-path-env)) - -;; eshell.el keeps the path in `eshell-path-env'. We must change it -;; when `default-directory' points to another host. -(defun tramp-eshell-directory-change () - "Set `eshell-path-env' to $PATH of the host related to `default-directory'." - (setq eshell-path-env - (if (file-remote-p default-directory) - (with-parsed-tramp-file-name default-directory nil - (mapconcat - 'identity - (tramp-get-remote-path v) - ":")) - (getenv "PATH")))) - -(eval-after-load "esh-util" - '(progn - (tramp-eshell-directory-change) - (add-hook 'eshell-directory-change-hook - 'tramp-eshell-directory-change) - (add-hook 'tramp-unload-hook - (lambda () - (remove-hook 'eshell-directory-change-hook - 'tramp-eshell-directory-change))))) - (add-hook 'tramp-unload-hook (lambda () (unload-feature 'tramp-sh 'force))) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index b4bf10d4715..65c52ae4f3c 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -195,6 +195,7 @@ See `tramp-actions-before-shell' for more info.") (dired-uncache . tramp-handle-dired-uncache) (expand-file-name . tramp-smb-handle-expand-file-name) (file-accessible-directory-p . tramp-smb-handle-file-directory-p) + (file-acl . tramp-smb-handle-file-acl) (file-attributes . tramp-smb-handle-file-attributes) (file-directory-p . tramp-smb-handle-file-directory-p) (file-executable-p . tramp-handle-file-exists-p) @@ -227,8 +228,9 @@ See `tramp-actions-before-shell' for more info.") (make-symbolic-link . tramp-smb-handle-make-symbolic-link) (process-file . tramp-smb-handle-process-file) (rename-file . tramp-smb-handle-rename-file) + (set-file-acl . ignore) (set-file-modes . tramp-smb-handle-set-file-modes) - ;; `set-file-selinux-context' performed by default handler. + (set-file-selinux-context . ignore) (set-file-times . ignore) (set-visited-file-modtime . ignore) (shell-command . tramp-handle-shell-command) @@ -265,6 +267,8 @@ This can be used to disable echo etc." :type 'string :version "24.3") +;; It must be a `defsubst' in order to push the whole code into +;; tramp-loaddefs.el. Otherwise, there would be recursive autoloading. ;;;###tramp-autoload (defsubst tramp-smb-file-name-p (filename) "Check if it's a filename for SMB servers." @@ -485,10 +489,10 @@ pass to the OPERATION." (defun tramp-smb-handle-copy-file (filename newname &optional ok-if-already-exists keep-date - preserve-uid-gid preserve-selinux-context) + preserve-uid-gid preserve-extended-attributes) "Like `copy-file' for Tramp files. KEEP-DATE has no effect in case NEWNAME resides on an SMB server. -PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored." +PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setq filename (expand-file-name filename) newname (expand-file-name newname)) (with-tramp-progress-reporter @@ -637,6 +641,23 @@ PRESERVE-UID-GID and PRESERVE-SELINUX-CONTEXT are completely ignored." method user host (tramp-run-real-handler 'expand-file-name (list localname)))))) +(defun tramp-smb-handle-file-acl (filename) + "Like `file-acl' for Tramp files." + (with-parsed-tramp-file-name filename nil + (with-tramp-file-property v localname "file-acl" + (when (tramp-smb-send-command + v (format "getfacl \"%s\"" (tramp-smb-get-localname v))) + (with-current-buffer (tramp-get-connection-buffer v) + (goto-char (point-min)) + (while (looking-at "^#") + (forward-line) + (delete-region (point-min) (point))) + (goto-char (point-max)) + (delete-blank-lines) + (when (> (point-max) (point-min)) + (tramp-compat-funcall + 'substring-no-properties (buffer-string)))))))) + (defun tramp-smb-handle-file-attributes (filename &optional id-format) "Like `file-attributes' for Tramp files." (unless id-format (setq id-format 'integer)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index c29879691d7..045304cbc4f 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -381,6 +381,23 @@ Useful for su and sudo methods mostly." :group 'tramp :type 'string) +;;;###tramp-autoload +(defcustom tramp-default-host-alist nil + "Default host to use for specific method/user pairs. +This is an alist of items (METHOD USER HOST). The first matching item +specifies the host to use for a file name which does not specify a +host. METHOD and HOST are regular expressions or nil, which is +interpreted as a regular expression which always matches. If no entry +matches, the variable `tramp-default-host' takes effect. + +If the file name does not specify the method, lookup is done using the +empty string for the method name." + :group 'tramp + :version "24.4" + :type '(repeat (list (choice :tag "Method regexp" regexp sexp) + (choice :tag " User regexp" regexp sexp) + (choice :tag " Host name" string (const nil))))) + (defcustom tramp-default-proxies-alist nil "Route to be followed for specific host/user pairs. This is an alist of items (HOST USER PROXY). The first matching @@ -918,7 +935,7 @@ See `tramp-file-name-structure' for more explanations.") This regexp should match partial Tramp file names only. Please note that the entry in `file-name-handler-alist' is made when -this file (tramp.el) is loaded. This means that this variable must be set +this file \(tramp.el\) is loaded. This means that this variable must be set before loading tramp.el. Alternatively, `file-name-handler-alist' can be updated after changing this variable. @@ -1123,9 +1140,12 @@ If the `tramp-methods' entry does not exist, return nil." ;;;###tramp-autoload (defun tramp-tramp-file-p (name) - "Return t if NAME is a string with Tramp file name syntax." + "Return t if NAME is a string with Tramp file name syntax. +It checks also, whether NAME is unibyte encoded." (save-match-data - (and (stringp name) (string-match tramp-file-name-regexp name)))) + (and (stringp name) + (string-equal name (string-as-unibyte name)) + (string-match tramp-file-name-regexp name)))) (defun tramp-find-method (method user host) "Return the right method string to use. @@ -1163,6 +1183,15 @@ This is USER, if non-nil. Otherwise, do a lookup in "Return the right host string to use. This is HOST, if non-nil. Otherwise, it is `tramp-default-host'." (or (and (> (length host) 0) host) + (let ((choices tramp-default-host-alist) + lhost item) + (while choices + (setq item (pop choices)) + (when (and (string-match (or (nth 0 item) "") (or method "")) + (string-match (or (nth 1 item) "") (or user ""))) + (setq lhost (nth 2 item)) + (setq choices nil))) + lhost) tramp-default-host)) (defun tramp-dissect-file-name (name &optional nodefault) @@ -1455,6 +1484,11 @@ an input event arrives. The other arguments are passed to `tramp-error'." (or (and (bufferp buffer) buffer) (and (processp vec-or-proc) (process-buffer vec-or-proc)) (tramp-get-connection-buffer vec-or-proc))) + (when (string-equal fmt-string "Process died") + (message + "%s\n %s" + "Tramp failed to connect. If this happens repeatedly, try" + "`M-x tramp-cleanup-this-connection'")) (sit-for 30)))))) (defmacro with-parsed-tramp-file-name (filename var &rest body) @@ -1749,19 +1783,22 @@ value of `default-file-modes', without execute permissions." (logand (default-file-modes) (tramp-compat-octal-to-decimal "0666")))) (defun tramp-replace-environment-variables (filename) - "Replace environment variables in FILENAME. + "Replace environment variables in FILENAME. Return the string with the replaced variables." - (save-match-data - (let ((idx (string-match "$\\(\\w+\\)" filename))) - ;; `$' is coded as `$$'. - (when (and idx - (or (zerop idx) (not (eq ?$ (aref filename (1- idx))))) - (getenv (match-string 1 filename))) - (setq filename - (replace-match - (substitute-in-file-name (match-string 0 filename)) - t nil filename))) - filename))) + (or (ignore-errors + (tramp-compat-funcall 'substitute-env-vars filename 'only-defined)) + ;; We need an own implementation. + (save-match-data + (let ((idx (string-match "$\\(\\w+\\)" filename))) + ;; `$' is coded as `$$'. + (when (and idx + (or (zerop idx) (not (eq ?$ (aref filename (1- idx))))) + (getenv (match-string 1 filename))) + (setq filename + (replace-match + (substitute-in-file-name (match-string 0 filename)) + t nil filename))) + filename)))) ;; In XEmacs, electricity is implemented via a key map for ?/ and ?~, ;; which calls corresponding functions (see minibuf.el). @@ -1871,7 +1908,8 @@ ARGS are the arguments OPERATION has been called with." ;; Emacs 22+ only. 'set-file-times ;; Emacs 24+ only. - 'file-selinux-context 'set-file-selinux-context + 'file-acl 'file-selinux-context + 'set-file-acl 'set-file-selinux-context ;; XEmacs only. 'abbreviate-file-name 'create-file-buffer 'dired-file-modtime 'dired-make-compressed-filename @@ -1922,10 +1960,7 @@ ARGS are the arguments OPERATION has been called with." ;; Emacs 23+ only. 'start-file-process ;; XEmacs only. - 'dired-print-file 'dired-shell-call-process - ;; nowhere yet. - 'executable-find 'start-process - 'call-process 'call-process-region)) + 'dired-print-file 'dired-shell-call-process)) default-directory) ;; Unknown file primitive. (t (error "unknown file I/O primitive: %s" operation)))) @@ -2746,6 +2781,11 @@ User is always nil." (if (or dir-p (file-directory-p dir)) dir (file-name-directory dir)) nil (tramp-flush-directory-property v localname))) +(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))) + (defun tramp-handle-file-exists-p (filename) "Like `file-exists-p' for Tramp files." (not (null (file-attributes filename)))) @@ -3845,6 +3885,39 @@ Only works for Bourne-like shells." t t result))) result)))) +;;; Integration of eshell.el: + +(eval-when-compile + (defvar eshell-path-env)) + +;; eshell.el keeps the path in `eshell-path-env'. We must change it +;; when `default-directory' points to another host. +(defun tramp-eshell-directory-change () + "Set `eshell-path-env' to $PATH of the host related to `default-directory'." + (setq eshell-path-env + (if (file-remote-p default-directory) + (with-parsed-tramp-file-name default-directory nil + (mapconcat + 'identity + (or + ;; When `tramp-own-remote-path' is in `tramp-remote-path', + ;; the remote path is only set in the session cache. + (tramp-get-connection-property + (tramp-get-connection-process v) "remote-path" nil) + (tramp-get-connection-property v "remote-path" nil)) + ":")) + (getenv "PATH")))) + +(eval-after-load "esh-util" + '(progn + (tramp-eshell-directory-change) + (add-hook 'eshell-directory-change-hook + 'tramp-eshell-directory-change) + (add-hook 'tramp-unload-hook + (lambda () + (remove-hook 'eshell-directory-change-hook + 'tramp-eshell-directory-change))))) + ;; Checklist for `tramp-unload-hook' ;; - Unload all `tramp-*' packages ;; - Reset `file-name-handler-alist' diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 993fbda6dd7..b346d085307 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.6-24.3" +(defconst tramp-version "2.2.7-pre" "This version of Tramp.") ;;;###tramp-autoload @@ -44,7 +44,7 @@ (= emacs-major-version 21) (>= emacs-minor-version 4))) "ok" - (format "Tramp 2.2.6-24.3 is not fit for %s" + (format "Tramp 2.2.7-pre 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 d55feaa3c1a..bcb5f721ae8 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el @@ -1206,7 +1206,8 @@ changed with `comment-style'." (defun comment-box (beg end &optional arg) "Comment out the BEG .. END region, putting it inside a box. The numeric prefix ARG specifies how many characters to add to begin- and -end- comment markers additionally to what `comment-add' already specifies." +end- comment markers additionally to what variable `comment-add' already +specifies." (interactive "*r\np") (comment-normalize-vars) (let ((comment-style (if (cadr (assoc comment-style comment-styles)) diff --git a/lisp/notifications.el b/lisp/notifications.el index 8133ac72da2..5c8c8f1dc68 100644 --- a/lisp/notifications.el +++ b/lisp/notifications.el @@ -66,6 +66,9 @@ (defconst notifications-get-capabilities-method "GetCapabilities" "D-Bus notifications get capabilities method.") +(defconst notifications-get-server-information-method "GetServerInformation" + "D-Bus notifications get server information method.") + (defconst notifications-action-signal "ActionInvoked" "D-Bus notifications action signal.") @@ -199,142 +202,144 @@ This function returns a notification id, an integer, which can be used to manipulate the notification item with `notifications-close-notification' or the `:replaces-id' argument of another `notifications-notify' call." - (let ((bus (or (plist-get params :bus) :session)) - (title (plist-get params :title)) - (body (plist-get params :body)) - (app-name (plist-get params :app-name)) - (replaces-id (plist-get params :replaces-id)) - (app-icon (plist-get params :app-icon)) - (actions (plist-get params :actions)) - (timeout (plist-get params :timeout)) - ;; Hints - (hints '()) - (urgency (plist-get params :urgency)) - (category (plist-get params :category)) - (desktop-entry (plist-get params :desktop-entry)) - (image-data (plist-get params :image-data)) - (image-path (plist-get params :image-path)) - (action-items (plist-get params :action-items)) - (sound-file (plist-get params :sound-file)) - (sound-name (plist-get params :sound-name)) - (suppress-sound (plist-get params :suppress-sound)) - (resident (plist-get params :resident)) - (transient (plist-get params :transient)) - (x (plist-get params :x)) - (y (plist-get params :y)) - id) - ;; Build hints array - (when urgency - (add-to-list 'hints `(:dict-entry - "urgency" - (:variant :byte ,(pcase urgency - (`low 0) - (`critical 2) - (_ 1)))) t)) - (when category - (add-to-list 'hints `(:dict-entry - "category" - (:variant :string ,category)) t)) - (when desktop-entry - (add-to-list 'hints `(:dict-entry - "desktop-entry" - (:variant :string ,desktop-entry)) t)) - (when image-data - (add-to-list 'hints `(:dict-entry - "image-data" - (:variant :struct ,image-data)) t)) - (when image-path - (add-to-list 'hints `(:dict-entry - "image-path" - (:variant :string ,image-path)) t)) - (when action-items - (add-to-list 'hints `(:dict-entry - "action-items" - (:variant :boolean ,action-items)) t)) - (when sound-file - (add-to-list 'hints `(:dict-entry - "sound-file" - (:variant :string ,sound-file)) t)) - (when sound-name - (add-to-list 'hints `(:dict-entry - "sound-name" - (:variant :string ,sound-name)) t)) - (when suppress-sound - (add-to-list 'hints `(:dict-entry - "suppress-sound" - (:variant :boolean ,suppress-sound)) t)) - (when resident - (add-to-list 'hints `(:dict-entry - "resident" - (:variant :boolean ,resident)) t)) - (when transient - (add-to-list 'hints `(:dict-entry - "transient" - (:variant :boolean ,transient)) t)) - (when x - (add-to-list 'hints `(:dict-entry "x" (:variant :int32 ,x)) t)) - (when y - (add-to-list 'hints `(:dict-entry "y" (:variant :int32 ,y)) t)) - - ;; Call Notify method. - (setq id - (dbus-call-method bus - notifications-service - notifications-path - notifications-interface - notifications-notify-method - :string (or app-name - notifications-application-name) - :uint32 (or replaces-id 0) - :string (if app-icon - (expand-file-name app-icon) - ;; If app-icon is nil because user - ;; requested it to be so, send the - ;; empty string - (if (plist-member params :app-icon) - "" - ;; Otherwise send the default icon path - notifications-application-icon)) - :string (or title "") - :string (or body "") - `(:array ,@actions) - (or hints '(:array :signature "{sv}")) - :int32 (or timeout -1))) - - ;; Register close/action callback function. We must also remember - ;; the daemon's unique name, because the daemon could have - ;; restarted. - (let ((on-action (plist-get params :on-action)) - (on-close (plist-get params :on-close)) - (unique-name (dbus-get-name-owner bus notifications-service))) - (when on-action - (add-to-list 'notifications-on-action-map - (list (list bus unique-name id) on-action)) - (unless notifications-on-action-object - (setq notifications-on-action-object - (dbus-register-signal - bus - nil - notifications-path - notifications-interface - notifications-action-signal - 'notifications-on-action-signal)))) - - (when on-close - (add-to-list 'notifications-on-close-map - (list (list bus unique-name id) on-close)) - (unless notifications-on-close-object - (setq notifications-on-close-object - (dbus-register-signal - bus - nil - notifications-path - notifications-interface - notifications-closed-signal - 'notifications-on-closed-signal))))) - - ;; Return notification id - id)) + (with-demoted-errors + (let ((bus (or (plist-get params :bus) :session)) + (title (plist-get params :title)) + (body (plist-get params :body)) + (app-name (plist-get params :app-name)) + (replaces-id (plist-get params :replaces-id)) + (app-icon (plist-get params :app-icon)) + (actions (plist-get params :actions)) + (timeout (plist-get params :timeout)) + ;; Hints + (hints '()) + (urgency (plist-get params :urgency)) + (category (plist-get params :category)) + (desktop-entry (plist-get params :desktop-entry)) + (image-data (plist-get params :image-data)) + (image-path (plist-get params :image-path)) + (action-items (plist-get params :action-items)) + (sound-file (plist-get params :sound-file)) + (sound-name (plist-get params :sound-name)) + (suppress-sound (plist-get params :suppress-sound)) + (resident (plist-get params :resident)) + (transient (plist-get params :transient)) + (x (plist-get params :x)) + (y (plist-get params :y)) + id) + ;; Build hints array + (when urgency + (add-to-list 'hints `(:dict-entry + "urgency" + (:variant :byte ,(pcase urgency + (`low 0) + (`critical 2) + (_ 1)))) t)) + (when category + (add-to-list 'hints `(:dict-entry + "category" + (:variant :string ,category)) t)) + (when desktop-entry + (add-to-list 'hints `(:dict-entry + "desktop-entry" + (:variant :string ,desktop-entry)) t)) + (when image-data + (add-to-list 'hints `(:dict-entry + "image-data" + (:variant :struct ,image-data)) t)) + (when image-path + (add-to-list 'hints `(:dict-entry + "image-path" + (:variant :string ,image-path)) t)) + (when action-items + (add-to-list 'hints `(:dict-entry + "action-items" + (:variant :boolean ,action-items)) t)) + (when sound-file + (add-to-list 'hints `(:dict-entry + "sound-file" + (:variant :string ,sound-file)) t)) + (when sound-name + (add-to-list 'hints `(:dict-entry + "sound-name" + (:variant :string ,sound-name)) t)) + (when suppress-sound + (add-to-list 'hints `(:dict-entry + "suppress-sound" + (:variant :boolean ,suppress-sound)) t)) + (when resident + (add-to-list 'hints `(:dict-entry + "resident" + (:variant :boolean ,resident)) t)) + (when transient + (add-to-list 'hints `(:dict-entry + "transient" + (:variant :boolean ,transient)) t)) + (when x + (add-to-list 'hints `(:dict-entry "x" (:variant :int32 ,x)) t)) + (when y + (add-to-list 'hints `(:dict-entry "y" (:variant :int32 ,y)) t)) + + ;; Call Notify method. + (setq id + (dbus-call-method bus + notifications-service + notifications-path + notifications-interface + notifications-notify-method + :string (or app-name + notifications-application-name) + :uint32 (or replaces-id 0) + :string (if app-icon + (expand-file-name app-icon) + ;; If app-icon is nil because user + ;; requested it to be so, send the + ;; empty string + (if (plist-member params :app-icon) + "" + ;; Otherwise send the + ;; default icon path + notifications-application-icon)) + :string (or title "") + :string (or body "") + `(:array ,@actions) + (or hints '(:array :signature "{sv}")) + :int32 (or timeout -1))) + + ;; Register close/action callback function. We must also + ;; remember the daemon's unique name, because the daemon could + ;; have restarted. + (let ((on-action (plist-get params :on-action)) + (on-close (plist-get params :on-close)) + (unique-name (dbus-get-name-owner bus notifications-service))) + (when on-action + (add-to-list 'notifications-on-action-map + (list (list bus unique-name id) on-action)) + (unless notifications-on-action-object + (setq notifications-on-action-object + (dbus-register-signal + bus + nil + notifications-path + notifications-interface + notifications-action-signal + 'notifications-on-action-signal)))) + + (when on-close + (add-to-list 'notifications-on-close-map + (list (list bus unique-name id) on-close)) + (unless notifications-on-close-object + (setq notifications-on-close-object + (dbus-register-signal + bus + nil + notifications-path + notifications-interface + notifications-closed-signal + 'notifications-on-closed-signal))))) + + ;; Return notification id + id))) (defun notifications-close-notification (id &optional bus) "Close a notification with identifier ID. @@ -349,7 +354,7 @@ BUS can be a string denoting a D-Bus connection, the default is `:session'." (defvar dbus-debug) ; used in the macroexpansion of dbus-ignore-errors (defun notifications-get-capabilities (&optional bus) - "Return the capabilities of the notification server, a list of strings. + "Return the capabilities of the notification server, a list of symbols. BUS can be a string denoting a D-Bus connection, the default is `:session'. The following capabilities can be expected: @@ -371,12 +376,34 @@ The following capabilities can be expected: Further vendor-specific caps start with `:x-vendor', like `:x-gnome-foo-cap'." (dbus-ignore-errors - (mapcar - (lambda (x) (intern (concat ":" x))) + (mapcar + (lambda (x) (intern (concat ":" x))) + (dbus-call-method (or bus :session) + notifications-service + notifications-path + notifications-interface + notifications-get-capabilities-method)))) + +(defun notifications-get-server-information (&optional bus) + "Return information on the notification server, a list of strings. +BUS can be a string denoting a D-Bus connection, the default is `:session'. +The returned list is (NAME VENDOR VERSION SPEC-VERSION). + + NAME The product name of the server. + VENDOR The vendor name. For example, \"KDE\", \"GNOME\". + VERSION The server's version number. + SPEC-VERSION The specification version the server is compliant with. + +If SPEC_VERSION is missing, the server supports a specification +prior to \"1.0\". + +See `notifications-specification-version' for the specification +version this library is compliant with." + (dbus-ignore-errors (dbus-call-method (or bus :session) notifications-service notifications-path notifications-interface - notifications-get-capabilities-method)))) + notifications-get-server-information-method))) (provide 'notifications) diff --git a/lisp/novice.el b/lisp/novice.el index 7966a89b995..92ba3d5277b 100644 --- a/lisp/novice.el +++ b/lisp/novice.el @@ -50,7 +50,6 @@ If nil, the feature is disabled, i.e., all commands work normally.") (unless keys (setq keys (this-command-keys))) (let (char) (save-window-excursion - (help-setup-xref (list 'disabled-command-function cmd keys) nil) (with-output-to-temp-buffer "*Disabled Command*" ;; (help-buffer) (if (or (eq (aref keys 0) (if (stringp keys) diff --git a/lisp/longlines.el b/lisp/obsolete/longlines.el index 833cede360b..b68a191d55a 100644 --- a/lisp/longlines.el +++ b/lisp/obsolete/longlines.el @@ -6,6 +6,7 @@ ;; Alex Schroeder <alex@gnu.org> ;; Chong Yidong <cyd@stupidchicken.com> ;; Maintainer: Chong Yidong <cyd@stupidchicken.com> +;; Obsolete-since: 24.4 ;; Keywords: convenience, wp ;; This file is part of GNU Emacs. @@ -278,7 +279,7 @@ end of the buffer." If wrapping is performed, point remains on the line. If the line does not need to be wrapped, move point to the next line and return t." (if (longlines-set-breakpoint) - (progn (insert-before-markers ?\n) + (progn (insert-before-markers-and-inherit ?\n) (backward-char 1) (delete-char -1) (forward-char 1) @@ -384,8 +385,12 @@ compatibility with `format-alist', and is ignored." (mod (buffer-modified-p))) (goto-char (min beg end)) (while (search-forward "\n" reg-max t) - (unless (get-text-property (match-beginning 0) 'hard) - (replace-match " "))) + (let ((pos (match-beginning 0))) + (unless (get-text-property pos 'hard) + (goto-char (1+ pos)) + (insert-and-inherit " ") + (delete-region pos (1+ pos)) + (remove-text-properties pos (1+ pos) 'hard)))) (set-buffer-modified-p mod) end))) diff --git a/lisp/terminal.el b/lisp/obsolete/terminal.el index e7903c65061..7f65d336899 100644 --- a/lisp/terminal.el +++ b/lisp/obsolete/terminal.el @@ -5,6 +5,7 @@ ;; Author: Richard Mlynarik <mly@eddie.mit.edu> ;; Maintainer: FSF +;; Obsolete-since: 24.4 ;; Keywords: comm, terminals ;; This file is part of GNU Emacs. @@ -24,14 +25,14 @@ ;;; Commentary: -;;; This file has been censored by the Communications Decency Act. -;;; That law was passed under the guise of a ban on pornography, but -;;; it bans far more than that. This file did not contain pornography, -;;; but it was censored nonetheless. +;; This file has been censored by the Communications Decency Act. +;; That law was passed under the guise of a ban on pornography, but +;; it bans far more than that. This file did not contain pornography, +;; but it was censored nonetheless. -;;; For information on US government censorship of the Internet, and -;;; what you can do to bring back freedom of the press, see the web -;;; site http://www.vtw.org/ +;; For information on US government censorship of the Internet, and +;; what you can do to bring back freedom of the press, see the web +;; site http://www.vtw.org/ ;;; Code: diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog index b6d196ecf54..56a76c7d680 100644 --- a/lisp/org/ChangeLog +++ b/lisp/org/ChangeLog @@ -37,7 +37,7 @@ * ob-eval.el (org-babel-shell-command-on-region): Use `executable-find' for local `shell-file-name'. -2013-01-08 Achim Gratz <Stromeko@Stromeko.de> +2013-01-09 Achim Gratz <Stromeko@Stromeko.de> * org-faces.el: Define face alias mode-line for XEmacs (it's called modeline there). @@ -48,21 +48,20 @@ byte-compiling. * org.el (org-get-location, org-switch-to-buffer-other-window): - Use the wrapper `org-no-popups´ to let-bind the correct variables + Use the wrapper `org-no-popups' to let-bind the correct variables for suppression of popup windows. - * org-compat.el (user-error): Defalias to `error´ for Emacsen that + * org-compat.el (user-error): Defalias to `error' for Emacsen that don't have it. * org-agenda.el (org-agenda-write): Use org-called-interactively-p instead of called-interactively-p. * org.el (org-find-invisible-foreground): Do not use the value of - variables `default-frame-alist´, `initial-frame-alist´ and - `window-system-default-frame-alist´ when their symbol is not - bound. + variables `default-frame-alist', `initial-frame-alist' and + `window-system-default-frame-alist' when their symbol is not bound. -2013-01-08 Bastien Guerry <bzg@gnu.org> +2013-01-09 Bastien Guerry <bzg@gnu.org> * org-src.el (org-edit-src-code): Fix bug when trying to edit a table.el table. @@ -71,8 +70,7 @@ whole function. * org.el (org-entry-get): Speed up by let-binding some variables - only if needed. Also fix a bug: consider an empty drawer as no - drawer. + only if needed. Also fix a bug: consider an empty drawer as no drawer. * org-agenda.el (org-search-view, org-agenda-get-todos) (org-agenda-get-timestamps, org-agenda-get-sexps) @@ -98,8 +96,8 @@ * org-clock.el (org-clock-in): Use the renamed defun. - * org-icalendar.el (org-icalendar-print-entries): Refresh the - 'org-appt-warntime property. + * org-icalendar.el (org-icalendar-print-entries): + Refresh the 'org-appt-warntime property. (org-icalendar-print-entries): * org-agenda.el (org-agenda-get-timestamps) (org-agenda-get-sexps, org-agenda-get-deadlines) @@ -110,28 +108,24 @@ * org-agenda.el (org-agenda-format-item): Do not use `org-get-effort' to get the effort text property. - (org-agenda-get-sexps): Use `org-back-to-heading' when setting the - tags. + (org-agenda-get-sexps): Use `org-back-to-heading' when setting tags. * org-clock.el (org-clock-in): Refresh effort properties. * org.el (org-refresh-effort-properties): New defun. (org-get-effort): Delete. (org-set-effort): - (org-property-next-allowed-value): Set the 'org-effort text - property. + (org-property-next-allowed-value): Set the 'org-effort text property. (org-agenda-prepare-buffers): Refresh effort properties. * org.el (org-read-date): Let-bind `mouse-autoselect-window' to - nil so that the mouse doesn't jump when the option is set to t - globally. + nil so that the mouse doesn't jump when the option is set to t globally. * org-agenda.el (org-agenda-dim-blocked-tasks): Default to nil. (org-agenda-dim-blocked-tasks): Make interactive and allow an optional parameter 'invisible to hide blocked tasks instead of just dimming them. - (org-agenda-mode-map): Bind `org-agenda-dim-blocked-tasks' to - "#". + (org-agenda-mode-map): Bind `org-agenda-dim-blocked-tasks' to "#". * org-agenda.el (org-agenda-finalize): Don't try to align tags when there are no tags. Only try to draw the habit consistency @@ -143,17 +137,16 @@ * org.el (org-get-priority): Save match data even when using `org-get-priority-function'. - * org-mobile.el (org-mobile-create-index-file): Possibly normalize - `org-todo-keywords'. + * org-mobile.el (org-mobile-create-index-file): + Possibly normalize `org-todo-keywords'. - * org-mobile.el (org-mobile-push): Use the correct agenda buffer - names. + * org-mobile.el (org-mobile-push): Use the correct agenda buffer names. * org.el (org-store-link): Use `org-id-link-to-org-use-id' instead of the obsolete variable name. - * org.el (org-fontify-meta-lines-and-blocks-1): Fix bug when - fontifying keywords with no value. + * org.el (org-fontify-meta-lines-and-blocks-1): + Fix bug when fontifying keywords with no value. * org.el (org-goto-auto-isearch): Enhance docstring. (org-goto-map): Make a defun, so that the customized value of @@ -165,8 +158,8 @@ * org-exp.el (org-export-as-org): Remove useless argument. * org-docbook.el (org-export-as-docbook-batch) - (org-export-region-as-docbook, org-export-as-docbook-pdf): Fix - the number of arguments. + (org-export-region-as-docbook, org-export-as-docbook-pdf): + Fix the number of arguments. (org-export-as-docbook): Remove useless argument. * org.el (org-speed-commands-default): Use ":" instead of ";" for @@ -180,8 +173,7 @@ * org-latex.el (org-export-as-latex): Fix typo in docstring. - * org-list.el (org-cycle-include-plain-lists): Docstring - enhancement. + * org-list.el (org-cycle-include-plain-lists): Docstring enhancement. * org.el (org-fontify-meta-lines-and-blocks-1): Fix fontification bug when fontifying a keyword with no associated value. @@ -214,15 +206,14 @@ * org.el (org-offer-links-in-entry): Do not open the link directly through `org-open-link-from-string', only offer to select a link - and return a cons with the link (as a string) and the end of - entry. + and return a cons with the link (as a string) and the end of entry. (org-open-at-point): Use `org-offer-links-in-entry' correctly. - * org.el (org-cycle-internal-local): Fix bug: allow headings with - leading blank characters. + * org.el (org-cycle-internal-local): + Fix bug: allow headings with leading blank characters. - * org-clock.el (org-clock-persist): Docstring fix: document the - 'history value. + * org-clock.el (org-clock-persist): + Docstring fix: document the 'history value. * org.el (org-insert-link): Fix bug when inserting links to headlines containing the ">" character. @@ -233,8 +224,8 @@ for Emacs 22, where `delete-directory' does not support recursive deletion. - * org-odt.el (org-odt-cleanup-xml-buffers): Use the new - compatibility function. + * org-odt.el (org-odt-cleanup-xml-buffers): + Use the new compatibility function. * org.el (org-table-map-tables): Fix allowed blocks. @@ -259,8 +250,8 @@ (org-edit-special): Fix bug about editing special blocks "example" and "verbatim". - * org.el (org-delete-backward-char, org-delete-char): Save match - data, `delete-backward-char' and `delete-char' don't. + * org.el (org-delete-backward-char, org-delete-char): + Save match data, `delete-backward-char' and `delete-char' don't. * org.el (org-enable-table-editor, org-insert-heading) (org-remove-timestamp-with-keyword, org-self-insert-command): @@ -268,8 +259,8 @@ (orgtbl-self-insert-command): * org-latex.el (org-export-latex-subcontent): * org-clock.el (org-clocktable-write-default): - * org-ascii.el (org-export-ascii-preprocess): Use - `delete-backward-char' instead of `backward-delete-char'. + * org-ascii.el (org-export-ascii-preprocess): + Use `delete-backward-char' instead of `backward-delete-char'. * org.el (org-todo): Ignore the comment string when changing the TODO state of a headline. @@ -283,8 +274,7 @@ (org-export-as-html-and-open, org-export-as-html-batch) (org-export-region-as-html): Don't use obsolete arg. - * org-ascii.el (org-export-as-ascii): Delete obsolete arg - `hidden'. + * org-ascii.el (org-export-as-ascii): Delete obsolete arg `hidden'. (org-export-as-ascii-to-buffer): Don't use obsolete arg. * org.el (org-in-fixed-width-region-p): Save match data. @@ -316,11 +306,10 @@ * org-agenda.el (org-agenda-skip): Only check if point is inside a code block, not at a code block. - * org.el (org-in-fixed-width-region-p): Rewrite using - org-element.el. + * org.el (org-in-fixed-width-region-p): + Rewrite using org-element.el. - * org.el (org-fill-paragraph): Fill correctly in source code - block. + * org.el (org-fill-paragraph): Fill correctly in source code block. * org.el (org-in-fixed-width-region-p): New function. (org-edit-special): Fix bug: make sure to DTRT in every @@ -339,7 +328,7 @@ * org-src.el (org-edit-src-code): Fix bug triggered by the sexp (copy-marker nil) on Emacs <24.1. -2013-01-08 Dmitry Antipov <dmantipov@yandex.ru> +2013-01-09 Dmitry Antipov <dmantipov@yandex.ru> * org-agenda.el (org-agenda-get-restriction-and-command): * org-capture.el (org-capture-place-template): @@ -348,17 +337,17 @@ * org-table.el (org-table-convert-region): * org.el (org-update-statistics-cookies): Use `point-marker'. -2013-01-08 Eric Schulte <eric.schulte@gmx.com> +2013-01-09 Eric Schulte <eric.schulte@gmx.com> * org-exp.el (org-export-string): Pass the dir option on through to any subsequent export functions. -2013-01-08 Henning Weiss <hdweiss@gmail.com> (tiny change) +2013-01-09 Henning Weiss <hdweiss@gmail.com> (tiny change) * org-mobile.el (org-mobile-sumo-agenda-command): Remove match description from block agendas when they have a title. -2013-01-08 Jambunathan K <kjambunathan@gmail.com> +2013-01-09 Jambunathan K <kjambunathan@gmail.com> * org-odt.el (org-export-as-odt-batch): Init `org-odt-zip-dir'. Fix Emacs Bug#13254. @@ -366,20 +355,11 @@ * org-odt.el (org-odt-format-org-link): Add check for presence of description in headline links. -2013-01-08 Michael Albinus <michael.albinus@gmx.de> - - * ob.el (org-babel-temp-file): Fix setting of - `temporary-file-directory' on remote hosts. - - * ob-eval.el (org-babel-shell-command-on-region): Use - `process-file' instead of `call-process-region'. The latter one - does not work on remote hosts. - -2013-01-08 Michael Gauland <mike_gauland@stanfordalumni.org> (tiny change) +2013-01-09 Michael Gauland <mike_gauland@stanfordalumni.org> (tiny change) * org-src.el: Create a marker to pass to copy-marker. -2013-01-08 Nicolas Goaziou <n.goaziou@gmail.com> +2013-01-09 Nicolas Goaziou <n.goaziou@gmail.com> * org.el (org-setup-filling): Set `auto-fill-inhibit-regexp' to nil because `org-adaptive-fill-function' already determines which @@ -388,15 +368,23 @@ * org.el (org-fill-paragraph): Small refactoring. * org-element.el (org-element--parse-elements) - (org-element-at-point): Fix parsing of a list in a block in a - list. + (org-element-at-point): Fix parsing of a list in a block in a list. + +2013-01-09 Sebastien Vauban <wxhgmqzgwmuf-geNee64TY+gS+FvcfC7Uqw@public.gmane.org> + + * org.el (org-copy-subtree, org-paste-subtree): + Fix whitespace handling when copying/pasting a subtree. -2013-01-08 Sebastien Vauban <wxhgmqzgwmuf-geNee64TY+gS+FvcfC7Uqw@public.gmane.org> +2012-12-20 Michael Albinus <michael.albinus@gmx.de> + + * ob.el (org-babel-temp-file): Fix setting of + `temporary-file-directory' on remote hosts. - * org.el (org-copy-subtree, org-paste-subtree): Fix whitespace - handling when copying/pasting a subtree. + * ob-eval.el (org-babel-shell-command-on-region): Use + `process-file' instead of `call-process-region'. The latter one + does not work on remote hosts. -2012-12-12 Bastien Guerry <bzg@gnu.org> +2012-12-13 Bastien Guerry <bzg@gnu.org> * org-latex.el (org-export-latex-links): Escape raw path when exporting links to files. @@ -422,8 +410,8 @@ * org-timer.el (org-timer-stop): Add message. - * org-agenda.el (org-agenda-schedule, org-agenda-deadline): Fix - redundant messages. + * org-agenda.el (org-agenda-schedule, org-agenda-deadline): + Fix redundant messages. * org-agenda.el (org-agenda-finalize): Fix clock highlighting. @@ -431,22 +419,22 @@ * org-install.el: Enhance warning. -2012-12-12 Erik Hetzner <egh@e6h.org> (tiny change) +2012-12-13 Erik Hetzner <egh@e6h.org> (tiny change) * org.el (org-log-into-drawer): Honor the nil value for the :LOG_INTO_DRAWER: property. -2012-12-12 Le Wang <l26wang@gmail.com> (tiny change) +2012-12-13 Le Wang <l26wang@gmail.com> (tiny change) * org-src.el (org-edit-src-exit): Fix editing source section with blank lines. -2012-12-12 Le Wang <le.wang@agworld.com.au> +2012-12-13 Le Wang <le.wang@agworld.com.au> * org-src.el (org-edit-src-code): Use marker with insertion type t to track end and remove hack requiring delete from beg to (1- end). -2012-12-12 Nicolas Goaziou <n.goaziou@gmail.com> +2012-12-13 Nicolas Goaziou <n.goaziou@gmail.com> * org-element.el (org-element-context): When point is between two objects, be sure to return the second one. @@ -462,7 +450,7 @@ delegate motion to `end-of-line' instead of `move-end-of-line' in order to stay on the current line. -2012-12-12 Rafael Laboissiere <rafael@laboissiere.net> (tiny change) +2012-12-13 Rafael Laboissiere <rafael@laboissiere.net> (tiny change) * org-bibtex.el: In the documentation section of the file, fix the broken URL to Andrew Roberts' document on BibTeX entries. @@ -475,14 +463,18 @@ commented lines in the Remember temporary buffer with the appropriate characters. -2012-12-12 Toby S. Cubitt <tsc25@cantab.net> +2012-12-13 Toby S. Cubitt <tsc25@cantab.net> * org.el (org-beginning-of-line): Check `visual-line-mode' instead - of `line-visual-mode' to determine whether to move by visual - lines. + of `line-visual-mode' to determine whether to move by visual lines. * org.el (org-kill-line): Use the `org-bound-and-true-p' macro. +2012-12-04 Chong Yidong <cyd@gnu.org> + + * org-bibtex.el (org-bibtex-ask): Use visual-line-mode instead of + longlines-mode. + 2012-10-26 Achim Gratz <stromeko@stromeko.de> * ob-ditaa.el: Needs to (require 'org-compat) for diff --git a/lisp/org/org-bibtex.el b/lisp/org/org-bibtex.el index 6827bdacb5e..36530a80c05 100644 --- a/lisp/org/org-bibtex.el +++ b/lisp/org/org-bibtex.el @@ -120,7 +120,6 @@ (declare-function bibtex-generate-autokey "bibtex" ()) (declare-function bibtex-parse-entry "bibtex" (&optional content)) (declare-function bibtex-url "bibtex" (&optional pos no-browse)) -(declare-function longlines-mode "longlines" (&optional arg)) (declare-function org-babel-trim "ob" (string &optional regexp)) @@ -381,7 +380,7 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords' is t." (buf-name (format "*Bibtex Help %s*" name))) (with-output-to-temp-buffer buf-name (princ (cdr (assoc field org-bibtex-fields)))) - (with-current-buffer buf-name (longlines-mode t)) + (with-current-buffer buf-name (visual-line-mode 1)) (org-fit-window-to-buffer (get-buffer-window buf-name)) ((lambda (result) (when (> (length result) 0) result)) (read-from-minibuffer (format "%s: " name)))))) diff --git a/lisp/paren.el b/lisp/paren.el index b87c8bde89a..a9d3be60622 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -243,27 +243,26 @@ matching parenthesis is highlighted in `show-paren-style' after ;; ;; Turn on highlighting for the matching paren, if found. ;; If it's an unmatched paren, turn off any such highlighting. - (unless (integerp pos) - (delete-overlay show-paren-overlay)) - (let ((to (if (or (eq show-paren-style 'expression) - (and (eq show-paren-style 'mixed) - (not (pos-visible-in-window-p pos)))) - (point) - pos)) - (from (if (or (eq show-paren-style 'expression) + (if (not (integerp pos)) + (when show-paren-overlay (delete-overlay show-paren-overlay)) + (let ((to (if (or (eq show-paren-style 'expression) (and (eq show-paren-style 'mixed) (not (pos-visible-in-window-p pos)))) - pos - (save-excursion - (goto-char pos) - (- (point) dir))))) - (if show-paren-overlay - (move-overlay show-paren-overlay from to (current-buffer)) - (setq show-paren-overlay (make-overlay from to nil t)))) - ;; - ;; Always set the overlay face, since it varies. - (overlay-put show-paren-overlay 'priority show-paren-priority) - (overlay-put show-paren-overlay 'face face))) + (point) + pos)) + (from (if (or (eq show-paren-style 'expression) + (and (eq show-paren-style 'mixed) + (not (pos-visible-in-window-p pos)))) + pos + (save-excursion + (goto-char pos) + (- (point) dir))))) + (if show-paren-overlay + (move-overlay show-paren-overlay from to (current-buffer)) + (setq show-paren-overlay (make-overlay from to nil t)))) + ;; Always set the overlay face, since it varies. + (overlay-put show-paren-overlay 'priority show-paren-priority) + (overlay-put show-paren-overlay 'face face)))) ;; show-paren-mode is nil in this buffer. (and show-paren-overlay (delete-overlay show-paren-overlay)) diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index 8d4fb927a69..eefe1e22599 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el @@ -175,7 +175,7 @@ static unsigned char gamegrid_bits[] = { (defun gamegrid-make-mono-tty-face () (let ((face (make-face 'gamegrid-mono-tty-face))) - (set-face-inverse-video-p face t) + (set-face-inverse-video face t) face)) (defun gamegrid-make-color-tty-face (color) @@ -560,7 +560,7 @@ FILE is created there." (goto-char (point-min)) (search-forward (concat (int-to-string score) " " (user-login-name) " " - marker-string)) + marker-string) nil t) (beginning-of-line))))) (defun gamegrid-add-score-insecure (file score &optional directory) diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el index 5cd39d535c8..3daf9d5f784 100644 --- a/lisp/play/gametree.el +++ b/lisp/play/gametree.el @@ -435,7 +435,7 @@ only work of Black's moves are explicitly numbered, for instance gametree-half-ply-regexp)) limit)) (goto-char (match-beginning 0)))) (gametree-transpose-following-leaves) - (let* ((pt (set-marker (make-marker) (point))) + (let* ((pt (point-marker)) (plys (gametree-current-branch-ply)) (depth (gametree-current-branch-depth)) (old-depth depth)) diff --git a/lisp/printing.el b/lisp/printing.el index 9d7efad83b4..bf50aa8f679 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -1383,6 +1383,10 @@ Used by `pr-menu-bind' and `pr-update-menus'.") (eval-when-compile (require 'easymenu)) ; to avoid compilation gripes + (declare-function easy-menu-add-item "easymenu" + (map path item &optional before)) + (declare-function easy-menu-remove-item "easymenu" (map path name)) + (eval-and-compile (defun pr-global-menubar (pr-menu-spec) (require 'easymenu) @@ -1796,7 +1800,7 @@ The alist element has the form: Where: SYMBOL It's a symbol to identify a text printer. It's for - `pr-txt-name' variable setting and for menu selection. + setting option `pr-txt-name' and for menu selection. Examples: 'prt_06a 'my_printer @@ -1947,7 +1951,7 @@ The alist element has the form: Where: SYMBOL It's a symbol to identify a PostScript printer. It's for - `pr-ps-name' variable setting and for menu selection. + setting option `pr-ps-name' and for menu selection. Examples: 'prt_06a 'my_printer @@ -2931,9 +2935,9 @@ INHERITS Specify the inheritance for SYMBOL group. It's a symbol name The example above has two setting groups: no-duplex and no-duplex-and-landscape. When setting no-duplex is activated - through `inherits-from:' (see `pr-ps-utility', `pr-mode-alist' - and `pr-ps-printer-alist'), the variables pr-file-duplex and - pr-file-tumble are both set to nil. + through `inherits-from:' (see option `pr-ps-utility', + `pr-mode-alist' and `pr-ps-printer-alist'), the variables + pr-file-duplex and pr-file-tumble are both set to nil. Now when setting no-duplex-and-landscape is activated through `inherits-from:', the variable pr-file-landscape is set to nil @@ -6079,6 +6083,8 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order." (and pr-i-region ; let region activated (pr-keep-region-active))) +(declare-function widget-field-action "wid-edit" (widget &optional _event)) +(declare-function widget-value-set "wid-edit" (widget value)) (defun pr-insert-section-1 () ;; 1. Print: diff --git a/lisp/profiler.el b/lisp/profiler.el index 04a171a6cb2..73b751c3fcd 100644 --- a/lisp/profiler.el +++ b/lisp/profiler.el @@ -200,11 +200,18 @@ function name of a function itself." (goto-char (point-min)) (read (current-buffer)))) +(defun profiler-running-p (&optional mode) + "Return non-nil if the profiler is running. +Optional argument MODE means only check for the specified mode (cpu or mem)." + (cond ((eq mode 'cpu) (and (fboundp 'profiler-cpu-running-p) + (profiler-cpu-running-p))) + ((eq mode 'mem) (profiler-memory-running-p)) + (t (or (profiler-running-p 'cpu) + (profiler-running-p 'mem))))) + (defun profiler-cpu-profile () "Return CPU profile." - (when (and (fboundp 'profiler-cpu-running-p) - (fboundp 'profiler-cpu-log) - (profiler-cpu-running-p)) + (when (profiler-running-p 'cpu) (profiler-make-profile :type 'cpu :timestamp (current-time) @@ -404,7 +411,6 @@ RET: expand or collapse")) (defvar profiler-report-mode-map (let ((map (make-sparse-keymap))) - ;; FIXME: Add menu. (define-key map "n" 'profiler-report-next-entry) (define-key map "p" 'profiler-report-previous-entry) ;; I find it annoying more than helpful to not be able to navigate @@ -424,8 +430,48 @@ RET: expand or collapse")) (define-key map "D" 'profiler-report-descending-sort) (define-key map "=" 'profiler-report-compare-profile) (define-key map (kbd "C-x C-w") 'profiler-report-write-profile) - (define-key map "q" 'quit-window) - map)) + (easy-menu-define profiler-report-menu map "Menu for Profiler Report mode." + '("Profiler" + ["Next Entry" profiler-report-next-entry :active t + :help "Move to next entry"] + ["Previous Entry" profiler-report-previous-entry :active t + :help "Move to previous entry"] + "--" + ["Toggle Entry" profiler-report-toggle-entry + :active (profiler-report-calltree-at-point) + :help "Expand or collapse the current entry"] + ["Find Entry" profiler-report-find-entry + ;; FIXME should deactivate if not on a known function. + :active (profiler-report-calltree-at-point) + :help "Find the definition of the current entry"] + ["Describe Entry" profiler-report-describe-entry + :active (profiler-report-calltree-at-point) + :help "Show the documentation of the current entry"] + "--" + ["Show Calltree" profiler-report-render-calltree + :active profiler-report-reversed + :help "Show calltree view"] + ["Show Reversed Calltree" profiler-report-render-reversed-calltree + :active (not profiler-report-reversed) + :help "Show reversed calltree view"] + ["Sort Ascending" profiler-report-ascending-sort + :active (not (eq profiler-report-order 'ascending)) + :help "Sort calltree view in ascending order"] + ["Sort Descending" profiler-report-descending-sort + :active (not (eq profiler-report-order 'descending)) + :help "Sort calltree view in descending order"] + "--" + ["Compare Profile..." profiler-report-compare-profile :active t + :help "Compare current profile with another"] + ["Write Profile..." profiler-report-write-profile :active t + :help "Write current profile to a file"] + "--" + ["Stop Profiler" profiler-stop :active (profiler-running-p) + :help "Stop profiling"] + ["New Report" profiler-report :active (profiler-running-p) + :help "Make a new report"])) + map) + "Keymap for `profiler-report-mode'.") (defun profiler-report-make-buffer-name (profile) (format "*%s-Profiler-Report %s*" @@ -529,11 +575,15 @@ otherwise collapse." (defun profiler-report-find-entry (&optional event) "Find entry at point." (interactive (list last-nonmenu-event)) - (if event (posn-set-point (event-end event))) - (let ((tree (profiler-report-calltree-at-point))) - (when tree - (let ((entry (profiler-calltree-entry tree))) - (find-function entry))))) + (with-current-buffer + (if event (window-buffer (posn-window (event-start event))) + (current-buffer)) + (and event (setq event (event-end event)) + (posn-set-point event)) + (let ((tree (profiler-report-calltree-at-point))) + (when tree + (let ((entry (profiler-calltree-entry tree))) + (find-function entry)))))) (defun profiler-report-describe-entry () "Describe entry at point." diff --git a/lisp/progmodes/autoconf.el b/lisp/progmodes/autoconf.el index 7a24192cee0..8a99ad6e1b3 100644 --- a/lisp/progmodes/autoconf.el +++ b/lisp/progmodes/autoconf.el @@ -78,22 +78,19 @@ searching backwards at another AC_... command." ;;;###autoload (define-derived-mode autoconf-mode prog-mode "Autoconf" "Major mode for editing Autoconf configure.ac files." - (set (make-local-variable 'parens-require-spaces) nil) ; for M4 arg lists - (set (make-local-variable 'defun-prompt-regexp) - "^[ \t]*A[CM]_\\(\\sw\\|\\s_\\)+") - (set (make-local-variable 'comment-start) "dnl ") - (set (make-local-variable 'comment-start-skip) - "\\(?:\\(\\W\\|\\`\\)dnl\\|#\\) +") - (set (make-local-variable 'syntax-propertize-function) - (syntax-propertize-rules ("\\<dnl\\>" (0 "<")))) - (set (make-local-variable 'font-lock-defaults) - `(autoconf-font-lock-keywords nil nil (("_" . "w")))) - (set (make-local-variable 'imenu-generic-expression) - autoconf-imenu-generic-expression) - (set (make-local-variable 'imenu-syntax-alist) '(("_" . "w"))) - (set (make-local-variable 'indent-line-function) #'indent-relative) - (set (make-local-variable 'add-log-current-defun-function) - #'autoconf-current-defun-function)) + (setq-local parens-require-spaces nil) ; for M4 arg lists + (setq-local defun-prompt-regexp "^[ \t]*A[CM]_\\(\\sw\\|\\s_\\)+") + (setq-local comment-start "dnl ") + (setq-local comment-start-skip "\\(?:\\(\\W\\|\\`\\)dnl\\|#\\) +") + (setq-local syntax-propertize-function + (syntax-propertize-rules ("\\<dnl\\>" (0 "<")))) + (setq-local font-lock-defaults + `(autoconf-font-lock-keywords nil nil (("_" . "w")))) + (setq-local imenu-generic-expression autoconf-imenu-generic-expression) + (setq-local imenu-syntax-alist '(("_" . "w"))) + (setq-local indent-line-function #'indent-relative) + (setq-local add-log-current-defun-function + #'autoconf-current-defun-function)) (provide 'autoconf-mode) (provide 'autoconf) diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el index c4099c7c5d3..0711bc983e8 100644 --- a/lisp/progmodes/cc-awk.el +++ b/lisp/progmodes/cc-awk.el @@ -127,22 +127,29 @@ ;; escaped EOL. ;; REGEXPS FOR "HARMLESS" STRINGS/LINES. -(defconst c-awk-harmless-char-re "[^_#/\"\\\\\n\r]") -;; Matches any character but a _, #, /, ", \, or newline. N.B. _" starts a -;; localization string in gawk 3.1 (defconst c-awk-harmless-_ "_\\([^\"]\\|\\'\\)") ;; Matches an underline NOT followed by ". +(defconst c-awk-harmless-char-re "[^_#/\"{}();\\\\\n\r]") +;; Matches any character not significant in the state machine applying +;; syntax-table properties to "s and /s. (defconst c-awk-harmless-string*-re (concat "\\(" c-awk-harmless-char-re "\\|" c-awk-esc-pair-re "\\|" c-awk-harmless-_ "\\)*")) -;; Matches a (possibly empty) sequence of chars without unescaped /, ", \, -;; #, or newlines. +;; Matches a (possibly empty) sequence of characters insignificant in the +;; state machine applying syntax-table properties to "s and /s. (defconst c-awk-harmless-string*-here-re (concat "\\=" c-awk-harmless-string*-re)) -;; Matches the (possibly empty) sequence of chars without unescaped /, ", \, -;; at point. +;; Matches the (possibly empty) sequence of "insignificant" chars at point. + +(defconst c-awk-harmless-line-char-re "[^_#/\"\\\\\n\r]") +;; Matches any character but a _, #, /, ", \, or newline. N.B. _" starts a +;; localisation string in gawk 3.1 +(defconst c-awk-harmless-line-string*-re + (concat "\\(" c-awk-harmless-line-char-re "\\|" c-awk-esc-pair-re "\\|" c-awk-harmless-_ "\\)*")) +;; Matches a (possibly empty) sequence of chars without unescaped /, ", \, +;; #, or newlines. (defconst c-awk-harmless-line-re - (concat c-awk-harmless-string*-re - "\\(" c-awk-comment-without-nl "\\)?" c-awk-nl-or-eob)) + (concat c-awk-harmless-line-string*-re + "\\(" c-awk-comment-without-nl "\\)?" c-awk-nl-or-eob)) ;; Matches (the tail of) an AWK \"logical\" line not containing an unescaped ;; " or /. "logical" means "possibly containing escaped newlines". A comment ;; is matched as part of the line even if it contains a " or a /. The End of @@ -211,11 +218,11 @@ ;; division sign. (defconst c-awk-neutral-re ; "\\([{}@` \t]\\|\\+\\+\\|--\\|\\\\.\\)+") ; changed, 2003/6/7 - "\\([{}@` \t]\\|\\+\\+\\|--\\|\\\\.\\)") + "\\([}@` \t]\\|\\+\\+\\|--\\|\\\\\\(.\\|[\n\r]\\)\\)") ;; A "neutral" char(pair). Doesn't change the "state" of a subsequent /. -;; This is space/tab, braces, an auto-increment/decrement operator or an +;; This is space/tab, close brace, an auto-increment/decrement operator or an ;; escaped character. Or one of the (invalid) characters @ or `. But NOT an -;; end of line (even if escaped). +;; end of line (unless escaped). (defconst c-awk-neutrals*-re (concat "\\(" c-awk-neutral-re "\\)*")) ;; A (possibly empty) string of neutral characters (or character pairs). @@ -231,8 +238,8 @@ ;; will only work when there won't be a preceding " or / before the sought / ;; to foul things up. (defconst c-awk-non-arith-op-bra-re - "[[\(&=:!><,?;'~|]") -;; Matches an opening BRAcket, round or square, or any operator character + "[[\({&=:!><,?;'~|]") +;; Matches an opening BRAcket (of any sort), or any operator character ;; apart from +,-,/,*,%. For the purpose at hand (detecting a / which is a ;; regexp bracket) these arith ops are unnecessary and a pain, because of "++" ;; and "--". @@ -242,6 +249,16 @@ ;; bracket, in a context where an immediate / would be a division sign. This ;; will only work when there won't be a preceding " or / before the sought / ;; to foul things up. +(defconst c-awk-pre-exp-alphanum-kwd-re + (concat "\\(^\\|\\=\\|[^_\n\r]\\)\\<" + (regexp-opt '("print" "return" "case") t) + "\\>\\([^_\n\r]\\|$\\)")) +;; Matches all AWK keywords which can precede expressions (including +;; /regexp/). +(defconst c-awk-kwd-regexp-sign-re + (concat c-awk-pre-exp-alphanum-kwd-re c-awk-escaped-nls*-with-space* "/")) +;; Matches a piece of AWK buffer ending in <kwd> /, where <kwd> is a keyword +;; which can precede an expression. ;; REGEXPS USED FOR FINDING THE POSITION OF A "virtual semicolon" (defconst c-awk-_-harmless-nonws-char-re "[^#/\"\\\\\n\r \t]") @@ -721,9 +738,10 @@ (goto-char anchor) ;; Analyze the line to find out what the / is. (if (if anchor-state-/div - (not (search-forward-regexp c-awk-regexp-sign-re (1+ /point) t)) - (search-forward-regexp c-awk-div-sign-re (1+ /point) t)) - ;; A division sign. + (not (search-forward-regexp c-awk-regexp-sign-re (1+ /point) t)) + (and (not (search-forward-regexp c-awk-kwd-regexp-sign-re (1+ /point) t)) + (search-forward-regexp c-awk-div-sign-re (1+ /point) t))) + ;; A division sign. (progn (goto-char (1+ /point)) nil) ;; A regexp opener ;; Jump over the regexp innards, setting the match data. @@ -776,12 +794,20 @@ (< (point) lim)) (setq anchor (point)) (search-forward-regexp c-awk-harmless-string*-here-re nil t) - ;; We are now looking at either a " or a /. - ;; Do our thing on the string, regexp or division sign. + ;; We are now looking at either a " or a / or a brace/paren/semicolon. + ;; Do our thing on the string, regexp or divsion sign or update our state. (setq anchor-state-/div - (if (looking-at "_?\"") - (c-awk-syntax-tablify-string) - (c-awk-syntax-tablify-/ anchor anchor-state-/div)))) + (cond + ((looking-at "_?\"") + (c-awk-syntax-tablify-string)) + ((eq (char-after) ?/) + (c-awk-syntax-tablify-/ anchor anchor-state-/div)) + ((memq (char-after) '(?{ ?} ?\( ?\;)) + (forward-char) + nil) + (t ; ?\) + (forward-char) + t)))) nil)) ;; ACM, 2002/07/21: Thoughts: We need an AWK Mode after-change function to set diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 1eac45d06e0..d4e4d6de483 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -9842,6 +9842,18 @@ comment at the start of cc-engine.el for more info." ;; contains any class offset ))) + ;; CASE 5P: AWK pattern or function or continuation + ;; thereof. + ((c-major-mode-is 'awk-mode) + (setq placeholder (point)) + (c-add-stmt-syntax + (if (and (eq (c-beginning-of-statement-1) 'same) + (/= (point) placeholder)) + 'topmost-intro-cont + 'topmost-intro) + nil nil + containing-sexp paren-state)) + ;; CASE 5D: this could be a top-level initialization, a ;; member init list continuation, or a template argument ;; list continuation. @@ -10001,18 +10013,6 @@ comment at the start of cc-engine.el for more info." (goto-char (point-min))) (c-add-syntax 'objc-method-intro (c-point 'boi))) - ;; CASE 5P: AWK pattern or function or continuation - ;; thereof. - ((c-major-mode-is 'awk-mode) - (setq placeholder (point)) - (c-add-stmt-syntax - (if (and (eq (c-beginning-of-statement-1) 'same) - (/= (point) placeholder)) - 'topmost-intro-cont - 'topmost-intro) - nil nil - containing-sexp paren-state)) - ;; CASE 5N: At a variable declaration that follows a class ;; definition or some other block declaration that doesn't ;; end at the closing '}'. C.f. case 5D.5. diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 376edcdc76b..f6c47f5bb4d 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -2049,7 +2049,7 @@ styles specified by `c-doc-comment-style'.") (defconst c-font-lock-keywords-3 (c-lang-const c-matchers-3 c) "Accurate normal font locking for C mode. -Like `c-font-lock-keywords-2' but detects declarations in a more +Like the variable `c-font-lock-keywords-2' but detects declarations in a more accurate way that works in most cases for arbitrary types without the need for `c-font-lock-extra-types'.") @@ -2207,7 +2207,7 @@ styles specified by `c-doc-comment-style'.") (defconst c++-font-lock-keywords-3 (c-lang-const c-matchers-3 c++) "Accurate normal font locking for C++ mode. -Like `c++-font-lock-keywords-2' but detects declarations in a more +Like the variable `c++-font-lock-keywords-2' but detects declarations in a more accurate way that works in most cases for arbitrary types without the need for `c++-font-lock-extra-types'.") @@ -2313,7 +2313,7 @@ comment styles specified by `c-doc-comment-style'.") (defconst objc-font-lock-keywords-3 (c-lang-const c-matchers-3 objc) "Accurate normal font locking for Objective-C mode. -Like `objc-font-lock-keywords-2' but detects declarations in a more +Like the variable `objc-font-lock-keywords-2' but detects declarations in a more accurate way that works in most cases for arbitrary types without the need for `objc-font-lock-extra-types'.") @@ -2356,7 +2356,7 @@ comment styles specified by `c-doc-comment-style'.") (defconst java-font-lock-keywords-3 (c-lang-const c-matchers-3 java) "Accurate normal font locking for Java mode. -Like `java-font-lock-keywords-2' but detects declarations in a more +Like variable `java-font-lock-keywords-2' but detects declarations in a more accurate way that works in most cases for arbitrary types without the need for `java-font-lock-extra-types'.") @@ -2389,7 +2389,7 @@ styles specified by `c-doc-comment-style'.") (defconst idl-font-lock-keywords-3 (c-lang-const c-matchers-3 idl) "Accurate normal font locking for CORBA IDL mode. -Like `idl-font-lock-keywords-2' but detects declarations in a more +Like the variable `idl-font-lock-keywords-2' but detects declarations in a more accurate way that works in most cases for arbitrary types without the need for `idl-font-lock-extra-types'.") @@ -2422,7 +2422,7 @@ comment styles specified by `c-doc-comment-style'.") (defconst pike-font-lock-keywords-3 (c-lang-const c-matchers-3 pike) "Accurate normal font locking for Pike mode. -Like `pike-font-lock-keywords-2' but detects declarations in a more +Like the variable `pike-font-lock-keywords-2' but detects declarations in a more accurate way that works in most cases for arbitrary types without the need for `pike-font-lock-extra-types'.") diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index c9fe648171d..3c3a5766582 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -647,7 +647,9 @@ compatible with old code; callers should always specify it." (set (make-local-variable 'outline-regexp) "[^#\n\^M]") (set (make-local-variable 'outline-level) 'c-outline-level) - + (set (make-local-variable 'add-log-current-defun-function) + (lambda () + (or (c-cpp-define-name) (c-defun-name)))) (let ((rfn (assq mode c-require-final-newline))) (when rfn (and (cdr rfn) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index f383e02bc7f..eb73b77bf52 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -134,6 +134,7 @@ and a string describing how the process finished.") ;; If you make any changes to `compilation-error-regexp-alist-alist', ;; be sure to run the ERT test in test/automated/compile-tests.el. +;; emacs -batch -l compile-tests.el -f ert-run-tests-batch-and-exit (defvar compilation-error-regexp-alist-alist '((absoft @@ -261,11 +262,11 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) ;; The "in \\|from " exception was added to handle messages from Ruby. "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\|[ \t]+\\(?:in \\|from \\)\\)?\ \\([0-9]*[^0-9\n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\): ?\ -\\([0-9]+\\)\\(?:[.:]\\([0-9]+\\)\\)?\ -\\(?:-\\([0-9]+\\)?\\(?:\\.\\([0-9]+\\)\\)?\\)?:\ +\\([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:\\|instantiated from\\|[Nn]ote\\)\\|\ - *[Ee]rror\\|\[0-9]?\\(?:[^0-9\n]\\|$\\)\\|[0-9][0-9][0-9]\\)" + *[Ee]rror\\|[0-9]?\\(?:[^0-9\n]\\|$\\)\\|[0-9][0-9][0-9]\\)" 1 (2 . 4) (3 . 5) (6 . 7)) (lcc @@ -1427,8 +1428,9 @@ and move to the source code that caused it. If optional second arg COMINT is t the buffer will be in Comint mode with `compilation-shell-minor-mode'. -Interactively, prompts for the command if `compilation-read-command' is -non-nil; otherwise uses `compile-command'. With prefix arg, always prompts. +Interactively, prompts for the command if the variable +`compilation-read-command' is non-nil; otherwise uses`compile-command'. +With prefix arg, always prompts. Additionally, with universal prefix arg, compilation buffer will be in comint mode, i.e. interactive. @@ -1611,7 +1613,11 @@ Returns the compilation buffer created." (format "%s started at %s\n\n" mode-name (substring (current-time-string) 0 19)) - command "\n") + ;; The command could be split into several lines, see + ;; `rgrep' for example. We want to display it as one + ;; line. + (apply 'concat (split-string command (regexp-quote "\\\n") t)) + "\n") (setq thisdir default-directory)) (set-buffer-modified-p nil)) ;; Pop up the compilation buffer. diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index c64a89aa17b..c302bb484af 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1742,6 +1742,13 @@ or as help on variables `cperl-tips', `cperl-problems', (setq outline-regexp cperl-outline-regexp) (make-local-variable 'outline-level) (setq outline-level 'cperl-outline-level) + (make-local-variable 'add-log-current-defun-function) + (setq add-log-current-defun-function + (lambda () + (save-excursion + (if (re-search-backward "^sub[ \t]+\\([^({ \t\n]+\\)" nil t) + (match-string-no-properties 1))))) + (make-local-variable 'paragraph-start) (setq paragraph-start (concat "^$\\|" page-delimiter)) (make-local-variable 'paragraph-separate) @@ -3113,8 +3120,10 @@ and closing parentheses and brackets." ((eq 'continuation (elt i 0)) ;; [continuation statement-start char-after is-block is-brace] (goto-char (elt i 1)) ; statement-start - (+ (if (memq (elt i 2) (append "}])" nil)) ; char-after - 0 ; Closing parenth + (+ (if (or (memq (elt i 2) (append "}])" nil)) ; char-after + (eq 'continuation ; do not stagger continuations + (elt (cperl-sniff-for-indent parse-data) 0))) + 0 ; Closing parenth or continuation of a continuation cperl-continued-statement-offset) (if (or (elt i 3) ; is-block (not (elt i 4)) ; is-brace diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 21844d20598..ff6321d74c3 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -199,7 +199,8 @@ Pop back to the last location with \\[negative-argument] \\[find-tag].") (defvar tags-table-files nil "List of file names covered by current tags table. -nil means it has not yet been computed; use `tags-table-files' to do so.") +nil means it has not yet been computed; +use function `tags-table-files' to do so.") (defvar tags-completion-table nil "Obarray of tag names defined in current tags table.") @@ -224,7 +225,7 @@ of the format-parsing tags function variables if successful.") One optional argument, a boolean specifying to return complete path (nil) or relative path (non-nil).") (defvar tags-table-files-function nil - "Function to do the work of `tags-table-files' (which see).") + "Function to do the work of function `tags-table-files' (which see).") (defvar tags-completion-table-function nil "Function to build the `tags-completion-table'.") (defvar snarf-tag-function nil @@ -251,7 +252,7 @@ One argument, the tag info returned by `snarf-tag-function'.") (defvar tags-apropos-function nil "Function to do the work of `tags-apropos' (which see).") (defvar tags-included-tables-function nil - "Function to do the work of `tags-included-tables' (which see).") + "Function to do the work of function `tags-included-tables' (which see).") (defvar verify-tags-table-function nil "Function to return t if current buffer contains valid tags file.") @@ -702,7 +703,9 @@ Returns t if it visits a tags table, or nil if there are no more in the list." (kill-local-variable 'tags-file-name) (if (eq local-tags-file-name tags-file-name) (setq tags-file-name nil)) - (user-error "File %s is not a valid tags table" + (user-error (if (file-exists-p local-tags-file-name) + "File %s is not a valid tags table" + "File %s does not exist") local-tags-file-name))))) (defun tags-reset-tags-tables () diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index 181704f82b9..dba1d6a2f9b 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -1178,11 +1178,11 @@ and lies before point." (defsubst f90-line-continued () "Return t if the current line is a continued one. -This includes comment lines embedded in continued lines, but -not the last line of a continued statement." +This includes comment or preprocessor lines embedded in continued lines, +but not the last line of a continued statement." (save-excursion (beginning-of-line) - (while (and (looking-at "[ \t]*\\(!\\|$\\)") (zerop (forward-line -1)))) + (while (and (looking-at "[ \t]*\\([!#]\\|$\\)") (zerop (forward-line -1)))) (end-of-line) (while (f90-in-comment) (search-backward "!" (line-beginning-position)) @@ -1832,11 +1832,15 @@ after indenting." (f90-indent-line-no) (setq no-line-number t) (skip-chars-forward " \t")) - (if (looking-at "!") - (setq indent (f90-comment-indent)) - (and f90-smart-end (looking-at "end") - (f90-match-end)) - (setq indent (f90-calculate-indent))) + ;; FIXME This means f90-calculate-indent gives different answers + ;; for comments and preprocessor lines to this function. + ;; Better to make f90-calculate-indent return the correct answer? + (cond ((looking-at "!") (setq indent (f90-comment-indent))) + ((looking-at "#") (setq indent 0)) + (t + (and f90-smart-end (looking-at "end") + (f90-match-end)) + (setq indent (f90-calculate-indent)))) (or (= indent (current-column)) (f90-indent-to indent no-line-number)) ;; If initial point was within line's indentation, @@ -1973,12 +1977,13 @@ If run in the middle of a line, the line is not broken." (f90-indent-to ind-curr)) (while (and (f90-line-continued) (zerop (forward-line 1)) (< (point) end-region-mark)) - (if (looking-at "[ \t]*!") - (f90-indent-to (f90-comment-indent)) - (or (= (current-indentation) - (+ ind-curr f90-continuation-indent)) - (f90-indent-to - (+ ind-curr f90-continuation-indent) 'no-line-no))))) + (cond ((looking-at "[ \t]*#") (f90-indent-to 0)) + ((looking-at "[ \t]*!") (f90-indent-to (f90-comment-indent))) + (t + (or (= (current-indentation) + (+ ind-curr f90-continuation-indent)) + (f90-indent-to + (+ ind-curr f90-continuation-indent) 'no-line-no)))))) ;; Restore point, etc. (setq f90-cache-position nil) (goto-char save-point) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 7ca0ececa78..0f92df95a9d 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -844,13 +844,21 @@ Return t if it has at least one flymake overlay, nil if no overlay." has-flymake-overlays)) (defface flymake-errline - '((t :inherit error)) + '((((supports :underline (:style wave))) + :underline (:style wave :color "Red1")) + (t + :inherit error)) "Face used for marking error lines." + :version "24.4" :group 'flymake) (defface flymake-warnline - '((t :inherit warning)) + '((((supports :underline (:style wave))) + :underline (:style wave :color "DarkOrange")) + (t + :inherit warning)) "Face used for marking warning lines." + :version "24.4" :group 'flymake) (defun flymake-highlight-line (line-no line-err-info-list) diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index fc3d336cf99..90c7cfc5008 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -607,12 +607,12 @@ executable followed by command-line options. The command-line options should include \"-i=mi\" to use gdb's MI text interface. Note that the old \"--annotate\" option is no longer supported. -If `gdb-many-windows' is nil (the default value) then gdb just +If option `gdb-many-windows' is nil (the default value) then gdb just pops up the GUD buffer unless `gdb-show-main' is t. In this case it starts with two windows: one displaying the GUD buffer and the other with the source file with the main routine of the inferior. -If `gdb-many-windows' is t, regardless of the value of +If option `gdb-many-windows' is t, regardless of the value of `gdb-show-main', the layout below will appear. Keybindings are shown in some of the buffers. @@ -4069,7 +4069,7 @@ window is dedicated." (set-window-dedicated-p window t)) (defun gdb-setup-windows () - "Layout the window pattern for `gdb-many-windows'." + "Layout the window pattern for option `gdb-many-windows'." (gdb-get-buffer-create 'gdb-locals-buffer) (gdb-get-buffer-create 'gdb-stack-buffer) (gdb-get-buffer-create 'gdb-breakpoints-buffer) @@ -4120,7 +4120,7 @@ of the debugged program. Non-nil means display the layout shown for (defun gdb-restore-windows () "Restore the basic arrangement of windows used by gdb. -This arrangement depends on the value of `gdb-many-windows'." +This arrangement depends on the value of option `gdb-many-windows'." (interactive) (switch-to-buffer gud-comint-buffer) ;Select the right window and frame. (delete-other-windows) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index c8a0dc449df..ef321addf24 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -586,7 +586,7 @@ This function is called from `compilation-filter-hook'." 'exec-plus) ((and (grep-probe find-program `(nil nil nil ,null-device "-print0")) - (grep-probe xargs-program `(nil nil nil "-0" "-e" "echo"))) + (grep-probe xargs-program `(nil nil nil "-0" "echo"))) 'gnu) (t 'exec)))) @@ -596,7 +596,7 @@ This function is called from `compilation-filter-hook'." ;; Windows shells need the program file name ;; after the pipe symbol be quoted if they use ;; forward slashes as directory separators. - (format "%s . -type f -print0 | \"%s\" -0 -e %s" + (format "%s . -type f -print0 | \"%s\" -0 %s" find-program xargs-program grep-command)) ((memq grep-find-use-xargs '(exec exec-plus)) (let ((cmd0 (format "%s . -type f -exec %s" @@ -621,7 +621,7 @@ This function is called from `compilation-filter-hook'." (format "%s " null-device) ""))) (cond ((eq grep-find-use-xargs 'gnu) - (format "%s . <X> -type f <F> -print0 | \"%s\" -0 -e %s" + (format "%s . <X> -type f <F> -print0 | \"%s\" -0 %s" find-program xargs-program gcmd)) ((eq grep-find-use-xargs 'exec) (format "%s . <X> -type f <F> -exec %s {} %s%s" @@ -992,14 +992,17 @@ to specify a command to run." (compilation-start regexp 'grep-mode)) (setq dir (file-name-as-directory (expand-file-name dir))) (require 'find-dired) ; for `find-name-arg' + ;; In Tramp, there could be problems if the command line is too + ;; long. We escape it, therefore. (let ((command (grep-expand-template grep-find-template regexp (concat (shell-quote-argument "(") " " find-name-arg " " - (mapconcat #'shell-quote-argument - (split-string files) - (concat " -o " find-name-arg " ")) + (mapconcat + #'shell-quote-argument + (split-string files) + (concat "\\\n" " -o " find-name-arg " ")) " " (shell-quote-argument ")")) dir @@ -1020,7 +1023,7 @@ to specify a command to run." (concat "*/" (cdr ignore))))))) grep-find-ignored-directories - " -o -path ") + "\\\n -o -path ") " " (shell-quote-argument ")") " -prune -o ")) @@ -1038,7 +1041,7 @@ to specify a command to run." (shell-quote-argument (cdr ignore)))))) grep-find-ignored-files - " -o -name ") + "\\\n -o -name ") " " (shell-quote-argument ")") " -prune -o ")))))) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index a16bac7a6cd..5f76cb4bbc5 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -1680,12 +1680,15 @@ This performs fontification according to `js--class-styles'." "each")) "Regexp matching keywords optionally followed by an opening brace.") +(defconst js--declaration-keyword-re + (regexp-opt '("var" "let" "const") 'words) + "Regular expression matching variable declaration keywords.") + (defconst js--indent-operator-re (concat "[-+*/%<>=&^|?:.]\\([^-+*/]\\|$\\)\\|" (js--regexp-opt-symbol '("in" "instanceof"))) "Regexp matching operators that affect indentation of continued expressions.") - (defun js--looking-at-operator-p () "Return non-nil if point is on a JavaScript operator, other than a comma." (save-match-data @@ -1764,6 +1767,37 @@ nil." (list (cons 'c js-comment-lineup-func)))) (c-get-syntactic-indentation (list (cons symbol anchor))))) +(defun js--multi-line-declaration-indentation () + "Helper function for `js--proper-indentation'. +Return the proper indentation of the current line if it belongs to a declaration +statement spanning multiple lines; otherwise, return nil." + (let (at-opening-bracket) + (save-excursion + (back-to-indentation) + (when (not (looking-at js--declaration-keyword-re)) + (when (looking-at js--indent-operator-re) + (goto-char (match-end 0))) + (while (and (not at-opening-bracket) + (not (bobp)) + (let ((pos (point))) + (save-excursion + (js--backward-syntactic-ws) + (or (eq (char-before) ?,) + (and (not (eq (char-before) ?\;)) + (prog2 + (skip-chars-backward "[[:punct:]]") + (looking-at js--indent-operator-re) + (js--backward-syntactic-ws)) + (not (eq (char-before) ?\;))) + (and (>= pos (point-at-bol)) + (<= pos (point-at-eol))))))) + (condition-case err + (backward-sexp) + (scan-error (setq at-opening-bracket t)))) + (when (looking-at js--declaration-keyword-re) + (goto-char (match-end 0)) + (1+ (current-column))))))) + (defun js--proper-indentation (parse-status) "Return the proper indentation for the current line." (save-excursion @@ -1772,6 +1806,7 @@ nil." (js--get-c-offset 'c (nth 8 parse-status))) ((nth 8 parse-status) 0) ; inside string ((js--ctrl-statement-indentation)) + ((js--multi-line-declaration-indentation)) ((eq (char-after) ?#) 0) ((save-excursion (js--beginning-of-macro)) 4) ((nth 1 parse-status) @@ -1823,22 +1858,31 @@ nil." ;;; Filling +(defvar js--filling-paragraph nil) + +;; FIXME: Such redefinitions are bad style. We should try and use some other +;; way to get the same result. +(defadvice c-forward-sws (around js-fill-paragraph activate) + (if js--filling-paragraph + (setq ad-return-value (js--forward-syntactic-ws (ad-get-arg 0))) + ad-do-it)) + +(defadvice c-backward-sws (around js-fill-paragraph activate) + (if js--filling-paragraph + (setq ad-return-value (js--backward-syntactic-ws (ad-get-arg 0))) + ad-do-it)) + +(defadvice c-beginning-of-macro (around js-fill-paragraph activate) + (if js--filling-paragraph + (setq ad-return-value (js--beginning-of-macro (ad-get-arg 0))) + ad-do-it)) + (defun js-c-fill-paragraph (&optional justify) "Fill the paragraph with `c-fill-paragraph'." (interactive "*P") - ;; FIXME: Such redefinitions are bad style. We should try and use some other - ;; way to get the same result. - (cl-letf (((symbol-function 'c-forward-sws) - (lambda (&optional limit) - (js--forward-syntactic-ws limit))) - ((symbol-function 'c-backward-sws) - (lambda (&optional limit) - (js--backward-syntactic-ws limit))) - ((symbol-function 'c-beginning-of-macro) - (lambda (&optional limit) - (js--beginning-of-macro limit)))) - (let ((fill-paragraph-function 'c-fill-paragraph)) - (c-fill-paragraph justify)))) + (let ((js--filling-paragraph t) + (fill-paragraph-function 'c-fill-paragraph)) + (c-fill-paragraph justify))) ;;; Type database and Imenu @@ -3297,29 +3341,21 @@ If one hasn't been set, or if it's stale, prompt for a new one." (define-derived-mode js-mode prog-mode "Javascript" "Major mode for editing JavaScript." :group 'js + (setq-local indent-line-function 'js-indent-line) + (setq-local beginning-of-defun-function 'js-beginning-of-defun) + (setq-local end-of-defun-function 'js-end-of-defun) + (setq-local open-paren-in-column-0-is-defun-start nil) + (setq-local font-lock-defaults (list js--font-lock-keywords)) + (setq-local syntax-propertize-function #'js-syntax-propertize) - (set (make-local-variable 'indent-line-function) 'js-indent-line) - (set (make-local-variable 'beginning-of-defun-function) - 'js-beginning-of-defun) - (set (make-local-variable 'end-of-defun-function) - 'js-end-of-defun) - - (set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil) - (set (make-local-variable 'font-lock-defaults) - (list js--font-lock-keywords)) - (set (make-local-variable 'syntax-propertize-function) - #'js-syntax-propertize) - - (set (make-local-variable 'parse-sexp-ignore-comments) t) - (set (make-local-variable 'parse-sexp-lookup-properties) t) - (set (make-local-variable 'which-func-imenu-joiner-function) - #'js--which-func-joiner) + (setq-local parse-sexp-ignore-comments t) + (setq-local parse-sexp-lookup-properties t) + (setq-local which-func-imenu-joiner-function #'js--which-func-joiner) ;; Comments - (set (make-local-variable 'comment-start) "// ") - (set (make-local-variable 'comment-end) "") - (set (make-local-variable 'fill-paragraph-function) - 'js-c-fill-paragraph) + (setq-local comment-start "// ") + (setq-local comment-end "") + (setq-local fill-paragraph-function 'js-c-fill-paragraph) ;; Parse cache (add-hook 'before-change-functions #'js--flush-caches t t) @@ -3329,8 +3365,7 @@ If one hasn't been set, or if it's stale, prompt for a new one." ;; Imenu (setq imenu-case-fold-search nil) - (set (make-local-variable 'imenu-create-index-function) - #'js--imenu-create-index) + (setq imenu-create-index-function #'js--imenu-create-index) ;; for filling, pretend we're cc-mode (setq c-comment-prefix-regexp "//+\\|\\**" @@ -3341,10 +3376,10 @@ If one hasn't been set, or if it's stale, prompt for a new one." c-comment-start-regexp "/[*/]\\|\\s!" comment-start-skip "\\(//+\\|/\\*+\\)\\s *") - (set (make-local-variable 'electric-indent-chars) - (append "{}():;," electric-indent-chars)) ;FIXME: js2-mode adds "[]*". - (set (make-local-variable 'electric-layout-rules) - '((?\; . after) (?\{ . after) (?\} . before))) + (setq-local electric-indent-chars + (append "{}():;," electric-indent-chars)) ;FIXME: js2-mode adds "[]*". + (setq-local electric-layout-rules + '((?\; . after) (?\{ . after) (?\} . before))) (let ((c-buffer-is-cc-mode t)) ;; FIXME: These are normally set by `c-basic-common-init'. Should @@ -3356,8 +3391,7 @@ If one hasn't been set, or if it's stale, prompt for a new one." (make-local-variable 'adaptive-fill-regexp) (c-setup-paragraph-variables)) - (set (make-local-variable 'syntax-begin-function) - #'js--syntax-begin-function) + (setq-local syntax-begin-function #'js--syntax-begin-function) ;; Important to fontify the whole buffer syntactically! If we don't, ;; then we might have regular expression literals that aren't marked @@ -3371,8 +3405,7 @@ If one hasn't been set, or if it's stale, prompt for a new one." ;; calls to syntax-propertize wherever it's really needed. (syntax-propertize (point-max))) -;;;###autoload -(defalias 'javascript-mode 'js-mode) +;;;###autoload (defalias 'javascript-mode 'js-mode) (eval-after-load 'folding '(when (fboundp 'folding-add-to-marks-list) diff --git a/lisp/progmodes/m4-mode.el b/lisp/progmodes/m4-mode.el index b1fd8cb259b..0641fc776de 100644 --- a/lisp/progmodes/m4-mode.el +++ b/lisp/progmodes/m4-mode.el @@ -141,13 +141,21 @@ "*m4-output*" nil) (switch-to-buffer-other-window "*m4-output*")) +(defun m4-current-defun-name () + "Return the name of the M4 function at point, or nil." + (save-excursion + (if (re-search-backward + "^\\(\\(m4_\\)?define\\|A._DEFUN\\)(\\[?\\([A-Za-z0-9_]+\\)" nil t) + (match-string-no-properties 3)))) + ;;;###autoload (define-derived-mode m4-mode prog-mode "m4" "A major mode to edit m4 macro files." :abbrev-table m4-mode-abbrev-table - (set (make-local-variable 'comment-start) "#") - (set (make-local-variable 'parse-sexp-ignore-comments) t) - (set (make-local-variable 'font-lock-defaults) '(m4-font-lock-keywords nil))) + (setq-local comment-start "#") + (setq-local parse-sexp-ignore-comments t) + (setq-local add-log-current-defun-function #'m4-current-defun-name) + (setq font-lock-defaults '(m4-font-lock-keywords nil))) (provide 'm4-mode) ;;stuff to play with for debugging diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index 9939a54fe41..8ab4c6f95b6 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -879,41 +879,42 @@ Makefile mode can be configured by modifying the following variables: (make-local-variable 'makefile-need-macro-pickup) ;; Font lock. - (set (make-local-variable 'font-lock-defaults) - ;; SYNTAX-BEGIN set to backward-paragraph to avoid slow-down - ;; near the end of a large buffer, due to parse-partial-sexp's - ;; trying to parse all the way till the beginning of buffer. - '(makefile-font-lock-keywords - nil nil - ((?$ . ".")) - backward-paragraph)) - (set (make-local-variable 'syntax-propertize-function) - makefile-syntax-propertize-function) + (setq-local font-lock-defaults + ;; Set SYNTAX-BEGIN to backward-paragraph to avoid + ;; slow-down near the end of a large buffer, due to + ;; `parse-partial-sexp' trying to parse all the way till + ;; the beginning of buffer. + '(makefile-font-lock-keywords + nil nil + ((?$ . ".")) + backward-paragraph)) + (setq-local syntax-propertize-function + makefile-syntax-propertize-function) ;; Add-log. - (set (make-local-variable 'add-log-current-defun-function) - 'makefile-add-log-defun) + (setq-local add-log-current-defun-function + 'makefile-add-log-defun) ;; Imenu. - (set (make-local-variable 'imenu-generic-expression) - makefile-imenu-generic-expression) + (setq-local imenu-generic-expression + makefile-imenu-generic-expression) ;; Dabbrev. - (set (make-local-variable 'dabbrev-abbrev-skip-leading-regexp) "\\$") + (setq-local dabbrev-abbrev-skip-leading-regexp "\\$") ;; Other abbrevs. (setq local-abbrev-table makefile-mode-abbrev-table) ;; Filling. - (set (make-local-variable 'fill-paragraph-function) 'makefile-fill-paragraph) + (setq-local fill-paragraph-function 'makefile-fill-paragraph) ;; Comment stuff. - (set (make-local-variable 'comment-start) "#") - (set (make-local-variable 'comment-end) "") - (set (make-local-variable 'comment-start-skip) "#+[ \t]*") + (setq-local comment-start "#") + (setq-local comment-end "") + (setq-local comment-start-skip "#+[ \t]*") ;; Make sure TAB really inserts \t. - (set (make-local-variable 'indent-line-function) 'indent-to-left-margin) + (setq-local indent-line-function 'indent-to-left-margin) ;; Real TABs are important in makefiles (setq indent-tabs-mode t)) @@ -934,8 +935,7 @@ Makefile mode can be configured by modifying the following variables: ;;;###autoload (define-derived-mode makefile-makepp-mode makefile-mode "Makeppfile" "An adapted `makefile-mode' that knows about makepp." - (set (make-local-variable 'makefile-rule-action-regex) - makefile-makepp-rule-action-regex) + (setq-local makefile-rule-action-regex makefile-makepp-rule-action-regex) (setq font-lock-defaults `(makefile-makepp-font-lock-keywords ,@(cdr font-lock-defaults)) imenu-generic-expression @@ -945,11 +945,9 @@ Makefile mode can be configured by modifying the following variables: ;;;###autoload (define-derived-mode makefile-bsdmake-mode makefile-mode "BSDmakefile" "An adapted `makefile-mode' that knows about BSD make." - (set (make-local-variable 'makefile-dependency-regex) - makefile-bsdmake-dependency-regex) - (set (make-local-variable 'makefile-dependency-skip) "^:!") - (set (make-local-variable 'makefile-rule-action-regex) - makefile-bsdmake-rule-action-regex) + (setq-local makefile-dependency-regex makefile-bsdmake-dependency-regex) + (setq-local makefile-dependency-skip "^:!") + (setq-local makefile-rule-action-regex makefile-bsdmake-rule-action-regex) (setq font-lock-defaults `(makefile-bsdmake-font-lock-keywords ,@(cdr font-lock-defaults)))) @@ -957,7 +955,7 @@ Makefile mode can be configured by modifying the following variables: (define-derived-mode makefile-imake-mode makefile-mode "Imakefile" "An adapted `makefile-mode' that knows about imake." :syntax-table makefile-imake-mode-syntax-table - (set (make-local-variable 'syntax-propertize-function) nil) + (setq-local syntax-propertize-function nil) (setq font-lock-defaults `(makefile-imake-font-lock-keywords ,@(cdr font-lock-defaults)))) @@ -1275,9 +1273,9 @@ definition and conveniently use this command." ;; Filling -(defun makefile-fill-paragraph (_arg) - ;; Fill comments, backslashed lines, and variable definitions - ;; specially. +(defun makefile-fill-paragraph (_justify) + "Function used for `fill-paragraph-function' in Makefile mode. +Fill comments, backslashed lines, and variable definitions specially." (save-excursion (beginning-of-line) (cond @@ -1297,7 +1295,9 @@ definition and conveniently use this command." (end-of-line 0) (while (= (preceding-char) ?\\) (end-of-line 0)) - (forward-char) + ;; Maybe we hit bobp, in which case we are not at EOL. + (if (eq (point) (line-end-position)) + (forward-char)) (point))) (end (save-excursion @@ -1501,8 +1501,8 @@ Insertion takes place at point." (pop-to-buffer browser-buffer) (makefile-browser-fill targets macros) (shrink-window-if-larger-than-buffer) - (set (make-local-variable 'makefile-browser-selection-vector) - (make-vector (+ (length targets) (length macros)) nil)) + (setq-local makefile-browser-selection-vector + (make-vector (+ (length targets) (length macros)) nil)) (makefile-browser-start-interaction)))) (defun makefile-switch-to-browser () diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index 2ee7734e40e..bd58a7300ec 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -1,4 +1,4 @@ -;;; perl-mode.el --- Perl code editing commands for GNU Emacs +;;; perl-mode.el --- Perl code editing commands for GNU Emacs -*- coding: utf-8 -*- ;; Copyright (C) 1990, 1994, 2001-2013 Free Software Foundation, Inc. @@ -102,11 +102,6 @@ ;;; Code: - -(defvar font-lock-comment-face) -(defvar font-lock-doc-face) -(defvar font-lock-string-face) - (defgroup perl nil "Major mode for editing Perl code." :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) @@ -119,16 +114,11 @@ (defvar perl-mode-map (let ((map (make-sparse-keymap))) - (define-key map "{" 'perl-electric-terminator) - (define-key map "}" 'perl-electric-terminator) - (define-key map ";" 'perl-electric-terminator) - (define-key map ":" 'perl-electric-terminator) (define-key map "\e\C-a" 'perl-beginning-of-function) (define-key map "\e\C-e" 'perl-end-of-function) (define-key map "\e\C-h" 'perl-mark-function) (define-key map "\e\C-q" 'perl-indent-exp) (define-key map "\177" 'backward-delete-char-untabify) - (define-key map "\t" 'perl-indent-command) map) "Keymap used in Perl mode.") @@ -158,16 +148,54 @@ (defvar perl-imenu-generic-expression '(;; Functions - (nil "^sub\\s-+\\([-A-Za-z0-9+_:]+\\)" 1) + (nil "^[ \t]*sub\\s-+\\([-A-Za-z0-9+_:]+\\)" 1) ;;Variables ("Variables" "^\\(?:my\\|our\\)\\s-+\\([$@%][-A-Za-z0-9+_:]+\\)\\s-*=" 1) - ("Packages" "^package\\s-+\\([-A-Za-z0-9+_:]+\\);" 1) + ("Packages" "^[ \t]*package\\s-+\\([-A-Za-z0-9+_:]+\\);" 1) ("Doc sections" "^=head[0-9][ \t]+\\(.*\\)" 1)) "Imenu generic expression for Perl mode. See `imenu-generic-expression'.") ;; Regexps updated with help from Tom Tromey <tromey@cambric.colorado.edu> and ;; Jim Campbell <jec@murzim.ca.boeing.com>. +(defcustom perl-prettify-symbols t + "If non-nil, some symbols will be displayed using Unicode chars." + :type 'boolean) + +(defconst perl--prettify-symbols-alist + '(;;("andalso" . ?∧) ("orelse" . ?∨) ("as" . ?≡)("not" . ?¬) + ;;("div" . ?÷) ("*" . ?×) ("o" . ?â—‹) + ("->" . ?→) + ("=>" . ?⇒) + ;;("<-" . ?â†) ("<>" . ?≠) (">=" . ?≥) ("<=" . ?≤) ("..." . ?⋯) + ("::" . ?∷) + )) + +(defun perl--font-lock-compose-symbol () + "Compose a sequence of ascii chars into a symbol. +Regexp match data 0 points to the chars." + ;; Check that the chars should really be composed into a symbol. + (let* ((start (match-beginning 0)) + (end (match-end 0)) + (syntaxes (if (eq (char-syntax (char-after start)) ?w) + '(?w) '(?. ?\\)))) + (if (or (memq (char-syntax (or (char-before start) ?\ )) syntaxes) + (memq (char-syntax (or (char-after end) ?\ )) syntaxes) + (nth 8 (syntax-ppss))) + ;; No composition for you. Let's actually remove any composition + ;; we may have added earlier and which is now incorrect. + (remove-text-properties start end '(composition)) + ;; That's a symbol alright, so add the composition. + (compose-region start end (cdr (assoc (match-string 0) + perl--prettify-symbols-alist))))) + ;; Return nil because we're not adding any face property. + nil) + +(defun perl--font-lock-symbols-keywords () + (when perl-prettify-symbols + `((,(regexp-opt (mapcar 'car perl--prettify-symbols-alist) t) + (0 (perl--font-lock-compose-symbol)))))) + (defconst perl-font-lock-keywords-1 '(;; What is this for? ;;("\\(--- .* ---\\|=== .* ===\\)" . font-lock-string-face) @@ -190,32 +218,32 @@ "Subdued level highlighting for Perl mode.") (defconst perl-font-lock-keywords-2 - (append perl-font-lock-keywords-1 - (list - ;; - ;; Fontify keywords, except those fontified otherwise. - (concat "\\<" - (regexp-opt '("if" "until" "while" "elsif" "else" "unless" - "do" "dump" "for" "foreach" "exit" "die" - "BEGIN" "END" "return" "exec" "eval") t) - "\\>") - ;; - ;; Fontify local and my keywords as types. - '("\\<\\(local\\|my\\)\\>" . font-lock-type-face) - ;; - ;; Fontify function, variable and file name references. - '("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face) - ;; Additionally underline non-scalar variables. Maybe this is a bad idea. - ;;'("[$@%*][#{]?\\(\\sw+\\)" 1 font-lock-variable-name-face) - '("[$*]{?\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-variable-name-face) - '("\\([@%]\\|\\$#\\)\\(\\sw+\\(::\\sw+\\)*\\)" + (append + perl-font-lock-keywords-1 + `( ;; Fontify keywords, except those fontified otherwise. + ,(concat "\\<" + (regexp-opt '("if" "until" "while" "elsif" "else" "unless" + "do" "dump" "for" "foreach" "exit" "die" + "BEGIN" "END" "return" "exec" "eval") t) + "\\>") + ;; + ;; Fontify local and my keywords as types. + ("\\<\\(local\\|my\\)\\>" . font-lock-type-face) + ;; + ;; Fontify function, variable and file name references. + ("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face) + ;; Additionally underline non-scalar variables. Maybe this is a bad idea. + ;;'("[$@%*][#{]?\\(\\sw+\\)" 1 font-lock-variable-name-face) + ("[$*]{?\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-variable-name-face) + ("\\([@%]\\|\\$#\\)\\(\\sw+\\(::\\sw+\\)*\\)" (2 (cons font-lock-variable-name-face '(underline)))) - '("<\\(\\sw+\\)>" 1 font-lock-constant-face) - ;; - ;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'. - '("\\<\\(continue\\|goto\\|last\\|next\\|redo\\)\\>[ \t]*\\(\\sw+\\)?" + ("<\\(\\sw+\\)>" 1 font-lock-constant-face) + ;; + ;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'. + ("\\<\\(continue\\|goto\\|last\\|next\\|redo\\)\\>[ \t]*\\(\\sw+\\)?" (1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) - '("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-constant-face))) + ("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-constant-face) + ,@(perl--font-lock-symbols-keywords))) "Gaudy level highlighting for Perl mode.") (defvar perl-font-lock-keywords perl-font-lock-keywords-1 @@ -543,11 +571,20 @@ create a new comment." (defun perl-outline-level () (cond - ((looking-at "package\\s-") 0) - ((looking-at "sub\\s-") 1) + ((looking-at "[ \t]*\\(package\\)\\s-") + (- (match-beginning 1) (match-beginning 0))) + ((looking-at "[ \t]*s\\(ub\\)\\s-") + (- (match-beginning 1) (match-beginning 0))) ((looking-at "=head[0-9]") (- (char-before (match-end 0)) ?0)) ((looking-at "=cut") 1) (t 3))) + +(defun perl-current-defun-name () + "The `add-log-current-defun' function in Perl mode." + (save-excursion + (if (re-search-backward "^sub[ \t]+\\([^({ \t\n]+\\)" nil t) + (match-string-no-properties 1)))) + (defvar perl-mode-hook nil "Normal hook to run when entering Perl mode.") @@ -601,15 +638,15 @@ Various indentation styles: K&R BSD BLK GNU LW Turning on Perl mode runs the normal hook `perl-mode-hook'." :abbrev-table perl-mode-abbrev-table - (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter)) - (set (make-local-variable 'paragraph-separate) paragraph-start) - (set (make-local-variable 'paragraph-ignore-fill-prefix) t) - (set (make-local-variable 'indent-line-function) #'perl-indent-line) - (set (make-local-variable 'comment-start) "# ") - (set (make-local-variable 'comment-end) "") - (set (make-local-variable 'comment-start-skip) "\\(^\\|\\s-\\);?#+ *") - (set (make-local-variable 'comment-indent-function) #'perl-comment-indent) - (set (make-local-variable 'parse-sexp-ignore-comments) t) + (setq-local paragraph-start (concat "$\\|" page-delimiter)) + (setq-local paragraph-separate paragraph-start) + (setq-local paragraph-ignore-fill-prefix t) + (setq-local indent-line-function #'perl-indent-line) + (setq-local comment-start "# ") + (setq-local comment-end "") + (setq-local comment-start-skip "\\(^\\|\\s-\\);?#+ *") + (setq-local comment-indent-function #'perl-comment-indent) + (setq-local parse-sexp-ignore-comments t) ;; Tell font-lock.el how to handle Perl. (setq font-lock-defaults '((perl-font-lock-keywords perl-font-lock-keywords-1 @@ -617,17 +654,21 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'." nil nil ((?\_ . "w")) nil (font-lock-syntactic-face-function . perl-font-lock-syntactic-face-function))) - (set (make-local-variable 'syntax-propertize-function) - #'perl-syntax-propertize-function) + (setq-local syntax-propertize-function #'perl-syntax-propertize-function) (add-hook 'syntax-propertize-extend-region-functions #'syntax-propertize-multiline 'append 'local) + ;; Electricity. + ;; FIXME: setup electric-layout-rules. + (setq-local electric-indent-chars + (append '(?\{ ?\} ?\; ?\:) electric-indent-chars)) + (add-hook 'electric-indent-functions #'perl-electric-noindent-p nil t) ;; Tell imenu how to handle Perl. - (set (make-local-variable 'imenu-generic-expression) - perl-imenu-generic-expression) + (setq-local imenu-generic-expression perl-imenu-generic-expression) (setq imenu-case-fold-search nil) ;; Setup outline-minor-mode. - (set (make-local-variable 'outline-regexp) perl-outline-regexp) - (set (make-local-variable 'outline-level) 'perl-outline-level)) + (setq-local outline-regexp perl-outline-regexp) + (setq-local outline-level 'perl-outline-level) + (setq-local add-log-current-defun-function #'perl-current-defun-name)) ;; This is used by indent-for-comment ;; to decide how much to indent a comment in Perl code @@ -637,7 +678,11 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'." 0 ;Existing comment at bol stays there. comment-column)) -(defalias 'electric-perl-terminator 'perl-electric-terminator) +(define-obsolete-function-alias 'electric-perl-terminator + 'perl-electric-terminator "22.1") +(defun perl-electric-noindent-p (char) + (unless (eolp) 'no-indent)) + (defun perl-electric-terminator (arg) "Insert character and maybe adjust indentation. If at end-of-line, and not in a comment or a quote, correct the indentation." @@ -661,6 +706,7 @@ If at end-of-line, and not in a comment or a quote, correct the indentation." (perl-indent-line) (delete-char -1)))) (self-insert-command (prefix-numeric-value arg))) +(make-obsolete 'perl-electric-terminator 'electric-indent-mode "24.4") ;; not used anymore, but may be useful someday: ;;(defun perl-inside-parens-p () @@ -744,6 +790,7 @@ following list: (t (message "Use backslash to quote # characters.") (ding t))))))))) +(make-obsolete 'perl-indent-command 'indent-according-to-mode "24.4") (defun perl-indent-line (&optional nochange parse-start) "Indent current line as Perl code. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 71c5ba57fa0..a1322239b35 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -208,12 +208,10 @@ (require 'ansi-color) (require 'comint) -(eval-when-compile - (require 'cl) - ;; Avoid compiler warnings - (defvar view-return-to-alist) - (defvar compilation-error-regexp-alist) - (defvar outline-heading-end-regexp)) +;; Avoid compiler warnings +(defvar view-return-to-alist) +(defvar compilation-error-regexp-alist) +(defvar outline-heading-end-regexp) (autoload 'comint-mode "comint") @@ -369,12 +367,24 @@ This variant of `rx' supports common python named REGEXPS." "Return non-nil if point is on TYPE using SYNTAX-PPSS. TYPE can be `comment', `string' or `paren'. It returns the start character address of the specified TYPE." + (declare (compiler-macro + (lambda (form) + (pcase type + (`'comment + `(let ((ppss (or ,syntax-ppss (syntax-ppss)))) + (and (nth 4 ppss) (nth 8 ppss)))) + (`'string + `(let ((ppss (or ,syntax-ppss (syntax-ppss)))) + (and (nth 3 ppss) (nth 8 ppss)))) + (`'paren + `(nth 1 (or ,syntax-ppss (syntax-ppss)))) + (_ form))))) (let ((ppss (or syntax-ppss (syntax-ppss)))) - (case type - (comment (and (nth 4 ppss) (nth 8 ppss))) - (string (and (not (nth 4 ppss)) (nth 8 ppss))) - (paren (nth 1 ppss)) - (t nil)))) + (pcase type + (`comment (and (nth 4 ppss) (nth 8 ppss))) + (`string (and (nth 3 ppss) (nth 8 ppss))) + (`paren (nth 1 ppss)) + (_ nil)))) (defun python-syntax-context-type (&optional syntax-ppss) "Return the context type using SYNTAX-PPSS. @@ -486,8 +496,8 @@ The type returned can be `comment', `string' or `paren'." (when (re-search-forward re limit t) (while (and (python-syntax-context 'paren) (re-search-forward re limit t))) - (if (and (not (python-syntax-context 'paren)) - (not (equal (char-after (point-marker)) ?=))) + (if (not (or (python-syntax-context 'paren) + (equal (char-after (point-marker)) ?=))) t (set-match-data nil))))) (1 font-lock-variable-name-face nil nil)) @@ -521,7 +531,7 @@ is used to limit the scan." (while (and (< i 3) (or (not limit) (< (+ point i) limit)) (eq (char-after (+ point i)) quote-char)) - (incf i)) + (setq i (1+ i))) i)) (defun python-syntax-stringify () @@ -734,17 +744,17 @@ START is the buffer position where the sexp starts." (save-restriction (widen) (save-excursion - (case context-status - ('no-indent 0) + (pcase context-status + (`no-indent 0) ;; When point is after beginning of block just add one level ;; of indentation relative to the context-start - ('after-beginning-of-block + (`after-beginning-of-block (goto-char context-start) (+ (current-indentation) python-indent-offset)) ;; When after a simple line just use previous line ;; indentation, in the case current line starts with a ;; `python-indent-dedenters' de-indent one level. - ('after-line + (`after-line (- (save-excursion (goto-char context-start) @@ -757,11 +767,11 @@ START is the buffer position where the sexp starts." ;; When inside of a string, do nothing. just use the current ;; indentation. XXX: perhaps it would be a good idea to ;; invoke standard text indentation here - ('inside-string + (`inside-string (goto-char context-start) (current-indentation)) ;; After backslash we have several possibilities. - ('after-backslash + (`after-backslash (cond ;; Check if current line is a dot continuation. For this ;; the current line must start with a dot and previous @@ -827,7 +837,7 @@ START is the buffer position where the sexp starts." (+ (current-indentation) python-indent-offset))))) ;; When inside a paren there's a need to handle nesting ;; correctly - ('inside-paren + (`inside-paren (cond ;; If current line closes the outermost open paren use the ;; current indentation of the context-start line. @@ -2207,11 +2217,11 @@ INPUT." 'default) (t nil))) (completion-code - (case completion-context - (pdb python-shell-completion-pdb-string-code) - (import python-shell-completion-module-string-code) - (default python-shell-completion-string-code) - (t nil))) + (pcase completion-context + (`pdb python-shell-completion-pdb-string-code) + (`import python-shell-completion-module-string-code) + (`default python-shell-completion-string-code) + (_ nil))) (input (if (eq completion-context 'import) (replace-regexp-in-string "^[ \t]+" "" line) @@ -2517,12 +2527,12 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'." JUSTIFY should be used (if applicable) as in `fill-paragraph'." (let* ((marker (point-marker)) (str-start-pos - (let ((m (make-marker))) - (setf (marker-position m) - (or (python-syntax-context 'string) - (and (equal (string-to-syntax "|") - (syntax-after (point))) - (point)))) m)) + (set-marker + (make-marker) + (or (python-syntax-context 'string) + (and (equal (string-to-syntax "|") + (syntax-after (point))) + (point))))) (num-quotes (python-syntax-count-quotes (char-after str-start-pos) str-start-pos)) (str-end-pos @@ -2535,17 +2545,17 @@ JUSTIFY should be used (if applicable) as in `fill-paragraph'." ;; Docstring styles may vary for oneliners and multi-liners. (> (count-matches "\n" str-start-pos str-end-pos) 0)) (delimiters-style - (case python-fill-docstring-style + (pcase python-fill-docstring-style ;; delimiters-style is a cons cell with the form ;; (START-NEWLINES . END-NEWLINES). When any of the sexps ;; is NIL means to not add any newlines for start or end ;; of docstring. See `python-fill-docstring-style' for a ;; graphic idea of each style. - (django (cons 1 1)) - (onetwo (and multi-line-p (cons 1 2))) - (pep-257 (and multi-line-p (cons nil 2))) - (pep-257-nn (and multi-line-p (cons nil 1))) - (symmetric (and multi-line-p (cons 1 1))))) + (`django (cons 1 1)) + (`onetwo (and multi-line-p (cons 1 2))) + (`pep-257 (and multi-line-p (cons nil 2))) + (`pep-257-nn (and multi-line-p (cons nil 1))) + (`symmetric (and multi-line-p (cons 1 1))))) (docstring-p (save-excursion ;; Consider docstrings those strings which ;; start on a line by themselves. @@ -2746,7 +2756,7 @@ The skeleton will be bound to python-skeleton-NAME." (easy-menu-add-item nil '("Python" "Skeletons") `[,(format - "Insert %s" (caddr (split-string (symbol-name skeleton) "-"))) + "Insert %s" (nth 2 (split-string (symbol-name skeleton) "-"))) ,skeleton t])))) ;;; FFAP diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index e48ee8e92d3..19d1ffe0a3b 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -103,10 +103,17 @@ '"\\(def\\|class\\|module\\)" "Regexp to match the beginning of a defun, in the general sense.") +(defconst ruby-singleton-class-re + "class\\s *<<" + "Regexp to match the beginning of a singleton class context.") + (eval-and-compile (defconst ruby-here-doc-beg-re "\\(<\\)<\\(-\\)?\\(\\([a-zA-Z0-9_]+\\)\\|[\"]\\([^\"]+\\)[\"]\\|[']\\([^']+\\)[']\\)" - "Regexp to match the beginning of a heredoc.")) + "Regexp to match the beginning of a heredoc.") + + (defconst ruby-expression-expansion-re + "[^\\]\\(\\\\\\\\\\)*\\(#\\({[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\|\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\)\\)")) (defun ruby-here-doc-end-match () "Return a regexp to find the end of a heredoc. @@ -382,10 +389,12 @@ and `\\' when preceded by `?'." (when pos (goto-char pos)) (forward-word -1) (and (or (bolp) (not (eq (char-before (point)) ?_))) - (looking-at "class\\s *<<")))) + (looking-at ruby-singleton-class-re)))) (defun ruby-expr-beg (&optional option) - "TODO: document." + "Check if point is possibly at the beginning of an expression. +OPTION specifies the type of the expression. +Can be one of `heredoc', `modifier', `expr-qstr', `expr-re'." (save-excursion (store-match-data nil) (let ((space (skip-chars-backward " \t")) @@ -398,10 +407,10 @@ and `\\' when preceded by `?'." (or (eq (char-syntax (char-before (point))) ?w) (ruby-special-char-p)))) nil) - ((and (eq option 'heredoc) (< space 0)) - (not (progn (goto-char start) (ruby-singleton-class-p)))) - ((or (looking-at ruby-operator-re) - (looking-at "[\\[({,;]") + ((looking-at ruby-operator-re)) + ((eq option 'heredoc) + (and (< space 0) (not (ruby-singleton-class-p start)))) + ((or (looking-at "[\\[({,;]") (and (looking-at "[!?]") (or (not (eq option 'modifier)) (bolp) @@ -866,39 +875,54 @@ calculating indentation on the lines after it." (beginning-of-line))))) (defun ruby-move-to-block (n) - "Move to the beginning (N < 0) or the end (N > 0) of the current block -or blocks containing the current block." - ;; TODO: Make this work for n > 1, - ;; make it not loop for n = 0, - ;; document body + "Move to the beginning (N < 0) or the end (N > 0) of the +current block, a sibling block, or an outer block. Do that (abs N) times." (let ((orig (point)) (start (ruby-calculate-indent)) - (down (looking-at (if (< n 0) ruby-block-end-re - (concat "\\<\\(" ruby-block-beg-re "\\)\\>")))) - pos done) - (while (and (not done) (not (if (< n 0) (bobp) (eobp)))) - (forward-line n) - (cond - ((looking-at "^\\s *$")) - ((looking-at "^\\s *#")) - ((and (> n 0) (looking-at "^=begin\\>")) - (re-search-forward "^=end\\>")) - ((and (< n 0) (looking-at "^=end\\>")) - (re-search-backward "^=begin\\>")) - (t - (setq pos (current-indentation)) + (signum (if (> n 0) 1 -1)) + (backward (< n 0)) + down pos done) + (dotimes (_ (abs n)) + (setq done nil) + (setq down (save-excursion + (back-to-indentation) + ;; There is a block start or block end keyword on this + ;; line, don't need to look for another block. + (and (re-search-forward + (if backward ruby-block-end-re + (concat "\\_<\\(" ruby-block-beg-re "\\)\\_>")) + (line-end-position) t) + (not (nth 8 (syntax-ppss)))))) + (while (and (not done) (not (if backward (bobp) (eobp)))) + (forward-line signum) (cond - ((< start pos) - (setq down t)) - ((and down (= pos start)) - (setq done t)) - ((> start pos) - (setq done t))))) - (if done - (save-excursion - (back-to-indentation) - (if (looking-at (concat "\\<\\(" ruby-block-mid-re "\\)\\>")) - (setq done nil))))) + ;; Skip empty and commented out lines. + ((looking-at "^\\s *$")) + ((looking-at "^\\s *#")) + ;; Skip block comments; + ((and (not backward) (looking-at "^=begin\\>")) + (re-search-forward "^=end\\>")) + ((and backward (looking-at "^=end\\>")) + (re-search-backward "^=begin\\>")) + (t + (setq pos (ruby-calculate-indent)) + (cond + ;; Deeper indentation, we found a block. + ;; FIXME: We can't recognize empty blocks this way. + ((< start pos) + (setq down t)) + ;; Block found, and same indentation as when started, stop. + ((and down (= pos start)) + (setq done t)) + ;; Shallower indentation, means outer block, can stop now. + ((> start pos) + (setq done t))))) + (if done + (save-excursion + (back-to-indentation) + ;; Not really at the first or last line of the block, move on. + (if (looking-at (concat "\\<\\(" ruby-block-mid-re "\\)\\>")) + (setq done nil)))))) (back-to-indentation))) (defun ruby-beginning-of-block (&optional arg) @@ -910,8 +934,7 @@ With ARG, move up multiple blocks." (defun ruby-end-of-block (&optional arg) "Move forward to the end of the current block. With ARG, move out of multiple blocks." - ;; Passing a value > 1 to ruby-move-to-block currently doesn't work. - (interactive) + (interactive "p") (ruby-move-to-block (or arg 1))) (defun ruby-forward-sexp (&optional arg) @@ -1034,70 +1057,76 @@ For example: #exit String#gsub Net::HTTP#active? - File::open. + File.open See `add-log-current-defun-function'." - ;; TODO: Document body - ;; Why does this append a period to class methods? (condition-case nil (save-excursion - (let (mname mlist (indent 0)) - ;; get current method (or class/module) - (if (re-search-backward - (concat "^[ \t]*" ruby-defun-beg-re "[ \t]+" - "\\(" - ;; \\. and :: for class method + (let ((indent 0) mname mlist + (start (point)) + (definition-re + (concat "^[ \t]*" ruby-defun-beg-re "[ \t]+" + "\\(" + ;; \\. and :: for class methods "\\([A-Za-z_]" ruby-symbol-re "*\\|\\.\\|::" "\\)" - "+\\)") - nil t) - (progn - (setq mname (match-string 2)) - (unless (string-equal "def" (match-string 1)) - (setq mlist (list mname) mname nil)) - (goto-char (match-beginning 1)) - (setq indent (current-column)) - (beginning-of-line))) - ;; nest class/module + "+\\)"))) + ;; Get the current method definition (or class/module). + (when (re-search-backward definition-re nil t) + (goto-char (match-beginning 1)) + (when (ruby-block-contains-point start) + ;; We're inside the method, class or module. + (setq mname (match-string 2)) + (unless (string-equal "def" (match-string 1)) + (setq mlist (list mname) mname nil))) + (setq indent (current-column)) + (beginning-of-line)) + ;; Walk up the class/module nesting. (while (and (> indent 0) - (re-search-backward - (concat - "^[ \t]*\\(class\\|module\\)[ \t]+" - "\\([A-Z]" ruby-symbol-re "*\\)") - nil t)) + (re-search-backward definition-re nil t)) (goto-char (match-beginning 1)) - (if (< (current-column) indent) - (progn - (setq mlist (cons (match-string 2) mlist)) - (setq indent (current-column)) - (beginning-of-line)))) + (when (ruby-block-contains-point start) + (setq mlist (cons (match-string 2) mlist)) + (setq indent (current-column)) + (beginning-of-line))) + ;; Process the method name. (when mname (let ((mn (split-string mname "\\.\\|::"))) (if (cdr mn) (progn - (cond - ((string-equal "" (car mn)) - (setq mn (cdr mn) mlist nil)) - ((string-equal "self" (car mn)) - (setq mn (cdr mn))) - ((let ((ml (nreverse mlist))) + (unless (string-equal "self" (car mn)) ; def self.foo + ;; def C.foo + (let ((ml (nreverse mlist))) + ;; If the method name references one of the + ;; containing modules, drop the more nested ones. (while ml (if (string-equal (car ml) (car mn)) (setq mlist (nreverse (cdr ml)) ml nil)) - (or (setq ml (cdr ml)) (nreverse mlist)))))) - (if mlist - (setcdr (last mlist) mn) - (setq mlist mn)) - (setq mn (last mn 2)) - (setq mname (concat "." (cadr mn))) - (setcdr mn nil)) - (setq mname (concat "#" mname))))) - ;; generate string + (or (setq ml (cdr ml)) (nreverse mlist)))) + (if mlist + (setcdr (last mlist) (butlast mn)) + (setq mlist (butlast mn)))) + (setq mname (concat "." (car (last mn))))) + ;; See if the method is in singleton class context. + (let ((in-singleton-class + (when (re-search-forward ruby-singleton-class-re start t) + (goto-char (match-beginning 0)) + (ruby-block-contains-point start)))) + (setq mname (concat + (if in-singleton-class "." "#") + mname)))))) + ;; Generate the string. (if (consp mlist) (setq mlist (mapconcat (function identity) mlist "::"))) (if mname (if mlist (concat mlist mname) mname) mlist))))) +(defun ruby-block-contains-point (pt) + (save-excursion + (save-match-data + (ruby-forward-sexp) + (> (point) pt)))) + (defun ruby-brace-to-do-end (orig end) (let (beg-marker end-marker) (goto-char end) @@ -1238,7 +1267,8 @@ It will be properly highlighted even when the call omits parens.")) ;; Handle percent literals: %w(), %q{}, etc. ((concat "\\(?:^\\|[[ \t\n<+(,=]\\)" ruby-percent-literal-beg-re) (1 (prog1 "|" (ruby-syntax-propertize-percent-literal end))))) - (point) end)) + (point) end) + (ruby-syntax-propertize-expansions start end)) (defun ruby-syntax-propertize-heredoc (limit) (let ((ppss (syntax-ppss)) @@ -1305,6 +1335,23 @@ It will be properly highlighted even when the call omits parens.")) (string-to-syntax "|"))) ;; Unclosed literal, leave the following text unpropertized. ((scan-error search-failed) (goto-char limit)))))) + + (defun ruby-syntax-propertize-expansions (start end) + (remove-text-properties start end '(ruby-expansion-match-data)) + (goto-char start) + ;; Find all expression expansions and + ;; - save the match data to a text property, for font-locking later, + ;; - set the syntax of all double quotes and backticks to punctuation. + (while (re-search-forward ruby-expression-expansion-re end 'move) + (let ((beg (match-beginning 2)) + (end (match-end 2))) + (when (and beg (save-excursion (nth 3 (syntax-ppss beg)))) + (put-text-property beg (1+ beg) 'ruby-expansion-match-data + (match-data)) + (goto-char beg) + (while (re-search-forward "[\"`]" end 'move) + (put-text-property (match-beginning 0) (match-end 0) + 'syntax-table (string-to-syntax "."))))))) ) ;; For Emacsen where syntax-propertize-rules is not (yet) available, @@ -1505,7 +1552,7 @@ See `font-lock-syntax-table'.") 1 font-lock-function-name-face) ;; keywords (cons (concat - "\\(^\\|[^_:.@$]\\|\\.\\.\\)\\b\\(defined\\?\\|" + "\\(^\\|[^.@$]\\|\\.\\.\\)\\_<\\(defined\\?\\|" (regexp-opt '("alias_method" "alias" @@ -1552,9 +1599,10 @@ See `font-lock-syntax-table'.") ruby-keyword-end-re) 2) ;; here-doc beginnings - (list ruby-here-doc-beg-re 0 'font-lock-string-face) + `(,ruby-here-doc-beg-re 0 (unless (ruby-singleton-class-p (match-beginning 0)) + 'font-lock-string-face)) ;; variables - '("\\(^\\|[^_:.@$]\\|\\.\\.\\)\\b\\(nil\\|self\\|true\\|false\\)\\>" + '("\\(^\\|[^.@$]\\|\\.\\.\\)\\_<\\(nil\\|self\\|true\\|false\\)\\>" 2 font-lock-variable-name-face) ;; symbols '("\\(^\\|[^:]\\)\\(:\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|![~=]?\\|\\[\\]=?\\|@?\\(\\w\\|_\\)+\\([!?=]\\|\\b_*\\)\\|#{[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\)\\)" @@ -1565,12 +1613,12 @@ See `font-lock-syntax-table'.") '("\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+" 0 font-lock-variable-name-face) ;; constants - '("\\(^\\|[^_]\\)\\b\\([A-Z]+\\(\\w\\|_\\)*\\)" - 2 font-lock-type-face) + '("\\(?:\\_<\\|::\\)\\([A-Z]+\\(\\w\\|_\\)*\\)" + 1 font-lock-type-face) '("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" 2 font-lock-constant-face) ;; expression expansion '(ruby-match-expression-expansion - 0 font-lock-variable-name-face t) + 2 font-lock-variable-name-face t) ;; warn lower camel case ;'("\\<[a-z]+[a-z0-9]*[A-Z][A-Za-z0-9]*\\([!?]?\\|\\>\\)" ; 0 font-lock-warning-face) @@ -1578,9 +1626,14 @@ See `font-lock-syntax-table'.") "Additional expressions to highlight in Ruby mode.") (defun ruby-match-expression-expansion (limit) - (when (re-search-forward "[^\\]\\(\\\\\\\\\\)*\\(#\\({[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\|\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\)\\)" limit 'move) - (or (ruby-in-ppss-context-p 'string) - (ruby-match-expression-expansion limit)))) + (let* ((prop 'ruby-expansion-match-data) + (pos (next-single-char-property-change (point) prop nil limit)) + value) + (when (and pos (> pos (point))) + (goto-char pos) + (or (and (setq value (get-text-property pos prop)) + (progn (set-match-data value) t)) + (ruby-match-expression-expansion limit))))) ;;;###autoload (define-derived-mode ruby-mode prog-mode "Ruby" @@ -1629,6 +1682,10 @@ The variable `ruby-indent-level' controls the amount of indentation. ;;;###autoload (add-to-list 'auto-mode-alist (cons (purecopy "\\.rb\\'") 'ruby-mode)) +;;;###autoload +(add-to-list 'auto-mode-alist (cons (purecopy "Rakefile\\'") 'ruby-mode)) +;;;###autoload +(add-to-list 'auto-mode-alist (cons (purecopy "\\.gemspec\\'") 'ruby-mode)) ;;;###autoload (dolist (name (list "ruby" "rbx" "jruby" "ruby1.9" "ruby1.8")) diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index a7dbc411622..aae5526ea82 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -126,44 +126,44 @@ (defun scheme-mode-variables () (set-syntax-table scheme-mode-syntax-table) (setq local-abbrev-table scheme-mode-abbrev-table) - (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter)) - (set (make-local-variable 'paragraph-separate) paragraph-start) - (set (make-local-variable 'paragraph-ignore-fill-prefix) t) - (set (make-local-variable 'fill-paragraph-function) 'lisp-fill-paragraph) + (setq-local paragraph-start (concat "$\\|" page-delimiter)) + (setq-local paragraph-separate paragraph-start) + (setq-local paragraph-ignore-fill-prefix t) + (setq-local fill-paragraph-function 'lisp-fill-paragraph) ;; Adaptive fill mode gets in the way of auto-fill, ;; and should make no difference for explicit fill ;; because lisp-fill-paragraph should do the job. - (set (make-local-variable 'adaptive-fill-mode) nil) - (set (make-local-variable 'indent-line-function) 'lisp-indent-line) - (set (make-local-variable 'parse-sexp-ignore-comments) t) - (set (make-local-variable 'outline-regexp) ";;; \\|(....") - (set (make-local-variable 'comment-start) ";") - (set (make-local-variable 'comment-add) 1) + (setq-local adaptive-fill-mode nil) + (setq-local indent-line-function 'lisp-indent-line) + (setq-local parse-sexp-ignore-comments t) + (setq-local outline-regexp ";;; \\|(....") + (setq-local add-log-current-defun-function #'lisp-current-defun-name) + (setq-local comment-start ";") + (setq-local comment-add 1) ;; Look within the line for a ; following an even number of backslashes ;; after either a non-backslash or the line beginning. - (set (make-local-variable 'comment-start-skip) - "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+[ \t]*") - (set (make-local-variable 'font-lock-comment-start-skip) ";+ *") - (set (make-local-variable 'comment-column) 40) - (set (make-local-variable 'parse-sexp-ignore-comments) t) - (set (make-local-variable 'lisp-indent-function) 'scheme-indent-function) + (setq-local comment-start-skip + "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+[ \t]*") + (setq-local font-lock-comment-start-skip ";+ *") + (setq-local comment-column 40) + (setq-local parse-sexp-ignore-comments t) + (setq-local lisp-indent-function 'scheme-indent-function) (setq mode-line-process '("" scheme-mode-line-process)) - (set (make-local-variable 'imenu-case-fold-search) t) + (setq-local imenu-case-fold-search t) (setq imenu-generic-expression scheme-imenu-generic-expression) - (set (make-local-variable 'imenu-syntax-alist) + (setq-local imenu-syntax-alist '(("+-*/.<>=?!$%_&~^:" . "w"))) - (set (make-local-variable 'font-lock-defaults) - '((scheme-font-lock-keywords - scheme-font-lock-keywords-1 scheme-font-lock-keywords-2) - nil t (("+-*/.<>=!?$%_&~^:" . "w") (?#. "w 14")) - beginning-of-defun - (font-lock-mark-block-function . mark-defun) - (font-lock-syntactic-face-function - . scheme-font-lock-syntactic-face-function) - (parse-sexp-lookup-properties . t) - (font-lock-extra-managed-props syntax-table))) - (set (make-local-variable 'lisp-doc-string-elt-property) - 'scheme-doc-string-elt)) + (setq font-lock-defaults + '((scheme-font-lock-keywords + scheme-font-lock-keywords-1 scheme-font-lock-keywords-2) + nil t (("+-*/.<>=!?$%_&~^:" . "w") (?#. "w 14")) + beginning-of-defun + (font-lock-mark-block-function . mark-defun) + (font-lock-syntactic-face-function + . scheme-font-lock-syntactic-face-function) + (parse-sexp-lookup-properties . t) + (font-lock-extra-managed-props syntax-table))) + (setq-local lisp-doc-string-elt-property 'scheme-doc-string-elt)) (defvar scheme-mode-line-process "") @@ -386,7 +386,7 @@ Blank lines separate paragraphs. Semicolons start comments. Entering this mode runs the hooks `scheme-mode-hook' and then `dsssl-mode-hook' and inserts the value of `dsssl-sgml-declaration' if that variable's value is a string." - (set (make-local-variable 'page-delimiter) "^;;;") ; ^L not valid SGML char + (setq-local page-delimiter "^;;;") ; ^L not valid SGML char ;; Insert a suitable SGML declaration into an empty buffer. ;; FIXME: This should use `auto-insert-alist' instead. (and (zerop (buffer-size)) @@ -397,10 +397,10 @@ that variable's value is a string." nil t (("+-*/.<>=?$%_&~^:" . "w")) beginning-of-defun (font-lock-mark-block-function . mark-defun))) - (set (make-local-variable 'imenu-case-fold-search) nil) + (setq-local add-log-current-defun-function #'lisp-current-defun-name) + (setq-local imenu-case-fold-search nil) (setq imenu-generic-expression dsssl-imenu-generic-expression) - (set (make-local-variable 'imenu-syntax-alist) - '(("+-*/.<>=?$%_&~^:" . "w")))) + (setq-local imenu-syntax-alist '(("+-*/.<>=?$%_&~^:" . "w")))) ;; Extra syntax for DSSSL. This isn't separated from Scheme, but ;; shouldn't cause much trouble in scheme-mode. diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 7baa1972c58..da30edf272b 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1498,42 +1498,41 @@ with your script for an edit-interpret-debug cycle." (make-local-variable 'sh-shell-file) (make-local-variable 'sh-shell) - (set (make-local-variable 'skeleton-pair-default-alist) - sh-skeleton-pair-default-alist) - (set (make-local-variable 'skeleton-end-hook) - (lambda () (or (eolp) (newline) (indent-relative)))) - - (set (make-local-variable 'paragraph-start) (concat page-delimiter "\\|$")) - (set (make-local-variable 'paragraph-separate) paragraph-start) - (set (make-local-variable 'comment-start) "# ") - (set (make-local-variable 'comment-start-skip) "#+[\t ]*") - (set (make-local-variable 'local-abbrev-table) sh-mode-abbrev-table) - (set (make-local-variable 'comint-dynamic-complete-functions) - sh-dynamic-complete-functions) + (setq-local skeleton-pair-default-alist + sh-skeleton-pair-default-alist) + (setq-local skeleton-end-hook + (lambda () (or (eolp) (newline) (indent-relative)))) + + (setq-local paragraph-start (concat page-delimiter "\\|$")) + (setq-local paragraph-separate paragraph-start) + (setq-local comment-start "# ") + (setq-local comment-start-skip "#+[\t ]*") + (setq-local local-abbrev-table sh-mode-abbrev-table) + (setq-local comint-dynamic-complete-functions + sh-dynamic-complete-functions) (add-hook 'completion-at-point-functions 'comint-completion-at-point nil t) ;; we can't look if previous line ended with `\' - (set (make-local-variable 'comint-prompt-regexp) "^[ \t]*") - (set (make-local-variable 'imenu-case-fold-search) nil) - (set (make-local-variable 'font-lock-defaults) - `((sh-font-lock-keywords - sh-font-lock-keywords-1 sh-font-lock-keywords-2) - nil nil - ((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w")) nil - (font-lock-syntactic-face-function - . sh-font-lock-syntactic-face-function))) - (set (make-local-variable 'syntax-propertize-function) - #'sh-syntax-propertize-function) + (setq-local comint-prompt-regexp "^[ \t]*") + (setq-local imenu-case-fold-search nil) + (setq font-lock-defaults + `((sh-font-lock-keywords + sh-font-lock-keywords-1 sh-font-lock-keywords-2) + nil nil + ((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w")) nil + (font-lock-syntactic-face-function + . sh-font-lock-syntactic-face-function))) + (setq-local syntax-propertize-function #'sh-syntax-propertize-function) (add-hook 'syntax-propertize-extend-region-functions #'syntax-propertize-multiline 'append 'local) (sh-electric-here-document-mode 1) - (set (make-local-variable 'skeleton-pair-alist) '((?` _ ?`))) - (set (make-local-variable 'skeleton-pair-filter-function) 'sh-quoted-p) - (set (make-local-variable 'skeleton-further-elements) - '((< '(- (min sh-indentation (current-column)))))) - (set (make-local-variable 'skeleton-filter-function) 'sh-feature) - (set (make-local-variable 'skeleton-newline-indent-rigidly) t) - (set (make-local-variable 'defun-prompt-regexp) - (concat "^\\(function[ \t]\\|[[:alnum:]]+[ \t]+()[ \t]+\\)")) + (setq-local skeleton-pair-alist '((?` _ ?`))) + (setq-local skeleton-pair-filter-function 'sh-quoted-p) + (setq-local skeleton-further-elements + '((< '(- (min sh-indentation (current-column)))))) + (setq-local skeleton-filter-function 'sh-feature) + (setq-local skeleton-newline-indent-rigidly t) + (setq-local defun-prompt-regexp + (concat "^\\(function[ \t]\\|[[:alnum:]]+[ \t]+()[ \t]+\\)")) ;; Parse or insert magic number for exec, and set all variables depending ;; on the shell thus determined. (sh-set-shell @@ -2105,19 +2104,19 @@ Calls the value of `sh-set-shell-hook' if set." (executable-set-magic shell (sh-feature sh-shell-arg) no-query-flag insert-flag))) (setq mode-line-process (format "[%s]" sh-shell)) - (set (make-local-variable 'sh-shell-variables) nil) - (set (make-local-variable 'sh-shell-variables-initialized) nil) - (set (make-local-variable 'imenu-generic-expression) - (sh-feature sh-imenu-generic-expression)) + (setq-local sh-shell-variables nil) + (setq-local sh-shell-variables-initialized nil) + (setq-local imenu-generic-expression + (sh-feature sh-imenu-generic-expression)) (let ((tem (sh-feature sh-mode-syntax-table-input))) (when tem - (set (make-local-variable 'sh-mode-syntax-table) - (apply 'sh-mode-syntax-table tem)) + (setq-local sh-mode-syntax-table + (apply 'sh-mode-syntax-table tem)) (set-syntax-table sh-mode-syntax-table))) (dolist (var (sh-feature sh-variables)) (sh-remember-variable var)) - (if (set (make-local-variable 'sh-indent-supported-here) - (sh-feature sh-indent-supported)) + (if (setq-local sh-indent-supported-here + (sh-feature sh-indent-supported)) (progn (message "Setting up indent for shell type %s" sh-shell) (if sh-use-smie @@ -2128,16 +2127,16 @@ Calls the value of `sh-set-shell-hook' if set." (funcall mksym "rules") :forward-token (funcall mksym "forward-token") :backward-token (funcall mksym "backward-token"))) - (set (make-local-variable 'parse-sexp-lookup-properties) t) - (set (make-local-variable 'sh-kw-alist) (sh-feature sh-kw)) + (setq-local parse-sexp-lookup-properties t) + (setq-local sh-kw-alist (sh-feature sh-kw)) (let ((regexp (sh-feature sh-kws-for-done))) (if regexp - (set (make-local-variable 'sh-regexp-for-done) - (sh-mkword-regexpr (regexp-opt regexp t))))) + (setq-local sh-regexp-for-done + (sh-mkword-regexpr (regexp-opt regexp t))))) (message "setting up indent stuff") ;; sh-mode has already made indent-line-function local ;; but do it in case this is called before that. - (set (make-local-variable 'indent-line-function) 'sh-indent-line)) + (setq-local indent-line-function 'sh-indent-line)) (if sh-make-vars-local (sh-make-vars-local)) (message "Indentation setup for shell type %s" sh-shell)) diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 52d29746edf..781aa241802 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -1,4 +1,4 @@ -;;; sql.el --- specialized comint.el for SQL interpreters +;;; sql.el --- specialized comint.el for SQL interpreters -*- lexical-binding: t -*- ;; Copyright (C) 1998-2013 Free Software Foundation, Inc. @@ -80,14 +80,6 @@ ;; Hint for newbies: take a look at `dabbrev-expand', `abbrev-mode', and ;; `imenu-add-menubar-index'. -;;; Requirements for Emacs 19.34: - -;; If you are using Emacs 19.34, you will have to get and install -;; the file regexp-opt.el -;; <URL:ftp://ftp.ifi.uio.no/pub/emacs/emacs-20.3/lisp/emacs-lisp/regexp-opt.el> -;; and the custom package -;; <URL:http://www.dina.kvl.dk/~abraham/custom/>. - ;;; Bugs: ;; sql-ms now uses osql instead of isql. Osql flushes its error @@ -169,15 +161,17 @@ ;; ;; ;; Do something with `sql-user', `sql-password', ;; ;; `sql-database', and `sql-server'. -;; (let ((params options)) -;; (if (not (string= "" sql-server)) -;; (setq params (append (list "-S" sql-server) params))) -;; (if (not (string= "" sql-database)) -;; (setq params (append (list "-D" sql-database) params))) -;; (if (not (string= "" sql-password)) -;; (setq params (append (list "-P" sql-password) params))) +;; (let ((params +;; (append ;; (if (not (string= "" sql-user)) -;; (setq params (append (list "-U" sql-user) params))) +;; (list "-U" sql-user)) +;; (if (not (string= "" sql-password)) +;; (list "-P" sql-password)) +;; (if (not (string= "" sql-database)) +;; (list "-D" sql-database)) +;; (if (not (string= "" sql-server)) +;; (list "-S" sql-server)) +;; options))) ;; (sql-comint product params))) ;; ;; (sql-set-product-feature 'xyz @@ -229,22 +223,13 @@ ;;; Code: +(require 'cl-lib) (require 'comint) ;; Need the following to allow GNU Emacs 19 to compile the file. (eval-when-compile (require 'regexp-opt)) (require 'custom) (require 'thingatpt) -(eval-when-compile ;; needed in Emacs 19, 20 - (setq max-specpdl-size (max max-specpdl-size 2000))) - -(defun sql-signum (n) - "Return 1, 0, or -1 to identify the sign of N." - (cond - ((not (numberp n)) nil) - ((< n 0) -1) - ((> n 0) 1) - (t 0))) (defvar font-lock-keyword-face) (defvar font-lock-set-defaults) @@ -636,12 +621,14 @@ making new SQLi sessions." (set (group (const :tag "Product" sql-product) (choice - ,@(mapcar (lambda (prod-info) - `(const :tag - ,(or (plist-get (cdr prod-info) :name) - (capitalize (symbol-name (car prod-info)))) - (quote ,(car prod-info)))) - sql-product-alist))) + ,@(mapcar + (lambda (prod-info) + `(const :tag + ,(or (plist-get (cdr prod-info) :name) + (capitalize + (symbol-name (car prod-info)))) + (quote ,(car prod-info)))) + sql-product-alist))) (group (const :tag "Username" sql-user) string) (group (const :tag "Password" sql-password) string) (group (const :tag "Server" sql-server) string) @@ -655,8 +642,8 @@ making new SQLi sessions." :group 'SQL) (defcustom sql-product 'ansi - "Select the SQL database product used so that buffers can be -highlighted properly when you open them." + "Select the SQL database product used. +This allows highlighting buffers properly when you open them." :type `(choice ,@(mapcar (lambda (prod-info) `(const :tag @@ -736,15 +723,15 @@ this variable is nil, that buffer is shown using (defvar sql-imenu-generic-expression ;; Items are in reverse order because they are rendered in reverse. - '(("Rules/Defaults" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*\\(rule\\|default\\)\\s-+\\(\\w+\\)" 3) - ("Sequences" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*sequence\\s-+\\(\\w+\\)" 2) - ("Triggers" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*trigger\\s-+\\(\\w+\\)" 2) - ("Functions" "^\\s-*\\(create\\s-+\\(\\w+\\s-+\\)*\\)?function\\s-+\\(\\w+\\)" 3) - ("Procedures" "^\\s-*\\(create\\s-+\\(\\w+\\s-+\\)*\\)?proc\\(edure\\)?\\s-+\\(\\w+\\)" 4) - ("Packages" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*package\\s-+\\(body\\s-+\\)?\\(\\w+\\)" 3) - ("Types" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*type\\s-+\\(body\\s-+\\)?\\(\\w+\\)" 3) - ("Indexes" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*index\\s-+\\(\\w+\\)" 2) - ("Tables/Views" "^\\s-*create\\s-+\\(\\w+\\s-+\\)*\\(table\\|view\\)\\s-+\\(\\w+\\)" 3)) + '(("Rules/Defaults" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*\\(?:rule\\|default\\)\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\s-+\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1) + ("Sequences" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*sequence\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1) + ("Triggers" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*trigger\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1) + ("Functions" "^\\s-*\\(?:create\\s-+\\(?:\\w+\\s-+\\)*\\)?function\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1) + ("Procedures" "^\\s-*\\(?:create\\s-+\\(?:\\w+\\s-+\\)*\\)?proc\\(?:edure\\)?\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1) + ("Packages" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*package\\s-+\\(?:body\\s-+\\)?\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1) + ("Types" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*type\\s-+\\(?:body\\s-+\\)?\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1) + ("Indexes" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*index\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1) + ("Tables/Views" "^\\s-*create\\s-+\\(?:\\w+\\s-+\\)*\\(?:table\\|view\\)\\s-+\\(?:if\\s-+not\\s-+exists\\s-+\\)?\\(\\(?:\\w+\\s-*[.]\\s-*\\)*\\w+\\)" 1)) "Define interesting points in the SQL buffer for `imenu'. This is used to set `imenu-generic-expression' when SQL mode is @@ -818,12 +805,11 @@ for the first time." ;; Customization for ANSI -(defcustom sql-ansi-statement-starters (regexp-opt '( - "create" "alter" "drop" - "select" "insert" "update" "delete" "merge" - "grant" "revoke" -)) - "Regexp of keywords that start SQL commands +(defcustom sql-ansi-statement-starters + (regexp-opt '("create" "alter" "drop" + "select" "insert" "update" "delete" "merge" + "grant" "revoke")) + "Regexp of keywords that start SQL commands. All products share this list; products should define a regexp to identify additional keywords in a variable defined by @@ -1167,10 +1153,10 @@ You can change `sql-prompt-length' on `sql-interactive-mode-hook'.") Used by `sql-rename-buffer'.") (defun sql-buffer-live-p (buffer &optional product connection) - "Returns non-nil if the process associated with buffer is live. + "Return non-nil if the process associated with buffer is live. BUFFER can be a buffer object or a buffer name. The buffer must -be a live buffer, have an running process attached to it, be in +be a live buffer, have a running process attached to it, be in `sql-interactive-mode', and, if PRODUCT or CONNECTION are specified, it's `sql-product' or `sql-connection' must match." @@ -1178,7 +1164,6 @@ specified, it's `sql-product' or `sql-connection' must match." (setq buffer (get-buffer buffer)) (and buffer (buffer-live-p buffer) - (get-buffer-process buffer) (comint-check-proc buffer) (with-current-buffer buffer (and (derived-mode-p 'sql-interactive-mode) @@ -1287,27 +1272,15 @@ Based on `comint-mode-map'.") ;; Abbreviations -- if you want more of them, define them in your init ;; file. Abbrevs have to be enabled in your init file, too. -(defvar sql-mode-abbrev-table nil +(define-abbrev-table 'sql-mode-abbrev-table + '(("ins" "insert" nil nil t) + ("upd" "update" nil nil t) + ("del" "delete" nil nil t) + ("sel" "select" nil nil t) + ("proc" "procedure" nil nil t) + ("func" "function" nil nil t) + ("cr" "create" nil nil t)) "Abbrev table used in `sql-mode' and `sql-interactive-mode'.") -(unless sql-mode-abbrev-table - (define-abbrev-table 'sql-mode-abbrev-table nil)) - -(mapc - ;; In Emacs 22+, provide SYSTEM-FLAG to define-abbrev. - (lambda (abbrev) - (let ((name (car abbrev)) - (expansion (cdr abbrev))) - (condition-case nil - (define-abbrev sql-mode-abbrev-table name expansion nil 0 t) - (error - (define-abbrev sql-mode-abbrev-table name expansion))))) - '(("ins" . "insert") - ("upd" . "update") - ("del" . "delete") - ("sel" . "select") - ("proc" . "procedure") - ("func" . "function") - ("cr" . "create"))) ;; Syntax Table @@ -1339,7 +1312,8 @@ Based on `comint-mode-map'.") "\\(?:\\w+\\s-+\\)*" ;; optional intervening keywords "\\(?:table\\|view\\|\\(?:package\\|type\\)\\(?:\\s-+body\\)?\\|proc\\(?:edure\\)?" "\\|function\\|trigger\\|sequence\\|rule\\|default\\)\\s-+" - "\\(\\w+\\)") + "\\(?:if\\s-+not\\s-+exists\\s-+\\)?" ;; IF NOT EXISTS + "\\(\\w+\\(?:\\s-*[.]\\s-*\\w+\\)*\\)") 1 'font-lock-function-name-face)) "Pattern to match the names of top-level objects. @@ -1529,9 +1503,8 @@ function `regexp-opt'. Therefore, take a look at the source before you define your own `sql-mode-ansi-font-lock-keywords'. You may want to add functions and PL/SQL keywords.") -(defun sql-oracle-show-reserved-words () +(defun sql--oracle-show-reserved-words () ;; This function is for use by the maintainer of SQL.EL only. - (interactive) (if (or (and (not (derived-mode-p 'sql-mode)) (not (derived-mode-p 'sql-interactive-mode))) (not sql-buffer) @@ -1957,7 +1930,7 @@ to add functions and PL/SQL keywords.") ;; Postgres non-reserved words (sql-font-lock-keywords-builder 'font-lock-builtin-face nil "abort" "absolute" "access" "action" "add" "admin" "after" "aggregate" -"also" "alter" "always" "assertion" "assignment" "at" "backward" +"also" "alter" "always" "assertion" "assignment" "at" "attribute" "backward" "before" "begin" "between" "by" "cache" "called" "cascade" "cascaded" "catalog" "chain" "characteristics" "checkpoint" "class" "close" "cluster" "coalesce" "comment" "comments" "commit" "committed" @@ -1968,40 +1941,40 @@ to add functions and PL/SQL keywords.") "delimiters" "dictionary" "disable" "discard" "document" "domain" "drop" "each" "enable" "encoding" "encrypted" "enum" "escape" "exclude" "excluding" "exclusive" "execute" "exists" "explain" -"external" "extract" "family" "first" "float" "following" "force" +"extension" "external" "extract" "family" "first" "float" "following" "force" "forward" "function" "functions" "global" "granted" "greatest" "handler" "header" "hold" "hour" "identity" "if" "immediate" "immutable" "implicit" "including" "increment" "index" "indexes" "inherit" "inherits" "inline" "inout" "input" "insensitive" "insert" -"instead" "invoker" "isolation" "key" "language" "large" "last" -"lc_collate" "lc_ctype" "least" "level" "listen" "load" "local" +"instead" "invoker" "isolation" "key" "label" "language" "large" "last" +"lc_collate" "lc_ctype" "leakproof" "least" "level" "listen" "load" "local" "location" "lock" "login" "mapping" "match" "maxvalue" "minute" -"minvalue" "mode" "month" "move" "name" "names" "national" "nchar" +"minvalue" "mode" "month" "move" "names" "national" "nchar" "next" "no" "nocreatedb" "nocreaterole" "nocreateuser" "noinherit" -"nologin" "none" "nosuperuser" "nothing" "notify" "nowait" "nullif" -"nulls" "object" "of" "oids" "operator" "option" "options" "out" -"overlay" "owned" "owner" "parser" "partial" "partition" "password" -"plans" "position" "preceding" "prepare" "prepared" "preserve" "prior" +"nologin" "none" "noreplication" "nosuperuser" "nothing" "notify" "nowait" "nullif" +"nulls" "object" "of" "off" "oids" "operator" "option" "options" "out" +"overlay" "owned" "owner" "parser" "partial" "partition" "passing" "password" +"plans" "position" "preceding" "precision" "prepare" "prepared" "preserve" "prior" "privileges" "procedural" "procedure" "quote" "range" "read" -"reassign" "recheck" "recursive" "reindex" "relative" "release" -"rename" "repeatable" "replace" "replica" "reset" "restart" "restrict" +"reassign" "recheck" "recursive" "ref" "reindex" "relative" "release" +"rename" "repeatable" "replace" "replica" "replication" "reset" "restart" "restrict" "returns" "revoke" "role" "rollback" "row" "rows" "rule" "savepoint" -"schema" "scroll" "search" "second" "security" "sequence" "sequences" +"schema" "scroll" "search" "second" "security" "sequence" "serializable" "server" "session" "set" "setof" "share" "show" -"simple" "stable" "standalone" "start" "statement" "statistics" +"simple" "snapshot" "stable" "standalone" "start" "statement" "statistics" "stdin" "stdout" "storage" "strict" "strip" "substring" "superuser" "sysid" "system" "tables" "tablespace" "temp" "template" "temporary" -"transaction" "treat" "trigger" "trim" "truncate" "trusted" "type" -"unbounded" "uncommitted" "unencrypted" "unknown" "unlisten" "until" -"update" "vacuum" "valid" "validator" "value" "values" "version" -"view" "volatile" "whitespace" "work" "wrapper" "write" -"xmlattributes" "xmlconcat" "xmlelement" "xmlforest" "xmlparse" -"xmlpi" "xmlroot" "xmlserialize" "year" "yes" +"transaction" "treat" "trim" "truncate" "trusted" "type" "types" +"unbounded" "uncommitted" "unencrypted" "unlisten" "unlogged" "until" +"update" "vacuum" "valid" "validate" "validator" "value" "values" "varying" "version" +"view" "volatile" "whitespace" "without" "work" "wrapper" "write" +"xmlattributes" "xmlconcat" "xmlelement" "xmlexists" "xmlforest" "xmlparse" +"xmlpi" "xmlroot" "xmlserialize" "year" "yes" "zone" ) ;; Postgres Reserved (sql-font-lock-keywords-builder 'font-lock-keyword-face nil -"all" "analyse" "analyze" "and" "any" "array" "asc" "as" "asymmetric" +"all" "analyse" "analyze" "and" "array" "asc" "as" "asymmetric" "authorization" "binary" "both" "case" "cast" "check" "collate" "column" "concurrently" "constraint" "create" "cross" "current_catalog" "current_date" "current_role" "current_schema" @@ -2010,7 +1983,7 @@ to add functions and PL/SQL keywords.") "fetch" "foreign" "for" "freeze" "from" "full" "grant" "group" "having" "ilike" "initially" "inner" "in" "intersect" "into" "isnull" "is" "join" "leading" "left" "like" "limit" "localtime" -"localtimestamp" "natural" "notnull" "not" "null" "off" "offset" +"localtimestamp" "natural" "notnull" "not" "null" "offset" "only" "on" "order" "or" "outer" "overlaps" "over" "placing" "primary" "references" "returning" "right" "select" "session_user" "similar" "some" "symmetric" "table" "then" "to" "trailing" "true" "union" @@ -2018,15 +1991,21 @@ to add functions and PL/SQL keywords.") "with" ) + ;; Postgres PL/pgSQL + (sql-font-lock-keywords-builder 'font-lock-keyword-face nil +"assign" "if" "case" "loop" "while" "for" "foreach" "exit" "elsif" "return" +"raise" "execsql" "dynexecute" "perform" "getdiag" "open" "fetch" "move" "close" +) + ;; Postgres Data Types (sql-font-lock-keywords-builder 'font-lock-type-face nil "bigint" "bigserial" "bit" "bool" "boolean" "box" "bytea" "char" "character" "cidr" "circle" "date" "decimal" "double" "float4" "float8" "inet" "int" "int2" "int4" "int8" "integer" "interval" "line" -"lseg" "macaddr" "money" "numeric" "path" "point" "polygon" -"precision" "real" "serial" "serial4" "serial8" "smallint" "text" +"lseg" "macaddr" "money" "name" "numeric" "path" "point" "polygon" +"precision" "real" "serial" "serial4" "serial8" "sequences" "smallint" "text" "time" "timestamp" "timestamptz" "timetz" "tsquery" "tsvector" -"txid_snapshot" "uuid" "varbit" "varchar" "varying" "without" +"txid_snapshot" "unknown" "uuid" "varbit" "varchar" "varying" "without" "xml" "zone" ))) @@ -2610,14 +2589,12 @@ adds a fontification pattern to fontify identifiers ending in (append keywords old-val)))))) (defun sql-for-each-login (login-params body) - "Iterates through login parameters and returns a list of results." - + "Iterate through login parameters and return a list of results." (delq nil (mapcar (lambda (param) - (let ((token (or (and (listp param) (car param)) param)) - (plist (or (and (listp param) (cdr param)) nil))) - + (let ((token (or (car-safe param) param)) + (plist (cdr-safe param))) (funcall body token plist))) login-params))) @@ -2681,6 +2658,34 @@ matching the regular expression `comint-prompt-regexp', a buffer local variable." (save-excursion (comint-bol nil) (point)))) +;;; SMIE support + +;; Needs a lot more love than I can provide. --Stef + +;; (require 'smie) + +;; (defconst sql-smie-grammar +;; (smie-prec2->grammar +;; (smie-bnf->prec2 +;; ;; Partly based on http://www.h2database.com/html/grammar.html +;; '((cmd ("SELECT" select-exp "FROM" select-table-exp) +;; ) +;; (select-exp ("*") (exp) (exp "AS" column-alias)) +;; (column-alias) +;; (select-table-exp (table-exp "WHERE" exp) (table-exp)) +;; (table-exp) +;; (exp ("CASE" exp "WHEN" exp "THEN" exp "ELSE" exp "END") +;; ("CASE" exp "WHEN" exp "THEN" exp "END")) +;; ;; Random ad-hoc additions. +;; (foo (foo "," foo)) +;; ) +;; '((assoc ","))))) + +;; (defun sql-smie-rules (kind token) +;; (pcase (cons kind token) +;; (`(:list-intro . ,_) t) +;; (`(:before . "(") (smie-rule-parent)))) + ;;; Motion Functions (defun sql-statement-regexp (prod) @@ -2693,7 +2698,7 @@ local variable." "\\>"))) (defun sql-beginning-of-statement (arg) - "Moves the cursor to the beginning of the current SQL statement." + "Move to the beginning of the current SQL statement." (interactive "p") (let ((here (point)) @@ -2720,10 +2725,10 @@ local variable." (beginning-of-line) ;; If we didn't move, try again (when (= here (point)) - (sql-beginning-of-statement (* 2 (sql-signum arg)))))) + (sql-beginning-of-statement (* 2 (cl-signum arg)))))) (defun sql-end-of-statement (arg) - "Moves the cursor to the end of the current SQL statement." + "Move to the end of the current SQL statement." (interactive "p") (let ((term (sql-get-product-feature sql-product :terminator)) (re-search (if (> 0 arg) 're-search-backward 're-search-forward)) @@ -2732,7 +2737,7 @@ local variable." (when (consp term) (setq term (car term))) ;; Iterate until we've moved the desired number of stmt ends - (while (not (= (sql-signum arg) 0)) + (while (not (= (cl-signum arg) 0)) ;; if we're looking at the terminator, jump by 2 (if (or (and (> 0 arg) (looking-back term)) (and (< 0 arg) (looking-at term))) @@ -2743,7 +2748,7 @@ local variable." (setq arg 0) ;; count it if we're not in a comment (unless (nth 7 (syntax-ppss)) - (setq arg (- arg (sql-signum arg)))))) + (setq arg (- arg (cl-signum arg)))))) (goto-char (if (match-data) (match-end 0) here)))) @@ -2802,8 +2807,12 @@ each line with INDENT." doc)) ;;;###autoload -(defun sql-help () - "Show short help for the SQL modes. +(eval + ;; FIXME: This dynamic-docstring-function trick doesn't work for byte-compiled + ;; functions, because of the lazy-loading of docstrings, which strips away + ;; text properties. + '(defun sql-help () + #("Show short help for the SQL modes. Use an entry function to open an interactive SQL buffer. This buffer is usually named `*SQL*'. The name of the major mode is SQLi. @@ -2834,36 +2843,23 @@ anything. The name of the major mode is SQL. In this SQL buffer (SQL mode), you can send the region or the entire buffer to the interactive SQL buffer (SQLi mode). The results are appended to the SQLi buffer without disturbing your SQL buffer." + 0 1 (dynamic-docstring-function sql--make-help-docstring)) (interactive) + (describe-function 'sql-help))) - ;; Insert references to loaded products into the help buffer string - (let ((doc (documentation 'sql-help t)) - changedp) - (setq changedp nil) - - ;; Insert FREE software list - (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]FREE\\s-*\n" doc 0) - (setq doc (replace-match (sql-help-list-products (match-string 1 doc) t) - t t doc 0) - changedp t)) - - ;; Insert non-FREE software list - (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]NONFREE\\s-*\n" doc 0) - (setq doc (replace-match (sql-help-list-products (match-string 1 doc) nil) - t t doc 0) - changedp t)) +(defun sql--make-help-docstring (doc _fun) + "Insert references to loaded products into the help buffer string." - ;; If we changed the help text, save the change so that the help - ;; sub-system will see it - (when changedp - (put 'sql-help 'function-documentation doc))) + ;; Insert FREE software list + (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]FREE\\s-*\n" doc 0) + (setq doc (replace-match (sql-help-list-products (match-string 1 doc) t) + t t doc 0))) - ;; Call help on this function - (describe-function 'sql-help)) - -(defun sql-read-passwd (prompt &optional default) - "Read a password using PROMPT. Optional DEFAULT is password to start with." - (read-passwd prompt nil default)) + ;; Insert non-FREE software list + (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]NONFREE\\s-*\n" doc 0) + (setq doc (replace-match (sql-help-list-products (match-string 1 doc) nil) + t t doc 0))) + doc) (defun sql-get-login-ext (symbol prompt history-var plist) "Prompt user with extended login parameters. @@ -2916,8 +2912,7 @@ value. (The property value is used as the PREDICATE argument to (read-number prompt (or default last-value 0))) (t - (let ((r (read-from-minibuffer prompt-def last-value nil nil history-var nil))) - (if (string= "" r) (or default "") r))))))) + (read-string prompt-def last-value history-var default)))))) (defun sql-get-login (&rest what) "Get username, password and database from the user. @@ -2947,32 +2942,29 @@ supported: In order to ask the user for username, password and database, call the function like this: (sql-get-login 'user 'password 'database)." - (interactive) - (mapcar - (lambda (w) - (let ((token (or (and (consp w) (car w)) w)) - (plist (or (and (consp w) (cdr w)) nil))) + (dolist (w what) + (let ((plist (cdr-safe w))) + (pcase (or (car-safe w) w) + (`user + (sql-get-login-ext 'sql-user "User: " 'sql-user-history plist)) - (cond - ((eq token 'user) ; user - (sql-get-login-ext 'sql-user "User: " 'sql-user-history plist)) - - ((eq token 'password) ; password - (setq-default sql-password - (sql-read-passwd "Password: " sql-password))) + (`password + (setq-default sql-password + (read-passwd "Password: " nil sql-password))) - ((eq token 'server) ; server - (sql-get-login-ext 'sql-server "Server: " 'sql-server-history plist)) + (`server + (sql-get-login-ext 'sql-server "Server: " 'sql-server-history plist)) - ((eq token 'database) ; database - (sql-get-login-ext 'sql-database "Database: " 'sql-database-history plist)) + (`database + (sql-get-login-ext 'sql-database "Database: " + 'sql-database-history plist)) - ((eq token 'port) ; port - (sql-get-login-ext 'sql-port "Port: " nil (append '(:number t) plist)))))) - what)) + (`port + (sql-get-login-ext 'sql-port "Port: " + nil (append '(:number t) plist))))))) (defun sql-find-sqli-buffer (&optional product connection) - "Returns the name of the current default SQLi buffer or nil. + "Return the name of the current default SQLi buffer or nil. In order to qualify, the SQLi buffer must be alive, be in `sql-interactive-mode' and have a process." (let ((buf sql-buffer) @@ -3076,29 +3068,29 @@ server/database name." (sql-for-each-login (sql-get-product-feature sql-product :sqli-login) (lambda (token plist) - (cond - ((eq token 'user) + (pcase token + (`user (unless (string= "" sql-user) (list "/" sql-user))) - ((eq token 'port) + (`port (unless (or (not (numberp sql-port)) (= 0 sql-port)) (list ":" (number-to-string sql-port)))) - ((eq token 'server) + (`server (unless (string= "" sql-server) (list "." (if (plist-member plist :file) (file-name-nondirectory sql-server) sql-server)))) - ((eq token 'database) + (`database (unless (string= "" sql-database) (list "@" (if (plist-member plist :file) (file-name-nondirectory sql-database) sql-database)))) - ((eq token 'password) nil) - (t nil)))))))) + ;; (`password nil) + (_ nil)))))))) ;; If there's a connection, use it and the name thus far (if sql-connection @@ -3227,9 +3219,6 @@ Every newline in STRING will be preceded with a space and a backslash." Allows the suppression of continuation prompts.") -(defvar sql-output-by-send nil - "Non-nil if the command in the input was generated by `sql-send-string'.") - (defun sql-input-sender (proc string) "Send STRING to PROC after applying filters." @@ -3296,8 +3285,7 @@ to avoid deleting non-prompt output." (if (= sql-output-newline-count 0) (setq sql-output-newline-count nil - oline (concat "\n" oline) - sql-output-by-send nil) + oline (concat "\n" oline)) (setq sql-preoutput-hold oline oline "")) @@ -3391,8 +3379,7 @@ to avoid deleting non-prompt output." (setq sql-output-newline-count (if sql-output-newline-count (1+ sql-output-newline-count) - 1))) - (setq sql-output-by-send t))) + 1))))) (defun sql-remove-tabs-filter (str) "Replace tab characters with spaces." @@ -3531,7 +3518,7 @@ for each match." (nreverse results))) (defun sql-execute (sqlbuf outbuf command enhanced arg) - "Executes a command in a SQL interactive buffer and captures the output. + "Execute a command in a SQL interactive buffer and capture the output. The commands are run in SQLBUF and the output saved in OUTBUF. COMMAND must be a string, a function or a list of such elements. @@ -3539,7 +3526,7 @@ Functions are called with SQLBUF, OUTBUF and ARG as parameters; strings are formatted with ARG and executed. If the results are empty the OUTBUF is deleted, otherwise the -buffer is popped into a view window. " +buffer is popped into a view window." (mapc (lambda (c) (cond @@ -3604,43 +3591,35 @@ The list is maintained in SQL interactive buffers.") (defvar sql-completion-sqlbuf nil) -(defun sql-try-completion (string collection &optional predicate) +(defun sql--completion-table (string pred action) (when sql-completion-sqlbuf - (with-current-buffer sql-completion-sqlbuf - (let ((schema (and (string-match "\\`\\(\\sw\\(:?\\sw\\|\\s_\\)*\\)[.]" string) - (downcase (match-string 1 string))))) - - ;; If we haven't loaded any object name yet, load local schema - (unless sql-completion-object - (sql-build-completions nil)) - - ;; If they want another schema, load it if we haven't yet - (when schema - (let ((schema-dot (concat schema ".")) - (schema-len (1+ (length schema))) - (names sql-completion-object) - has-schema) - - (while (and (not has-schema) names) - (setq has-schema (and - (>= (length (car names)) schema-len) - (string= schema-dot - (downcase (substring (car names) - 0 schema-len)))) - names (cdr names))) - (unless has-schema - (sql-build-completions schema))))) - - ;; Try to find the completion - (cond - ((not predicate) - (try-completion string sql-completion-object)) - ((eq predicate t) - (all-completions string sql-completion-object)) - ((eq predicate 'lambda) - (test-completion string sql-completion-object)) - ((eq (car predicate) 'boundaries) - (completion-boundaries string sql-completion-object nil (cdr predicate))))))) + (with-current-buffer sql-completion-sqlbuf + (let ((schema (and (string-match "\\`\\(\\sw\\(:?\\sw\\|\\s_\\)*\\)[.]" string) + (downcase (match-string 1 string))))) + + ;; If we haven't loaded any object name yet, load local schema + (unless sql-completion-object + (sql-build-completions nil)) + + ;; If they want another schema, load it if we haven't yet + (when schema + (let ((schema-dot (concat schema ".")) + (schema-len (1+ (length schema))) + (names sql-completion-object) + has-schema) + + (while (and (not has-schema) names) + (setq has-schema (and + (>= (length (car names)) schema-len) + (string= schema-dot + (downcase (substring (car names) + 0 schema-len)))) + names (cdr names))) + (unless has-schema + (sql-build-completions schema))))) + + ;; Try to find the completion + (complete-with-action action sql-completion-object string pred)))) (defun sql-read-table-name (prompt) "Read the name of a database table." @@ -3656,7 +3635,7 @@ The list is maintained in SQL interactive buffers.") (completion-ignore-case t)) (if (sql-get-product-feature product :completion-object) - (completing-read prompt (function sql-try-completion) + (completing-read prompt #'sql--completion-table nil nil tname) (read-from-minibuffer prompt tname)))) @@ -3724,6 +3703,7 @@ must tell Emacs. Here's how to do that in your init file: (if sql-mode-menu (easy-menu-add sql-mode-menu)); XEmacs + ;; (smie-setup sql-smie-grammar #'sql-smie-rules) (set (make-local-variable 'comment-start) "--") ;; Make each buffer in sql-mode remember the "current" SQLi buffer. (make-local-variable 'sql-buffer) @@ -3737,7 +3717,7 @@ must tell Emacs. Here's how to do that in your init file: (set (make-local-variable 'paragraph-separate) "[\f]*$") (set (make-local-variable 'paragraph-start) "[\n\f]") ;; Abbrevs - (setq abbrev-all-caps 1) + (setq-local abbrev-all-caps 1) ;; Contains the name of database objects (set (make-local-variable 'sql-contains-names) t) ;; Catch changes to sql-product and highlight accordingly @@ -3872,7 +3852,6 @@ you entered, right above the output it created. (sql-get-product-feature sql-product :prompt-cont-regexp)) (make-local-variable 'sql-output-newline-count) (make-local-variable 'sql-preoutput-hold) - (make-local-variable 'sql-output-by-send) (add-hook 'comint-preoutput-filter-functions 'sql-interactive-remove-continuation-prompt nil t) (make-local-variable 'sql-input-ring-separator) @@ -3945,7 +3924,7 @@ is specified in the connection settings." ;; Was one selected (when connection ;; Get connection settings - (let ((connect-set (assoc connection sql-connection-alist))) + (let ((connect-set (assoc-string connection sql-connection-alist t))) ;; Settings are defined (if connect-set ;; Set the desired parameters @@ -3963,13 +3942,13 @@ is specified in the connection settings." (setq set-params (mapcar (lambda (v) - (cond - ((eq (car v) 'sql-user) 'user) - ((eq (car v) 'sql-password) 'password) - ((eq (car v) 'sql-server) 'server) - ((eq (car v) 'sql-database) 'database) - ((eq (car v) 'sql-port) 'port) - (t (car v)))) + (pcase (car v) + (`sql-user 'user) + (`sql-password 'password) + (`sql-server 'server) + (`sql-database 'database) + (`sql-port 'port) + (s s))) (cdr connect-set))) ;; the remaining params (w/o the connection params) @@ -3988,7 +3967,7 @@ is specified in the connection settings." ;; Start the SQLi session with revised list of login parameters (eval `(let ((,param-var ',rem-params)) - (sql-product-interactive sql-product new-name)))) + (sql-product-interactive ',sql-product ',new-name)))) (message "SQL Connection <%s> does not exist" connection) nil))) @@ -4032,16 +4011,16 @@ optionally is saved to the user's init file." (if (assoc name alist) (message "Connection <%s> already exists" name) (setq connect - (append (list name) - (sql-for-each-login - `(product ,@login) - (lambda (token _plist) - (cond - ((eq token 'product) `(sql-product ',product)) - ((eq token 'user) `(sql-user ,user)) - ((eq token 'database) `(sql-database ,database)) - ((eq token 'server) `(sql-server ,server)) - ((eq token 'port) `(sql-port ,port))))))) + (cons name + (sql-for-each-login + `(product ,@login) + (lambda (token _plist) + (pcase token + (`product `(sql-product ',product)) + (`user `(sql-user ,user)) + (`database `(sql-database ,database)) + (`server `(sql-server ,server)) + (`port `(sql-port ,port))))))) (setq alist (append alist (list connect))) @@ -4051,7 +4030,7 @@ optionally is saved to the user's init file." (customize-set-variable 'sql-connection-alist alist))))))) (defun sql-connection-menu-filter (tail) - "Generates menu entries for using each connection." + "Generate menu entries for using each connection." (append (mapcar (lambda (conn) @@ -4118,7 +4097,8 @@ the call to \\[sql-product-interactive] with new-sqli-buffer) ;; Get credentials. - (apply 'sql-get-login (sql-get-product-feature product :sqli-login)) + (apply #'sql-get-login + (sql-get-product-feature product :sqli-login)) ;; Connect to database. (message "Login...") @@ -4148,9 +4128,17 @@ the call to \\[sql-product-interactive] with (setq sql-buffer (buffer-name new-sqli-buffer)) (run-hooks 'sql-set-sqli-hook))) + ;; Make sure the connection is complete + ;; (Sometimes start up can be slow) + ;; and call the login hook + (let ((proc (get-buffer-process new-sqli-buffer))) + (while (and (memq (process-status proc) '(open run)) + (accept-process-output proc 2.5) + (progn (goto-char (point-max)) + (not (looking-back sql-prompt-regexp)))))) + (run-hooks 'sql-login-hook) ;; All done. (message "Login...done") - (run-hooks 'sql-login-hook) (pop-to-buffer new-sqli-buffer))))) (message "No default SQL product defined. Set `sql-product'."))) @@ -4216,7 +4204,7 @@ The default comes from `process-coding-system-alist' and ;; is meaningless; database without user/password is meaningless, ;; because "@param" will ask sqlplus to interpret the script ;; "param". - (let ((parameter nil)) + (let (parameter nlslang coding) (if (not (string= "" sql-user)) (if (not (string= "" sql-password)) (setq parameter (concat sql-user "/" sql-password)) @@ -4226,10 +4214,32 @@ The default comes from `process-coding-system-alist' and (if parameter (setq parameter (nconc (list parameter) options)) (setq parameter options)) - (sql-comint product parameter))) + (sql-comint product parameter) + ;; Set process coding system to agree with the interpreter + (setq nlslang (or (getenv "NLS_LANG") "") + coding (dolist (cs + ;; Are we missing any common NLS character sets + '(("US8PC437" . cp437) + ("EL8PC737" . cp737) + ("WE8PC850" . cp850) + ("EE8PC852" . cp852) + ("TR8PC857" . cp857) + ("WE8PC858" . cp858) + ("IS8PC861" . cp861) + ("IW8PC1507" . cp862) + ("N8PC865" . cp865) + ("RU8PC866" . cp866) + ("US7ASCII" . us-ascii) + ("UTF8" . utf-8) + ("AL32UTF8" . utf-8) + ("AL16UTF16" . utf-16)) + (or coding 'utf-8)) + (when (string-match (format "\\.%s\\'" (car cs)) nlslang) + (setq coding (cdr cs))))) + (set-buffer-process-coding-system coding coding))) (defun sql-oracle-save-settings (sqlbuf) - "Saves most SQL*Plus settings so they may be reset by \\[sql-redirect]." + "Save most SQL*Plus settings so they may be reset by \\[sql-redirect]." ;; Note: does not capture the following settings: ;; ;; APPINFO @@ -4301,7 +4311,7 @@ The default comes from `process-coding-system-alist' and ;; Restore the changed settings (sql-redirect sqlbuf saved-settings)) -(defun sql-oracle-list-all (sqlbuf outbuf enhanced table-name) +(defun sql-oracle-list-all (sqlbuf outbuf enhanced _table-name) ;; Query from USER_OBJECTS or ALL_OBJECTS (let ((settings (sql-oracle-save-settings sqlbuf)) (simple-sql @@ -4340,7 +4350,7 @@ The default comes from `process-coding-system-alist' and (sql-oracle-restore-settings sqlbuf settings))) -(defun sql-oracle-list-table (sqlbuf outbuf enhanced table-name) +(defun sql-oracle-list-table (sqlbuf outbuf _enhanced table-name) "Implements :list-table under Oracle." (let ((settings (sql-oracle-save-settings sqlbuf))) @@ -4417,15 +4427,17 @@ The default comes from `process-coding-system-alist' and "Create comint buffer and connect to Sybase." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. - (let ((params options)) - (if (not (string= "" sql-server)) - (setq params (append (list "-S" sql-server) params))) - (if (not (string= "" sql-database)) - (setq params (append (list "-D" sql-database) params))) - (if (not (string= "" sql-password)) - (setq params (append (list "-P" sql-password) params))) - (if (not (string= "" sql-user)) - (setq params (append (list "-U" sql-user) params))) + (let ((params + (append + (if (not (string= "" sql-user)) + (list "-U" sql-user)) + (if (not (string= "" sql-password)) + (list "-P" sql-password)) + (if (not (string= "" sql-database)) + (list "-D" sql-database)) + (if (not (string= "" sql-server)) + (list "-S" sql-server)) + options))) (sql-comint product params))) @@ -4510,14 +4522,13 @@ The default comes from `process-coding-system-alist' and "Create comint buffer and connect to SQLite." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. - (let ((params)) - (if (not (string= "" sql-database)) - (setq params (append (list (expand-file-name sql-database)) - params))) - (setq params (append options params)) + (let ((params + (append options + (if (not (string= "" sql-database)) + `(,(expand-file-name sql-database)))))) (sql-comint product params))) -(defun sql-sqlite-completion-object (sqlbuf schema) +(defun sql-sqlite-completion-object (sqlbuf _schema) (sql-redirect-value sqlbuf ".tables" "\\sw\\(?:\\sw\\|\\s_\\)*" 0)) @@ -4560,18 +4571,19 @@ The default comes from `process-coding-system-alist' and "Create comint buffer and connect to MySQL." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. - (let ((params)) - (if (not (string= "" sql-database)) - (setq params (append (list sql-database) params))) - (if (not (string= "" sql-server)) - (setq params (append (list (concat "--host=" sql-server)) params))) - (if (not (= 0 sql-port)) - (setq params (append (list (concat "--port=" (number-to-string sql-port))) params))) - (if (not (string= "" sql-password)) - (setq params (append (list (concat "--password=" sql-password)) params))) - (if (not (string= "" sql-user)) - (setq params (append (list (concat "--user=" sql-user)) params))) - (setq params (append options params)) + (let ((params + (append + options + (if (not (string= "" sql-user)) + (list (concat "--user=" sql-user))) + (if (not (string= "" sql-password)) + (list (concat "--password=" sql-password))) + (if (not (= 0 sql-port)) + (list (concat "--port=" (number-to-string sql-port)))) + (if (not (string= "" sql-server)) + (list (concat "--host=" sql-server))) + (if (not (string= "" sql-database)) + (list sql-database))))) (sql-comint product params))) @@ -4611,13 +4623,15 @@ The default comes from `process-coding-system-alist' and "Create comint buffer and connect to Solid." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. - (let ((params options)) - ;; It only makes sense if both username and password are there. - (if (not (or (string= "" sql-user) - (string= "" sql-password))) - (setq params (append (list sql-user sql-password) params))) - (if (not (string= "" sql-server)) - (setq params (append (list sql-server) params))) + (let ((params + (append + (if (not (string= "" sql-server)) + (list sql-server)) + ;; It only makes sense if both username and password are there. + (if (not (or (string= "" sql-user) + (string= "" sql-password))) + (list sql-user sql-password)) + options))) (sql-comint product params))) @@ -4699,22 +4713,25 @@ The default comes from `process-coding-system-alist' and "Create comint buffer and connect to Microsoft SQL Server." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. - (let ((params options)) - (if (not (string= "" sql-server)) - (setq params (append (list "-S" sql-server) params))) - (if (not (string= "" sql-database)) - (setq params (append (list "-d" sql-database) params))) - (if (not (string= "" sql-user)) - (setq params (append (list "-U" sql-user) params))) - (if (not (string= "" sql-password)) - (setq params (append (list "-P" sql-password) params)) - (if (string= "" sql-user) - ;; if neither user nor password is provided, use system - ;; credentials. - (setq params (append (list "-E") params)) - ;; If -P is passed to ISQL as the last argument without a - ;; password, it's considered null. - (setq params (append params (list "-P"))))) + (let ((params + (append + (if (not (string= "" sql-user)) + (list "-U" sql-user)) + (if (not (string= "" sql-database)) + (list "-d" sql-database)) + (if (not (string= "" sql-server)) + (list "-S" sql-server)) + options))) + (setq params + (if (not (string= "" sql-password)) + `("-P" ,sql-password ,@params) + (if (string= "" sql-user) + ;; If neither user nor password is provided, use system + ;; credentials. + `("-E" ,@params) + ;; If -P is passed to ISQL as the last argument without a + ;; password, it's considered null. + `(,@params "-P")))) (sql-comint product params))) @@ -4758,48 +4775,58 @@ Try to set `comint-output-filter-functions' like this: (defun sql-comint-postgres (product options) "Create comint buffer and connect to Postgres." - ;; username and password are ignored. Mark Stosberg suggest to add - ;; the database at the end. Jason Beegan suggest using --pset and + ;; username and password are ignored. Mark Stosberg suggests to add + ;; the database at the end. Jason Beegan suggests using --pset and ;; pager=off instead of \\o|cat. The later was the solution by ;; Gregor Zych. Jason's suggestion is the default value for ;; sql-postgres-options. - (let ((params options)) - (if (not (string= "" sql-database)) - (setq params (append params (list sql-database)))) - (if (not (string= "" sql-server)) - (setq params (append (list "-h" sql-server) params))) - (if (not (string= "" sql-user)) - (setq params (append (list "-U" sql-user) params))) - (if (not (= 0 sql-port)) - (setq params (append (list "-p" (number-to-string sql-port)) params))) + (let ((params + (append + (if (not (= 0 sql-port)) + (list "-p" (number-to-string sql-port))) + (if (not (string= "" sql-user)) + (list "-U" sql-user)) + (if (not (string= "" sql-server)) + (list "-h" sql-server)) + options + (if (not (string= "" sql-database)) + (list sql-database))))) (sql-comint product params))) (defun sql-postgres-completion-object (sqlbuf schema) - (let (cl re fs a r) - (sql-redirect sqlbuf "\\t on") - (setq a (car (sql-redirect-value sqlbuf "\\a" "Output format is \\(.*\\)[.]$" 1))) - (when (string= a "aligned") - (sql-redirect sqlbuf "\\a")) - (setq fs (or (car (sql-redirect-value sqlbuf "\\f" "Field separator is \"\\(.\\)[.]$" 1)) "|")) - - (setq re (concat "^\\([^" fs "]*\\)" fs "\\([^" fs "]*\\)" fs "[^" fs "]*" fs "[^" fs "]*$")) - (setq cl (if (not schema) - (sql-redirect-value sqlbuf "\\d" re '(1 2)) - (append (sql-redirect-value sqlbuf (format "\\dt %s.*" schema) re '(1 2)) - (sql-redirect-value sqlbuf (format "\\dv %s.*" schema) re '(1 2)) - (sql-redirect-value sqlbuf (format "\\ds %s.*" schema) re '(1 2))))) - - ;; Restore tuples and alignment to what they were - (sql-redirect sqlbuf "\\t off") - (when (not (string= a "aligned")) + (sql-redirect sqlbuf "\\t on") + (let ((aligned + (string= "aligned" + (car (sql-redirect-value + sqlbuf "\\a" + "Output format is \\(.*\\)[.]$" 1))))) + (when aligned (sql-redirect sqlbuf "\\a")) - - ;; Return the list of table names (public schema name can be omitted) - (mapcar (lambda (tbl) - (if (string= (car tbl) "public") - (cadr tbl) - (format "%s.%s" (car tbl) (cadr tbl)))) - cl))) + (let* ((fs (or (car (sql-redirect-value + sqlbuf "\\f" "Field separator is \"\\(.\\)[.]$" 1)) + "|")) + (re (concat "^\\([^" fs "]*\\)" fs "\\([^" fs "]*\\)" + fs "[^" fs "]*" fs "[^" fs "]*$")) + (cl (if (not schema) + (sql-redirect-value sqlbuf "\\d" re '(1 2)) + (append (sql-redirect-value + sqlbuf (format "\\dt %s.*" schema) re '(1 2)) + (sql-redirect-value + sqlbuf (format "\\dv %s.*" schema) re '(1 2)) + (sql-redirect-value + sqlbuf (format "\\ds %s.*" schema) re '(1 2)))))) + + ;; Restore tuples and alignment to what they were. + (sql-redirect sqlbuf "\\t off") + (when (not aligned) + (sql-redirect sqlbuf "\\a")) + + ;; Return the list of table names (public schema name can be omitted) + (mapcar (lambda (tbl) + (if (string= (car tbl) "public") + (cadr tbl) + (format "%s.%s" (car tbl) (cadr tbl)))) + cl)))) @@ -4838,13 +4865,15 @@ The default comes from `process-coding-system-alist' and "Create comint buffer and connect to Interbase." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. - (let ((params options)) - (if (not (string= "" sql-user)) - (setq params (append (list "-u" sql-user) params))) - (if (not (string= "" sql-password)) - (setq params (append (list "-p" sql-password) params))) - (if (not (string= "" sql-database)) - (setq params (cons sql-database params))) ; add to the front! + (let ((params + (append + (if (not (string= "" sql-database)) + (list sql-database)) ; Add to the front! + (if (not (string= "" sql-password)) + (list "-p" sql-password)) + (if (not (string= "" sql-user)) + (list "-u" sql-user)) + options))) (sql-comint product params))) @@ -4926,19 +4955,18 @@ buffer. "Create comint buffer and connect to Linter." ;; Put all parameters to the program (if defined) in a list and call ;; make-comint. - (let ((params options) - (login nil) - (old-mbx (getenv "LINTER_MBX"))) - (if (not (string= "" sql-user)) - (setq login (concat sql-user "/" sql-password))) - (setq params (append (list "-u" login) params)) - (if (not (string= "" sql-server)) - (setq params (append (list "-n" sql-server) params))) - (if (string= "" sql-database) - (setenv "LINTER_MBX" nil) - (setenv "LINTER_MBX" sql-database)) - (sql-comint product params) - (setenv "LINTER_MBX" old-mbx))) + (let* ((login + (if (not (string= "" sql-user)) + (concat sql-user "/" sql-password))) + (params + (append + (if (not (string= "" sql-server)) + (list "-n" sql-server)) + (list "-u" login) + options))) + (cl-letf (((getenv "LINTER_MBX") + (unless (string= "" sql-database) sql-database))) + (sql-comint product params)))) diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 0279319cc89..edfe368479c 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -290,7 +290,7 @@ If no function name is found, return nil." (when (and (null name) (boundp 'imenu--index-alist) (null imenu--index-alist) (null which-function-imenu-failed)) - (imenu--make-index-alist t) + (ignore-errors (imenu--make-index-alist t)) (unless imenu--index-alist (set (make-local-variable 'which-function-imenu-failed) t))) ;; If we have an index alist, use it. @@ -319,7 +319,9 @@ If no function name is found, return nil." namestack (cons (car pair) namestack) alist (cdr pair))) - ((number-or-marker-p (setq mark (cdr pair))) + ((or (number-or-marker-p (setq mark (cdr pair))) + (and (overlayp mark) + (setq mark (overlay-start mark)))) (when (and (>= (setq offset (- (point) mark)) 0) (< offset minoffset)) ; Find the closest item. (setq minoffset offset diff --git a/lisp/ps-print.el b/lisp/ps-print.el index 99f22df4107..f7c03c2de85 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -1959,13 +1959,13 @@ Valid values are: Any other value is treated as nil. -If you set `ps-selected-pages' (see it for documentation), first the pages are -filtered by `ps-selected-pages' and then by `ps-even-or-odd-pages'. For -example, if we have: +If you set option `ps-selected-pages', first the pages are +filtered by option `ps-selected-pages' and then by `ps-even-or-odd-pages'. +For example, if we have: (setq ps-selected-pages '(1 4 (6 . 10) (12 . 16) 20)) -Combining with `ps-even-or-odd-pages' and `ps-n-up-printing', we have: +Combining with `ps-even-or-odd-pages' and option `ps-n-up-printing', we have: `ps-n-up-printing' = 1: `ps-even-or-odd-pages' PAGES PRINTED @@ -3566,9 +3566,9 @@ Use the command `ps-despool' to send the spooled images to the printer." ;;;###autoload (defun ps-spool-buffer-with-faces () "Generate and spool a PostScript image of the buffer. -Like `ps-spool-buffer', but includes font, color, and underline information in -the generated image. This command works only if you are using a window system, -so it has a way to determine color values. +Like the command `ps-spool-buffer', but includes font, color, and underline +information in the generated image. This command works only if you are using +a window system, so it has a way to determine color values. Use the command `ps-despool' to send the spooled images to the printer." (interactive) @@ -5369,7 +5369,7 @@ Each element has the following form: (KIND XCOL YCOL XLIN YLIN REPEAT END XSTART YSTART) Where: -KIND is a valid value of `ps-n-up-filling'. +KIND is a valid value of the variable `ps-n-up-filling'. XCOL YCOL are the relative position for the next column. XLIN YLIN are the relative position for the beginning of next line. REPEAT is the number of repetitions for external loop. diff --git a/lisp/server.el b/lisp/server.el index 4a871576091..64224d2a310 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -361,7 +361,7 @@ Updates `server-clients'." (defconst server-buffer " *server*" "Buffer used internally by Emacs's server. -One use is to log the I/O for debugging purposes (see `server-log'), +One use is to log the I/O for debugging purposes (see option `server-log'), the other is to provide a current buffer in which the process filter can safely let-bind buffer-local variables like `default-directory'.") @@ -369,7 +369,7 @@ safely let-bind buffer-local variables like `default-directory'.") "If non-nil, log the server's inputs and outputs in the `server-buffer'.") (defun server-log (string &optional client) - "If `server-log' is non-nil, log STRING to `server-buffer'. + "If option `server-log' is non-nil, log STRING to `server-buffer'. If CLIENT is non-nil, add a description of it to the logged message." (when server-log (with-current-buffer (get-buffer-create server-buffer) @@ -1257,12 +1257,17 @@ The following commands are accepted by the client: (mapc 'funcall (nreverse commands)) ;; If we were told only to open a new client, obey - ;; `initial-buffer-choice' if it specifies a file. - (unless (or files commands) - (if (stringp initial-buffer-choice) - (find-file initial-buffer-choice) - (switch-to-buffer (get-buffer-create "*scratch*") - 'norecord))) + ;; `initial-buffer-choice' if it specifies a file + ;; or a function. + (unless (or files commands) + (let ((buf + (cond ((stringp initial-buffer-choice) + (find-file-noselect initial-buffer-choice)) + ((functionp initial-buffer-choice) + (funcall initial-buffer-choice))))) + (switch-to-buffer + (if (buffer-live-p buf) buf (get-buffer-create "*scratch*")) + 'norecord))) ;; Delete the client if necessary. (cond diff --git a/lisp/ses.el b/lisp/ses.el index 552c09bb47e..bf88364456f 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -278,6 +278,7 @@ default printer and then modify its output.") ses--default-printer ses--deferred-narrow ses--deferred-recalc ses--deferred-write ses--file-format + ses--named-cell-hashmap (ses--header-hscroll . -1) ; Flag for "initial recalc needed" ses--header-row ses--header-string ses--linewidth ses--numcols ses--numrows ses--symbolic-formulas @@ -511,9 +512,22 @@ PROPERTY-NAME." `(aref ses--col-printers ,col)) (defmacro ses-sym-rowcol (sym) - "From a cell-symbol SYM, gets the cons (row . col). A1 => (0 . 0). -Result is nil if SYM is not a symbol that names a cell." - `(and (symbolp ,sym) (get ,sym 'ses-cell))) + "From a cell-symbol SYM, gets the cons (row . col). A1 => (0 . 0). Result +is nil if SYM is not a symbol that names a cell." + `(let ((rc (and (symbolp ,sym) (get ,sym 'ses-cell)))) + (if (eq rc :ses-named) + (gethash ,sym ses--named-cell-hashmap) + rc))) + +(defun ses-is-cell-sym-p (sym) + "Check whether SYM point at a cell of this spread sheet." + (let ((rowcol (get sym 'ses-cell))) + (and rowcol + (if (eq rowcol :ses-named) + (and ses--named-cell-hashmap (gethash sym ses--named-cell-hashmap)) + (and (< (car rowcol) ses--numrows) + (< (cdr rowcol) ses--numcols) + (eq (ses-cell-symbol (car rowcol) (cdr rowcol)) sym)))))) (defmacro ses-cell (sym value formula printer references) "Load a cell SYM from the spreadsheet file. Does not recompute VALUE from @@ -682,6 +696,28 @@ for this spreadsheet." "Produce a symbol that names the cell (ROW,COL). (0,0) => 'A1." (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." + (let (case-fold-search) + (and (string-match "\\`\\([A-Z]+\\)\\([0-9]+\\)\\'" str) + (let* ((col-str (match-string-no-properties 1 str)) + (col 0) + (col-offset 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)) + col-base (* col-base 26) + col-idx (1- col-idx)) + (and (>= col-idx 0) + (setq col (+ col col-base))))) + (cons row col))))))) + (defun ses-create-cell-variable-range (minrow maxrow mincol maxcol) "Create buffer-local variables for cells. This is undoable." (push `(apply ses-destroy-cell-variable-range ,minrow ,maxrow ,mincol ,maxcol) @@ -704,7 +740,11 @@ row and column of the cell, with numbering starting from 0. Return nil in case of failure." (unless (local-variable-p sym) (make-local-variable sym) - (put sym 'ses-cell (cons row col)))) + (if (let (case-fold-search) (string-match "\\`[A-Z]+[0-9]+\\'" (symbol-name sym))) + (put sym 'ses-cell (cons row col)) + (put sym 'ses-cell :ses-named) + (setq ses--named-cell-hashmap (or ses--named-cell-hashmap (make-hash-table :test 'eq))) + (puthash sym (cons row col) ses--named-cell-hashmap)))) ;; We do not delete the ses-cell properties for the cell-variables, in ;; case a formula that refers to this cell is in the kill-ring and is @@ -2678,8 +2718,9 @@ inserts a new row if at bottom of print area. Repeat COUNT times." ;; Cut and paste, import and export ;;---------------------------------------------------------------------------- -(defadvice copy-region-as-kill (around ses-copy-region-as-kill - activate preactivate) +(defun ses--advice-copy-region-as-kill (crak-fun beg end &rest args) + ;; FIXME: Why doesn't it make sense to copy read-only or + ;; intangible attributes? They're removed upon yank! "It doesn't make sense to copy read-only or intangible attributes into the kill ring. It probably doesn't make sense to copy keymap properties. We'll assume copying front-sticky properties doesn't make sense, either. @@ -2690,14 +2731,15 @@ hard to override how mouse-1 works." (let ((temp beg)) (setq beg end end temp))) - (if (not (and (eq major-mode 'ses-mode) + (if (not (and (derived-mode-p 'ses-mode) (eq (get-text-property beg 'read-only) 'ses) (eq (get-text-property (1- end) 'read-only) 'ses))) - ad-do-it ; Normal copy-region-as-kill. + (apply crak-fun beg end args) ; Normal copy-region-as-kill. (kill-new (ses-copy-region beg end)) (if transient-mark-mode (setq deactivate-mark t)) nil)) +(advice-add 'copy-region-as-kill :around #'ses--advice-copy-region-as-kill) (defun ses-copy-region (beg end) "Treat the region as rectangular. Convert the intangible attributes to @@ -2761,7 +2803,7 @@ We clear the killed cells instead of deleting them." (ses-clear-cell row col)) (ses-jump (car ses--curcell))) -(defadvice yank (around ses-yank activate preactivate) +(defun ses--advice-yank (yank-fun &optional arg &rest args) "In SES mode, the yanked text is inserted as cells. If the text contains 'ses attributes (meaning it went to the kill-ring from a @@ -2779,9 +2821,9 @@ When inserting formulas, the text is treated as a string constant if it doesn't make sense as a sexp or would otherwise be considered a symbol. Use 'sym to explicitly insert a symbol, or use the C-u prefix to treat all unmarked words as symbols." - (if (not (and (eq major-mode 'ses-mode) + (if (not (and (derived-mode-p 'ses-mode) (eq (get-text-property (point) 'keymap) 'ses-mode-print-map))) - ad-do-it ; Normal non-SES yank. + (apply yank-fun arg args) ; Normal non-SES yank. (ses-check-curcell 'end) (push-mark (point)) (let ((text (current-kill (cond @@ -2799,6 +2841,7 @@ as symbols." arg))) (if (consp arg) (exchange-point-and-mark)))) +(advice-add 'yank :around #'ses--advice-yank) (defun ses-yank-pop (arg) "Replace just-yanked stretch of killed text with a different stretch. @@ -3211,27 +3254,36 @@ highlighted range in the spreadsheet." (defun ses-rename-cell (new-name &optional cell) "Rename current cell." (interactive "*SEnter new name: ") - (and (local-variable-p new-name) - (ses-sym-rowcol new-name) - ;; this test is needed because ses-cell property of deleted cells - ;; is not deleted in case of subsequent undo - (memq new-name ses--renamed-cell-symb-list) - (error "Already a cell name")) - (and (boundp new-name) - (null (yes-or-no-p (format "`%S' is already bound outside this buffer, continue? " - new-name))) - (error "Already a bound cell name")) - (let* ((sym (if (ses-cell-p cell) + (or + (and (local-variable-p new-name) + (ses-is-cell-sym-p new-name) + (error "Already a cell name")) + (and (boundp new-name) + (null (yes-or-no-p (format "`%S' is already bound outside this buffer, continue? " + new-name))) + (error "Already a bound cell name"))) + (let* (curcell + (sym (if (ses-cell-p cell) (ses-cell-symbol cell) - (setq cell nil) + (setq cell nil + curcell t) (ses-check-curcell) ses--curcell)) (rowcol (ses-sym-rowcol sym)) (row (car rowcol)) - (col (cdr rowcol))) - (setq cell (or cell (ses-get-cell row col))) - (push `(ses-rename-cell ,(ses-cell-symbol cell) ,cell) buffer-undo-list) - (put new-name 'ses-cell rowcol) + (col (cdr rowcol)) + new-rowcol old-name) + (setq cell (or cell (ses-get-cell row col)) + old-name (ses-cell-symbol cell) + new-rowcol (ses-decode-cell-symbol (symbol-name new-name))) + (if new-rowcol + (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))) + (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 (dolist (ref (ses-cell-references cell)) (let* ((x (ses-sym-rowcol ref)) @@ -3251,9 +3303,8 @@ highlighted range in the spreadsheet." (push new-name ses--renamed-cell-symb-list) (set new-name (symbol-value sym)) (aset cell 0 new-name) - (put sym 'ses-cell nil) (makunbound sym) - (setq sym new-name) + (and curcell (setq ses--curcell new-name)) (let* ((pos (point)) (inhibit-read-only t) (col (current-column)) @@ -3265,7 +3316,7 @@ highlighted range in the spreadsheet." (put-text-property pos end 'intangible new-name)) ;; update mode line (setq mode-line-process (list " cell " - (symbol-name sym))) + (symbol-name new-name))) (force-mode-line-update))) ;;---------------------------------------------------------------------------- @@ -3538,10 +3589,9 @@ current column and continues until the next nonblank column." (defun ses-unload-function () "Unload the Simple Emacs Spreadsheet." - (dolist (fun '(copy-region-as-kill yank)) - (ad-remove-advice fun 'around (intern (concat "ses-" (symbol-name fun)))) - (ad-update fun)) - ;; continue standard unloading + (advice-remove 'yank #'ses--advice-yank) + (advice-remove 'copy-region-as-kill #'ses--advice-copy-region-as-kill) + ;; Continue standard unloading. nil) (provide 'ses) diff --git a/lisp/shell.el b/lisp/shell.el index d79ca363a0f..d09d7aee43f 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -562,10 +562,8 @@ buffer." ;; very inefficient in Shell buffers (e.g. Bug#10835). We use a ;; custom `ansi-color-apply-face-function' to convert color escape ;; sequences into `font-lock-face' properties. - (set (make-local-variable 'ansi-color-apply-face-function) - (lambda (beg end face) - (when face - (put-text-property beg end 'font-lock-face face)))) + (setq-local ansi-color-apply-face-function #'shell-apply-ansi-color) + (shell-reapply-ansi-color) ;; This is not really correct, since the shell buffer does not really ;; edit this directory. But it is useful in the buffer list and menus. @@ -604,6 +602,27 @@ buffer." 'shell-filter-ctrl-a-ctrl-b nil t))) (comint-read-input-ring t))) +(defun shell-apply-ansi-color (beg end face) + "Apply FACE as the ansi-color face for the text between BEG and END." + (when face + (put-text-property beg end 'ansi-color-face face) + (put-text-property beg end 'font-lock-face face))) + +(defun shell-reapply-ansi-color () + "Reapply ansi-color faces to the existing contents of the buffer." + (save-restriction + (widen) + (let* ((pos (point-min)) + (end (or (next-single-property-change pos 'ansi-color-face) + (point-max))) + face) + (while end + (if (setq face (get-text-property pos 'ansi-color-face)) + (put-text-property pos (or end (point-max)) + 'font-lock-face face)) + (setq pos end + end (next-single-property-change pos 'ansi-color-face)))))) + (defun shell-filter-ctrl-a-ctrl-b (string) "Remove `^A' and `^B' characters from comint output. @@ -672,7 +691,12 @@ Otherwise, one argument `-i' is passed to the shell. (and current-prefix-arg (prog1 (read-buffer "Shell buffer: " - (generate-new-buffer-name "*shell*")) + ;; If the current buffer is an inactive + ;; shell buffer, use it as the default. + (if (and (eq major-mode 'shell-mode) + (null (get-buffer-process (current-buffer)))) + (buffer-name) + (generate-new-buffer-name "*shell*"))) (if (file-remote-p default-directory) ;; It must be possible to declare a local default-directory. ;; FIXME: This can't be right: it changes the default-directory diff --git a/lisp/simple.el b/lisp/simple.el index 57307baad8c..847c07a5c26 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1,4 +1,4 @@ -;;; simple.el --- basic editing commands for Emacs +;;; simple.el --- basic editing commands for Emacs -*- lexical-binding: t -*- ;; Copyright (C) 1985-1987, 1993-2013 Free Software Foundation, Inc. @@ -401,7 +401,7 @@ Other major modes are defined by comparison with this one." (defun newline (&optional arg) "Insert a newline, and move to left margin of the new line if it's blank. -If `use-hard-newlines' is non-nil, the newline is marked with the +If option `use-hard-newlines' is non-nil, the newline is marked with the text-property `hard'. With ARG, insert that many newlines. Call `auto-fill-function' if the current column number is greater @@ -752,7 +752,7 @@ If N is negative, delete newlines as well, leaving -N spaces." (n (abs n))) (skip-chars-backward skip-characters) (constrain-to-field nil orig-pos) - (dotimes (i n) + (dotimes (_ n) (if (= (following-char) ?\s) (forward-char 1) (insert ?\s))) @@ -837,7 +837,7 @@ instead of deleted." "Delete the previous N characters (following if N is negative). If Transient Mark mode is enabled, the mark is active, and N is 1, delete the text in the region and deactivate the mark instead. -To disable this, set `delete-active-region' to nil. +To disable this, set option `delete-active-region' to nil. Optional second arg KILLFLAG, if non-nil, means to kill (save in kill ring) instead of delete. Interactively, N is the prefix @@ -873,7 +873,7 @@ the end of the line." "Delete the following N characters (previous if N is negative). If Transient Mark mode is enabled, the mark is active, and N is 1, delete the text in the region and deactivate the mark instead. -To disable this, set `delete-active-region' to nil. +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 @@ -1778,7 +1778,7 @@ Intended to be added to `minibuffer-setup-hook'." If there are no search errors, this function displays an overlay with the isearch prompt which replaces the original minibuffer prompt. Otherwise, it displays the standard isearch message returned from -`isearch-message'." +the function `isearch-message'." (if (not (and (minibufferp) isearch-success (not isearch-error))) ;; Use standard function `isearch-message' when not in the minibuffer, ;; or search fails, or has an error (like incomplete regexp). @@ -1815,8 +1815,9 @@ or to the last history element for a backward search." "Save a function restoring the state of minibuffer history search. Save `minibuffer-history-position' to the additional state parameter in the search status stack." - `(lambda (cmd) - (minibuffer-history-isearch-pop-state cmd ,minibuffer-history-position))) + (let ((pos minibuffer-history-position)) + (lambda (cmd) + (minibuffer-history-isearch-pop-state cmd pos)))) (defun minibuffer-history-isearch-pop-state (_cmd hist-pos) "Restore the minibuffer history search state. @@ -1981,6 +1982,117 @@ then call `undo-more' one or more times to undo them." (if (null pending-undo-list) (setq pending-undo-list t)))) +(defun primitive-undo (n list) + "Undo N records from the front of the list LIST. +Return what remains of the list." + + ;; This is a good feature, but would make undo-start + ;; unable to do what is expected. + ;;(when (null (car (list))) + ;; ;; If the head of the list is a boundary, it is the boundary + ;; ;; preceding this command. Get rid of it and don't count it. + ;; (setq list (cdr list)))) + + (let ((arg n) + ;; In a writable buffer, enable undoing read-only text that is + ;; so because of text properties. + (inhibit-read-only t) + ;; Don't let `intangible' properties interfere with undo. + (inhibit-point-motion-hooks t) + ;; We use oldlist only to check for EQ. ++kfs + (oldlist buffer-undo-list) + (did-apply nil) + (next nil)) + (while (> arg 0) + (while (setq next (pop list)) ;Exit inner loop at undo boundary. + ;; Handle an integer by setting point to that value. + (pcase next + ((pred integerp) (goto-char next)) + ;; Element (t . TIME) records previous modtime. + ;; Preserve any flag of NONEXISTENT_MODTIME_NSECS or + ;; UNKNOWN_MODTIME_NSECS. + (`(t . ,time) + ;; If this records an obsolete save + ;; (not matching the actual disk file) + ;; then don't mark unmodified. + (when (or (equal time (visited-file-modtime)) + (and (consp time) + (equal (list (car time) (cdr time)) + (visited-file-modtime)))) + (when (fboundp 'unlock-buffer) + (unlock-buffer)) + (set-buffer-modified-p nil))) + ;; Element (nil PROP VAL BEG . END) is property change. + (`(nil . ,(or `(,prop ,val ,beg . ,end) pcase--dontcare)) + (when (or (> (point-min) beg) (< (point-max) end)) + (error "Changes to be undone are outside visible portion of buffer")) + (put-text-property beg end prop val)) + ;; Element (BEG . END) means range was inserted. + (`(,(and beg (pred integerp)) . ,(and end (pred integerp))) + ;; (and `(,beg . ,end) `(,(pred integerp) . ,(pred integerp))) + ;; Ideally: `(,(pred integerp beg) . ,(pred integerp end)) + (when (or (> (point-min) beg) (< (point-max) end)) + (error "Changes to be undone are outside visible portion of buffer")) + ;; Set point first thing, so that undoing this undo + ;; does not send point back to where it is now. + (goto-char beg) + (delete-region beg end)) + ;; Element (apply FUN . ARGS) means call FUN to undo. + (`(apply . ,fun-args) + (let ((currbuff (current-buffer))) + (if (integerp (car fun-args)) + ;; Long format: (apply DELTA START END FUN . ARGS). + (pcase-let* ((`(,delta ,start ,end ,fun . ,args) fun-args) + (start-mark (copy-marker start nil)) + (end-mark (copy-marker end t))) + (when (or (> (point-min) start) (< (point-max) end)) + (error "Changes to be undone are outside visible portion of buffer")) + (apply fun args) ;; Use `save-current-buffer'? + ;; Check that the function did what the entry + ;; said it would do. + (unless (and (= start start-mark) + (= (+ delta end) end-mark)) + (error "Changes to be undone by function different than announced")) + (set-marker start-mark nil) + (set-marker end-mark nil)) + (apply fun-args)) + (unless (eq currbuff (current-buffer)) + (error "Undo function switched buffer")) + (setq did-apply t))) + ;; Element (STRING . POS) means STRING was deleted. + (`(,(and string (pred stringp)) . ,(and pos (pred integerp))) + (when (let ((apos (abs pos))) + (or (< apos (point-min)) (> apos (point-max)))) + (error "Changes to be undone are outside visible portion of buffer")) + (if (< pos 0) + (progn + (goto-char (- pos)) + (insert string)) + (goto-char pos) + ;; Now that we record marker adjustments + ;; (caused by deletion) for undo, + ;; we should always insert after markers, + ;; so that undoing the marker adjustments + ;; put the markers back in the right place. + (insert string) + (goto-char pos))) + ;; (MARKER . OFFSET) means a marker MARKER was adjusted by OFFSET. + (`(,(and marker (pred markerp)) . ,(and offset (pred integerp))) + (when (marker-buffer marker) + (set-marker marker + (- marker offset) + (marker-buffer marker)))) + (_ (error "Unrecognized entry in undo list %S" next)))) + (setq arg (1- arg))) + ;; Make sure an apply entry produces at least one undo entry, + ;; so the test in `undo' for continuing an undo series + ;; will work right. + (if (and did-apply + (eq oldlist buffer-undo-list)) + (setq buffer-undo-list + (cons (list 'apply 'cdr nil) buffer-undo-list)))) + list) + ;; Deep copy of a list (defun undo-copy-list (list) "Make a copy of undo list LIST." @@ -2806,7 +2918,7 @@ value passed." (or lc infile) (if stderr-file (list (car buffer) stderr-file) buffer) display args) - (when stderr-file (copy-file stderr-file (cadr buffer))))) + (when stderr-file (copy-file stderr-file (cadr buffer) t)))) (when stderr-file (delete-file stderr-file)) (when lc (delete-file lc))))) @@ -3372,6 +3484,7 @@ to make one entry in the kill ring." (kill-new string nil yank-handler))) (when (or string (eq last-command 'kill-region)) (setq this-command 'kill-region)) + (setq deactivate-mark t) nil) ((buffer-read-only text-read-only) ;; The code above failed because the buffer, or some of the characters @@ -3692,7 +3805,7 @@ If `show-trailing-whitespace' is non-nil, this command will just kill the rest of the current line, even if there are only nonblanks there. -If `kill-whole-line' is non-nil, then this command kills the whole line +If option `kill-whole-line' is non-nil, then this command kills the whole line including its terminating newline, when used at the beginning of a line with no argument. As a consequence, you can always kill a whole line by typing \\[move-beginning-of-line] \\[kill-line]. @@ -4014,7 +4127,8 @@ run `deactivate-mark-hook'." (when (mark t) (setq mark-active t) (unless transient-mark-mode - (setq transient-mark-mode 'lambda)))) + (setq transient-mark-mode 'lambda)) + (run-hooks 'activate-mark-hook))) (defun set-mark (pos) "Set this buffer's mark to POS. Don't use this function! @@ -4135,15 +4249,6 @@ after C-u \\[set-mark-command]." :type 'boolean :group 'editing-basics) -(defcustom set-mark-default-inactive nil - "If non-nil, setting the mark does not activate it. -This option does the same thing as disabling Transient Mark mode, -and it will be removed in the near future." - :type 'boolean - :group 'editing-basics - :version "23.1") -(make-obsolete-variable 'set-mark-default-inactive nil "24.3") - (defun set-mark-command (arg) "Set the mark where point is, or jump to the mark. Setting the mark also alters the region, which is the text @@ -4205,8 +4310,7 @@ purposes. See the documentation of `set-mark' for more information." (activate-mark) (message "Mark activated"))) (t - (push-mark-command nil) - (if set-mark-default-inactive (deactivate-mark))))) + (push-mark-command nil)))) (defun push-mark (&optional location nomsg activate) "Set mark at LOCATION (point, by default) and push old mark on mark ring. @@ -4270,7 +4374,6 @@ mode temporarily." (deactivate-mark) (set-mark (point)) (goto-char omark) - (if set-mark-default-inactive (deactivate-mark)) (cond (temp-highlight (setq transient-mark-mode (cons 'only transient-mark-mode))) ((or (and arg (region-active-p)) ; (xor arg (not (region-active-p))) @@ -4472,13 +4575,13 @@ to use and more reliable (no dependence on goal column, etc.)." "Non-nil means vertical motion starting at end of line keeps to ends of lines. This means moving to the end of each line moved onto. The beginning of a blank line does not count as the end of a line. -This has no effect when `line-move-visual' is non-nil." +This has no effect when the variable `line-move-visual' is non-nil." :type 'boolean :group 'editing-basics) (defcustom goal-column nil "Semipermanent goal column for vertical motion, as set by \\[set-goal-column], or nil. -A non-nil setting overrides `line-move-visual', which see." +A non-nil setting overrides the variable `line-move-visual', which see." :type '(choice integer (const :tag "None" nil)) :group 'editing-basics) @@ -4489,7 +4592,7 @@ A non-nil setting overrides `line-move-visual', which see." It is the column where point was at the start of the current run of vertical motion commands. -When moving by visual lines via `line-move-visual', it is a cons +When moving by visual lines via the function `line-move-visual', it is a cons cell (COL . HSCROLL), where COL is the x-position, in pixels, divided by the default column width, and HSCROLL is the number of columns by which window is scrolled from left margin. @@ -5311,14 +5414,21 @@ current object." (setq pos1 pos2 pos2 swap))) (if (> (cdr pos1) (car pos2)) (error "Don't have two things to transpose")) (atomic-change-group - (let (word2) - ;; FIXME: We first delete the two pieces of text, so markers that - ;; used to point to after the text end up pointing to before it :-( - (setq word2 (delete-and-extract-region (car pos2) (cdr pos2))) - (goto-char (car pos2)) - (insert (delete-and-extract-region (car pos1) (cdr pos1))) - (goto-char (car pos1)) - (insert word2)))) + ;; This sequence of insertions attempts to preserve marker + ;; positions at the start and end of the transposed objects. + (let* ((word (buffer-substring (car pos2) (cdr pos2))) + (len1 (- (cdr pos1) (car pos1))) + (len2 (length word)) + (boundary (make-marker))) + (set-marker boundary (car pos2)) + (goto-char (cdr pos1)) + (insert-before-markers word) + (setq word (delete-and-extract-region (car pos1) (+ (car pos1) len1))) + (goto-char boundary) + (insert word) + (goto-char (+ boundary len1)) + (delete-region (point) (+ (point) len2)) + (set-marker boundary nil)))) (defun backward-word (&optional arg) "Move backward until encountering the beginning of a word. diff --git a/lisp/sort.el b/lisp/sort.el index 47632148598..56e97061d13 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -567,6 +567,62 @@ From a program takes two point or marker arguments, BEG and END." (setq ll (cdr ll))) (insert (car ll))))) +;;;###autoload +(defun delete-duplicate-lines (beg end &optional reverse adjacent interactive) + "Delete duplicate lines in the region between BEG and END. + +If REVERSE is nil, search and delete duplicates forward keeping the first +occurrence of duplicate lines. If REVERSE is non-nil (when called +interactively with C-u prefix), search and delete duplicates backward +keeping the last occurrence of duplicate lines. + +If ADJACENT is non-nil (when called interactively with two C-u prefixes), +delete repeated lines only if they are adjacent. It works like the utility +`uniq' and is useful when lines are already sorted in a large file since +this is more efficient in performance and memory usage than when ADJACENT +is nil that uses additional memory to remember previous lines. + +When called from Lisp and INTERACTIVE is omitted or nil, return the number +of deleted duplicate lines, do not print it; if INTERACTIVE is t, the +function behaves in all respects as if it had been called interactively." + (interactive + (progn + (barf-if-buffer-read-only) + (list (region-beginning) (region-end) + (equal current-prefix-arg '(4)) + (equal current-prefix-arg '(16)) + t))) + (let ((lines (unless adjacent (make-hash-table :weakness 'key :test 'equal))) + line prev-line + (count 0) + (beg (copy-marker beg)) + (end (copy-marker end))) + (save-excursion + (goto-char (if reverse end beg)) + (if (and reverse (bolp)) (forward-char -1)) + (while (if reverse + (and (> (point) beg) (not (bobp))) + (and (< (point) end) (not (eobp)))) + (setq line (buffer-substring-no-properties + (line-beginning-position) (line-end-position))) + (if (if adjacent (equal line prev-line) (gethash line lines)) + (progn + (delete-region (progn (forward-line 0) (point)) + (progn (forward-line 1) (point))) + (if reverse (forward-line -1)) + (setq count (1+ count))) + (if adjacent (setq prev-line line) (puthash line t lines)) + (forward-line (if reverse -1 1))))) + (set-marker beg nil) + (set-marker end nil) + (when interactive + (message "Deleted %d %sduplicate line%s%s" + count + (if adjacent "adjacent " "") + (if (= count 1) "" "s") + (if reverse " backward" ""))) + count)) + (provide 'sort) ;;; sort.el ends here diff --git a/lisp/speedbar.el b/lisp/speedbar.el index a0e5f617a24..70bf5f41518 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -3608,6 +3608,7 @@ functions to do caching and flushing if appropriate." nil (eval-when-compile (condition-case nil (require 'imenu) (error nil))) +(declare-function imenu--make-index-alist "imenu" (&optional no-error)) (defun speedbar-fetch-dynamic-imenu (file) "Load FILE into a buffer, and generate tags using Imenu. diff --git a/lisp/startup.el b/lisp/startup.el index aaba900b028..5406c0f6513 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -42,9 +42,10 @@ (defcustom initial-buffer-choice nil "Buffer to show after starting Emacs. If the value is nil and `inhibit-startup-screen' is nil, show the -startup screen. If the value is a string, visit the specified file -or directory using `find-file'. If t, open the `*scratch*' -buffer. +startup screen. If the value is a string, switch to a buffer +visiting the file or directory specified by that string. If the +value is a function, switch to the buffer returned by that +function. If t, open the `*scratch*' buffer. A string value also causes emacsclient to open the specified file or directory when no target file is specified." @@ -52,8 +53,9 @@ or directory when no target file is specified." (const :tag "Startup screen" nil) (directory :tag "Directory" :value "~/") (file :tag "File" :value "~/.emacs") + (function :tag "Function") (const :tag "Lisp scratch buffer" t)) - :version "23.1" + :version "24.4" :group 'initialization) (defcustom inhibit-startup-screen nil @@ -1570,27 +1572,24 @@ a face or button specification." :face '(variable-pitch (:height 0.8)) emacs-copyright "\n") - (and auto-save-list-file-prefix - ;; Don't signal an error if the - ;; directory for auto-save-list files - ;; does not yet exist. - (file-directory-p (file-name-directory - auto-save-list-file-prefix)) - (directory-files - (file-name-directory auto-save-list-file-prefix) - nil - (concat "\\`" - (regexp-quote (file-name-nondirectory - auto-save-list-file-prefix))) - t) - (fancy-splash-insert :face '(variable-pitch font-lock-comment-face) - "\nIf an Emacs session crashed recently, " - "type " - :face '(fixed-pitch font-lock-comment-face) - "Meta-x recover-session RET" - :face '(variable-pitch font-lock-comment-face) - "\nto recover" - " the files you were editing.")) + (when auto-save-list-file-prefix + (let ((dir (file-name-directory auto-save-list-file-prefix)) + (name (file-name-nondirectory auto-save-list-file-prefix)) + files) + ;; Don't warn if the directory for auto-save-list files does not + ;; yet exist. + (and (file-directory-p dir) + (setq files (directory-files dir nil (concat "\\`" name) t)) + (fancy-splash-insert :face '(variable-pitch font-lock-comment-face) + (if (= (length files) 1) + "\nAn auto-save file list was found. " + "\nAuto-save file lists were found. ") + "If an Emacs session crashed recently,\ntype " + :link `("M-x recover-session RET" + ,(lambda (_button) + (call-interactively + 'recover-session))) + " to recover the files you were editing.")))) (when concise (fancy-splash-insert @@ -2327,10 +2326,14 @@ A fancy display is used on graphic displays, normal otherwise." (set-buffer-modified-p nil)))) (when initial-buffer-choice - (cond ((eq initial-buffer-choice t) - (switch-to-buffer (get-buffer-create "*scratch*"))) - ((stringp initial-buffer-choice) - (find-file initial-buffer-choice)))) + (let ((buf + (cond ((stringp initial-buffer-choice) + (find-file-noselect initial-buffer-choice)) + ((functionp initial-buffer-choice) + (funcall initial-buffer-choice))))) + (switch-to-buffer + (if (buffer-live-p buf) buf (get-buffer-create "*scratch*")) + 'norecord))) (if (or inhibit-startup-screen initial-buffer-choice diff --git a/lisp/subr.el b/lisp/subr.el index eef8c46c7d6..e1ab5298409 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -195,11 +195,6 @@ value of last one, or nil if there are none. (declare (indent 1) (debug t)) (cons 'if (cons cond (cons nil body)))) -(if (null (featurep 'cl)) - (progn - ;; If we reload subr.el after having loaded CL, be careful not to - ;; overwrite CL's extended definition of `dolist', `dotimes', `declare'. - (defmacro dolist (spec &rest body) "Loop over a list. Evaluate BODY with VAR bound to each car from LIST, in turn. @@ -222,9 +217,7 @@ Then evaluate RESULT to get return value, default nil. (let ((,(car spec) (car ,temp))) ,@body (setq ,temp (cdr ,temp)))) - ,@(if (cdr (cdr spec)) - ;; FIXME: This let often leads to "unused var" warnings. - `((let ((,(car spec) nil)) ,@(cdr (cdr spec)))))) + ,@(cdr (cdr spec))) `(let ((,temp ,(nth 1 spec)) ,(car spec)) (while ,temp @@ -281,7 +274,6 @@ The possible values of SPECS are specified by `defun-declarations-alist' and `macro-declarations-alist'." ;; FIXME: edebug spec should pay attention to defun-declarations-alist. nil) -)) (defmacro ignore-errors (&rest body) "Execute BODY; if an error occurs, return nil. @@ -1199,8 +1191,6 @@ is converted into a string by expressing it in decimal." (make-obsolete 'unfocus-frame "it does nothing." "22.1") (make-obsolete 'make-variable-frame-local "explicitly check for a frame-parameter instead." "22.2") -(make-obsolete 'interactive-p 'called-interactively-p "23.2") -(set-advertised-calling-convention 'called-interactively-p '(kind) "23.1") (set-advertised-calling-convention 'all-completions '(string collection &optional predicate) "23.1") (set-advertised-calling-convention 'unintern '(name obarray) "23.3") @@ -2638,7 +2628,7 @@ This variable is meaningful on MS-DOG and MS-Windows. On those systems, it is automatically local in every buffer. On other systems, this variable is normally always nil. -WARNING: This variable is obsolete and will disapper Real Soon Now. +WARNING: This variable is obsolete and will disappear Real Soon Now. Don't use it!") ;; The `assert' macro from the cl package signals @@ -2658,13 +2648,17 @@ See also `locate-user-emacs-file'.") (defun locate-user-emacs-file (new-name &optional old-name) "Return an absolute per-user Emacs-specific file name. -If OLD-NAME is non-nil and ~/OLD-NAME exists, return ~/OLD-NAME. +If NEW-NAME exists in `user-emacs-directory', return it. +Else If OLD-NAME is non-nil and ~/OLD-NAME exists, return ~/OLD-NAME. Else return NEW-NAME in `user-emacs-directory', creating the directory if it does not exist." (convert-standard-filename (let* ((home (concat "~" (or init-file-user ""))) - (at-home (and old-name (expand-file-name old-name home)))) - (if (and at-home (file-readable-p at-home)) + (at-home (and old-name (expand-file-name old-name home))) + (bestname (abbreviate-file-name + (expand-file-name new-name user-emacs-directory)))) + (if (and at-home (not (file-readable-p bestname)) + (file-readable-p at-home)) at-home ;; Make sure `user-emacs-directory' exists, ;; unless we're in batch mode or dumping Emacs @@ -2678,8 +2672,7 @@ directory if it does not exist." (set-default-file-modes ?\700) (make-directory user-emacs-directory)) (set-default-file-modes umask)))) - (abbreviate-file-name - (expand-file-name new-name user-emacs-directory)))))) + bestname)))) ;;;; Misc. useful functions. @@ -2809,6 +2802,12 @@ Otherwise, return nil." Otherwise, return nil." (and (memq object '(nil t)) t)) +(defun special-form-p (object) + "Non-nil if and only if OBJECT is a special form." + (if (and (symbolp object) (fboundp object)) + (setq object (indirect-function object t))) + (and (subrp object) (eq (cdr (subr-arity object)) 'unevalled))) + (defun field-at-pos (pos) "Return the field at position POS, taking stickiness etc into account." (let ((raw-field (get-char-property (field-beginning pos) 'field))) @@ -3368,16 +3367,17 @@ If BODY finishes, `while-no-input' returns whatever value BODY produced." (progn ,@body))))))) (defmacro condition-case-unless-debug (var bodyform &rest handlers) - "Like `condition-case' except that it does not catch anything when debugging. -More specifically if `debug-on-error' is set, then it does not catch any signal." + "Like `condition-case' except that it does not prevent debugging. +More specifically if `debug-on-error' is set then the debugger will be invoked +even if this catches the signal." (declare (debug condition-case) (indent 2)) - (let ((bodysym (make-symbol "body"))) - `(let ((,bodysym (lambda () ,bodyform))) - (if debug-on-error - (funcall ,bodysym) - (condition-case ,var - (funcall ,bodysym) - ,@handlers))))) + `(condition-case ,var + ,bodyform + ,@(mapcar (lambda (handler) + `((debug ,@(if (listp (car handler)) (car handler) + (list (car handler)))) + ,@(cdr handler))) + handlers))) (define-obsolete-function-alias 'condition-case-no-debug 'condition-case-unless-debug "24.1") @@ -3848,7 +3848,7 @@ This is used on the `modification-hooks' property of text clones." (if (not (re-search-forward (overlay-get ol1 'text-clone-syntax) cend t)) ;; Mark the overlay for deletion. - (overlay-put ol1 'text-clones nil) + (setq end cbeg) (when (< (match-end 0) cend) ;; Shrink the clone at its end. (setq end (min end (match-end 0))) @@ -3963,6 +3963,152 @@ The properties used on SYMBOL are `composefunc', `sendfunc', (put symbol 'abortfunc (or abortfunc 'kill-buffer)) (put symbol 'hookvar (or hookvar 'mail-send-hook))) +(defvar called-interactively-p-functions nil + "Special hook called to skip special frames in `called-interactively-p'. +The functions are called with 3 arguments: (I FRAME1 FRAME2), +where FRAME1 is a \"current frame\", FRAME2 is the next frame, +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).") + +(defmacro internal--called-interactively-p--get-frame (n) + ;; `sym' will hold a global variable, which will be used kind of like C's + ;; "static" variables. + (let ((sym (make-symbol "base-index"))) + `(progn + (defvar ,sym + (let ((i 1)) + (while (not (eq (indirect-function (nth 1 (backtrace-frame i)) t) + (indirect-function 'called-interactively-p))) + (setq i (1+ i))) + i)) + ;; (unless (eq (nth 1 (backtrace-frame ,sym)) 'called-interactively-p) + ;; (error "called-interactively-p: %s is out-of-sync!" ,sym)) + (backtrace-frame (+ ,sym ,n))))) + +(defun called-interactively-p (&optional kind) + "Return t if the containing function was called by `call-interactively'. +If KIND is `interactive', then only return t if the call was made +interactively by the user, i.e. not in `noninteractive' mode nor +when `executing-kbd-macro'. +If KIND is `any', on the other hand, it will return t for any kind of +interactive call, including being called as the binding of a key or +from a keyboard macro, even in `noninteractive' mode. + +This function is very brittle, it may fail to return the intended result when +the code is debugged, advised, or instrumented in some form. Some macros and +special forms (such as `condition-case') may also sometimes wrap their bodies +in a `lambda', so any call to `called-interactively-p' from those bodies will +indicate whether that lambda (rather than the surrounding function) was called +interactively. + +Instead of using this function, it is cleaner and more reliable to give your +function an extra optional argument whose `interactive' spec specifies +non-nil unconditionally (\"p\" is a good way to do this), or via +\(not (or executing-kbd-macro noninteractive)). + +The only known proper use of `interactive' for KIND is in deciding +whether to display a helpful message, or how to display it. If you're +thinking of using it for any other purpose, it is quite likely that +you're making a mistake. Think: what do you want to do when the +command is called from a keyboard macro?" + (declare (advertised-calling-convention (kind) "23.1")) + (when (not (and (eq kind 'interactive) + (or executing-kbd-macro noninteractive))) + (let* ((i 1) ;; 0 is the called-interactively-p frame. + frame nextframe + (get-next-frame + (lambda () + (setq frame nextframe) + (setq nextframe (internal--called-interactively-p--get-frame i)) + ;; (message "Frame %d = %S" i nextframe) + (setq i (1+ i))))) + (funcall get-next-frame) ;; Get the first frame. + (while + ;; FIXME: The edebug and advice handling should be made modular and + ;; provided directly by edebug.el and nadvice.el. + (progn + ;; frame =(backtrace-frame i-2) + ;; nextframe=(backtrace-frame i-1) + (funcall get-next-frame) + ;; `pcase' would be a fairly good fit here, but it sometimes moves + ;; branches within local functions, which then messes up the + ;; `backtrace-frame' data we get, + (or + ;; Skip special forms (from non-compiled code). + (and frame (null (car frame))) + ;; Skip also `interactive-p' (because we don't want to know if + ;; interactive-p was called interactively but if it's caller was) + ;; and `byte-code' (idem; this appears in subexpressions of things + ;; like condition-case, which are wrapped in a separate bytecode + ;; chunk). + ;; FIXME: For lexical-binding code, this is much worse, + ;; because the frames look like "byte-code -> funcall -> #[...]", + ;; which is not a reliable signature. + (memq (nth 1 frame) '(interactive-p 'byte-code)) + ;; Skip package-specific stack-frames. + (let ((skip (run-hook-with-args-until-success + 'called-interactively-p-functions + i frame nextframe))) + (pcase skip + (`nil nil) + (`0 t) + (_ (setq i (+ i skip -1)) (funcall get-next-frame))))))) + ;; Now `frame' should be "the function from which we were called". + (pcase (cons frame nextframe) + ;; No subr calls `interactive-p', so we can rule that out. + (`((,_ ,(pred (lambda (f) (subrp (indirect-function f)))) . ,_) . ,_) nil) + ;; Somehow, I sometimes got `command-execute' rather than + ;; `call-interactively' on my stacktrace !? + ;;(`(,_ . (t command-execute . ,_)) t) + (`(,_ . (t call-interactively . ,_)) t))))) + +(defun interactive-p () + "Return t if the containing function was run directly by user input. +This means that the function was called with `call-interactively' +\(which includes being called as the binding of a key) +and input is currently coming from the keyboard (not a keyboard macro), +and Emacs is not running in batch mode (`noninteractive' is nil). + +The only known proper use of `interactive-p' is in deciding whether to +display a helpful message, or how to display it. If you're thinking +of using it for any other purpose, it is quite likely that you're +making a mistake. Think: what do you want to do when the command is +called from a keyboard macro or in batch mode? + +To test whether your function was called with `call-interactively', +either (i) add an extra optional argument and give it an `interactive' +spec that specifies non-nil unconditionally (such as \"p\"); or (ii) +use `called-interactively-p'." + (declare (obsolete called-interactively-p "23.2")) + (called-interactively-p 'interactive)) + +(defun function-arity (f &optional num) + "Return the (MIN . MAX) arity of F. +If the maximum arity is infinite, MAX is `many'. +F can be a function or a macro. +If NUM is non-nil, return non-nil iff F can be called with NUM args." + (if (symbolp f) (setq f (indirect-function f))) + (if (eq (car-safe f) 'macro) (setq f (cdr f))) + (let ((res + (if (subrp f) + (let ((x (subr-arity f))) + (if (eq (cdr x) 'unevalled) (cons (car x) 'many))) + (let* ((args (if (consp f) (cadr f) (aref f 0))) + (max (length args)) + (opt (memq '&optional args)) + (rest (memq '&rest args)) + (min (- max (length opt)))) + (if opt + (cons min (if rest 'many (1- max))) + (if rest + (cons (- max (length rest)) 'many) + (cons min max))))))) + (if (not num) + res + (and (>= num (car res)) + (or (eq 'many (cdr res)) (<= num (cdr res))))))) + (defun set-temporary-overlay-map (map &optional keep-pred) "Set MAP as a temporary keymap taking precedence over most other keymaps. Note that this does NOT take precedence over the \"overriding\" maps @@ -4178,6 +4324,36 @@ convenience wrapper around `make-progress-reporter' and friends. nil ,@(cdr (cdr spec))))) +;;;; Support for watching filesystem events. + +(defun inotify-event-p (event) + "Check if EVENT is an inotify event." + (and (listp event) + (>= (length event) 3) + (eq (car event) 'file-inotify))) + +;;;###autoload +(defun inotify-handle-event (event) + "Handle inotify file system monitoring event. +If EVENT is an inotify filewatch event, call its callback. +Otherwise, signal a `filewatch-error'." + (interactive "e") + (unless (inotify-event-p event) + (signal 'filewatch-error (cons "Not a valid inotify event" event))) + (funcall (nth 2 event) (nth 1 event))) + +(defun w32notify-handle-event (event) + "Handle MS-Windows file system monitoring event. +If EVENT is an MS-Windows filewatch event, call its callback. +Otherwise, signal a `filewatch-error'." + (interactive "e") + (if (and (eq (car event) 'file-w32notify) + (= (length event) 3)) + (funcall (nth 2 event) (nth 1 event)) + (signal 'filewatch-error + (cons "Not a valid MS-Windows file-notify event" event)))) + + ;;;; Comparing version strings. (defconst version-separator "." diff --git a/lisp/term.el b/lisp/term.el index 1a0dd0cc86f..b37e71280da 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -397,6 +397,12 @@ (require 'ring) (require 'ehelp) +(declare-function ring-empty-p "ring" (ring)) +(declare-function ring-ref "ring" (ring index)) +(declare-function ring-insert-at-beginning "ring" (ring item)) +(declare-function ring-length "ring" (ring)) +(declare-function ring-insert "ring" (ring item)) + (defgroup term nil "General command interpreter in a window." :group 'processes) diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 1aad645870b..b8baaa077ce 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -656,18 +656,6 @@ This defines a fontset consisting of the Courier and other fonts that come with OS X. See the documentation of `create-fontset-from-fontset-spec' for the format.") -;; Conditional on new-fontset so bootstrapping works on non-GUI compiles. -(when (fboundp 'new-fontset) - ;; Setup the default fontset. - (create-default-fontset) - ;; Create the standard fontset. - (condition-case err - (create-fontset-from-fontset-spec ns-standard-fontset-spec t) - (error (display-warning - 'initialization - (format "Creation of the standard fontset failed: %s" err) - :error)))) - (defvar ns-reg-to-script) ; nsfont.m ;; This maps font registries (not exposed by NS APIs for font selection) to @@ -914,6 +902,16 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") ;; PENDING: not needed? (setq command-line-args (x-handle-args command-line-args)) + ;; Setup the default fontset. + (create-default-fontset) + ;; Create the standard fontset. + (condition-case err + (create-fontset-from-fontset-spec ns-standard-fontset-spec t) + (error (display-warning + 'initialization + (format "Creation of the standard fontset failed: %s" err) + :error))) + (x-open-connection (system-name) nil t) (dolist (service (ns-list-services)) diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index eac43fb70dc..cbd08e68a39 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -92,7 +92,7 @@ (declare-function set-message-beep "w32fns.c") (declare-function cygwin-convert-file-name-from-windows "cygw32.c" - (path &optional absolute_p)) + (path &optional absolute_p)) ;; Conditional on new-fontset so bootstrapping works on non-GUI compiles (if (fboundp 'new-fontset) @@ -119,7 +119,11 @@ "/") "/"))) (dnd-handle-one-url window 'private - (concat "file:" file-name))) + (concat + (if (eq system-type 'cygwin) + "file://" + "file:") + file-name))) (defun w32-drag-n-drop (event &optional new-frame) "Edit the files listed in the drag-n-drop EVENT. diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 97b1dcfb238..cb19c018839 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -266,22 +266,22 @@ ;;;###autoload (define-derived-mode css-mode fundamental-mode "CSS" "Major mode to edit Cascading Style Sheets." - (set (make-local-variable 'font-lock-defaults) css-font-lock-defaults) - (set (make-local-variable 'comment-start) "/*") - (set (make-local-variable 'comment-start-skip) "/\\*+[ \t]*") - (set (make-local-variable 'comment-end) "*/") - (set (make-local-variable 'comment-end-skip) "[ \t]*\\*+/") - (set (make-local-variable 'forward-sexp-function) 'css-forward-sexp) - (set (make-local-variable 'parse-sexp-ignore-comments) t) - (set (make-local-variable 'indent-line-function) 'css-indent-line) - (set (make-local-variable 'fill-paragraph-function) - 'css-fill-paragraph) + (setq-local font-lock-defaults css-font-lock-defaults) + (setq-local comment-start "/*") + (setq-local comment-start-skip "/\\*+[ \t]*") + (setq-local comment-end "*/") + (setq-local comment-end-skip "[ \t]*\\*+/") + (setq-local forward-sexp-function 'css-forward-sexp) + (setq-local parse-sexp-ignore-comments t) + (setq-local indent-line-function 'css-indent-line) + (setq-local fill-paragraph-function 'css-fill-paragraph) + (setq-local add-log-current-defun-function #'css-current-defun-name) (when css-electric-keys (let ((fc (make-char-table 'auto-fill-chars))) (set-char-table-parent fc auto-fill-chars) (dolist (c css-electric-keys) (aset fc c 'indent-according-to-mode)) - (set (make-local-variable 'auto-fill-chars) fc)))) + (setq-local auto-fill-chars fc)))) (defvar comment-continue) @@ -481,5 +481,15 @@ (save-excursion (indent-line-to indent)) (indent-line-to indent))))) +(defun css-current-defun-name () + "Return the name of the CSS section at point, or nil." + (save-excursion + (let ((max (max (point-min) (- (point) 1600)))) ; approx 20 lines back + (when (search-backward "{" max t) + (skip-chars-backward " \t\r\n") + (beginning-of-line) + (if (looking-at "^[ \t]*\\([^{\r\n]*[^ {\t\r\n]\\)") + (match-string-no-properties 1)))))) + (provide 'css-mode) ;;; css-mode.el ends here diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index feb2fa6cc73..5b6d5f359e6 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -721,7 +721,11 @@ space does not end a sentence, so don't break a line there." (move-to-column (current-fill-column)) (if (when (< (point) to) ;; Find the position where we'll break the line. - (forward-char 1) ;Use an immediately following space, if any. + ;; Use an immediately following space, if any. + ;; However, note that `move-to-column' may overshoot + ;; if there are wide characters (Bug#3234). + (unless (> (current-column) (current-fill-column)) + (forward-char 1)) (fill-move-to-break-point linebeg) ;; Check again to see if we got to the end of ;; the paragraph. diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index 7e692960dbc..6ab3e3d3f16 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -63,7 +63,7 @@ Non-nil means use highlight, nil means use minibuffer messages." "Non-nil means Flyspell reports a repeated word as an error. See `flyspell-mark-duplications-exceptions' to add exceptions to this rule. Detection of repeated words is not implemented in -\"large\" regions; see `flyspell-large-region'." +\"large\" regions; see variable `flyspell-large-region'." :group 'flyspell :type 'boolean) @@ -145,9 +145,10 @@ whose length is specified by `flyspell-delay'." (defcustom flyspell-default-deplacement-commands '(next-line previous-line handle-switch-frame handle-select-window - scroll-up scroll-down) + scroll-up + scroll-down) "The standard list of deplacement commands for Flyspell. -See `flyspell-deplacement-commands'." +See variable `flyspell-deplacement-commands'." :group 'flyspell :version "21.1" :type '(repeat (symbol))) @@ -445,13 +446,23 @@ like <img alt=\"Some thing.\">." ;;*---------------------------------------------------------------------*/ ;;* Highlighting */ ;;*---------------------------------------------------------------------*/ -(defface flyspell-incorrect '((t :underline t :inherit error)) +(defface flyspell-incorrect + '((((supports :underline (:style wave))) + :underline (:style wave :color "Red1")) + (t + :underline t :inherit error)) "Flyspell face for misspelled words." + :version "24.4" :group 'flyspell) -(defface flyspell-duplicate '((t :underline t :inherit warning)) +(defface flyspell-duplicate + '((((supports :underline (:style wave))) + :underline (:style wave :color "DarkOrange")) + (t + :underline t :inherit warning)) "Flyspell face for words that appear twice in a row. See also `flyspell-duplicate-distance'." + :version "24.4" :group 'flyspell) (defvar flyspell-overlay nil) diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 7bdb587c560..dbcf3910db8 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -357,6 +357,10 @@ Must be greater than 1." "ispell") "Program invoked by \\[ispell-word] and \\[ispell-region] commands." :type 'string + :set (lambda (symbol value) + (set-default symbol value) + (if (featurep 'ispell) + (ispell-set-spellchecker-params))) :group 'ispell) (defcustom ispell-alternate-dictionary @@ -769,6 +773,41 @@ here just for backwards compatibility.") (make-obsolete-variable 'ispell-aspell-supports-utf8 'ispell-encoding8-command "23.1") +(defvar ispell-hunspell-dictionary-equivs-alist + '(("american" "en_US") + ("brasileiro" "pt_BR") + ("british" "en_GB") + ("castellano" "es_ES") + ("castellano8" "es_ES") + ("czech" "cs_CZ") + ("dansk" "da_DK") + ("deutsch" "de_DE") + ("deutsch8" "de_DE") + ("english" "en_US") + ("esperanto" "eo") + ("esperanto-tex" "eo") + ("finnish" "fi_FI") + ("francais7" "fr_FR") + ("francais" "fr_FR") + ("francais-tex" "fr_FR") + ("german" "de_DE") + ("german8" "de_DE") + ("italiano" "it_IT") + ("nederlands" "nl_NL") + ("nederlands8" "nl_NL") + ("norsk" "nn_NO") + ("norsk7-tex" "nn_NO") + ("polish" "pl_PL") + ("portugues" "pt_PT") + ("russian" "ru_RU") + ("russianw" "ru_RU") + ("slovak" "sk_SK") + ("slovenian" "sl_SI") + ("svenska" "sv_SE") + ("hebrew" "he_IL")) + "Alist with matching hunspell dict names for standard dict names in + `ispell-dictionary-base-alist'.") + (defvar ispell-emacs-alpha-regexp (if (string-match "^[[:alpha:]]+$" "abcde") "[[:alpha:]]" @@ -903,6 +942,24 @@ Otherwise returns the library directory name, if that is defined." (setq default-directory (expand-file-name "~/"))) (apply 'call-process-region args))) +(defun ispell-create-debug-buffer (&optional append) + "Create an ispell debug buffer for debugging output. +Use APPEND to append the info to previous buffer if exists, +otherwise is reset. Returns name of ispell debug buffer. +See `ispell-buffer-with-debug' for an example of use." + (let ((ispell-debug-buffer (get-buffer-create "*ispell-debug*"))) + (with-current-buffer ispell-debug-buffer + (if append + (insert + (format "-----------------------------------------------\n")) + (erase-buffer))) + ispell-debug-buffer)) + +(defsubst ispell-print-if-debug (string) + "Print STRING to `ispell-debug-buffer' buffer if enabled." + (if (boundp 'ispell-debug-buffer) + (with-current-buffer ispell-debug-buffer + (insert string)))) ;; The preparation of the menu bar menu must be autoloaded @@ -1112,9 +1169,57 @@ aspell is used along with Emacs).") ispell-encoding8-command) ispell-aspell-dictionary-alist nil)) + (ispell-dictionary-base-alist ispell-dictionary-base-alist) ispell-base-dicts-override-alist ; Override only base-dicts-alist all-dicts-alist) + ;; While ispell and aspell (through aliases) use the traditional + ;; dict naming originally expected by ispell.el, hunspell + ;; uses locale based names with no alias. We need to map + ;; standard names to locale based names to make default dict + ;; definitions available for hunspell. + (if ispell-really-hunspell + (let (tmp-dicts-alist) + (dolist (adict ispell-dictionary-base-alist) + (let* ((dict-name (nth 0 adict)) + (dict-equiv + (cadr (assoc dict-name + ispell-hunspell-dictionary-equivs-alist))) + (ispell-args (nth 5 adict)) + (ispell-args-has-d (member "-d" ispell-args)) + skip-dict) + ;; Remove "-d" option from `ispell-args' if present + (if ispell-args-has-d + (let ((ispell-args-after-d + (cdr (cdr ispell-args-has-d))) + (ispell-args-before-d + (butlast ispell-args (length ispell-args-has-d)))) + (setq ispell-args + (nconc ispell-args-before-d + ispell-args-after-d)))) + ;; Unless default dict, re-add "-d" option with the mapped value + (if dict-name + (if dict-equiv + (nconc ispell-args (list "-d" dict-equiv)) + (message + "ispell-set-spellchecker-params: Missing hunspell equiv for \"%s\". Skipping." + dict-name) + (setq skip-dict t))) + + (unless skip-dict + (add-to-list 'tmp-dicts-alist + (list + dict-name ; dict name + (nth 1 adict) ; casechars + (nth 2 adict) ; not-casechars + (nth 3 adict) ; otherchars + (nth 4 adict) ; many-otherchars-p + ispell-args ; ispell-args + (nth 6 adict) ; extended-character-mode + (nth 7 adict) ; dict encoding + )))) + (setq ispell-dictionary-base-alist tmp-dicts-alist)))) + (run-hooks 'ispell-initialize-spellchecker-hook) ;; Add dicts to ``ispell-dictionary-alist'' unless already present. @@ -1572,8 +1677,8 @@ You can set this variable in hooks in your init file -- eg: (defun ispell-accept-output (&optional timeout-secs timeout-msecs) "Wait for output from ispell process, or TIMEOUT-SECS and TIMEOUT-MSECS. -If asynchronous subprocesses are not supported, call `ispell-filter' and -pass it the output of the last ispell invocation." +If asynchronous subprocesses are not supported, call function `ispell-filter' +and pass it the output of the last ispell invocation." (if ispell-async-processp (accept-process-output ispell-process timeout-secs timeout-msecs) (if (null ispell-process) @@ -2627,11 +2732,8 @@ When asynchronous processes are not supported, `run' is always returned." (defun ispell-start-process () "Start the Ispell process, with support for no asynchronous processes. Keeps argument list for future Ispell invocations for no async support." - ;; Local dictionary becomes the global dictionary in use. - (setq ispell-current-dictionary - (or ispell-local-dictionary ispell-dictionary)) - (setq ispell-current-personal-dictionary - (or ispell-local-pdict ispell-personal-dictionary)) + ;; `ispell-current-dictionary' and `ispell-current-personal-dictionary' + ;; are properly set in `ispell-internal-change-dictionary'. (let* ((default-directory (if (and (file-directory-p default-directory) (file-readable-p default-directory)) @@ -2646,8 +2748,7 @@ Keeps argument list for future Ispell invocations for no async support." (list "-d" ispell-current-dictionary)) orig-args (if ispell-current-personal-dictionary ; Use specified pers dict. - (list "-p" - (expand-file-name ispell-current-personal-dictionary))) + (list "-p" ispell-current-personal-dictionary)) ;; If we are using recent aspell or hunspell, make sure we use the ;; right encoding for communication. ispell or older aspell/hunspell ;; does not support this. @@ -2684,6 +2785,9 @@ Keeps argument list for future Ispell invocations for no async support." (let* (;; Basename of dictionary used by the spell-checker (dict-bname (or (car (cdr (member "-d" (ispell-get-ispell-args)))) ispell-current-dictionary)) + ;; The directory where process was started. + (current-ispell-directory default-directory) + ;; The default directory for the process. ;; Use "~/" as default-directory unless using Ispell with per-dir ;; personal dictionaries and not in a minibuffer under XEmacs (default-directory @@ -2874,13 +2978,15 @@ By just answering RET you can find out what the current dictionary is." "Update the dictionary and the personal dictionary used by Ispell. This may kill the Ispell process; if so, a new one will be started when needed." - (let ((dict (or ispell-local-dictionary ispell-dictionary)) - (pdict (or ispell-local-pdict ispell-personal-dictionary))) + (let* ((dict (or ispell-local-dictionary ispell-dictionary)) + (pdict (or ispell-local-pdict ispell-personal-dictionary)) + (expanded-pdict (if pdict (expand-file-name pdict)))) (unless (and (equal ispell-current-dictionary dict) - (equal ispell-current-personal-dictionary pdict)) + (equal ispell-current-personal-dictionary + expanded-pdict)) (ispell-kill-ispell t) (setq ispell-current-dictionary dict - ispell-current-personal-dictionary pdict)))) + ispell-current-personal-dictionary expanded-pdict)))) ;; Avoid error messages when compiling for these dynamic variables. (defvar ispell-start) @@ -2898,114 +3004,142 @@ amount for last line processed." (if (not recheckp) (ispell-accept-buffer-local-defs)) ; set up dictionary, local words, etc. (let ((skip-region-start (make-marker)) - (rstart (make-marker))) - (unwind-protect - (save-excursion - (message "Spell-checking %s using %s with %s dictionary..." - (if (and (= reg-start (point-min)) (= reg-end (point-max))) - (buffer-name) "region") - (file-name-nondirectory ispell-program-name) - (or ispell-current-dictionary "default")) - ;; Returns cursor to original location. - (save-window-excursion - (goto-char reg-start) - (let ((transient-mark-mode) - (case-fold-search case-fold-search) - (query-fcc t) - in-comment key) - (let (message-log-max) - (message "searching for regions to skip")) - (if (re-search-forward (ispell-begin-skip-region-regexp) reg-end t) - (progn - (setq key (match-string-no-properties 0)) - (set-marker skip-region-start (- (point) (length key))) - (goto-char reg-start))) - (let (message-log-max) - (message - "Continuing spelling check using %s with %s dictionary..." - (file-name-nondirectory ispell-program-name) - (or ispell-current-dictionary "default"))) - (set-marker rstart reg-start) - (set-marker ispell-region-end reg-end) - (while (and (not ispell-quit) - (< (point) ispell-region-end)) - ;; spell-check region with skipping - (if (and (marker-position skip-region-start) - (<= skip-region-start (point))) + (rstart (make-marker)) + (region-type (if (and (= reg-start (point-min)) (= reg-end (point-max))) + (buffer-name) "region")) + (program-basename (file-name-nondirectory ispell-program-name)) + (dictionary (or ispell-current-dictionary "default"))) + (unwind-protect + (save-excursion + (message "Spell-checking %s using %s with %s dictionary..." + region-type program-basename dictionary) + ;; Returns cursor to original location. + (save-window-excursion + (goto-char reg-start) + (let ((transient-mark-mode) + (case-fold-search case-fold-search) + (query-fcc t) + in-comment key) + (ispell-print-if-debug + (concat + (format + "ispell-region: (ispell-skip-region-list):\n%s\n" + (ispell-skip-region-list)) + (format + "ispell-region: (ispell-begin-skip-region-regexp):\n%s\n" + (ispell-begin-skip-region-regexp)) + "ispell-region: Search for first region to skip after (ispell-begin-skip-region-regexp)\n")) + (if (re-search-forward (ispell-begin-skip-region-regexp) reg-end t) (progn - ;; If region inside line comment, must keep comment start. - (setq in-comment (point) - in-comment - (and comment-start - (or (null comment-end) (string= "" comment-end)) - (save-excursion - (beginning-of-line) - (re-search-forward comment-start in-comment t)) - comment-start)) - ;; Can change skip-regexps (in ispell-message) - (ispell-skip-region key) ; moves pt past region. - (set-marker rstart (point)) - ;; check for saving large attachments... - (setq query-fcc (and query-fcc - (ispell-ignore-fcc skip-region-start - rstart))) - (if (and (< rstart ispell-region-end) - (re-search-forward - (ispell-begin-skip-region-regexp) - ispell-region-end t)) - (progn - (setq key (match-string-no-properties 0)) - (set-marker skip-region-start - (- (point) (length key))) - (goto-char rstart)) - (set-marker skip-region-start nil)))) - (setq reg-end (max (point) - (if (marker-position skip-region-start) - (min skip-region-start ispell-region-end) - (marker-position ispell-region-end)))) - (let* ((ispell-start (point)) - (ispell-end (min (point-at-eol) reg-end)) - (string (ispell-get-line - ispell-start ispell-end in-comment))) - (if in-comment ; account for comment chars added - (setq ispell-start (- ispell-start (length in-comment)) - in-comment nil)) - (setq ispell-end (point)) ; "end" tracks region retrieved. - (if string ; there is something to spell check! - ;; (special start end) - (setq shift (ispell-process-line string - (and recheckp shift)))) - (goto-char ispell-end))))) - (if ispell-quit - nil - (or shift 0))) - ;; protected - (if (and (not (and recheckp ispell-keep-choices-win)) - (get-buffer ispell-choices-buffer)) - (kill-buffer ispell-choices-buffer)) - (set-marker skip-region-start nil) - (set-marker rstart nil) - (if ispell-quit - (progn - ;; preserve or clear the region for ispell-continue. - (if (not (numberp ispell-quit)) - (set-marker ispell-region-end nil) - ;; Ispell-continue enabled - ispell-region-end is set. - (goto-char ispell-quit)) - ;; Check for aborting - (if (and ispell-checking-message (numberp ispell-quit)) - (progn - (setq ispell-quit nil) - (error "Message send aborted"))) - (if (not recheckp) (setq ispell-quit nil))) - (if (not recheckp) (set-marker ispell-region-end nil)) - ;; Only save if successful exit. - (ispell-pdict-save ispell-silently-savep) - (message "Spell-checking %s using %s with %s dictionary...done" - (if (and (= reg-start (point-min)) (= reg-end (point-max))) - (buffer-name) "region") - (file-name-nondirectory ispell-program-name) - (or ispell-current-dictionary "default")))))) + (setq key (match-string-no-properties 0)) + (set-marker skip-region-start (- (point) (length key))) + (goto-char reg-start) + (ispell-print-if-debug + (format "ispell-region: First skip: %s at (pos,line,column): (%s,%s,%s).\n" + key + (save-excursion (goto-char skip-region-start) (point)) + (line-number-at-pos skip-region-start) + (save-excursion (goto-char skip-region-start) (current-column)))))) + (ispell-print-if-debug + (format + "ispell-region: Continue spell-checking with %s and %s dictionary...\n" + program-basename dictionary)) + (set-marker rstart reg-start) + (set-marker ispell-region-end reg-end) + (while (and (not ispell-quit) + (< (point) ispell-region-end)) + ;; spell-check region with skipping + (if (and (marker-position skip-region-start) + (<= skip-region-start (point))) + (progn + ;; If region inside line comment, must keep comment start. + (setq in-comment (point) + in-comment + (and comment-start + (or (null comment-end) (string= "" comment-end)) + (save-excursion + (beginning-of-line) + (re-search-forward comment-start in-comment t)) + comment-start)) + ;; Can change skip-regexps (in ispell-message) + (ispell-skip-region key) ; moves pt past region. + (set-marker rstart (point)) + ;; check for saving large attachments... + (setq query-fcc (and query-fcc + (ispell-ignore-fcc skip-region-start + rstart))) + (if (and (< rstart ispell-region-end) + (re-search-forward + (ispell-begin-skip-region-regexp) + ispell-region-end t)) + (progn + (setq key (match-string-no-properties 0)) + (set-marker skip-region-start + (- (point) (length key))) + (goto-char rstart) + (ispell-print-if-debug + (format "ispell-region: Next skip: %s at (pos,line,column): (%s,%s,%s).\n" + key + (save-excursion (goto-char skip-region-start) (point)) + (line-number-at-pos skip-region-start) + (save-excursion (goto-char skip-region-start) (current-column))))) + (set-marker skip-region-start nil)))) + (setq reg-end (max (point) + (if (marker-position skip-region-start) + (min skip-region-start ispell-region-end) + (marker-position ispell-region-end)))) + (let* ((ispell-start (point)) + (ispell-end (min (point-at-eol) reg-end)) + ;; See if line must be prefixed by comment string to let ispell know this is + ;; part of a comment string. This is only supported in some modes. + ;; In particular, this is not supported in autoconf mode where adding the + ;; comment string messes everything up because ispell tries to spellcheck the + ;; `dnl' string header causing misalignments in some cases (debbugs.gnu.org: #12768). + (add-comment (and in-comment + (not (string= in-comment "dnl ")) + in-comment)) + (string (ispell-get-line + ispell-start ispell-end add-comment))) + (ispell-print-if-debug + (format + "ispell-region: string pos (%s->%s), eol: %s, [in-comment]: [%s], [add-comment]: [%s], [string]: [%s]\n" + ispell-start ispell-end (point-at-eol) in-comment add-comment string)) + (if add-comment ; account for comment chars added + (setq ispell-start (- ispell-start (length add-comment)) + add-comment nil)) + (setq ispell-end (point)) ; "end" tracks region retrieved. + (if string ; there is something to spell check! + ;; (special start end) + (setq shift (ispell-process-line string + (and recheckp shift)))) + (goto-char ispell-end))))) + (if ispell-quit + nil + (or shift 0))) + ;; protected + (if (and (not (and recheckp ispell-keep-choices-win)) + (get-buffer ispell-choices-buffer)) + (kill-buffer ispell-choices-buffer)) + (set-marker skip-region-start nil) + (set-marker rstart nil) + (if ispell-quit + (progn + ;; preserve or clear the region for ispell-continue. + (if (not (numberp ispell-quit)) + (set-marker ispell-region-end nil) + ;; Ispell-continue enabled - ispell-region-end is set. + (goto-char ispell-quit)) + ;; Check for aborting + (if (and ispell-checking-message (numberp ispell-quit)) + (progn + (setq ispell-quit nil) + (error "Message send aborted"))) + (if (not recheckp) (setq ispell-quit nil))) + (if (not recheckp) (set-marker ispell-region-end nil)) + ;; Only save if successful exit. + (ispell-pdict-save ispell-silently-savep) + (message "Spell-checking %s using %s with %s dictionary...done" + region-type program-basename dictionary))))) (defun ispell-begin-skip-region-regexp () @@ -3252,10 +3386,19 @@ Returns the sum SHIFT due to changes in word replacements." ;; Alignment cannot be tracked and this error will occur when ;; `query-replace' makes multiple corrections on the starting line. (or (ispell-looking-at (car poss)) - ;; This occurs due to filter pipe problems - (error (concat "Ispell misalignment: word " - "`%s' point %d; probably incompatible versions") - (car poss) (marker-position word-start))) + ;; This error occurs due to filter pipe problems + (let* ((ispell-pipe-word (car poss)) + (actual-point (marker-position word-start)) + (actual-line (line-number-at-pos actual-point)) + (actual-column (save-excursion (goto-char actual-point) (current-column)))) + (ispell-print-if-debug + (concat + "ispell-process-line: Ispell misalignment error:\n" + (format " [Word from ispell pipe]: [%s], actual (point,line,column): (%s,%s,%s)\n" + ispell-pipe-word actual-point actual-line actual-column))) + (error (concat "Ispell misalignment: word " + "`%s' point %d; probably incompatible versions") + ispell-pipe-word actual-point))) ;; ispell-cmd-loop can go recursive & change buffer (if ispell-keep-choices-win (setq replace (ispell-command-loop @@ -3389,6 +3532,13 @@ Returns the sum SHIFT due to changes in word replacements." (interactive) (ispell-region (point-min) (point-max))) +;;;###autoload +(defun ispell-buffer-with-debug (&optional append) + "`ispell-buffer' with some output sent to `ispell-debug-buffer' buffer. +Use APPEND to append the info to previous buffer if exists." + (interactive) + (let ((ispell-debug-buffer (ispell-create-debug-buffer append))) + (ispell-buffer))) ;;;###autoload (defun ispell-continue () diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el index 3b294e62b01..079101b56ee 100644 --- a/lisp/textmodes/reftex-cite.el +++ b/lisp/textmodes/reftex-cite.el @@ -1043,6 +1043,7 @@ While entering the regexp, completion on knows citation keys is possible. ((= l ?k) (reftex-get-bib-field "key" entry)) ((= l ?m) (reftex-get-bib-field "month" entry)) ((= l ?n) (reftex-get-bib-field "number" entry)) + ((= l ?N) (reftex-get-bib-field "note" entry)) ((= l ?o) (reftex-get-bib-field "organization" entry)) ((= l ?p) (reftex-get-bib-field "pages" entry)) ((= l ?P) (car (split-string @@ -1050,6 +1051,7 @@ While entering the regexp, completion on knows citation keys is possible. "[- .]+"))) ((= l ?s) (reftex-get-bib-field "school" entry)) ((= l ?u) (reftex-get-bib-field "publisher" entry)) + ((= l ?U) (reftex-get-bib-field "url" entry)) ((= l ?r) (reftex-get-bib-field "address" entry)) ((= l ?t) (reftex-get-bib-field "title" entry)) ((= l ?T) (reftex-abbreviate-title diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el index 095c5953947..a86b10e21cc 100644 --- a/lisp/textmodes/reftex-parse.el +++ b/lisp/textmodes/reftex-parse.el @@ -251,7 +251,7 @@ of master file." ;; the next parsing iteration. (when (eq (char-before) ?\\) (backward-char)) ;; Insert in List - (setq toc-entry (reftex-section-info file)) + (setq toc-entry (funcall reftex-section-info-function file)) (when toc-entry ;; It can happen that section info returns nil (setq level (nth 5 toc-entry)) diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el index 2beb3af628b..248e36a5299 100644 --- a/lisp/textmodes/reftex-toc.el +++ b/lisp/textmodes/reftex-toc.el @@ -785,7 +785,7 @@ PRO-OR-DE is assumed to be dynamically scoped into this function." (marker (nth 4 data))) (with-current-buffer (marker-buffer marker) (goto-char (marker-position marker)) - (if (looking-at (concat "\\([ \t]*\\\\\\)" (regexp-quote name))) + (if (looking-at (concat "\\([ \t]*" reftex-section-pre-regexp "\\)" (regexp-quote name))) (replace-match (concat "\\1" newname)) (error "Fatal error during %smotion" pro-or-de))))) diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el index db08ca3a514..2a5c9c55866 100644 --- a/lisp/textmodes/reftex-vars.el +++ b/lisp/textmodes/reftex-vars.el @@ -1125,12 +1125,12 @@ In the format, the following percent escapes will be expanded. %e Works like %a, but on list of editor names. (%2e and %E work a well) It is also possible to access all other BibTeX database fields: -%b booktitle %c chapter %d edition %h howpublished -%i institution %j journal %k key %m month -%n number %o organization %p pages %P first page -%r address %s school %u publisher %t title -%v volume %y year -%B booktitle, abbreviated %T title, abbreviated +%b booktitle %c chapter %d edition %h howpublished +%i institution %j journal %k key %m month +%n number %N note %o organization %p pages +%P first page %r address %s school %u publisher +%U url %t title %v volume %y year +%B booktitle, abbreviated %T title, abbreviated Usually, only %l is needed. The other stuff is mainly for the echo area display, and for (setq reftex-comment-citations t). diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el index d511bf9ff8b..a41409fc897 100644 --- a/lisp/textmodes/reftex.el +++ b/lisp/textmodes/reftex.el @@ -301,7 +301,9 @@ on the menu bar. (modify-syntax-entry ?\' "." reftex-syntax-table-for-bib) (modify-syntax-entry ?\" "." reftex-syntax-table-for-bib) (modify-syntax-entry ?\[ "." reftex-syntax-table-for-bib) - (modify-syntax-entry ?\] "." reftex-syntax-table-for-bib)) + (modify-syntax-entry ?\] "." reftex-syntax-table-for-bib) + + (run-hooks 'reftex-mode-hook)) ;; Mode was turned off (easy-menu-remove reftex-mode-menu))) @@ -664,6 +666,16 @@ will deactivate it." (defvar reftex-find-label-regexp-format nil) (defvar reftex-find-label-regexp-format2 nil) +;; Constants for making RefTeX open to Texinfo hooking +(defvar reftex-section-pre-regexp "\\\\") +;; Including `\' as a character to be matched at the end of the regexp +;; will allow stuff like \begin{foo}\label{bar} to be matched. This +;; will make the parser to advance one char too much. Therefore +;; `reftex-parse-from-file' will step one char back if a section is +;; found. +(defvar reftex-section-post-regexp "\\*?\\(\\[[^]]*\\]\\)?[[{ \t\r\n\\]") +(defvar reftex-section-info-function 'reftex-section-info) + (defvar reftex-memory nil "Memorizes old variable values to indicate changes in these variables.") @@ -1083,16 +1095,10 @@ This enforces rescanning the buffer on next use." reftex-include-file-commands "\\|") "\\)[{ \t]+\\([^} \t\n\r]+\\)")) (section-re - ;; Including `\' as a character to be matched at the end - ;; of the regexp will allow stuff like - ;; \begin{foo}\label{bar} to be matched. This will make - ;; the parser to advance one char too much. Therefore - ;; `reftex-parse-from-file' will step one char back if a - ;; section is found. - (concat wbol "\\\\\\(" + (concat wbol reftex-section-pre-regexp "\\(" (mapconcat (lambda (x) (regexp-quote (car x))) reftex-section-levels-all "\\|") - "\\)\\*?\\(\\[[^]]*\\]\\)?[[{ \t\r\n\\]")) + "\\)" reftex-section-post-regexp)) (appendix-re (concat wbol "\\(\\\\appendix\\)")) (macro-re (if macros-with-labels diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 74b26db1064..b7288772034 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -463,47 +463,39 @@ Do \\[describe-key] on the following bindings to discover what they do. ;; A start or end tag by itself on a line separates a paragraph. ;; This is desirable because SGML discards a newline that appears ;; immediately after a start tag or immediately before an end tag. - (set (make-local-variable 'paragraph-start) (concat "[ \t]*$\\|\ + (setq-local paragraph-start (concat "[ \t]*$\\|\ \[ \t]*</?\\(" sgml-name-re sgml-attrs-re "\\)?>")) - (set (make-local-variable 'paragraph-separate) - (concat paragraph-start "$")) - (set (make-local-variable 'adaptive-fill-regexp) "[ \t]*") + (setq-local paragraph-separate (concat paragraph-start "$")) + (setq-local adaptive-fill-regexp "[ \t]*") (add-hook 'fill-nobreak-predicate 'sgml-fill-nobreak nil t) - (set (make-local-variable 'indent-line-function) 'sgml-indent-line) - (set (make-local-variable 'comment-start) "<!-- ") - (set (make-local-variable 'comment-end) " -->") - (set (make-local-variable 'comment-indent-function) 'sgml-comment-indent) - (set (make-local-variable 'comment-line-break-function) - 'sgml-comment-indent-new-line) - (set (make-local-variable 'skeleton-further-elements) - '((completion-ignore-case t))) - (set (make-local-variable 'skeleton-end-hook) - (lambda () - (or (eolp) - (not (or (eq v2 '\n) (eq (car-safe v2) '\n))) - (newline-and-indent)))) - (set (make-local-variable 'font-lock-defaults) - '((sgml-font-lock-keywords - sgml-font-lock-keywords-1 - sgml-font-lock-keywords-2) - nil t)) - (set (make-local-variable 'syntax-propertize-function) - sgml-syntax-propertize-function) - (set (make-local-variable 'facemenu-add-face-function) - 'sgml-mode-facemenu-add-face-function) - (set (make-local-variable 'sgml-xml-mode) (sgml-xml-guess)) - (if sgml-xml-mode - () - (set (make-local-variable 'skeleton-transformation-function) - sgml-transformation-function)) + (setq-local indent-line-function 'sgml-indent-line) + (setq-local comment-start "<!-- ") + (setq-local comment-end " -->") + (setq-local comment-indent-function 'sgml-comment-indent) + (setq-local comment-line-break-function 'sgml-comment-indent-new-line) + (setq-local skeleton-further-elements '((completion-ignore-case t))) + (setq-local skeleton-end-hook + (lambda () + (or (eolp) + (not (or (eq v2 '\n) (eq (car-safe v2) '\n))) + (newline-and-indent)))) + (setq font-lock-defaults '((sgml-font-lock-keywords + sgml-font-lock-keywords-1 + sgml-font-lock-keywords-2) + nil t)) + (setq-local syntax-propertize-function sgml-syntax-propertize-function) + (setq-local facemenu-add-face-function 'sgml-mode-facemenu-add-face-function) + (setq-local sgml-xml-mode (sgml-xml-guess)) + (unless sgml-xml-mode + (setq-local skeleton-transformation-function sgml-transformation-function)) ;; This will allow existing comments within declarations to be ;; recognized. ;; I can't find a clear description of SGML/XML comments, but it seems that ;; the only reliable ones are <!-- ... --> although it's not clear what ;; "..." can contain. It used to accept -- ... -- as well, but that was ;; apparently a mistake. - (set (make-local-variable 'comment-start-skip) "<!--[ \t]*") - (set (make-local-variable 'comment-end-skip) "[ \t]*--[ \t\n]*>") + (setq-local comment-start-skip "<!--[ \t]*") + (setq-local comment-end-skip "[ \t]*--[ \t\n]*>") ;; This definition has an HTML leaning but probably fits well for other modes. (setq imenu-generic-expression `((nil @@ -671,13 +663,13 @@ in your `.emacs': (if (eq v2 t) (setq v2 nil)) ;; We use `identity' to prevent skeleton from passing ;; `str' through `skeleton-transformation-function' a second time. - '(("") v2 _ v2 "</" (identity ',str) ?>)) + '(("") v2 _ v2 "</" (identity ',str) ?> >)) ((eq (car v2) t) (cons '("") (cdr v2))) (t (append '(("") (car v2)) (cdr v2) - '(resume: (car v2) _ "</" (identity ',str) ?>)))))) + '(resume: (car v2) _ "</" (identity ',str) ?> >)))))) (autoload 'skeleton-read "skeleton") @@ -982,10 +974,10 @@ With prefix argument ARG, repeat this ARG times." (unwind-protect (save-excursion (goto-char (point-min)) - (if (set (make-local-variable 'sgml-tags-invisible) - (if arg - (>= (prefix-numeric-value arg) 0) - (not sgml-tags-invisible))) + (if (setq-local sgml-tags-invisible + (if arg + (>= (prefix-numeric-value arg) 0) + (not sgml-tags-invisible))) (while (re-search-forward sgml-tag-name-re nil t) (setq string (cdr (assq (intern-soft (downcase (match-string 1))) @@ -1564,8 +1556,7 @@ Add this to `sgml-mode-hook' for convenience." (goto-char (point-min)) (if (re-search-forward "^\\([ \t]+\\)<" 500 'noerror) (progn - (set (make-local-variable 'sgml-basic-offset) - (1- (current-column))) + (setq-local sgml-basic-offset (1- (current-column))) (message "Guessed sgml-basic-offset = %d" sgml-basic-offset) )))) @@ -1935,12 +1926,25 @@ This takes effect when first loading the library.") ("ul" . "Unordered list") ("var" . "Math variable face") ("wbr" . "Enable <br> within <nobr>")) - "Value of `sgml-tag-help' for HTML mode.") + "Value of variable `sgml-tag-help' for HTML mode.") (defvar outline-regexp) (defvar outline-heading-end-regexp) (defvar outline-level) +(defun html-current-defun-name () + "Return the name of the last HTML title or heading, or nil." + (save-excursion + (if (re-search-backward + (concat + "<[ \t\r\n]*" + "\\(?:[hH][0-6]\\|title\\|TITLE\\|Title\\)" + "[^>]*>" + "[ \t\r\n]*" + "\\([^<\r\n]*[^ <\t\r\n]+\\)") + nil t) + (match-string-no-properties 1)))) + ;;;###autoload (define-derived-mode html-mode sgml-mode '(sgml-xml-mode "XHTML" "HTML") @@ -1979,33 +1983,29 @@ To work around that, do: (eval-after-load \"sgml-mode\" '(aset sgml-char-names ?' nil)) \\{html-mode-map}" - (set (make-local-variable 'sgml-display-text) html-display-text) - (set (make-local-variable 'sgml-tag-face-alist) html-tag-face-alist) - (make-local-variable 'sgml-tag-alist) - (make-local-variable 'sgml-face-tag-alist) - (make-local-variable 'sgml-tag-help) - (make-local-variable 'outline-regexp) - (make-local-variable 'outline-heading-end-regexp) - (make-local-variable 'outline-level) - (make-local-variable 'sentence-end-base) - (setq sentence-end-base "[.?!][]\"'â€)}]*\\(<[^>]*>\\)*" - sgml-tag-alist html-tag-alist - sgml-face-tag-alist html-face-tag-alist - sgml-tag-help html-tag-help - outline-regexp "^.*<[Hh][1-6]\\>" - outline-heading-end-regexp "</[Hh][1-6]>" - outline-level (lambda () - (char-before (match-end 0)))) + (setq-local sgml-display-text html-display-text) + (setq-local sgml-tag-face-alist html-tag-face-alist) + (setq-local sgml-tag-alist html-tag-alist) + (setq-local sgml-face-tag-alist html-face-tag-alist) + (setq-local sgml-tag-help html-tag-help) + (setq-local outline-regexp "^.*<[Hh][1-6]\\>") + (setq-local outline-heading-end-regexp "</[Hh][1-6]>") + (setq-local outline-level + (lambda () (char-before (match-end 0)))) + (setq-local add-log-current-defun-function #'html-current-defun-name) + (setq-local sentence-end-base "[.?!][]\"'â€)}]*\\(<[^>]*>\\)*") + (setq imenu-create-index-function 'html-imenu-index) - (set (make-local-variable 'sgml-empty-tags) - ;; From HTML-4.01's loose.dtd, parsed with `sgml-parse-dtd', - ;; plus manual addition of "wbr". - '("area" "base" "basefont" "br" "col" "frame" "hr" "img" "input" - "isindex" "link" "meta" "param" "wbr")) - (set (make-local-variable 'sgml-unclosed-tags) - ;; From HTML-4.01's loose.dtd, parsed with `sgml-parse-dtd'. - '("body" "colgroup" "dd" "dt" "head" "html" "li" "option" - "p" "tbody" "td" "tfoot" "th" "thead" "tr")) + + (setq-local sgml-empty-tags + ;; From HTML-4.01's loose.dtd, parsed with + ;; `sgml-parse-dtd', plus manual addition of "wbr". + '("area" "base" "basefont" "br" "col" "frame" "hr" "img" "input" + "isindex" "link" "meta" "param" "wbr")) + (setq-local sgml-unclosed-tags + ;; From HTML-4.01's loose.dtd, parsed with `sgml-parse-dtd'. + '("body" "colgroup" "dd" "dt" "head" "html" "li" "option" + "p" "tbody" "td" "tfoot" "th" "thead" "tr")) ;; It's for the user to decide if it defeats it or not -stef ;; (make-local-variable 'imenu-sort-function) ;; (setq imenu-sort-function nil) ; sorting the menu defeats the purpose diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index 411604088ae..4d8a74323c7 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el @@ -5215,7 +5215,7 @@ instead of the current buffer and returns the OBJECT." "Update cell face according to the current mode." (if (featurep 'xemacs) (set-face-property 'table-cell 'underline table-fixed-width-mode) - (set-face-inverse-video-p 'table-cell table-fixed-width-mode))) + (set-face-inverse-video 'table-cell table-fixed-width-mode))) (table--update-cell-face) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index db012e5cf9b..480ab8a581a 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -421,6 +421,17 @@ An alternative value is \" . \", if you use a font with a narrow period." (if (looking-at latex-outline-regexp) (1+ (or (cdr (assoc (match-string 1) latex-section-alist)) -1)) 1000)) + +(defun tex-current-defun-name () + "Return the name of the TeX section/paragraph/chapter at point, or nil." + (save-excursion + (when (re-search-backward + "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" + nil t) + (goto-char (match-beginning 0)) + (buffer-substring-no-properties + (1+ (point)) ; without initial backslash + (line-end-position))))) ;;;; ;;;; Font-Lock support @@ -1062,10 +1073,10 @@ tex-show-queue-command Entering Plain-tex mode runs the hook `text-mode-hook', then the hook `tex-mode-hook', and finally the hook `plain-tex-mode-hook'. When the special subshell is initiated, the hook `tex-shell-hook' is run." - (set (make-local-variable 'tex-command) tex-run-command) - (set (make-local-variable 'tex-start-of-header) "%\\*\\*start of header") - (set (make-local-variable 'tex-end-of-header) "%\\*\\*end of header") - (set (make-local-variable 'tex-trailer) "\\bye\n")) + (setq-local tex-command tex-run-command) + (setq-local tex-start-of-header "%\\*\\*start of header") + (setq-local tex-end-of-header "%\\*\\*end of header") + (setq-local tex-trailer "\\bye\n")) ;;;###autoload (define-derived-mode latex-mode tex-mode "LaTeX" @@ -1108,11 +1119,10 @@ tex-show-queue-command Entering Latex mode runs the hook `text-mode-hook', then `tex-mode-hook', and finally `latex-mode-hook'. When the special subshell is initiated, `tex-shell-hook' is run." - (set (make-local-variable 'tex-command) latex-run-command) - (set (make-local-variable 'tex-start-of-header) - "\\\\document\\(style\\|class\\)") - (set (make-local-variable 'tex-end-of-header) "\\\\begin\\s-*{document}") - (set (make-local-variable 'tex-trailer) "\\end{document}\n") + (setq-local tex-command latex-run-command) + (setq-local tex-start-of-header "\\\\document\\(style\\|class\\)") + (setq-local tex-end-of-header "\\\\begin\\s-*{document}") + (setq-local tex-trailer "\\end{document}\n") ;; A line containing just $$ is treated as a paragraph separator. ;; A line starting with $$ starts a paragraph, ;; but does not separate paragraphs if it has more stuff on it. @@ -1138,18 +1148,17 @@ subshell is initiated, `tex-shell-hook' is run." "marginpar" "parbox" "caption")) "\\|\\$\\$\\|[a-z]*\\(space\\|skip\\|page[a-z]*\\)" "\\>\\)[ \t]*\\($\\|%\\)\\)")) - (set (make-local-variable 'imenu-create-index-function) - 'latex-imenu-create-index) - (set (make-local-variable 'tex-face-alist) tex-latex-face-alist) + (setq-local imenu-create-index-function 'latex-imenu-create-index) + (setq-local tex-face-alist tex-latex-face-alist) (add-hook 'fill-nobreak-predicate 'latex-fill-nobreak-predicate nil t) - (set (make-local-variable 'indent-line-function) 'latex-indent) - (set (make-local-variable 'fill-indent-according-to-mode) t) + (setq-local indent-line-function 'latex-indent) + (setq-local fill-indent-according-to-mode t) (add-hook 'completion-at-point-functions 'latex-complete-data nil 'local) - (set (make-local-variable 'outline-regexp) latex-outline-regexp) - (set (make-local-variable 'outline-level) 'latex-outline-level) - (set (make-local-variable 'forward-sexp-function) 'latex-forward-sexp) - (set (make-local-variable 'skeleton-end-hook) nil)) + (setq-local outline-regexp latex-outline-regexp) + (setq-local outline-level 'latex-outline-level) + (setq-local forward-sexp-function 'latex-forward-sexp) + (setq-local skeleton-end-hook nil)) ;;;###autoload (define-derived-mode slitex-mode latex-mode "SliTeX" @@ -1198,39 +1207,36 @@ Entering SliTeX mode runs the hook `text-mode-hook', then the hook (defun tex-common-initialization () ;; Regexp isearch should accept newline and formfeed as whitespace. - (set (make-local-variable 'search-whitespace-regexp) "[ \t\r\n\f]+") + (setq-local search-whitespace-regexp "[ \t\r\n\f]+") ;; A line containing just $$ is treated as a paragraph separator. - (set (make-local-variable 'paragraph-start) - "[ \t]*$\\|[\f\\\\%]\\|[ \t]*\\$\\$") + (setq-local paragraph-start "[ \t]*$\\|[\f\\\\%]\\|[ \t]*\\$\\$") ;; A line starting with $$ starts a paragraph, ;; but does not separate paragraphs if it has more stuff on it. - (set (make-local-variable 'paragraph-separate) - "[ \t]*$\\|[\f\\\\%]\\|[ \t]*\\$\\$[ \t]*$") - (set (make-local-variable 'comment-start) "%") - (set (make-local-variable 'comment-add) 1) - (set (make-local-variable 'comment-start-skip) - "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\)\\(%+ *\\)") - (set (make-local-variable 'parse-sexp-ignore-comments) t) - (set (make-local-variable 'compare-windows-whitespace) - 'tex-categorize-whitespace) - (set (make-local-variable 'facemenu-add-face-function) - 'tex-facemenu-add-face-function) - (set (make-local-variable 'facemenu-end-add-face) "}") - (set (make-local-variable 'facemenu-remove-face-function) t) - (set (make-local-variable 'font-lock-defaults) - '((tex-font-lock-keywords tex-font-lock-keywords-1 - tex-font-lock-keywords-2 tex-font-lock-keywords-3) - nil nil nil nil - ;; Who ever uses that anyway ??? - (font-lock-mark-block-function . mark-paragraph) - (font-lock-syntactic-face-function - . tex-font-lock-syntactic-face-function) - (font-lock-unfontify-region-function - . tex-font-lock-unfontify-region))) - (set (make-local-variable 'syntax-propertize-function) - (syntax-propertize-rules latex-syntax-propertize-rules)) + (setq-local paragraph-separate "[ \t]*$\\|[\f\\\\%]\\|[ \t]*\\$\\$[ \t]*$") + (setq-local add-log-current-defun-function #'tex-current-defun-name) + (setq-local comment-start "%") + (setq-local comment-add 1) + (setq-local comment-start-skip + "\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\)\\(%+ *\\)") + (setq-local parse-sexp-ignore-comments t) + (setq-local compare-windows-whitespace 'tex-categorize-whitespace) + (setq-local facemenu-add-face-function 'tex-facemenu-add-face-function) + (setq-local facemenu-end-add-face "}") + (setq-local facemenu-remove-face-function t) + (setq-local font-lock-defaults + '((tex-font-lock-keywords tex-font-lock-keywords-1 + tex-font-lock-keywords-2 tex-font-lock-keywords-3) + nil nil nil nil + ;; Who ever uses that anyway ??? + (font-lock-mark-block-function . mark-paragraph) + (font-lock-syntactic-face-function + . tex-font-lock-syntactic-face-function) + (font-lock-unfontify-region-function + . tex-font-lock-unfontify-region))) + (setq-local syntax-propertize-function + (syntax-propertize-rules latex-syntax-propertize-rules)) ;; TABs in verbatim environments don't do what you think. - (set (make-local-variable 'indent-tabs-mode) nil) + (setq-local indent-tabs-mode nil) ;; Other vars that should be buffer-local. (make-local-variable 'tex-command) (make-local-variable 'tex-start-of-header) @@ -1523,8 +1529,7 @@ Puts point on a blank line between them." (looking-at bibtex-reference-key)) (push (match-string-no-properties 0) keys))))) ;; Fill the cache. - (set (make-local-variable 'latex-complete-bibtex-cache) - (list files key keys))) + (setq-local latex-complete-bibtex-cache (list files key keys))) (complete-with-action action keys key pred))))) (defun latex-complete-envnames () @@ -1885,8 +1890,7 @@ Mark is left at original location." ;; The utility functions: (define-derived-mode tex-shell shell-mode "TeX-Shell" - (set (make-local-variable 'compilation-error-regexp-alist) - tex-error-regexp-alist) + (setq-local compilation-error-regexp-alist tex-error-regexp-alist) (compilation-shell-minor-mode t)) ;;;###autoload @@ -2099,8 +2103,7 @@ of the current buffer." (with-no-warnings (when (boundp 'TeX-master) (cond ((stringp TeX-master) - (make-local-variable 'tex-main-file) - (setq tex-main-file TeX-master)) + (setq-local tex-main-file TeX-master)) ((and (eq TeX-master t) buffer-file-name) (file-relative-name buffer-file-name))))) ;; Try to guess the main file. @@ -2870,8 +2873,8 @@ There might be text before point." (cons (car x) 'doctex-font-lock-syntactic-face-function)) (_ x))) (cdr font-lock-defaults)))) - (set (make-local-variable 'syntax-propertize-function) - (syntax-propertize-rules doctex-syntax-propertize-rules))) + (setq-local syntax-propertize-function + (syntax-propertize-rules doctex-syntax-propertize-rules))) (run-hooks 'tex-mode-load-hook) diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el index abff7f750c5..44e839d2474 100644 --- a/lisp/textmodes/texinfo.el +++ b/lisp/textmodes/texinfo.el @@ -33,6 +33,15 @@ ;;; Code: (eval-when-compile (require 'tex-mode)) +(declare-function tex-buffer "tex-mode" ()) +(declare-function tex-region "tex-mode" (beg end)) +(declare-function tex-send-command "tex-mode") +(declare-function tex-recenter-output-buffer "tex-mode" (linenum)) +(declare-function tex-print "tex-mode" (&optional alt)) +(declare-function tex-view "tex-mode" ()) +(declare-function tex-shell-running "tex-mode" ()) +(declare-function tex-kill-job "tex-mode" ()) + (defvar outline-heading-alist) (defgroup texinfo nil @@ -502,6 +511,12 @@ Subexpression 1 is what goes into the corresponding `@end' statement.") (regexp-opt (texinfo-filter 2 texinfo-section-list)) "Regular expression matching just the Texinfo chapter level headings.") +(defun texinfo-current-defun-name () + "Return the name of the Texinfo node at point, or nil." + (save-excursion + (if (re-search-backward "^@node[ \t]+\\([^,\n]+\\)" nil t) + (match-string-no-properties 1)))) + ;;; Texinfo mode ;;;###autoload @@ -571,66 +586,53 @@ be the first node in the file. Entering Texinfo mode calls the value of `text-mode-hook', and then the value of `texinfo-mode-hook'." - (set (make-local-variable 'page-delimiter) - (concat - "^@node [ \t]*[Tt]op\\|^@\\(" - texinfo-chapter-level-regexp - "\\)\\>")) - (make-local-variable 'require-final-newline) - (setq require-final-newline mode-require-final-newline) - (make-local-variable 'indent-tabs-mode) - (setq indent-tabs-mode nil) - (make-local-variable 'paragraph-separate) - (setq paragraph-separate - (concat "\b\\|@[a-zA-Z]*[ \n]\\|" paragraph-separate)) - (make-local-variable 'paragraph-start) - (setq paragraph-start (concat "\b\\|@[a-zA-Z]*[ \n]\\|" paragraph-start)) - (set (make-local-variable 'sentence-end-base) - "\\(@\\(end\\)?dots{}\\|[.?!]\\)[]\"'â€)}]*") - (make-local-variable 'fill-column) - (setq fill-column 70) - (make-local-variable 'comment-start) - (setq comment-start "@c ") - (make-local-variable 'comment-start-skip) - (setq comment-start-skip "@c +\\|@comment +") - (make-local-variable 'words-include-escapes) - (setq words-include-escapes t) - (make-local-variable 'imenu-generic-expression) - (setq imenu-generic-expression texinfo-imenu-generic-expression) + (setq-local page-delimiter + (concat "^@node [ \t]*[Tt]op\\|^@\\(" + texinfo-chapter-level-regexp + "\\)\\>")) + (setq-local require-final-newline mode-require-final-newline) + (setq-local indent-tabs-mode nil) + (setq-local paragraph-separate + (concat "\b\\|@[a-zA-Z]*[ \n]\\|" + paragraph-separate)) + (setq-local paragraph-start (concat "\b\\|@[a-zA-Z]*[ \n]\\|" + paragraph-start)) + (setq-local sentence-end-base "\\(@\\(end\\)?dots{}\\|[.?!]\\)[]\"'â€)}]*") + (setq-local fill-column 70) + (setq-local comment-start "@c ") + (setq-local comment-start-skip "@c +\\|@comment +") + (setq-local words-include-escapes t) + (setq-local imenu-generic-expression texinfo-imenu-generic-expression) (setq imenu-case-fold-search nil) - (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(texinfo-font-lock-keywords nil nil nil backward-paragraph)) - (set (make-local-variable 'syntax-propertize-function) - texinfo-syntax-propertize-function) - (set (make-local-variable 'parse-sexp-lookup-properties) t) + (setq-local syntax-propertize-function texinfo-syntax-propertize-function) + (setq-local parse-sexp-lookup-properties t) + (setq-local add-log-current-defun-function #'texinfo-current-defun-name) ;; Outline settings. - (set (make-local-variable 'outline-heading-alist) - ;; We should merge outline-heading-alist and texinfo-section-list - ;; but in the mean time, let's just generate one from the other. - (mapcar (lambda (x) (cons (concat "@" (car x)) (cadr x))) - texinfo-section-list)) - (set (make-local-variable 'outline-regexp) - (concat (regexp-opt (mapcar 'car outline-heading-alist) t) - "\\>")) - - (make-local-variable 'tex-start-of-header) - (setq tex-start-of-header "%\\*\\*start") - (make-local-variable 'tex-end-of-header) - (setq tex-end-of-header "%\\*\\*end") - (make-local-variable 'tex-first-line-header-regexp) - (setq tex-first-line-header-regexp "^\\\\input") - (make-local-variable 'tex-trailer) - (setq tex-trailer "@bye\n") - - ;; Prevent filling certain lines, in addition to ones specified - ;; by the user. - (let ((prevent-filling "^@\\(def\\|multitable\\)")) - (set (make-local-variable 'auto-fill-inhibit-regexp) - (if (null auto-fill-inhibit-regexp) - prevent-filling - (concat auto-fill-inhibit-regexp "\\|" prevent-filling))))) + (setq-local outline-heading-alist + ;; We should merge `outline-heading-alist' and + ;; `texinfo-section-list'. But in the mean time, let's + ;; just generate one from the other. + (mapcar (lambda (x) (cons (concat "@" (car x)) (cadr x))) + texinfo-section-list)) + (setq-local outline-regexp + (concat (regexp-opt (mapcar 'car outline-heading-alist) t) + "\\>")) + + (setq-local tex-start-of-header "%\\*\\*start") + (setq-local tex-end-of-header "%\\*\\*end") + (setq-local tex-first-line-header-regexp "^\\\\input") + (setq-local tex-trailer "@bye\n") + + ;; Prevent filling certain lines, in addition to ones specified by + ;; the user. + (setq-local auto-fill-inhibit-regexp + (let ((prevent-filling "^@\\(def\\|multitable\\)")) + (if (null auto-fill-inhibit-regexp) + prevent-filling + (concat auto-fill-inhibit-regexp "\\|" prevent-filling))))) diff --git a/lisp/uniquify.el b/lisp/uniquify.el index 3340f1962de..546796b619a 100644 --- a/lisp/uniquify.el +++ b/lisp/uniquify.el @@ -184,10 +184,9 @@ contains the name of the directory which the buffer is visiting.") ;; Internal variables used free (defvar uniquify-possibly-resolvable nil) -(defvar uniquify-managed nil +(defvar-local uniquify-managed nil "Non-nil if the name of this buffer is managed by uniquify. It actually holds the list of `uniquify-item's corresponding to the conflict.") -(make-variable-buffer-local 'uniquify-managed) (put 'uniquify-managed 'permanent-local t) ;; Used in desktop.el to save the non-uniquified buffer name @@ -465,27 +464,34 @@ For use on `kill-buffer-hook'." ;; rename-buffer and create-file-buffer. (Setting find-file-hook isn't ;; sufficient.) -(defadvice rename-buffer (after rename-buffer-uniquify activate) +(advice-add 'rename-buffer :around #'uniquify--rename-buffer-advice) +(defun uniquify--rename-buffer-advice (rb-fun newname &optional unique &rest args) "Uniquify buffer names with parts of directory name." + (let ((retval (apply rb-fun newname unique args))) (uniquify-maybe-rerationalize-w/o-cb) - (if (null (ad-get-arg 1)) ; no UNIQUE argument. + (if (null unique) ;; Mark this buffer so it won't be renamed by uniquify. (setq uniquify-managed nil) (when uniquify-buffer-name-style ;; Rerationalize w.r.t the new name. (uniquify-rationalize-file-buffer-names - (ad-get-arg 0) + newname (uniquify-buffer-file-name (current-buffer)) (current-buffer)) - (setq ad-return-value (buffer-name (current-buffer)))))) + (setq retval (buffer-name (current-buffer))))) + retval)) -(defadvice create-file-buffer (after create-file-buffer-uniquify activate) + +(advice-add 'create-file-buffer :around #'uniquify--create-file-buffer-advice) +(defun uniquify--create-file-buffer-advice (cfb-fun filename &rest args) "Uniquify buffer names with parts of directory name." + (let ((retval (apply cfb-fun filename args))) (if uniquify-buffer-name-style - (let ((filename (expand-file-name (directory-file-name (ad-get-arg 0))))) + (let ((filename (expand-file-name (directory-file-name filename)))) (uniquify-rationalize-file-buffer-names (file-name-nondirectory filename) - (file-name-directory filename) ad-return-value)))) + (file-name-directory filename) retval))) + retval)) ;;; The End @@ -497,9 +503,8 @@ For use on `kill-buffer-hook'." (set-buffer buf) (when uniquify-managed (push (cons buf (uniquify-item-base (car uniquify-managed))) buffers))) - (dolist (fun '(rename-buffer create-file-buffer)) - (ad-remove-advice fun 'after (intern (concat (symbol-name fun) "-uniquify"))) - (ad-update fun)) + (advice-remove 'rename-buffer #'uniquify--rename-buffer-advice) + (advice-remove 'create-file-buffer #'uniquify--create-file-buffer-advice) (dolist (buf buffers) (set-buffer (car buf)) (rename-buffer (cdr buf) t)))) diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index 95c8edbe8b1..969d3c7d269 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,20 @@ +2012-12-22 Takafumi Arakaki <aka.tkf@gmail.com> (tiny change) + + * url-http.el (url-http-end-of-document-sentinel): Bind relevant + url-request-* variables around the call to url-http (Bug#11469). + + * url-expand.el (url-default-expander): Don't calculate a default + url port before checking url-type (Bug#12374). + +2012-12-22 Chong Yidong <cyd@gnu.org> + + * url-parse.el (url-port): Doc fix. + +2012-12-03 Chong Yidong <cyd@gnu.org> + + * url-misc.el (url-do-terminal-emulator): Use make-term instead of + terminal-emulator. + 2012-10-13 Liam Stitt <stittl@cuug.ab.ca> (tiny change) * url-vars.el (url-uncompressor-alist): diff --git a/lisp/url/url-expand.el b/lisp/url/url-expand.el index cd3c0163301..51a3e64064a 100644 --- a/lisp/url/url-expand.el +++ b/lisp/url/url-expand.el @@ -112,7 +112,7 @@ path components followed by `..' are removed, along with the `..' itself." ;; Well, they told us the scheme, let's just go with it. nil (setf (url-type urlobj) (or (url-type urlobj) (url-type defobj))) - (setf (url-port urlobj) (or (url-port urlobj) + (setf (url-port urlobj) (or (url-portspec urlobj) (and (string= (url-type urlobj) (url-type defobj)) (url-port defobj)))) diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 222dbc98e4a..5dd3a751702 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -890,8 +890,11 @@ should be shown to the user." (url-http-activate-callback) ;; Call `url-http' again if our connection expired. (erase-buffer) - (url-http url-current-object url-callback-function - url-callback-arguments (current-buffer)))) + (let ((url-request-method url-http-method) + (url-request-extra-headers url-http-extra-headers) + (url-request-data url-http-data)) + (url-http url-current-object url-callback-function + url-callback-arguments (current-buffer))))) ((url-http-parse-headers) (url-http-activate-callback)))))) diff --git a/lisp/url/url-misc.el b/lisp/url/url-misc.el index aca3aff6327..c8e9b591790 100644 --- a/lisp/url/url-misc.el +++ b/lisp/url/url-misc.el @@ -45,27 +45,21 @@ nil)) (defun url-do-terminal-emulator (type server port user) - (terminal-emulator - (generate-new-buffer (format "%s%s" (if user (concat user "@") "") server)) - (pcase type - (`rlogin "rlogin") - (`telnet "telnet") - (`tn3270 "tn3270") - (_ - (error "Unknown terminal emulator required: %s" type))) - (pcase type - (`rlogin - (if user - (list server "-l" user) - (list server))) - (`telnet - (if user (message "Please log in as user: %s" user)) - (if port - (list server port) - (list server))) - (`tn3270 - (if user (message "Please log in as user: %s" user)) - (list server))))) + (switch-to-buffer + (apply + 'make-term + (format "%s%s" (if user (concat user "@") "") server) + (cond ((eq type 'rlogin) "rlogin") + ((eq type 'telnet) "telnet") + ((eq type 'tn3270) "tn3270") + (t (error "Unknown terminal emulator required: %s" type))) + nil + (cond ((eq type 'rlogin) + (if user (list server "-l" user) (list server))) + ((eq type 'telnet) + (if port (list server port) (list server))) + ((eq type 'tn3270) + (list server)))))) ;;;###autoload (defun url-generic-emulator-loader (url) diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el index 644428d19cd..1628290a358 100644 --- a/lisp/url/url-parse.el +++ b/lisp/url/url-parse.el @@ -39,13 +39,14 @@ silent (use-cookies t)) (defsubst url-port (urlobj) - "Return the port number for the URL specified by URLOBJ." + "Return the port number for the URL specified by URLOBJ. +If the port spec is nil (i.e. URLOBJ specifies no port number), +return the default port number for URLOBJ's scheme." (declare (gv-setter (lambda (port) `(setf (url-portspec ,urlobj) ,port)))) (or (url-portspec urlobj) (if (url-type urlobj) (url-scheme-get-property (url-type urlobj) 'default-port)))) - (defun url-path-and-query (urlobj) "Return the path and query components of URLOBJ. These two components are stored together in the FILENAME slot of diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el index bc07b61acff..f0ea9c68464 100644 --- a/lisp/vc/add-log.el +++ b/lisp/vc/add-log.el @@ -61,8 +61,9 @@ ;;;###autoload (defcustom add-log-current-defun-function nil "If non-nil, function to guess name of surrounding function. -It is used by `add-log-current-defun' in preference to built-in rules. -Returns function's name as a string, or nil if outside a function." +It is called by `add-log-current-defun' with no argument, and +should return the function's name as a string, or nil if point is +outside a function." :type '(choice (const nil) function) :group 'change-log) @@ -1118,21 +1119,6 @@ parentheses." :type 'regexp :group 'change-log) -;;;###autoload -(defvar add-log-lisp-like-modes - '(emacs-lisp-mode lisp-mode scheme-mode dsssl-mode lisp-interaction-mode) - "Modes that look like Lisp to `add-log-current-defun'.") - -;;;###autoload -(defvar add-log-c-like-modes - '(c-mode c++-mode c++-c-mode objc-mode) - "Modes that look like C to `add-log-current-defun'.") - -;;;###autoload -(defvar add-log-tex-like-modes - '(TeX-mode plain-TeX-mode LaTeX-mode tex-mode) - "Modes that look like TeX to `add-log-current-defun'.") - (declare-function c-cpp-define-name "cc-cmds" ()) (declare-function c-defun-name "cc-cmds" ()) @@ -1152,75 +1138,21 @@ identifiers followed by `:' or `='. See variables Has a preference of looking backwards." (condition-case nil (save-excursion - (let ((location (point))) - (cond (add-log-current-defun-function - (funcall add-log-current-defun-function)) - ((apply 'derived-mode-p add-log-lisp-like-modes) - ;; If we are now precisely at the beginning of a defun, - ;; make sure beginning-of-defun finds that one - ;; rather than the previous one. - (or (eobp) (forward-char 1)) - (beginning-of-defun) - ;; Make sure we are really inside the defun found, - ;; not after it. - (when (and (looking-at "\\s(") - (progn (end-of-defun) - (< location (point))) - (progn (forward-sexp -1) - (>= location (point)))) - (if (looking-at "\\s(") - (forward-char 1)) - ;; Skip the defining construct name, typically "defun" - ;; or "defvar". - (forward-sexp 1) - ;; The second element is usually a symbol being defined. - ;; If it is not, use the first symbol in it. - (skip-chars-forward " \t\n'(") - (buffer-substring-no-properties (point) - (progn (forward-sexp 1) - (point))))) - ((apply 'derived-mode-p add-log-c-like-modes) - (or (c-cpp-define-name) - (c-defun-name))) - ((apply #'derived-mode-p add-log-tex-like-modes) - (if (re-search-backward - "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" - nil t) - (progn - (goto-char (match-beginning 0)) - (buffer-substring-no-properties - (1+ (point)) ; without initial backslash - (line-end-position))))) - ((derived-mode-p 'texinfo-mode) - (if (re-search-backward "^@node[ \t]+\\([^,\n]+\\)" nil t) - (match-string-no-properties 1))) - ((derived-mode-p 'perl-mode 'cperl-mode) - (if (re-search-backward "^sub[ \t]+\\([^({ \t\n]+\\)" nil t) - (match-string-no-properties 1))) - ;; Emacs's autoconf-mode installs its own - ;; `add-log-current-defun-function'. This applies to - ;; a different mode apparently for editing .m4 - ;; autoconf source. - ((derived-mode-p 'autoconf-mode) - (if (re-search-backward - "^\\(\\(m4_\\)?define\\|A._DEFUN\\)(\\[?\\([A-Za-z0-9_]+\\)" nil t) - (match-string-no-properties 3))) - (t - ;; If all else fails, try heuristics - (let (case-fold-search - result) - (end-of-line) - (when (re-search-backward - add-log-current-defun-header-regexp - (- (point) 10000) - t) - (setq result (or (match-string-no-properties 1) - (match-string-no-properties 0))) - ;; Strip whitespace away - (when (string-match "\\([^ \t\n\r\f].*[^ \t\n\r\f]\\)" - result) - (setq result (match-string-no-properties 1 result))) - result)))))) + (if add-log-current-defun-function + (funcall add-log-current-defun-function) + ;; If all else fails, try heuristics + (let (case-fold-search + result) + (end-of-line) + (when (re-search-backward add-log-current-defun-header-regexp + (- (point) 10000) t) + (setq result (or (match-string-no-properties 1) + (match-string-no-properties 0))) + ;; Strip whitespace away + (when (string-match "\\([^ \t\n\r\f].*[^ \t\n\r\f]\\)" + result) + (setq result (match-string-no-properties 1 result))) + result)))) (error nil))) (defvar change-log-get-method-definition-md) diff --git a/lisp/vc/compare-w.el b/lisp/vc/compare-w.el index 2423d322460..fa451ccbe20 100644 --- a/lisp/vc/compare-w.el +++ b/lisp/vc/compare-w.el @@ -53,13 +53,13 @@ whitespace is considered to match, and is skipped." :group 'compare-windows) (defcustom compare-ignore-whitespace nil - "Non-nil means `compare-windows' ignores whitespace." + "Non-nil means command `compare-windows' ignores whitespace." :type 'boolean :group 'compare-windows :version "22.1") (defcustom compare-ignore-case nil - "Non-nil means `compare-windows' ignores case differences." + "Non-nil means command `compare-windows' ignores case differences." :type 'boolean :group 'compare-windows) @@ -379,7 +379,7 @@ on third call it again advances points to the next difference and so on." (delete-overlay compare-windows-overlay2))))) (defun compare-windows-dehighlight () - "Remove highlighting created by `compare-windows-highlight'." + "Remove highlighting created by function `compare-windows-highlight'." (interactive) (remove-hook 'pre-command-hook 'compare-windows-dehighlight) (mapc 'delete-overlay compare-windows-overlays1) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 1647e6bca96..940457b6cc0 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -575,19 +575,21 @@ next hunk if TRY-HARDER is non-nil; otherwise signal an error." (easy-mmode-define-navigation diff-hunk diff-hunk-header-re "hunk" diff-end-of-hunk diff-restrict-view (when diff-auto-refine-mode - (setq diff--auto-refine-data (cons (current-buffer) (point-marker))) - (run-at-time 0.0 nil - (lambda () - (when diff--auto-refine-data - (let ((buffer (car diff--auto-refine-data)) - (point (cdr diff--auto-refine-data))) - (setq diff--auto-refine-data nil) - (with-local-quit - (when (buffer-live-p buffer) - (with-current-buffer buffer - (save-excursion - (goto-char point) - (diff-refine-hunk))))))))))) + (unless (prog1 diff--auto-refine-data + (setq diff--auto-refine-data + (cons (current-buffer) (point-marker)))) + (run-at-time 0.0 nil + (lambda () + (when diff--auto-refine-data + (let ((buffer (car diff--auto-refine-data)) + (point (cdr diff--auto-refine-data))) + (setq diff--auto-refine-data nil) + (with-local-quit + (when (buffer-live-p buffer) + (with-current-buffer buffer + (save-excursion + (goto-char point) + (diff-refine-hunk)))))))))))) (easy-mmode-define-navigation diff-file diff-file-header-re "file" diff-end-of-file) @@ -1296,7 +1298,7 @@ See `after-change-functions' for the meaning of BEG, END and LEN." (re-search-forward diff-context-mid-hunk-header-re nil t))))) (when (and ;; Don't try to fixup changes in the hunk header. - (> (car diff-unhandled-changes) start) + (>= (car diff-unhandled-changes) start) ;; Don't try to fixup changes in the mid-hunk header either. (or (not mid) (< (cdr diff-unhandled-changes) (match-beginning 0)) diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el index d0e496d2d21..8b4ff792969 100644 --- a/lisp/vc/diff.el +++ b/lisp/vc/diff.el @@ -86,7 +86,7 @@ exists. If NO-ASYNC is non-nil, call diff synchronously. When called interactively with a prefix argument, prompt interactively for diff switches. Otherwise, the switches -specified in `diff-switches' are passed to the diff command." +specified in the variable `diff-switches' are passed to the diff command." (interactive (let* ((newf (if (and buffer-file-name (file-exists-p buffer-file-name)) (read-file-name diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el index 9ad1b39ac38..b4d986fb036 100644 --- a/lisp/vc/ediff-diff.el +++ b/lisp/vc/ediff-diff.el @@ -453,52 +453,30 @@ one optional arguments, diff-number to refine.") c-prev c-end) ;; else convert lines to points (ediff-with-current-buffer A-buffer - (let ((longlines-mode-val - (if (and (boundp 'longlines-mode) longlines-mode) 1 0))) - ;; we must disable and then restore longlines-mode - (if (eq longlines-mode-val 1) - (longlines-mode 0)) - (goto-char (or a-prev-pt shift-A (point-min))) - (forward-line (- a-begin a-prev)) - (setq a-begin-pt (point)) - (forward-line (- a-end a-begin)) - (setq a-end-pt (point) - a-prev a-end - a-prev-pt a-end-pt) - (if (eq longlines-mode-val 1) - (longlines-mode longlines-mode-val)) - )) + (goto-char (or a-prev-pt shift-A (point-min))) + (forward-line (- a-begin a-prev)) + (setq a-begin-pt (point)) + (forward-line (- a-end a-begin)) + (setq a-end-pt (point) + a-prev a-end + a-prev-pt a-end-pt)) (ediff-with-current-buffer B-buffer - (let ((longlines-mode-val - (if (and (boundp 'longlines-mode) longlines-mode) 1 0))) - (if (eq longlines-mode-val 1) - (longlines-mode 0)) - (goto-char (or b-prev-pt shift-B (point-min))) - (forward-line (- b-begin b-prev)) - (setq b-begin-pt (point)) - (forward-line (- b-end b-begin)) - (setq b-end-pt (point) - b-prev b-end - b-prev-pt b-end-pt) - (if (eq longlines-mode-val 1) - (longlines-mode longlines-mode-val)) - )) + (goto-char (or b-prev-pt shift-B (point-min))) + (forward-line (- b-begin b-prev)) + (setq b-begin-pt (point)) + (forward-line (- b-end b-begin)) + (setq b-end-pt (point) + b-prev b-end + b-prev-pt b-end-pt)) (if (ediff-buffer-live-p C-buffer) (ediff-with-current-buffer C-buffer - (let ((longlines-mode-val - (if (and (boundp 'longlines-mode) longlines-mode) 1 0))) - (if (eq longlines-mode-val 1) - (longlines-mode 0)) - (goto-char (or c-prev-pt (point-min))) - (forward-line (- c-begin c-prev)) - (setq c-begin-pt (point)) - (forward-line (- c-end c-begin)) - (setq c-end-pt (point) - c-prev c-end - c-prev-pt c-end-pt) - (if (eq longlines-mode-val 1) - (longlines-mode longlines-mode-val)) - ))) + (goto-char (or c-prev-pt (point-min))) + (forward-line (- c-begin c-prev)) + (setq c-begin-pt (point)) + (forward-line (- c-end c-begin)) + (setq c-end-pt (point) + c-prev c-end + c-prev-pt c-end-pt))) (setq diff-list (nconc diff-list @@ -1085,65 +1063,36 @@ delimiter regions")) c-prev c-end) ;; else convert lines to points (ediff-with-current-buffer A-buffer - (let ((longlines-mode-val - (if (and (boundp 'longlines-mode) longlines-mode) 1 0))) - ;; we must disable and then restore longlines-mode - (if (eq longlines-mode-val 1) - (longlines-mode 0)) - (goto-char (or a-prev-pt shift-A (point-min))) - (forward-line (- a-begin a-prev)) - (setq a-begin-pt (point)) - (forward-line (- a-end a-begin)) - (setq a-end-pt (point) - a-prev a-end - a-prev-pt a-end-pt) - (if (eq longlines-mode-val 1) - (longlines-mode longlines-mode-val)) - )) + (goto-char (or a-prev-pt shift-A (point-min))) + (forward-line (- a-begin a-prev)) + (setq a-begin-pt (point)) + (forward-line (- a-end a-begin)) + (setq a-end-pt (point) + a-prev a-end + a-prev-pt a-end-pt)) (ediff-with-current-buffer B-buffer - (let ((longlines-mode-val - (if (and (boundp 'longlines-mode) longlines-mode) 1 0))) - (if (eq longlines-mode-val 1) - (longlines-mode 0)) - (goto-char (or b-prev-pt shift-B (point-min))) - (forward-line (- b-begin b-prev)) - (setq b-begin-pt (point)) - (forward-line (- b-end b-begin)) - (setq b-end-pt (point) - b-prev b-end - b-prev-pt b-end-pt) - (if (eq longlines-mode-val 1) - (longlines-mode longlines-mode-val)) - )) + (goto-char (or b-prev-pt shift-B (point-min))) + (forward-line (- b-begin b-prev)) + (setq b-begin-pt (point)) + (forward-line (- b-end b-begin)) + (setq b-end-pt (point) + b-prev b-end + b-prev-pt b-end-pt)) (ediff-with-current-buffer C-buffer - (let ((longlines-mode-val - (if (and (boundp 'longlines-mode) longlines-mode) 1 0))) - (if (eq longlines-mode-val 1) - (longlines-mode 0)) - (goto-char (or c-prev-pt shift-C (point-min))) - (forward-line (- c-begin c-prev)) - (setq c-begin-pt (point)) - (forward-line (- c-end c-begin)) - (setq c-end-pt (point) - c-prev c-end - c-prev-pt c-end-pt) - (if (eq longlines-mode-val 1) - (longlines-mode longlines-mode-val)) - )) + (goto-char (or c-prev-pt shift-C (point-min))) + (forward-line (- c-begin c-prev)) + (setq c-begin-pt (point)) + (forward-line (- c-end c-begin)) + (setq c-end-pt (point) + c-prev c-end + c-prev-pt c-end-pt)) (if (ediff-buffer-live-p anc-buffer) (ediff-with-current-buffer anc-buffer - (let ((longlines-mode-val - (if (and (boundp 'longlines-mode) longlines-mode) 1 0))) - (if (eq longlines-mode-val 1) - (longlines-mode 0)) - (forward-line (- c-or-anc-begin anc-prev)) - (setq anc-begin-pt (point)) - (forward-line (- c-or-anc-end c-or-anc-begin)) - (setq anc-end-pt (point) - anc-prev c-or-anc-end) - (if (eq longlines-mode-val 1) - (longlines-mode longlines-mode-val)) - ))) + (forward-line (- c-or-anc-begin anc-prev)) + (setq anc-begin-pt (point)) + (forward-line (- c-or-anc-end c-or-anc-begin)) + (setq anc-end-pt (point) + anc-prev c-or-anc-end))) (setq diff-list (nconc diff-list diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el index eccd17e5afe..64f4ee4a6ac 100644 --- a/lisp/vc/ediff-ptch.el +++ b/lisp/vc/ediff-ptch.el @@ -190,15 +190,15 @@ program." ;; We usually come up with two candidates and ediff-file-name-sans-prefix ;; resolves this later. ;; -;; The marker `marker1' delimits the beginning of the corresponding patch and -;; `marker2' does it for the end. +;; The marker `mark1' delimits the beginning of the corresponding patch and +;; `mark2' does it for the end. ;; The result of ediff-map-patch-buffer is a list, which is then assigned ;; to ediff-patch-map. ;; The function returns the number of elements in the list ediff-patch-map (defun ediff-map-patch-buffer (buf) (ediff-with-current-buffer buf (let ((count 0) - (mark1 (move-marker (make-marker) (point-min))) + (mark1 (point-min-marker)) (mark1-end (point-min)) (possible-file-names '("/dev/null" . "/dev/null")) mark2-end mark2 filenames diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index c72e8e2af18..2456d6ede41 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -3378,10 +3378,18 @@ Without an argument, it saves customized diff argument, if available (set-window-buffer wind cloned-buff) cloned-buff)) -(defun ediff-clone-buffer-for-current-diff-comparison (buff buf-type reg-name) - (let ((cloned-buff (ediff-make-cloned-buffer buff reg-name)) - (reg-start (ediff-get-diff-posn buf-type 'beg)) - (reg-end (ediff-get-diff-posn buf-type 'end))) +(defun ediff-buffer-type (buffer) + (cond ((eq buffer ediff-buffer-A) 'A) + ((eq buffer ediff-buffer-B) 'B) + ((eq buffer ediff-buffer-C) 'C) + ((eq buffer ediff-ancestor-buffer) 'Ancestor) + (t nil))) + +(defun ediff-clone-buffer-for-current-diff-comparison (buff reg-name) + (let* ((cloned-buff (ediff-make-cloned-buffer buff reg-name)) + (buf-type (ediff-buffer-type buff)) + (reg-start (ediff-get-diff-posn buf-type 'beg)) + (reg-end (ediff-get-diff-posn buf-type 'end))) (ediff-with-current-buffer cloned-buff ;; set region to be the current diff region (goto-char reg-start) @@ -3466,7 +3474,7 @@ Without an argument, it saves customized diff argument, if available (defun ediff-inferior-compare-regions () "Compare regions in an active Ediff session. -Like ediff-regions-linewise but is called from under an active Ediff session on +Like `ediff-regions-linewise' but is called from under an active Ediff session on the files that belong to that session. After quitting the session invoked via this function, type C-l to the parent @@ -3555,7 +3563,7 @@ Ediff Control Panel to restore highlighting." (setq bufA (if use-current-diff-p (ediff-clone-buffer-for-current-diff-comparison - bufA 'A "-Region.A-") + bufA "-Region.A-") (ediff-clone-buffer-for-region-comparison bufA "-Region.A-"))) (ediff-with-current-buffer bufA (setq begA (region-beginning) @@ -3570,7 +3578,7 @@ Ediff Control Panel to restore highlighting." (setq bufB (if use-current-diff-p (ediff-clone-buffer-for-current-diff-comparison - bufB 'B "-Region.B-") + bufB "-Region.B-") (ediff-clone-buffer-for-region-comparison bufB "-Region.B-"))) (ediff-with-current-buffer bufB (setq begB (region-beginning) diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index f8e753772e4..dfc7eee81a6 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -953,13 +953,14 @@ line of MSG." (while (re-search-forward (concat "^" (car header) ":" log-edit-header-contents-regexp) nil t) - (if (eq t (cdr header)) - (setq summary (match-string 1)) - (if (functionp (cdr header)) - (setq res (nconc res (funcall (cdr header) (match-string 1)))) - (push (match-string 1) res) - (push (or (cdr header) (car header)) res))) - (replace-match "" t t))) + (let ((txt (match-string 1))) + (replace-match "" t t) + (if (eq t (cdr header)) + (setq summary txt) + (if (functionp (cdr header)) + (setq res (nconc res (funcall (cdr header) txt))) + (push txt res) + (push (or (cdr header) (car header)) res)))))) ;; Remove header separator if the header is empty. (widen) (goto-char (point-min)) diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el index 52dc7edfa2d..208b93d9670 100644 --- a/lisp/vc/pcvs.el +++ b/lisp/vc/pcvs.el @@ -856,7 +856,8 @@ the problem." (defun cvs-cleanup-collection (c rm-handled rm-dirs rm-msgs) "Remove undesired entries. C is the collection -RM-HANDLED if non-nil means remove handled entries. +RM-HANDLED if non-nil means remove handled entries (if file is currently + visited, only remove if value is `all'). RM-DIRS behaves like `cvs-auto-remove-directories'. RM-MSGS if non-nil means remove messages." (let (last-fi first-dir (rerun t)) @@ -870,16 +871,17 @@ RM-MSGS if non-nil means remove messages." (subtype (cvs-fileinfo->subtype fi)) (keep (pcase type - ;; remove temp messages and keep the others + ;; Remove temp messages and keep the others. (`MESSAGE (not (or rm-msgs (eq subtype 'TEMP)))) - ;; remove entries + ;; Remove dead entries. (`DEAD nil) - ;; handled also? + ;; Handled also? (`UP-TO-DATE - (if (find-buffer-visiting (cvs-fileinfo->full-name fi)) - t - (not rm-handled))) - ;; keep the rest + (not + (if (find-buffer-visiting (cvs-fileinfo->full-name fi)) + (eq rm-handled 'all) + rm-handled))) + ;; Keep the rest. (_ (not (run-hook-with-args-until-success 'cvs-cleanup-functions fi)))))) @@ -2121,7 +2123,7 @@ if you are convinced that the process that created the lock is dead." Empty directories are removed." (interactive) (cvs-cleanup-collection cvs-cookies - t (or cvs-auto-remove-directories 'handled) t)) + 'all (or cvs-auto-remove-directories 'handled) t)) (defun-cvs-mode cvs-mode-acknowledge () diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index f436d300089..0968c83ae5f 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -620,15 +620,24 @@ or a superior directory.") (declare-function log-edit-extract-headers "log-edit" (headers string)) +(defun vc-bzr--sanitize-header (arg) + ;; Newlines in --fixes (and probably other fields as well) trigger a nasty + ;; Bazaar bug; see https://bugs.launchpad.net/bzr/+bug/1094180. + (lambda (str) (list arg + (replace-regexp-in-string "\\`[ \t]+\\|[ \t]+\\'" + "" (replace-regexp-in-string + "\n[ \t]?" " " str))))) + (defun vc-bzr-checkin (files rev comment) "Check FILES in to bzr with log message COMMENT. REV non-nil gets an error." (if rev (error "Can't check in a specific revision with bzr")) - (apply 'vc-bzr-command "commit" nil 0 - files (cons "-m" (log-edit-extract-headers '(("Author" . "--author") - ("Date" . "--commit-time") - ("Fixes" . "--fixes")) - comment)))) + (apply 'vc-bzr-command "commit" nil 0 files + (cons "-m" (log-edit-extract-headers + `(("Author" . ,(vc-bzr--sanitize-header "--author")) + ("Date" . ,(vc-bzr--sanitize-header "--commit-time")) + ("Fixes" . ,(vc-bzr--sanitize-header "--fixes"))) + comment)))) (defun vc-bzr-find-revision (file rev buffer) "Fetch revision REV of file FILE and put it into BUFFER." diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index e3b9941fe18..d10e3934680 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -930,6 +930,8 @@ If it is a file, return the corresponding cons for the file itself." (defvar use-vc-backend) ;; dynamically bound +;; Autoload cookie needed by desktop.el. +;;;###autoload (define-derived-mode vc-dir-mode special-mode "VC dir" "Major mode for VC directory buffers. Marking/Unmarking key bindings and actions: @@ -967,6 +969,8 @@ the *vc-dir* buffer. \\{vc-dir-mode-map}" (set (make-local-variable 'vc-dir-backend) use-vc-backend) + (set (make-local-variable 'desktop-save-buffer) + 'vc-dir-desktop-buffer-misc-data) (setq buffer-read-only t) (when (boundp 'tool-bar-map) (set (make-local-variable 'tool-bar-map) vc-dir-tool-bar-map)) @@ -1288,6 +1292,31 @@ These are the commands available for use in the file status buffer: "Default absence of extra information returned for a file." nil) + +;;; Support for desktop.el (adapted from what dired.el does). + +(declare-function desktop-file-name "desktop" (filename dirname)) + +(defun vc-dir-desktop-buffer-misc-data (dirname) + "Auxiliary information to be saved in desktop file." + (cons (desktop-file-name default-directory dirname) vc-dir-backend)) + +(defun vc-dir-restore-desktop-buffer (_filename _buffername misc-data) + "Restore a `vc-dir' buffer specified in a desktop file." + (let ((dir (car misc-data)) + (backend (cdr misc-data))) + (if (file-directory-p dir) + (progn + (vc-dir dir backend) + (current-buffer)) + (message "Desktop: Directory %s no longer exists." dir) + (when desktop-missing-file-warning (sit-for 1)) + nil))) + +(add-to-list 'desktop-buffer-mode-handlers + '(vc-dir-mode . vc-dir-restore-desktop-buffer)) + + (provide 'vc-dir) ;;; vc-dir.el ends here diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index fb39f1baec7..29f7aaa5480 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1148,7 +1148,7 @@ This command shares argument histories with \\[rgrep] and \\[grep]." The difference to vc-do-command is that this function always invokes `vc-git-program'." (apply 'vc-do-command (or buffer "*vc*") okstatus vc-git-program - file-or-list flags)) + file-or-list (cons "--no-pager" flags))) (defun vc-git--empty-db-p () "Check if the git db is empty (no commit done yet)." diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 18667117714..5c8201e51cc 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -93,7 +93,7 @@ ;; - clear-headers () ?? ;; - delete-file (file) TEST IT ;; - rename-file (old new) OK -;; - find-file-hook () PROBABLY NOT NEEDED +;; - find-file-hook () added for bug#10709 ;; 2) Implement Stefan Monnier's advice: ;; vc-hg-registered and vc-hg-state @@ -384,7 +384,7 @@ Optional arg REVISION is a revision to annotate from." (let ((newrev (1+ (string-to-number rev))) (tip-revision (with-temp-buffer - (vc-hg-command t 0 nil "tip") + (vc-hg-command t 0 nil "tip" "--style=default") (goto-char (point-min)) (re-search-forward "^changeset:[ \t]*\\([0-9]+\\):") (string-to-number (match-string-no-properties 1))))) @@ -464,6 +464,35 @@ REV is the revision to check out into WORKFILE." (vc-hg-command t 0 file "cat" "-r" rev) (vc-hg-command t 0 file "cat"))))) +(defun vc-hg-resolve-when-done () + "Call \"hg resolve -m\" if the conflict markers have been removed." + (save-excursion + (goto-char (point-min)) + (unless (re-search-forward "^<<<<<<< " nil t) + (vc-hg-command nil 0 buffer-file-name "resolve" "-m") + ;; Remove the hook so that it is not called multiple times. + (remove-hook 'after-save-hook 'vc-hg-resolve-when-done t)))) + +(defun vc-hg-find-file-hook () + (when (and buffer-file-name + (file-exists-p (concat buffer-file-name ".orig")) + ;; Hg does not seem to have a "conflict" status, eg + ;; hg http://bz.selenic.com/show_bug.cgi?id=2724 + (memq (vc-file-getprop buffer-file-name 'vc-state) + '(edited conflict)) + ;; Maybe go on to check that "hg resolve -l" says "U"? + ;; If "hg resolve -l" says there's a conflict but there are no + ;; conflict markers, it's not clear what we should do. + (save-excursion + (goto-char (point-min)) + (re-search-forward "^<<<<<<< " nil t))) + ;; Hg may not recognize "conflict" as a state, but we can do better. + (vc-file-setprop buffer-file-name 'vc-state 'conflict) + (smerge-start-session) + (add-hook 'after-save-hook 'vc-hg-resolve-when-done nil t) + (message "There are unresolved conflicts in this file"))) + + ;; Modeled after the similar function in vc-bzr.el (defun vc-hg-workfile-unchanged-p (file) (eq 'up-to-date (vc-hg-state file))) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index dd87fb6de79..99436303fa2 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -703,19 +703,21 @@ Before doing that, check if there are any old backups and get rid of them." ;; the state to 'edited and redisplay the mode line. (let* ((file buffer-file-name) (backend (vc-backend file))) - (and backend - (or (and (equal (vc-file-getprop file 'vc-checkout-time) - (nth 5 (file-attributes file))) - ;; File has been saved in the same second in which - ;; it was checked out. Clear the checkout-time - ;; to avoid confusion. - (vc-file-setprop file 'vc-checkout-time nil)) - t) - (eq (vc-checkout-model backend (list file)) 'implicit) - (vc-state-refresh file backend) - (vc-mode-line file backend)) - ;; Try to avoid unnecessary work, a *vc-dir* buffer is - ;; present if this is true. + (cond + ((null backend)) + ((eq (vc-checkout-model backend (list file)) 'implicit) + ;; If the file was saved in the same second in which it was + ;; checked out, clear the checkout-time to avoid confusion. + (if (equal (vc-file-getprop file 'vc-checkout-time) + (nth 5 (file-attributes file))) + (vc-file-setprop file 'vc-checkout-time nil)) + (if (vc-state-refresh file backend) + (vc-mode-line file backend))) + ;; If we saved an unlocked file on a locking based VCS, that + ;; file is not longer up-to-date. + ((eq (vc-file-getprop file 'vc-state) 'up-to-date) + (vc-file-setprop file 'vc-state nil))) + ;; Resynch *vc-dir* buffers, if any are present. (when vc-dir-buffers (vc-dir-resynch-file file)))) @@ -856,8 +858,9 @@ current, and kill the buffer that visits the link." (set (make-local-variable 'backup-inhibited) t)) ;; Let the backend setup any buffer-local things he needs. (vc-call-backend backend 'find-file-hook)) - ((let ((link-type (and (not (equal buffer-file-name buffer-file-truename)) - (vc-backend buffer-file-truename)))) + ((let* ((truename (expand-file-name buffer-file-truename)) + (link-type (and (not (equal buffer-file-name truename)) + (vc-backend truename)))) (cond ((not link-type) nil) ;Nothing to do. ((eq vc-follow-symlinks nil) (message diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index 2899a5e8737..b79af07a756 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -155,9 +155,24 @@ If you want to force an empty list of arguments, use t." (vc-svn-command t 0 file "status" (if localp "-v" "-u")) (vc-svn-parse-status file)))) +;; NB this does not handle svn properties, which can be changed +;; without changing the file timestamp. +;; Note that unlike vc-cvs-state-heuristic, this is not called from +;; vc-svn-state. AFAICS, it is only called from vc-state-refresh via +;; vc-after-save (bug#7850). Therefore the fact that it ignores +;; properties is irrelevant. If you want to make vc-svn-state call +;; this, it should be extended to handle svn properties. (defun vc-svn-state-heuristic (file) "SVN-specific state heuristic." - (vc-svn-state file 'local)) + ;; If the file has not changed since checkout, consider it `up-to-date'. + ;; Otherwise consider it `edited'. Copied from vc-cvs-state-heuristic. + (let ((checkout-time (vc-file-getprop file 'vc-checkout-time)) + (lastmod (nth 5 (file-attributes file)))) + (cond + ((equal checkout-time lastmod) 'up-to-date) + ((string= (vc-working-revision file) "0") 'added) + ((null checkout-time) 'unregistered) + (t 'edited)))) ;; FIXME it would be better not to have the "remote" argument, ;; but to distinguish the two output formats based on content. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 35c15f1721d..9b8b94916c4 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -659,6 +659,10 @@ (eval-when-compile (require 'dired)) +(declare-function dired-get-filename "dired" (&optional localp noerror)) +(declare-function dired-move-to-filename "dired" (&optional err eol)) +(declare-function dired-marker-regexp "dired" ()) + (unless (assoc 'vc-parent-buffer minor-mode-alist) (setq minor-mode-alist (cons '(vc-parent-buffer vc-parent-buffer-name) @@ -1072,6 +1076,17 @@ For old-style locking-based version control systems, like RCS: ;; among all the `files'. (model (nth 4 vc-fileset))) + ;; If a buffer has unsaved changes, a checkout would discard those + ;; changes, so treat the buffer as having unlocked changes. + (when (and (not (eq model 'implicit)) (eq state 'up-to-date)) + (let ((files files)) + (while files + (let ((buffer (get-file-buffer (car files)))) + (and buffer + (buffer-modified-p buffer) + (setq state 'unlocked-changes + files nil)))))) + ;; Do the right thing (cond ((eq state 'missing) @@ -1271,12 +1286,10 @@ first backend that could register the file is used." ;; many VCS allow that as well. (dolist (fname files) (let ((bname (get-file-buffer fname))) - (unless fname (setq fname buffer-file-name)) - (when (vc-backend fname) - (if (vc-registered fname) - (error "This file is already registered") - (unless (y-or-n-p "Previous master file has vanished. Make a new one? ") - (error "Aborted")))) + (unless fname + (setq fname buffer-file-name)) + (when (vc-call-backend backend 'registered fname) + (error "This file is already registered")) ;; Watch out for new buffers of size 0: the corresponding file ;; does not exist yet, even though buffer-modified-p is nil. (when bname @@ -2556,8 +2569,12 @@ backend to NEW-BACKEND, and unregister FILE from the current backend. ;;;###autoload (defun vc-delete-file (file) - "Delete file and mark it as such in the version control system." - (interactive "fVC delete file: ") + "Delete file and mark it as such in the version control system. +If called interactively, read FILE, defaulting to the current +buffer's file name if it's under version control." + (interactive (list (read-file-name "VC delete file: " nil + (when (vc-backend buffer-file-name) + buffer-file-name) t))) (setq file (expand-file-name file)) (let ((buf (get-file-buffer file)) (backend (vc-backend file))) @@ -2595,8 +2612,13 @@ backend to NEW-BACKEND, and unregister FILE from the current backend. ;;;###autoload (defun vc-rename-file (old new) - "Rename file OLD to NEW in both work area and repository." - (interactive "fVC rename file: \nFRename to: ") + "Rename file OLD to NEW in both work area and repository. +If called interactively, read OLD and NEW, defaulting OLD to the +current buffer's file name if it's under version control." + (interactive (list (read-file-name "VC rename file: " nil + (when (vc-backend buffer-file-name) + buffer-file-name) t) + (read-file-name "Rename to: "))) ;; in CL I would have said (setq new (merge-pathnames new old)) (let ((old-base (file-name-nondirectory old))) (when (and (not (string= "" old-base)) diff --git a/lisp/vcursor.el b/lisp/vcursor.el index b586145d667..b6ea3383bec 100644 --- a/lisp/vcursor.el +++ b/lisp/vcursor.el @@ -882,6 +882,8 @@ ALL-FRAMES is also used to decide whether to split the window." (vcursor-disable -1)))) ) +(declare-function compare-windows-skip-whitespace "compare-w" (start)) + ;; vcursor-compare-windows is copied from compare-w.el with only ;; minor modifications; these are too bound up with the function ;; to make it really useful to call compare-windows itself. diff --git a/lisp/view.el b/lisp/view.el index b814520fceb..2717c915c71 100644 --- a/lisp/view.el +++ b/lisp/view.el @@ -461,15 +461,13 @@ then \\[View-leave], \\[View-quit] and \\[View-kill-and-leave] will return to th Entry to view-mode runs the normal hook `view-mode-hook'." :lighter " View" :keymap view-mode-map - (if view-mode (view-mode-enable) (view-mode-disable))) + (if view-mode (view--enable) (view--disable))) -(defun view-mode-enable () - "Turn on View mode." +(defun view--enable () ;; Always leave view mode before changing major mode. ;; This is to guarantee that the buffer-read-only variable is restored. - (add-hook 'change-major-mode-hook 'view-mode-disable nil t) - (setq view-mode t - view-page-size nil + (add-hook 'change-major-mode-hook 'view--disable nil t) + (setq view-page-size nil view-half-page-size nil view-old-buffer-read-only buffer-read-only buffer-read-only t) @@ -480,15 +478,18 @@ Entry to view-mode runs the normal hook `view-mode-hook'." (format "continue viewing %s" (if (buffer-file-name) (file-name-nondirectory (buffer-file-name)) - (buffer-name))))) - (force-mode-line-update) - (run-hooks 'view-mode-hook)) + (buffer-name)))))) + +(define-obsolete-function-alias 'view-mode-enable 'view-mode "24.4") (defun view-mode-disable () "Turn off View mode." - (remove-hook 'change-major-mode-hook 'view-mode-disable t) + (declare (obsolete view-mode "24.4")) + (view-mode -1)) + +(defun view--disable () + (remove-hook 'change-major-mode-hook 'view--disable t) (and view-overlay (delete-overlay view-overlay)) - (force-mode-line-update) ;; Calling toggle-read-only while View mode is enabled ;; sets view-read-only to t as a buffer-local variable ;; after exiting View mode. That arranges that the next toggle-read-only @@ -497,7 +498,6 @@ Entry to view-mode runs the normal hook `view-mode-hook'." ;; so that View mode stays off if toggle-read-only is called. (if (local-variable-p 'view-read-only) (kill-local-variable 'view-read-only)) - (setq view-mode nil) (if (boundp 'Helper-return-blurb) (setq Helper-return-blurb view-old-Helper-return-blurb)) (if buffer-read-only @@ -560,8 +560,7 @@ This function runs the normal hook `view-mode-hook'." (setq view-exit-action exit-action)) (unless view-mode - (view-mode-enable) - (force-mode-line-update) + (view-mode 1) (unless view-inhibit-help-message (message "%s" (substitute-command-keys "\ @@ -588,7 +587,7 @@ current buffer. " (when view-mode (let ((buffer (window-buffer))) (unless view-no-disable-on-exit - (view-mode-disable)) + (view-mode -1)) (unless exit-only (cond @@ -599,8 +598,7 @@ current buffer. " (quit-window))) (when exit-action - (funcall exit-action buffer)) - (force-mode-line-update))))) + (funcall exit-action buffer)))))) (defun View-exit () "Exit View mode but stay in current buffer." diff --git a/lisp/whitespace.el b/lisp/whitespace.el index e2a726f4264..ed7edbc5a68 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -1271,19 +1271,19 @@ SYMBOL is a valid symbol associated with CHAR. (defvar whitespace-point (point) "Used to save locally current point value. -Used by `whitespace-trailing-regexp' function (which see).") +Used by function `whitespace-trailing-regexp' (which see).") (defvar whitespace-font-lock-refontify nil "Used to save locally the font-lock refontify state. -Used by `whitespace-post-command-hook' function (which see).") +Used by function `whitespace-post-command-hook' (which see).") (defvar whitespace-bob-marker nil "Used to save locally the bob marker value. -Used by `whitespace-post-command-hook' function (which see).") +Used by function `whitespace-post-command-hook' (which see).") (defvar whitespace-eob-marker nil "Used to save locally the eob marker value. -Used by `whitespace-post-command-hook' function (which see).") +Used by function `whitespace-post-command-hook' (which see).") (defvar whitespace-buffer-changed nil "Used to indicate locally if buffer changed. diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 5402b0ec204..fb62b039d79 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -526,7 +526,16 @@ Otherwise, just return the value." "Extract the default external value of WIDGET." (widget-apply widget :value-to-external (or (widget-get widget :value) - (widget-apply widget :default-get)))) + (progn + (when (widget-get widget :args) + (let (args) + (dolist (arg (widget-get widget :args)) + (setq args (append args + (if (widget-get arg :inline) + (widget-get arg :args) + (list arg))))) + (widget-put widget :args args))) + (widget-apply widget :default-get))))) (defun widget-match-inline (widget vals) "In WIDGET, match the start of VALS." diff --git a/lisp/window.el b/lisp/window.el index 63d75f60e1e..627b9a425eb 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -1340,7 +1340,7 @@ violate size restrictions of WINDOW or its child windows." delta)) (t 0))) -(defun window--resizable-p (window delta &optional horizontal ignore trail noup nodown) +(defun window-resizable-p (window delta &optional horizontal ignore trail noup nodown) "Return t if WINDOW can be resized vertically by DELTA lines. WINDOW must be a valid window and defaults to the selected one. For the meaning of the arguments of this function see the @@ -1943,7 +1943,7 @@ instead." ;; nil or the minibuffer window is active, resize the minibuffer ;; window. (window--resize-mini-window minibuffer-window (- delta))) - ((window--resizable-p window delta horizontal ignore) + ((window-resizable-p window delta horizontal ignore) (window--resize-reset frame horizontal) (window--resize-this-window window delta horizontal ignore t) (if (and (not window-combination-resize) @@ -1969,6 +1969,14 @@ instead." (t (error "Cannot resize window %s" window))))) +(defun window-resize-no-error (window delta &optional horizontal ignore) + "Resize WINDOW vertically if it is resizable by DELTA lines. +This function is like `window-resize' but does not signal an +error when WINDOW cannot be resized. For the meaning of the +optional arguments see the documentation of `window-resize'." + (when (window-resizable-p window delta horizontal ignore) + (window-resize window delta horizontal ignore))) + (defun window--resize-child-windows-skip-p (window) "Return non-nil if WINDOW shall be skipped by resizing routines." (memq (window-new-normal window) '(ignore stuck skip))) @@ -2594,7 +2602,7 @@ negative, shrink selected window by -DELTA lines or columns." ;; If the selected window is full height and `resize-mini-windows' ;; is nil, resize the minibuffer window. (window--resize-mini-window minibuffer-window (- delta))) - ((window--resizable-p nil delta horizontal) + ((window-resizable-p nil delta horizontal) (window-resize nil delta horizontal)) (t (window-resize @@ -2627,7 +2635,7 @@ Also see the `window-min-height' variable." ;; If the selected window is full height and `resize-mini-windows' ;; is nil, resize the minibuffer window. (window--resize-mini-window minibuffer-window delta)) - ((window--resizable-p nil (- delta) horizontal) + ((window-resizable-p nil (- delta) horizontal) (window-resize nil (- delta) horizontal)) (t (window-resize @@ -2901,7 +2909,7 @@ that is its frame's root window." (set-window-new-normal sibling (+ (window-normal-size sibling horizontal) (window-normal-size window horizontal)))) - ((window--resizable-p window (- size) horizontal nil nil nil t) + ((window-resizable-p window (- size) horizontal nil nil nil t) ;; Can do without resizing fixed-size windows. (window--resize-siblings window (- size) horizontal)) (t @@ -4440,13 +4448,13 @@ value can be also stored on disk and read back in a new session." (let ((delta (- (cdr (assq 'total-height item)) (window-total-height window))) window-size-fixed) - (when (window--resizable-p window delta) + (when (window-resizable-p window delta) (window-resize window delta))) ;; Else check whether the window is not high enough. (let* ((min-size (window-min-size window nil ignore)) (delta (- min-size (window-total-size window)))) (when (and (> delta 0) - (window--resizable-p window delta nil ignore)) + (window-resizable-p window delta nil ignore)) (window-resize window delta nil ignore)))) ;; Adjust horizontally. (if (memq window-size-fixed '(t width)) @@ -4454,13 +4462,13 @@ value can be also stored on disk and read back in a new session." (let ((delta (- (cdr (assq 'total-width item)) (window-total-width window))) window-size-fixed) - (when (window--resizable-p window delta) + (when (window-resizable-p window delta) (window-resize window delta))) ;; Else check whether the window is not wide enough. (let* ((min-size (window-min-size window t ignore)) (delta (- min-size (window-total-size window t)))) (when (and (> delta 0) - (window--resizable-p window delta t ignore)) + (window-resizable-p window delta t ignore)) (window-resize window delta t ignore)))) ;; Set dedicated status. (set-window-dedicated-p window (cdr (assq 'dedicated state))) @@ -5211,7 +5219,7 @@ live." (* (window-total-size (frame-root-window window)) height)))) (delta (- new-height (window-total-size window)))) - (when (and (window--resizable-p window delta nil 'safe) + (when (and (window-resizable-p window delta nil 'safe) (window-combined-p window)) (window-resize window delta nil 'safe)))) ((functionp height) @@ -5227,7 +5235,7 @@ live." (* (window-total-size (frame-root-window window) t) width)))) (delta (- new-width (window-total-size window t)))) - (when (and (window--resizable-p window delta t 'safe) + (when (and (window-resizable-p window delta t 'safe) (window-combined-p window t)) (window-resize window delta t 'safe)))) ((functionp width) diff --git a/lisp/woman.el b/lisp/woman.el index e5d5ac1660f..1cead32ab2f 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -949,6 +949,7 @@ or different fonts." (defun woman-default-faces () "Set foreground colors of italic and bold faces to their default values." + (declare (obsolete choose-completion-guess-base-position "23.2")) (interactive) (face-spec-set 'woman-italic (face-user-default-spec 'woman-italic)) (face-spec-set 'woman-bold (face-user-default-spec 'woman-bold))) @@ -956,6 +957,7 @@ or different fonts." (defun woman-monochrome-faces () "Set foreground colors of italic and bold faces to that of the default face. This is usually either black or white." + (declare (obsolete choose-completion-guess-base-position "23.2")) (interactive) (set-face-foreground 'woman-italic 'unspecified) (set-face-foreground 'woman-bold 'unspecified)) @@ -1303,12 +1305,12 @@ cache to be re-read." ((null (cdr files)) (car (car files))) ; only 1 file for topic. (t ;; Multiple files for topic, so must select 1. - ;; Unread the command event (TAB = ?\t = 9) that runs the command - ;; `minibuffer-complete' in order to automatically complete the - ;; minibuffer contents as far as possible. - (setq unread-command-events '(9)) ; and delete any type-ahead! - (completing-read "Manual file: " files nil 1 - (try-completion "" files) 'woman-file-history)))))) + ;; Run the command `minibuffer-complete' in order to automatically + ;; complete the minibuffer contents as far as possible. + (minibuffer-with-setup-hook + (lambda () (let ((this-command this-command)) (minibuffer-complete))) + (completing-read "Manual file: " files nil 1 + (try-completion "" files) 'woman-file-history))))))) (defun woman-select (predicate list) "Select unique elements for which PREDICATE is true in LIST. @@ -1550,11 +1552,13 @@ Also make each path-info component into a list. (woman-dired-define-keys) (add-hook 'dired-mode-hook 'woman-dired-define-keys)) +(declare-function dired-get-filename "dired" + (&optional localp no-error-if-not-filep)) + ;;;###autoload (defun woman-dired-find-file () "In dired, run the WoMan man-page browser on this file." (interactive) - ;; dired-get-filename is defined in dired.el (woman-find-file (dired-get-filename))) @@ -1826,8 +1830,6 @@ Argument EVENT is the invoking mouse event." ["Use Full Frame Width" woman-toggle-fill-frame :active t :style toggle :selected woman-fill-frame] ["Reformat Last Man Page" woman-reformat-last-file t] - ["Use Monochrome Main Faces" woman-monochrome-faces t] - ["Use Default Main Faces" woman-default-faces t] ["Make Contents Menu" (woman-imenu t) (not woman-imenu-done)] "--" ["Describe (Wo)Man Mode" describe-mode t] @@ -1947,6 +1949,9 @@ Optional argument REDRAW, if non-nil, forces mode line to be updated." (message "Woman fill column set to %s." (if woman-fill-frame "frame width" woman-fill-column))) +(declare-function apropos-print "apropos" + (do-keys spacing &optional text nosubst)) + (defun woman-mini-help () "Display WoMan commands and user options in an `apropos' buffer." ;; Based on apropos-command in apropos.el |