aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorXue Fuqiao2013-06-12 20:12:47 +0800
committerXue Fuqiao2013-06-12 20:12:47 +0800
commit6186a2767fcae48a43675dabc457ed2b2177b884 (patch)
tree8eb823df7cbd64d9bf9201c03cadd89fe1e441ac /lisp
parent8d0b26f65d9d4cf52a11a273073cd52fb1feaf13 (diff)
parent5f9dbd7a1241239b5376435e96fbd9dbfa65e0f5 (diff)
downloademacs-6186a2767fcae48a43675dabc457ed2b2177b884.tar.gz
emacs-6186a2767fcae48a43675dabc457ed2b2177b884.zip
Merge from mainline.
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog208
-rw-r--r--lisp/ChangeLog.26
-rw-r--r--lisp/allout.el2
-rw-r--r--lisp/cedet/semantic/ctxt.el10
-rw-r--r--lisp/cedet/semantic/decorate/mode.el6
-rw-r--r--lisp/emacs-lisp/cl-loaddefs.el11
-rw-r--r--lisp/emacs-lisp/cl-macs.el42
-rw-r--r--lisp/emacs-lisp/generic.el89
-rw-r--r--lisp/emacs-lisp/lisp-mode.el4
-rw-r--r--lisp/emacs-lisp/package-x.el63
-rw-r--r--lisp/emacs-lisp/package.el378
-rw-r--r--lisp/epa.el27
-rw-r--r--lisp/eshell/em-term.el18
-rw-r--r--lisp/finder.el3
-rw-r--r--lisp/gnus/ChangeLog73
-rw-r--r--lisp/gnus/eww.el349
-rw-r--r--lisp/gnus/mm-view.el20
-rw-r--r--lisp/gnus/shr.el50
-rw-r--r--lisp/gnus/sieve-manage.el248
-rw-r--r--lisp/gnus/sieve.el13
-rw-r--r--lisp/help-fns.el21
-rw-r--r--lisp/help-mode.el4
-rw-r--r--lisp/ibuf-ext.el2
-rw-r--r--lisp/ido.el108
-rw-r--r--lisp/international/mule-conf.el1
-rw-r--r--lisp/international/mule.el2
-rw-r--r--lisp/progmodes/octave.el74
-rw-r--r--lisp/progmodes/prolog.el44
-rw-r--r--lisp/replace.el8
-rw-r--r--lisp/subr.el64
-rw-r--r--lisp/vc/log-view.el11
-rw-r--r--lisp/vc/vc.el28
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 @@
12013-06-12 Xue Fuqiao <xfq.free@gmail.com>
2
3 * ibuf-ext.el (ibuffer-mark-help-buffers): Doc fix.
4
52013-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
102013-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
162013-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
252013-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
412013-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
522013-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
822013-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
1022013-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
1072013-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
1162013-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
1212013-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
1262013-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
1312013-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
1372013-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
12013-06-09 Xue Fuqiao <xfq.free@gmail.com> 1422013-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
72013-06-09 Aidan Gauland <aidalgol@amuri.net> 1472013-06-09 Aidan Gauland <aidalgol@amuri.net>
@@ -12,9 +152,11 @@
122013-06-09 Aidan Gauland <aidalgol@amuri.net> 1522013-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
192013-06-08 Leo Liu <sdl.web@gmail.com> 1612013-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
27272013-04-03 Alan Mackenzie <acm@muc.de> 28692013-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 @@
49542013-01-12 Eli Zaretskii <eliz@gnu.org> 50962013-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
49602013-01-12 Stefan Monnier <monnier@iro.umontreal.ca> 51022013-01-12 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -5037,7 +5179,7 @@
50372013-01-11 Julien Danjou <julien@danjou.info> 51792013-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
50432013-01-11 Dmitry Antipov <dmantipov@yandex.ru> 51852013-01-11 Dmitry Antipov <dmantipov@yandex.ru>
@@ -5491,7 +5633,7 @@
54912012-12-31 Jürgen Hötzel <juergen@archlinux.org> 56332012-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
54962012-12-31 Martin Rudalics <rudalics@gmx.at> 56382012-12-31 Martin Rudalics <rudalics@gmx.at>
5497 5639
@@ -5876,7 +6018,7 @@
5876 6018
58772012-12-14 Paul Eggert <eggert@cs.ucla.edu> 60192012-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
63402012-12-03 Jay Belanger <jay.p.belanger@gmail.com> 64822012-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
70212012-11-17 Chong Yidong <cyd@gnu.org> 71632012-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
70902012-11-16 Glenn Morris <rgm@gnu.org> 72322012-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
75272012-11-06 Dmitry Antipov <dmantipov@yandex.ru> 76692012-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
92812012-09-23 Roland Winkler <winkler@gnu.org> 94232012-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
206882011-10-07 Chong Yidong <cyd@stupidchicken.com> 208302011-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
206932011-10-07 Glenn Morris <rgm@gnu.org> 208352011-10-07 Glenn Morris <rgm@gnu.org>
@@ -26009,15 +26151,15 @@
260092011-05-10 Jim Meyering <meyering@redhat.com> 261512011-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
260222011-05-10 Glenn Morris <rgm@gnu.org> 261642011-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
7781987-12-21 Richard Stallman (rms@frosted-flakes) 7781987-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
7831987-12-09 Richard Stallman (rms@frosted-flakes) 7831987-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
1561substitution string. If it's just a regexp, all its matches are removed 1561substitution string. If it's just a regexp, all its matches are removed
1562before the text is encrypted. If it's a regexp and a substitution, the 1562before the text is encrypted. If it's a regexp and a substitution, the
1563substitution is used against the regexp matches, a la `replace-match'.") 1563substitution 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:
366If the cursor is on 'this', will move point to the ; after entry.") 366If 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.
370This will move past type/field names when applicable. 370This will move past type/field names when applicable.
371Depends on `semantic-type-relation-separator-character', and will 371Depends on `semantic-type-relation-separator-character', and will
372work on C like languages." 372work 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
699KEYWORD can be one of :conc-name, :constructor, :copier, :predicate, 699KEYWORD 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
702Each SLOT may instead take the form (SLOT SLOT-OPTS...), where 702Each SLOT may instead take the form (SNAME SDEFAULT SOPTIONS...), where
703SLOT-OPTS are keyword-value pairs for that slot. Currently, only 703SDEFAULT is the default value of that slot and SOPTIONS are keyword-value
704one keyword is supported, `:read-only'. If this has a non-nil 704pairs for that slot.
705Currently, only one keyword is supported, `:read-only'. If this has a non-nil
705value, that slot cannot be set via `setf'. 706value, 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" "\
728Verify that FORM is of type TYPE; signal an error if not. 731Verify that FORM is of type TYPE; signal an error if not.
729STRING is an optional description of the desired type. 732STRING 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.
584If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level. 584If `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
2276KEYWORD can be one of :conc-name, :constructor, :copier, :predicate, 2276KEYWORD 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
2279Each SLOT may instead take the form (SLOT SLOT-OPTS...), where 2279Each SLOT may instead take the form (SNAME SDEFAULT SOPTIONS...), where
2280SLOT-OPTS are keyword-value pairs for that slot. Currently, only 2280SDEFAULT is the default value of that slot and SOPTIONS are keyword-value
2281one keyword is supported, `:read-only'. If this has a non-nil 2281pairs for that slot.
2282Currently, only one keyword is supported, `:read-only'. If this has a non-nil
2282value, that slot cannot be set via `setf'. 2283value, 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.
2576TYPE is a Common Lisp-style type specifier." 2577TYPE 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
306PREFIX and SUFFIX. Then it returns a construct based on this 322PREFIX and SUFFIX. Then it returns a construct based on this
307regular expression that can be used as an element of 323regular 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.
167PKG-INFO is the package info, see `package-buffer-info'. 169PKG-DESC is the `package-desc'.
168EXTENSION is the file extension, a string. It can be either 170EXTENSION 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.
265This is an alist mapping package names (symbols) to package 267This is an alist mapping package names (symbols) to
266descriptor vectors. These are like the vectors for `package-alist' 268`package--desc' structures.")
267but have extra entries: one which is 'tar for tar packages and
268'single for single-file packages, and one which is the name of
269the 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
322Slots:
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
329the first line of the file.
330
331`reqs' Requirements of the package. A list of (PACKAGE
332VERSION-LIST) naming the dependent package and the minimum
333required version.
334
335`kind' The distribution format of the package. Currently, it is
336either `single' or `tar'.
337
338`archive' The name of the archive (as a string) whence this
339package 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
306function `package-built-in-p'. 361function `package-built-in-p'.
307 362
308Each element has the form (PKG . DESC), where PKG is a package 363Each element has the form (PKG . PACKAGE-BI-DESC), where PKG is a package
309name (a symbol) and DESC is a vector that describes the package. 364name (a symbol) and DESC is a `package--bi-desc' structure.")
310The 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.
320Each element has the form (PKG . DESC), where PKG is a package 369Each element has the form (PKG . DESC), where PKG is a package
321name (a symbol) and DESC is a vector that describes the package. 370name (a symbol) and DESC is a `package-desc' structure.
322
323The 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
330This variable is set automatically by `package-load-descriptor', 372This variable is set automatically by `package-load-descriptor',
331called via `package-initialize'. To change which packages are 373called 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.
341Like `package-alist', but maps package name to a second alist. 383Like `package-alist', but maps package name to a second alist.
342The inner alist is keyed by version.") 384The inner alist is keyed by version.
385
386Each element of the list is (NAME . VERSION-ALIST), where each
387entry 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.
451NAME and VERSION are both strings." 486NAME 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."
525Required package `%s-%s' is unavailable" 565Required 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.
555EXTRA-PROPERTIES is currently unused." 595EXTRA-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.
651PKG-DIR is the name of the package directory." 688PKG-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.
872Also, add the originating archive to the end of the package vector." 923PACKAGE should have the form (NAME . PACKAGE--AC-DESC).
873 (let* ((name (car package)) 924Also, 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.
965The vector has the form
966
967 [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY]
968
969FILENAME is the file name, a string, sans the \".el\" extension.
970REQUIRES is a list of requirements, each requirement having the
971 form (NAME VER); NAME is a string and VER is a version list.
972DESCRIPTION is the package description, a string.
973VERSION is the version, a string.
974COMMENTARY is the commentary section, a string, or nil if none.
975 1023
976If the buffer does not contain a conforming package, signal an 1024If the buffer does not contain a conforming package, signal an
977error. If there is a package, narrow the buffer to the file's 1025error. 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.
1062When called interactively, the current buffer is assumed to be a 1088When called interactively, the current buffer is assumed to be a
1063single .el file that follows the packaging guidelines; see info 1089single .el file that follows the packaging guidelines; see info
1064node `(elisp)Packaging'. 1090node `(elisp)Packaging'.
1065 1091
1066When called from Lisp, PKG-INFO is a vector describing the 1092When called from Lisp, PKG-DESC is a `package-desc' describing the
1067information, of the type returned by `package-buffer-info'; and 1093information)."
1068TYPE 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
1418package PACKAGE with descriptor DESC, add one. The alist is 1440package PACKAGE with descriptor DESC, add one. The alist is
1419keyed with cons cells (PACKAGE . VERSION-LIST), where PACKAGE is 1441keyed with cons cells (PACKAGE . VERSION-LIST), where PACKAGE is
1420a symbol and VERSION-LIST is a version list." 1442a 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.
635If 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
67Commands listed here are run in a term buffer.
68
69See 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
77An 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
81because git shows logs and diffs using a pager by default." 87because git shows logs and diffs using a pager by default.
88
89See 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
99because \"git <command> --help\" shows the command's 107because \"git <command> --help\" shows the command's
100documentation with a pager." 108documentation with a pager.
109
110See 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 @@
12013-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
72013-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
252013-06-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
26
27 * eww.el (eww-tag-input): Support password fields.
28 (eww-submit): Support POST.
29
302013-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
592013-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
682013-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
12013-06-06 Teodor Zlatanov <tzz@lifelogs.com> 742013-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
122NAME names the stream, CHECK is a function returning non-nil if the
123server support the stream and OPEN is a function for opening the
124stream."
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'."
160Must 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.
196Return 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
396If nil, chooses the best stream the server is capable of. 344If nil, chooses the best stream the server is capable of.
397Optional argument BUFFER is buffer (buffer, or string naming buffer) 345Optional argument BUFFER is buffer (buffer, or string naming buffer)
398to work in." 346to 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) 504Set 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))
260Server : " 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. 3418Currently 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 3419The 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 3420created 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, 3421in this list. If DEFAULT is non-nil, and corresponds to an existing buffer,
3418 ;; it is put to the start of the list. 3422it 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, 3465If DEFAULT is non-nil, and corresponds to an element of choices,
3462 ;; it is put to the start of the list. 3466it 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 3523Uses 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 3582If 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. 3594Currently 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 3595The 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 3596created to allow the user to further modify the order of the file names
3593 ;; in this list. 3597in 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 3639If 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 3650The 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 3651created to allow the user to further modify the order of the
3648 ;; directory names in this list. 3652directory 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 3684If optional argument CURRENT is given, restrict searching to the current
3681 ;; current frame, rather than all frames, regardless of value of 3685frame, 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. 3862If `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. 4055If 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'. 4540Modified 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.
1696Each element looks like (REGEXP . CODING-SYSTEM). 1696Each element looks like (REGEXP . CODING-SYSTEM).
1697A file whose name matches REGEXP is decoded by CODING-SYSTEM on reading. 1697A 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.
613For example, for suppressing the startup message and using `traditional' 613For example, for suppressing the startup message and using `traditional'
614mode, set this to (\"-q\" \"--traditional\")." 614mode, 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.
899Use \\[inferior-octave-resync-dirs] to resync if Emacs gets confused." 900Use \\[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.
916This command queries the inferior Octave process about its current 917This command queries the inferior Octave process about its current
917directory and makes this the current buffer's default directory." 918directory 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)))
1523if 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 "\
1724if iskeyword(\"%s\") disp(\"`%s' is a keyword\") else which(\"%s\") endif\n" 1731if 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.
1959If 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
246FROM-STRING has no uppercase letters. Replacement transfers the case 246FROM-STRING has no uppercase letters. Replacement transfers the case
247pattern of the old text to the new text, if `case-replace' and 247pattern 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
249letters. \(Transferring the case pattern means that if the old text 249letters. (Transferring the case pattern means that if the old text
250matched is all caps, or capitalized, then its replacement is upcased 250matched is all caps, or capitalized, then its replacement is upcased
251or capitalized.) 251or capitalized.)
252 252
@@ -1175,8 +1175,8 @@ is called only during interactive use.
1175 1175
1176For example, to check for occurrence of symbol at point use 1176For 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.
44Optional ARGLIST is the argument list used by the function. The 44Optional ARGLIST is the argument list used by the function.
45FILE argument is not used by the byte-compiler, but by the 45The 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
47definition for FN. ARGLIST is used by both the byte-compiler and 47definition for FN. ARGLIST is used by both the byte-compiler
48`check-declare' to check for consistency. 48and `check-declare' to check for consistency.
49 49
50FILE can be either a Lisp file (in which case the \".el\" 50FILE can be either a Lisp file (in which case the \".el\"
51extension is optional), or a C file. C files are expanded 51extension 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.
398INC is the increment used between numbers in the sequence and defaults to 1. 398INC is the increment used between numbers in the sequence and defaults to 1.
399So, the Nth element of the list is \(+ FROM \(* N INC)) where N counts from 399So, the Nth element of the list is (+ FROM (* N INC)) where N counts from
400zero. TO is only included if there is an N for which TO = FROM + N * INC. 400zero. TO is only included if there is an N for which TO = FROM + N * INC.
401If TO is nil or numerically equal to FROM, return \(FROM). 401If TO is nil or numerically equal to FROM, return (FROM).
402If INC is positive and TO is less than FROM, or INC is negative 402If INC is positive and TO is less than FROM, or INC is negative
403and TO is larger than FROM, return nil. 403and TO is larger than FROM, return nil.
404If INC is zero and TO is neither nil nor numerically equal to 404If INC is zero and TO is neither nil nor numerically equal to
@@ -408,11 +408,11 @@ This function is primarily designed for integer arguments.
408Nevertheless, FROM, TO and INC can be integer or float. However, 408Nevertheless, FROM, TO and INC can be integer or float. However,
409floating point arithmetic is inexact. For instance, depending on 409floating point arithmetic is inexact. For instance, depending on
410the machine, it may quite well happen that 410the 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),
412whereas \(number-sequence 0.4 0.8 0.2) returns a list with three 412whereas (number-sequence 0.4 0.8 0.2) returns a list with three
413elements. Thus, if some of the arguments are floats and one wants 413elements. Thus, if some of the arguments are floats and one wants
414to make sure that TO is included, one may have to explicitly write 414to make sure that TO is included, one may have to explicitly write
415TO as \(+ FROM \(* N INC)) or use a variable whose value was 415TO as (+ FROM (* N INC)) or use a variable whose value was
416computed with this exact expression. Alternatively, you can, 416computed with this exact expression. Alternatively, you can,
417of course, also replace TO with a slightly larger value 417of 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
784of characters or event types, and non-ASCII characters with codes 784of characters or event types, and non-ASCII characters with codes
785above 127 (such as ISO Latin-1) can be included if you use a vector. 785above 127 (such as ISO Latin-1) can be included if you use a vector.
786 786
787The binding goes in the current buffer's local map, 787The binding goes in the current buffer's local map, which in most
788which in most cases is shared with all other buffers in the same major mode." 788cases 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
822If you don't specify OLDMAP, you can usually get the same results 822If you don't specify OLDMAP, you can usually get the same results
823in a cleaner way with command remapping, like this: 823in 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.
2542If NEW-NAME exists in `user-emacs-directory', return it. 2542If NEW-NAME exists in `user-emacs-directory', return it.
2543Else If OLD-NAME is non-nil and ~/OLD-NAME exists, return ~/OLD-NAME. 2543Else if OLD-NAME is non-nil and ~/OLD-NAME exists, return ~/OLD-NAME.
2544Else return NEW-NAME in `user-emacs-directory', creating the 2544Else return NEW-NAME in `user-emacs-directory', creating the
2545directory if it does not exist." 2545directory 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
3232This macro will run BODY normally, but doesn't count its buffer 3232This macro will run BODY normally, but doesn't count its buffer
3233modifications as being buffer modifications. This affects things 3233modifications as being buffer modifications. This affects things
3234like buffer-modified-p, checking whether the file is locked by 3234like `buffer-modified-p', checking whether the file is locked by
3235someone else, running buffer modification hooks, and other things 3235someone else, running buffer modification hooks, and other things
3236of that nature. 3236of 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
3537OMIT-NULLS is forced to t. 3537OMIT-NULLS is forced to t.
3538 3538
3539If OMIT-NULLS is t, zero-length substrings are omitted from the list \(so 3539If OMIT-NULLS is t, zero-length substrings are omitted from the list (so
3540that for the default value of SEPARATORS leading and trailing whitespace 3540that for the default value of SEPARATORS leading and trailing whitespace
3541are effectively trimmed). If nil, all zero-length substrings are retained, 3541are effectively trimmed). If nil, all zero-length substrings are retained,
3542which correctly parses CSV format, for example. 3542which correctly parses CSV format, for example.
@@ -3733,18 +3733,18 @@ If FILE is already loaded, evaluate FORM right now.
3733If a matching file is loaded again, FORM will be evaluated again. 3733If a matching file is loaded again, FORM will be evaluated again.
3734 3734
3735If FILE is a string, it may be either an absolute or a relative file 3735If FILE is a string, it may be either an absolute or a relative file
3736name, and may have an extension \(e.g. \".el\") or may lack one, and 3736name, and may have an extension (e.g. \".el\") or may lack one, and
3737additionally may or may not have an extension denoting a compressed 3737additionally may or may not have an extension denoting a compressed
3738format \(e.g. \".gz\"). 3738format (e.g. \".gz\").
3739 3739
3740When FILE is absolute, this first converts it to a true name by chasing 3740When FILE is absolute, this first converts it to a true name by chasing
3741symbolic links. Only a file of this name \(see next paragraph regarding 3741symbolic links. Only a file of this name (see next paragraph regarding
3742extensions) will trigger the evaluation of FORM. When FILE is relative, 3742extensions) will trigger the evaluation of FORM. When FILE is relative,
3743a file whose absolute true name ends in FILE will trigger evaluation. 3743a file whose absolute true name ends in FILE will trigger evaluation.
3744 3744
3745When FILE lacks an extension, a file name with any extension will trigger 3745When FILE lacks an extension, a file name with any extension will trigger
3746evaluation. Otherwise, its extension must match FILE's. A further 3746evaluation. Otherwise, its extension must match FILE's. A further
3747extension for a compressed format \(e.g. \".gz\") on FILE will not affect 3747extension for a compressed format (e.g. \".gz\") on FILE will not affect
3748this name matching. 3748this name matching.
3749 3749
3750Alternatively, FILE can be a feature (i.e. a symbol), in which case FORM 3750Alternatively, 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.
4239If the maximum arity is infinite, MAX is `many'.
4240F can be a function or a macro.
4241If 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.
4265Note that this does NOT take precedence over the \"overriding\" maps 4239Note 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