diff options
| author | Xue Fuqiao | 2013-06-12 20:12:47 +0800 |
|---|---|---|
| committer | Xue Fuqiao | 2013-06-12 20:12:47 +0800 |
| commit | 6186a2767fcae48a43675dabc457ed2b2177b884 (patch) | |
| tree | 8eb823df7cbd64d9bf9201c03cadd89fe1e441ac /lisp | |
| parent | 8d0b26f65d9d4cf52a11a273073cd52fb1feaf13 (diff) | |
| parent | 5f9dbd7a1241239b5376435e96fbd9dbfa65e0f5 (diff) | |
| download | emacs-6186a2767fcae48a43675dabc457ed2b2177b884.tar.gz emacs-6186a2767fcae48a43675dabc457ed2b2177b884.zip | |
Merge from mainline.
Diffstat (limited to 'lisp')
32 files changed, 1257 insertions, 730 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index a6f45a1d727..5abb3b1b1bc 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,7 +1,147 @@ | |||
| 1 | 2013-06-12 Xue Fuqiao <xfq.free@gmail.com> | ||
| 2 | |||
| 3 | * ibuf-ext.el (ibuffer-mark-help-buffers): Doc fix. | ||
| 4 | |||
| 5 | 2013-06-12 Andreas Schwab <schwab@suse.de> | ||
| 6 | |||
| 7 | * international/mule.el (auto-coding-alist): Use utf-8-emacs-unix | ||
| 8 | for auto-save files. | ||
| 9 | |||
| 10 | 2013-06-12 Glenn Morris <rgm@gnu.org> | ||
| 11 | |||
| 12 | * ido.el (ido-delete-ignored-files): Remove. | ||
| 13 | (ido-wide-find-dirs-or-files, ido-make-file-list-1): | ||
| 14 | Go back to calling ido-ignore-item-p directly. | ||
| 15 | |||
| 16 | 2013-06-12 Eyal Lotem <eyal.lotem@gmail.com> (tiny change) | ||
| 17 | |||
| 18 | * ido.el (ido-wide-find-dirs-or-files): Respect ido-case-fold. | ||
| 19 | |||
| 20 | * ido.el (ido-delete-ignored-files): New function, | ||
| 21 | split from ido-make-file-list-1. | ||
| 22 | (ido-wide-find-dirs-or-files): Maybe ignore files. (Bug#13003) | ||
| 23 | (ido-make-file-list-1): Use ido-delete-ignored-files. | ||
| 24 | |||
| 25 | 2013-06-12 Leo Liu <sdl.web@gmail.com> | ||
| 26 | |||
| 27 | * progmodes/octave.el (inferior-octave-startup) | ||
| 28 | (inferior-octave-completion-table) | ||
| 29 | (inferior-octave-track-window-width-change) | ||
| 30 | (octave-eldoc-function-signatures, octave-help) | ||
| 31 | (octave-find-definition): Use single quoted strings. | ||
| 32 | (inferior-octave-startup-args): Change default value. | ||
| 33 | (inferior-octave-startup): Do not hard code "-i" and | ||
| 34 | "--no-line-editing". | ||
| 35 | (inferior-octave-resync-dirs): Add optional arg NOERROR. | ||
| 36 | (inferior-octave-directory-tracker): Use it. | ||
| 37 | (octave-goto-function-definition): Robustify. | ||
| 38 | (octave-help): Support highlighting operators in 'See also'. | ||
| 39 | (octave-find-definition): Find subfunctions only in Octave mode. | ||
| 40 | |||
| 41 | 2013-06-12 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 42 | |||
| 43 | * help-fns.el (help-fns--compiler-macro): If the handler function is | ||
| 44 | named, then put a link to it. | ||
| 45 | * help-mode.el (help-function-cmacro): Adjust regexp for cl-lib names. | ||
| 46 | * emacs-lisp/cl-macs.el (cl--compiler-macro-typep): New function. | ||
| 47 | (cl-typep): Use it. | ||
| 48 | (cl-eval-when): Simplify debug spec. | ||
| 49 | (cl-define-compiler-macro): Use eval-and-compile. Give a name to the | ||
| 50 | compiler-macro function instead of setting `compiler-macro-file'. | ||
| 51 | |||
| 52 | 2013-06-12 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 53 | Daniel Hackney <dan@haxney.org> | ||
| 54 | |||
| 55 | First part of Daniel Hackney's patch to package.el. | ||
| 56 | * emacs-lisp/package.el: Use defstruct. | ||
| 57 | (package-desc): New, main struct. | ||
| 58 | (package--bi-desc, package--ac-desc): New structs, used to describe the | ||
| 59 | format in external files. | ||
| 60 | (package-desc-vers): Replace with package-desc-version accessor. | ||
| 61 | (package-desc-doc): Replace with package-desc-summary accessor. | ||
| 62 | (package-activate-1): Remove `package' arg since the pkg-vec now | ||
| 63 | includes the name. | ||
| 64 | (define-package): Use package-desc-from-define. | ||
| 65 | (package-unpack-single): Change file-name arg to be a symbol. | ||
| 66 | (package--add-to-archive-contents): Use package-desc-create and new | ||
| 67 | accessor functions to package--ac-desc. | ||
| 68 | (package-buffer-info, package-tar-file-info): Return a package-desc. | ||
| 69 | (package-install-from-buffer): Remove `type' argument. Change pkg-info | ||
| 70 | arg to be a package-desc. | ||
| 71 | (package-install-file): Adjust accordingly. Use \' to match EOS. | ||
| 72 | (package--from-builtin): New function. | ||
| 73 | (describe-package-1, package-menu--generate): Use it. | ||
| 74 | (package--make-autoloads-and-compile): Change name arg to be a symbol. | ||
| 75 | (package-generate-autoloads): Idem and return the name of the file. | ||
| 76 | * emacs-lisp/package-x.el (package-upload-buffer-internal): | ||
| 77 | Change pkg-info arg to be a package-desc. | ||
| 78 | Use package-make-ac-desc. | ||
| 79 | (package-upload-file): Use \' to match EOS. | ||
| 80 | * finder.el (finder-compile-keywords): Use package-make-builtin. | ||
| 81 | |||
| 82 | 2013-06-11 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 83 | |||
| 84 | * vc/vc.el (vc-deduce-fileset): Change error message. | ||
| 85 | (vc-read-backend): New function. | ||
| 86 | (vc-next-action): Use it. | ||
| 87 | |||
| 88 | * subr.el (function-arity): Remove (mistakenly added) (bug#14590). | ||
| 89 | |||
| 90 | * progmodes/prolog.el (prolog-make-keywords-regexp): Remove. | ||
| 91 | (prolog-font-lock-keywords): Use regexp-opt instead. | ||
| 92 | Don't manually highlight strings. | ||
| 93 | (prolog-mode-variables): Simplify comment-start-skip. | ||
| 94 | (prolog-consult-compile): Use display-buffer. Remove unused old-filter. | ||
| 95 | |||
| 96 | * emacs-lisp/generic.el (generic--normalise-comments) | ||
| 97 | (generic-set-comment-syntax, generic-set-comment-vars): New functions. | ||
| 98 | (generic-mode-set-comments): Use them. | ||
| 99 | (generic-bracket-support): Use setq-local. | ||
| 100 | (generic-make-keywords-list): Declare obsolete. | ||
| 101 | |||
| 102 | 2013-06-11 Glenn Morris <rgm@gnu.org> | ||
| 103 | |||
| 104 | * emacs-lisp/lisp-mode.el (lisp-mode-variables): | ||
| 105 | Prettify after setting font-lock-defaults. (Bug#14574) | ||
| 106 | |||
| 107 | 2013-06-11 Juanma Barranquero <lekktu@gmail.com> | ||
| 108 | |||
| 109 | * replace.el (query-replace, occur-read-regexp-defaults-function) | ||
| 110 | (replace-search): | ||
| 111 | * subr.el (declare-function, number-sequence, local-set-key) | ||
| 112 | (substitute-key-definition, locate-user-emacs-file) | ||
| 113 | (with-silent-modifications, split-string, eval-after-load): | ||
| 114 | Fix typos, remove unneeded backslashes and reflow some docstrings. | ||
| 115 | |||
| 116 | 2013-06-11 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 117 | |||
| 118 | * international/mule-conf.el (file-coding-system-alist): Use utf-8 as | ||
| 119 | default for Elisp files. | ||
| 120 | |||
| 121 | 2013-06-11 Glenn Morris <rgm@gnu.org> | ||
| 122 | |||
| 123 | * vc/log-view.el (log-view-mode-map): Inherit from special-mode-map, | ||
| 124 | although define-derived-mode was doing this anyway. (Bug#14583) | ||
| 125 | |||
| 126 | 2013-06-10 Juanma Barranquero <lekktu@gmail.com> | ||
| 127 | |||
| 128 | * allout.el (allout-encryption-plaintext-sanitization-regexps): | ||
| 129 | Fix make-variable-buffer-local call to refer to the correct variable. | ||
| 130 | |||
| 131 | 2013-06-10 Aidan Gauland <aidalgol@amuri.net> | ||
| 132 | |||
| 133 | * eshell/em-term.el (eshell-visual-commands) | ||
| 134 | (eshell-visual-subcommands, eshell-visual-options): | ||
| 135 | Add summary line to docstrings. Add cross-references. | ||
| 136 | |||
| 137 | 2013-06-10 Glenn Morris <rgm@gnu.org> | ||
| 138 | |||
| 139 | * epa.el (epa-read-file-name): New function. (Bug#14510) | ||
| 140 | (epa-decrypt-file): Make plain-file optional. Use epa-read-file-name. | ||
| 141 | |||
| 1 | 2013-06-09 Xue Fuqiao <xfq.free@gmail.com> | 142 | 2013-06-09 Xue Fuqiao <xfq.free@gmail.com> |
| 2 | 143 | ||
| 3 | * vc/vc-cvs.el (vc-cvs-stay-local): Doc fix. | 144 | * vc/vc-cvs.el (vc-cvs-stay-local): Doc fix. |
| 4 | |||
| 5 | * vc/vc-hooks.el (vc-stay-local): Doc fix. | 145 | * vc/vc-hooks.el (vc-stay-local): Doc fix. |
| 6 | 146 | ||
| 7 | 2013-06-09 Aidan Gauland <aidalgol@amuri.net> | 147 | 2013-06-09 Aidan Gauland <aidalgol@amuri.net> |
| @@ -12,9 +152,11 @@ | |||
| 12 | 2013-06-09 Aidan Gauland <aidalgol@amuri.net> | 152 | 2013-06-09 Aidan Gauland <aidalgol@amuri.net> |
| 13 | 153 | ||
| 14 | * eshell/em-term.el (eshell-visual-command-p): New function. | 154 | * eshell/em-term.el (eshell-visual-command-p): New function. |
| 15 | (eshell-term-initialize): Move long lambda to separate function eshell-visual-command-p. | 155 | (eshell-term-initialize): Move long lambda to separate function |
| 16 | * eshell/em-dirs.el (eshell-dirs-initialise): Add missing #' to lambda. | 156 | eshell-visual-command-p. |
| 17 | * eshell/em-script.el (eshell-script-initialize): Add missing #' to lambda. | 157 | * eshell/em-dirs.el (eshell-dirs-initialise): |
| 158 | * eshell/em-script.el (eshell-script-initialize): | ||
| 159 | Add missing #' to lambda. | ||
| 18 | 160 | ||
| 19 | 2013-06-08 Leo Liu <sdl.web@gmail.com> | 161 | 2013-06-08 Leo Liu <sdl.web@gmail.com> |
| 20 | 162 | ||
| @@ -235,7 +377,7 @@ | |||
| 235 | (auto-revert-notify-event-p, auto-revert-notify-event-file-name) | 377 | (auto-revert-notify-event-p, auto-revert-notify-event-file-name) |
| 236 | (auto-revert-notify-handler): Handle also gfilenotify. | 378 | (auto-revert-notify-handler): Handle also gfilenotify. |
| 237 | 379 | ||
| 238 | * subr.el (file-notify-handle-event): New defun. Replacing ... | 380 | * subr.el (file-notify-handle-event): New defun. Replacing ... |
| 239 | (inotify-event-p, inotify-handle-event, w32notify-handle-event): | 381 | (inotify-event-p, inotify-handle-event, w32notify-handle-event): |
| 240 | Remove. | 382 | Remove. |
| 241 | 383 | ||
| @@ -347,10 +489,10 @@ | |||
| 347 | (eshell-find-interpreter): Add new second parameter ARGS. | 489 | (eshell-find-interpreter): Add new second parameter ARGS. |
| 348 | 490 | ||
| 349 | * eshell/em-script.el (eshell-script-initialize): Add second arg | 491 | * eshell/em-script.el (eshell-script-initialize): Add second arg |
| 350 | to the function added as MATCH to `eshell-interpreter-alist' | 492 | to the function added as MATCH to `eshell-interpreter-alist'. |
| 351 | 493 | ||
| 352 | * eshell/em-dirs.el (eshell-dirs-initialize): Add second arg to | 494 | * eshell/em-dirs.el (eshell-dirs-initialize): Add second arg to |
| 353 | the function added as MATCH to `eshell-interpreter-alist' | 495 | the function added as MATCH to `eshell-interpreter-alist'. |
| 354 | 496 | ||
| 355 | * eshell/em-term.el (eshell-visual-subcommands): New defcustom. | 497 | * eshell/em-term.el (eshell-visual-subcommands): New defcustom. |
| 356 | (eshell-visual-options): New defcustom. | 498 | (eshell-visual-options): New defcustom. |
| @@ -2255,7 +2397,7 @@ | |||
| 2255 | 2397 | ||
| 2256 | * comint.el (comint-dynamic-complete-functions, comint-mode-map): | 2398 | * comint.el (comint-dynamic-complete-functions, comint-mode-map): |
| 2257 | `comint-dynamic-complete' is obsolete since 24.1, replaced by | 2399 | `comint-dynamic-complete' is obsolete since 24.1, replaced by |
| 2258 | `completion-at-point'. (Bug#13774) | 2400 | `completion-at-point'. (Bug#13774) |
| 2259 | 2401 | ||
| 2260 | * startup.el (normal-no-mouse-startup-screen): Bug fix, the | 2402 | * startup.el (normal-no-mouse-startup-screen): Bug fix, the |
| 2261 | default key binding for `describe-distribution' has been moved to | 2403 | default key binding for `describe-distribution' has been moved to |
| @@ -2284,7 +2426,8 @@ | |||
| 2284 | 2426 | ||
| 2285 | * comint.el (comint-redirect-original-filter-function): Remove. | 2427 | * comint.el (comint-redirect-original-filter-function): Remove. |
| 2286 | (comint-redirect-cleanup, comint-redirect-send-command-to-process): | 2428 | (comint-redirect-cleanup, comint-redirect-send-command-to-process): |
| 2287 | * vc/vc-cvs.el (vc-cvs-annotate-process-filter,vc-cvs-annotate-command): | 2429 | * vc/vc-cvs.el (vc-cvs-annotate-process-filter) |
| 2430 | (vc-cvs-annotate-command): | ||
| 2288 | * progmodes/octave-inf.el (inferior-octave-send-list-and-digest): | 2431 | * progmodes/octave-inf.el (inferior-octave-send-list-and-digest): |
| 2289 | * progmodes/prolog.el (prolog-consult-compile): | 2432 | * progmodes/prolog.el (prolog-consult-compile): |
| 2290 | * progmodes/gdb-mi.el (gdb, gdb--check-interpreter): | 2433 | * progmodes/gdb-mi.el (gdb, gdb--check-interpreter): |
| @@ -2723,7 +2866,6 @@ | |||
| 2723 | * emacs-lisp/package.el (package-pinned-packages): New var. | 2866 | * emacs-lisp/package.el (package-pinned-packages): New var. |
| 2724 | (package--add-to-archive-contents): Obey it (bug#14118). | 2867 | (package--add-to-archive-contents): Obey it (bug#14118). |
| 2725 | 2868 | ||
| 2726 | |||
| 2727 | 2013-04-03 Alan Mackenzie <acm@muc.de> | 2869 | 2013-04-03 Alan Mackenzie <acm@muc.de> |
| 2728 | 2870 | ||
| 2729 | Handle `parse-partial-sexp' landing inside a comment opener (Bug#13244). | 2871 | Handle `parse-partial-sexp' landing inside a comment opener (Bug#13244). |
| @@ -4954,7 +5096,7 @@ | |||
| 4954 | 2013-01-12 Eli Zaretskii <eliz@gnu.org> | 5096 | 2013-01-12 Eli Zaretskii <eliz@gnu.org> |
| 4955 | 5097 | ||
| 4956 | * autorevert.el (auto-revert-notify-handler): Fix filtering of | 5098 | * autorevert.el (auto-revert-notify-handler): Fix filtering of |
| 4957 | file notification by ACTION. For filtering by file name, compare | 5099 | file notification by ACTION. For filtering by file name, compare |
| 4958 | only the non-directory part of the file name. | 5100 | only the non-directory part of the file name. |
| 4959 | 5101 | ||
| 4960 | 2013-01-12 Stefan Monnier <monnier@iro.umontreal.ca> | 5102 | 2013-01-12 Stefan Monnier <monnier@iro.umontreal.ca> |
| @@ -5037,7 +5179,7 @@ | |||
| 5037 | 2013-01-11 Julien Danjou <julien@danjou.info> | 5179 | 2013-01-11 Julien Danjou <julien@danjou.info> |
| 5038 | 5180 | ||
| 5039 | * color.el (color-rgb-to-hsv): Fix conversion computing in case min and | 5181 | * color.el (color-rgb-to-hsv): Fix conversion computing in case min and |
| 5040 | max are almost equal. Also return the correct value for V which is | 5182 | max are almost equal. Also return the correct value for V which is |
| 5041 | already between 0 and 1. | 5183 | already between 0 and 1. |
| 5042 | 5184 | ||
| 5043 | 2013-01-11 Dmitry Antipov <dmantipov@yandex.ru> | 5185 | 2013-01-11 Dmitry Antipov <dmantipov@yandex.ru> |
| @@ -5491,7 +5633,7 @@ | |||
| 5491 | 2012-12-31 Jürgen Hötzel <juergen@archlinux.org> | 5633 | 2012-12-31 Jürgen Hötzel <juergen@archlinux.org> |
| 5492 | 5634 | ||
| 5493 | * net/tramp-adb.el (tramp-adb-maybe-open-connection): Handle errors | 5635 | * net/tramp-adb.el (tramp-adb-maybe-open-connection): Handle errors |
| 5494 | (No device connected, invalid device name). (Bug #13299) | 5636 | (No device connected, invalid device name). (Bug #13299) |
| 5495 | 5637 | ||
| 5496 | 2012-12-31 Martin Rudalics <rudalics@gmx.at> | 5638 | 2012-12-31 Martin Rudalics <rudalics@gmx.at> |
| 5497 | 5639 | ||
| @@ -5876,7 +6018,7 @@ | |||
| 5876 | 6018 | ||
| 5877 | 2012-12-14 Paul Eggert <eggert@cs.ucla.edu> | 6019 | 2012-12-14 Paul Eggert <eggert@cs.ucla.edu> |
| 5878 | 6020 | ||
| 5879 | Fix permissions bugs with setgid directories etc. (Bug#13125) | 6021 | Fix permissions bugs with setgid directories etc. (Bug#13125) |
| 5880 | * files.el (backup-buffer): Don't rely on 9th output of | 6022 | * files.el (backup-buffer): Don't rely on 9th output of |
| 5881 | file-attributes, as it's now a placeholder. Instead, use the new | 6023 | file-attributes, as it's now a placeholder. Instead, use the new |
| 5882 | optional arg of file-ownership-preserved-p. | 6024 | optional arg of file-ownership-preserved-p. |
| @@ -6334,7 +6476,7 @@ | |||
| 6334 | * textmodes/ispell.el (ispell-init-process) | 6476 | * textmodes/ispell.el (ispell-init-process) |
| 6335 | (ispell-start-process, ispell-internal-change-dictionary): | 6477 | (ispell-start-process, ispell-internal-change-dictionary): |
| 6336 | Make sure personal dictionary name is expanded after initial | 6478 | Make sure personal dictionary name is expanded after initial |
| 6337 | `default-directory' value. Use expanded strings for | 6479 | `default-directory' value. Use expanded strings for |
| 6338 | keep/restart checks and for value (Bug#13019). | 6480 | keep/restart checks and for value (Bug#13019). |
| 6339 | 6481 | ||
| 6340 | 2012-12-03 Jay Belanger <jay.p.belanger@gmail.com> | 6482 | 2012-12-03 Jay Belanger <jay.p.belanger@gmail.com> |
| @@ -7016,7 +7158,7 @@ | |||
| 7016 | 7158 | ||
| 7017 | * play/gamegrid.el (gamegrid-add-score-with-update-game-score-1): | 7159 | * play/gamegrid.el (gamegrid-add-score-with-update-game-score-1): |
| 7018 | Don't signal an error with a score that is too low to add to the | 7160 | Don't signal an error with a score that is too low to add to the |
| 7019 | list of top scores. (Bug#12779) | 7161 | list of top scores. (Bug#12779) |
| 7020 | 7162 | ||
| 7021 | 2012-11-17 Chong Yidong <cyd@gnu.org> | 7163 | 2012-11-17 Chong Yidong <cyd@gnu.org> |
| 7022 | 7164 | ||
| @@ -7085,7 +7227,7 @@ | |||
| 7085 | 7227 | ||
| 7086 | * window.el (record-window-buffer) | 7228 | * window.el (record-window-buffer) |
| 7087 | (display-buffer-record-window): When copying the markers to | 7229 | (display-buffer-record-window): When copying the markers to |
| 7088 | window-point preserve window-point-insertion-type. (Bug#12588) | 7230 | window-point preserve window-point-insertion-type. (Bug#12588) |
| 7089 | 7231 | ||
| 7090 | 2012-11-16 Glenn Morris <rgm@gnu.org> | 7232 | 2012-11-16 Glenn Morris <rgm@gnu.org> |
| 7091 | 7233 | ||
| @@ -7173,8 +7315,8 @@ | |||
| 7173 | (ad-advice-definition): Redefine as functions. | 7315 | (ad-advice-definition): Redefine as functions. |
| 7174 | (ad-advice-classes): Move before first use. | 7316 | (ad-advice-classes): Move before first use. |
| 7175 | (ad-make-origname, ad-set-orig-definition, ad-clear-orig-definition) | 7317 | (ad-make-origname, ad-set-orig-definition, ad-clear-orig-definition) |
| 7176 | (ad-make-mapped-call, ad-make-advised-docstring,ad-make-plain-docstring) | 7318 | (ad-make-mapped-call, ad-make-advised-docstring) |
| 7177 | (ad--defalias-fset): Remove functions. | 7319 | (ad-make-plain-docstring, ad--defalias-fset): Remove functions. |
| 7178 | (ad-make-advicefunname, ad-clear-advicefunname-definition): New funs. | 7320 | (ad-make-advicefunname, ad-clear-advicefunname-definition): New funs. |
| 7179 | (ad-get-orig-definition): Rewrite. | 7321 | (ad-get-orig-definition): Rewrite. |
| 7180 | (ad-make-advised-definition-docstring): Change base docstring. | 7322 | (ad-make-advised-definition-docstring): Change base docstring. |
| @@ -7522,7 +7664,7 @@ | |||
| 7522 | buffer and calls `ispell-buffer' with debugging enabled. | 7664 | buffer and calls `ispell-buffer' with debugging enabled. |
| 7523 | 7665 | ||
| 7524 | * textmodes/ispell.el (ispell-region): Do not prefix sent string by | 7666 | * textmodes/ispell.el (ispell-region): Do not prefix sent string by |
| 7525 | comment in autoconf mode. (Bug#12768) | 7667 | comment in autoconf mode. (Bug#12768) |
| 7526 | 7668 | ||
| 7527 | 2012-11-06 Dmitry Antipov <dmantipov@yandex.ru> | 7669 | 2012-11-06 Dmitry Antipov <dmantipov@yandex.ru> |
| 7528 | 7670 | ||
| @@ -8667,13 +8809,13 @@ | |||
| 8667 | 8809 | ||
| 8668 | * textmodes/reftex-cite.el (reftex-create-bibtex-file): Make sure | 8810 | * textmodes/reftex-cite.el (reftex-create-bibtex-file): Make sure |
| 8669 | that entries with whitespace at various places are found. | 8811 | that entries with whitespace at various places are found. |
| 8670 | Doc fix. Include entries that are cross-referenced from cited entries. | 8812 | Doc fix. Include entries that are cross-referenced from cited entries. |
| 8671 | Include @String definitions in the resulting bib file. Add header | 8813 | Include @String definitions in the resulting bib file. Add header |
| 8672 | and footer defined in `reftex-create-bibtex-header' and | 8814 | and footer defined in `reftex-create-bibtex-header' and |
| 8673 | `reftex-create-bibtex-footer'. | 8815 | `reftex-create-bibtex-footer'. |
| 8674 | (reftex-do-citation): Make it possible again to insert | 8816 | (reftex-do-citation): Make it possible again to insert |
| 8675 | non-existent entries. Save match data when asking for optional | 8817 | non-existent entries. Save match data when asking for optional |
| 8676 | arguments. Return all keys, not just the first one. | 8818 | arguments. Return all keys, not just the first one. |
| 8677 | (reftex-all-used-citation-keys): Fix regexp to correctly extract | 8819 | (reftex-all-used-citation-keys): Fix regexp to correctly extract |
| 8678 | all citations in the same line. | 8820 | all citations in the same line. |
| 8679 | (reftex-parse-bibtex-entry): Accept additional optional argument | 8821 | (reftex-parse-bibtex-entry): Accept additional optional argument |
| @@ -8733,7 +8875,7 @@ | |||
| 8733 | 8875 | ||
| 8734 | * textmodes/reftex-sel.el | 8876 | * textmodes/reftex-sel.el |
| 8735 | (reftex-select-cycle-ref-style-internal): Adapt to new structure | 8877 | (reftex-select-cycle-ref-style-internal): Adapt to new structure |
| 8736 | of `reftex-ref-style-alist'. Remove code for testing macro type. | 8878 | of `reftex-ref-style-alist'. Remove code for testing macro type. |
| 8737 | (reftex-select-toggle-varioref) | 8879 | (reftex-select-toggle-varioref) |
| 8738 | (reftex-select-toggle-fancyref): Remove. | 8880 | (reftex-select-toggle-fancyref): Remove. |
| 8739 | (reftex-select-cycle-ref-style-internal) | 8881 | (reftex-select-cycle-ref-style-internal) |
| @@ -9275,7 +9417,7 @@ | |||
| 9275 | 9417 | ||
| 9276 | * textmodes/bibtex.el (bibtex-autokey-transcriptions): | 9418 | * textmodes/bibtex.el (bibtex-autokey-transcriptions): |
| 9277 | Transcribe also LaTeX hyphenation. | 9419 | Transcribe also LaTeX hyphenation. |
| 9278 | (bibtex-reformat): Bug fix. Do not quote twice the elements of | 9420 | (bibtex-reformat): Bug fix. Do not quote twice the elements of |
| 9279 | bibtex-reformat-previous-options. | 9421 | bibtex-reformat-previous-options. |
| 9280 | 9422 | ||
| 9281 | 2012-09-23 Roland Winkler <winkler@gnu.org> | 9423 | 2012-09-23 Roland Winkler <winkler@gnu.org> |
| @@ -12302,7 +12444,7 @@ | |||
| 12302 | (xml-name-start-char-re, xml-name-char-re, xml-name-re) | 12444 | (xml-name-start-char-re, xml-name-char-re, xml-name-re) |
| 12303 | (xml-names-re, xml-nmtoken-re, xml-nmtokens-re, xml-char-ref-re) | 12445 | (xml-names-re, xml-nmtoken-re, xml-nmtokens-re, xml-char-ref-re) |
| 12304 | (xml-entity-ref, xml-pe-reference-re) | 12446 | (xml-entity-ref, xml-pe-reference-re) |
| 12305 | (xml-reference-re,xml-att-value-re, xml-tokenized-type-re) | 12447 | (xml-reference-re, xml-att-value-re, xml-tokenized-type-re) |
| 12306 | (xml-notation-type-re, xml-enumeration-re, xml-enumerated-type-re) | 12448 | (xml-notation-type-re, xml-enumeration-re, xml-enumerated-type-re) |
| 12307 | (xml-att-type-re, xml-default-decl-re, xml-att-def-re) | 12449 | (xml-att-type-re, xml-default-decl-re, xml-att-def-re) |
| 12308 | (xml-entity-value-re): Use syntax references in regexps where | 12450 | (xml-entity-value-re): Use syntax references in regexps where |
| @@ -20687,7 +20829,7 @@ | |||
| 20687 | 20829 | ||
| 20688 | 2011-10-07 Chong Yidong <cyd@stupidchicken.com> | 20830 | 2011-10-07 Chong Yidong <cyd@stupidchicken.com> |
| 20689 | 20831 | ||
| 20690 | * bindings.el ([M-left],[M-right]): Bind to left-word and | 20832 | * bindings.el ([M-left], [M-right]): Bind to left-word and |
| 20691 | right-word respectively. | 20833 | right-word respectively. |
| 20692 | 20834 | ||
| 20693 | 2011-10-07 Glenn Morris <rgm@gnu.org> | 20835 | 2011-10-07 Glenn Morris <rgm@gnu.org> |
| @@ -26009,15 +26151,15 @@ | |||
| 26009 | 2011-05-10 Jim Meyering <meyering@redhat.com> | 26151 | 2011-05-10 Jim Meyering <meyering@redhat.com> |
| 26010 | 26152 | ||
| 26011 | Fix doubled-word typos. | 26153 | Fix doubled-word typos. |
| 26012 | * international/quail.el (quail-insert-kbd-layout): and and -> and | 26154 | * international/quail.el (quail-insert-kbd-layout): and and -> and. |
| 26013 | * kermit.el: and and -> and | 26155 | * kermit.el: and and -> and. |
| 26014 | * net/ldap.el (ldap-search-internal): to to -> to | 26156 | * net/ldap.el (ldap-search-internal): to to -> to. |
| 26015 | * progmodes/vhdl-mode.el (vhdl-offsets-alist): Likewise. | 26157 | * progmodes/vhdl-mode.el (vhdl-offsets-alist): Likewise. |
| 26016 | * progmodes/js.el (js-mode): and and -> and | 26158 | * progmodes/js.el (js-mode): and and -> and. |
| 26017 | * textmodes/artist.el (artist-move-to-xy): at at -> at | 26159 | * textmodes/artist.el (artist-move-to-xy): at at -> at. |
| 26018 | (artist-draw-region-trim-line-endings): if if -> if | 26160 | (artist-draw-region-trim-line-endings): if if -> if. |
| 26019 | And Safetyc -> Safety. | 26161 | And Safetyc -> Safety. |
| 26020 | * textmodes/reftex-dcr.el (reftex-view-crossref): at at -> at a | 26162 | * textmodes/reftex-dcr.el (reftex-view-crossref): at at -> at a. |
| 26021 | 26163 | ||
| 26022 | 2011-05-10 Glenn Morris <rgm@gnu.org> | 26164 | 2011-05-10 Glenn Morris <rgm@gnu.org> |
| 26023 | Stefan Monnier <monnier@iro.umontreal.ca> | 26165 | Stefan Monnier <monnier@iro.umontreal.ca> |
diff --git a/lisp/ChangeLog.2 b/lisp/ChangeLog.2 index 3832f342d6f..fddc98a612d 100644 --- a/lisp/ChangeLog.2 +++ b/lisp/ChangeLog.2 | |||
| @@ -777,7 +777,7 @@ | |||
| 777 | 777 | ||
| 778 | 1987-12-21 Richard Stallman (rms@frosted-flakes) | 778 | 1987-12-21 Richard Stallman (rms@frosted-flakes) |
| 779 | 779 | ||
| 780 | * window.el (split-widow-{vertically,horizontally}): | 780 | * window.el (split-window-{vertically,horizontally}): |
| 781 | Make the arg optional. | 781 | Make the arg optional. |
| 782 | 782 | ||
| 783 | 1987-12-09 Richard Stallman (rms@frosted-flakes) | 783 | 1987-12-09 Richard Stallman (rms@frosted-flakes) |
| @@ -1392,7 +1392,7 @@ | |||
| 1392 | * shell.el: Minor doc fixes. | 1392 | * shell.el: Minor doc fixes. |
| 1393 | 1393 | ||
| 1394 | * rmail.el (rmail-get-new-mail): | 1394 | * rmail.el (rmail-get-new-mail): |
| 1395 | Handle errors competently. (Don't attempt to | 1395 | Handle errors competently. (Don't attempt to |
| 1396 | handle them, rather than botching the job) | 1396 | handle them, rather than botching the job) |
| 1397 | 1397 | ||
| 1398 | * rmail.el (rmail-insert-inbox-text): | 1398 | * rmail.el (rmail-insert-inbox-text): |
| @@ -3032,7 +3032,7 @@ | |||
| 3032 | 3032 | ||
| 3033 | Rename "kill" -> "delete" for both function-names and documentation. | 3033 | Rename "kill" -> "delete" for both function-names and documentation. |
| 3034 | 3034 | ||
| 3035 | Define C-d as Buffer-menu-delete-backwards. (also in ebuff-menu) | 3035 | Define C-d as Buffer-menu-delete-backwards (also in ebuff-menu). |
| 3036 | 3036 | ||
| 3037 | Save space: Merge buffer-menu-{execute,do-saves,do-kills}. | 3037 | Save space: Merge buffer-menu-{execute,do-saves,do-kills}. |
| 3038 | 3038 | ||
diff --git a/lisp/allout.el b/lisp/allout.el index 5a9b03b7a0e..1e4134b3ccf 100644 --- a/lisp/allout.el +++ b/lisp/allout.el | |||
| @@ -1561,7 +1561,7 @@ Each value can be a regexp or a list with a regexp followed by a | |||
| 1561 | substitution string. If it's just a regexp, all its matches are removed | 1561 | substitution string. If it's just a regexp, all its matches are removed |
| 1562 | before the text is encrypted. If it's a regexp and a substitution, the | 1562 | before the text is encrypted. If it's a regexp and a substitution, the |
| 1563 | substitution is used against the regexp matches, a la `replace-match'.") | 1563 | substitution is used against the regexp matches, a la `replace-match'.") |
| 1564 | (make-variable-buffer-local 'allout-encryption-text-removal-regexps) | 1564 | (make-variable-buffer-local 'allout-encryption-plaintext-sanitization-regexps) |
| 1565 | ;;;_ = allout-encryption-ciphertext-rejection-regexps | 1565 | ;;;_ = allout-encryption-ciphertext-rejection-regexps |
| 1566 | (defvar allout-encryption-ciphertext-rejection-regexps nil | 1566 | (defvar allout-encryption-ciphertext-rejection-regexps nil |
| 1567 | "Variable for regexps matching plaintext to remove before encryption. | 1567 | "Variable for regexps matching plaintext to remove before encryption. |
diff --git a/lisp/cedet/semantic/ctxt.el b/lisp/cedet/semantic/ctxt.el index efaec4f63b4..629bbdee561 100644 --- a/lisp/cedet/semantic/ctxt.el +++ b/lisp/cedet/semantic/ctxt.el | |||
| @@ -366,7 +366,7 @@ For example, in the C statement: | |||
| 366 | If the cursor is on 'this', will move point to the ; after entry.") | 366 | If the cursor is on 'this', will move point to the ; after entry.") |
| 367 | 367 | ||
| 368 | (defun semantic-ctxt-end-of-symbol-default (&optional point) | 368 | (defun semantic-ctxt-end-of-symbol-default (&optional point) |
| 369 | "Move poin to the end of the current symbol under POINT. | 369 | "Move point to the end of the current symbol under POINT. |
| 370 | This will move past type/field names when applicable. | 370 | This will move past type/field names when applicable. |
| 371 | Depends on `semantic-type-relation-separator-character', and will | 371 | Depends on `semantic-type-relation-separator-character', and will |
| 372 | work on C like languages." | 372 | work on C like languages." |
| @@ -422,18 +422,18 @@ work on C like languages." | |||
| 422 | 422 | ||
| 423 | ;; Skip the separator and the symbol. | 423 | ;; Skip the separator and the symbol. |
| 424 | (goto-char (match-end 0)) | 424 | (goto-char (match-end 0)) |
| 425 | 425 | ||
| 426 | (if (looking-at "\\w\\|\\s_") | 426 | (if (looking-at "\\w\\|\\s_") |
| 427 | ;; Skip symbols | 427 | ;; Skip symbols |
| 428 | (forward-sexp 1) | 428 | (forward-sexp 1) |
| 429 | ;; No symbol, exit the search... | 429 | ;; No symbol, exit the search... |
| 430 | (setq continuesearch nil)) | 430 | (setq continuesearch nil)) |
| 431 | 431 | ||
| 432 | (setq end (point))) | 432 | (setq end (point))) |
| 433 | 433 | ||
| 434 | ;; Cont... | 434 | ;; Cont... |
| 435 | ) | 435 | ) |
| 436 | 436 | ||
| 437 | ;; Restore position if we go to far.... | 437 | ;; Restore position if we go to far.... |
| 438 | (error (goto-char end)) ) | 438 | (error (goto-char end)) ) |
| 439 | 439 | ||
diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el index 3487e615168..a4aa535eb1a 100644 --- a/lisp/cedet/semantic/decorate/mode.el +++ b/lisp/cedet/semantic/decorate/mode.el | |||
| @@ -396,7 +396,7 @@ decoration API found in this library." | |||
| 396 | (let ((predicate (semantic-decorate-style-predicate name)) | 396 | (let ((predicate (semantic-decorate-style-predicate name)) |
| 397 | (highlighter (semantic-decorate-style-highlighter name)) | 397 | (highlighter (semantic-decorate-style-highlighter name)) |
| 398 | (predicatedef (semantic-decorate-style-predicate-default name)) | 398 | (predicatedef (semantic-decorate-style-predicate-default name)) |
| 399 | (highlighterdef (semantic-decorate-style-highlighter-default name)) | 399 | (highlighterdef (semantic-decorate-style-highlighter-default name)) |
| 400 | (defaultenable (if (plist-member flags :enabled) | 400 | (defaultenable (if (plist-member flags :enabled) |
| 401 | (plist-get flags :enabled) | 401 | (plist-get flags :enabled) |
| 402 | t)) | 402 | t)) |
| @@ -422,14 +422,14 @@ decoration API found in this library." | |||
| 422 | (add-to-list 'semantic-decoration-styles | 422 | (add-to-list 'semantic-decoration-styles |
| 423 | (cons ',(symbol-name name) | 423 | (cons ',(symbol-name name) |
| 424 | ,defaultenable)) | 424 | ,defaultenable)) |
| 425 | ;; If there is a load file, then create the autload tokens for | 425 | ;; If there is a load file, then create the autoload tokens for |
| 426 | ;; those functions to load the token, but only if the fsym | 426 | ;; those functions to load the token, but only if the fsym |
| 427 | ;; doesn't exist yet. | 427 | ;; doesn't exist yet. |
| 428 | (when (stringp ,loadfile) | 428 | (when (stringp ,loadfile) |
| 429 | (unless (fboundp ',predicatedef) | 429 | (unless (fboundp ',predicatedef) |
| 430 | (autoload ',predicatedef ',loadfile "Return non-nil to decorate TAG." | 430 | (autoload ',predicatedef ',loadfile "Return non-nil to decorate TAG." |
| 431 | nil 'function)) | 431 | nil 'function)) |
| 432 | 432 | ||
| 433 | (unless (fboundp ',highlighterdef) | 433 | (unless (fboundp ',highlighterdef) |
| 434 | (autoload ',highlighterdef ',loadfile "Decorate TAG." | 434 | (autoload ',highlighterdef ',loadfile "Decorate TAG." |
| 435 | nil 'function)) | 435 | nil 'function)) |
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 33ee7c0bbd2..a06abb03b95 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el | |||
| @@ -267,7 +267,7 @@ including `cl-block' and `cl-eval-when'. | |||
| 267 | ;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when | 267 | ;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when |
| 268 | ;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp | 268 | ;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp |
| 269 | ;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*) | 269 | ;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*) |
| 270 | ;;;;;; "cl-macs" "cl-macs.el" "80cb53f97b21adb6069c43c38a2e094d") | 270 | ;;;;;; "cl-macs" "cl-macs.el" "fd824d987086eafec0b1cb2efa8312f4") |
| 271 | ;;; Generated autoloads from cl-macs.el | 271 | ;;; Generated autoloads from cl-macs.el |
| 272 | 272 | ||
| 273 | (autoload 'cl--compiler-macro-list* "cl-macs" "\ | 273 | (autoload 'cl--compiler-macro-list* "cl-macs" "\ |
| @@ -699,9 +699,10 @@ OPTION is either a single keyword or (KEYWORD VALUE) where | |||
| 699 | KEYWORD can be one of :conc-name, :constructor, :copier, :predicate, | 699 | KEYWORD can be one of :conc-name, :constructor, :copier, :predicate, |
| 700 | :type, :named, :initial-offset, :print-function, or :include. | 700 | :type, :named, :initial-offset, :print-function, or :include. |
| 701 | 701 | ||
| 702 | Each SLOT may instead take the form (SLOT SLOT-OPTS...), where | 702 | Each SLOT may instead take the form (SNAME SDEFAULT SOPTIONS...), where |
| 703 | SLOT-OPTS are keyword-value pairs for that slot. Currently, only | 703 | SDEFAULT is the default value of that slot and SOPTIONS are keyword-value |
| 704 | one keyword is supported, `:read-only'. If this has a non-nil | 704 | pairs for that slot. |
| 705 | Currently, only one keyword is supported, `:read-only'. If this has a non-nil | ||
| 705 | value, that slot cannot be set via `setf'. | 706 | value, that slot cannot be set via `setf'. |
| 706 | 707 | ||
| 707 | \(fn NAME SLOTS...)" nil t) | 708 | \(fn NAME SLOTS...)" nil t) |
| @@ -724,6 +725,8 @@ TYPE is a Common Lisp-style type specifier. | |||
| 724 | 725 | ||
| 725 | \(fn OBJECT TYPE)" nil nil) | 726 | \(fn OBJECT TYPE)" nil nil) |
| 726 | 727 | ||
| 728 | (eval-and-compile (put 'cl-typep 'compiler-macro #'cl--compiler-macro-typep)) | ||
| 729 | |||
| 727 | (autoload 'cl-check-type "cl-macs" "\ | 730 | (autoload 'cl-check-type "cl-macs" "\ |
| 728 | Verify that FORM is of type TYPE; signal an error if not. | 731 | Verify that FORM is of type TYPE; signal an error if not. |
| 729 | STRING is an optional description of the desired type. | 732 | STRING is an optional description of the desired type. |
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 66ad8e769b5..34957d86796 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el | |||
| @@ -584,7 +584,7 @@ If `load' is in WHEN, BODY is evaluated when loaded after top-level compile. | |||
| 584 | If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level. | 584 | If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level. |
| 585 | 585 | ||
| 586 | \(fn (WHEN...) BODY...)" | 586 | \(fn (WHEN...) BODY...)" |
| 587 | (declare (indent 1) (debug ((&rest &or "compile" "load" "eval") body))) | 587 | (declare (indent 1) (debug (sexp body))) |
| 588 | (if (and (fboundp 'cl--compiling-file) (cl--compiling-file) | 588 | (if (and (fboundp 'cl--compiling-file) (cl--compiling-file) |
| 589 | (not cl--not-toplevel) (not (boundp 'for-effect))) ;Horrible kludge. | 589 | (not cl--not-toplevel) (not (boundp 'for-effect))) ;Horrible kludge. |
| 590 | (let ((comp (or (memq 'compile when) (memq :compile-toplevel when))) | 590 | (let ((comp (or (memq 'compile when) (memq :compile-toplevel when))) |
| @@ -2276,9 +2276,10 @@ OPTION is either a single keyword or (KEYWORD VALUE) where | |||
| 2276 | KEYWORD can be one of :conc-name, :constructor, :copier, :predicate, | 2276 | KEYWORD can be one of :conc-name, :constructor, :copier, :predicate, |
| 2277 | :type, :named, :initial-offset, :print-function, or :include. | 2277 | :type, :named, :initial-offset, :print-function, or :include. |
| 2278 | 2278 | ||
| 2279 | Each SLOT may instead take the form (SLOT SLOT-OPTS...), where | 2279 | Each SLOT may instead take the form (SNAME SDEFAULT SOPTIONS...), where |
| 2280 | SLOT-OPTS are keyword-value pairs for that slot. Currently, only | 2280 | SDEFAULT is the default value of that slot and SOPTIONS are keyword-value |
| 2281 | one keyword is supported, `:read-only'. If this has a non-nil | 2281 | pairs for that slot. |
| 2282 | Currently, only one keyword is supported, `:read-only'. If this has a non-nil | ||
| 2282 | value, that slot cannot be set via `setf'. | 2283 | value, that slot cannot be set via `setf'. |
| 2283 | 2284 | ||
| 2284 | \(fn NAME SLOTS...)" | 2285 | \(fn NAME SLOTS...)" |
| @@ -2574,9 +2575,16 @@ The type name can then be used in `cl-typecase', `cl-check-type', etc." | |||
| 2574 | (defun cl-typep (object type) ; See compiler macro below. | 2575 | (defun cl-typep (object type) ; See compiler macro below. |
| 2575 | "Check that OBJECT is of type TYPE. | 2576 | "Check that OBJECT is of type TYPE. |
| 2576 | TYPE is a Common Lisp-style type specifier." | 2577 | TYPE is a Common Lisp-style type specifier." |
| 2578 | (declare (compiler-macro cl--compiler-macro-typep)) | ||
| 2577 | (let ((cl--object object)) ;; Yuck!! | 2579 | (let ((cl--object object)) ;; Yuck!! |
| 2578 | (eval (cl--make-type-test 'cl--object type)))) | 2580 | (eval (cl--make-type-test 'cl--object type)))) |
| 2579 | 2581 | ||
| 2582 | (defun cl--compiler-macro-typep (form val type) | ||
| 2583 | (if (macroexp-const-p type) | ||
| 2584 | (macroexp-let2 macroexp-copyable-p temp val | ||
| 2585 | (cl--make-type-test temp (cl--const-expr-val type))) | ||
| 2586 | form)) | ||
| 2587 | |||
| 2580 | ;;;###autoload | 2588 | ;;;###autoload |
| 2581 | (defmacro cl-check-type (form type &optional string) | 2589 | (defmacro cl-check-type (form type &optional string) |
| 2582 | "Verify that FORM is of type TYPE; signal an error if not. | 2590 | "Verify that FORM is of type TYPE; signal an error if not. |
| @@ -2635,19 +2643,13 @@ and then returning foo." | |||
| 2635 | (let ((p args) (res nil)) | 2643 | (let ((p args) (res nil)) |
| 2636 | (while (consp p) (push (pop p) res)) | 2644 | (while (consp p) (push (pop p) res)) |
| 2637 | (setq args (nconc (nreverse res) (and p (list '&rest p))))) | 2645 | (setq args (nconc (nreverse res) (and p (list '&rest p))))) |
| 2638 | `(cl-eval-when (compile load eval) | 2646 | (let ((fname (make-symbol (concat (symbol-name func) "--cmacro")))) |
| 2639 | (put ',func 'compiler-macro | 2647 | `(eval-and-compile |
| 2640 | (cl-function (lambda ,(if (memq '&whole args) (delq '&whole args) | 2648 | ;; Name the compiler-macro function, so that `symbol-file' can find it. |
| 2641 | (cons '_cl-whole-arg args)) | 2649 | (cl-defun ,fname ,(if (memq '&whole args) (delq '&whole args) |
| 2642 | ,@body))) | 2650 | (cons '_cl-whole-arg args)) |
| 2643 | ;; This is so that describe-function can locate | 2651 | ,@body) |
| 2644 | ;; the macro definition. | 2652 | (put ',func 'compiler-macro #',fname)))) |
| 2645 | (let ((file ,(or buffer-file-name | ||
| 2646 | (and (boundp 'byte-compile-current-file) | ||
| 2647 | (stringp byte-compile-current-file) | ||
| 2648 | byte-compile-current-file)))) | ||
| 2649 | (if file (put ',func 'compiler-macro-file | ||
| 2650 | (purecopy (file-name-nondirectory file))))))) | ||
| 2651 | 2653 | ||
| 2652 | ;;;###autoload | 2654 | ;;;###autoload |
| 2653 | (defun cl-compiler-macroexpand (form) | 2655 | (defun cl-compiler-macroexpand (form) |
| @@ -2773,12 +2775,6 @@ surrounded by (cl-block NAME ...). | |||
| 2773 | `(cl-getf (symbol-plist ,sym) ,prop ,def) | 2775 | `(cl-getf (symbol-plist ,sym) ,prop ,def) |
| 2774 | `(get ,sym ,prop))) | 2776 | `(get ,sym ,prop))) |
| 2775 | 2777 | ||
| 2776 | (cl-define-compiler-macro cl-typep (&whole form val type) | ||
| 2777 | (if (macroexp-const-p type) | ||
| 2778 | (macroexp-let2 macroexp-copyable-p temp val | ||
| 2779 | (cl--make-type-test temp (cl--const-expr-val type))) | ||
| 2780 | form)) | ||
| 2781 | |||
| 2782 | (dolist (y '(cl-first cl-second cl-third cl-fourth | 2778 | (dolist (y '(cl-first cl-second cl-third cl-fourth |
| 2783 | cl-fifth cl-sixth cl-seventh | 2779 | cl-fifth cl-sixth cl-seventh |
| 2784 | cl-eighth cl-ninth cl-tenth | 2780 | cl-eighth cl-ninth cl-tenth |
diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el index dd5ff0ec694..cb86a554335 100644 --- a/lisp/emacs-lisp/generic.el +++ b/lisp/emacs-lisp/generic.el | |||
| @@ -93,6 +93,8 @@ | |||
| 93 | 93 | ||
| 94 | ;;; Code: | 94 | ;;; Code: |
| 95 | 95 | ||
| 96 | (eval-when-compile (require 'pcase)) | ||
| 97 | |||
| 96 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 98 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 97 | ;; Internal Variables | 99 | ;; Internal Variables |
| 98 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 100 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| @@ -224,18 +226,11 @@ Some generic modes are defined in `generic-x.el'." | |||
| 224 | (funcall (intern mode))) | 226 | (funcall (intern mode))) |
| 225 | 227 | ||
| 226 | ;;; Comment Functionality | 228 | ;;; Comment Functionality |
| 227 | (defun generic-mode-set-comments (comment-list) | ||
| 228 | "Set up comment functionality for generic mode." | ||
| 229 | (let ((st (make-syntax-table)) | ||
| 230 | (chars nil) | ||
| 231 | (comstyles)) | ||
| 232 | (make-local-variable 'comment-start) | ||
| 233 | (make-local-variable 'comment-start-skip) | ||
| 234 | (make-local-variable 'comment-end) | ||
| 235 | 229 | ||
| 236 | ;; Go through all the comments | 230 | (defun generic--normalise-comments (comment-list) |
| 231 | (let ((normalized '())) | ||
| 237 | (dolist (start comment-list) | 232 | (dolist (start comment-list) |
| 238 | (let (end (comstyle "")) | 233 | (let (end) |
| 239 | ;; Normalize | 234 | ;; Normalize |
| 240 | (when (consp start) | 235 | (when (consp start) |
| 241 | (setq end (cdr start)) | 236 | (setq end (cdr start)) |
| @@ -244,58 +239,79 @@ Some generic modes are defined in `generic-x.el'." | |||
| 244 | (cond | 239 | (cond |
| 245 | ((characterp end) (setq end (char-to-string end))) | 240 | ((characterp end) (setq end (char-to-string end))) |
| 246 | ((zerop (length end)) (setq end "\n"))) | 241 | ((zerop (length end)) (setq end "\n"))) |
| 242 | (push (cons start end) normalized))) | ||
| 243 | (nreverse normalized))) | ||
| 247 | 244 | ||
| 248 | ;; Setup the vars for `comment-region' | 245 | (defun generic-set-comment-syntax (st comment-list) |
| 249 | (if comment-start | 246 | "Set up comment functionality for generic mode." |
| 250 | ;; We have already setup a comment-style, so use style b | 247 | (let ((chars nil) |
| 251 | (progn | 248 | (comstyles) |
| 252 | (setq comstyle "b") | 249 | (comstyle "") |
| 253 | (setq comment-start-skip | 250 | (comment-start nil)) |
| 254 | (concat comment-start-skip "\\|" (regexp-quote start) "+\\s-*"))) | 251 | |
| 255 | ;; First comment-style | 252 | ;; Go through all the comments. |
| 256 | (setq comment-start start) | 253 | (pcase-dolist (`(,start . ,end) comment-list) |
| 257 | (setq comment-end (if (string-equal end "\n") "" end)) | 254 | (let ((comstyle |
| 258 | (setq comment-start-skip (concat (regexp-quote start) "+\\s-*"))) | 255 | ;; Reuse comstyles if necessary. |
| 259 | |||
| 260 | ;; Reuse comstyles if necessary | ||
| 261 | (setq comstyle | ||
| 262 | (or (cdr (assoc start comstyles)) | 256 | (or (cdr (assoc start comstyles)) |
| 263 | (cdr (assoc end comstyles)) | 257 | (cdr (assoc end comstyles)) |
| 264 | comstyle)) | 258 | ;; Otherwise, use a style not yet in use. |
| 259 | (if (not (rassoc "" comstyles)) "") | ||
| 260 | (if (not (rassoc "b" comstyles)) "b") | ||
| 261 | "c"))) | ||
| 265 | (push (cons start comstyle) comstyles) | 262 | (push (cons start comstyle) comstyles) |
| 266 | (push (cons end comstyle) comstyles) | 263 | (push (cons end comstyle) comstyles) |
| 267 | 264 | ||
| 268 | ;; Setup the syntax table | 265 | ;; Setup the syntax table. |
| 269 | (if (= (length start) 1) | 266 | (if (= (length start) 1) |
| 270 | (modify-syntax-entry (string-to-char start) | 267 | (modify-syntax-entry (aref start 0) |
| 271 | (concat "< " comstyle) st) | 268 | (concat "< " comstyle) st) |
| 272 | (let ((c0 (elt start 0)) (c1 (elt start 1))) | 269 | (let ((c0 (aref start 0)) (c1 (aref start 1))) |
| 273 | ;; Store the relevant info but don't update yet | 270 | ;; Store the relevant info but don't update yet. |
| 274 | (push (cons c0 (concat (cdr (assoc c0 chars)) "1")) chars) | 271 | (push (cons c0 (concat (cdr (assoc c0 chars)) "1")) chars) |
| 275 | (push (cons c1 (concat (cdr (assoc c1 chars)) | 272 | (push (cons c1 (concat (cdr (assoc c1 chars)) |
| 276 | (concat "2" comstyle))) chars))) | 273 | (concat "2" comstyle))) chars))) |
| 277 | (if (= (length end) 1) | 274 | (if (= (length end) 1) |
| 278 | (modify-syntax-entry (string-to-char end) | 275 | (modify-syntax-entry (aref end 0) |
| 279 | (concat ">" comstyle) st) | 276 | (concat ">" comstyle) st) |
| 280 | (let ((c0 (elt end 0)) (c1 (elt end 1))) | 277 | (let ((c0 (aref end 0)) (c1 (aref end 1))) |
| 281 | ;; Store the relevant info but don't update yet | 278 | ;; Store the relevant info but don't update yet. |
| 282 | (push (cons c0 (concat (cdr (assoc c0 chars)) | 279 | (push (cons c0 (concat (cdr (assoc c0 chars)) |
| 283 | (concat "3" comstyle))) chars) | 280 | (concat "3" comstyle))) chars) |
| 284 | (push (cons c1 (concat (cdr (assoc c1 chars)) "4")) chars))))) | 281 | (push (cons c1 (concat (cdr (assoc c1 chars)) "4")) chars))))) |
| 285 | 282 | ||
| 286 | ;; Process the chars that were part of a 2-char comment marker | 283 | ;; Process the chars that were part of a 2-char comment marker |
| 284 | (with-syntax-table st ;For `char-syntax'. | ||
| 287 | (dolist (cs (nreverse chars)) | 285 | (dolist (cs (nreverse chars)) |
| 288 | (modify-syntax-entry (car cs) | 286 | (modify-syntax-entry (car cs) |
| 289 | (concat (char-to-string (char-syntax (car cs))) | 287 | (concat (char-to-string (char-syntax (car cs))) |
| 290 | " " (cdr cs)) | 288 | " " (cdr cs)) |
| 291 | st)) | 289 | st))))) |
| 290 | |||
| 291 | (defun generic-set-comment-vars (comment-list) | ||
| 292 | (when comment-list | ||
| 293 | (setq-local comment-start (caar comment-list)) | ||
| 294 | (setq-local comment-end | ||
| 295 | (let ((end (cdar comment-list))) | ||
| 296 | (if (string-equal end "\n") "" end))) | ||
| 297 | (setq-local comment-start-skip | ||
| 298 | (concat (regexp-opt (mapcar #'car comment-list)) | ||
| 299 | "+[ \t]*")) | ||
| 300 | (setq-local comment-end-skip | ||
| 301 | (concat "[ \t]*" (regexp-opt (mapcar #'cdr comment-list)))))) | ||
| 302 | |||
| 303 | (defun generic-mode-set-comments (comment-list) | ||
| 304 | "Set up comment functionality for generic mode." | ||
| 305 | (let ((st (make-syntax-table)) | ||
| 306 | (comment-list (generic--normalise-comments comment-list))) | ||
| 307 | (generic-set-comment-syntax st comment-list) | ||
| 308 | (generic-set-comment-vars comment-list) | ||
| 292 | (set-syntax-table st))) | 309 | (set-syntax-table st))) |
| 293 | 310 | ||
| 294 | (defun generic-bracket-support () | 311 | (defun generic-bracket-support () |
| 295 | "Imenu support for [KEYWORD] constructs found in INF, INI and Samba files." | 312 | "Imenu support for [KEYWORD] constructs found in INF, INI and Samba files." |
| 296 | (setq imenu-generic-expression | 313 | (setq-local imenu-generic-expression '((nil "^\\[\\(.*\\)\\]" 1))) |
| 297 | '((nil "^\\[\\(.*\\)\\]" 1)) | 314 | (setq-local imenu-case-fold-search t)) |
| 298 | imenu-case-fold-search t)) | ||
| 299 | 315 | ||
| 300 | ;;;###autoload | 316 | ;;;###autoload |
| 301 | (defun generic-make-keywords-list (keyword-list face &optional prefix suffix) | 317 | (defun generic-make-keywords-list (keyword-list face &optional prefix suffix) |
| @@ -306,6 +322,7 @@ expression that matches these keywords and concatenates it with | |||
| 306 | PREFIX and SUFFIX. Then it returns a construct based on this | 322 | PREFIX and SUFFIX. Then it returns a construct based on this |
| 307 | regular expression that can be used as an element of | 323 | regular expression that can be used as an element of |
| 308 | `font-lock-keywords'." | 324 | `font-lock-keywords'." |
| 325 | (declare (obsolete regexp-opt "24.4")) | ||
| 309 | (unless (listp keyword-list) | 326 | (unless (listp keyword-list) |
| 310 | (error "Keywords argument must be a list of strings")) | 327 | (error "Keywords argument must be a list of strings")) |
| 311 | (list (concat prefix "\\_<" | 328 | (list (concat prefix "\\_<" |
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 4267b9f45b9..cbd8854e7d6 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el | |||
| @@ -223,7 +223,6 @@ font-lock keywords will not be case sensitive." | |||
| 223 | (setq-local imenu-generic-expression lisp-imenu-generic-expression) | 223 | (setq-local imenu-generic-expression lisp-imenu-generic-expression) |
| 224 | (setq-local multibyte-syntax-as-symbol t) | 224 | (setq-local multibyte-syntax-as-symbol t) |
| 225 | (setq-local syntax-begin-function 'beginning-of-defun) | 225 | (setq-local syntax-begin-function 'beginning-of-defun) |
| 226 | (prog-prettify-install lisp--prettify-symbols-alist) | ||
| 227 | (setq font-lock-defaults | 226 | (setq font-lock-defaults |
| 228 | `((lisp-font-lock-keywords | 227 | `((lisp-font-lock-keywords |
| 229 | lisp-font-lock-keywords-1 | 228 | lisp-font-lock-keywords-1 |
| @@ -231,7 +230,8 @@ font-lock keywords will not be case sensitive." | |||
| 231 | nil ,keywords-case-insensitive nil nil | 230 | nil ,keywords-case-insensitive nil nil |
| 232 | (font-lock-mark-block-function . mark-defun) | 231 | (font-lock-mark-block-function . mark-defun) |
| 233 | (font-lock-syntactic-face-function | 232 | (font-lock-syntactic-face-function |
| 234 | . lisp-font-lock-syntactic-face-function)))) | 233 | . lisp-font-lock-syntactic-face-function))) |
| 234 | (prog-prettify-install lisp--prettify-symbols-alist)) | ||
| 235 | 235 | ||
| 236 | (defun lisp-outline-level () | 236 | (defun lisp-outline-level () |
| 237 | "Lisp mode `outline-level' function." | 237 | "Lisp mode `outline-level' function." |
diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el index a3ce1672a63..17919d9bbeb 100644 --- a/lisp/emacs-lisp/package-x.el +++ b/lisp/emacs-lisp/package-x.el | |||
| @@ -162,9 +162,11 @@ DESCRIPTION is the text of the news item." | |||
| 162 | description | 162 | description |
| 163 | archive-url)) | 163 | archive-url)) |
| 164 | 164 | ||
| 165 | (defun package-upload-buffer-internal (pkg-info extension &optional archive-url) | 165 | (declare-function lm-commentary "lisp-mnt" (&optional file)) |
| 166 | |||
| 167 | (defun package-upload-buffer-internal (pkg-desc extension &optional archive-url) | ||
| 166 | "Upload a package whose contents are in the current buffer. | 168 | "Upload a package whose contents are in the current buffer. |
| 167 | PKG-INFO is the package info, see `package-buffer-info'. | 169 | PKG-DESC is the `package-desc'. |
| 168 | EXTENSION is the file extension, a string. It can be either | 170 | EXTENSION is the file extension, a string. It can be either |
| 169 | \"el\" or \"tar\". | 171 | \"el\" or \"tar\". |
| 170 | 172 | ||
| @@ -196,18 +198,18 @@ if it exists." | |||
| 196 | (error "Aborted"))) | 198 | (error "Aborted"))) |
| 197 | (save-excursion | 199 | (save-excursion |
| 198 | (save-restriction | 200 | (save-restriction |
| 199 | (let* ((file-type (cond | 201 | (let* ((file-type (package-desc-kind pkg-desc)) |
| 200 | ((equal extension "el") 'single) | 202 | (pkg-name (package-desc-name pkg-desc)) |
| 201 | ((equal extension "tar") 'tar) | 203 | (requires (package-desc-reqs pkg-desc)) |
| 202 | (t (error "Unknown extension `%s'" extension)))) | 204 | (desc (if (eq (package-desc-summary pkg-desc) |
| 203 | (file-name (aref pkg-info 0)) | 205 | package--default-summary) |
| 204 | (pkg-name (intern file-name)) | ||
| 205 | (requires (aref pkg-info 1)) | ||
| 206 | (desc (if (string= (aref pkg-info 2) "") | ||
| 207 | (read-string "Description of package: ") | 206 | (read-string "Description of package: ") |
| 208 | (aref pkg-info 2))) | 207 | (package-desc-summary pkg-desc))) |
| 209 | (pkg-version (aref pkg-info 3)) | 208 | (pkg-version (package-desc-version pkg-desc)) |
| 210 | (commentary (aref pkg-info 4)) | 209 | (commentary |
| 210 | (pcase file-type | ||
| 211 | (`single (lm-commentary)) | ||
| 212 | (`tar nil))) ;; FIXME: Get it from the README file. | ||
| 211 | (split-version (version-to-list pkg-version)) | 213 | (split-version (version-to-list pkg-version)) |
| 212 | (pkg-buffer (current-buffer))) | 214 | (pkg-buffer (current-buffer))) |
| 213 | 215 | ||
| @@ -215,7 +217,8 @@ if it exists." | |||
| 215 | ;; from `package-archive-upload-base' otherwise. | 217 | ;; from `package-archive-upload-base' otherwise. |
| 216 | (let ((contents (or (package--archive-contents-from-url archive-url) | 218 | (let ((contents (or (package--archive-contents-from-url archive-url) |
| 217 | (package--archive-contents-from-file))) | 219 | (package--archive-contents-from-file))) |
| 218 | (new-desc (vector split-version requires desc file-type))) | 220 | (new-desc (package-make-ac-desc |
| 221 | split-version requires desc file-type))) | ||
| 219 | (if (> (car contents) package-archive-version) | 222 | (if (> (car contents) package-archive-version) |
| 220 | (error "Unrecognized archive version %d" (car contents))) | 223 | (error "Unrecognized archive version %d" (car contents))) |
| 221 | (let ((elt (assq pkg-name (cdr contents)))) | 224 | (let ((elt (assq pkg-name (cdr contents)))) |
| @@ -232,6 +235,7 @@ if it exists." | |||
| 232 | ;; this and the package itself. For now we assume ELPA is | 235 | ;; this and the package itself. For now we assume ELPA is |
| 233 | ;; writable via file primitives. | 236 | ;; writable via file primitives. |
| 234 | (let ((print-level nil) | 237 | (let ((print-level nil) |
| 238 | (print-quoted t) | ||
| 235 | (print-length nil)) | 239 | (print-length nil)) |
| 236 | (write-region (concat (pp-to-string contents) "\n") | 240 | (write-region (concat (pp-to-string contents) "\n") |
| 237 | nil | 241 | nil |
| @@ -241,29 +245,29 @@ if it exists." | |||
| 241 | ;; If there is a commentary section, write it. | 245 | ;; If there is a commentary section, write it. |
| 242 | (when commentary | 246 | (when commentary |
| 243 | (write-region commentary nil | 247 | (write-region commentary nil |
| 244 | (expand-file-name | 248 | (expand-file-name |
| 245 | (concat (symbol-name pkg-name) "-readme.txt") | 249 | (concat (symbol-name pkg-name) "-readme.txt") |
| 246 | package-archive-upload-base))) | 250 | package-archive-upload-base))) |
| 247 | 251 | ||
| 248 | (set-buffer pkg-buffer) | 252 | (set-buffer pkg-buffer) |
| 249 | (write-region (point-min) (point-max) | 253 | (write-region (point-min) (point-max) |
| 250 | (expand-file-name | 254 | (expand-file-name |
| 251 | (concat file-name "-" pkg-version "." extension) | 255 | (format "%s-%s.%s" pkg-name pkg-version extension) |
| 252 | package-archive-upload-base) | 256 | package-archive-upload-base) |
| 253 | nil nil nil 'excl) | 257 | nil nil nil 'excl) |
| 254 | 258 | ||
| 255 | ;; Write a news entry. | 259 | ;; Write a news entry. |
| 256 | (and package-update-news-on-upload | 260 | (and package-update-news-on-upload |
| 257 | archive-url | 261 | archive-url |
| 258 | (package--update-news (concat file-name "." extension) | 262 | (package--update-news (format "%s.%s" pkg-name extension) |
| 259 | pkg-version desc archive-url)) | 263 | pkg-version desc archive-url)) |
| 260 | 264 | ||
| 261 | ;; special-case "package": write a second copy so that the | 265 | ;; special-case "package": write a second copy so that the |
| 262 | ;; installer can easily find the latest version. | 266 | ;; installer can easily find the latest version. |
| 263 | (if (string= file-name "package") | 267 | (if (eq pkg-name 'package) |
| 264 | (write-region (point-min) (point-max) | 268 | (write-region (point-min) (point-max) |
| 265 | (expand-file-name | 269 | (expand-file-name |
| 266 | (concat file-name "." extension) | 270 | (format "%s.%s" pkg-name extension) |
| 267 | package-archive-upload-base) | 271 | package-archive-upload-base) |
| 268 | nil nil nil 'ask)))))))) | 272 | nil nil nil 'ask)))))))) |
| 269 | 273 | ||
| @@ -275,8 +279,8 @@ destination, prompt for one." | |||
| 275 | (save-excursion | 279 | (save-excursion |
| 276 | (save-restriction | 280 | (save-restriction |
| 277 | ;; Find the package in this buffer. | 281 | ;; Find the package in this buffer. |
| 278 | (let ((pkg-info (package-buffer-info))) | 282 | (let ((pkg-desc (package-buffer-info))) |
| 279 | (package-upload-buffer-internal pkg-info "el"))))) | 283 | (package-upload-buffer-internal pkg-desc "el"))))) |
| 280 | 284 | ||
| 281 | (defun package-upload-file (file) | 285 | (defun package-upload-file (file) |
| 282 | "Upload the Emacs Lisp package FILE to the package archive. | 286 | "Upload the Emacs Lisp package FILE to the package archive. |
| @@ -288,12 +292,13 @@ destination, prompt for one." | |||
| 288 | (interactive "fPackage file name: ") | 292 | (interactive "fPackage file name: ") |
| 289 | (with-temp-buffer | 293 | (with-temp-buffer |
| 290 | (insert-file-contents-literally file) | 294 | (insert-file-contents-literally file) |
| 291 | (let ((info (cond | 295 | (let ((pkg-desc |
| 292 | ((string-match "\\.tar$" file) (package-tar-file-info file)) | 296 | (cond |
| 293 | ((string-match "\\.el$" file) (package-buffer-info)) | 297 | ((string-match "\\.tar\\'" file) (package-tar-file-info file)) |
| 294 | (t (error "Unrecognized extension `%s'" | 298 | ((string-match "\\.el\\'" file) (package-buffer-info)) |
| 295 | (file-name-extension file)))))) | 299 | (t (error "Unrecognized extension `%s'" |
| 296 | (package-upload-buffer-internal info (file-name-extension file))))) | 300 | (file-name-extension file)))))) |
| 301 | (package-upload-buffer-internal pkg-desc (file-name-extension file))))) | ||
| 297 | 302 | ||
| 298 | (defun package-gnus-summary-upload () | 303 | (defun package-gnus-summary-upload () |
| 299 | "Upload a package contained in the current *Article* buffer. | 304 | "Upload a package contained in the current *Article* buffer. |
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 41b635bbe30..d5176abded0 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el | |||
| @@ -170,6 +170,8 @@ | |||
| 170 | 170 | ||
| 171 | ;;; Code: | 171 | ;;; Code: |
| 172 | 172 | ||
| 173 | (eval-when-compile (require 'cl-lib)) | ||
| 174 | |||
| 173 | (require 'tabulated-list) | 175 | (require 'tabulated-list) |
| 174 | 176 | ||
| 175 | (defgroup package nil | 177 | (defgroup package nil |
| @@ -262,11 +264,8 @@ Lower version numbers than this will probably be understood as well.") | |||
| 262 | ;; We don't prime the cache since it tends to get out of date. | 264 | ;; We don't prime the cache since it tends to get out of date. |
| 263 | (defvar package-archive-contents nil | 265 | (defvar package-archive-contents nil |
| 264 | "Cache of the contents of the Emacs Lisp Package Archive. | 266 | "Cache of the contents of the Emacs Lisp Package Archive. |
| 265 | This is an alist mapping package names (symbols) to package | 267 | This is an alist mapping package names (symbols) to |
| 266 | descriptor vectors. These are like the vectors for `package-alist' | 268 | `package--desc' structures.") |
| 267 | but have extra entries: one which is 'tar for tar packages and | ||
| 268 | 'single for single-file packages, and one which is the name of | ||
| 269 | the archive from which it came.") | ||
| 270 | (put 'package-archive-contents 'risky-local-variable t) | 269 | (put 'package-archive-contents 'risky-local-variable t) |
| 271 | 270 | ||
| 272 | (defcustom package-user-dir (locate-user-emacs-file "elpa") | 271 | (defcustom package-user-dir (locate-user-emacs-file "elpa") |
| @@ -297,6 +296,62 @@ contrast, `package-user-dir' contains packages for personal use." | |||
| 297 | :group 'package | 296 | :group 'package |
| 298 | :version "24.1") | 297 | :version "24.1") |
| 299 | 298 | ||
| 299 | (defvar package--default-summary "No description available.") | ||
| 300 | |||
| 301 | (cl-defstruct (package-desc | ||
| 302 | ;; Rename the default constructor from `make-package-desc'. | ||
| 303 | (:constructor package-desc-create) | ||
| 304 | ;; Has the same interface as the old `define-package', | ||
| 305 | ;; which is still used in the "foo-pkg.el" files. Extra | ||
| 306 | ;; options can be supported by adding additional keys. | ||
| 307 | (:constructor | ||
| 308 | package-desc-from-define | ||
| 309 | (name-string version-string &optional summary requirements | ||
| 310 | &key kind archive | ||
| 311 | &aux | ||
| 312 | (name (intern name-string)) | ||
| 313 | (version (version-to-list version-string)) | ||
| 314 | (reqs (mapcar #'(lambda (elt) | ||
| 315 | (list (car elt) | ||
| 316 | (version-to-list (cadr elt)))) | ||
| 317 | (if (eq 'quote (car requirements)) | ||
| 318 | (nth 1 requirements) | ||
| 319 | requirements)))))) | ||
| 320 | "Structure containing information about an individual package. | ||
| 321 | |||
| 322 | Slots: | ||
| 323 | |||
| 324 | `name' Name of the package, as a symbol. | ||
| 325 | |||
| 326 | `version' Version of the package, as a version list. | ||
| 327 | |||
| 328 | `summary' Short description of the package, typically taken from | ||
| 329 | the first line of the file. | ||
| 330 | |||
| 331 | `reqs' Requirements of the package. A list of (PACKAGE | ||
| 332 | VERSION-LIST) naming the dependent package and the minimum | ||
| 333 | required version. | ||
| 334 | |||
| 335 | `kind' The distribution format of the package. Currently, it is | ||
| 336 | either `single' or `tar'. | ||
| 337 | |||
| 338 | `archive' The name of the archive (as a string) whence this | ||
| 339 | package came." | ||
| 340 | name | ||
| 341 | version | ||
| 342 | (summary package--default-summary) | ||
| 343 | reqs | ||
| 344 | kind | ||
| 345 | archive) | ||
| 346 | |||
| 347 | ;; Package descriptor format used in finder-inf.el and package--builtins. | ||
| 348 | (cl-defstruct (package--bi-desc | ||
| 349 | (:constructor package-make-builtin (version summary)) | ||
| 350 | (:type vector)) | ||
| 351 | version | ||
| 352 | reqs | ||
| 353 | summary) | ||
| 354 | |||
| 300 | ;; The value is precomputed in finder-inf.el, but don't load that | 355 | ;; The value is precomputed in finder-inf.el, but don't load that |
| 301 | ;; until it's needed (i.e. when `package-initialize' is called). | 356 | ;; until it's needed (i.e. when `package-initialize' is called). |
| 302 | (defvar package--builtins nil | 357 | (defvar package--builtins nil |
| @@ -305,27 +360,14 @@ The actual value is initialized by loading the library | |||
| 305 | `finder-inf'; this is not done until it is needed, e.g. by the | 360 | `finder-inf'; this is not done until it is needed, e.g. by the |
| 306 | function `package-built-in-p'. | 361 | function `package-built-in-p'. |
| 307 | 362 | ||
| 308 | Each element has the form (PKG . DESC), where PKG is a package | 363 | Each element has the form (PKG . PACKAGE-BI-DESC), where PKG is a package |
| 309 | name (a symbol) and DESC is a vector that describes the package. | 364 | name (a symbol) and DESC is a `package--bi-desc' structure.") |
| 310 | The vector DESC has the form [VERSION-LIST REQS DOCSTRING]. | ||
| 311 | VERSION-LIST is a version list. | ||
| 312 | REQS is a list of packages required by the package, each | ||
| 313 | requirement having the form (NAME VL), where NAME is a string | ||
| 314 | and VL is a version list. | ||
| 315 | DOCSTRING is a brief description of the package.") | ||
| 316 | (put 'package--builtins 'risky-local-variable t) | 365 | (put 'package--builtins 'risky-local-variable t) |
| 317 | 366 | ||
| 318 | (defvar package-alist nil | 367 | (defvar package-alist nil |
| 319 | "Alist of all packages available for activation. | 368 | "Alist of all packages available for activation. |
| 320 | Each element has the form (PKG . DESC), where PKG is a package | 369 | Each element has the form (PKG . DESC), where PKG is a package |
| 321 | name (a symbol) and DESC is a vector that describes the package. | 370 | name (a symbol) and DESC is a `package-desc' structure. |
| 322 | |||
| 323 | The vector DESC has the form [VERSION-LIST REQS DOCSTRING]. | ||
| 324 | VERSION-LIST is a version list. | ||
| 325 | REQS is a list of packages required by the package, each | ||
| 326 | requirement having the form (NAME VL) where NAME is a string | ||
| 327 | and VL is a version list. | ||
| 328 | DOCSTRING is a brief description of the package. | ||
| 329 | 371 | ||
| 330 | This variable is set automatically by `package-load-descriptor', | 372 | This variable is set automatically by `package-load-descriptor', |
| 331 | called via `package-initialize'. To change which packages are | 373 | called via `package-initialize'. To change which packages are |
| @@ -339,7 +381,10 @@ loaded and/or activated, customize `package-load-list'.") | |||
| 339 | (defvar package-obsolete-alist nil | 381 | (defvar package-obsolete-alist nil |
| 340 | "Representation of obsolete packages. | 382 | "Representation of obsolete packages. |
| 341 | Like `package-alist', but maps package name to a second alist. | 383 | Like `package-alist', but maps package name to a second alist. |
| 342 | The inner alist is keyed by version.") | 384 | The inner alist is keyed by version. |
| 385 | |||
| 386 | Each element of the list is (NAME . VERSION-ALIST), where each | ||
| 387 | entry in VERSION-ALIST is (VERSION-LIST . PACKAGE-DESC).") | ||
| 343 | (put 'package-obsolete-alist 'risky-local-variable t) | 388 | (put 'package-obsolete-alist 'risky-local-variable t) |
| 344 | 389 | ||
| 345 | (defun package-version-join (vlist) | 390 | (defun package-version-join (vlist) |
| @@ -430,26 +475,16 @@ the package by calling `package-load-descriptor'." | |||
| 430 | ;; Actually load the descriptor: | 475 | ;; Actually load the descriptor: |
| 431 | (package-load-descriptor dir subdir)))) | 476 | (package-load-descriptor dir subdir)))) |
| 432 | 477 | ||
| 433 | (defsubst package-desc-vers (desc) | 478 | (define-obsolete-function-alias 'package-desc-vers 'package-desc-version "24.4") |
| 434 | "Extract version from a package description vector." | ||
| 435 | (aref desc 0)) | ||
| 436 | 479 | ||
| 437 | (defsubst package-desc-reqs (desc) | 480 | (define-obsolete-function-alias 'package-desc-doc 'package-desc-summary "24.4") |
| 438 | "Extract requirements from a package description vector." | ||
| 439 | (aref desc 1)) | ||
| 440 | 481 | ||
| 441 | (defsubst package-desc-doc (desc) | ||
| 442 | "Extract doc string from a package description vector." | ||
| 443 | (aref desc 2)) | ||
| 444 | |||
| 445 | (defsubst package-desc-kind (desc) | ||
| 446 | "Extract the kind of download from an archive package description vector." | ||
| 447 | (aref desc 3)) | ||
| 448 | 482 | ||
| 449 | (defun package--dir (name version) | 483 | (defun package--dir (name version) |
| 484 | ;; FIXME: Keep this as a field in the package-desc. | ||
| 450 | "Return the directory where a package is installed, or nil if none. | 485 | "Return the directory where a package is installed, or nil if none. |
| 451 | NAME and VERSION are both strings." | 486 | NAME is a symbol and VERSION is a string." |
| 452 | (let* ((subdir (concat name "-" version)) | 487 | (let* ((subdir (format "%s-%s" name version)) |
| 453 | (dir-list (cons package-user-dir package-directory-list)) | 488 | (dir-list (cons package-user-dir package-directory-list)) |
| 454 | pkg-dir) | 489 | pkg-dir) |
| 455 | (while dir-list | 490 | (while dir-list |
| @@ -460,9 +495,9 @@ NAME and VERSION are both strings." | |||
| 460 | (setq dir-list (cdr dir-list))))) | 495 | (setq dir-list (cdr dir-list))))) |
| 461 | pkg-dir)) | 496 | pkg-dir)) |
| 462 | 497 | ||
| 463 | (defun package-activate-1 (package pkg-vec) | 498 | (defun package-activate-1 (pkg-desc) |
| 464 | (let* ((name (symbol-name package)) | 499 | (let* ((name (package-desc-name pkg-desc)) |
| 465 | (version-str (package-version-join (package-desc-vers pkg-vec))) | 500 | (version-str (package-version-join (package-desc-version pkg-desc))) |
| 466 | (pkg-dir (package--dir name version-str))) | 501 | (pkg-dir (package--dir name version-str))) |
| 467 | (unless pkg-dir | 502 | (unless pkg-dir |
| 468 | (error "Internal error: unable to find directory for `%s-%s'" | 503 | (error "Internal error: unable to find directory for `%s-%s'" |
| @@ -475,8 +510,8 @@ NAME and VERSION are both strings." | |||
| 475 | (push pkg-dir Info-directory-list)) | 510 | (push pkg-dir Info-directory-list)) |
| 476 | ;; Add to load path, add autoloads, and activate the package. | 511 | ;; Add to load path, add autoloads, and activate the package. |
| 477 | (push pkg-dir load-path) | 512 | (push pkg-dir load-path) |
| 478 | (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t) | 513 | (load (expand-file-name (format "%s-autoloads" name) pkg-dir) nil t) |
| 479 | (push package package-activated-list) | 514 | (push name package-activated-list) |
| 480 | ;; Don't return nil. | 515 | ;; Don't return nil. |
| 481 | t)) | 516 | t)) |
| 482 | 517 | ||
| @@ -489,7 +524,12 @@ specifying the minimum acceptable version." | |||
| 489 | (version-list-<= min-version (version-to-list emacs-version)) | 524 | (version-list-<= min-version (version-to-list emacs-version)) |
| 490 | (let ((elt (assq package package--builtins))) | 525 | (let ((elt (assq package package--builtins))) |
| 491 | (and elt (version-list-<= min-version | 526 | (and elt (version-list-<= min-version |
| 492 | (package-desc-vers (cdr elt))))))) | 527 | (package--bi-desc-version (cdr elt))))))) |
| 528 | |||
| 529 | (defun package--from-builtin (bi-desc) | ||
| 530 | (package-desc-create :name (pop bi-desc) | ||
| 531 | :version (package--bi-desc-version bi-desc) | ||
| 532 | :summary (package--bi-desc-summary bi-desc))) | ||
| 493 | 533 | ||
| 494 | ;; This function goes ahead and activates a newer version of a package | 534 | ;; This function goes ahead and activates a newer version of a package |
| 495 | ;; if an older one was already activated. This is not ideal; we'd at | 535 | ;; if an older one was already activated. This is not ideal; we'd at |
| @@ -504,7 +544,7 @@ Return nil if the package could not be activated." | |||
| 504 | available-version found) | 544 | available-version found) |
| 505 | ;; Check if PACKAGE is available in `package-alist'. | 545 | ;; Check if PACKAGE is available in `package-alist'. |
| 506 | (when pkg-vec | 546 | (when pkg-vec |
| 507 | (setq available-version (package-desc-vers pkg-vec) | 547 | (setq available-version (package-desc-version pkg-vec) |
| 508 | found (version-list-<= min-version available-version))) | 548 | found (version-list-<= min-version available-version))) |
| 509 | (cond | 549 | (cond |
| 510 | ;; If no such package is found, maybe it's built-in. | 550 | ;; If no such package is found, maybe it's built-in. |
| @@ -525,7 +565,7 @@ Return nil if the package could not be activated." | |||
| 525 | Required package `%s-%s' is unavailable" | 565 | Required package `%s-%s' is unavailable" |
| 526 | package (car fail) (package-version-join (cadr fail))) | 566 | package (car fail) (package-version-join (cadr fail))) |
| 527 | ;; If all goes well, activate the package itself. | 567 | ;; If all goes well, activate the package itself. |
| 528 | (package-activate-1 package pkg-vec))))))) | 568 | (package-activate-1 pkg-vec))))))) |
| 529 | 569 | ||
| 530 | (defun package-mark-obsolete (package pkg-vec) | 570 | (defun package-mark-obsolete (package pkg-vec) |
| 531 | "Put package on the obsolete list, if not already there." | 571 | "Put package on the obsolete list, if not already there." |
| @@ -533,11 +573,11 @@ Required package `%s-%s' is unavailable" | |||
| 533 | (if elt | 573 | (if elt |
| 534 | ;; If this obsolete version does not exist in the list, update | 574 | ;; If this obsolete version does not exist in the list, update |
| 535 | ;; it the list. | 575 | ;; it the list. |
| 536 | (unless (assoc (package-desc-vers pkg-vec) (cdr elt)) | 576 | (unless (assoc (package-desc-version pkg-vec) (cdr elt)) |
| 537 | (setcdr elt (cons (cons (package-desc-vers pkg-vec) pkg-vec) | 577 | (setcdr elt (cons (cons (package-desc-version pkg-vec) pkg-vec) |
| 538 | (cdr elt)))) | 578 | (cdr elt)))) |
| 539 | ;; Make a new association. | 579 | ;; Make a new association. |
| 540 | (push (cons package (list (cons (package-desc-vers pkg-vec) | 580 | (push (cons package (list (cons (package-desc-version pkg-vec) |
| 541 | pkg-vec))) | 581 | pkg-vec))) |
| 542 | package-obsolete-alist)))) | 582 | package-obsolete-alist)))) |
| 543 | 583 | ||
| @@ -555,21 +595,17 @@ REQUIREMENTS is a list of dependencies on other packages. | |||
| 555 | EXTRA-PROPERTIES is currently unused." | 595 | EXTRA-PROPERTIES is currently unused." |
| 556 | (let* ((name (intern name-string)) | 596 | (let* ((name (intern name-string)) |
| 557 | (version (version-to-list version-string)) | 597 | (version (version-to-list version-string)) |
| 558 | (new-pkg-desc | 598 | (new-pkg-desc (cons name |
| 559 | (cons name | 599 | (package-desc-from-define name-string |
| 560 | (vector version | 600 | version-string |
| 561 | (mapcar | 601 | docstring |
| 562 | (lambda (elt) | 602 | requirements))) |
| 563 | (list (car elt) | ||
| 564 | (version-to-list (car (cdr elt))))) | ||
| 565 | requirements) | ||
| 566 | docstring))) | ||
| 567 | (old-pkg (assq name package-alist))) | 603 | (old-pkg (assq name package-alist))) |
| 568 | (cond | 604 | (cond |
| 569 | ;; If there's no old package, just add this to `package-alist'. | 605 | ;; If there's no old package, just add this to `package-alist'. |
| 570 | ((null old-pkg) | 606 | ((null old-pkg) |
| 571 | (push new-pkg-desc package-alist)) | 607 | (push new-pkg-desc package-alist)) |
| 572 | ((version-list-< (package-desc-vers (cdr old-pkg)) version) | 608 | ((version-list-< (package-desc-version (cdr old-pkg)) version) |
| 573 | ;; Remove the old package and declare it obsolete. | 609 | ;; Remove the old package and declare it obsolete. |
| 574 | (package-mark-obsolete name (cdr old-pkg)) | 610 | (package-mark-obsolete name (cdr old-pkg)) |
| 575 | (setq package-alist (cons new-pkg-desc | 611 | (setq package-alist (cons new-pkg-desc |
| @@ -577,7 +613,7 @@ EXTRA-PROPERTIES is currently unused." | |||
| 577 | ;; You can have two packages with the same version, e.g. one in | 613 | ;; You can have two packages with the same version, e.g. one in |
| 578 | ;; the system package directory and one in your private | 614 | ;; the system package directory and one in your private |
| 579 | ;; directory. We just let the first one win. | 615 | ;; directory. We just let the first one win. |
| 580 | ((not (version-list-= (package-desc-vers (cdr old-pkg)) version)) | 616 | ((not (version-list-= (package-desc-version (cdr old-pkg)) version)) |
| 581 | ;; The package is born obsolete. | 617 | ;; The package is born obsolete. |
| 582 | (package-mark-obsolete name (cdr new-pkg-desc)))))) | 618 | (package-mark-obsolete name (cdr new-pkg-desc)))))) |
| 583 | 619 | ||
| @@ -603,14 +639,15 @@ EXTRA-PROPERTIES is currently unused." | |||
| 603 | 639 | ||
| 604 | (defun package-generate-autoloads (name pkg-dir) | 640 | (defun package-generate-autoloads (name pkg-dir) |
| 605 | (require 'autoload) ;Load before we let-bind generated-autoload-file! | 641 | (require 'autoload) ;Load before we let-bind generated-autoload-file! |
| 606 | (let* ((auto-name (concat name "-autoloads.el")) | 642 | (let* ((auto-name (format "%s-autoloads.el" name)) |
| 607 | ;;(ignore-name (concat name "-pkg.el")) | 643 | ;;(ignore-name (concat name "-pkg.el")) |
| 608 | (generated-autoload-file (expand-file-name auto-name pkg-dir)) | 644 | (generated-autoload-file (expand-file-name auto-name pkg-dir)) |
| 609 | (version-control 'never)) | 645 | (version-control 'never)) |
| 610 | (package-autoload-ensure-default-file generated-autoload-file) | 646 | (package-autoload-ensure-default-file generated-autoload-file) |
| 611 | (update-directory-autoloads pkg-dir) | 647 | (update-directory-autoloads pkg-dir) |
| 612 | (let ((buf (find-buffer-visiting generated-autoload-file))) | 648 | (let ((buf (find-buffer-visiting generated-autoload-file))) |
| 613 | (when buf (kill-buffer buf))))) | 649 | (when buf (kill-buffer buf))) |
| 650 | auto-name)) | ||
| 614 | 651 | ||
| 615 | (defvar tar-parse-info) | 652 | (defvar tar-parse-info) |
| 616 | (declare-function tar-untar-buffer "tar-mode" ()) | 653 | (declare-function tar-untar-buffer "tar-mode" ()) |
| @@ -644,57 +681,62 @@ untar into a directory named DIR; otherwise, signal an error." | |||
| 644 | ;; FIXME: should we delete PKG-DIR if it exists? | 681 | ;; FIXME: should we delete PKG-DIR if it exists? |
| 645 | (let* ((default-directory (file-name-as-directory package-user-dir))) | 682 | (let* ((default-directory (file-name-as-directory package-user-dir))) |
| 646 | (package-untar-buffer dirname) | 683 | (package-untar-buffer dirname) |
| 647 | (package--make-autoloads-and-compile name pkg-dir)))) | 684 | (package--make-autoloads-and-compile package pkg-dir)))) |
| 648 | 685 | ||
| 649 | (defun package--make-autoloads-and-compile (name pkg-dir) | 686 | (defun package--make-autoloads-and-compile (name pkg-dir) |
| 650 | "Generate autoloads and do byte-compilation for package named NAME. | 687 | "Generate autoloads and do byte-compilation for package named NAME. |
| 651 | PKG-DIR is the name of the package directory." | 688 | PKG-DIR is the name of the package directory." |
| 652 | (package-generate-autoloads name pkg-dir) | 689 | (let ((auto-name (package-generate-autoloads name pkg-dir)) |
| 653 | (let ((load-path (cons pkg-dir load-path))) | 690 | (load-path (cons pkg-dir load-path))) |
| 654 | ;; We must load the autoloads file before byte compiling, in | 691 | ;; We must load the autoloads file before byte compiling, in |
| 655 | ;; case there are magic cookies to set up non-trivial paths. | 692 | ;; case there are magic cookies to set up non-trivial paths. |
| 656 | (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t) | 693 | (load auto-name nil t) |
| 694 | ;; FIXME: Compilation should be done as a separate, optional, step. | ||
| 695 | ;; E.g. for multi-package installs, we should first install all packages | ||
| 696 | ;; and then compile them. | ||
| 657 | (byte-recompile-directory pkg-dir 0 t))) | 697 | (byte-recompile-directory pkg-dir 0 t))) |
| 658 | 698 | ||
| 659 | (defun package--write-file-no-coding (file-name) | 699 | (defun package--write-file-no-coding (file-name) |
| 660 | (let ((buffer-file-coding-system 'no-conversion)) | 700 | (let ((buffer-file-coding-system 'no-conversion)) |
| 661 | (write-region (point-min) (point-max) file-name))) | 701 | (write-region (point-min) (point-max) file-name))) |
| 662 | 702 | ||
| 663 | (defun package-unpack-single (file-name version desc requires) | 703 | (defun package-unpack-single (name version desc requires) |
| 664 | "Install the contents of the current buffer as a package." | 704 | "Install the contents of the current buffer as a package." |
| 665 | ;; Special case "package". | 705 | ;; Special case "package". FIXME: Should this still be supported? |
| 666 | (if (string= file-name "package") | 706 | (if (eq name 'package) |
| 667 | (package--write-file-no-coding | 707 | (package--write-file-no-coding |
| 668 | (expand-file-name (concat file-name ".el") package-user-dir)) | 708 | (expand-file-name (format "%s.el" name) package-user-dir)) |
| 669 | (let* ((pkg-dir (expand-file-name (concat file-name "-" | 709 | (let* ((pkg-dir (expand-file-name (format "%s-%s" name |
| 670 | (package-version-join | 710 | (package-version-join |
| 671 | (version-to-list version))) | 711 | (version-to-list version))) |
| 672 | package-user-dir)) | 712 | package-user-dir)) |
| 673 | (el-file (expand-file-name (concat file-name ".el") pkg-dir)) | 713 | (el-file (expand-file-name (format "%s.el" name) pkg-dir)) |
| 674 | (pkg-file (expand-file-name (concat file-name "-pkg.el") pkg-dir))) | 714 | (pkg-file (expand-file-name (format "%s-pkg.el" name) pkg-dir))) |
| 675 | (make-directory pkg-dir t) | 715 | (make-directory pkg-dir t) |
| 676 | (package--write-file-no-coding el-file) | 716 | (package--write-file-no-coding el-file) |
| 677 | (let ((print-level nil) | 717 | (let ((print-level nil) |
| 718 | (print-quoted t) | ||
| 678 | (print-length nil)) | 719 | (print-length nil)) |
| 679 | (write-region | 720 | (write-region |
| 680 | (concat | 721 | (concat |
| 681 | (prin1-to-string | 722 | (prin1-to-string |
| 682 | (list 'define-package | 723 | (list 'define-package |
| 683 | file-name | 724 | (symbol-name name) |
| 684 | version | 725 | version |
| 685 | desc | 726 | desc |
| 686 | (list 'quote | 727 | (when requires ;Don't bother quoting nil. |
| 687 | ;; Turn version lists into string form. | 728 | (list 'quote |
| 688 | (mapcar | 729 | ;; Turn version lists into string form. |
| 689 | (lambda (elt) | 730 | (mapcar |
| 690 | (list (car elt) | 731 | (lambda (elt) |
| 691 | (package-version-join (cadr elt)))) | 732 | (list (car elt) |
| 692 | requires)))) | 733 | (package-version-join (cadr elt)))) |
| 734 | requires))))) | ||
| 693 | "\n") | 735 | "\n") |
| 694 | nil | 736 | nil |
| 695 | pkg-file | 737 | pkg-file |
| 696 | nil nil nil 'excl)) | 738 | nil nil nil 'excl)) |
| 697 | (package--make-autoloads-and-compile file-name pkg-dir)))) | 739 | (package--make-autoloads-and-compile name pkg-dir)))) |
| 698 | 740 | ||
| 699 | (defmacro package--with-work-buffer (location file &rest body) | 741 | (defmacro package--with-work-buffer (location file &rest body) |
| 700 | "Run BODY in a buffer containing the contents of FILE at LOCATION. | 742 | "Run BODY in a buffer containing the contents of FILE at LOCATION. |
| @@ -744,7 +786,7 @@ It will move point to somewhere in the headers." | |||
| 744 | (let ((location (package-archive-base name)) | 786 | (let ((location (package-archive-base name)) |
| 745 | (file (concat (symbol-name name) "-" version ".el"))) | 787 | (file (concat (symbol-name name) "-" version ".el"))) |
| 746 | (package--with-work-buffer location file | 788 | (package--with-work-buffer location file |
| 747 | (package-unpack-single (symbol-name name) version desc requires)))) | 789 | (package-unpack-single name version desc requires)))) |
| 748 | 790 | ||
| 749 | (defun package-download-tar (name version) | 791 | (defun package-download-tar (name version) |
| 750 | "Download and install a tar package." | 792 | "Download and install a tar package." |
| @@ -762,7 +804,7 @@ MIN-VERSION should be a version list." | |||
| 762 | (let ((pkg-desc (assq package package-alist))) | 804 | (let ((pkg-desc (assq package package-alist))) |
| 763 | (if pkg-desc | 805 | (if pkg-desc |
| 764 | (version-list-<= min-version | 806 | (version-list-<= min-version |
| 765 | (package-desc-vers (cdr pkg-desc))) | 807 | (package-desc-version (cdr pkg-desc))) |
| 766 | ;; Also check built-in packages. | 808 | ;; Also check built-in packages. |
| 767 | (package-built-in-p package min-version)))) | 809 | (package-built-in-p package min-version)))) |
| 768 | 810 | ||
| @@ -785,7 +827,7 @@ not included in this list." | |||
| 785 | (unless (package-installed-p next-pkg next-version) | 827 | (unless (package-installed-p next-pkg next-version) |
| 786 | ;; A package is required, but not installed. It might also be | 828 | ;; A package is required, but not installed. It might also be |
| 787 | ;; blocked via `package-load-list'. | 829 | ;; blocked via `package-load-list'. |
| 788 | (let ((pkg-desc (assq next-pkg package-archive-contents)) | 830 | (let ((pkg-desc (cdr (assq next-pkg package-archive-contents))) |
| 789 | hold) | 831 | hold) |
| 790 | (when (setq hold (assq next-pkg package-load-list)) | 832 | (when (setq hold (assq next-pkg package-load-list)) |
| 791 | (setq hold (cadr hold)) | 833 | (setq hold (cadr hold)) |
| @@ -805,17 +847,17 @@ but version %s required" | |||
| 805 | (symbol-name next-pkg) | 847 | (symbol-name next-pkg) |
| 806 | (package-version-join next-version))) | 848 | (package-version-join next-version))) |
| 807 | (unless (version-list-<= next-version | 849 | (unless (version-list-<= next-version |
| 808 | (package-desc-vers (cdr pkg-desc))) | 850 | (package-desc-version pkg-desc)) |
| 809 | (error | 851 | (error |
| 810 | "Need package `%s-%s', but only %s is available" | 852 | "Need package `%s-%s', but only %s is available" |
| 811 | (symbol-name next-pkg) (package-version-join next-version) | 853 | (symbol-name next-pkg) (package-version-join next-version) |
| 812 | (package-version-join (package-desc-vers (cdr pkg-desc))))) | 854 | (package-version-join (package-desc-version pkg-desc)))) |
| 813 | ;; Move to front, so it gets installed early enough (bug#14082). | 855 | ;; Move to front, so it gets installed early enough (bug#14082). |
| 814 | (setq package-list (cons next-pkg (delq next-pkg package-list))) | 856 | (setq package-list (cons next-pkg (delq next-pkg package-list))) |
| 815 | (setq package-list | 857 | (setq package-list |
| 816 | (package-compute-transaction package-list | 858 | (package-compute-transaction package-list |
| 817 | (package-desc-reqs | 859 | (package-desc-reqs |
| 818 | (cdr pkg-desc)))))))) | 860 | pkg-desc))))))) |
| 819 | package-list) | 861 | package-list) |
| 820 | 862 | ||
| 821 | (defun package-read-from-string (str) | 863 | (defun package-read-from-string (str) |
| @@ -867,13 +909,29 @@ If the archive version is too new, signal an error." | |||
| 867 | (dolist (package contents) | 909 | (dolist (package contents) |
| 868 | (package--add-to-archive-contents package archive))))) | 910 | (package--add-to-archive-contents package archive))))) |
| 869 | 911 | ||
| 912 | ;; Package descriptor objects used inside the "archive-contents" file. | ||
| 913 | ;; Changing this defstruct implies changing the format of the | ||
| 914 | ;; "archive-contents" files. | ||
| 915 | (cl-defstruct (package--ac-desc | ||
| 916 | (:constructor package-make-ac-desc (version reqs summary kind)) | ||
| 917 | (:copier nil) | ||
| 918 | (:type vector)) | ||
| 919 | version reqs summary kind) | ||
| 920 | |||
| 870 | (defun package--add-to-archive-contents (package archive) | 921 | (defun package--add-to-archive-contents (package archive) |
| 871 | "Add the PACKAGE from the given ARCHIVE if necessary. | 922 | "Add the PACKAGE from the given ARCHIVE if necessary. |
| 872 | Also, add the originating archive to the end of the package vector." | 923 | PACKAGE should have the form (NAME . PACKAGE--AC-DESC). |
| 873 | (let* ((name (car package)) | 924 | Also, add the originating archive to the `package-desc' structure." |
| 874 | (version (package-desc-vers (cdr package))) | 925 | (let* ((name (car package)) |
| 875 | (entry (cons name | 926 | (pkg-desc |
| 876 | (vconcat (cdr package) (vector archive)))) | 927 | (package-desc-create |
| 928 | :name name | ||
| 929 | :version (package--ac-desc-version (cdr package)) | ||
| 930 | :reqs (package--ac-desc-reqs (cdr package)) | ||
| 931 | :summary (package--ac-desc-summary (cdr package)) | ||
| 932 | :kind (package--ac-desc-kind (cdr package)) | ||
| 933 | :archive archive)) | ||
| 934 | (entry (cons name pkg-desc)) | ||
| 877 | (existing-package (assq name package-archive-contents)) | 935 | (existing-package (assq name package-archive-contents)) |
| 878 | (pinned-to-archive (assoc name package-pinned-packages))) | 936 | (pinned-to-archive (assoc name package-pinned-packages))) |
| 879 | (cond ((and pinned-to-archive | 937 | (cond ((and pinned-to-archive |
| @@ -881,9 +939,9 @@ Also, add the originating archive to the end of the package vector." | |||
| 881 | (not (equal (cdr pinned-to-archive) archive))) | 939 | (not (equal (cdr pinned-to-archive) archive))) |
| 882 | nil) | 940 | nil) |
| 883 | ((not existing-package) | 941 | ((not existing-package) |
| 884 | (add-to-list 'package-archive-contents entry)) | 942 | (push entry package-archive-contents)) |
| 885 | ((version-list-< (package-desc-vers (cdr existing-package)) | 943 | ((version-list-< (package-desc-version (cdr existing-package)) |
| 886 | version) | 944 | (package-desc-version pkg-desc)) |
| 887 | ;; Replace the entry with this one. | 945 | ;; Replace the entry with this one. |
| 888 | (setq package-archive-contents | 946 | (setq package-archive-contents |
| 889 | (cons entry | 947 | (cons entry |
| @@ -902,14 +960,14 @@ using `package-compute-transaction'." | |||
| 902 | ;; `package-load-list', download the held version. | 960 | ;; `package-load-list', download the held version. |
| 903 | (hold (cadr (assq elt package-load-list))) | 961 | (hold (cadr (assq elt package-load-list))) |
| 904 | (v-string (or (and (stringp hold) hold) | 962 | (v-string (or (and (stringp hold) hold) |
| 905 | (package-version-join (package-desc-vers desc)))) | 963 | (package-version-join (package-desc-version desc)))) |
| 906 | (kind (package-desc-kind desc))) | 964 | (kind (package-desc-kind desc))) |
| 907 | (cond | 965 | (cond |
| 908 | ((eq kind 'tar) | 966 | ((eq kind 'tar) |
| 909 | (package-download-tar elt v-string)) | 967 | (package-download-tar elt v-string)) |
| 910 | ((eq kind 'single) | 968 | ((eq kind 'single) |
| 911 | (package-download-single elt v-string | 969 | (package-download-single elt v-string |
| 912 | (package-desc-doc desc) | 970 | (package-desc-summary desc) |
| 913 | (package-desc-reqs desc))) | 971 | (package-desc-reqs desc))) |
| 914 | (t | 972 | (t |
| 915 | (error "Unknown package kind: %s" (symbol-name kind)))) | 973 | (error "Unknown package kind: %s" (symbol-name kind)))) |
| @@ -961,17 +1019,7 @@ Otherwise return nil." | |||
| 961 | (error nil)))) | 1019 | (error nil)))) |
| 962 | 1020 | ||
| 963 | (defun package-buffer-info () | 1021 | (defun package-buffer-info () |
| 964 | "Return a vector describing the package in the current buffer. | 1022 | "Return a `package-desc' describing the package in the current buffer. |
| 965 | The vector has the form | ||
| 966 | |||
| 967 | [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY] | ||
| 968 | |||
| 969 | FILENAME is the file name, a string, sans the \".el\" extension. | ||
| 970 | REQUIRES is a list of requirements, each requirement having the | ||
| 971 | form (NAME VER); NAME is a string and VER is a version list. | ||
| 972 | DESCRIPTION is the package description, a string. | ||
| 973 | VERSION is the version, a string. | ||
| 974 | COMMENTARY is the commentary section, a string, or nil if none. | ||
| 975 | 1023 | ||
| 976 | If the buffer does not contain a conforming package, signal an | 1024 | If the buffer does not contain a conforming package, signal an |
| 977 | error. If there is a package, narrow the buffer to the file's | 1025 | error. If there is a package, narrow the buffer to the file's |
| @@ -990,25 +1038,18 @@ boundaries." | |||
| 990 | (require 'lisp-mnt) | 1038 | (require 'lisp-mnt) |
| 991 | ;; Use some headers we've invented to drive the process. | 1039 | ;; Use some headers we've invented to drive the process. |
| 992 | (let* ((requires-str (lm-header "package-requires")) | 1040 | (let* ((requires-str (lm-header "package-requires")) |
| 993 | (requires (if requires-str | ||
| 994 | (package-read-from-string requires-str))) | ||
| 995 | ;; Prefer Package-Version; if defined, the package author | 1041 | ;; Prefer Package-Version; if defined, the package author |
| 996 | ;; probably wants us to use it. Otherwise try Version. | 1042 | ;; probably wants us to use it. Otherwise try Version. |
| 997 | (pkg-version | 1043 | (pkg-version |
| 998 | (or (package-strip-rcs-id (lm-header "package-version")) | 1044 | (or (package-strip-rcs-id (lm-header "package-version")) |
| 999 | (package-strip-rcs-id (lm-header "version")))) | 1045 | (package-strip-rcs-id (lm-header "version"))))) |
| 1000 | (commentary (lm-commentary))) | ||
| 1001 | (unless pkg-version | 1046 | (unless pkg-version |
| 1002 | (error | 1047 | (error |
| 1003 | "Package lacks a \"Version\" or \"Package-Version\" header")) | 1048 | "Package lacks a \"Version\" or \"Package-Version\" header")) |
| 1004 | ;; Turn string version numbers into list form. | 1049 | (package-desc-from-define |
| 1005 | (setq requires | 1050 | file-name pkg-version desc |
| 1006 | (mapcar | 1051 | (if requires-str (package-read-from-string requires-str)) |
| 1007 | (lambda (elt) | 1052 | :kind 'single)))) |
| 1008 | (list (car elt) | ||
| 1009 | (version-to-list (car (cdr elt))))) | ||
| 1010 | requires)) | ||
| 1011 | (vector file-name requires desc pkg-version commentary)))) | ||
| 1012 | 1053 | ||
| 1013 | (defun package-tar-file-info (file) | 1054 | (defun package-tar-file-info (file) |
| 1014 | "Find package information for a tar file. | 1055 | "Find package information for a tar file. |
| @@ -1025,67 +1066,46 @@ The return result is a vector like `package-buffer-info'." | |||
| 1025 | (pkg-def-contents (shell-command-to-string | 1066 | (pkg-def-contents (shell-command-to-string |
| 1026 | ;; Requires GNU tar. | 1067 | ;; Requires GNU tar. |
| 1027 | (concat "tar -xOf " file " " | 1068 | (concat "tar -xOf " file " " |
| 1028 | |||
| 1029 | pkg-name "-" pkg-version "/" | 1069 | pkg-name "-" pkg-version "/" |
| 1030 | pkg-name "-pkg.el"))) | 1070 | pkg-name "-pkg.el"))) |
| 1031 | (pkg-def-parsed (package-read-from-string pkg-def-contents))) | 1071 | (pkg-def-parsed (package-read-from-string pkg-def-contents))) |
| 1032 | (unless (eq (car pkg-def-parsed) 'define-package) | 1072 | (unless (eq (car pkg-def-parsed) 'define-package) |
| 1033 | (error "No `define-package' sexp is present in `%s-pkg.el'" pkg-name)) | 1073 | (error "No `define-package' sexp is present in `%s-pkg.el'" pkg-name)) |
| 1034 | (let ((name-str (nth 1 pkg-def-parsed)) | 1074 | (let ((pkg-desc |
| 1035 | (version-string (nth 2 pkg-def-parsed)) | 1075 | (apply #'package-desc-from-define (append (cdr pkg-def-parsed) |
| 1036 | (docstring (nth 3 pkg-def-parsed)) | 1076 | '(:kind tar))))) |
| 1037 | (requires (nth 4 pkg-def-parsed)) | 1077 | (unless (equal pkg-version |
| 1038 | (readme (shell-command-to-string | 1078 | (package-version-join (package-desc-version pkg-desc))) |
| 1039 | ;; Requires GNU tar. | ||
| 1040 | (concat "tar -xOf " file " " | ||
| 1041 | pkg-name "-" pkg-version "/README")))) | ||
| 1042 | (unless (equal pkg-version version-string) | ||
| 1043 | (error "Package has inconsistent versions")) | 1079 | (error "Package has inconsistent versions")) |
| 1044 | (unless (equal pkg-name name-str) | 1080 | (unless (equal pkg-name (symbol-name (package-desc-name pkg-desc))) |
| 1045 | (error "Package has inconsistent names")) | 1081 | (error "Package has inconsistent names")) |
| 1046 | ;; Kind of a hack. | 1082 | pkg-desc)))) |
| 1047 | (if (string-match ": Not found in archive" readme) | 1083 | |
| 1048 | (setq readme nil)) | ||
| 1049 | ;; Turn string version numbers into list form. | ||
| 1050 | (if (eq (car requires) 'quote) | ||
| 1051 | (setq requires (car (cdr requires)))) | ||
| 1052 | (setq requires | ||
| 1053 | (mapcar (lambda (elt) | ||
| 1054 | (list (car elt) | ||
| 1055 | (version-to-list (cadr elt)))) | ||
| 1056 | requires)) | ||
| 1057 | (vector pkg-name requires docstring version-string readme))))) | ||
| 1058 | 1084 | ||
| 1059 | ;;;###autoload | 1085 | ;;;###autoload |
| 1060 | (defun package-install-from-buffer (pkg-info type) | 1086 | (defun package-install-from-buffer (pkg-desc) |
| 1061 | "Install a package from the current buffer. | 1087 | "Install a package from the current buffer. |
| 1062 | When called interactively, the current buffer is assumed to be a | 1088 | When called interactively, the current buffer is assumed to be a |
| 1063 | single .el file that follows the packaging guidelines; see info | 1089 | single .el file that follows the packaging guidelines; see info |
| 1064 | node `(elisp)Packaging'. | 1090 | node `(elisp)Packaging'. |
| 1065 | 1091 | ||
| 1066 | When called from Lisp, PKG-INFO is a vector describing the | 1092 | When called from Lisp, PKG-DESC is a `package-desc' describing the |
| 1067 | information, of the type returned by `package-buffer-info'; and | 1093 | information)." |
| 1068 | TYPE is the package type (either `single' or `tar')." | 1094 | (interactive (list (package-buffer-info))) |
| 1069 | (interactive (list (package-buffer-info) 'single)) | ||
| 1070 | (save-excursion | 1095 | (save-excursion |
| 1071 | (save-restriction | 1096 | (save-restriction |
| 1072 | (let* ((file-name (aref pkg-info 0)) | 1097 | (let* ((name (package-desc-name pkg-desc)) |
| 1073 | (requires (aref pkg-info 1)) | 1098 | (requires (package-desc-reqs pkg-desc)) |
| 1074 | (desc (if (string= (aref pkg-info 2) "") | 1099 | (desc (package-desc-summary pkg-desc)) |
| 1075 | "No description available." | 1100 | (pkg-version (package-desc-version pkg-desc))) |
| 1076 | (aref pkg-info 2))) | ||
| 1077 | (pkg-version (aref pkg-info 3))) | ||
| 1078 | ;; Download and install the dependencies. | 1101 | ;; Download and install the dependencies. |
| 1079 | (let ((transaction (package-compute-transaction nil requires))) | 1102 | (let ((transaction (package-compute-transaction nil requires))) |
| 1080 | (package-download-transaction transaction)) | 1103 | (package-download-transaction transaction)) |
| 1081 | ;; Install the package itself. | 1104 | ;; Install the package itself. |
| 1082 | (cond | 1105 | (pcase (package-desc-kind pkg-desc) |
| 1083 | ((eq type 'single) | 1106 | (`single (package-unpack-single name pkg-version desc requires)) |
| 1084 | (package-unpack-single file-name pkg-version desc requires)) | 1107 | (`tar (package-unpack name pkg-version)) |
| 1085 | ((eq type 'tar) | 1108 | (type (error "Unknown type: %S" type))) |
| 1086 | (package-unpack (intern file-name) pkg-version)) | ||
| 1087 | (t | ||
| 1088 | (error "Unknown type: %s" (symbol-name type)))) | ||
| 1089 | ;; Try to activate it. | 1109 | ;; Try to activate it. |
| 1090 | (package-initialize))))) | 1110 | (package-initialize))))) |
| 1091 | 1111 | ||
| @@ -1097,10 +1117,10 @@ The file can either be a tar file or an Emacs Lisp file." | |||
| 1097 | (with-temp-buffer | 1117 | (with-temp-buffer |
| 1098 | (insert-file-contents-literally file) | 1118 | (insert-file-contents-literally file) |
| 1099 | (cond | 1119 | (cond |
| 1100 | ((string-match "\\.el$" file) | 1120 | ((string-match "\\.el\\'" file) |
| 1101 | (package-install-from-buffer (package-buffer-info) 'single)) | 1121 | (package-install-from-buffer (package-buffer-info))) |
| 1102 | ((string-match "\\.tar$" file) | 1122 | ((string-match "\\.tar\\'" file) |
| 1103 | (package-install-from-buffer (package-tar-file-info file) 'tar)) | 1123 | (package-install-from-buffer (package-tar-file-info file))) |
| 1104 | (t (error "Unrecognized extension `%s'" (file-name-extension file)))))) | 1124 | (t (error "Unrecognized extension `%s'" (file-name-extension file)))))) |
| 1105 | 1125 | ||
| 1106 | (defun package-delete (name version) | 1126 | (defun package-delete (name version) |
| @@ -1118,7 +1138,7 @@ The file can either be a tar file or an Emacs Lisp file." | |||
| 1118 | (defun package-archive-base (name) | 1138 | (defun package-archive-base (name) |
| 1119 | "Return the archive containing the package NAME." | 1139 | "Return the archive containing the package NAME." |
| 1120 | (let ((desc (cdr (assq (intern-soft name) package-archive-contents)))) | 1140 | (let ((desc (cdr (assq (intern-soft name) package-archive-contents)))) |
| 1121 | (cdr (assoc (aref desc (- (length desc) 1)) package-archives)))) | 1141 | (cdr (assoc (package-desc-archive desc) package-archives)))) |
| 1122 | 1142 | ||
| 1123 | (defun package--download-one-archive (archive file) | 1143 | (defun package--download-one-archive (archive file) |
| 1124 | "Retrieve an archive file FILE from ARCHIVE, and cache it. | 1144 | "Retrieve an archive file FILE from ARCHIVE, and cache it. |
| @@ -1163,7 +1183,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." | |||
| 1163 | (package-read-all-archive-contents) | 1183 | (package-read-all-archive-contents) |
| 1164 | (unless no-activate | 1184 | (unless no-activate |
| 1165 | (dolist (elt package-alist) | 1185 | (dolist (elt package-alist) |
| 1166 | (package-activate (car elt) (package-desc-vers (cdr elt))))) | 1186 | (package-activate (car elt) (package-desc-version (cdr elt))))) |
| 1167 | (setq package--initialized t)) | 1187 | (setq package--initialized t)) |
| 1168 | 1188 | ||
| 1169 | 1189 | ||
| @@ -1210,22 +1230,22 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." | |||
| 1210 | (cond | 1230 | (cond |
| 1211 | ;; Loaded packages are in `package-alist'. | 1231 | ;; Loaded packages are in `package-alist'. |
| 1212 | ((setq desc (cdr (assq package package-alist))) | 1232 | ((setq desc (cdr (assq package package-alist))) |
| 1213 | (setq version (package-version-join (package-desc-vers desc))) | 1233 | (setq version (package-version-join (package-desc-version desc))) |
| 1214 | (if (setq pkg-dir (package--dir package-name version)) | 1234 | (if (setq pkg-dir (package--dir package-name version)) |
| 1215 | (insert "an installed package.\n\n") | 1235 | (insert "an installed package.\n\n") |
| 1216 | ;; This normally does not happen. | 1236 | ;; This normally does not happen. |
| 1217 | (insert "a deleted package.\n\n"))) | 1237 | (insert "a deleted package.\n\n"))) |
| 1218 | ;; Available packages are in `package-archive-contents'. | 1238 | ;; Available packages are in `package-archive-contents'. |
| 1219 | ((setq desc (cdr (assq package package-archive-contents))) | 1239 | ((setq desc (cdr (assq package package-archive-contents))) |
| 1220 | (setq version (package-version-join (package-desc-vers desc)) | 1240 | (setq version (package-version-join (package-desc-version desc)) |
| 1221 | archive (aref desc (- (length desc) 1)) | 1241 | archive (package-desc-archive desc) |
| 1222 | installable t) | 1242 | installable t) |
| 1223 | (if built-in | 1243 | (if built-in |
| 1224 | (insert "a built-in package.\n\n") | 1244 | (insert "a built-in package.\n\n") |
| 1225 | (insert "an uninstalled package.\n\n"))) | 1245 | (insert "an uninstalled package.\n\n"))) |
| 1226 | (built-in | 1246 | (built-in |
| 1227 | (setq desc (cdr built-in) | 1247 | (setq desc (package--from-builtin built-in) |
| 1228 | version (package-version-join (package-desc-vers desc))) | 1248 | version (package-version-join (package-desc-version desc))) |
| 1229 | (insert "a built-in package.\n\n")) | 1249 | (insert "a built-in package.\n\n")) |
| 1230 | (t | 1250 | (t |
| 1231 | (insert "an orphan package.\n\n"))) | 1251 | (insert "an orphan package.\n\n"))) |
| @@ -1246,7 +1266,8 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." | |||
| 1246 | (insert "'."))) | 1266 | (insert "'."))) |
| 1247 | (installable | 1267 | (installable |
| 1248 | (if built-in | 1268 | (if built-in |
| 1249 | (insert (propertize "Built-in." 'font-lock-face 'font-lock-builtin-face) | 1269 | (insert (propertize "Built-in." |
| 1270 | 'font-lock-face 'font-lock-builtin-face) | ||
| 1250 | " Alternate version available") | 1271 | " Alternate version available") |
| 1251 | (insert "Available")) | 1272 | (insert "Available")) |
| 1252 | (insert " from " archive) | 1273 | (insert " from " archive) |
| @@ -1261,7 +1282,8 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." | |||
| 1261 | 'package-symbol package | 1282 | 'package-symbol package |
| 1262 | 'action 'package-install-button-action))) | 1283 | 'action 'package-install-button-action))) |
| 1263 | (built-in | 1284 | (built-in |
| 1264 | (insert (propertize "Built-in." 'font-lock-face 'font-lock-builtin-face))) | 1285 | (insert (propertize "Built-in." |
| 1286 | 'font-lock-face 'font-lock-builtin-face))) | ||
| 1265 | (t (insert "Deleted."))) | 1287 | (t (insert "Deleted."))) |
| 1266 | (insert "\n") | 1288 | (insert "\n") |
| 1267 | (and version (> (length version) 0) | 1289 | (and version (> (length version) 0) |
| @@ -1286,7 +1308,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." | |||
| 1286 | (help-insert-xref-button text 'help-package name)) | 1308 | (help-insert-xref-button text 'help-package name)) |
| 1287 | (insert "\n"))) | 1309 | (insert "\n"))) |
| 1288 | (insert " " (propertize "Summary" 'font-lock-face 'bold) | 1310 | (insert " " (propertize "Summary" 'font-lock-face 'bold) |
| 1289 | ": " (if desc (package-desc-doc desc)) "\n\n") | 1311 | ": " (if desc (package-desc-summary desc)) "\n\n") |
| 1290 | 1312 | ||
| 1291 | (if built-in | 1313 | (if built-in |
| 1292 | ;; For built-in packages, insert the commentary. | 1314 | ;; For built-in packages, insert the commentary. |
| @@ -1418,10 +1440,10 @@ If the alist stored in the symbol LISTNAME lacks an entry for a | |||
| 1418 | package PACKAGE with descriptor DESC, add one. The alist is | 1440 | package PACKAGE with descriptor DESC, add one. The alist is |
| 1419 | keyed with cons cells (PACKAGE . VERSION-LIST), where PACKAGE is | 1441 | keyed with cons cells (PACKAGE . VERSION-LIST), where PACKAGE is |
| 1420 | a symbol and VERSION-LIST is a version list." | 1442 | a symbol and VERSION-LIST is a version list." |
| 1421 | `(let* ((version (package-desc-vers ,desc)) | 1443 | `(let* ((version (package-desc-version ,desc)) |
| 1422 | (key (cons ,package version))) | 1444 | (key (cons ,package version))) |
| 1423 | (unless (assoc key ,listname) | 1445 | (unless (assoc key ,listname) |
| 1424 | (push (list key ,status (package-desc-doc ,desc)) ,listname)))) | 1446 | (push (list key ,status (package-desc-summary ,desc)) ,listname)))) |
| 1425 | 1447 | ||
| 1426 | (defun package-menu--generate (remember-pos packages) | 1448 | (defun package-menu--generate (remember-pos packages) |
| 1427 | "Populate the Package Menu. | 1449 | "Populate the Package Menu. |
| @@ -1444,7 +1466,7 @@ or a list of package names (symbols) to display." | |||
| 1444 | (setq name (car elt)) | 1466 | (setq name (car elt)) |
| 1445 | (when (and (not (eq name 'emacs)) ; Hide the `emacs' package. | 1467 | (when (and (not (eq name 'emacs)) ; Hide the `emacs' package. |
| 1446 | (or (eq packages t) (memq name packages))) | 1468 | (or (eq packages t) (memq name packages))) |
| 1447 | (package--push name (cdr elt) "built-in" info-list))) | 1469 | (package--push name (package--from-builtin elt) "built-in" info-list))) |
| 1448 | 1470 | ||
| 1449 | ;; Available and disabled packages: | 1471 | ;; Available and disabled packages: |
| 1450 | (dolist (elt package-archive-contents) | 1472 | (dolist (elt package-archive-contents) |
diff --git a/lisp/epa.el b/lisp/epa.el index b567df5f40b..14f8879c1c6 100644 --- a/lisp/epa.el +++ b/lisp/epa.el | |||
| @@ -620,21 +620,24 @@ If SECRET is non-nil, list secret keys instead of public keys." | |||
| 620 | (floor (* (/ current (float total)) 100)))) | 620 | (floor (* (/ current (float total)) 100)))) |
| 621 | (message "%s..." prompt)))) | 621 | (message "%s..." prompt)))) |
| 622 | 622 | ||
| 623 | (defun epa-read-file-name (input) | ||
| 624 | "Interactively read an output file name based on INPUT file name." | ||
| 625 | (setq input (file-name-sans-extension (expand-file-name input))) | ||
| 626 | (expand-file-name | ||
| 627 | (read-file-name | ||
| 628 | (concat "To file (default " (file-name-nondirectory input) ") ") | ||
| 629 | (file-name-directory input) | ||
| 630 | input))) | ||
| 631 | |||
| 623 | ;;;###autoload | 632 | ;;;###autoload |
| 624 | (defun epa-decrypt-file (decrypt-file plain-file) | 633 | (defun epa-decrypt-file (decrypt-file &optional plain-file) |
| 625 | "Decrypt DECRYPT-FILE into PLAIN-FILE." | 634 | "Decrypt DECRYPT-FILE into PLAIN-FILE. |
| 635 | If you do not specify PLAIN-FILE, this functions prompts for the value to use." | ||
| 626 | (interactive | 636 | (interactive |
| 627 | (let (file default-name plain) | 637 | (let* ((file (read-file-name "File to decrypt: ")) |
| 628 | (setq file (read-file-name "File to decrypt: ")) | 638 | (plain (epa-read-file-name file))) |
| 629 | (setq default-name (file-name-sans-extension (expand-file-name file))) | ||
| 630 | (setq plain (expand-file-name | ||
| 631 | (read-file-name | ||
| 632 | (concat "To file (default " | ||
| 633 | (file-name-nondirectory default-name) | ||
| 634 | ") ") | ||
| 635 | (file-name-directory default-name) | ||
| 636 | default-name))) | ||
| 637 | (list file plain))) | 639 | (list file plain))) |
| 640 | (or plain-file (setq plain-file (epa-read-file-name decrypt-file))) | ||
| 638 | (setq decrypt-file (expand-file-name decrypt-file)) | 641 | (setq decrypt-file (expand-file-name decrypt-file)) |
| 639 | (let ((context (epg-make-context epa-protocol))) | 642 | (let ((context (epg-make-context epa-protocol))) |
| 640 | (epg-context-set-passphrase-callback context | 643 | (epg-context-set-passphrase-callback context |
diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el index 1d4b2a59d4b..2932f443e4f 100644 --- a/lisp/eshell/em-term.el +++ b/lisp/eshell/em-term.el | |||
| @@ -62,13 +62,19 @@ which commands are considered visual in nature." | |||
| 62 | "less" "more" ; M-x view-file | 62 | "less" "more" ; M-x view-file |
| 63 | "lynx" "ncftp" ; w3.el, ange-ftp | 63 | "lynx" "ncftp" ; w3.el, ange-ftp |
| 64 | "pine" "tin" "trn" "elm") ; GNUS!! | 64 | "pine" "tin" "trn" "elm") ; GNUS!! |
| 65 | "A list of commands that present their output in a visual fashion." | 65 | "A list of commands that present their output in a visual fashion. |
| 66 | |||
| 67 | Commands listed here are run in a term buffer. | ||
| 68 | |||
| 69 | See also `eshell-visual-subcommands' and `eshell-visual-options'." | ||
| 66 | :type '(repeat string) | 70 | :type '(repeat string) |
| 67 | :group 'eshell-term) | 71 | :group 'eshell-term) |
| 68 | 72 | ||
| 69 | (defcustom eshell-visual-subcommands | 73 | (defcustom eshell-visual-subcommands |
| 70 | nil | 74 | nil |
| 71 | "An alist of the form | 75 | "An alist of subcommands that present their output in a visual fashion. |
| 76 | |||
| 77 | An alist of the form | ||
| 72 | 78 | ||
| 73 | ((COMMAND1 SUBCOMMAND1 SUBCOMMAND2...) | 79 | ((COMMAND1 SUBCOMMAND1 SUBCOMMAND2...) |
| 74 | (COMMAND2 SUBCOMMAND1 ...)) | 80 | (COMMAND2 SUBCOMMAND1 ...)) |
| @@ -78,7 +84,9 @@ visual fashion. A likely entry is | |||
| 78 | 84 | ||
| 79 | (\"git\" \"log\" \"diff\" \"show\") | 85 | (\"git\" \"log\" \"diff\" \"show\") |
| 80 | 86 | ||
| 81 | because git shows logs and diffs using a pager by default." | 87 | because git shows logs and diffs using a pager by default. |
| 88 | |||
| 89 | See also `eshell-visual-commands' and `eshell-visual-options'." | ||
| 82 | :type '(repeat (cons (string :tag "Command") | 90 | :type '(repeat (cons (string :tag "Command") |
| 83 | (repeat (string :tag "Subcommand")))) | 91 | (repeat (string :tag "Subcommand")))) |
| 84 | :version "24.4" | 92 | :version "24.4" |
| @@ -97,7 +105,9 @@ fashion. For example, a sensible entry would be | |||
| 97 | (\"git\" \"--help\") | 105 | (\"git\" \"--help\") |
| 98 | 106 | ||
| 99 | because \"git <command> --help\" shows the command's | 107 | because \"git <command> --help\" shows the command's |
| 100 | documentation with a pager." | 108 | documentation with a pager. |
| 109 | |||
| 110 | See also `eshell-visual-commands' and `eshell-visual-subcommands'." | ||
| 101 | :type '(repeat (cons (string :tag "Command") | 111 | :type '(repeat (cons (string :tag "Command") |
| 102 | (repeat (string :tag "Option")))) | 112 | (repeat (string :tag "Option")))) |
| 103 | :version "24.4" | 113 | :version "24.4" |
diff --git a/lisp/finder.el b/lisp/finder.el index 3d988b41bde..f6593c554eb 100644 --- a/lisp/finder.el +++ b/lisp/finder.el | |||
| @@ -206,7 +206,8 @@ from; the default is `load-path'." | |||
| 206 | (setq version (ignore-errors (version-to-list version))) | 206 | (setq version (ignore-errors (version-to-list version))) |
| 207 | (setq entry (assq package package--builtins)) | 207 | (setq entry (assq package package--builtins)) |
| 208 | (cond ((null entry) | 208 | (cond ((null entry) |
| 209 | (push (cons package (vector version nil summary)) | 209 | (push (cons package |
| 210 | (package-make-builtin version summary)) | ||
| 210 | package--builtins)) | 211 | package--builtins)) |
| 211 | ((eq base-name package) | 212 | ((eq base-name package) |
| 212 | (setq desc (cdr entry)) | 213 | (setq desc (cdr entry)) |
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 35f9f47936d..ac5cdfafca2 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog | |||
| @@ -1,3 +1,76 @@ | |||
| 1 | 2013-06-11 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 2 | |||
| 3 | * eww.el (eww-convert-widgets): Make widgets from non-tabular layouts | ||
| 4 | work, too. | ||
| 5 | (eww-tag-select): Implement <select>. | ||
| 6 | |||
| 7 | 2013-06-10 Albert Krewinkel <krewinkel@moltkeplatz.de> | ||
| 8 | |||
| 9 | * sieve-manage.el (sieve-manage-open): work with STARTTLS: shorten | ||
| 10 | stream managing functions by using open-protocol-stream to do most of | ||
| 11 | the work. Has the nice benefit of enabling STARTTLS. | ||
| 12 | Wait for capabilities after STARTTLS: following RFC5804, the server | ||
| 13 | sends new capabilities after successfully establishing a TLS connection | ||
| 14 | with the client. The client should update the cached list of | ||
| 15 | capabilities, but we just ignore the answer for now. | ||
| 16 | (sieve-manage-network-p, sieve-manage-network-open) | ||
| 17 | (sieve-manage-starttls-p, sieve-manage-starttls-open) | ||
| 18 | (sieve-manage-forward, sieve-manage-streams) | ||
| 19 | (sieve-manage-stream-alist): Remove unneeded functions neither in the | ||
| 20 | API, nor called by any other function. | ||
| 21 | Enable Multibyte for SieveManage buffers: The parser won't properly | ||
| 22 | handle umlauts and line endings unless multibyte is turned on in the | ||
| 23 | process buffer. | ||
| 24 | |||
| 25 | 2013-06-11 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 26 | |||
| 27 | * eww.el (eww-tag-input): Support password fields. | ||
| 28 | (eww-submit): Support POST. | ||
| 29 | |||
| 30 | 2013-06-10 Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 31 | |||
| 32 | * eww.el (eww-tag-form): Protect against degenerate forms. | ||
| 33 | |||
| 34 | * shr.el (shr-expand-url): Expand URLs that start with a slash | ||
| 35 | correctly. | ||
| 36 | |||
| 37 | * eww.el (eww-submit): Get submit button logic right. | ||
| 38 | |||
| 39 | * shr.el (shr-final-table-render): New variable to signal when we're | ||
| 40 | doing the final table rendering so that we can collect more data at | ||
| 41 | that point. | ||
| 42 | |||
| 43 | * eww.el (eww-submit): Make form submission work. | ||
| 44 | (eww-tag-input): Implement submit buttons. | ||
| 45 | (eww-click-radio): Implement radio and checkboxes. | ||
| 46 | (eww-submit): Handle hidden elements. | ||
| 47 | |||
| 48 | * shr.el (shr-descend): Allow other packages to override (or provide) | ||
| 49 | rendering of elements. | ||
| 50 | (shr-expand-url): Strip query strings from URLs before expanding them. | ||
| 51 | |||
| 52 | * eww.el: Don't require cl-lib. | ||
| 53 | (eww-tag-form): Start form support. | ||
| 54 | |||
| 55 | * eww.el: Start writing a new, tiny web browser. | ||
| 56 | (eww-previous-url): New command. | ||
| 57 | (eww-quit): New command. | ||
| 58 | |||
| 59 | 2013-06-10 Albert Krewinkel <krewinkel@moltkeplatz.de> | ||
| 60 | |||
| 61 | * sieve.el: Put point at beginning of buffer when viewing a script. | ||
| 62 | (sieve-open-server): respect the PORT parameter. Show the correct port | ||
| 63 | number in sieve-buffer's header. Fixed code to also work with a string | ||
| 64 | as port specifier. Properly close the connection on pressing 'q'. Make | ||
| 65 | sieve-manage-quit close the connection and process buffer. Also, remove | ||
| 66 | duplicate keybinding for 'q'. | ||
| 67 | |||
| 68 | 2013-06-10 Roy Hashimoto <roy.hashimoto@gmail.com> (tiny change) | ||
| 69 | |||
| 70 | * mm-view.el (mm-pkcs7-signed-magic): Allow newline in the regexp and | ||
| 71 | make it easier to read. | ||
| 72 | (mm-pkcs7-enveloped-magic): Ditto. | ||
| 73 | |||
| 1 | 2013-06-06 Teodor Zlatanov <tzz@lifelogs.com> | 74 | 2013-06-06 Teodor Zlatanov <tzz@lifelogs.com> |
| 2 | 75 | ||
| 3 | * gnus-ems.el (gnus-image-type-available-p): Test `display-images-p' | 76 | * gnus-ems.el (gnus-image-type-available-p): Test `display-images-p' |
diff --git a/lisp/gnus/eww.el b/lisp/gnus/eww.el new file mode 100644 index 00000000000..3e799732ecb --- /dev/null +++ b/lisp/gnus/eww.el | |||
| @@ -0,0 +1,349 @@ | |||
| 1 | ;;; eww.el --- Emacs Web Wowser | ||
| 2 | |||
| 3 | ;; Copyright (C) 2013 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> | ||
| 6 | ;; Keywords: html | ||
| 7 | |||
| 8 | ;; This file is part of GNU Emacs. | ||
| 9 | |||
| 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 11 | ;; it under the terms of the GNU General Public License as published by | ||
| 12 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 13 | ;; (at your option) any later version. | ||
| 14 | |||
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 18 | ;; GNU General Public License for more details. | ||
| 19 | |||
| 20 | ;; You should have received a copy of the GNU General Public License | ||
| 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 22 | |||
| 23 | ;;; Commentary: | ||
| 24 | |||
| 25 | ;;; Code: | ||
| 26 | |||
| 27 | (eval-when-compile (require 'cl)) | ||
| 28 | (require 'shr) | ||
| 29 | (require 'url) | ||
| 30 | (require 'mm-url) | ||
| 31 | |||
| 32 | (defvar eww-current-url nil) | ||
| 33 | (defvar eww-history nil) | ||
| 34 | |||
| 35 | ;;;###autoload | ||
| 36 | (defun eww (url) | ||
| 37 | "Fetch URL and render the page." | ||
| 38 | (interactive "sUrl: ") | ||
| 39 | (url-retrieve url 'eww-render (list url))) | ||
| 40 | |||
| 41 | (defun eww-render (status url &optional point) | ||
| 42 | (let* ((headers (eww-parse-headers)) | ||
| 43 | (content-type | ||
| 44 | (mail-header-parse-content-type | ||
| 45 | (or (cdr (assoc "content-type" headers)) | ||
| 46 | "text/plain"))) | ||
| 47 | (charset (intern | ||
| 48 | (downcase | ||
| 49 | (or (cdr (assq 'charset (cdr content-type))) | ||
| 50 | "utf8")))) | ||
| 51 | (data-buffer (current-buffer))) | ||
| 52 | (unwind-protect | ||
| 53 | (progn | ||
| 54 | (cond | ||
| 55 | ((equal (car content-type) "text/html") | ||
| 56 | (eww-display-html charset url)) | ||
| 57 | ((string-match "^image/" (car content-type)) | ||
| 58 | (eww-display-image)) | ||
| 59 | (t | ||
| 60 | (eww-display-raw charset))) | ||
| 61 | (when point | ||
| 62 | (goto-char point))) | ||
| 63 | (kill-buffer data-buffer)))) | ||
| 64 | |||
| 65 | (defun eww-parse-headers () | ||
| 66 | (let ((headers nil)) | ||
| 67 | (while (and (not (eobp)) | ||
| 68 | (not (eolp))) | ||
| 69 | (when (looking-at "\\([^:]+\\): *\\(.*\\)") | ||
| 70 | (push (cons (downcase (match-string 1)) | ||
| 71 | (match-string 2)) | ||
| 72 | headers)) | ||
| 73 | (forward-line 1)) | ||
| 74 | (unless (eobp) | ||
| 75 | (forward-line 1)) | ||
| 76 | headers)) | ||
| 77 | |||
| 78 | (defun eww-display-html (charset url) | ||
| 79 | (unless (eq charset 'utf8) | ||
| 80 | (decode-coding-region (point) (point-max) charset)) | ||
| 81 | (let ((document | ||
| 82 | (list | ||
| 83 | 'base (list (cons 'href url)) | ||
| 84 | (libxml-parse-html-region (point) (point-max))))) | ||
| 85 | (eww-setup-buffer) | ||
| 86 | (setq eww-current-url url) | ||
| 87 | (let ((inhibit-read-only t) | ||
| 88 | (shr-external-rendering-functions | ||
| 89 | '((form . eww-tag-form) | ||
| 90 | (input . eww-tag-input) | ||
| 91 | (select . eww-tag-select)))) | ||
| 92 | (shr-insert-document document) | ||
| 93 | (eww-convert-widgets)) | ||
| 94 | (goto-char (point-min)))) | ||
| 95 | |||
| 96 | (defun eww-display-raw (charset) | ||
| 97 | (let ((data (buffer-substring (point) (point-max)))) | ||
| 98 | (eww-setup-buffer) | ||
| 99 | (let ((inhibit-read-only t)) | ||
| 100 | (insert data)) | ||
| 101 | (goto-char (point-min)))) | ||
| 102 | |||
| 103 | (defun eww-display-image () | ||
| 104 | (let ((data (buffer-substring (point) (point-max)))) | ||
| 105 | (eww-setup-buffer) | ||
| 106 | (let ((inhibit-read-only t)) | ||
| 107 | (shr-put-image data nil)) | ||
| 108 | (goto-char (point-min)))) | ||
| 109 | |||
| 110 | (defun eww-setup-buffer () | ||
| 111 | (pop-to-buffer (get-buffer-create "*eww*")) | ||
| 112 | (remove-overlays) | ||
| 113 | (setq widget-field-list nil) | ||
| 114 | (let ((inhibit-read-only t)) | ||
| 115 | (erase-buffer)) | ||
| 116 | (eww-mode)) | ||
| 117 | |||
| 118 | (defvar eww-mode-map | ||
| 119 | (let ((map (make-sparse-keymap))) | ||
| 120 | (suppress-keymap map) | ||
| 121 | (define-key map "q" 'eww-quit) | ||
| 122 | (define-key map "g" 'eww-reload) | ||
| 123 | (define-key map [tab] 'widget-forward) | ||
| 124 | (define-key map [backtab] 'widget-backward) | ||
| 125 | (define-key map [delete] 'scroll-down-command) | ||
| 126 | (define-key map "\177" 'scroll-down-command) | ||
| 127 | (define-key map " " 'scroll-up-command) | ||
| 128 | (define-key map "p" 'eww-previous-url) | ||
| 129 | ;;(define-key map "n" 'eww-next-url) | ||
| 130 | map)) | ||
| 131 | |||
| 132 | (defun eww-mode () | ||
| 133 | "Mode for browsing the web. | ||
| 134 | |||
| 135 | \\{eww-mode-map}" | ||
| 136 | (interactive) | ||
| 137 | (setq major-mode 'eww-mode | ||
| 138 | mode-name "eww") | ||
| 139 | (set (make-local-variable 'eww-current-url) 'author) | ||
| 140 | (set (make-local-variable 'browse-url-browser-function) 'eww-browse-url) | ||
| 141 | ;;(setq buffer-read-only t) | ||
| 142 | (use-local-map eww-mode-map)) | ||
| 143 | |||
| 144 | (defun eww-browse-url (url &optional new-window) | ||
| 145 | (push (list eww-current-url (point)) | ||
| 146 | eww-history) | ||
| 147 | (eww url)) | ||
| 148 | |||
| 149 | (defun eww-quit () | ||
| 150 | "Exit the Emacs Web Wowser." | ||
| 151 | (interactive) | ||
| 152 | (setq eww-history nil) | ||
| 153 | (kill-buffer (current-buffer))) | ||
| 154 | |||
| 155 | (defun eww-previous-url () | ||
| 156 | "Go to the previously displayed page." | ||
| 157 | (interactive) | ||
| 158 | (when (zerop (length eww-history)) | ||
| 159 | (error "No previous page")) | ||
| 160 | (let ((prev (pop eww-history))) | ||
| 161 | (url-retrieve (car prev) 'eww-render (list (car prev) (cadr prev))))) | ||
| 162 | |||
| 163 | (defun eww-reload () | ||
| 164 | "Reload the current page." | ||
| 165 | (interactive) | ||
| 166 | (url-retrieve eww-current-url 'eww-render | ||
| 167 | (list eww-current-url (point)))) | ||
| 168 | |||
| 169 | ;; Form support. | ||
| 170 | |||
| 171 | (defvar eww-form nil) | ||
| 172 | |||
| 173 | (defun eww-tag-form (cont) | ||
| 174 | (let ((eww-form | ||
| 175 | (list (assq :method cont) | ||
| 176 | (assq :action cont))) | ||
| 177 | (start (point))) | ||
| 178 | (shr-ensure-paragraph) | ||
| 179 | (shr-generic cont) | ||
| 180 | (shr-ensure-paragraph) | ||
| 181 | (when (> (point) start) | ||
| 182 | (put-text-property start (1+ start) | ||
| 183 | 'eww-form eww-form)))) | ||
| 184 | |||
| 185 | (defun eww-tag-input (cont) | ||
| 186 | (let* ((start (point)) | ||
| 187 | (type (downcase (or (cdr (assq :type cont)) | ||
| 188 | "text"))) | ||
| 189 | (widget | ||
| 190 | (cond | ||
| 191 | ((equal type "submit") | ||
| 192 | (list | ||
| 193 | 'push-button | ||
| 194 | :notify 'eww-submit | ||
| 195 | :name (cdr (assq :name cont)) | ||
| 196 | :eww-form eww-form | ||
| 197 | (or (cdr (assq :value cont)) "Submit"))) | ||
| 198 | ((or (equal type "radio") | ||
| 199 | (equal type "checkbox")) | ||
| 200 | (list 'checkbox | ||
| 201 | :notify 'eww-click-radio | ||
| 202 | :name (cdr (assq :name cont)) | ||
| 203 | :checkbox-value (cdr (assq :value cont)) | ||
| 204 | :checkbox-type type | ||
| 205 | :eww-form eww-form | ||
| 206 | (cdr (assq :checked cont)))) | ||
| 207 | ((equal type "hidden") | ||
| 208 | (list 'hidden | ||
| 209 | :name (cdr (assq :name cont)) | ||
| 210 | :value (cdr (assq :value cont)))) | ||
| 211 | (t | ||
| 212 | (list | ||
| 213 | 'editable-field | ||
| 214 | :size (string-to-number | ||
| 215 | (or (cdr (assq :size cont)) | ||
| 216 | "40")) | ||
| 217 | :value (or (cdr (assq :value cont)) "") | ||
| 218 | :secret (and (equal type "password") ?*) | ||
| 219 | :action 'eww-submit | ||
| 220 | :name (cdr (assq :name cont)) | ||
| 221 | :eww-form eww-form))))) | ||
| 222 | (if (eq (car widget) 'hidden) | ||
| 223 | (when shr-final-table-render | ||
| 224 | (nconc eww-form (list widget))) | ||
| 225 | (apply 'widget-create widget)) | ||
| 226 | (put-text-property start (point) 'eww-widget widget) | ||
| 227 | (insert " "))) | ||
| 228 | |||
| 229 | (defun eww-tag-select (cont) | ||
| 230 | (shr-ensure-paragraph) | ||
| 231 | (let ((menu (list 'menu-choice | ||
| 232 | :name (cdr (assq :name cont)) | ||
| 233 | :eww-form eww-form)) | ||
| 234 | (options nil) | ||
| 235 | (start (point))) | ||
| 236 | (dolist (elem cont) | ||
| 237 | (when (eq (car elem) 'option) | ||
| 238 | (when (cdr (assq :selected (cdr elem))) | ||
| 239 | (nconc menu (list :value | ||
| 240 | (cdr (assq :value (cdr elem)))))) | ||
| 241 | (push (list 'item | ||
| 242 | :value (cdr (assq :value (cdr elem))) | ||
| 243 | :tag (cdr (assq 'text (cdr elem)))) | ||
| 244 | options))) | ||
| 245 | (nconc menu options) | ||
| 246 | (apply 'widget-create menu) | ||
| 247 | (put-text-property start (point) 'eww-widget menu) | ||
| 248 | (shr-ensure-paragraph))) | ||
| 249 | |||
| 250 | (defun eww-click-radio (widget &rest ignore) | ||
| 251 | (let ((form (plist-get (cdr widget) :eww-form)) | ||
| 252 | (name (plist-get (cdr widget) :name))) | ||
| 253 | (when (equal (plist-get (cdr widget) :type) "radio") | ||
| 254 | (if (widget-value widget) | ||
| 255 | ;; Switch all the other radio buttons off. | ||
| 256 | (dolist (overlay (overlays-in (point-min) (point-max))) | ||
| 257 | (let ((field (plist-get (overlay-properties overlay) 'button))) | ||
| 258 | (when (and (eq (plist-get (cdr field) :eww-form) form) | ||
| 259 | (equal name (plist-get (cdr field) :name))) | ||
| 260 | (unless (eq field widget) | ||
| 261 | (widget-value-set field nil))))) | ||
| 262 | (widget-value-set widget t))) | ||
| 263 | (eww-fix-widget-keymap))) | ||
| 264 | |||
| 265 | (defun eww-submit (widget &rest ignore) | ||
| 266 | (let ((form (plist-get (cdr widget) :eww-form)) | ||
| 267 | (first-button t) | ||
| 268 | values) | ||
| 269 | (dolist (overlay (sort (overlays-in (point-min) (point-max)) | ||
| 270 | (lambda (o1 o2) | ||
| 271 | (< (overlay-start o1) (overlay-start o2))))) | ||
| 272 | (let ((field (or (plist-get (overlay-properties overlay) 'field) | ||
| 273 | (plist-get (overlay-properties overlay) 'button) | ||
| 274 | (plist-get (overlay-properties overlay) 'eww-hidden)))) | ||
| 275 | (when (eq (plist-get (cdr field) :eww-form) form) | ||
| 276 | (let ((name (plist-get (cdr field) :name))) | ||
| 277 | (when name | ||
| 278 | (cond | ||
| 279 | ((eq (car field) 'checkbox) | ||
| 280 | (when (widget-value field) | ||
| 281 | (push (cons name (plist-get (cdr field) :checkbox-value)) | ||
| 282 | values))) | ||
| 283 | ((eq (car field) 'eww-hidden) | ||
| 284 | (push (cons name (plist-get (cdr field) :value)) | ||
| 285 | values)) | ||
| 286 | ((eq (car field) 'push-button) | ||
| 287 | ;; We want the values from buttons if we hit a button, | ||
| 288 | ;; or we're submitting something and this is the first | ||
| 289 | ;; button displayed. | ||
| 290 | (when (or (and (eq (car widget) 'push-button) | ||
| 291 | (eq widget field)) | ||
| 292 | (and (not (eq (car widget) 'push-button)) | ||
| 293 | (eq (car field) 'push-button) | ||
| 294 | first-button)) | ||
| 295 | (setq first-button nil) | ||
| 296 | (push (cons name (widget-value field)) | ||
| 297 | values))) | ||
| 298 | (t | ||
| 299 | (push (cons name (widget-value field)) | ||
| 300 | values)))))))) | ||
| 301 | (dolist (elem form) | ||
| 302 | (when (and (consp elem) | ||
| 303 | (eq (car elem) 'hidden)) | ||
| 304 | (push (cons (plist-get (cdr elem) :name) | ||
| 305 | (plist-get (cdr elem) :value)) | ||
| 306 | values))) | ||
| 307 | (let ((shr-base eww-current-url)) | ||
| 308 | (if (and (stringp (cdr (assq :method form))) | ||
| 309 | (equal (downcase (cdr (assq :method form))) "post")) | ||
| 310 | (let ((url-request-method "POST") | ||
| 311 | (url-request-extra-headers | ||
| 312 | '(("Content-Type" . "application/x-www-form-urlencoded"))) | ||
| 313 | (url-request-data (mm-url-encode-www-form-urlencoded values))) | ||
| 314 | (eww-browse-url (shr-expand-url (cdr (assq :action form))))) | ||
| 315 | (eww-browse-url | ||
| 316 | (shr-expand-url | ||
| 317 | (concat | ||
| 318 | (cdr (assq :action form)) | ||
| 319 | "?" | ||
| 320 | (mm-url-encode-www-form-urlencoded values)))))))) | ||
| 321 | |||
| 322 | (defun eww-convert-widgets () | ||
| 323 | (let ((start (point-min)) | ||
| 324 | widget) | ||
| 325 | ;; Some widgets come from different buffers (rendered for tables), | ||
| 326 | ;; so we need to nix out the list of widgets and recreate them. | ||
| 327 | (setq widget-field-list nil | ||
| 328 | widget-field-new nil) | ||
| 329 | (while (setq start (next-single-property-change start 'eww-widget)) | ||
| 330 | (setq widget (get-text-property start 'eww-widget)) | ||
| 331 | (goto-char start) | ||
| 332 | (let ((end (next-single-property-change start 'eww-widget))) | ||
| 333 | (dolist (overlay (overlays-in start end)) | ||
| 334 | (when (or (plist-get (overlay-properties overlay) 'button) | ||
| 335 | (plist-get (overlay-properties overlay) 'field)) | ||
| 336 | (delete-overlay overlay))) | ||
| 337 | (delete-region start end)) | ||
| 338 | (apply 'widget-create widget)) | ||
| 339 | (widget-setup) | ||
| 340 | (eww-fix-widget-keymap))) | ||
| 341 | |||
| 342 | (defun eww-fix-widget-keymap () | ||
| 343 | (dolist (overlay (overlays-in (point-min) (point-max))) | ||
| 344 | (when (plist-get (overlay-properties overlay) 'button) | ||
| 345 | (overlay-put overlay 'local-map widget-keymap)))) | ||
| 346 | |||
| 347 | (provide 'eww) | ||
| 348 | |||
| 349 | ;;; eww.el ends here | ||
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index ac6170a3cdf..b1cba27c335 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el | |||
| @@ -660,14 +660,26 @@ If MODE is not set, try to find mode automatically." | |||
| 660 | ;; id-signedData OBJECT IDENTIFIER ::= { iso(1) member-body(2) | 660 | ;; id-signedData OBJECT IDENTIFIER ::= { iso(1) member-body(2) |
| 661 | ;; us(840) rsadsi(113549) pkcs(1) pkcs7(7) 2 } | 661 | ;; us(840) rsadsi(113549) pkcs(1) pkcs7(7) 2 } |
| 662 | (defvar mm-pkcs7-signed-magic | 662 | (defvar mm-pkcs7-signed-magic |
| 663 | "\x30\x5c\x28\x80\x5c\x7c\x81\x2e\x5c\x7c\x82\x2e\x2e\x5c\x7c\x83\x2e\x2e\ | 663 | (concat |
| 664 | \x2e\x5c\x29\x06\x09\x5c\x2a\x86\x48\x86\xf7\x0d\x01\x07\x02") | 664 | "0" |
| 665 | "\\(\\(\x80\\)" | ||
| 666 | "\\|\\(\x81\\(.\\|\n\\)\\{1\\}\\)" | ||
| 667 | "\\|\\(\x82\\(.\\|\n\\)\\{2\\}\\)" | ||
| 668 | "\\|\\(\x83\\(.\\|\n\\)\\{3\\}\\)" | ||
| 669 | "\\)" | ||
| 670 | "\x06\x09\\*\x86H\x86\xf7\x0d\x01\x07\x02")) | ||
| 665 | 671 | ||
| 666 | ;; id-envelopedData OBJECT IDENTIFIER ::= { iso(1) member-body(2) | 672 | ;; id-envelopedData OBJECT IDENTIFIER ::= { iso(1) member-body(2) |
| 667 | ;; us(840) rsadsi(113549) pkcs(1) pkcs7(7) 3 } | 673 | ;; us(840) rsadsi(113549) pkcs(1) pkcs7(7) 3 } |
| 668 | (defvar mm-pkcs7-enveloped-magic | 674 | (defvar mm-pkcs7-enveloped-magic |
| 669 | "\x30\x5c\x28\x80\x5c\x7c\x81\x2e\x5c\x7c\x82\x2e\x2e\x5c\x7c\x83\x2e\x2e\ | 675 | (concat |
| 670 | \x2e\x5c\x29\x06\x09\x5c\x2a\x86\x48\x86\xf7\x0d\x01\x07\x03") | 676 | "0" |
| 677 | "\\(\\(\x80\\)" | ||
| 678 | "\\|\\(\x81\\(.\\|\n\\)\\{1\\}\\)" | ||
| 679 | "\\|\\(\x82\\(.\\|\n\\)\\{2\\}\\)" | ||
| 680 | "\\|\\(\x83\\(.\\|\n\\)\\{3\\}\\)" | ||
| 681 | "\\)" | ||
| 682 | "\x06\x09\\*\x86H\x86\xf7\x0d\x01\x07\x03")) | ||
| 671 | 683 | ||
| 672 | (defun mm-view-pkcs7-get-type (handle) | 684 | (defun mm-view-pkcs7-get-type (handle) |
| 673 | (mm-with-unibyte-buffer | 685 | (mm-with-unibyte-buffer |
diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el index 9284da4c4b3..d9e267e5288 100644 --- a/lisp/gnus/shr.el +++ b/lisp/gnus/shr.el | |||
| @@ -114,6 +114,8 @@ cid: URL as the argument.") | |||
| 114 | (defvar shr-stylesheet nil) | 114 | (defvar shr-stylesheet nil) |
| 115 | (defvar shr-base nil) | 115 | (defvar shr-base nil) |
| 116 | (defvar shr-ignore-cache nil) | 116 | (defvar shr-ignore-cache nil) |
| 117 | (defvar shr-external-rendering-functions nil) | ||
| 118 | (defvar shr-final-table-render nil) | ||
| 117 | 119 | ||
| 118 | (defvar shr-map | 120 | (defvar shr-map |
| 119 | (let ((map (make-sparse-keymap))) | 121 | (let ((map (make-sparse-keymap))) |
| @@ -291,7 +293,12 @@ size, and full-buffer size." | |||
| 291 | (nreverse result))) | 293 | (nreverse result))) |
| 292 | 294 | ||
| 293 | (defun shr-descend (dom) | 295 | (defun shr-descend (dom) |
| 294 | (let ((function (intern (concat "shr-tag-" (symbol-name (car dom))) obarray)) | 296 | (let ((function |
| 297 | (or | ||
| 298 | ;; Allow other packages to override (or provide) rendering | ||
| 299 | ;; of elements. | ||
| 300 | (cdr (assq (car dom) shr-external-rendering-functions)) | ||
| 301 | (intern (concat "shr-tag-" (symbol-name (car dom))) obarray))) | ||
| 295 | (style (cdr (assq :style (cdr dom)))) | 302 | (style (cdr (assq :style (cdr dom)))) |
| 296 | (shr-stylesheet shr-stylesheet) | 303 | (shr-stylesheet shr-stylesheet) |
| 297 | (start (point))) | 304 | (start (point))) |
| @@ -478,20 +485,27 @@ size, and full-buffer size." | |||
| 478 | (not failed))) | 485 | (not failed))) |
| 479 | 486 | ||
| 480 | (defun shr-expand-url (url) | 487 | (defun shr-expand-url (url) |
| 481 | (cond | 488 | (if (or (not url) |
| 482 | ;; Absolute URL. | 489 | (string-match "\\`[a-z]*:" url) |
| 483 | ((or (not url) | 490 | (not shr-base)) |
| 484 | (string-match "\\`[a-z]*:" url) | 491 | ;; Absolute URL. |
| 485 | (not shr-base)) | 492 | url |
| 486 | url) | 493 | (let ((base shr-base)) |
| 487 | ((and (string-match "\\`//" url) | 494 | ;; Chop off query string. |
| 488 | (string-match "\\`[a-z]*:" shr-base)) | 495 | (when (string-match "^\\([^?]+\\)[?]" base) |
| 489 | (concat (match-string 0 shr-base) url)) | 496 | (setq base (match-string 1 base))) |
| 490 | ((and (not (string-match "/\\'" shr-base)) | 497 | (cond |
| 491 | (not (string-match "\\`/" url))) | 498 | ((and (string-match "\\`//" url) |
| 492 | (concat shr-base "/" url)) | 499 | (string-match "\\`[a-z]*:" base)) |
| 493 | (t | 500 | (concat (match-string 0 base) url)) |
| 494 | (concat shr-base url)))) | 501 | ((and (not (string-match "/\\'" base)) |
| 502 | (not (string-match "\\`/" url))) | ||
| 503 | (concat base "/" url)) | ||
| 504 | ((and (string-match "\\`/" url) | ||
| 505 | (string-match "\\(\\`[^:]*://[^/]+\\)/" base)) | ||
| 506 | (concat (match-string 1 base) url)) | ||
| 507 | (t | ||
| 508 | (concat base url)))))) | ||
| 495 | 509 | ||
| 496 | (defun shr-ensure-newline () | 510 | (defun shr-ensure-newline () |
| 497 | (unless (zerop (current-column)) | 511 | (unless (zerop (current-column)) |
| @@ -945,7 +959,8 @@ ones, in case fg and bg are nil." | |||
| 945 | plist))) | 959 | plist))) |
| 946 | 960 | ||
| 947 | (defun shr-tag-base (cont) | 961 | (defun shr-tag-base (cont) |
| 948 | (setq shr-base (cdr (assq :href cont)))) | 962 | (setq shr-base (cdr (assq :href cont))) |
| 963 | (shr-generic cont)) | ||
| 949 | 964 | ||
| 950 | (defun shr-tag-a (cont) | 965 | (defun shr-tag-a (cont) |
| 951 | (let ((url (cdr (assq :href cont))) | 966 | (let ((url (cdr (assq :href cont))) |
| @@ -1167,7 +1182,8 @@ ones, in case fg and bg are nil." | |||
| 1167 | (frame-width)) | 1182 | (frame-width)) |
| 1168 | (setq truncate-lines t)) | 1183 | (setq truncate-lines t)) |
| 1169 | ;; Then render the table again with these new "hard" widths. | 1184 | ;; Then render the table again with these new "hard" widths. |
| 1170 | (shr-insert-table (shr-make-table cont sketch-widths t) sketch-widths)) | 1185 | (let ((shr-final-table-render t)) |
| 1186 | (shr-insert-table (shr-make-table cont sketch-widths t) sketch-widths))) | ||
| 1171 | ;; Finally, insert all the images after the table. The Emacs buffer | 1187 | ;; Finally, insert all the images after the table. The Emacs buffer |
| 1172 | ;; model isn't strong enough to allow us to put the images actually | 1188 | ;; model isn't strong enough to allow us to put the images actually |
| 1173 | ;; into the tables. | 1189 | ;; into the tables. |
diff --git a/lisp/gnus/sieve-manage.el b/lisp/gnus/sieve-manage.el index b96261764e5..23ab24152d9 100644 --- a/lisp/gnus/sieve-manage.el +++ b/lisp/gnus/sieve-manage.el | |||
| @@ -3,6 +3,7 @@ | |||
| 3 | ;; Copyright (C) 2001-2013 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2001-2013 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | ;; Author: Simon Josefsson <simon@josefsson.org> | 5 | ;; Author: Simon Josefsson <simon@josefsson.org> |
| 6 | ;; Albert Krewinkel <tarleb@moltkeplatz.de> | ||
| 6 | 7 | ||
| 7 | ;; This file is part of GNU Emacs. | 8 | ;; This file is part of GNU Emacs. |
| 8 | 9 | ||
| @@ -66,6 +67,7 @@ | |||
| 66 | ;; 2001-10-31 Committed to Oort Gnus. | 67 | ;; 2001-10-31 Committed to Oort Gnus. |
| 67 | ;; 2002-07-27 Added DELETESCRIPT. Suggested by Ned Ludd. | 68 | ;; 2002-07-27 Added DELETESCRIPT. Suggested by Ned Ludd. |
| 68 | ;; 2002-08-03 Use SASL library. | 69 | ;; 2002-08-03 Use SASL library. |
| 70 | ;; 2013-06-05 Enabled STARTTLS support, fixed bit rot. | ||
| 69 | 71 | ||
| 70 | ;;; Code: | 72 | ;;; Code: |
| 71 | 73 | ||
| @@ -82,7 +84,6 @@ | |||
| 82 | (require 'sasl) | 84 | (require 'sasl) |
| 83 | (require 'starttls)) | 85 | (require 'starttls)) |
| 84 | (autoload 'sasl-find-mechanism "sasl") | 86 | (autoload 'sasl-find-mechanism "sasl") |
| 85 | (autoload 'starttls-open-stream "starttls") | ||
| 86 | (autoload 'auth-source-search "auth-source") | 87 | (autoload 'auth-source-search "auth-source") |
| 87 | 88 | ||
| 88 | ;; User customizable variables: | 89 | ;; User customizable variables: |
| @@ -107,23 +108,6 @@ | |||
| 107 | :type 'string | 108 | :type 'string |
| 108 | :group 'sieve-manage) | 109 | :group 'sieve-manage) |
| 109 | 110 | ||
| 110 | (defcustom sieve-manage-streams '(network starttls shell) | ||
| 111 | "Priority of streams to consider when opening connection to server." | ||
| 112 | :group 'sieve-manage) | ||
| 113 | |||
| 114 | (defcustom sieve-manage-stream-alist | ||
| 115 | '((network sieve-manage-network-p sieve-manage-network-open) | ||
| 116 | (shell sieve-manage-shell-p sieve-manage-shell-open) | ||
| 117 | (starttls sieve-manage-starttls-p sieve-manage-starttls-open)) | ||
| 118 | "Definition of network streams. | ||
| 119 | |||
| 120 | \(NAME CHECK OPEN) | ||
| 121 | |||
| 122 | NAME names the stream, CHECK is a function returning non-nil if the | ||
| 123 | server support the stream and OPEN is a function for opening the | ||
| 124 | stream." | ||
| 125 | :group 'sieve-manage) | ||
| 126 | |||
| 127 | (defcustom sieve-manage-authenticators '(digest-md5 | 111 | (defcustom sieve-manage-authenticators '(digest-md5 |
| 128 | cram-md5 | 112 | cram-md5 |
| 129 | scram-md5 | 113 | scram-md5 |
| @@ -156,8 +140,7 @@ for doing the actual authentication." | |||
| 156 | :group 'sieve-manage) | 140 | :group 'sieve-manage) |
| 157 | 141 | ||
| 158 | (defcustom sieve-manage-default-stream 'network | 142 | (defcustom sieve-manage-default-stream 'network |
| 159 | "Default stream type to use for `sieve-manage'. | 143 | "Default stream type to use for `sieve-manage'." |
| 160 | Must be a name of a stream in `sieve-manage-stream-alist'." | ||
| 161 | :version "24.1" | 144 | :version "24.1" |
| 162 | :type 'symbol | 145 | :type 'symbol |
| 163 | :group 'sieve-manage) | 146 | :group 'sieve-manage) |
| @@ -185,17 +168,21 @@ Valid states are `closed', `initial', `nonauth', and `auth'.") | |||
| 185 | (defvar sieve-manage-capability nil) | 168 | (defvar sieve-manage-capability nil) |
| 186 | 169 | ||
| 187 | ;; Internal utility functions | 170 | ;; Internal utility functions |
| 188 | 171 | (defun sieve-manage-make-process-buffer () | |
| 189 | (defmacro sieve-manage-disable-multibyte () | 172 | (with-current-buffer |
| 190 | "Enable multibyte in the current buffer." | 173 | (generate-new-buffer (format " *sieve %s:%s*" |
| 191 | (unless (featurep 'xemacs) | 174 | sieve-manage-server |
| 192 | '(set-buffer-multibyte nil))) | 175 | sieve-manage-port)) |
| 176 | (mapc 'make-local-variable sieve-manage-local-variables) | ||
| 177 | (mm-enable-multibyte) | ||
| 178 | (buffer-disable-undo) | ||
| 179 | (current-buffer))) | ||
| 193 | 180 | ||
| 194 | (defun sieve-manage-erase (&optional p buffer) | 181 | (defun sieve-manage-erase (&optional p buffer) |
| 195 | (let ((buffer (or buffer (current-buffer)))) | 182 | (let ((buffer (or buffer (current-buffer)))) |
| 196 | (and sieve-manage-log | 183 | (and sieve-manage-log |
| 197 | (with-current-buffer (get-buffer-create sieve-manage-log) | 184 | (with-current-buffer (get-buffer-create sieve-manage-log) |
| 198 | (sieve-manage-disable-multibyte) | 185 | (mm-enable-multibyte) |
| 199 | (buffer-disable-undo) | 186 | (buffer-disable-undo) |
| 200 | (goto-char (point-max)) | 187 | (goto-char (point-max)) |
| 201 | (insert-buffer-substring buffer (with-current-buffer buffer | 188 | (insert-buffer-substring buffer (with-current-buffer buffer |
| @@ -204,71 +191,32 @@ Valid states are `closed', `initial', `nonauth', and `auth'.") | |||
| 204 | (point-max))))))) | 191 | (point-max))))))) |
| 205 | (delete-region (point-min) (or p (point-max)))) | 192 | (delete-region (point-min) (or p (point-max)))) |
| 206 | 193 | ||
| 207 | (defun sieve-manage-open-1 (buffer) | 194 | (defun sieve-manage-open-server (server port &optional stream buffer) |
| 195 | "Open network connection to SERVER on PORT. | ||
| 196 | Return the buffer associated with the connection." | ||
| 208 | (with-current-buffer buffer | 197 | (with-current-buffer buffer |
| 209 | (sieve-manage-erase) | 198 | (sieve-manage-erase) |
| 210 | (setq sieve-manage-state 'initial | 199 | (setq sieve-manage-state 'initial) |
| 211 | sieve-manage-process | 200 | (destructuring-bind (proc . props) |
| 212 | (condition-case () | 201 | (open-protocol-stream |
| 213 | (funcall (nth 2 (assq sieve-manage-stream | 202 | "SIEVE" buffer server port |
| 214 | sieve-manage-stream-alist)) | 203 | :type stream |
| 215 | "sieve" buffer sieve-manage-server sieve-manage-port) | 204 | :capability-command "CAPABILITY\r\n" |
| 216 | ((error quit) nil))) | 205 | :end-of-command "^\\(OK\\|NO\\).*\n" |
| 217 | (when sieve-manage-process | 206 | :success "^OK.*\n" |
| 218 | (while (and (eq sieve-manage-state 'initial) | 207 | :return-list t |
| 219 | (memq (process-status sieve-manage-process) '(open run))) | 208 | :starttls-function |
| 220 | (message "Waiting for response from %s..." sieve-manage-server) | 209 | '(lambda (capabilities) |
| 221 | (accept-process-output sieve-manage-process 1)) | 210 | (when (string-match "\\bSTARTTLS\\b" capabilities) |
| 222 | (message "Waiting for response from %s...done" sieve-manage-server) | 211 | "STARTTLS\r\n"))) |
| 223 | (and (memq (process-status sieve-manage-process) '(open run)) | 212 | (setq sieve-manage-process proc) |
| 224 | sieve-manage-process)))) | 213 | (setq sieve-manage-capability |
| 225 | 214 | (sieve-manage-parse-capability (getf props :capabilities))) | |
| 226 | ;; Streams | 215 | ;; Ignore new capabilities issues after successful STARTTLS |
| 227 | 216 | (when (and (memq stream '(nil network starttls)) | |
| 228 | (defun sieve-manage-network-p (buffer) | 217 | (eq (getf props :type) 'tls)) |
| 229 | t) | 218 | (sieve-manage-drop-next-answer)) |
| 230 | 219 | (current-buffer)))) | |
| 231 | (defun sieve-manage-network-open (name buffer server port) | ||
| 232 | (let* ((port (or port sieve-manage-default-port)) | ||
| 233 | (coding-system-for-read sieve-manage-coding-system-for-read) | ||
| 234 | (coding-system-for-write sieve-manage-coding-system-for-write) | ||
| 235 | (process (open-network-stream name buffer server port))) | ||
| 236 | (when process | ||
| 237 | (while (and (memq (process-status process) '(open run)) | ||
| 238 | (set-buffer buffer) ;; XXX "blue moon" nntp.el bug | ||
| 239 | (goto-char (point-min)) | ||
| 240 | (not (sieve-manage-parse-greeting-1))) | ||
| 241 | (accept-process-output process 1) | ||
| 242 | (sit-for 1)) | ||
| 243 | (sieve-manage-erase nil buffer) | ||
| 244 | (when (memq (process-status process) '(open run)) | ||
| 245 | process)))) | ||
| 246 | |||
| 247 | (defun sieve-manage-starttls-p (buffer) | ||
| 248 | (condition-case () | ||
| 249 | (progn | ||
| 250 | (require 'starttls) | ||
| 251 | (call-process "starttls")) | ||
| 252 | (error nil))) | ||
| 253 | |||
| 254 | (defun sieve-manage-starttls-open (name buffer server port) | ||
| 255 | (let* ((port (or port sieve-manage-default-port)) | ||
| 256 | (coding-system-for-read sieve-manage-coding-system-for-read) | ||
| 257 | (coding-system-for-write sieve-manage-coding-system-for-write) | ||
| 258 | (process (starttls-open-stream name buffer server port)) | ||
| 259 | done) | ||
| 260 | (when process | ||
| 261 | (while (and (memq (process-status process) '(open run)) | ||
| 262 | (set-buffer buffer) ;; XXX "blue moon" nntp.el bug | ||
| 263 | (goto-char (point-min)) | ||
| 264 | (not (sieve-manage-parse-greeting-1))) | ||
| 265 | (accept-process-output process 1) | ||
| 266 | (sit-for 1)) | ||
| 267 | (sieve-manage-erase nil buffer) | ||
| 268 | (sieve-manage-send "STARTTLS") | ||
| 269 | (starttls-negotiate process)) | ||
| 270 | (when (memq (process-status process) '(open run)) | ||
| 271 | process))) | ||
| 272 | 220 | ||
| 273 | ;; Authenticators | 221 | ;; Authenticators |
| 274 | (defun sieve-sasl-auth (buffer mech) | 222 | (defun sieve-sasl-auth (buffer mech) |
| @@ -396,63 +344,33 @@ Optional argument AUTH indicates authenticator to use, see | |||
| 396 | If nil, chooses the best stream the server is capable of. | 344 | If nil, chooses the best stream the server is capable of. |
| 397 | Optional argument BUFFER is buffer (buffer, or string naming buffer) | 345 | Optional argument BUFFER is buffer (buffer, or string naming buffer) |
| 398 | to work in." | 346 | to work in." |
| 399 | (or port (setq port sieve-manage-default-port)) | 347 | (setq sieve-manage-port (or port sieve-manage-default-port)) |
| 400 | (setq buffer (or buffer (format " *sieve* %s:%s" server port))) | 348 | (with-current-buffer (or buffer (sieve-manage-make-process-buffer)) |
| 401 | (with-current-buffer (get-buffer-create buffer) | 349 | (setq sieve-manage-server (or server |
| 402 | (mapc 'make-local-variable sieve-manage-local-variables) | 350 | sieve-manage-server) |
| 403 | (sieve-manage-disable-multibyte) | 351 | sieve-manage-stream (or stream |
| 404 | (buffer-disable-undo) | 352 | sieve-manage-stream |
| 405 | (setq sieve-manage-server (or server sieve-manage-server)) | 353 | sieve-manage-default-stream) |
| 406 | (setq sieve-manage-port port) | 354 | sieve-manage-auth (or auth |
| 407 | (setq sieve-manage-stream (or stream sieve-manage-stream)) | 355 | sieve-manage-auth)) |
| 408 | (message "sieve: Connecting to %s..." sieve-manage-server) | 356 | (message "sieve: Connecting to %s..." sieve-manage-server) |
| 409 | (if (let ((sieve-manage-stream | 357 | (sieve-manage-open-server sieve-manage-server |
| 410 | (or sieve-manage-stream sieve-manage-default-stream))) | 358 | sieve-manage-port |
| 411 | (sieve-manage-open-1 buffer)) | 359 | sieve-manage-stream |
| 412 | ;; Choose stream. | 360 | (current-buffer)) |
| 413 | (let (stream-changed) | 361 | (when (sieve-manage-opened (current-buffer)) |
| 414 | (message "sieve: Connecting to %s...done" sieve-manage-server) | 362 | ;; Choose authenticator |
| 415 | (when (null sieve-manage-stream) | 363 | (when (and (null sieve-manage-auth) |
| 416 | (let ((streams sieve-manage-streams)) | 364 | (not (eq sieve-manage-state 'auth))) |
| 417 | (while (setq stream (pop streams)) | 365 | (dolist (auth sieve-manage-authenticators) |
| 418 | (if (funcall (nth 1 (assq stream | 366 | (when (funcall (nth 1 (assq auth sieve-manage-authenticator-alist)) |
| 419 | sieve-manage-stream-alist)) buffer) | 367 | buffer) |
| 420 | (setq stream-changed | 368 | (setq sieve-manage-auth auth) |
| 421 | (not (eq (or sieve-manage-stream | 369 | (return))) |
| 422 | sieve-manage-default-stream) | 370 | (unless sieve-manage-auth |
| 423 | stream)) | 371 | (error "Couldn't figure out authenticator for server"))) |
| 424 | sieve-manage-stream stream | ||
| 425 | streams nil))) | ||
| 426 | (unless sieve-manage-stream | ||
| 427 | (error "Couldn't figure out a stream for server")))) | ||
| 428 | (when stream-changed | ||
| 429 | (message "sieve: Reconnecting with stream `%s'..." | ||
| 430 | sieve-manage-stream) | ||
| 431 | (sieve-manage-close buffer) | ||
| 432 | (if (sieve-manage-open-1 buffer) | ||
| 433 | (message "sieve: Reconnecting with stream `%s'...done" | ||
| 434 | sieve-manage-stream) | ||
| 435 | (message "sieve: Reconnecting with stream `%s'...failed" | ||
| 436 | sieve-manage-stream)) | ||
| 437 | (setq sieve-manage-capability nil)) | ||
| 438 | (if (sieve-manage-opened buffer) | ||
| 439 | ;; Choose authenticator | ||
| 440 | (when (and (null sieve-manage-auth) | ||
| 441 | (not (eq sieve-manage-state 'auth))) | ||
| 442 | (let ((auths sieve-manage-authenticators)) | ||
| 443 | (while (setq auth (pop auths)) | ||
| 444 | (if (funcall (nth 1 (assq | ||
| 445 | auth | ||
| 446 | sieve-manage-authenticator-alist)) | ||
| 447 | buffer) | ||
| 448 | (setq sieve-manage-auth auth | ||
| 449 | auths nil))) | ||
| 450 | (unless sieve-manage-auth | ||
| 451 | (error "Couldn't figure out authenticator for server")))))) | ||
| 452 | (message "sieve: Connecting to %s...failed" sieve-manage-server)) | ||
| 453 | (when (sieve-manage-opened buffer) | ||
| 454 | (sieve-manage-erase) | 372 | (sieve-manage-erase) |
| 455 | buffer))) | 373 | (current-buffer)))) |
| 456 | 374 | ||
| 457 | (defun sieve-manage-authenticate (&optional buffer) | 375 | (defun sieve-manage-authenticate (&optional buffer) |
| 458 | "Authenticate on server in BUFFER. | 376 | "Authenticate on server in BUFFER. |
| @@ -544,12 +462,22 @@ If NAME is nil, return the full server list of capabilities." | |||
| 544 | 462 | ||
| 545 | ;; Protocol parsing routines | 463 | ;; Protocol parsing routines |
| 546 | 464 | ||
| 465 | (defun sieve-manage-wait-for-answer () | ||
| 466 | (let ((pattern "^\\(OK\\|NO\\).*\n") | ||
| 467 | pos) | ||
| 468 | (while (not pos) | ||
| 469 | (setq pos (search-forward-regexp pattern nil t)) | ||
| 470 | (goto-char (point-min)) | ||
| 471 | (sleep-for 0 50)) | ||
| 472 | pos)) | ||
| 473 | |||
| 474 | (defun sieve-manage-drop-next-answer () | ||
| 475 | (sieve-manage-wait-for-answer) | ||
| 476 | (sieve-manage-erase)) | ||
| 477 | |||
| 547 | (defun sieve-manage-ok-p (rsp) | 478 | (defun sieve-manage-ok-p (rsp) |
| 548 | (string= (downcase (or (car-safe rsp) "")) "ok")) | 479 | (string= (downcase (or (car-safe rsp) "")) "ok")) |
| 549 | 480 | ||
| 550 | (defsubst sieve-manage-forward () | ||
| 551 | (or (eobp) (forward-char))) | ||
| 552 | |||
| 553 | (defun sieve-manage-is-okno () | 481 | (defun sieve-manage-is-okno () |
| 554 | (when (looking-at (concat | 482 | (when (looking-at (concat |
| 555 | "^\\(OK\\|NO\\)\\( (\\([^)]+\\))\\)?\\( \\(.*\\)\\)?" | 483 | "^\\(OK\\|NO\\)\\( (\\([^)]+\\))\\)?\\( \\(.*\\)\\)?" |
| @@ -571,21 +499,15 @@ If NAME is nil, return the full server list of capabilities." | |||
| 571 | (sieve-manage-erase) | 499 | (sieve-manage-erase) |
| 572 | rsp)) | 500 | rsp)) |
| 573 | 501 | ||
| 574 | (defun sieve-manage-parse-capability-1 () | 502 | (defun sieve-manage-parse-capability (str) |
| 575 | "Accept a managesieve greeting." | 503 | "Parse managesieve capability string `STR'. |
| 576 | (let (str) | 504 | Set variable `sieve-manage-capability' to " |
| 577 | (while (setq str (sieve-manage-is-string)) | 505 | (let ((capas (remove-if #'null |
| 578 | (if (eq (char-after) ? ) | 506 | (mapcar #'split-string-and-unquote |
| 579 | (progn | 507 | (split-string str "\n"))))) |
| 580 | (sieve-manage-forward) | 508 | (when (string= "OK" (caar (last capas))) |
| 581 | (push (list str (sieve-manage-is-string)) | 509 | (setq sieve-manage-state 'nonauth)) |
| 582 | sieve-manage-capability)) | 510 | capas)) |
| 583 | (push (list str) sieve-manage-capability)) | ||
| 584 | (forward-line))) | ||
| 585 | (when (re-search-forward (concat "^OK.*" sieve-manage-server-eol) nil t) | ||
| 586 | (setq sieve-manage-state 'nonauth))) | ||
| 587 | |||
| 588 | (defalias 'sieve-manage-parse-greeting-1 'sieve-manage-parse-capability-1) | ||
| 589 | 511 | ||
| 590 | (defun sieve-manage-is-string () | 512 | (defun sieve-manage-is-string () |
| 591 | (cond ((looking-at "\"\\([^\"]+\\)\"") | 513 | (cond ((looking-at "\"\\([^\"]+\\)\"") |
| @@ -639,7 +561,7 @@ If NAME is nil, return the full server list of capabilities." | |||
| 639 | (setq cmdstr (concat cmdstr sieve-manage-client-eol)) | 561 | (setq cmdstr (concat cmdstr sieve-manage-client-eol)) |
| 640 | (and sieve-manage-log | 562 | (and sieve-manage-log |
| 641 | (with-current-buffer (get-buffer-create sieve-manage-log) | 563 | (with-current-buffer (get-buffer-create sieve-manage-log) |
| 642 | (sieve-manage-disable-multibyte) | 564 | (mm-enable-multibyte) |
| 643 | (buffer-disable-undo) | 565 | (buffer-disable-undo) |
| 644 | (goto-char (point-max)) | 566 | (goto-char (point-max)) |
| 645 | (insert cmdstr))) | 567 | (insert cmdstr))) |
diff --git a/lisp/gnus/sieve.el b/lisp/gnus/sieve.el index 0e46cb66361..2c11c039d56 100644 --- a/lisp/gnus/sieve.el +++ b/lisp/gnus/sieve.el | |||
| @@ -109,7 +109,6 @@ require \"fileinto\"; | |||
| 109 | ;; various | 109 | ;; various |
| 110 | (define-key map "?" 'sieve-help) | 110 | (define-key map "?" 'sieve-help) |
| 111 | (define-key map "h" 'sieve-help) | 111 | (define-key map "h" 'sieve-help) |
| 112 | (define-key map "q" 'kill-buffer) | ||
| 113 | ;; activating | 112 | ;; activating |
| 114 | (define-key map "m" 'sieve-activate) | 113 | (define-key map "m" 'sieve-activate) |
| 115 | (define-key map "u" 'sieve-deactivate) | 114 | (define-key map "u" 'sieve-deactivate) |
| @@ -152,6 +151,8 @@ require \"fileinto\"; | |||
| 152 | (defun sieve-manage-quit () | 151 | (defun sieve-manage-quit () |
| 153 | "Quit." | 152 | "Quit." |
| 154 | (interactive) | 153 | (interactive) |
| 154 | (sieve-manage-close sieve-manage-buffer) | ||
| 155 | (kill-buffer sieve-manage-buffer) | ||
| 155 | (kill-buffer (current-buffer))) | 156 | (kill-buffer (current-buffer))) |
| 156 | 157 | ||
| 157 | (defun sieve-activate (&optional pos) | 158 | (defun sieve-activate (&optional pos) |
| @@ -206,6 +207,7 @@ require \"fileinto\"; | |||
| 206 | (insert sieve-template)) | 207 | (insert sieve-template)) |
| 207 | (sieve-mode) | 208 | (sieve-mode) |
| 208 | (setq sieve-buffer-script-name name) | 209 | (setq sieve-buffer-script-name name) |
| 210 | (beginning-of-buffer) | ||
| 209 | (message | 211 | (message |
| 210 | (substitute-command-keys | 212 | (substitute-command-keys |
| 211 | "Press \\[sieve-upload] to upload script to server.")))) | 213 | "Press \\[sieve-upload] to upload script to server.")))) |
| @@ -256,10 +258,9 @@ Used to bracket operations which move point in the sieve-buffer." | |||
| 256 | (setq buffer-read-only nil) | 258 | (setq buffer-read-only nil) |
| 257 | (erase-buffer) | 259 | (erase-buffer) |
| 258 | (buffer-disable-undo) | 260 | (buffer-disable-undo) |
| 259 | (insert "\ | 261 | (let* ((port (or port sieve-manage-default-port)) |
| 260 | Server : " server ":" (or port sieve-manage-default-port) " | 262 | (header (format "Server : %s:%s\n\n" server port))) |
| 261 | 263 | (insert header)) | |
| 262 | ") | ||
| 263 | (set (make-local-variable 'sieve-buffer-header-end) | 264 | (set (make-local-variable 'sieve-buffer-header-end) |
| 264 | (point-max))) | 265 | (point-max))) |
| 265 | 266 | ||
| @@ -305,7 +306,7 @@ Server : " server ":" (or port sieve-manage-default-port) " | |||
| 305 | (with-current-buffer | 306 | (with-current-buffer |
| 306 | (or ;; open server | 307 | (or ;; open server |
| 307 | (set (make-local-variable 'sieve-manage-buffer) | 308 | (set (make-local-variable 'sieve-manage-buffer) |
| 308 | (sieve-manage-open server)) | 309 | (sieve-manage-open server port)) |
| 309 | (error "Error opening server %s" server)) | 310 | (error "Error opening server %s" server)) |
| 310 | (sieve-manage-authenticate))) | 311 | (sieve-manage-authenticate))) |
| 311 | 312 | ||
diff --git a/lisp/help-fns.el b/lisp/help-fns.el index bdf86016844..86bb67e87c2 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el | |||
| @@ -435,14 +435,19 @@ suitable file is found, return nil." | |||
| 435 | (let ((handler (function-get function 'compiler-macro))) | 435 | (let ((handler (function-get function 'compiler-macro))) |
| 436 | (when handler | 436 | (when handler |
| 437 | (insert "\nThis function has a compiler macro") | 437 | (insert "\nThis function has a compiler macro") |
| 438 | (let ((lib (get function 'compiler-macro-file))) | 438 | (if (symbolp handler) |
| 439 | ;; FIXME: rather than look at the compiler-macro-file property, | 439 | (progn |
| 440 | ;; just look at `handler' itself. | 440 | (insert (format " `%s'" handler)) |
| 441 | (when (stringp lib) | 441 | (save-excursion |
| 442 | (insert (format " in `%s'" lib)) | 442 | (re-search-backward "`\\([^`']+\\)'" nil t) |
| 443 | (save-excursion | 443 | (help-xref-button 1 'help-function handler))) |
| 444 | (re-search-backward "`\\([^`']+\\)'" nil t) | 444 | ;; FIXME: Obsolete since 24.4. |
| 445 | (help-xref-button 1 'help-function-cmacro function lib)))) | 445 | (let ((lib (get function 'compiler-macro-file))) |
| 446 | (when (stringp lib) | ||
| 447 | (insert (format " in `%s'" lib)) | ||
| 448 | (save-excursion | ||
| 449 | (re-search-backward "`\\([^`']+\\)'" nil t) | ||
| 450 | (help-xref-button 1 'help-function-cmacro function lib))))) | ||
| 446 | (insert ".\n")))) | 451 | (insert ".\n")))) |
| 447 | 452 | ||
| 448 | (defun help-fns--signature (function doc real-def real-function) | 453 | (defun help-fns--signature (function doc real-def real-function) |
diff --git a/lisp/help-mode.el b/lisp/help-mode.el index b5aca1a4445..b56adc2a4a9 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el | |||
| @@ -204,7 +204,7 @@ The format is (FUNCTION ARGS...).") | |||
| 204 | (message "Unable to find location in file")))) | 204 | (message "Unable to find location in file")))) |
| 205 | 'help-echo (purecopy "mouse-2, RET: find function's definition")) | 205 | 'help-echo (purecopy "mouse-2, RET: find function's definition")) |
| 206 | 206 | ||
| 207 | (define-button-type 'help-function-cmacro | 207 | (define-button-type 'help-function-cmacro ; FIXME: Obsolete since 24.4. |
| 208 | :supertype 'help-xref | 208 | :supertype 'help-xref |
| 209 | 'help-function (lambda (fun file) | 209 | 'help-function (lambda (fun file) |
| 210 | (setq file (locate-library file t)) | 210 | (setq file (locate-library file t)) |
| @@ -213,7 +213,7 @@ The format is (FUNCTION ARGS...).") | |||
| 213 | (pop-to-buffer (find-file-noselect file)) | 213 | (pop-to-buffer (find-file-noselect file)) |
| 214 | (goto-char (point-min)) | 214 | (goto-char (point-min)) |
| 215 | (if (re-search-forward | 215 | (if (re-search-forward |
| 216 | (format "^[ \t]*(define-compiler-macro[ \t]+%s" | 216 | (format "^[ \t]*(\\(cl-\\)?define-compiler-macro[ \t]+%s" |
| 217 | (regexp-quote (symbol-name fun))) nil t) | 217 | (regexp-quote (symbol-name fun))) nil t) |
| 218 | (forward-line 0) | 218 | (forward-line 0) |
| 219 | (message "Unable to find location in file"))) | 219 | (message "Unable to find location in file"))) |
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index 146ba61a517..de36c6c86ce 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el | |||
| @@ -1523,7 +1523,7 @@ You can then feed the file name(s) to other commands with \\[yank]." | |||
| 1523 | 1523 | ||
| 1524 | ;;;###autoload | 1524 | ;;;###autoload |
| 1525 | (defun ibuffer-mark-help-buffers () | 1525 | (defun ibuffer-mark-help-buffers () |
| 1526 | "Mark buffers like *Help*, *Apropos*, *Info*." | 1526 | "Mark buffers whose major mode is in variable `ibuffer-help-buffer-modes'." |
| 1527 | (interactive) | 1527 | (interactive) |
| 1528 | (ibuffer-mark-on-buffer | 1528 | (ibuffer-mark-on-buffer |
| 1529 | #'(lambda (buf) | 1529 | #'(lambda (buf) |
diff --git a/lisp/ido.el b/lisp/ido.el index 8087124765c..47c05b080f7 100644 --- a/lisp/ido.el +++ b/lisp/ido.el | |||
| @@ -3276,14 +3276,18 @@ for first matching file." | |||
| 3276 | (defun ido-wide-find-dirs-or-files (dir file &optional prefix finddir) | 3276 | (defun ido-wide-find-dirs-or-files (dir file &optional prefix finddir) |
| 3277 | ;; As ido-run-find-command, but returns a list of cons pairs ("file" . "dir") | 3277 | ;; As ido-run-find-command, but returns a list of cons pairs ("file" . "dir") |
| 3278 | (let ((filenames | 3278 | (let ((filenames |
| 3279 | (split-string | 3279 | (delq nil |
| 3280 | (shell-command-to-string | 3280 | (mapcar (lambda (name) |
| 3281 | (concat "find " | 3281 | (unless (ido-ignore-item-p name ido-ignore-files t) |
| 3282 | (shell-quote-argument dir) | 3282 | name)) |
| 3283 | " -name " | 3283 | (split-string |
| 3284 | (shell-quote-argument | 3284 | (shell-command-to-string |
| 3285 | (concat (if prefix "" "*") file "*")) | 3285 | (concat "find " |
| 3286 | " -type " (if finddir "d" "f") " -print")))) | 3286 | (shell-quote-argument dir) |
| 3287 | (if ido-case-fold " -iname " " -name ") | ||
| 3288 | (shell-quote-argument | ||
| 3289 | (concat (if prefix "" "*") file "*")) | ||
| 3290 | " -type " (if finddir "d" "f") " -print")))))) | ||
| 3287 | filename d f | 3291 | filename d f |
| 3288 | res) | 3292 | res) |
| 3289 | (while filenames | 3293 | (while filenames |
| @@ -3297,7 +3301,7 @@ for first matching file." | |||
| 3297 | res)) | 3301 | res)) |
| 3298 | 3302 | ||
| 3299 | (defun ido-flatten-merged-list (items) | 3303 | (defun ido-flatten-merged-list (items) |
| 3300 | ;; Create a list of directory names based on a merged directory list. | 3304 | "Create a list of directory names based on a merged directory list." |
| 3301 | (let (res) | 3305 | (let (res) |
| 3302 | (while items | 3306 | (while items |
| 3303 | (let* ((item (car items)) | 3307 | (let* ((item (car items)) |
| @@ -3400,7 +3404,7 @@ for first matching file." | |||
| 3400 | res)) | 3404 | res)) |
| 3401 | 3405 | ||
| 3402 | (defun ido-make-buffer-list-1 (&optional frame visible) | 3406 | (defun ido-make-buffer-list-1 (&optional frame visible) |
| 3403 | ;; Return list of non-ignored buffer names | 3407 | "Return list of non-ignored buffer names." |
| 3404 | (delq nil | 3408 | (delq nil |
| 3405 | (mapcar | 3409 | (mapcar |
| 3406 | (lambda (x) | 3410 | (lambda (x) |
| @@ -3410,12 +3414,12 @@ for first matching file." | |||
| 3410 | (buffer-list frame)))) | 3414 | (buffer-list frame)))) |
| 3411 | 3415 | ||
| 3412 | (defun ido-make-buffer-list (default) | 3416 | (defun ido-make-buffer-list (default) |
| 3413 | ;; Return the current list of buffers. | 3417 | "Return the current list of buffers. |
| 3414 | ;; Currently visible buffers are put at the end of the list. | 3418 | Currently visible buffers are put at the end of the list. |
| 3415 | ;; The hook `ido-make-buffer-list-hook' is run after the list has been | 3419 | The hook `ido-make-buffer-list-hook' is run after the list has been |
| 3416 | ;; created to allow the user to further modify the order of the buffer names | 3420 | created to allow the user to further modify the order of the buffer names |
| 3417 | ;; in this list. If DEFAULT is non-nil, and corresponds to an existing buffer, | 3421 | in this list. If DEFAULT is non-nil, and corresponds to an existing buffer, |
| 3418 | ;; it is put to the start of the list. | 3422 | it is put to the start of the list." |
| 3419 | (let* ((ido-current-buffers (ido-get-buffers-in-frames 'current)) | 3423 | (let* ((ido-current-buffers (ido-get-buffers-in-frames 'current)) |
| 3420 | (ido-temp-list (ido-make-buffer-list-1 (selected-frame) ido-current-buffers))) | 3424 | (ido-temp-list (ido-make-buffer-list-1 (selected-frame) ido-current-buffers))) |
| 3421 | (if ido-temp-list | 3425 | (if ido-temp-list |
| @@ -3457,9 +3461,9 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3457 | (nreverse (mapcar #'car ido-virtual-buffers)))))) | 3461 | (nreverse (mapcar #'car ido-virtual-buffers)))))) |
| 3458 | 3462 | ||
| 3459 | (defun ido-make-choice-list (default) | 3463 | (defun ido-make-choice-list (default) |
| 3460 | ;; Return the current list of choices. | 3464 | "Return the current list of choices. |
| 3461 | ;; If DEFAULT is non-nil, and corresponds to an element of choices, | 3465 | If DEFAULT is non-nil, and corresponds to an element of choices, |
| 3462 | ;; it is put to the start of the list. | 3466 | it is put to the start of the list." |
| 3463 | (let ((ido-temp-list ido-choice-list)) | 3467 | (let ((ido-temp-list ido-choice-list)) |
| 3464 | (if default | 3468 | (if default |
| 3465 | (progn | 3469 | (progn |
| @@ -3471,7 +3475,7 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3471 | ido-temp-list)) | 3475 | ido-temp-list)) |
| 3472 | 3476 | ||
| 3473 | (defun ido-to-end (items) | 3477 | (defun ido-to-end (items) |
| 3474 | ;; Move the elements from ITEMS to the end of `ido-temp-list' | 3478 | "Move the elements from ITEMS to the end of `ido-temp-list'." |
| 3475 | (mapc | 3479 | (mapc |
| 3476 | (lambda (elem) | 3480 | (lambda (elem) |
| 3477 | (setq ido-temp-list (delq elem ido-temp-list))) | 3481 | (setq ido-temp-list (delq elem ido-temp-list))) |
| @@ -3515,8 +3519,8 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3515 | (file-name-all-completions "" dir)))) | 3519 | (file-name-all-completions "" dir)))) |
| 3516 | 3520 | ||
| 3517 | (defun ido-file-name-all-completions (dir) | 3521 | (defun ido-file-name-all-completions (dir) |
| 3518 | ;; Return name of all files in DIR | 3522 | "Return name of all files in DIR. |
| 3519 | ;; Uses and updates ido-dir-file-cache | 3523 | Uses and updates `ido-dir-file-cache'." |
| 3520 | (cond | 3524 | (cond |
| 3521 | ((ido-is-unc-root dir) | 3525 | ((ido-is-unc-root dir) |
| 3522 | (mapcar | 3526 | (mapcar |
| @@ -3565,7 +3569,7 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3565 | (ido-file-name-all-completions-1 dir)))) | 3569 | (ido-file-name-all-completions-1 dir)))) |
| 3566 | 3570 | ||
| 3567 | (defun ido-remove-cached-dir (dir) | 3571 | (defun ido-remove-cached-dir (dir) |
| 3568 | ;; Remove dir from ido-dir-file-cache | 3572 | "Remove DIR from `ido-dir-file-cache'." |
| 3569 | (if (and ido-dir-file-cache | 3573 | (if (and ido-dir-file-cache |
| 3570 | (stringp dir) (> (length dir) 0)) | 3574 | (stringp dir) (> (length dir) 0)) |
| 3571 | (let ((cached (assoc dir ido-dir-file-cache))) | 3575 | (let ((cached (assoc dir ido-dir-file-cache))) |
| @@ -3574,8 +3578,8 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3574 | 3578 | ||
| 3575 | 3579 | ||
| 3576 | (defun ido-make-file-list-1 (dir &optional merged) | 3580 | (defun ido-make-file-list-1 (dir &optional merged) |
| 3577 | ;; Return list of non-ignored files in DIR | 3581 | "Return list of non-ignored files in DIR |
| 3578 | ;; If MERGED is non-nil, each file is cons'ed with DIR | 3582 | If MERGED is non-nil, each file is cons'ed with DIR." |
| 3579 | (and (or (ido-is-tramp-root dir) (ido-is-unc-root dir) | 3583 | (and (or (ido-is-tramp-root dir) (ido-is-unc-root dir) |
| 3580 | (file-directory-p dir)) | 3584 | (file-directory-p dir)) |
| 3581 | (delq nil | 3585 | (delq nil |
| @@ -3586,11 +3590,11 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3586 | (ido-file-name-all-completions dir))))) | 3590 | (ido-file-name-all-completions dir))))) |
| 3587 | 3591 | ||
| 3588 | (defun ido-make-file-list (default) | 3592 | (defun ido-make-file-list (default) |
| 3589 | ;; Return the current list of files. | 3593 | "Return the current list of files. |
| 3590 | ;; Currently visible files are put at the end of the list. | 3594 | Currently visible files are put at the end of the list. |
| 3591 | ;; The hook `ido-make-file-list-hook' is run after the list has been | 3595 | The hook `ido-make-file-list-hook' is run after the list has been |
| 3592 | ;; created to allow the user to further modify the order of the file names | 3596 | created to allow the user to further modify the order of the file names |
| 3593 | ;; in this list. | 3597 | in this list." |
| 3594 | (let ((ido-temp-list (ido-make-file-list-1 ido-current-directory))) | 3598 | (let ((ido-temp-list (ido-make-file-list-1 ido-current-directory))) |
| 3595 | (setq ido-temp-list (sort ido-temp-list | 3599 | (setq ido-temp-list (sort ido-temp-list |
| 3596 | (if ido-file-extensions-order | 3600 | (if ido-file-extensions-order |
| @@ -3631,8 +3635,8 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3631 | ido-temp-list)) | 3635 | ido-temp-list)) |
| 3632 | 3636 | ||
| 3633 | (defun ido-make-dir-list-1 (dir &optional merged) | 3637 | (defun ido-make-dir-list-1 (dir &optional merged) |
| 3634 | ;; Return list of non-ignored subdirs in DIR | 3638 | "Return list of non-ignored subdirs in DIR. |
| 3635 | ;; If MERGED is non-nil, each subdir is cons'ed with DIR | 3639 | If MERGED is non-nil, each subdir is cons'ed with DIR." |
| 3636 | (and (or (ido-is-tramp-root dir) (file-directory-p dir)) | 3640 | (and (or (ido-is-tramp-root dir) (file-directory-p dir)) |
| 3637 | (delq nil | 3641 | (delq nil |
| 3638 | (mapcar | 3642 | (mapcar |
| @@ -3642,10 +3646,10 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3642 | (ido-file-name-all-completions dir))))) | 3646 | (ido-file-name-all-completions dir))))) |
| 3643 | 3647 | ||
| 3644 | (defun ido-make-dir-list (default) | 3648 | (defun ido-make-dir-list (default) |
| 3645 | ;; Return the current list of directories. | 3649 | "Return the current list of directories. |
| 3646 | ;; The hook `ido-make-dir-list-hook' is run after the list has been | 3650 | The hook `ido-make-dir-list-hook' is run after the list has been |
| 3647 | ;; created to allow the user to further modify the order of the | 3651 | created to allow the user to further modify the order of the |
| 3648 | ;; directory names in this list. | 3652 | directory names in this list." |
| 3649 | (let ((ido-temp-list (ido-make-dir-list-1 ido-current-directory))) | 3653 | (let ((ido-temp-list (ido-make-dir-list-1 ido-current-directory))) |
| 3650 | (setq ido-temp-list (sort ido-temp-list #'ido-file-lessp)) | 3654 | (setq ido-temp-list (sort ido-temp-list #'ido-file-lessp)) |
| 3651 | (ido-to-end ;; move . files to end | 3655 | (ido-to-end ;; move . files to end |
| @@ -3676,10 +3680,9 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3676 | (defvar ido-bufs-in-frame) | 3680 | (defvar ido-bufs-in-frame) |
| 3677 | 3681 | ||
| 3678 | (defun ido-get-buffers-in-frames (&optional current) | 3682 | (defun ido-get-buffers-in-frames (&optional current) |
| 3679 | ;; Return the list of buffers that are visible in the current frame. | 3683 | "Return the list of buffers that are visible in the current frame. |
| 3680 | ;; If optional argument `current' is given, restrict searching to the | 3684 | If optional argument CURRENT is given, restrict searching to the current |
| 3681 | ;; current frame, rather than all frames, regardless of value of | 3685 | frame, rather than all frames, regardless of value of `ido-all-frames'." |
| 3682 | ;; `ido-all-frames'. | ||
| 3683 | (let ((ido-bufs-in-frame nil)) | 3686 | (let ((ido-bufs-in-frame nil)) |
| 3684 | (walk-windows 'ido-get-bufname nil | 3687 | (walk-windows 'ido-get-bufname nil |
| 3685 | (if current | 3688 | (if current |
| @@ -3688,7 +3691,7 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3688 | ido-bufs-in-frame)) | 3691 | ido-bufs-in-frame)) |
| 3689 | 3692 | ||
| 3690 | (defun ido-get-bufname (win) | 3693 | (defun ido-get-bufname (win) |
| 3691 | ;; Used by `ido-get-buffers-in-frames' to walk through all windows | 3694 | "Used by `ido-get-buffers-in-frames' to walk through all windows." |
| 3692 | (let ((buf (buffer-name (window-buffer win)))) | 3695 | (let ((buf (buffer-name (window-buffer win)))) |
| 3693 | (unless (or (member buf ido-bufs-in-frame) | 3696 | (unless (or (member buf ido-bufs-in-frame) |
| 3694 | (member buf ido-ignore-item-temp-list)) | 3697 | (member buf ido-ignore-item-temp-list)) |
| @@ -3701,7 +3704,7 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3701 | ;;; FIND MATCHING ITEMS | 3704 | ;;; FIND MATCHING ITEMS |
| 3702 | 3705 | ||
| 3703 | (defun ido-set-matches-1 (items &optional do-full) | 3706 | (defun ido-set-matches-1 (items &optional do-full) |
| 3704 | ;; Return list of matches in items | 3707 | "Return list of matches in ITEMS." |
| 3705 | (let* ((case-fold-search ido-case-fold) | 3708 | (let* ((case-fold-search ido-case-fold) |
| 3706 | (slash (and (not ido-enable-prefix) (ido-final-slash ido-text))) | 3709 | (slash (and (not ido-enable-prefix) (ido-final-slash ido-text))) |
| 3707 | (text (if slash (substring ido-text 0 -1) ido-text)) | 3710 | (text (if slash (substring ido-text 0 -1) ido-text)) |
| @@ -3789,13 +3792,13 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3789 | 3792 | ||
| 3790 | 3793 | ||
| 3791 | (defun ido-set-matches () | 3794 | (defun ido-set-matches () |
| 3792 | ;; Set `ido-matches' to the list of items matching prompt | 3795 | "Set `ido-matches' to the list of items matching prompt." |
| 3793 | (when ido-rescan | 3796 | (when ido-rescan |
| 3794 | (setq ido-matches (ido-set-matches-1 (reverse ido-cur-list) (not ido-rotate)) | 3797 | (setq ido-matches (ido-set-matches-1 (reverse ido-cur-list) (not ido-rotate)) |
| 3795 | ido-rotate nil))) | 3798 | ido-rotate nil))) |
| 3796 | 3799 | ||
| 3797 | (defun ido-ignore-item-p (name re-list &optional ignore-ext) | 3800 | (defun ido-ignore-item-p (name re-list &optional ignore-ext) |
| 3798 | ;; Return t if the buffer or file NAME should be ignored. | 3801 | "Return t if the buffer or file NAME should be ignored." |
| 3799 | (or (member name ido-ignore-item-temp-list) | 3802 | (or (member name ido-ignore-item-temp-list) |
| 3800 | (and | 3803 | (and |
| 3801 | ido-process-ignore-lists re-list | 3804 | ido-process-ignore-lists re-list |
| @@ -3835,7 +3838,7 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3835 | (defvar ido-change-word-sub) | 3838 | (defvar ido-change-word-sub) |
| 3836 | 3839 | ||
| 3837 | (defun ido-find-common-substring (items subs) | 3840 | (defun ido-find-common-substring (items subs) |
| 3838 | ;; Return common string following SUBS in each element of ITEMS. | 3841 | "Return common string following SUBS in each element of ITEMS." |
| 3839 | (let (res | 3842 | (let (res |
| 3840 | alist | 3843 | alist |
| 3841 | ido-change-word-sub) | 3844 | ido-change-word-sub) |
| @@ -3855,8 +3858,8 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3855 | comp)))) | 3858 | comp)))) |
| 3856 | 3859 | ||
| 3857 | (defun ido-word-matching-substring (word) | 3860 | (defun ido-word-matching-substring (word) |
| 3858 | ;; Return part of WORD before 1st match to `ido-change-word-sub'. | 3861 | "Return part of WORD before first match to `ido-change-word-sub'. |
| 3859 | ;; If `ido-change-word-sub' cannot be found in WORD, return nil. | 3862 | If `ido-change-word-sub' cannot be found in WORD, return nil." |
| 3860 | (let ((case-fold-search ido-case-fold)) | 3863 | (let ((case-fold-search ido-case-fold)) |
| 3861 | (let ((m (string-match ido-change-word-sub (ido-name word)))) | 3864 | (let ((m (string-match ido-change-word-sub (ido-name word)))) |
| 3862 | (if m | 3865 | (if m |
| @@ -3865,7 +3868,7 @@ This is to make them appear as if they were \"virtual buffers\"." | |||
| 3865 | nil)))) | 3868 | nil)))) |
| 3866 | 3869 | ||
| 3867 | (defun ido-makealist (res) | 3870 | (defun ido-makealist (res) |
| 3868 | ;; Return dotted pair (RES . 1). | 3871 | "Return dotted pair (RES . 1)." |
| 3869 | (cons res 1)) | 3872 | (cons res 1)) |
| 3870 | 3873 | ||
| 3871 | (defun ido-choose-completion-string (choice &rest ignored) | 3874 | (defun ido-choose-completion-string (choice &rest ignored) |
| @@ -4048,8 +4051,8 @@ Record command in `command-history' if optional RECORD is non-nil." | |||
| 4048 | 4051 | ||
| 4049 | 4052 | ||
| 4050 | (defun ido-buffer-window-other-frame (buffer) | 4053 | (defun ido-buffer-window-other-frame (buffer) |
| 4051 | ;; Return window pointer if BUFFER is visible in another frame. | 4054 | "Return window pointer if BUFFER is visible in another frame. |
| 4052 | ;; If BUFFER is visible in the current frame, return nil. | 4055 | If BUFFER is visible in the current frame, return nil." |
| 4053 | (let ((blist (ido-get-buffers-in-frames 'current))) | 4056 | (let ((blist (ido-get-buffers-in-frames 'current))) |
| 4054 | ;;If the buffer is visible in current frame, return nil | 4057 | ;;If the buffer is visible in current frame, return nil |
| 4055 | (if (member buffer blist) | 4058 | (if (member buffer blist) |
| @@ -4533,9 +4536,8 @@ For details of keybindings, see `ido-find-file'." | |||
| 4533 | )))) | 4536 | )))) |
| 4534 | 4537 | ||
| 4535 | (defun ido-completions (name) | 4538 | (defun ido-completions (name) |
| 4536 | ;; Return the string that is displayed after the user's text. | 4539 | "Return the string that is displayed after the user's text. |
| 4537 | ;; Modified from `icomplete-completions'. | 4540 | Modified from `icomplete-completions'." |
| 4538 | |||
| 4539 | (let* ((comps ido-matches) | 4541 | (let* ((comps ido-matches) |
| 4540 | (ind (and (consp (car comps)) (> (length (cdr (car comps))) 1) | 4542 | (ind (and (consp (car comps)) (> (length (cdr (car comps))) 1) |
| 4541 | ido-merged-indicator)) | 4543 | ido-merged-indicator)) |
diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el index a31a90d9cfb..48487b850df 100644 --- a/lisp/international/mule-conf.el +++ b/lisp/international/mule-conf.el | |||
| @@ -1508,6 +1508,7 @@ for decoding and encoding files, process I/O, etc." | |||
| 1508 | (setq file-coding-system-alist | 1508 | (setq file-coding-system-alist |
| 1509 | (mapcar (lambda (arg) (cons (purecopy (car arg)) (cdr arg))) | 1509 | (mapcar (lambda (arg) (cons (purecopy (car arg)) (cdr arg))) |
| 1510 | '(("\\.elc\\'" . utf-8-emacs) | 1510 | '(("\\.elc\\'" . utf-8-emacs) |
| 1511 | ("\\.el\\'" . utf-8) | ||
| 1511 | ("\\.utf\\(-8\\)?\\'" . utf-8) | 1512 | ("\\.utf\\(-8\\)?\\'" . utf-8) |
| 1512 | ("\\.xml\\'" . xml-find-file-coding-system) | 1513 | ("\\.xml\\'" . xml-find-file-coding-system) |
| 1513 | ;; We use raw-text for reading loaddefs.el so that if it | 1514 | ;; We use raw-text for reading loaddefs.el so that if it |
diff --git a/lisp/international/mule.el b/lisp/international/mule.el index dd0f3821728..4ce1a28c438 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el | |||
| @@ -1691,7 +1691,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\)\\'" | |||
| 1691 | ("\\.\\(gz\\|Z\\|bz\\|bz2\\|xz\\|gpg\\)\\'" . no-conversion) | 1691 | ("\\.\\(gz\\|Z\\|bz\\|bz2\\|xz\\|gpg\\)\\'" . no-conversion) |
| 1692 | ("\\.\\(jpe?g\\|png\\|gif\\|tiff?\\|p[bpgn]m\\)\\'" . no-conversion) | 1692 | ("\\.\\(jpe?g\\|png\\|gif\\|tiff?\\|p[bpgn]m\\)\\'" . no-conversion) |
| 1693 | ("\\.pdf\\'" . no-conversion) | 1693 | ("\\.pdf\\'" . no-conversion) |
| 1694 | ("/#[^/]+#\\'" . emacs-mule))) | 1694 | ("/#[^/]+#\\'" . utf-8-emacs-unix))) |
| 1695 | "Alist of filename patterns vs corresponding coding systems. | 1695 | "Alist of filename patterns vs corresponding coding systems. |
| 1696 | Each element looks like (REGEXP . CODING-SYSTEM). | 1696 | Each element looks like (REGEXP . CODING-SYSTEM). |
| 1697 | A file whose name matches REGEXP is decoded by CODING-SYSTEM on reading. | 1697 | A file whose name matches REGEXP is decoded by CODING-SYSTEM on reading. |
diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index aaf723f8a8b..b1936467274 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el | |||
| @@ -608,12 +608,13 @@ startup." | |||
| 608 | :group 'octave | 608 | :group 'octave |
| 609 | :version "24.4") | 609 | :version "24.4") |
| 610 | 610 | ||
| 611 | (defcustom inferior-octave-startup-args nil | 611 | (defcustom inferior-octave-startup-args '("-i" "--no-line-editing") |
| 612 | "List of command line arguments for the inferior Octave process. | 612 | "List of command line arguments for the inferior Octave process. |
| 613 | For example, for suppressing the startup message and using `traditional' | 613 | For example, for suppressing the startup message and using `traditional' |
| 614 | mode, set this to (\"-q\" \"--traditional\")." | 614 | mode, include \"-q\" and \"--traditional\"." |
| 615 | :type '(repeat string) | 615 | :type '(repeat string) |
| 616 | :group 'octave) | 616 | :group 'octave |
| 617 | :version "24.4") | ||
| 617 | 618 | ||
| 618 | (defcustom inferior-octave-mode-hook nil | 619 | (defcustom inferior-octave-mode-hook nil |
| 619 | "Hook to be run when Inferior Octave mode is started." | 620 | "Hook to be run when Inferior Octave mode is started." |
| @@ -723,13 +724,13 @@ startup file, `~/.emacs-octave'." | |||
| 723 | (substring inferior-octave-buffer 1 -1) | 724 | (substring inferior-octave-buffer 1 -1) |
| 724 | inferior-octave-buffer | 725 | inferior-octave-buffer |
| 725 | inferior-octave-program | 726 | inferior-octave-program |
| 726 | (append (list "-i" "--no-line-editing") | 727 | (append |
| 727 | ;; --no-gui is introduced in Octave > 3.7 | 728 | inferior-octave-startup-args |
| 728 | (when (zerop (process-file inferior-octave-program | 729 | ;; --no-gui is introduced in Octave > 3.7 |
| 729 | nil nil nil | 730 | (and (not (member "--no-gui" inferior-octave-startup-args)) |
| 730 | "--no-gui" "--help")) | 731 | (zerop (process-file inferior-octave-program |
| 731 | (list "--no-gui")) | 732 | nil nil nil "--no-gui" "--help")) |
| 732 | inferior-octave-startup-args)))) | 733 | '("--no-gui")))))) |
| 733 | (set-process-filter proc 'inferior-octave-output-digest) | 734 | (set-process-filter proc 'inferior-octave-output-digest) |
| 734 | (setq inferior-octave-process proc | 735 | (setq inferior-octave-process proc |
| 735 | inferior-octave-output-list nil | 736 | inferior-octave-output-list nil |
| @@ -759,10 +760,10 @@ startup file, `~/.emacs-octave'." | |||
| 759 | (inferior-octave-send-list-and-digest (list "PS2\n")) | 760 | (inferior-octave-send-list-and-digest (list "PS2\n")) |
| 760 | (when (string-match "\\(PS2\\|ans\\) = *$" | 761 | (when (string-match "\\(PS2\\|ans\\) = *$" |
| 761 | (car inferior-octave-output-list)) | 762 | (car inferior-octave-output-list)) |
| 762 | (inferior-octave-send-list-and-digest (list "PS2 (\"> \");\n"))) | 763 | (inferior-octave-send-list-and-digest (list "PS2 ('> ');\n"))) |
| 763 | 764 | ||
| 764 | (inferior-octave-send-list-and-digest | 765 | (inferior-octave-send-list-and-digest |
| 765 | (list "disp(getenv(\"OCTAVE_SRCDIR\"))\n")) | 766 | (list "disp (getenv ('OCTAVE_SRCDIR'))\n")) |
| 766 | (process-put proc 'octave-srcdir | 767 | (process-put proc 'octave-srcdir |
| 767 | (unless (equal (car inferior-octave-output-list) "") | 768 | (unless (equal (car inferior-octave-output-list) "") |
| 768 | (car inferior-octave-output-list))) | 769 | (car inferior-octave-output-list))) |
| @@ -771,19 +772,19 @@ startup file, `~/.emacs-octave'." | |||
| 771 | (inferior-octave-send-list-and-digest | 772 | (inferior-octave-send-list-and-digest |
| 772 | (list "more off;\n" | 773 | (list "more off;\n" |
| 773 | (unless (equal inferior-octave-output-string ">> ") | 774 | (unless (equal inferior-octave-output-string ">> ") |
| 774 | "PS1 (\"\\\\s> \");\n") | 775 | "PS1 ('\\s> ');\n") |
| 775 | (when (and inferior-octave-startup-file | 776 | (when (and inferior-octave-startup-file |
| 776 | (file-exists-p inferior-octave-startup-file)) | 777 | (file-exists-p inferior-octave-startup-file)) |
| 777 | (format "source (\"%s\");\n" inferior-octave-startup-file)))) | 778 | (format "source ('%s');\n" inferior-octave-startup-file)))) |
| 778 | (when inferior-octave-output-list | 779 | (when inferior-octave-output-list |
| 779 | (insert-before-markers | 780 | (insert-before-markers |
| 780 | (mapconcat 'identity inferior-octave-output-list "\n"))) | 781 | (mapconcat 'identity inferior-octave-output-list "\n"))) |
| 781 | 782 | ||
| 782 | ;; And finally, everything is back to normal. | 783 | ;; And finally, everything is back to normal. |
| 783 | (set-process-filter proc 'comint-output-filter) | 784 | (set-process-filter proc 'comint-output-filter) |
| 784 | ;; Just in case, to be sure a cd in the startup file | 785 | ;; Just in case, to be sure a cd in the startup file won't have |
| 785 | ;; won't have detrimental effects. | 786 | ;; detrimental effects. |
| 786 | (inferior-octave-resync-dirs) | 787 | (with-demoted-errors (inferior-octave-resync-dirs)) |
| 787 | ;; Generate a proper prompt, which is critical to | 788 | ;; Generate a proper prompt, which is critical to |
| 788 | ;; `comint-history-isearch-backward-regexp'. Bug#14433. | 789 | ;; `comint-history-isearch-backward-regexp'. Bug#14433. |
| 789 | (comint-send-string proc "\n"))) | 790 | (comint-send-string proc "\n"))) |
| @@ -799,7 +800,7 @@ startup file, `~/.emacs-octave'." | |||
| 799 | (unless (and (equal (car cache) command) | 800 | (unless (and (equal (car cache) command) |
| 800 | (< (float-time) (+ 5 (cadr cache)))) | 801 | (< (float-time) (+ 5 (cadr cache)))) |
| 801 | (inferior-octave-send-list-and-digest | 802 | (inferior-octave-send-list-and-digest |
| 802 | (list (concat "completion_matches (\"" command "\");\n"))) | 803 | (list (format "completion_matches ('%s');\n" command))) |
| 803 | (setq cache (list command (float-time) | 804 | (setq cache (list command (float-time) |
| 804 | (delete-consecutive-dups | 805 | (delete-consecutive-dups |
| 805 | (sort inferior-octave-output-list 'string-lessp))))) | 806 | (sort inferior-octave-output-list 'string-lessp))))) |
| @@ -898,8 +899,8 @@ output is passed to the filter `inferior-octave-output-digest'." | |||
| 898 | "Tracks `cd' commands issued to the inferior Octave process. | 899 | "Tracks `cd' commands issued to the inferior Octave process. |
| 899 | Use \\[inferior-octave-resync-dirs] to resync if Emacs gets confused." | 900 | Use \\[inferior-octave-resync-dirs] to resync if Emacs gets confused." |
| 900 | (when inferior-octave-directory-tracker-resync | 901 | (when inferior-octave-directory-tracker-resync |
| 901 | (setq inferior-octave-directory-tracker-resync nil) | 902 | (or (inferior-octave-resync-dirs 'noerror) |
| 902 | (inferior-octave-resync-dirs)) | 903 | (setq inferior-octave-directory-tracker-resync nil))) |
| 903 | (cond | 904 | (cond |
| 904 | ((string-match "^[ \t]*cd[ \t;]*$" string) | 905 | ((string-match "^[ \t]*cd[ \t;]*$" string) |
| 905 | (cd "~")) | 906 | (cd "~")) |
| @@ -911,13 +912,17 @@ Use \\[inferior-octave-resync-dirs] to resync if Emacs gets confused." | |||
| 911 | (error-message-string err) | 912 | (error-message-string err) |
| 912 | (match-string 1 string))))))) | 913 | (match-string 1 string))))))) |
| 913 | 914 | ||
| 914 | (defun inferior-octave-resync-dirs () | 915 | (defun inferior-octave-resync-dirs (&optional noerror) |
| 915 | "Resync the buffer's idea of the current directory. | 916 | "Resync the buffer's idea of the current directory. |
| 916 | This command queries the inferior Octave process about its current | 917 | This command queries the inferior Octave process about its current |
| 917 | directory and makes this the current buffer's default directory." | 918 | directory and makes this the current buffer's default directory." |
| 918 | (interactive) | 919 | (interactive) |
| 919 | (inferior-octave-send-list-and-digest '("disp (pwd ())\n")) | 920 | (inferior-octave-send-list-and-digest '("disp (pwd ())\n")) |
| 920 | (cd (car inferior-octave-output-list))) | 921 | (condition-case err |
| 922 | (progn | ||
| 923 | (cd (car inferior-octave-output-list)) | ||
| 924 | t) | ||
| 925 | (error (unless noerror (signal (car err) (cdr err)))))) | ||
| 921 | 926 | ||
| 922 | (defcustom inferior-octave-minimal-columns 80 | 927 | (defcustom inferior-octave-minimal-columns 80 |
| 923 | "The minimal column width for the inferior Octave process." | 928 | "The minimal column width for the inferior Octave process." |
| @@ -935,7 +940,7 @@ directory and makes this the current buffer's default directory." | |||
| 935 | (when (and inferior-octave-process | 940 | (when (and inferior-octave-process |
| 936 | (process-live-p inferior-octave-process)) | 941 | (process-live-p inferior-octave-process)) |
| 937 | (inferior-octave-send-list-and-digest | 942 | (inferior-octave-send-list-and-digest |
| 938 | (list (format "putenv(\"COLUMNS\", \"%s\");\n" width))))))) | 943 | (list (format "putenv ('COLUMNS', '%s');\n" width))))))) |
| 939 | 944 | ||
| 940 | 945 | ||
| 941 | ;;; Miscellaneous useful functions | 946 | ;;; Miscellaneous useful functions |
| @@ -989,7 +994,7 @@ directory and makes this the current buffer's default directory." | |||
| 989 | (setq found t))) | 994 | (setq found t))) |
| 990 | (unless found (goto-char orig)) | 995 | (unless found (goto-char orig)) |
| 991 | found)))) | 996 | found)))) |
| 992 | (pcase (file-name-extension (buffer-file-name)) | 997 | (pcase (and buffer-file-name (file-name-extension buffer-file-name)) |
| 993 | (`"cc" (funcall search | 998 | (`"cc" (funcall search |
| 994 | "\\_<DEFUN\\(?:_DLD\\)?\\s-*(\\s-*\\(\\(?:\\sw\\|\\s_\\)+\\)" 1)) | 999 | "\\_<DEFUN\\(?:_DLD\\)?\\s-*(\\s-*\\(\\(?:\\sw\\|\\s_\\)+\\)" 1)) |
| 995 | (t (funcall search octave-function-header-regexp 3))))) | 1000 | (t (funcall search octave-function-header-regexp 3))))) |
| @@ -1519,9 +1524,7 @@ code line." | |||
| 1519 | (defun octave-eldoc-function-signatures (fn) | 1524 | (defun octave-eldoc-function-signatures (fn) |
| 1520 | (unless (equal fn (car octave-eldoc-cache)) | 1525 | (unless (equal fn (car octave-eldoc-cache)) |
| 1521 | (inferior-octave-send-list-and-digest | 1526 | (inferior-octave-send-list-and-digest |
| 1522 | (list (format "\ | 1527 | (list (format "print_usage ('%s');\n" fn))) |
| 1523 | if ismember(exist(\"%s\"), [2 3 5 103]) print_usage(\"%s\") endif\n" | ||
| 1524 | fn fn))) | ||
| 1525 | (let (result) | 1528 | (let (result) |
| 1526 | (dolist (line inferior-octave-output-list) | 1529 | (dolist (line inferior-octave-output-list) |
| 1527 | (when (string-match | 1530 | (when (string-match |
| @@ -1622,7 +1625,7 @@ if ismember(exist(\"%s\"), [2 3 5 103]) print_usage(\"%s\") endif\n" | |||
| 1622 | "Display the documentation of FN." | 1625 | "Display the documentation of FN." |
| 1623 | (interactive (list (octave-completing-read))) | 1626 | (interactive (list (octave-completing-read))) |
| 1624 | (inferior-octave-send-list-and-digest | 1627 | (inferior-octave-send-list-and-digest |
| 1625 | (list (format "help \"%s\"\n" fn))) | 1628 | (list (format "help ('%s');\n" fn))) |
| 1626 | (let ((lines inferior-octave-output-list) | 1629 | (let ((lines inferior-octave-output-list) |
| 1627 | (inhibit-read-only t)) | 1630 | (inhibit-read-only t)) |
| 1628 | (when (string-match "error: \\(.*\\)$" (car lines)) | 1631 | (when (string-match "error: \\(.*\\)$" (car lines)) |
| @@ -1658,12 +1661,15 @@ if ismember(exist(\"%s\"), [2 3 5 103]) print_usage(\"%s\") endif\n" | |||
| 1658 | (help-insert-xref-button (file-relative-name file dir) | 1661 | (help-insert-xref-button (file-relative-name file dir) |
| 1659 | 'octave-help-file fn) | 1662 | 'octave-help-file fn) |
| 1660 | (insert "'"))) | 1663 | (insert "'"))) |
| 1661 | ;; Make 'See also' clickable | 1664 | ;; Make 'See also' clickable. |
| 1662 | (with-syntax-table octave-mode-syntax-table | 1665 | (with-syntax-table octave-mode-syntax-table |
| 1663 | (when (re-search-forward "^\\s-*See also:" nil t) | 1666 | (when (re-search-forward "^\\s-*See also:" nil t) |
| 1664 | (let ((end (save-excursion (re-search-forward "^\\s-*$" nil t)))) | 1667 | (let ((end (save-excursion (re-search-forward "^\\s-*$" nil t)))) |
| 1665 | (while (re-search-forward "\\_<\\(?:\\sw\\|\\s_\\)+\\_>" end t) | 1668 | (while (re-search-forward |
| 1666 | (make-text-button (match-beginning 0) (match-end 0) | 1669 | ;; Match operators and symbols. |
| 1670 | "\\(?1:\\s.+?\\)\\(?:$\\|[,;]\\|\\s-\\)\\|\\_<\\(?1:\\(?:\\sw\\|\\s_\\)+\\)\\_>" | ||
| 1671 | end t) | ||
| 1672 | (make-text-button (match-beginning 1) (match-end 1) | ||
| 1667 | :type 'octave-help-function))))) | 1673 | :type 'octave-help-function))))) |
| 1668 | (octave-help-mode))))) | 1674 | (octave-help-mode))))) |
| 1669 | 1675 | ||
| @@ -1716,12 +1722,13 @@ Functions implemented in C++ can be found if | |||
| 1716 | (interactive (list (octave-completing-read))) | 1722 | (interactive (list (octave-completing-read))) |
| 1717 | (require 'etags) | 1723 | (require 'etags) |
| 1718 | (let ((orig (point))) | 1724 | (let ((orig (point))) |
| 1719 | (if (octave-goto-function-definition fn) | 1725 | (if (and (derived-mode-p 'octave-mode) |
| 1726 | (octave-goto-function-definition fn)) | ||
| 1720 | (ring-insert find-tag-marker-ring (copy-marker orig)) | 1727 | (ring-insert find-tag-marker-ring (copy-marker orig)) |
| 1721 | (inferior-octave-send-list-and-digest | 1728 | (inferior-octave-send-list-and-digest |
| 1722 | ;; help NAME is more verbose | 1729 | ;; help NAME is more verbose |
| 1723 | (list (format "\ | 1730 | (list (format "\ |
| 1724 | if iskeyword(\"%s\") disp(\"`%s' is a keyword\") else which(\"%s\") endif\n" | 1731 | if iskeyword('%s') disp('`%s'' is a keyword') else which('%s') endif\n" |
| 1725 | fn fn fn))) | 1732 | fn fn fn))) |
| 1726 | (let (line file) | 1733 | (let (line file) |
| 1727 | ;; Skip garbage lines such as | 1734 | ;; Skip garbage lines such as |
| @@ -1738,6 +1745,5 @@ if iskeyword(\"%s\") disp(\"`%s' is a keyword\") else which(\"%s\") endif\n" | |||
| 1738 | (find-file file) | 1745 | (find-file file) |
| 1739 | (octave-goto-function-definition fn))))))) | 1746 | (octave-goto-function-definition fn))))))) |
| 1740 | 1747 | ||
| 1741 | |||
| 1742 | (provide 'octave) | 1748 | (provide 'octave) |
| 1743 | ;;; octave.el ends here | 1749 | ;;; octave.el ends here |
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 63bd9258d69..0f3c1504ee9 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el | |||
| @@ -1149,11 +1149,7 @@ VERSION is of the format (Major . Minor)" | |||
| 1149 | (set (make-local-variable 'comment-start) "%") | 1149 | (set (make-local-variable 'comment-start) "%") |
| 1150 | (set (make-local-variable 'comment-end) "") | 1150 | (set (make-local-variable 'comment-end) "") |
| 1151 | (set (make-local-variable 'comment-add) 1) | 1151 | (set (make-local-variable 'comment-add) 1) |
| 1152 | (set (make-local-variable 'comment-start-skip) | 1152 | (set (make-local-variable 'comment-start-skip) "\\(?:/\\*+ *\\|%%+ *\\)") |
| 1153 | ;; This complex regexp makes sure that comments cannot start | ||
| 1154 | ;; inside quoted atoms or strings | ||
| 1155 | (format "^\\(\\(%s\\|%s\\|[^\n\'\"%%]\\)*\\)\\(/\\*+ *\\|%%+ *\\)" | ||
| 1156 | prolog-quoted-atom-regexp prolog-string-regexp)) | ||
| 1157 | (set (make-local-variable 'parens-require-spaces) nil) | 1153 | (set (make-local-variable 'parens-require-spaces) nil) |
| 1158 | ;; Initialize Prolog system specific variables | 1154 | ;; Initialize Prolog system specific variables |
| 1159 | (dolist (var '(prolog-keywords prolog-types prolog-mode-specificators | 1155 | (dolist (var '(prolog-keywords prolog-types prolog-mode-specificators |
| @@ -1739,8 +1735,7 @@ This function must be called from the source code buffer." | |||
| 1739 | (real-file buffer-file-name) | 1735 | (real-file buffer-file-name) |
| 1740 | (command-string (prolog-build-prolog-command compilep file | 1736 | (command-string (prolog-build-prolog-command compilep file |
| 1741 | real-file first-line)) | 1737 | real-file first-line)) |
| 1742 | (process (get-process "prolog")) | 1738 | (process (get-process "prolog"))) |
| 1743 | (old-filter (process-filter process))) | ||
| 1744 | (with-current-buffer buffer | 1739 | (with-current-buffer buffer |
| 1745 | (delete-region (point-min) (point-max)) | 1740 | (delete-region (point-min) (point-max)) |
| 1746 | ;; FIXME: Wasn't this supposed to use prolog-inferior-mode? | 1741 | ;; FIXME: Wasn't this supposed to use prolog-inferior-mode? |
| @@ -1759,8 +1754,7 @@ This function must be called from the source code buffer." | |||
| 1759 | 'prolog-parse-sicstus-compilation-errors)) | 1754 | 'prolog-parse-sicstus-compilation-errors)) |
| 1760 | (setq buffer-read-only nil) | 1755 | (setq buffer-read-only nil) |
| 1761 | (insert command-string "\n")) | 1756 | (insert command-string "\n")) |
| 1762 | (save-selected-window | 1757 | (display-buffer buffer) |
| 1763 | (pop-to-buffer buffer)) | ||
| 1764 | (setq prolog-process-flag t | 1758 | (setq prolog-process-flag t |
| 1765 | prolog-consult-compile-output "" | 1759 | prolog-consult-compile-output "" |
| 1766 | prolog-consult-compile-first-line (if first-line (1- first-line) 0) | 1760 | prolog-consult-compile-first-line (if first-line (1- first-line) 0) |
| @@ -1954,20 +1948,6 @@ If COMPILEP is non-nil, compile, otherwise consult." | |||
| 1954 | ;;------------------------------------------------------------------- | 1948 | ;;------------------------------------------------------------------- |
| 1955 | 1949 | ||
| 1956 | ;; Auxiliary functions | 1950 | ;; Auxiliary functions |
| 1957 | (defun prolog-make-keywords-regexp (keywords &optional protect) | ||
| 1958 | "Create regexp from the list of strings KEYWORDS. | ||
| 1959 | If PROTECT is non-nil, surround the result regexp by word breaks." | ||
| 1960 | (let ((regexp | ||
| 1961 | (if (fboundp 'regexp-opt) | ||
| 1962 | ;; Emacs 20 | ||
| 1963 | ;; Avoid compile warnings under earlier versions by using eval | ||
| 1964 | (eval '(regexp-opt keywords)) | ||
| 1965 | ;; Older Emacsen | ||
| 1966 | (concat (mapconcat 'regexp-quote keywords "\\|"))) | ||
| 1967 | )) | ||
| 1968 | (if protect | ||
| 1969 | (concat "\\<\\(" regexp "\\)\\>") | ||
| 1970 | regexp))) | ||
| 1971 | 1951 | ||
| 1972 | (defun prolog-font-lock-object-matcher (bound) | 1952 | (defun prolog-font-lock-object-matcher (bound) |
| 1973 | "Find SICStus objects method name for font lock. | 1953 | "Find SICStus objects method name for font lock. |
| @@ -2084,20 +2064,16 @@ Argument BOUND is a buffer position limiting searching." | |||
| 2084 | (if (eq prolog-system 'mercury) | 2064 | (if (eq prolog-system 'mercury) |
| 2085 | (concat | 2065 | (concat |
| 2086 | "\\<\\(" | 2066 | "\\<\\(" |
| 2087 | (prolog-make-keywords-regexp prolog-keywords-i) | 2067 | (regexp-opt prolog-keywords-i) |
| 2088 | "\\|" | 2068 | "\\|" |
| 2089 | (prolog-make-keywords-regexp | 2069 | (regexp-opt |
| 2090 | prolog-determinism-specificators-i) | 2070 | prolog-determinism-specificators-i) |
| 2091 | "\\)\\>") | 2071 | "\\)\\>") |
| 2092 | (concat | 2072 | (concat |
| 2093 | "^[?:]- *\\(" | 2073 | "^[?:]- *\\(" |
| 2094 | (prolog-make-keywords-regexp prolog-keywords-i) | 2074 | (regexp-opt prolog-keywords-i) |
| 2095 | "\\)\\>")) | 2075 | "\\)\\>")) |
| 2096 | 1 prolog-builtin-face)) | 2076 | 1 prolog-builtin-face)) |
| 2097 | (quoted_atom (list prolog-quoted-atom-regexp | ||
| 2098 | 2 'font-lock-string-face 'append)) | ||
| 2099 | (string (list prolog-string-regexp | ||
| 2100 | 1 'font-lock-string-face 'append)) | ||
| 2101 | ;; SICStus specific patterns | 2077 | ;; SICStus specific patterns |
| 2102 | (sicstus-object-methods | 2078 | (sicstus-object-methods |
| 2103 | (if (eq prolog-system 'sicstus) | 2079 | (if (eq prolog-system 'sicstus) |
| @@ -2107,17 +2083,17 @@ Argument BOUND is a buffer position limiting searching." | |||
| 2107 | (types | 2083 | (types |
| 2108 | (if (eq prolog-system 'mercury) | 2084 | (if (eq prolog-system 'mercury) |
| 2109 | (list | 2085 | (list |
| 2110 | (prolog-make-keywords-regexp prolog-types-i t) | 2086 | (regexp-opt prolog-types-i 'words) |
| 2111 | 0 'font-lock-type-face))) | 2087 | 0 'font-lock-type-face))) |
| 2112 | (modes | 2088 | (modes |
| 2113 | (if (eq prolog-system 'mercury) | 2089 | (if (eq prolog-system 'mercury) |
| 2114 | (list | 2090 | (list |
| 2115 | (prolog-make-keywords-regexp prolog-mode-specificators-i t) | 2091 | (regexp-opt prolog-mode-specificators-i 'words) |
| 2116 | 0 'font-lock-constant-face))) | 2092 | 0 'font-lock-constant-face))) |
| 2117 | (directives | 2093 | (directives |
| 2118 | (if (eq prolog-system 'mercury) | 2094 | (if (eq prolog-system 'mercury) |
| 2119 | (list | 2095 | (list |
| 2120 | (prolog-make-keywords-regexp prolog-directives-i t) | 2096 | (regexp-opt prolog-directives-i 'words) |
| 2121 | 0 'prolog-warning-face))) | 2097 | 0 'prolog-warning-face))) |
| 2122 | ;; Inferior mode specific patterns | 2098 | ;; Inferior mode specific patterns |
| 2123 | (prompt | 2099 | (prompt |
| @@ -2211,8 +2187,6 @@ Argument BOUND is a buffer position limiting searching." | |||
| 2211 | (list | 2187 | (list |
| 2212 | head-predicates | 2188 | head-predicates |
| 2213 | head-predicates-1 | 2189 | head-predicates-1 |
| 2214 | quoted_atom | ||
| 2215 | string | ||
| 2216 | variables | 2190 | variables |
| 2217 | important-elements | 2191 | important-elements |
| 2218 | important-elements-1 | 2192 | important-elements-1 |
diff --git a/lisp/replace.el b/lisp/replace.el index af05bd11fb2..24cfccf60fd 100644 --- a/lisp/replace.el +++ b/lisp/replace.el | |||
| @@ -246,7 +246,7 @@ Matching is independent of case if `case-fold-search' is non-nil and | |||
| 246 | FROM-STRING has no uppercase letters. Replacement transfers the case | 246 | FROM-STRING has no uppercase letters. Replacement transfers the case |
| 247 | pattern of the old text to the new text, if `case-replace' and | 247 | pattern of the old text to the new text, if `case-replace' and |
| 248 | `case-fold-search' are non-nil and FROM-STRING has no uppercase | 248 | `case-fold-search' are non-nil and FROM-STRING has no uppercase |
| 249 | letters. \(Transferring the case pattern means that if the old text | 249 | letters. (Transferring the case pattern means that if the old text |
| 250 | matched is all caps, or capitalized, then its replacement is upcased | 250 | matched is all caps, or capitalized, then its replacement is upcased |
| 251 | or capitalized.) | 251 | or capitalized.) |
| 252 | 252 | ||
| @@ -1175,8 +1175,8 @@ is called only during interactive use. | |||
| 1175 | 1175 | ||
| 1176 | For example, to check for occurrence of symbol at point use | 1176 | For example, to check for occurrence of symbol at point use |
| 1177 | 1177 | ||
| 1178 | \(setq occur-read-regexp-defaults-function | 1178 | (setq occur-read-regexp-defaults-function |
| 1179 | 'find-tag-default-as-regexp\).") | 1179 | 'find-tag-default-as-regexp).") |
| 1180 | 1180 | ||
| 1181 | (defun occur-read-regexp-defaults () | 1181 | (defun occur-read-regexp-defaults () |
| 1182 | "Return the latest regexp from `regexp-history'. | 1182 | "Return the latest regexp from `regexp-history'. |
| @@ -1874,7 +1874,7 @@ It is called with three arguments, as if it were | |||
| 1874 | 1874 | ||
| 1875 | (defun replace-search (search-string limit regexp-flag delimited-flag | 1875 | (defun replace-search (search-string limit regexp-flag delimited-flag |
| 1876 | case-fold-search) | 1876 | case-fold-search) |
| 1877 | "Search for the next occurence of SEARCH-STRING to replace." | 1877 | "Search for the next occurrence of SEARCH-STRING to replace." |
| 1878 | ;; Let-bind global isearch-* variables to values used | 1878 | ;; Let-bind global isearch-* variables to values used |
| 1879 | ;; to search the next replacement. These let-bindings | 1879 | ;; to search the next replacement. These let-bindings |
| 1880 | ;; should be effective both at the time of calling | 1880 | ;; should be effective both at the time of calling |
diff --git a/lisp/subr.el b/lisp/subr.el index 65943aea337..8f290f356da 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -41,11 +41,11 @@ Each element of this list holds the arguments to one call to `defcustom'.") | |||
| 41 | 41 | ||
| 42 | (defmacro declare-function (_fn _file &optional _arglist _fileonly) | 42 | (defmacro declare-function (_fn _file &optional _arglist _fileonly) |
| 43 | "Tell the byte-compiler that function FN is defined, in FILE. | 43 | "Tell the byte-compiler that function FN is defined, in FILE. |
| 44 | Optional ARGLIST is the argument list used by the function. The | 44 | Optional ARGLIST is the argument list used by the function. |
| 45 | FILE argument is not used by the byte-compiler, but by the | 45 | The FILE argument is not used by the byte-compiler, but by the |
| 46 | `check-declare' package, which checks that FILE contains a | 46 | `check-declare' package, which checks that FILE contains a |
| 47 | definition for FN. ARGLIST is used by both the byte-compiler and | 47 | definition for FN. ARGLIST is used by both the byte-compiler |
| 48 | `check-declare' to check for consistency. | 48 | and `check-declare' to check for consistency. |
| 49 | 49 | ||
| 50 | FILE can be either a Lisp file (in which case the \".el\" | 50 | FILE can be either a Lisp file (in which case the \".el\" |
| 51 | extension is optional), or a C file. C files are expanded | 51 | extension is optional), or a C file. C files are expanded |
| @@ -396,9 +396,9 @@ non-nil." | |||
| 396 | (defun number-sequence (from &optional to inc) | 396 | (defun number-sequence (from &optional to inc) |
| 397 | "Return a sequence of numbers from FROM to TO (both inclusive) as a list. | 397 | "Return a sequence of numbers from FROM to TO (both inclusive) as a list. |
| 398 | INC is the increment used between numbers in the sequence and defaults to 1. | 398 | INC is the increment used between numbers in the sequence and defaults to 1. |
| 399 | So, the Nth element of the list is \(+ FROM \(* N INC)) where N counts from | 399 | So, the Nth element of the list is (+ FROM (* N INC)) where N counts from |
| 400 | zero. TO is only included if there is an N for which TO = FROM + N * INC. | 400 | zero. TO is only included if there is an N for which TO = FROM + N * INC. |
| 401 | If TO is nil or numerically equal to FROM, return \(FROM). | 401 | If TO is nil or numerically equal to FROM, return (FROM). |
| 402 | If INC is positive and TO is less than FROM, or INC is negative | 402 | If INC is positive and TO is less than FROM, or INC is negative |
| 403 | and TO is larger than FROM, return nil. | 403 | and TO is larger than FROM, return nil. |
| 404 | If INC is zero and TO is neither nil nor numerically equal to | 404 | If INC is zero and TO is neither nil nor numerically equal to |
| @@ -408,11 +408,11 @@ This function is primarily designed for integer arguments. | |||
| 408 | Nevertheless, FROM, TO and INC can be integer or float. However, | 408 | Nevertheless, FROM, TO and INC can be integer or float. However, |
| 409 | floating point arithmetic is inexact. For instance, depending on | 409 | floating point arithmetic is inexact. For instance, depending on |
| 410 | the machine, it may quite well happen that | 410 | the machine, it may quite well happen that |
| 411 | \(number-sequence 0.4 0.6 0.2) returns the one element list \(0.4), | 411 | \(number-sequence 0.4 0.6 0.2) returns the one element list (0.4), |
| 412 | whereas \(number-sequence 0.4 0.8 0.2) returns a list with three | 412 | whereas (number-sequence 0.4 0.8 0.2) returns a list with three |
| 413 | elements. Thus, if some of the arguments are floats and one wants | 413 | elements. Thus, if some of the arguments are floats and one wants |
| 414 | to make sure that TO is included, one may have to explicitly write | 414 | to make sure that TO is included, one may have to explicitly write |
| 415 | TO as \(+ FROM \(* N INC)) or use a variable whose value was | 415 | TO as (+ FROM (* N INC)) or use a variable whose value was |
| 416 | computed with this exact expression. Alternatively, you can, | 416 | computed with this exact expression. Alternatively, you can, |
| 417 | of course, also replace TO with a slightly larger value | 417 | of course, also replace TO with a slightly larger value |
| 418 | \(or a slightly more negative value if INC is negative)." | 418 | \(or a slightly more negative value if INC is negative)." |
| @@ -784,8 +784,8 @@ KEY is a key sequence; noninteractively, it is a string or vector | |||
| 784 | of characters or event types, and non-ASCII characters with codes | 784 | of characters or event types, and non-ASCII characters with codes |
| 785 | above 127 (such as ISO Latin-1) can be included if you use a vector. | 785 | above 127 (such as ISO Latin-1) can be included if you use a vector. |
| 786 | 786 | ||
| 787 | The binding goes in the current buffer's local map, | 787 | The binding goes in the current buffer's local map, which in most |
| 788 | which in most cases is shared with all other buffers in the same major mode." | 788 | cases is shared with all other buffers in the same major mode." |
| 789 | (interactive "KSet key locally: \nCSet key %s locally to command: ") | 789 | (interactive "KSet key locally: \nCSet key %s locally to command: ") |
| 790 | (let ((map (current-local-map))) | 790 | (let ((map (current-local-map))) |
| 791 | (or map | 791 | (or map |
| @@ -821,7 +821,7 @@ in KEYMAP as NEWDEF those keys which are defined as OLDDEF in OLDMAP. | |||
| 821 | 821 | ||
| 822 | If you don't specify OLDMAP, you can usually get the same results | 822 | If you don't specify OLDMAP, you can usually get the same results |
| 823 | in a cleaner way with command remapping, like this: | 823 | in a cleaner way with command remapping, like this: |
| 824 | \(define-key KEYMAP [remap OLDDEF] NEWDEF) | 824 | (define-key KEYMAP [remap OLDDEF] NEWDEF) |
| 825 | \n(fn OLDDEF NEWDEF KEYMAP &optional OLDMAP)" | 825 | \n(fn OLDDEF NEWDEF KEYMAP &optional OLDMAP)" |
| 826 | ;; Don't document PREFIX in the doc string because we don't want to | 826 | ;; Don't document PREFIX in the doc string because we don't want to |
| 827 | ;; advertise it. It's meant for recursive calls only. Here's its | 827 | ;; advertise it. It's meant for recursive calls only. Here's its |
| @@ -2540,7 +2540,7 @@ Set this to nil at your own risk..." | |||
| 2540 | (defun locate-user-emacs-file (new-name &optional old-name) | 2540 | (defun locate-user-emacs-file (new-name &optional old-name) |
| 2541 | "Return an absolute per-user Emacs-specific file name. | 2541 | "Return an absolute per-user Emacs-specific file name. |
| 2542 | If NEW-NAME exists in `user-emacs-directory', return it. | 2542 | If NEW-NAME exists in `user-emacs-directory', return it. |
| 2543 | Else If OLD-NAME is non-nil and ~/OLD-NAME exists, return ~/OLD-NAME. | 2543 | Else if OLD-NAME is non-nil and ~/OLD-NAME exists, return ~/OLD-NAME. |
| 2544 | Else return NEW-NAME in `user-emacs-directory', creating the | 2544 | Else return NEW-NAME in `user-emacs-directory', creating the |
| 2545 | directory if it does not exist." | 2545 | directory if it does not exist." |
| 2546 | (convert-standard-filename | 2546 | (convert-standard-filename |
| @@ -3231,7 +3231,7 @@ than cosmetic ones, undo data may become corrupted. | |||
| 3231 | 3231 | ||
| 3232 | This macro will run BODY normally, but doesn't count its buffer | 3232 | This macro will run BODY normally, but doesn't count its buffer |
| 3233 | modifications as being buffer modifications. This affects things | 3233 | modifications as being buffer modifications. This affects things |
| 3234 | like buffer-modified-p, checking whether the file is locked by | 3234 | like `buffer-modified-p', checking whether the file is locked by |
| 3235 | someone else, running buffer modification hooks, and other things | 3235 | someone else, running buffer modification hooks, and other things |
| 3236 | of that nature. | 3236 | of that nature. |
| 3237 | 3237 | ||
| @@ -3536,7 +3536,7 @@ which separates, but is not part of, the substrings. If nil it defaults to | |||
| 3536 | `split-string-default-separators', normally \"[ \\f\\t\\n\\r\\v]+\", and | 3536 | `split-string-default-separators', normally \"[ \\f\\t\\n\\r\\v]+\", and |
| 3537 | OMIT-NULLS is forced to t. | 3537 | OMIT-NULLS is forced to t. |
| 3538 | 3538 | ||
| 3539 | If OMIT-NULLS is t, zero-length substrings are omitted from the list \(so | 3539 | If OMIT-NULLS is t, zero-length substrings are omitted from the list (so |
| 3540 | that for the default value of SEPARATORS leading and trailing whitespace | 3540 | that for the default value of SEPARATORS leading and trailing whitespace |
| 3541 | are effectively trimmed). If nil, all zero-length substrings are retained, | 3541 | are effectively trimmed). If nil, all zero-length substrings are retained, |
| 3542 | which correctly parses CSV format, for example. | 3542 | which correctly parses CSV format, for example. |
| @@ -3733,18 +3733,18 @@ If FILE is already loaded, evaluate FORM right now. | |||
| 3733 | If a matching file is loaded again, FORM will be evaluated again. | 3733 | If a matching file is loaded again, FORM will be evaluated again. |
| 3734 | 3734 | ||
| 3735 | If FILE is a string, it may be either an absolute or a relative file | 3735 | If FILE is a string, it may be either an absolute or a relative file |
| 3736 | name, and may have an extension \(e.g. \".el\") or may lack one, and | 3736 | name, and may have an extension (e.g. \".el\") or may lack one, and |
| 3737 | additionally may or may not have an extension denoting a compressed | 3737 | additionally may or may not have an extension denoting a compressed |
| 3738 | format \(e.g. \".gz\"). | 3738 | format (e.g. \".gz\"). |
| 3739 | 3739 | ||
| 3740 | When FILE is absolute, this first converts it to a true name by chasing | 3740 | When FILE is absolute, this first converts it to a true name by chasing |
| 3741 | symbolic links. Only a file of this name \(see next paragraph regarding | 3741 | symbolic links. Only a file of this name (see next paragraph regarding |
| 3742 | extensions) will trigger the evaluation of FORM. When FILE is relative, | 3742 | extensions) will trigger the evaluation of FORM. When FILE is relative, |
| 3743 | a file whose absolute true name ends in FILE will trigger evaluation. | 3743 | a file whose absolute true name ends in FILE will trigger evaluation. |
| 3744 | 3744 | ||
| 3745 | When FILE lacks an extension, a file name with any extension will trigger | 3745 | When FILE lacks an extension, a file name with any extension will trigger |
| 3746 | evaluation. Otherwise, its extension must match FILE's. A further | 3746 | evaluation. Otherwise, its extension must match FILE's. A further |
| 3747 | extension for a compressed format \(e.g. \".gz\") on FILE will not affect | 3747 | extension for a compressed format (e.g. \".gz\") on FILE will not affect |
| 3748 | this name matching. | 3748 | this name matching. |
| 3749 | 3749 | ||
| 3750 | Alternatively, FILE can be a feature (i.e. a symbol), in which case FORM | 3750 | Alternatively, FILE can be a feature (i.e. a symbol), in which case FORM |
| @@ -4234,32 +4234,6 @@ use `called-interactively-p'." | |||
| 4234 | (declare (obsolete called-interactively-p "23.2")) | 4234 | (declare (obsolete called-interactively-p "23.2")) |
| 4235 | (called-interactively-p 'interactive)) | 4235 | (called-interactively-p 'interactive)) |
| 4236 | 4236 | ||
| 4237 | (defun function-arity (f &optional num) | ||
| 4238 | "Return the (MIN . MAX) arity of F. | ||
| 4239 | If the maximum arity is infinite, MAX is `many'. | ||
| 4240 | F can be a function or a macro. | ||
| 4241 | If NUM is non-nil, return non-nil iff F can be called with NUM args." | ||
| 4242 | (if (symbolp f) (setq f (indirect-function f))) | ||
| 4243 | (if (eq (car-safe f) 'macro) (setq f (cdr f))) | ||
| 4244 | (let ((res | ||
| 4245 | (if (subrp f) | ||
| 4246 | (let ((x (subr-arity f))) | ||
| 4247 | (if (eq (cdr x) 'unevalled) (cons (car x) 'many))) | ||
| 4248 | (let* ((args (if (consp f) (cadr f) (aref f 0))) | ||
| 4249 | (max (length args)) | ||
| 4250 | (opt (memq '&optional args)) | ||
| 4251 | (rest (memq '&rest args)) | ||
| 4252 | (min (- max (length opt)))) | ||
| 4253 | (if opt | ||
| 4254 | (cons min (if rest 'many (1- max))) | ||
| 4255 | (if rest | ||
| 4256 | (cons (- max (length rest)) 'many) | ||
| 4257 | (cons min max))))))) | ||
| 4258 | (if (not num) | ||
| 4259 | res | ||
| 4260 | (and (>= num (car res)) | ||
| 4261 | (or (eq 'many (cdr res)) (<= num (cdr res))))))) | ||
| 4262 | |||
| 4263 | (defun set-temporary-overlay-map (map &optional keep-pred) | 4237 | (defun set-temporary-overlay-map (map &optional keep-pred) |
| 4264 | "Set MAP as a temporary keymap taking precedence over most other keymaps. | 4238 | "Set MAP as a temporary keymap taking precedence over most other keymaps. |
| 4265 | Note that this does NOT take precedence over the \"overriding\" maps | 4239 | Note that this does NOT take precedence over the \"overriding\" maps |
diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index f20785966cd..de103c0cdb6 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el | |||
| @@ -123,8 +123,6 @@ | |||
| 123 | 123 | ||
| 124 | (easy-mmode-defmap log-view-mode-map | 124 | (easy-mmode-defmap log-view-mode-map |
| 125 | '( | 125 | '( |
| 126 | ;; FIXME: (copy-keymap special-mode-map) instead | ||
| 127 | (" " . scroll-up-command) | ||
| 128 | ("-" . negative-argument) | 126 | ("-" . negative-argument) |
| 129 | ("0" . digit-argument) | 127 | ("0" . digit-argument) |
| 130 | ("1" . digit-argument) | 128 | ("1" . digit-argument) |
| @@ -136,14 +134,6 @@ | |||
| 136 | ("7" . digit-argument) | 134 | ("7" . digit-argument) |
| 137 | ("8" . digit-argument) | 135 | ("8" . digit-argument) |
| 138 | ("9" . digit-argument) | 136 | ("9" . digit-argument) |
| 139 | ("<" . beginning-of-buffer) | ||
| 140 | (">" . end-of-buffer) | ||
| 141 | ("?" . describe-mode) | ||
| 142 | ("h" . describe-mode) | ||
| 143 | ("" . scroll-down-command) | ||
| 144 | (33554464 . scroll-down-command) | ||
| 145 | ("q" . quit-window) | ||
| 146 | ("g" . revert-buffer) | ||
| 147 | 137 | ||
| 148 | ("\C-m" . log-view-toggle-entry-display) | 138 | ("\C-m" . log-view-toggle-entry-display) |
| 149 | ("m" . log-view-toggle-mark-entry) | 139 | ("m" . log-view-toggle-mark-entry) |
| @@ -162,6 +152,7 @@ | |||
| 162 | ("\M-n" . log-view-file-next) | 152 | ("\M-n" . log-view-file-next) |
| 163 | ("\M-p" . log-view-file-prev)) | 153 | ("\M-p" . log-view-file-prev)) |
| 164 | "Log-View's keymap." | 154 | "Log-View's keymap." |
| 155 | :inherit special-mode-map | ||
| 165 | :group 'log-view) | 156 | :group 'log-view) |
| 166 | 157 | ||
| 167 | (easy-menu-define log-view-mode-menu log-view-mode-map | 158 | (easy-menu-define log-view-mode-menu log-view-mode-map |
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 5e1d27c0ea3..0308dd1ebd4 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el | |||
| @@ -115,10 +115,10 @@ | |||
| 115 | ;; Return non-nil if FILE is registered in this backend. Both this | 115 | ;; Return non-nil if FILE is registered in this backend. Both this |
| 116 | ;; function as well as `state' should be careful to fail gracefully | 116 | ;; function as well as `state' should be careful to fail gracefully |
| 117 | ;; in the event that the backend executable is absent. It is | 117 | ;; in the event that the backend executable is absent. It is |
| 118 | ;; preferable that this function's body is autoloaded, that way only | 118 | ;; preferable that this function's *body* is autoloaded, that way only |
| 119 | ;; calling vc-registered does not cause the backend to be loaded | 119 | ;; calling vc-registered does not cause the backend to be loaded |
| 120 | ;; (all the vc-FOO-registered functions are called to try to find | 120 | ;; (all the vc-FOO-registered functions are called to try to find |
| 121 | ;; the controlling backend for FILE. | 121 | ;; the controlling backend for FILE). |
| 122 | ;; | 122 | ;; |
| 123 | ;; * state (file) | 123 | ;; * state (file) |
| 124 | ;; | 124 | ;; |
| @@ -233,6 +233,7 @@ | |||
| 233 | ;; The implementation should pass the value of vc-register-switches | 233 | ;; The implementation should pass the value of vc-register-switches |
| 234 | ;; to the backend command. (Note: in older versions of VC, this | 234 | ;; to the backend command. (Note: in older versions of VC, this |
| 235 | ;; command took a single file argument and not a list.) | 235 | ;; command took a single file argument and not a list.) |
| 236 | ;; The REV argument is a historical leftover and is never used. | ||
| 236 | ;; | 237 | ;; |
| 237 | ;; - init-revision (file) | 238 | ;; - init-revision (file) |
| 238 | ;; | 239 | ;; |
| @@ -999,7 +1000,7 @@ current buffer." | |||
| 999 | nil) | 1000 | nil) |
| 1000 | (list (vc-backend-for-registration (buffer-file-name)) | 1001 | (list (vc-backend-for-registration (buffer-file-name)) |
| 1001 | (list buffer-file-name)))) | 1002 | (list buffer-file-name)))) |
| 1002 | (t (error "No fileset is available here"))))) | 1003 | (t (error "File is not under version control"))))) |
| 1003 | 1004 | ||
| 1004 | (defun vc-dired-deduce-fileset () | 1005 | (defun vc-dired-deduce-fileset () |
| 1005 | (let ((backend (vc-responsible-backend default-directory))) | 1006 | (let ((backend (vc-responsible-backend default-directory))) |
| @@ -1041,6 +1042,11 @@ current buffer." | |||
| 1041 | (eq p q) | 1042 | (eq p q) |
| 1042 | (and (member p '(edited added removed)) (member q '(edited added removed))))) | 1043 | (and (member p '(edited added removed)) (member q '(edited added removed))))) |
| 1043 | 1044 | ||
| 1045 | (defun vc-read-backend (prompt) | ||
| 1046 | (intern | ||
| 1047 | (completing-read prompt (mapcar 'symbol-name vc-handled-backends) | ||
| 1048 | nil 'require-match))) | ||
| 1049 | |||
| 1044 | ;; Here's the major entry point. | 1050 | ;; Here's the major entry point. |
| 1045 | 1051 | ||
| 1046 | ;;;###autoload | 1052 | ;;;###autoload |
| @@ -1099,8 +1105,9 @@ For old-style locking-based version control systems, like RCS: | |||
| 1099 | ((or (eq state 'up-to-date) (and verbose (eq state 'needs-update))) | 1105 | ((or (eq state 'up-to-date) (and verbose (eq state 'needs-update))) |
| 1100 | (cond | 1106 | (cond |
| 1101 | (verbose | 1107 | (verbose |
| 1102 | ;; go to a different revision | 1108 | ;; Go to a different revision. |
| 1103 | (let* ((revision | 1109 | (let* ((revision |
| 1110 | ;; FIXME: Provide completion. | ||
| 1104 | (read-string "Branch, revision, or backend to move to: ")) | 1111 | (read-string "Branch, revision, or backend to move to: ")) |
| 1105 | (revision-downcase (downcase revision))) | 1112 | (revision-downcase (downcase revision))) |
| 1106 | (if (member | 1113 | (if (member |
| @@ -1161,15 +1168,10 @@ For old-style locking-based version control systems, like RCS: | |||
| 1161 | (message "No files remain to be committed") | 1168 | (message "No files remain to be committed") |
| 1162 | (if (not verbose) | 1169 | (if (not verbose) |
| 1163 | (vc-checkin ready-for-commit backend) | 1170 | (vc-checkin ready-for-commit backend) |
| 1164 | (let* ((revision (read-string "New revision or backend: ")) | 1171 | (let ((new-backend (vc-read-backend "New backend: "))) |
| 1165 | (revision-downcase (downcase revision))) | 1172 | (if new-backend |
| 1166 | (if (member | 1173 | (dolist (file files) |
| 1167 | revision-downcase | 1174 | (vc-transfer-file file new-backend)))))))) |
| 1168 | (mapcar (lambda (arg) (downcase (symbol-name arg))) | ||
| 1169 | vc-handled-backends)) | ||
| 1170 | (let ((vsym (intern revision-downcase))) | ||
| 1171 | (dolist (file files) (vc-transfer-file file vsym))) | ||
| 1172 | (vc-checkin ready-for-commit backend revision))))))) | ||
| 1173 | ;; locked by somebody else (locking VCSes only) | 1175 | ;; locked by somebody else (locking VCSes only) |
| 1174 | ((stringp state) | 1176 | ((stringp state) |
| 1175 | ;; In the old days, we computed the revision once and used it on | 1177 | ;; In the old days, we computed the revision once and used it on |