aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorTom Tromey2013-06-13 11:29:06 -0600
committerTom Tromey2013-06-13 11:29:06 -0600
commit5ccb7e7b1ea2ca7f6e45d00d839e19f22cc961da (patch)
treeaf9b79246f0b18d748c3e1c33b1bb1b33cf1fbe0 /lisp
parent313dfb6277b3e1ef28c7bb76e776f10168e3f0a3 (diff)
parent94fa6ec7b306b47c251f7b8b67662598027a7ff3 (diff)
downloademacs-5ccb7e7b1ea2ca7f6e45d00d839e19f22cc961da.tar.gz
emacs-5ccb7e7b1ea2ca7f6e45d00d839e19f22cc961da.zip
merge from trunk
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog501
-rw-r--r--lisp/ChangeLog.26
-rw-r--r--lisp/Makefile.in5
-rw-r--r--lisp/allout.el2
-rw-r--r--lisp/autorevert.el12
-rw-r--r--lisp/cedet/semantic/ctxt.el10
-rw-r--r--lisp/cedet/semantic/decorate/mode.el6
-rw-r--r--lisp/emacs-lisp/bytecomp.el189
-rw-r--r--lisp/emacs-lisp/cconv.el15
-rw-r--r--lisp/emacs-lisp/cl-lib.el4
-rw-r--r--lisp/emacs-lisp/cl-loaddefs.el11
-rw-r--r--lisp/emacs-lisp/cl-macs.el50
-rw-r--r--lisp/emacs-lisp/edebug.el5
-rw-r--r--lisp/emacs-lisp/generic.el89
-rw-r--r--lisp/emacs-lisp/lisp-mode.el9
-rw-r--r--lisp/emacs-lisp/macroexp.el15
-rw-r--r--lisp/emacs-lisp/package-x.el63
-rw-r--r--lisp/emacs-lisp/package.el378
-rw-r--r--lisp/emacs-lisp/smie.el175
-rw-r--r--lisp/epa.el27
-rw-r--r--lisp/eshell/em-dirs.el4
-rw-r--r--lisp/eshell/em-script.el7
-rw-r--r--lisp/eshell/em-term.el42
-rw-r--r--lisp/eshell/esh-mode.el7
-rw-r--r--lisp/finder.el3
-rw-r--r--lisp/font-lock.el2
-rw-r--r--lisp/gnus/ChangeLog109
-rw-r--r--lisp/gnus/eww.el367
-rw-r--r--lisp/gnus/gnus-art.el104
-rw-r--r--lisp/gnus/gnus-ems.el4
-rw-r--r--lisp/gnus/mm-view.el20
-rw-r--r--lisp/gnus/shr.el56
-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/ibuffer.el4
-rw-r--r--lisp/ido.el108
-rw-r--r--lisp/image-dired.el12
-rw-r--r--lisp/international/mule-conf.el1
-rw-r--r--lisp/international/mule.el2
-rw-r--r--lisp/isearch.el28
-rw-r--r--lisp/loadup.el1
-rw-r--r--lisp/mail/reporter.el8
-rw-r--r--lisp/net/secrets.el57
-rw-r--r--lisp/net/tls.el5
-rw-r--r--lisp/newcomment.el44
-rw-r--r--lisp/progmodes/cc-engine.el4
-rw-r--r--lisp/progmodes/cfengine.el10
-rw-r--r--lisp/progmodes/compile.el6
-rw-r--r--lisp/progmodes/octave.el155
-rw-r--r--lisp/progmodes/perl-mode.el49
-rw-r--r--lisp/progmodes/prog-mode.el119
-rw-r--r--lisp/progmodes/prolog.el44
-rw-r--r--lisp/replace.el8
-rw-r--r--lisp/simple.el28
-rw-r--r--lisp/skeleton.el12
-rw-r--r--lisp/subr.el437
-rw-r--r--lisp/term.el12
-rw-r--r--lisp/textmodes/reftex-cite.el129
-rw-r--r--lisp/textmodes/reftex-parse.el154
-rw-r--r--lisp/vc/log-view.el40
-rw-r--r--lisp/vc/vc-cvs.el2
-rw-r--r--lisp/vc/vc-hooks.el2
-rw-r--r--lisp/vc/vc.el28
66 files changed, 2594 insertions, 1500 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 29c912933c8..2d9fd3f28b4 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,9 +1,412 @@
12013-06-13 Michael Albinus <michael.albinus@gmx.de>
2
3 Implement changes in Secret Service API. Make it backward compatible.
4 * net/secrets.el (secrets-struct-secret-content-type): New defonst.
5 (secrets-create-item): Use it. Prefix properties with interface.
6
72013-06-13 Michael Hoffman <9qobl2n02@sneakemail.com> (tiny change)
8
9 * term.el (term-suppress-hard-newline): New option. (Bug#12017)
10 (term-emulate-terminal): Respect term-suppress-hard-newline.
11
122013-06-13 E Sabof <esabof@gmail.com> (tiny change)
13
14 * image-dired.el (image-dired-dired-toggle-marked-thumbs):
15 Only remove a `thumb-file' overlay. (Bug#14548)
16
172013-06-12 Grégoire Jadi <daimrod@gmail.com>
18
19 * mail/reporter.el (reporter-submit-bug-report):
20 Handle missing package-name. (Bug#14600)
21
222013-06-12 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
23
24 * textmodes/reftex-cite.el (reftex-cite-regexp-hist)
25 (reftex-citation-prompt, reftex-default-bibliography)
26 (reftex-bib-or-thebib, reftex-get-bibfile-list)
27 (reftex-pop-to-bibtex-entry, reftex-extract-bib-entries)
28 (reftex-bib-sort-author, reftex-bib-sort-year)
29 (reftex-bib-sort-year-reverse, reftex-get-crossref-alist)
30 (reftex-extract-bib-entries-from-thebibliography)
31 (reftex-get-bibkey-default, reftex-get-bib-names)
32 (reftex-parse-bibtex-entry, reftex-get-bib-field)
33 (reftex-format-bib-entry, reftex-parse-bibitem)
34 (reftex-format-bibitem, reftex-do-citation)
35 (reftex-figure-out-cite-format, reftex-offer-bib-menu)
36 (reftex-restrict-bib-matches, reftex-extract-bib-file)
37 (reftex-insert-bib-matches, reftex-format-citation)
38 (reftex-make-cite-echo-string, reftex-bibtex-selection-callback)
39 (reftex-create-bibtex-file): Add docstrings, mostly by converting
40 existing comments into docstrings.
41
422013-06-12 Xue Fuqiao <xfq.free@gmail.com>
43
44 * ibuf-ext.el (ibuffer-mark-help-buffers): Doc fix.
45
462013-06-12 Andreas Schwab <schwab@suse.de>
47
48 * international/mule.el (auto-coding-alist): Use utf-8-emacs-unix
49 for auto-save files.
50
512013-06-12 Glenn Morris <rgm@gnu.org>
52
53 * ido.el (ido-delete-ignored-files): Remove.
54 (ido-wide-find-dirs-or-files, ido-make-file-list-1):
55 Go back to calling ido-ignore-item-p directly.
56
572013-06-12 Eyal Lotem <eyal.lotem@gmail.com> (tiny change)
58
59 * ido.el (ido-wide-find-dirs-or-files): Respect ido-case-fold.
60
61 * ido.el (ido-delete-ignored-files): New function,
62 split from ido-make-file-list-1.
63 (ido-wide-find-dirs-or-files): Maybe ignore files. (Bug#13003)
64 (ido-make-file-list-1): Use ido-delete-ignored-files.
65
662013-06-12 Leo Liu <sdl.web@gmail.com>
67
68 * progmodes/octave.el (inferior-octave-startup)
69 (inferior-octave-completion-table)
70 (inferior-octave-track-window-width-change)
71 (octave-eldoc-function-signatures, octave-help)
72 (octave-find-definition): Use single quoted strings.
73 (inferior-octave-startup-args): Change default value.
74 (inferior-octave-startup): Do not hard code "-i" and
75 "--no-line-editing".
76 (inferior-octave-resync-dirs): Add optional arg NOERROR.
77 (inferior-octave-directory-tracker): Use it.
78 (octave-goto-function-definition): Robustify.
79 (octave-help): Support highlighting operators in 'See also'.
80 (octave-find-definition): Find subfunctions only in Octave mode.
81
822013-06-12 Stefan Monnier <monnier@iro.umontreal.ca>
83
84 * help-fns.el (help-fns--compiler-macro): If the handler function is
85 named, then put a link to it.
86 * help-mode.el (help-function-cmacro): Adjust regexp for cl-lib names.
87 * emacs-lisp/cl-macs.el (cl--compiler-macro-typep): New function.
88 (cl-typep): Use it.
89 (cl-eval-when): Simplify debug spec.
90 (cl-define-compiler-macro): Use eval-and-compile. Give a name to the
91 compiler-macro function instead of setting `compiler-macro-file'.
92
932013-06-12 Stefan Monnier <monnier@iro.umontreal.ca>
94 Daniel Hackney <dan@haxney.org>
95
96 First part of Daniel Hackney's patch to package.el.
97 * emacs-lisp/package.el: Use defstruct.
98 (package-desc): New, main struct.
99 (package--bi-desc, package--ac-desc): New structs, used to describe the
100 format in external files.
101 (package-desc-vers): Replace with package-desc-version accessor.
102 (package-desc-doc): Replace with package-desc-summary accessor.
103 (package-activate-1): Remove `package' arg since the pkg-vec now
104 includes the name.
105 (define-package): Use package-desc-from-define.
106 (package-unpack-single): Change file-name arg to be a symbol.
107 (package--add-to-archive-contents): Use package-desc-create and new
108 accessor functions to package--ac-desc.
109 (package-buffer-info, package-tar-file-info): Return a package-desc.
110 (package-install-from-buffer): Remove `type' argument. Change pkg-info
111 arg to be a package-desc.
112 (package-install-file): Adjust accordingly. Use \' to match EOS.
113 (package--from-builtin): New function.
114 (describe-package-1, package-menu--generate): Use it.
115 (package--make-autoloads-and-compile): Change name arg to be a symbol.
116 (package-generate-autoloads): Idem and return the name of the file.
117 * emacs-lisp/package-x.el (package-upload-buffer-internal):
118 Change pkg-info arg to be a package-desc.
119 Use package-make-ac-desc.
120 (package-upload-file): Use \' to match EOS.
121 * finder.el (finder-compile-keywords): Use package-make-builtin.
122
1232013-06-11 Stefan Monnier <monnier@iro.umontreal.ca>
124
125 * vc/vc.el (vc-deduce-fileset): Change error message.
126 (vc-read-backend): New function.
127 (vc-next-action): Use it.
128
129 * subr.el (function-arity): Remove (mistakenly added) (bug#14590).
130
131 * progmodes/prolog.el (prolog-make-keywords-regexp): Remove.
132 (prolog-font-lock-keywords): Use regexp-opt instead.
133 Don't manually highlight strings.
134 (prolog-mode-variables): Simplify comment-start-skip.
135 (prolog-consult-compile): Use display-buffer. Remove unused old-filter.
136
137 * emacs-lisp/generic.el (generic--normalise-comments)
138 (generic-set-comment-syntax, generic-set-comment-vars): New functions.
139 (generic-mode-set-comments): Use them.
140 (generic-bracket-support): Use setq-local.
141 (generic-make-keywords-list): Declare obsolete.
142
1432013-06-11 Glenn Morris <rgm@gnu.org>
144
145 * emacs-lisp/lisp-mode.el (lisp-mode-variables):
146 Prettify after setting font-lock-defaults. (Bug#14574)
147
1482013-06-11 Juanma Barranquero <lekktu@gmail.com>
149
150 * replace.el (query-replace, occur-read-regexp-defaults-function)
151 (replace-search):
152 * subr.el (declare-function, number-sequence, local-set-key)
153 (substitute-key-definition, locate-user-emacs-file)
154 (with-silent-modifications, split-string, eval-after-load):
155 Fix typos, remove unneeded backslashes and reflow some docstrings.
156
1572013-06-11 Stefan Monnier <monnier@iro.umontreal.ca>
158
159 * international/mule-conf.el (file-coding-system-alist): Use utf-8 as
160 default for Elisp files.
161
1622013-06-11 Glenn Morris <rgm@gnu.org>
163
164 * vc/log-view.el (log-view-mode-map): Inherit from special-mode-map,
165 although define-derived-mode was doing this anyway. (Bug#14583)
166
1672013-06-10 Juanma Barranquero <lekktu@gmail.com>
168
169 * allout.el (allout-encryption-plaintext-sanitization-regexps):
170 Fix make-variable-buffer-local call to refer to the correct variable.
171
1722013-06-10 Aidan Gauland <aidalgol@amuri.net>
173
174 * eshell/em-term.el (eshell-visual-commands)
175 (eshell-visual-subcommands, eshell-visual-options):
176 Add summary line to docstrings. Add cross-references.
177
1782013-06-10 Glenn Morris <rgm@gnu.org>
179
180 * epa.el (epa-read-file-name): New function. (Bug#14510)
181 (epa-decrypt-file): Make plain-file optional. Use epa-read-file-name.
182
1832013-06-09 Xue Fuqiao <xfq.free@gmail.com>
184
185 * vc/vc-cvs.el (vc-cvs-stay-local): Doc fix.
186 * vc/vc-hooks.el (vc-stay-local): Doc fix.
187
1882013-06-09 Aidan Gauland <aidalgol@amuri.net>
189
190 * eshell/em-term.el (eshell-visual-command-p): Fix bug that caused
191 output redirection to be ignored with visual commands.
192
1932013-06-09 Aidan Gauland <aidalgol@amuri.net>
194
195 * eshell/em-term.el (eshell-visual-command-p): New function.
196 (eshell-term-initialize): Move long lambda to separate function
197 eshell-visual-command-p.
198 * eshell/em-dirs.el (eshell-dirs-initialise):
199 * eshell/em-script.el (eshell-script-initialize):
200 Add missing #' to lambda.
201
2022013-06-08 Leo Liu <sdl.web@gmail.com>
203
204 * progmodes/octave.el (octave-add-log-current-defun): New function.
205 (octave-mode): Set add-log-current-defun-function.
206 (octave-goto-function-definition): Do not move point if not found.
207 (octave-find-definition): Enhance to try subfunctions first.
208
2092013-06-08 Glenn Morris <rgm@gnu.org>
210
211 * emacs-lisp/bytecomp.el (byte-compile-char-before)
212 (byte-compile-backward-char, byte-compile-backward-word):
213 Improve previous change, to handle non-explicit nil.
214
2152013-06-07 Stefan Monnier <monnier@iro.umontreal.ca>
216
217 * emacs-lisp/smie.el: Improve show-paren-mode behavior.
218 (smie--opener/closer-at-point): New function.
219 (smie--matching-block-data): Use it. Don't match from right after an
220 opener or right before a closer. Obey smie-blink-matching-inners.
221 Don't signal a mismatch for repeated inners like "switch..case..case".
222
2232013-06-07 Leo Liu <sdl.web@gmail.com>
224
225 * progmodes/octave.el (octave-mode): Set comment-use-global-state
226 to t. (Bug#14303)
227 (octave-function-header-regexp): Fix. (Bug#14570)
228 (octave-help-mode-finish-hook, octave-help-mode-finish):
229 Remove. Just use temp-buffer-show-hook.
230
231 * newcomment.el (comment-search-backward): Revert last change.
232 (Bug#14434)
233
234 * emacs-lisp/smie.el (smie--matching-block-data): Minor simplification.
235
2362013-06-07 Eli Zaretskii <eliz@gnu.org>
237
238 * Makefile.in (TAGS TAGS-LISP): Pass the (long) list of *.el files
239 through xargs, to avoid failure due to MS-Windows limitations on
240 command-line length.
241
2422013-06-06 Glenn Morris <rgm@gnu.org>
243
244 * font-lock.el (lisp-font-lock-keywords-2):
245 Treat user-error like error.
246
247 * emacs-lisp/bytecomp.el (byte-compile-char-before)
248 (byte-compile-backward-char, byte-compile-backward-word):
249 Handle explicit nil arguments. (Bug#14565)
250
2512013-06-05 Alan Mackenzie <acm@muc.de>
252
253 * isearch.el (isearch-allow-prefix): New user option.
254 (isearch-other-meta-char): Don't exit isearch when a prefix
255 argument is typed whilst `isearch-allow-prefix' is non-nil.
256 (Bug#9706)
257
2582013-06-05 Stefan Monnier <monnier@iro.umontreal.ca>
259
260 * autorevert.el (auto-revert-notify-handler): Use memq.
261 Hide assertion failure.
262
263 * skeleton.el: Use cl-lib.
264 (skeleton-further-elements): Use defvar-local.
265 (skeleton-insert): Use cl-progv.
266
2672013-06-05 Teodor Zlatanov <tzz@lifelogs.com>
268
269 * progmodes/prog-mode.el (prog-prettify-symbols)
270 (prog-prettify-install): Update docstrings.
271
2722013-06-05 Stefan Monnier <monnier@iro.umontreal.ca>
273
274 * simple.el: Move all the prog-mode code to prog-mode.el.
275 * progmodes/prog-mode.el: New file.
276 * loadup.el: Add prog-mode.el.
277
2782013-06-05 Teodor Zlatanov <tzz@lifelogs.com>
279
280 * simple.el (prog-prettify-symbols): Add version.
281 (prog-prettify-install): Add convenience function to prettify symbols.
282
283 * progmodes/perl-mode.el (perl--augmented-font-lock-keywords)
284 (perl--augmented-font-lock-keywords-1)
285 (perl--augmented-font-lock-keywords-2, perl-mode): Remove unneeded
286 variables and use it.
287
288 * progmodes/cfengine.el (cfengine3--augmented-font-lock-keywords)
289 (cfengine3-mode): Remove unneeded variable and use it.
290
291 * emacs-lisp/lisp-mode.el (lisp--augmented-font-lock-keywords)
292 (lisp--augmented-font-lock-keywords-1)
293 (lisp--augmented-font-lock-keywords-2, lisp-mode-variables):
294 Remove unneeded variables and use it.
295
2962013-06-05 João Távora <joaotavora@gmail.com>
297
298 * net/tls.el (open-tls-stream): Remove unneeded buffer contents up
299 to point when opening the connection. (Bug#14380)
300
3012013-06-05 Stefan Monnier <monnier@iro.umontreal.ca>
302
303 * subr.el (load-history-regexp, load-history-filename-element)
304 (eval-after-load, after-load-functions, do-after-load-evaluation)
305 (eval-next-after-load, display-delayed-warnings)
306 (collapse-delayed-warnings, delayed-warnings-hook): Move after the
307 definition of save-match-data.
308 (overriding-local-map): Remove accidental obsolescence declaration.
309
310 * emacs-lisp/edebug.el (edebug-result): Move before first use.
311
3122013-06-05 Teodor Zlatanov <tzz@lifelogs.com>
313
314 Generalize symbol prettify support to prog-mode and implement it
315 for perl-mode, cfengine3-mode, and emacs-lisp-mode.
316 * simple.el (prog-prettify-symbols-alist, prog-prettify-symbols)
317 (prog--prettify-font-lock-compose-symbol)
318 (prog-prettify-font-lock-symbols-keywords): New variables and
319 functions to support symbol prettification.
320 * emacs-lisp/lisp-mode.el (lisp--augmented-font-lock-keywords)
321 (lisp--augmented-font-lock-keywords-1)
322 (lisp--augmented-font-lock-keywords-2, lisp-mode-variables)
323 (lisp--prettify-symbols-alist): Implement prettify of lambda.
324 * progmodes/cfengine.el (cfengine3--augmented-font-lock-keywords)
325 (cfengine3--prettify-symbols-alist, cfengine3-mode):
326 Implement prettify of -> => :: strings.
327 * progmodes/perl-mode.el (perl-prettify-symbols)
328 (perl--font-lock-compose-symbol)
329 (perl--font-lock-symbols-keywords): Move to prog-mode.
330 (perl--prettify-symbols-alist): Prettify -> => :: strings.
331 (perl-font-lock-keywords-1)
332 (perl-font-lock-keywords-2): Remove explicit prettify support.
333 (perl--augmented-font-lock-keywords)
334 (perl--augmented-font-lock-keywords-1)
335 (perl--augmented-font-lock-keywords-2, perl-mode):
336 Implement prettify support.
337
3382013-06-05 Leo Liu <sdl.web@gmail.com>
339
340 Re-implement smie matching block highlight using
341 show-paren-data-function. (Bug#14395)
342 * emacs-lisp/smie.el (smie-matching-block-highlight)
343 (smie--highlight-matching-block-overlay)
344 (smie--highlight-matching-block-lastpos)
345 (smie-highlight-matching-block)
346 (smie-highlight-matching-block-mode): Remove.
347 (smie--matching-block-data-cache): New variable.
348 (smie--matching-block-data): New function.
349 (smie-setup): Use smie--matching-block-data for
350 show-paren-data-function.
351
352 * progmodes/octave.el (octave-mode-menu): Fix.
353 (octave-find-definition): Skip garbage lines.
354
3552013-06-05 Stefan Monnier <monnier@iro.umontreal.ca>
356
357 Fix compilation error with simultaneous dynamic+lexical scoping.
358 Add warning when a defvar appears after the first let-binding.
359 * emacs-lisp/bytecomp.el (byte-compile-lexical-variables): New var.
360 (byte-compile-close-variables): Initialize it.
361 (byte-compile--declare-var): New function.
362 (byte-compile-file-form-defvar)
363 (byte-compile-file-form-define-abbrev-table)
364 (byte-compile-file-form-custom-declare-variable): Use it.
365 (byte-compile-make-lambda-lexenv): Change the argument. Simplify.
366 (byte-compile-lambda): Share call to byte-compile-arglist-vars.
367 (byte-compile-bind): Handle dynamic bindings that shadow
368 lexical bindings.
369 (byte-compile-unbind): Make arg non-optional.
370 (byte-compile-let): Simplify.
371 * emacs-lisp/cconv.el (byte-compile-lexical-variables): Declare var.
372 (cconv--analyse-function, cconv-analyse-form): Populate it.
373 Protect byte-compile-bound-variables to limit the scope of defvars.
374 (cconv-analyse-form): Add missing rule for (defvar <foo>).
375 Remove unneeded rule for `declare'.
376
377 * emacs-lisp/cl-macs.el (cl--compiler-macro-adjoin): Use macroexp-let2
378 so as to avoid depending on cl-adjoin at run-time.
379 * emacs-lisp/cl-lib.el (cl-pushnew): Use backquotes.
380
381 * emacs-lisp/macroexp.el (macroexp--compiling-p): New function.
382 (macroexp--warn-and-return): Use it.
383
3842013-06-05 Leo Liu <sdl.web@gmail.com>
385
386 * eshell/esh-mode.el (eshell-mode): Fix key bindings.
387
3882013-06-04 Leo Liu <sdl.web@gmail.com>
389
390 * progmodes/compile.el (compile-goto-error): Add optional arg NOMSG.
391 (compilation-auto-jump): Suppress the "Mark set" message to give
392 way to exit message.
393
3942013-06-04 Alan Mackenzie <acm@muc.de>
395
396 Remove faulty optimisation from indentation calculation.
397 * progmodes/cc-engine.el (c-guess-basic-syntax): Don't calculate
398 search limit based on 2000 characters back from indent-point.
399
4002013-06-03 Tassilo Horn <tsdh@gnu.org>
401
402 * eshell/em-term.el (cl-lib): Require `cl-lib'.
403
12013-06-03 Stefan Monnier <monnier@iro.umontreal.ca> 4042013-06-03 Stefan Monnier <monnier@iro.umontreal.ca>
2 405
3 * emacs-lisp/lisp.el: Use lexical-binding. 406 * emacs-lisp/lisp.el: Use lexical-binding.
4 (lisp--local-variables-1, lisp--local-variables): New functions. 407 (lisp--local-variables-1, lisp--local-variables): New functions.
5 (lisp--local-variables-completion-table): New var. 408 (lisp--local-variables-completion-table): New var.
6 (lisp-completion-at-point): Use it to provide completion of let-bound vars. 409 (lisp-completion-at-point): Use it complete let-bound vars.
7 410
8 * emacs-lisp/lisp-mode.el (eval-sexp-add-defvars): Expand macros 411 * emacs-lisp/lisp-mode.el (eval-sexp-add-defvars): Expand macros
9 eagerly (bug#14422). 412 eagerly (bug#14422).
@@ -15,9 +418,9 @@
15 (auto-revert-notify-event-p, auto-revert-notify-event-file-name) 418 (auto-revert-notify-event-p, auto-revert-notify-event-file-name)
16 (auto-revert-notify-handler): Handle also gfilenotify. 419 (auto-revert-notify-handler): Handle also gfilenotify.
17 420
18 * subr.el: (file-notify-handle-event): New defun. Replacing ... 421 * subr.el (file-notify-handle-event): New defun. Replacing ...
19 (inotify-event-p, inotify-handle-event, w32notify-handle-event): 422 (inotify-event-p, inotify-handle-event, w32notify-handle-event):
20 Removed. 423 Remove.
21 424
222013-06-03 Juri Linkov <juri@jurta.org> 4252013-06-03 Juri Linkov <juri@jurta.org>
23 426
@@ -43,10 +446,15 @@
43 446
442013-06-03 Tassilo Horn <tsdh@gnu.org> 4472013-06-03 Tassilo Horn <tsdh@gnu.org>
45 448
46 * eshell/em-term.el (eshell-term-initialize): Use 449 * eshell/em-term.el (eshell-term-initialize):
47 `cl-intersection' rather than `intersection'. 450 Use `cl-intersection' rather than `intersection'.
48 451
492013-06-02 Eric Ludlam <zappo@gnu.org> 4522013-06-02 Xue Fuqiao <xfq.free@gmail.com>
453
454 * vc/log-view.el: Doc fix.
455 (log-view-mode-map): Copy keymap from `special-mode-map'.
456
4572013-06-02 Eric Ludlam <zappo@gnu.org>
50 458
51 * emacs-lisp/eieio.el (eieio--defalias, eieio-hook) 459 * emacs-lisp/eieio.el (eieio--defalias, eieio-hook)
52 (eieio-error-unsupported-class-tags, eieio-skip-typecheck) 460 (eieio-error-unsupported-class-tags, eieio-skip-typecheck)
@@ -93,7 +501,7 @@
93 (eieiomt-optimizing-obarray, eieiomt-install) 501 (eieiomt-optimizing-obarray, eieiomt-install)
94 (eieiomt-add, eieiomt-next, eieiomt-sym-optimize) 502 (eieiomt-add, eieiomt-next, eieiomt-sym-optimize)
95 (eieio-generic-form, eieio-defmethod, make-obsolete) 503 (eieio-generic-form, eieio-defmethod, make-obsolete)
96 (eieio-defgeneric, make-obsolete): Moved to eieio-core.el 504 (eieio-defgeneric, make-obsolete): Move to eieio-core.el
97 (defclass): Remove `eval-and-compile' from macro. 505 (defclass): Remove `eval-and-compile' from macro.
98 (call-next-method, shared-initialize): Instead of using 506 (call-next-method, shared-initialize): Instead of using
99 `scoped-class' variable, use new eieio--scoped-class, and 507 `scoped-class' variable, use new eieio--scoped-class, and
@@ -122,10 +530,10 @@
122 (eshell-find-interpreter): Add new second parameter ARGS. 530 (eshell-find-interpreter): Add new second parameter ARGS.
123 531
124 * eshell/em-script.el (eshell-script-initialize): Add second arg 532 * eshell/em-script.el (eshell-script-initialize): Add second arg
125 to the function added as MATCH to `eshell-interpreter-alist' 533 to the function added as MATCH to `eshell-interpreter-alist'.
126 534
127 * eshell/em-dirs.el (eshell-dirs-initialize): Add second arg to 535 * eshell/em-dirs.el (eshell-dirs-initialize): Add second arg to
128 the function added as MATCH to `eshell-interpreter-alist' 536 the function added as MATCH to `eshell-interpreter-alist'.
129 537
130 * eshell/em-term.el (eshell-visual-subcommands): New defcustom. 538 * eshell/em-term.el (eshell-visual-subcommands): New defcustom.
131 (eshell-visual-options): New defcustom. 539 (eshell-visual-options): New defcustom.
@@ -185,8 +593,8 @@
185 593
1862013-05-31 Dmitry Gutov <dgutov@yandex.ru> 5942013-05-31 Dmitry Gutov <dgutov@yandex.ru>
187 595
188 * progmodes/ruby-mode.el (ruby-syntax-expansion-allowed-p): New 596 * progmodes/ruby-mode.el (ruby-syntax-expansion-allowed-p):
189 function, checks if point is inside a literal that allows 597 New function, checks if point is inside a literal that allows
190 expression expansion. 598 expression expansion.
191 (ruby-syntax-propertize-expansion): Use it. 599 (ruby-syntax-propertize-expansion): Use it.
192 (ruby-syntax-propertize-function): Bind `case-fold-search' to nil 600 (ruby-syntax-propertize-function): Bind `case-fold-search' to nil
@@ -297,7 +705,7 @@
297 * emacs-lisp/trace.el (trace--read-args): Provide a default. 705 * emacs-lisp/trace.el (trace--read-args): Provide a default.
298 706
299 * emacs-lisp/lisp-mode.el (lisp-mode-shared-map): Inherit from 707 * emacs-lisp/lisp-mode.el (lisp-mode-shared-map): Inherit from
300 prog-mode-map. 708 prog-mode-map (bug#14504).
301 709
3022013-05-29 Leo Liu <sdl.web@gmail.com> 7102013-05-29 Leo Liu <sdl.web@gmail.com>
303 711
@@ -329,7 +737,7 @@
329 737
3302013-05-28 Aidan Gauland <aidalgol@amuri.net> 7382013-05-28 Aidan Gauland <aidalgol@amuri.net>
331 739
332 * eshell/em-unix.el: Added -r option to cp 740 * eshell/em-unix.el: Add -r option to cp.
333 741
3342013-05-28 Glenn Morris <rgm@gnu.org> 7422013-05-28 Glenn Morris <rgm@gnu.org>
335 743
@@ -2030,7 +2438,7 @@
2030 2438
2031 * comint.el (comint-dynamic-complete-functions, comint-mode-map): 2439 * comint.el (comint-dynamic-complete-functions, comint-mode-map):
2032 `comint-dynamic-complete' is obsolete since 24.1, replaced by 2440 `comint-dynamic-complete' is obsolete since 24.1, replaced by
2033 `completion-at-point'. (Bug#13774) 2441 `completion-at-point'. (Bug#13774)
2034 2442
2035 * startup.el (normal-no-mouse-startup-screen): Bug fix, the 2443 * startup.el (normal-no-mouse-startup-screen): Bug fix, the
2036 default key binding for `describe-distribution' has been moved to 2444 default key binding for `describe-distribution' has been moved to
@@ -2059,7 +2467,8 @@
2059 2467
2060 * comint.el (comint-redirect-original-filter-function): Remove. 2468 * comint.el (comint-redirect-original-filter-function): Remove.
2061 (comint-redirect-cleanup, comint-redirect-send-command-to-process): 2469 (comint-redirect-cleanup, comint-redirect-send-command-to-process):
2062 * vc/vc-cvs.el (vc-cvs-annotate-process-filter,vc-cvs-annotate-command): 2470 * vc/vc-cvs.el (vc-cvs-annotate-process-filter)
2471 (vc-cvs-annotate-command):
2063 * progmodes/octave-inf.el (inferior-octave-send-list-and-digest): 2472 * progmodes/octave-inf.el (inferior-octave-send-list-and-digest):
2064 * progmodes/prolog.el (prolog-consult-compile): 2473 * progmodes/prolog.el (prolog-consult-compile):
2065 * progmodes/gdb-mi.el (gdb, gdb--check-interpreter): 2474 * progmodes/gdb-mi.el (gdb, gdb--check-interpreter):
@@ -2081,9 +2490,9 @@
20812013-04-19 Masatake YAMATO <yamato@redhat.com> 24902013-04-19 Masatake YAMATO <yamato@redhat.com>
2082 2491
2083 * progmodes/sh-script.el (sh-imenu-generic-expression): 2492 * progmodes/sh-script.el (sh-imenu-generic-expression):
2084 Handle function names with a single character. (Bug#14111) 2493 Handle function names with a single character. (Bug#14111)
2085 2494
20862013-04-19 Dima Kogan <dima@secretsauce.net> (tiny change) 24952013-04-19 Dima Kogan <dima@secretsauce.net> (tiny change)
2087 2496
2088 * progmodes/gud.el (gud-perldb-marker-filter): Understand position info 2497 * progmodes/gud.el (gud-perldb-marker-filter): Understand position info
2089 for subroutines defined in an eval (bug#14182). 2498 for subroutines defined in an eval (bug#14182).
@@ -3193,7 +3602,7 @@
3193 3602
3194 Correct the position of point in some line-up functions. 3603 Correct the position of point in some line-up functions.
3195 * progmodes/cc-align.el (c-lineup-whitesmith-in-block) 3604 * progmodes/cc-align.el (c-lineup-whitesmith-in-block)
3196 (c-lineup-assignments, c-lineup-gcc-asm-reg ): take position of 3605 (c-lineup-assignments, c-lineup-gcc-asm-reg ): Take position of
3197 point at column 0 rather than at a random place in the line. 3606 point at column 0 rather than at a random place in the line.
3198 3607
31992013-03-05 Michael Albinus <michael.albinus@gmx.de> 36082013-03-05 Michael Albinus <michael.albinus@gmx.de>
@@ -4728,7 +5137,7 @@
47282013-01-12 Eli Zaretskii <eliz@gnu.org> 51372013-01-12 Eli Zaretskii <eliz@gnu.org>
4729 5138
4730 * autorevert.el (auto-revert-notify-handler): Fix filtering of 5139 * autorevert.el (auto-revert-notify-handler): Fix filtering of
4731 file notification by ACTION. For filtering by file name, compare 5140 file notification by ACTION. For filtering by file name, compare
4732 only the non-directory part of the file name. 5141 only the non-directory part of the file name.
4733 5142
47342013-01-12 Stefan Monnier <monnier@iro.umontreal.ca> 51432013-01-12 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -4811,7 +5220,7 @@
48112013-01-11 Julien Danjou <julien@danjou.info> 52202013-01-11 Julien Danjou <julien@danjou.info>
4812 5221
4813 * color.el (color-rgb-to-hsv): Fix conversion computing in case min and 5222 * color.el (color-rgb-to-hsv): Fix conversion computing in case min and
4814 max are almost equal. Also return the correct value for V which is 5223 max are almost equal. Also return the correct value for V which is
4815 already between 0 and 1. 5224 already between 0 and 1.
4816 5225
48172013-01-11 Dmitry Antipov <dmantipov@yandex.ru> 52262013-01-11 Dmitry Antipov <dmantipov@yandex.ru>
@@ -5265,7 +5674,7 @@
52652012-12-31 Jürgen Hötzel <juergen@archlinux.org> 56742012-12-31 Jürgen Hötzel <juergen@archlinux.org>
5266 5675
5267 * net/tramp-adb.el (tramp-adb-maybe-open-connection): Handle errors 5676 * net/tramp-adb.el (tramp-adb-maybe-open-connection): Handle errors
5268 (No device connected, invalid device name). (Bug #13299) 5677 (No device connected, invalid device name). (Bug #13299)
5269 5678
52702012-12-31 Martin Rudalics <rudalics@gmx.at> 56792012-12-31 Martin Rudalics <rudalics@gmx.at>
5271 5680
@@ -5650,7 +6059,7 @@
5650 6059
56512012-12-14 Paul Eggert <eggert@cs.ucla.edu> 60602012-12-14 Paul Eggert <eggert@cs.ucla.edu>
5652 6061
5653 Fix permissions bugs with setgid directories etc. (Bug#13125) 6062 Fix permissions bugs with setgid directories etc. (Bug#13125)
5654 * files.el (backup-buffer): Don't rely on 9th output of 6063 * files.el (backup-buffer): Don't rely on 9th output of
5655 file-attributes, as it's now a placeholder. Instead, use the new 6064 file-attributes, as it's now a placeholder. Instead, use the new
5656 optional arg of file-ownership-preserved-p. 6065 optional arg of file-ownership-preserved-p.
@@ -6108,7 +6517,7 @@
6108 * textmodes/ispell.el (ispell-init-process) 6517 * textmodes/ispell.el (ispell-init-process)
6109 (ispell-start-process, ispell-internal-change-dictionary): 6518 (ispell-start-process, ispell-internal-change-dictionary):
6110 Make sure personal dictionary name is expanded after initial 6519 Make sure personal dictionary name is expanded after initial
6111 `default-directory' value. Use expanded strings for 6520 `default-directory' value. Use expanded strings for
6112 keep/restart checks and for value (Bug#13019). 6521 keep/restart checks and for value (Bug#13019).
6113 6522
61142012-12-03 Jay Belanger <jay.p.belanger@gmail.com> 65232012-12-03 Jay Belanger <jay.p.belanger@gmail.com>
@@ -6790,7 +7199,7 @@
6790 7199
6791 * play/gamegrid.el (gamegrid-add-score-with-update-game-score-1): 7200 * play/gamegrid.el (gamegrid-add-score-with-update-game-score-1):
6792 Don't signal an error with a score that is too low to add to the 7201 Don't signal an error with a score that is too low to add to the
6793 list of top scores. (Bug#12779) 7202 list of top scores. (Bug#12779)
6794 7203
67952012-11-17 Chong Yidong <cyd@gnu.org> 72042012-11-17 Chong Yidong <cyd@gnu.org>
6796 7205
@@ -6859,7 +7268,7 @@
6859 7268
6860 * window.el (record-window-buffer) 7269 * window.el (record-window-buffer)
6861 (display-buffer-record-window): When copying the markers to 7270 (display-buffer-record-window): When copying the markers to
6862 window-point preserve window-point-insertion-type. (Bug#12588) 7271 window-point preserve window-point-insertion-type. (Bug#12588)
6863 7272
68642012-11-16 Glenn Morris <rgm@gnu.org> 72732012-11-16 Glenn Morris <rgm@gnu.org>
6865 7274
@@ -6947,8 +7356,8 @@
6947 (ad-advice-definition): Redefine as functions. 7356 (ad-advice-definition): Redefine as functions.
6948 (ad-advice-classes): Move before first use. 7357 (ad-advice-classes): Move before first use.
6949 (ad-make-origname, ad-set-orig-definition, ad-clear-orig-definition) 7358 (ad-make-origname, ad-set-orig-definition, ad-clear-orig-definition)
6950 (ad-make-mapped-call, ad-make-advised-docstring,ad-make-plain-docstring) 7359 (ad-make-mapped-call, ad-make-advised-docstring)
6951 (ad--defalias-fset): Remove functions. 7360 (ad-make-plain-docstring, ad--defalias-fset): Remove functions.
6952 (ad-make-advicefunname, ad-clear-advicefunname-definition): New funs. 7361 (ad-make-advicefunname, ad-clear-advicefunname-definition): New funs.
6953 (ad-get-orig-definition): Rewrite. 7362 (ad-get-orig-definition): Rewrite.
6954 (ad-make-advised-definition-docstring): Change base docstring. 7363 (ad-make-advised-definition-docstring): Change base docstring.
@@ -7200,7 +7609,7 @@
7200 7609
72012012-11-09 Vincent Belaïche <vincentb1@users.sourceforge.net> 76102012-11-09 Vincent Belaïche <vincentb1@users.sourceforge.net>
7202 7611
7203 * ses.el: symbol to coordinate mapping is made by symbol property 7612 * ses.el: Symbol to coordinate mapping is made by symbol property
7204 `ses-cell'. This means that the same mapping is done for all SES 7613 `ses-cell'. This means that the same mapping is done for all SES
7205 sheets. That is good enough for cells with standard A1 names, but 7614 sheets. That is good enough for cells with standard A1 names, but
7206 not for named cell. So a hash map is added for the latter. 7615 not for named cell. So a hash map is added for the latter.
@@ -7296,7 +7705,7 @@
7296 buffer and calls `ispell-buffer' with debugging enabled. 7705 buffer and calls `ispell-buffer' with debugging enabled.
7297 7706
7298 * textmodes/ispell.el (ispell-region): Do not prefix sent string by 7707 * textmodes/ispell.el (ispell-region): Do not prefix sent string by
7299 comment in autoconf mode. (Bug#12768) 7708 comment in autoconf mode. (Bug#12768)
7300 7709
73012012-11-06 Dmitry Antipov <dmantipov@yandex.ru> 77102012-11-06 Dmitry Antipov <dmantipov@yandex.ru>
7302 7711
@@ -8441,13 +8850,13 @@
8441 8850
8442 * textmodes/reftex-cite.el (reftex-create-bibtex-file): Make sure 8851 * textmodes/reftex-cite.el (reftex-create-bibtex-file): Make sure
8443 that entries with whitespace at various places are found. 8852 that entries with whitespace at various places are found.
8444 Doc fix. Include entries that are cross-referenced from cited entries. 8853 Doc fix. Include entries that are cross-referenced from cited entries.
8445 Include @String definitions in the resulting bib file. Add header 8854 Include @String definitions in the resulting bib file. Add header
8446 and footer defined in `reftex-create-bibtex-header' and 8855 and footer defined in `reftex-create-bibtex-header' and
8447 `reftex-create-bibtex-footer'. 8856 `reftex-create-bibtex-footer'.
8448 (reftex-do-citation): Make it possible again to insert 8857 (reftex-do-citation): Make it possible again to insert
8449 non-existent entries. Save match data when asking for optional 8858 non-existent entries. Save match data when asking for optional
8450 arguments. Return all keys, not just the first one. 8859 arguments. Return all keys, not just the first one.
8451 (reftex-all-used-citation-keys): Fix regexp to correctly extract 8860 (reftex-all-used-citation-keys): Fix regexp to correctly extract
8452 all citations in the same line. 8861 all citations in the same line.
8453 (reftex-parse-bibtex-entry): Accept additional optional argument 8862 (reftex-parse-bibtex-entry): Accept additional optional argument
@@ -8507,7 +8916,7 @@
8507 8916
8508 * textmodes/reftex-sel.el 8917 * textmodes/reftex-sel.el
8509 (reftex-select-cycle-ref-style-internal): Adapt to new structure 8918 (reftex-select-cycle-ref-style-internal): Adapt to new structure
8510 of `reftex-ref-style-alist'. Remove code for testing macro type. 8919 of `reftex-ref-style-alist'. Remove code for testing macro type.
8511 (reftex-select-toggle-varioref) 8920 (reftex-select-toggle-varioref)
8512 (reftex-select-toggle-fancyref): Remove. 8921 (reftex-select-toggle-fancyref): Remove.
8513 (reftex-select-cycle-ref-style-internal) 8922 (reftex-select-cycle-ref-style-internal)
@@ -9049,7 +9458,7 @@
9049 9458
9050 * textmodes/bibtex.el (bibtex-autokey-transcriptions): 9459 * textmodes/bibtex.el (bibtex-autokey-transcriptions):
9051 Transcribe also LaTeX hyphenation. 9460 Transcribe also LaTeX hyphenation.
9052 (bibtex-reformat): Bug fix. Do not quote twice the elements of 9461 (bibtex-reformat): Bug fix. Do not quote twice the elements of
9053 bibtex-reformat-previous-options. 9462 bibtex-reformat-previous-options.
9054 9463
90552012-09-23 Roland Winkler <winkler@gnu.org> 94642012-09-23 Roland Winkler <winkler@gnu.org>
@@ -11135,7 +11544,7 @@
11135 * progmodes/python.el (python-shell-send-setup-max-wait): Delete var. 11544 * progmodes/python.el (python-shell-send-setup-max-wait): Delete var.
11136 (python-shell-make-comint): accept-process-output at startup. 11545 (python-shell-make-comint): accept-process-output at startup.
11137 (run-python-internal): Set inferior-python-mode-hook to nil. 11546 (run-python-internal): Set inferior-python-mode-hook to nil.
11138 (python-shell-internal-get-or-create-process): call sit-for. 11547 (python-shell-internal-get-or-create-process): Call sit-for.
11139 (python-preoutput-result): Add obsolete alias. 11548 (python-preoutput-result): Add obsolete alias.
11140 (python-shell-internal-send-string): Use it. 11549 (python-shell-internal-send-string): Use it.
11141 (python-shell-send-setup-code): Remove call to 11550 (python-shell-send-setup-code): Remove call to
@@ -11327,7 +11736,7 @@
113272012-07-27 Fabián Ezequiel Gallina <fgallina@cuca> 117362012-07-27 Fabián Ezequiel Gallina <fgallina@cuca>
11328 11737
11329 Consistent completion in inferior python with emacs -nw. 11738 Consistent completion in inferior python with emacs -nw.
11330 * progmodes/python.el (inferior-python-mode): replace "<tab>" 11739 * progmodes/python.el (inferior-python-mode): Replace "<tab>"
11331 binding in inferior-python-mode-map with "\t". 11740 binding in inferior-python-mode-map with "\t".
11332 (python-shell-completion-complete-at-point) 11741 (python-shell-completion-complete-at-point)
11333 (python-completion-complete-at-point): Remove interactive spec. 11742 (python-completion-complete-at-point): Remove interactive spec.
@@ -12076,7 +12485,7 @@
12076 (xml-name-start-char-re, xml-name-char-re, xml-name-re) 12485 (xml-name-start-char-re, xml-name-char-re, xml-name-re)
12077 (xml-names-re, xml-nmtoken-re, xml-nmtokens-re, xml-char-ref-re) 12486 (xml-names-re, xml-nmtoken-re, xml-nmtokens-re, xml-char-ref-re)
12078 (xml-entity-ref, xml-pe-reference-re) 12487 (xml-entity-ref, xml-pe-reference-re)
12079 (xml-reference-re,xml-att-value-re, xml-tokenized-type-re) 12488 (xml-reference-re, xml-att-value-re, xml-tokenized-type-re)
12080 (xml-notation-type-re, xml-enumeration-re, xml-enumerated-type-re) 12489 (xml-notation-type-re, xml-enumeration-re, xml-enumerated-type-re)
12081 (xml-att-type-re, xml-default-decl-re, xml-att-def-re) 12490 (xml-att-type-re, xml-default-decl-re, xml-att-def-re)
12082 (xml-entity-value-re): Use syntax references in regexps where 12491 (xml-entity-value-re): Use syntax references in regexps where
@@ -18891,8 +19300,8 @@
18891 19300
18892 * progmodes/verilog-mode.el (verilog-read-defines): Fix reading 19301 * progmodes/verilog-mode.el (verilog-read-defines): Fix reading
18893 parameters with embedded comments. Reported by Ray Stevens. 19302 parameters with embedded comments. Reported by Ray Stevens.
18894 (verilog-calc-1, verilog-fork-wait-re) (verilog-forward-sexp, 19303 (verilog-calc-1, verilog-fork-wait-re, verilog-forward-sexp)
18895 verilog-wait-fork-re): Fix indentation of "wait fork", bug407. 19304 (verilog-wait-fork-re): Fix indentation of "wait fork", bug407.
18896 Reported by Tim Holt. 19305 Reported by Tim Holt.
18897 (verilog-auto): Fix AUTOing a upper module then AUTOing module 19306 (verilog-auto): Fix AUTOing a upper module then AUTOing module
18898 instantiated by upper module causing wrong expansion until AUTOed a 19307 instantiated by upper module causing wrong expansion until AUTOed a
@@ -20461,7 +20870,7 @@
20461 20870
204622011-10-07 Chong Yidong <cyd@stupidchicken.com> 208712011-10-07 Chong Yidong <cyd@stupidchicken.com>
20463 20872
20464 * bindings.el ([M-left],[M-right]): Bind to left-word and 20873 * bindings.el ([M-left], [M-right]): Bind to left-word and
20465 right-word respectively. 20874 right-word respectively.
20466 20875
204672011-10-07 Glenn Morris <rgm@gnu.org> 208762011-10-07 Glenn Morris <rgm@gnu.org>
@@ -25783,15 +26192,15 @@
257832011-05-10 Jim Meyering <meyering@redhat.com> 261922011-05-10 Jim Meyering <meyering@redhat.com>
25784 26193
25785 Fix doubled-word typos. 26194 Fix doubled-word typos.
25786 * international/quail.el (quail-insert-kbd-layout): and and -> and 26195 * international/quail.el (quail-insert-kbd-layout): and and -> and.
25787 * kermit.el: and and -> and 26196 * kermit.el: and and -> and.
25788 * net/ldap.el (ldap-search-internal): to to -> to 26197 * net/ldap.el (ldap-search-internal): to to -> to.
25789 * progmodes/vhdl-mode.el (vhdl-offsets-alist): Likewise. 26198 * progmodes/vhdl-mode.el (vhdl-offsets-alist): Likewise.
25790 * progmodes/js.el (js-mode): and and -> and 26199 * progmodes/js.el (js-mode): and and -> and.
25791 * textmodes/artist.el (artist-move-to-xy): at at -> at 26200 * textmodes/artist.el (artist-move-to-xy): at at -> at.
25792 (artist-draw-region-trim-line-endings): if if -> if 26201 (artist-draw-region-trim-line-endings): if if -> if.
25793 And Safetyc -> Safety. 26202 And Safetyc -> Safety.
25794 * textmodes/reftex-dcr.el (reftex-view-crossref): at at -> at a 26203 * textmodes/reftex-dcr.el (reftex-view-crossref): at at -> at a.
25795 26204
257962011-05-10 Glenn Morris <rgm@gnu.org> 262052011-05-10 Glenn Morris <rgm@gnu.org>
25797 Stefan Monnier <monnier@iro.umontreal.ca> 26206 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/Makefile.in b/lisp/Makefile.in
index 4884213daeb..61449b66c9b 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -209,8 +209,9 @@ update-authors:
209 $(emacs) -l authors -f batch-update-authors $(top_srcdir)/etc/AUTHORS $(top_srcdir) 209 $(emacs) -l authors -f batch-update-authors $(top_srcdir)/etc/AUTHORS $(top_srcdir)
210 210
211TAGS TAGS-LISP: $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptagsfiles4) 211TAGS TAGS-LISP: $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptagsfiles4)
212 els=`echo $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptagsfiles4) | sed -e "s,$(lisp)/[^ ]*loaddefs[^ ]*,," -e "s,$(lisp)/ldefs-boot[^ ]*,,"`; \ 212 rm -f $@; touch $@; \
213 ${ETAGS} -o $@ $$els 213 echo $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptagsfiles4) | sed -e "s,$(lisp)/[^ ]*loaddefs[^ ]*,," -e "s,$(lisp)/ldefs-boot[^ ]*,," | \
214 xargs $(XARGS_LIMIT) ${ETAGS} -a -o $@
214 215
215# The src/Makefile.in has its own set of dependencies and when they decide 216# The src/Makefile.in has its own set of dependencies and when they decide
216# that one Lisp file needs to be re-compiled, we had better recompile it as 217# that one Lisp file needs to be re-compiled, we had better recompile it as
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/autorevert.el b/lisp/autorevert.el
index 90dda93a166..4a6d4cb4cc0 100644
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -578,7 +578,7 @@ will use an up-to-date value of `auto-revert-interval'"
578 ((featurep 'w32notify) (nth 2 event))))) 578 ((featurep 'w32notify) (nth 2 event)))))
579 579
580(defun auto-revert-notify-handler (event) 580(defun auto-revert-notify-handler (event)
581 "Handle an event returned from file notification." 581 "Handle an EVENT returned from file notification."
582 (when (auto-revert-notify-event-p event) 582 (when (auto-revert-notify-event-p event)
583 (let* ((descriptor (auto-revert-notify-event-descriptor event)) 583 (let* ((descriptor (auto-revert-notify-event-descriptor event))
584 (action (auto-revert-notify-event-action event)) 584 (action (auto-revert-notify-event-action event))
@@ -591,10 +591,12 @@ will use an up-to-date value of `auto-revert-interval'"
591 (cl-assert descriptor) 591 (cl-assert descriptor)
592 (cond 592 (cond
593 ((featurep 'gfilenotify) 593 ((featurep 'gfilenotify)
594 (cl-assert (or (eq 'attribute-changed action) 594 (cl-assert (memq action '(attribute-changed changed created deleted
595 (eq 'changed action) 595 ;; FIXME: I keep getting this action, so I
596 (eq 'created action) 596 ;; added it here, but I have no idea what
597 (eq 'deleted action)))) 597 ;; I'm doing. --Stef
598 changes-done-hint))
599 t))
598 ((featurep 'inotify) 600 ((featurep 'inotify)
599 (cl-assert (or (memq 'attrib action) 601 (cl-assert (or (memq 'attrib action)
600 (memq 'create action) 602 (memq 'create action)
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/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index c910acdbc14..e603f76f41d 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -411,6 +411,9 @@ specify different fields to sort on."
411(defvar byte-compile-bound-variables nil 411(defvar byte-compile-bound-variables nil
412 "List of dynamic variables bound in the context of the current form. 412 "List of dynamic variables bound in the context of the current form.
413This list lives partly on the stack.") 413This list lives partly on the stack.")
414(defvar byte-compile-lexical-variables nil
415 "List of variables that have been treated as lexical.
416Filled in `cconv-analyse-form' but initialized and consulted here.")
414(defvar byte-compile-const-variables nil 417(defvar byte-compile-const-variables nil
415 "List of variables declared as constants during compilation of this file.") 418 "List of variables declared as constants during compilation of this file.")
416(defvar byte-compile-free-references) 419(defvar byte-compile-free-references)
@@ -1489,6 +1492,7 @@ extra args."
1489 (byte-compile--outbuffer nil) 1492 (byte-compile--outbuffer nil)
1490 (byte-compile-function-environment nil) 1493 (byte-compile-function-environment nil)
1491 (byte-compile-bound-variables nil) 1494 (byte-compile-bound-variables nil)
1495 (byte-compile-lexical-variables nil)
1492 (byte-compile-const-variables nil) 1496 (byte-compile-const-variables nil)
1493 (byte-compile-free-references nil) 1497 (byte-compile-free-references nil)
1494 (byte-compile-free-assignments nil) 1498 (byte-compile-free-assignments nil)
@@ -2245,15 +2249,24 @@ list that represents a doc string reference.
2245 2249
2246(put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar) 2250(put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar)
2247(put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar) 2251(put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar)
2248(defun byte-compile-file-form-defvar (form) 2252
2249 (when (and (symbolp (nth 1 form)) 2253(defun byte-compile--declare-var (sym)
2250 (not (string-match "[-*/:$]" (symbol-name (nth 1 form)))) 2254 (when (and (symbolp sym)
2255 (not (string-match "[-*/:$]" (symbol-name sym)))
2251 (byte-compile-warning-enabled-p 'lexical)) 2256 (byte-compile-warning-enabled-p 'lexical))
2252 (byte-compile-warn "global/dynamic var `%s' lacks a prefix" 2257 (byte-compile-warn "global/dynamic var `%s' lacks a prefix"
2253 (nth 1 form))) 2258 sym))
2254 (push (nth 1 form) byte-compile-bound-variables) 2259 (when (memq sym byte-compile-lexical-variables)
2255 (if (eq (car form) 'defconst) 2260 (setq byte-compile-lexical-variables
2256 (push (nth 1 form) byte-compile-const-variables)) 2261 (delq sym byte-compile-lexical-variables))
2262 (byte-compile-warn "Variable `%S' declared after its first use" sym))
2263 (push sym byte-compile-bound-variables))
2264
2265(defun byte-compile-file-form-defvar (form)
2266 (let ((sym (nth 1 form)))
2267 (byte-compile--declare-var sym)
2268 (if (eq (car form) 'defconst)
2269 (push sym byte-compile-const-variables)))
2257 (if (and (null (cddr form)) ;No `value' provided. 2270 (if (and (null (cddr form)) ;No `value' provided.
2258 (eq (car form) 'defvar)) ;Just a declaration. 2271 (eq (car form) 'defvar)) ;Just a declaration.
2259 nil 2272 nil
@@ -2267,7 +2280,7 @@ list that represents a doc string reference.
2267 'byte-compile-file-form-define-abbrev-table) 2280 'byte-compile-file-form-define-abbrev-table)
2268(defun byte-compile-file-form-define-abbrev-table (form) 2281(defun byte-compile-file-form-define-abbrev-table (form)
2269 (if (eq 'quote (car-safe (car-safe (cdr form)))) 2282 (if (eq 'quote (car-safe (car-safe (cdr form))))
2270 (push (car-safe (cdr (cadr form))) byte-compile-bound-variables)) 2283 (byte-compile--declare-var (car-safe (cdr (cadr form)))))
2271 (byte-compile-keep-pending form)) 2284 (byte-compile-keep-pending form))
2272 2285
2273(put 'custom-declare-variable 'byte-hunk-handler 2286(put 'custom-declare-variable 'byte-hunk-handler
@@ -2275,7 +2288,7 @@ list that represents a doc string reference.
2275(defun byte-compile-file-form-custom-declare-variable (form) 2288(defun byte-compile-file-form-custom-declare-variable (form)
2276 (when (byte-compile-warning-enabled-p 'callargs) 2289 (when (byte-compile-warning-enabled-p 'callargs)
2277 (byte-compile-nogroup-warn form)) 2290 (byte-compile-nogroup-warn form))
2278 (push (nth 1 (nth 1 form)) byte-compile-bound-variables) 2291 (byte-compile--declare-var (nth 1 (nth 1 form)))
2279 (byte-compile-keep-pending form)) 2292 (byte-compile-keep-pending form))
2280 2293
2281(put 'require 'byte-hunk-handler 'byte-compile-file-form-require) 2294(put 'require 'byte-hunk-handler 'byte-compile-file-form-require)
@@ -2576,19 +2589,16 @@ If FORM is a lambda or a macro, byte-compile it as a function."
2576 "Return a list of the variables in the lambda argument list ARGLIST." 2589 "Return a list of the variables in the lambda argument list ARGLIST."
2577 (remq '&rest (remq '&optional arglist))) 2590 (remq '&rest (remq '&optional arglist)))
2578 2591
2579(defun byte-compile-make-lambda-lexenv (form) 2592(defun byte-compile-make-lambda-lexenv (args)
2580 "Return a new lexical environment for a lambda expression FORM." 2593 "Return a new lexical environment for a lambda expression FORM."
2581 ;; See if this is a closure or not 2594 (let* ((lexenv nil)
2582 (let ((args (byte-compile-arglist-vars (cadr form)))) 2595 (stackpos 0))
2583 (let ((lexenv nil)) 2596 ;; Add entries for each argument.
2584 ;; Fill in the initial stack contents 2597 (dolist (arg args)
2585 (let ((stackpos 0)) 2598 (push (cons arg stackpos) lexenv)
2586 ;; Add entries for each argument 2599 (setq stackpos (1+ stackpos)))
2587 (dolist (arg args) 2600 ;; Return the new lexical environment.
2588 (push (cons arg stackpos) lexenv) 2601 lexenv))
2589 (setq stackpos (1+ stackpos)))
2590 ;; Return the new lexical environment
2591 lexenv))))
2592 2602
2593(defun byte-compile-make-args-desc (arglist) 2603(defun byte-compile-make-args-desc (arglist)
2594 (let ((mandatory 0) 2604 (let ((mandatory 0)
@@ -2626,9 +2636,9 @@ for symbols generated by the byte compiler itself."
2626 (byte-compile-set-symbol-position 'lambda)) 2636 (byte-compile-set-symbol-position 'lambda))
2627 (byte-compile-check-lambda-list (nth 1 fun)) 2637 (byte-compile-check-lambda-list (nth 1 fun))
2628 (let* ((arglist (nth 1 fun)) 2638 (let* ((arglist (nth 1 fun))
2639 (arglistvars (byte-compile-arglist-vars arglist))
2629 (byte-compile-bound-variables 2640 (byte-compile-bound-variables
2630 (append (and (not lexical-binding) 2641 (append (if (not lexical-binding) arglistvars)
2631 (byte-compile-arglist-vars arglist))
2632 byte-compile-bound-variables)) 2642 byte-compile-bound-variables))
2633 (body (cdr (cdr fun))) 2643 (body (cdr (cdr fun)))
2634 (doc (if (stringp (car body)) 2644 (doc (if (stringp (car body))
@@ -2676,7 +2686,8 @@ for symbols generated by the byte compiler itself."
2676 ;; args (since lambda expressions should be 2686 ;; args (since lambda expressions should be
2677 ;; closed by now). 2687 ;; closed by now).
2678 (and lexical-binding 2688 (and lexical-binding
2679 (byte-compile-make-lambda-lexenv fun)) 2689 (byte-compile-make-lambda-lexenv
2690 arglistvars))
2680 reserved-csts))) 2691 reserved-csts)))
2681 ;; Build the actual byte-coded function. 2692 ;; Build the actual byte-coded function.
2682 (cl-assert (eq 'byte-code (car-safe compiled))) 2693 (cl-assert (eq 'byte-code (car-safe compiled)))
@@ -3435,32 +3446,38 @@ discarding."
3435(byte-defop-compiler (/ byte-quo) byte-compile-quo) 3446(byte-defop-compiler (/ byte-quo) byte-compile-quo)
3436(byte-defop-compiler nconc) 3447(byte-defop-compiler nconc)
3437 3448
3449;; Is this worth it? Both -before and -after are written in C.
3438(defun byte-compile-char-before (form) 3450(defun byte-compile-char-before (form)
3439 (cond ((= 2 (length form)) 3451 (cond ((or (= 1 (length form))
3452 (and (= 2 (length form)) (not (nth 1 form))))
3453 (byte-compile-form '(char-after (1- (point)))))
3454 ((= 2 (length form))
3440 (byte-compile-form (list 'char-after (if (numberp (nth 1 form)) 3455 (byte-compile-form (list 'char-after (if (numberp (nth 1 form))
3441 (1- (nth 1 form)) 3456 (1- (nth 1 form))
3442 `(1- ,(nth 1 form)))))) 3457 `(1- (or ,(nth 1 form)
3443 ((= 1 (length form)) 3458 (point)))))))
3444 (byte-compile-form '(char-after (1- (point)))))
3445 (t (byte-compile-subr-wrong-args form "0-1")))) 3459 (t (byte-compile-subr-wrong-args form "0-1"))))
3446 3460
3447;; backward-... ==> forward-... with negated argument. 3461;; backward-... ==> forward-... with negated argument.
3462;; Is this worth it? Both -backward and -forward are written in C.
3448(defun byte-compile-backward-char (form) 3463(defun byte-compile-backward-char (form)
3449 (cond ((= 2 (length form)) 3464 (cond ((or (= 1 (length form))
3465 (and (= 2 (length form)) (not (nth 1 form))))
3466 (byte-compile-form '(forward-char -1)))
3467 ((= 2 (length form))
3450 (byte-compile-form (list 'forward-char (if (numberp (nth 1 form)) 3468 (byte-compile-form (list 'forward-char (if (numberp (nth 1 form))
3451 (- (nth 1 form)) 3469 (- (nth 1 form))
3452 `(- ,(nth 1 form)))))) 3470 `(- (or ,(nth 1 form) 1))))))
3453 ((= 1 (length form))
3454 (byte-compile-form '(forward-char -1)))
3455 (t (byte-compile-subr-wrong-args form "0-1")))) 3471 (t (byte-compile-subr-wrong-args form "0-1"))))
3456 3472
3457(defun byte-compile-backward-word (form) 3473(defun byte-compile-backward-word (form)
3458 (cond ((= 2 (length form)) 3474 (cond ((or (= 1 (length form))
3475 (and (= 2 (length form)) (not (nth 1 form))))
3476 (byte-compile-form '(forward-word -1)))
3477 ((= 2 (length form))
3459 (byte-compile-form (list 'forward-word (if (numberp (nth 1 form)) 3478 (byte-compile-form (list 'forward-word (if (numberp (nth 1 form))
3460 (- (nth 1 form)) 3479 (- (nth 1 form))
3461 `(- ,(nth 1 form)))))) 3480 `(- (or ,(nth 1 form) 1))))))
3462 ((= 1 (length form))
3463 (byte-compile-form '(forward-word -1)))
3464 (t (byte-compile-subr-wrong-args form "0-1")))) 3481 (t (byte-compile-subr-wrong-args form "0-1"))))
3465 3482
3466(defun byte-compile-list (form) 3483(defun byte-compile-list (form)
@@ -3862,9 +3879,8 @@ that suppresses all warnings during execution of BODY."
3862 "Emit byte-codes to push the initialization value for CLAUSE on the stack. 3879 "Emit byte-codes to push the initialization value for CLAUSE on the stack.
3863Return the offset in the form (VAR . OFFSET)." 3880Return the offset in the form (VAR . OFFSET)."
3864 (let* ((var (if (consp clause) (car clause) clause))) 3881 (let* ((var (if (consp clause) (car clause) clause)))
3865 ;; We record the stack position even of dynamic bindings and 3882 ;; We record the stack position even of dynamic bindings; we'll put
3866 ;; variables in non-stack lexical environments; we'll put 3883 ;; them in the proper place later.
3867 ;; them in the proper place below.
3868 (prog1 (cons var byte-compile-depth) 3884 (prog1 (cons var byte-compile-depth)
3869 (if (consp clause) 3885 (if (consp clause)
3870 (byte-compile-form (cadr clause)) 3886 (byte-compile-form (cadr clause))
@@ -3882,33 +3898,41 @@ Return the offset in the form (VAR . OFFSET)."
3882INIT-LEXENV should be a lexical-environment alist describing the 3898INIT-LEXENV should be a lexical-environment alist describing the
3883positions of the init value that have been pushed on the stack. 3899positions of the init value that have been pushed on the stack.
3884Return non-nil if the TOS value was popped." 3900Return non-nil if the TOS value was popped."
3885 ;; The presence of lexical bindings mean that we may have to 3901 ;; The mix of lexical and dynamic bindings mean that we may have to
3886 ;; juggle things on the stack, to move them to TOS for 3902 ;; juggle things on the stack, to move them to TOS for
3887 ;; dynamic binding. 3903 ;; dynamic binding.
3888 (cond ((not (byte-compile-not-lexical-var-p var)) 3904 (if (and lexical-binding (not (byte-compile-not-lexical-var-p var)))
3889 ;; VAR is a simple stack-allocated lexical variable 3905 ;; VAR is a simple stack-allocated lexical variable.
3890 (push (assq var init-lexenv) 3906 (progn (push (assq var init-lexenv)
3891 byte-compile--lexical-environment) 3907 byte-compile--lexical-environment)
3892 nil) 3908 nil)
3893 ((eq var (caar init-lexenv)) 3909 ;; VAR should be dynamically bound.
3894 ;; VAR is dynamic and is on the top of the 3910 (while (assq var byte-compile--lexical-environment)
3895 ;; stack, so we can just bind it like usual 3911 ;; This dynamic binding shadows a lexical binding.
3896 (byte-compile-dynamic-variable-bind var) 3912 (setq byte-compile--lexical-environment
3897 t) 3913 (remq (assq var byte-compile--lexical-environment)
3898 (t 3914 byte-compile--lexical-environment)))
3899 ;; VAR is dynamic, but we have to get its 3915 (cond
3900 ;; value out of the middle of the stack 3916 ((eq var (caar init-lexenv))
3901 (let ((stack-pos (cdr (assq var init-lexenv)))) 3917 ;; VAR is dynamic and is on the top of the
3902 (byte-compile-stack-ref stack-pos) 3918 ;; stack, so we can just bind it like usual.
3903 (byte-compile-dynamic-variable-bind var) 3919 (byte-compile-dynamic-variable-bind var)
3904 ;; Now we have to store nil into its temporary 3920 t)
3905 ;; stack position to avoid problems with GC 3921 (t
3906 (byte-compile-push-constant nil) 3922 ;; VAR is dynamic, but we have to get its
3907 (byte-compile-stack-set stack-pos)) 3923 ;; value out of the middle of the stack.
3908 nil))) 3924 (let ((stack-pos (cdr (assq var init-lexenv))))
3909 3925 (byte-compile-stack-ref stack-pos)
3910(defun byte-compile-unbind (clauses init-lexenv 3926 (byte-compile-dynamic-variable-bind var)
3911 &optional preserve-body-value) 3927 ;; Now we have to store nil into its temporary
3928 ;; stack position so it doesn't prevent the value from being GC'd.
3929 ;; FIXME: Not worth the trouble.
3930 ;; (byte-compile-push-constant nil)
3931 ;; (byte-compile-stack-set stack-pos)
3932 )
3933 nil))))
3934
3935(defun byte-compile-unbind (clauses init-lexenv preserve-body-value)
3912 "Emit byte-codes to unbind the variables bound by CLAUSES. 3936 "Emit byte-codes to unbind the variables bound by CLAUSES.
3913CLAUSES is a `let'-style variable binding list. INIT-LEXENV should be a 3937CLAUSES is a `let'-style variable binding list. INIT-LEXENV should be a
3914lexical-environment alist describing the positions of the init value that 3938lexical-environment alist describing the positions of the init value that
@@ -3916,7 +3940,7 @@ have been pushed on the stack. If PRESERVE-BODY-VALUE is true,
3916then an additional value on the top of the stack, above any lexical binding 3940then an additional value on the top of the stack, above any lexical binding
3917slots, is preserved, so it will be on the top of the stack after all 3941slots, is preserved, so it will be on the top of the stack after all
3918binding slots have been popped." 3942binding slots have been popped."
3919 ;; Unbind dynamic variables 3943 ;; Unbind dynamic variables.
3920 (let ((num-dynamic-bindings 0)) 3944 (let ((num-dynamic-bindings 0))
3921 (dolist (clause clauses) 3945 (dolist (clause clauses)
3922 (unless (assq (if (consp clause) (car clause) clause) 3946 (unless (assq (if (consp clause) (car clause) clause)
@@ -3927,14 +3951,15 @@ binding slots have been popped."
3927 ;; Pop lexical variables off the stack, possibly preserving the 3951 ;; Pop lexical variables off the stack, possibly preserving the
3928 ;; return value of the body. 3952 ;; return value of the body.
3929 (when init-lexenv 3953 (when init-lexenv
3930 ;; INIT-LEXENV contains all init values left on the stack 3954 ;; INIT-LEXENV contains all init values left on the stack.
3931 (byte-compile-discard (length init-lexenv) preserve-body-value))) 3955 (byte-compile-discard (length init-lexenv) preserve-body-value)))
3932 3956
3933(defun byte-compile-let (form) 3957(defun byte-compile-let (form)
3934 "Generate code for the `let' form FORM." 3958 "Generate code for the `let' or `let*' form FORM."
3935 (let ((clauses (cadr form)) 3959 (let ((clauses (cadr form))
3936 (init-lexenv nil)) 3960 (init-lexenv nil)
3937 (when (eq (car form) 'let) 3961 (is-let (eq (car form) 'let)))
3962 (when is-let
3938 ;; First compute the binding values in the old scope. 3963 ;; First compute the binding values in the old scope.
3939 (dolist (var clauses) 3964 (dolist (var clauses)
3940 (push (byte-compile-push-binding-init var) init-lexenv))) 3965 (push (byte-compile-push-binding-init var) init-lexenv)))
@@ -3946,28 +3971,20 @@ binding slots have been popped."
3946 ;; For `let', do it in reverse order, because it makes no 3971 ;; For `let', do it in reverse order, because it makes no
3947 ;; semantic difference, but it is a lot more efficient since the 3972 ;; semantic difference, but it is a lot more efficient since the
3948 ;; values are now in reverse order on the stack. 3973 ;; values are now in reverse order on the stack.
3949 (dolist (var (if (eq (car form) 'let) (reverse clauses) clauses)) 3974 (dolist (var (if is-let (reverse clauses) clauses))
3950 (unless (eq (car form) 'let) 3975 (unless is-let
3951 (push (byte-compile-push-binding-init var) init-lexenv)) 3976 (push (byte-compile-push-binding-init var) init-lexenv))
3952 (let ((var (if (consp var) (car var) var))) 3977 (let ((var (if (consp var) (car var) var)))
3953 (cond ((null lexical-binding) 3978 (if (byte-compile-bind var init-lexenv)
3954 ;; If there are no lexical bindings, we can do things simply. 3979 (pop init-lexenv))))
3955 (byte-compile-dynamic-variable-bind var))
3956 ((byte-compile-bind var init-lexenv)
3957 (pop init-lexenv)))))
3958 ;; Emit the body. 3980 ;; Emit the body.
3959 (let ((init-stack-depth byte-compile-depth)) 3981 (let ((init-stack-depth byte-compile-depth))
3960 (byte-compile-body-do-effect (cdr (cdr form))) 3982 (byte-compile-body-do-effect (cdr (cdr form)))
3961 ;; Unbind the variables. 3983 ;; Unbind both lexical and dynamic variables.
3962 (if lexical-binding 3984 (cl-assert (or (eq byte-compile-depth init-stack-depth)
3963 ;; Unbind both lexical and dynamic variables. 3985 (eq byte-compile-depth (1+ init-stack-depth))))
3964 (progn 3986 (byte-compile-unbind clauses init-lexenv
3965 (cl-assert (or (eq byte-compile-depth init-stack-depth) 3987 (> byte-compile-depth init-stack-depth))))))
3966 (eq byte-compile-depth (1+ init-stack-depth))))
3967 (byte-compile-unbind clauses init-lexenv (> byte-compile-depth
3968 init-stack-depth)))
3969 ;; Unbind dynamic variables.
3970 (byte-compile-out 'byte-unbind (length clauses)))))))
3971 3988
3972 3989
3973 3990
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index ee84a9f69ba..761e33c059d 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -81,7 +81,6 @@
81;; and other oddities. 81;; and other oddities.
82;; - new byte codes for unwind-protect, catch, and condition-case so that 82;; - new byte codes for unwind-protect, catch, and condition-case so that
83;; closures aren't needed at all. 83;; closures aren't needed at all.
84;; - inline source code of different binding mode by first compiling it.
85;; - a reference to a var that is known statically to always hold a constant 84;; - a reference to a var that is known statically to always hold a constant
86;; should be turned into a byte-constant rather than a byte-stack-ref. 85;; should be turned into a byte-constant rather than a byte-stack-ref.
87;; Hmm... right, that's called constant propagation and could be done here, 86;; Hmm... right, that's called constant propagation and could be done here,
@@ -95,6 +94,7 @@
95 94
96;; (defmacro dlet (binders &rest body) 95;; (defmacro dlet (binders &rest body)
97;; ;; Works in both lexical and non-lexical mode. 96;; ;; Works in both lexical and non-lexical mode.
97;; (declare (indent 1) (debug let))
98;; `(progn 98;; `(progn
99;; ,@(mapcar (lambda (binder) 99;; ,@(mapcar (lambda (binder)
100;; `(defvar ,(if (consp binder) (car binder) binder))) 100;; `(defvar ,(if (consp binder) (car binder) binder)))
@@ -489,6 +489,7 @@ places where they originally did not directly appear."
489(unless (fboundp 'byte-compile-not-lexical-var-p) 489(unless (fboundp 'byte-compile-not-lexical-var-p)
490 ;; Only used to test the code in non-lexbind Emacs. 490 ;; Only used to test the code in non-lexbind Emacs.
491 (defalias 'byte-compile-not-lexical-var-p 'boundp)) 491 (defalias 'byte-compile-not-lexical-var-p 'boundp))
492(defvar byte-compile-lexical-variables)
492 493
493(defun cconv--analyse-use (vardata form varkind) 494(defun cconv--analyse-use (vardata form varkind)
494 "Analyze the use of a variable. 495 "Analyze the use of a variable.
@@ -530,6 +531,7 @@ FORM is the parent form that binds this var."
530 ;; outside of it. 531 ;; outside of it.
531 (envcopy 532 (envcopy
532 (mapcar (lambda (vdata) (list (car vdata) nil nil nil nil)) env)) 533 (mapcar (lambda (vdata) (list (car vdata) nil nil nil nil)) env))
534 (byte-compile-bound-variables byte-compile-bound-variables)
533 (newenv envcopy)) 535 (newenv envcopy))
534 ;; Push it before recursing, so cconv-freevars-alist contains entries in 536 ;; Push it before recursing, so cconv-freevars-alist contains entries in
535 ;; the order they'll be used by closure-convert-rec. 537 ;; the order they'll be used by closure-convert-rec.
@@ -541,6 +543,7 @@ FORM is the parent form that binds this var."
541 (format "Argument %S is not a lexical variable" arg))) 543 (format "Argument %S is not a lexical variable" arg)))
542 ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ... 544 ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ...
543 (t (let ((varstruct (list arg nil nil nil nil))) 545 (t (let ((varstruct (list arg nil nil nil nil)))
546 (cl-pushnew arg byte-compile-lexical-variables)
544 (push (cons (list arg) (cdr varstruct)) newvars) 547 (push (cons (list arg) (cdr varstruct)) newvars)
545 (push varstruct newenv))))) 548 (push varstruct newenv)))))
546 (dolist (form body) ;Analyze body forms. 549 (dolist (form body) ;Analyze body forms.
@@ -579,6 +582,7 @@ and updates the data stored in ENV."
579 (let ((orig-env env) 582 (let ((orig-env env)
580 (newvars nil) 583 (newvars nil)
581 (var nil) 584 (var nil)
585 (byte-compile-bound-variables byte-compile-bound-variables)
582 (value nil)) 586 (value nil))
583 (dolist (binder binders) 587 (dolist (binder binders)
584 (if (not (consp binder)) 588 (if (not (consp binder))
@@ -592,6 +596,7 @@ and updates the data stored in ENV."
592 (cconv-analyse-form value (if (eq letsym 'let*) env orig-env))) 596 (cconv-analyse-form value (if (eq letsym 'let*) env orig-env)))
593 597
594 (unless (byte-compile-not-lexical-var-p var) 598 (unless (byte-compile-not-lexical-var-p var)
599 (cl-pushnew var byte-compile-lexical-variables)
595 (let ((varstruct (list var nil nil nil nil))) 600 (let ((varstruct (list var nil nil nil nil)))
596 (push (cons binder (cdr varstruct)) newvars) 601 (push (cons binder (cdr varstruct)) newvars)
597 (push varstruct env)))) 602 (push varstruct env))))
@@ -616,7 +621,8 @@ and updates the data stored in ENV."
616 621
617 (`((lambda . ,_) . ,_) ; First element is lambda expression. 622 (`((lambda . ,_) . ,_) ; First element is lambda expression.
618 (byte-compile-log-warning 623 (byte-compile-log-warning
619 "Use of deprecated ((lambda ...) ...) form" t :warning) 624 (format "Use of deprecated ((lambda %s ...) ...) form" (nth 1 (car form)))
625 t :warning)
620 (dolist (exp `((function ,(car form)) . ,(cdr form))) 626 (dolist (exp `((function ,(car form)) . ,(cdr form)))
621 (cconv-analyse-form exp env))) 627 (cconv-analyse-form exp env)))
622 628
@@ -645,6 +651,7 @@ and updates the data stored in ENV."
645 (`(track-mouse . ,body) 651 (`(track-mouse . ,body)
646 (cconv--analyse-function () body env form)) 652 (cconv--analyse-function () body env form))
647 653
654 (`(defvar ,var) (push var byte-compile-bound-variables))
648 (`(,(or `defconst `defvar) ,var ,value . ,_) 655 (`(,(or `defconst `defvar) ,var ,value . ,_)
649 (push var byte-compile-bound-variables) 656 (push var byte-compile-bound-variables)
650 (cconv-analyse-form value env)) 657 (cconv-analyse-form value env))
@@ -668,7 +675,9 @@ and updates the data stored in ENV."
668 ;; seem worth the trouble. 675 ;; seem worth the trouble.
669 (dolist (form forms) (cconv-analyse-form form nil))) 676 (dolist (form forms) (cconv-analyse-form form nil)))
670 677
671 (`(declare . ,_) nil) ;The args don't contain code. 678 ;; `declare' should now be macro-expanded away (and if they're not, we're
679 ;; in trouble because they *can* contain code nowadays).
680 ;; (`(declare . ,_) nil) ;The args don't contain code.
672 681
673 (`(,_ . ,body-forms) ; First element is a function or whatever. 682 (`(,_ . ,body-forms) ; First element is a function or whatever.
674 (dolist (form body-forms) (cconv-analyse-form form env))) 683 (dolist (form body-forms) (cconv-analyse-form form env)))
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index f3bf70b0190..52f123c83ec 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -156,8 +156,8 @@ an element already on the list.
156 ;; earlier and should have triggered them already. 156 ;; earlier and should have triggered them already.
157 (with-no-warnings ,place) 157 (with-no-warnings ,place)
158 (setq ,place (cons ,var ,place)))) 158 (setq ,place (cons ,var ,place))))
159 (list 'setq place (cl-list* 'cl-adjoin x place keys))) 159 `(setq ,place (cl-adjoin ,x ,place ,@keys)))
160 (cl-list* 'cl-callf2 'cl-adjoin x place keys))) 160 `(cl-callf2 cl-adjoin ,x ,place ,@keys)))
161 161
162(defun cl--set-elt (seq n val) 162(defun cl--set-elt (seq n val)
163 (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val))) 163 (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val)))
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el
index af19db63f30..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" "b839ad3781c4f2f849df0639b4eba166") 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 4aae2c6efe5..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)
@@ -2763,22 +2765,16 @@ surrounded by (cl-block NAME ...).
2763 2765
2764;;;###autoload 2766;;;###autoload
2765(defun cl--compiler-macro-adjoin (form a list &rest keys) 2767(defun cl--compiler-macro-adjoin (form a list &rest keys)
2766 (if (and (cl--simple-expr-p a) (cl--simple-expr-p list) 2768 (if (memq :key keys) form
2767 (not (memq :key keys))) 2769 (macroexp-let2 macroexp-copyable-p va a
2768 `(if (cl-member ,a ,list ,@keys) ,list (cons ,a ,list)) 2770 (macroexp-let2 macroexp-copyable-p vlist list
2769 form)) 2771 `(if (cl-member ,va ,vlist ,@keys) ,vlist (cons ,va ,vlist))))))
2770 2772
2771(defun cl--compiler-macro-get (_form sym prop &optional def) 2773(defun cl--compiler-macro-get (_form sym prop &optional def)
2772 (if def 2774 (if def
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/edebug.el b/lisp/emacs-lisp/edebug.el
index 867f079ce5f..319af588eac 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -472,6 +472,8 @@ the option `edebug-all-forms'."
472(or (fboundp 'edebug-original-eval-defun) 472(or (fboundp 'edebug-original-eval-defun)
473 (defalias 'edebug-original-eval-defun (symbol-function 'eval-defun))) 473 (defalias 'edebug-original-eval-defun (symbol-function 'eval-defun)))
474 474
475(defvar edebug-result) ; The result of the function call returned by body.
476
475;; We should somehow arrange to be able to do this 477;; We should somehow arrange to be able to do this
476;; without actually replacing the eval-defun command. 478;; without actually replacing the eval-defun command.
477(defun edebug-eval-defun (edebug-it) 479(defun edebug-eval-defun (edebug-it)
@@ -487,7 +489,7 @@ With a prefix argument, instrument the code for Edebug.
487 489
488Setting option `edebug-all-defs' to a non-nil value reverses the meaning 490Setting option `edebug-all-defs' to a non-nil value reverses the meaning
489of the prefix argument. Code is then instrumented when this function is 491of the prefix argument. Code is then instrumented when this function is
490invoked without a prefix argument 492invoked without a prefix argument.
491 493
492If acting on a `defun' for FUNCTION, and the function was instrumented, 494If acting on a `defun' for FUNCTION, and the function was instrumented,
493`Edebug: FUNCTION' is printed in the minibuffer. If not instrumented, 495`Edebug: FUNCTION' is printed in the minibuffer. If not instrumented,
@@ -2106,7 +2108,6 @@ expressions; a `progn' form will be returned enclosing these forms."
2106(defvar edebug-coverage) ; the coverage results of each expression of function. 2108(defvar edebug-coverage) ; the coverage results of each expression of function.
2107 2109
2108(defvar edebug-buffer) ; which buffer the function is in. 2110(defvar edebug-buffer) ; which buffer the function is in.
2109(defvar edebug-result) ; the result of the function call returned by body
2110(defvar edebug-outside-executing-macro) 2111(defvar edebug-outside-executing-macro)
2111(defvar edebug-outside-defining-kbd-macro) 2112(defvar edebug-outside-defining-kbd-macro)
2112 2113
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 02b020fa241..cbd8854e7d6 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -225,11 +225,13 @@ font-lock keywords will not be case sensitive."
225 (setq-local syntax-begin-function 'beginning-of-defun) 225 (setq-local syntax-begin-function 'beginning-of-defun)
226 (setq font-lock-defaults 226 (setq font-lock-defaults
227 `((lisp-font-lock-keywords 227 `((lisp-font-lock-keywords
228 lisp-font-lock-keywords-1 lisp-font-lock-keywords-2) 228 lisp-font-lock-keywords-1
229 lisp-font-lock-keywords-2)
229 nil ,keywords-case-insensitive nil nil 230 nil ,keywords-case-insensitive nil nil
230 (font-lock-mark-block-function . mark-defun) 231 (font-lock-mark-block-function . mark-defun)
231 (font-lock-syntactic-face-function 232 (font-lock-syntactic-face-function
232 . lisp-font-lock-syntactic-face-function)))) 233 . lisp-font-lock-syntactic-face-function)))
234 (prog-prettify-install lisp--prettify-symbols-alist))
233 235
234(defun lisp-outline-level () 236(defun lisp-outline-level ()
235 "Lisp mode `outline-level' function." 237 "Lisp mode `outline-level' function."
@@ -448,6 +450,9 @@ All commands in `lisp-mode-shared-map' are inherited by this map.")
448 :type 'hook 450 :type 'hook
449 :group 'lisp) 451 :group 'lisp)
450 452
453(defconst lisp--prettify-symbols-alist
454 '(("lambda" . ?λ)))
455
451(define-derived-mode emacs-lisp-mode prog-mode "Emacs-Lisp" 456(define-derived-mode emacs-lisp-mode prog-mode "Emacs-Lisp"
452 "Major mode for editing Lisp code to run in Emacs. 457 "Major mode for editing Lisp code to run in Emacs.
453Commands: 458Commands:
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 6bb796434fd..e8b513fcd3e 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -111,15 +111,20 @@ and also to avoid outputting the warning during normal execution."
111 (funcall (eval (cadr form))) 111 (funcall (eval (cadr form)))
112 (byte-compile-constant nil))) 112 (byte-compile-constant nil)))
113 113
114(defun macroexp--compiling-p ()
115 "Return non-nil if we're macroexpanding for the compiler."
116 ;; FIXME: ¡¡Major Ugly Hack!! To determine whether the output of this
117 ;; macro-expansion will be processed by the byte-compiler, we check
118 ;; circumstantial evidence.
119 (member '(declare-function . byte-compile-macroexpand-declare-function)
120 macroexpand-all-environment))
121
122
114(defun macroexp--warn-and-return (msg form) 123(defun macroexp--warn-and-return (msg form)
115 (let ((when-compiled (lambda () (byte-compile-log-warning msg t)))) 124 (let ((when-compiled (lambda () (byte-compile-log-warning msg t))))
116 (cond 125 (cond
117 ((null msg) form) 126 ((null msg) form)
118 ;; FIXME: ¡¡Major Ugly Hack!! To determine whether the output of this 127 ((macroexp--compiling-p)
119 ;; macro-expansion will be processed by the byte-compiler, we check
120 ;; circumstantial evidence.
121 ((member '(declare-function . byte-compile-macroexpand-declare-function)
122 macroexpand-all-environment)
123 `(progn 128 `(progn
124 (macroexp--funcall-if-compiled ',when-compiled) 129 (macroexp--funcall-if-compiled ',when-compiled)
125 ,form)) 130 ,form))
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/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index a88b9d70930..f9d0fd9366b 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -957,7 +957,7 @@ If non-nil, it will blink not only for \"begin..end\" but also for \"if...else\"
957 (let ((ender (funcall smie-backward-token-function))) 957 (let ((ender (funcall smie-backward-token-function)))
958 (cond 958 (cond
959 ((not (and ender (rassoc ender smie-closer-alist))) 959 ((not (and ender (rassoc ender smie-closer-alist)))
960 ;; This not is one of the begin..end we know how to check. 960 ;; This is not one of the begin..end we know how to check.
961 (blink-matching-check-mismatch start end)) 961 (blink-matching-check-mismatch start end))
962 ((not start) t) 962 ((not start) t)
963 ((eq t (car (rassoc ender smie-closer-alist))) nil) 963 ((eq t (car (rassoc ender smie-closer-alist))) nil)
@@ -1012,6 +1012,9 @@ This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'.
1012 (or (eq (char-before) last-command-event) 1012 (or (eq (char-before) last-command-event)
1013 (not (memq (char-before) 1013 (not (memq (char-before)
1014 smie-blink-matching-triggers))) 1014 smie-blink-matching-triggers)))
1015 ;; FIXME: For octave's "switch ... case ... case" we flash
1016 ;; `switch' at the end of the first `case' and we burp
1017 ;; "mismatch" at the end of the second `case'.
1015 (or smie-blink-matching-inners 1018 (or smie-blink-matching-inners
1016 (not (numberp (nth 2 (assoc token smie-grammar)))))) 1019 (not (numberp (nth 2 (assoc token smie-grammar))))))
1017 ;; The major mode might set blink-matching-check-function 1020 ;; The major mode might set blink-matching-check-function
@@ -1021,87 +1024,90 @@ This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'.
1021 (let ((blink-matching-check-function #'smie-blink-matching-check)) 1024 (let ((blink-matching-check-function #'smie-blink-matching-check))
1022 (blink-matching-open)))))))) 1025 (blink-matching-open))))))))
1023 1026
1024(defface smie-matching-block-highlight '((t (:inherit highlight))) 1027(defvar-local smie--matching-block-data-cache nil)
1025 "Face used to highlight matching block." 1028
1026 :group 'smie) 1029(defun smie--opener/closer-at-point ()
1027 1030 "Return (OPENER TOKEN START END) or nil.
1028(defvar smie--highlight-matching-block-overlay nil) 1031OPENER is non-nil if TOKEN is an opener and nil if it's a closer."
1029(defvar-local smie--highlight-matching-block-lastpos -1) 1032 (let* ((start (point))
1030 1033 ;; Move to a previous position outside of a token.
1031(defun smie-highlight-matching-block () 1034 (_ (funcall smie-backward-token-function))
1032 (when (and smie-closer-alist 1035 ;; Move to the end of the token before point.
1033 (/= (point) smie--highlight-matching-block-lastpos)) 1036 (btok (funcall smie-forward-token-function))
1034 (unless (overlayp smie--highlight-matching-block-overlay) 1037 (bend (point)))
1035 (setq smie--highlight-matching-block-overlay 1038 (cond
1036 (make-overlay (point) (point)))) 1039 ;; Token before point is a closer?
1037 (setq smie--highlight-matching-block-lastpos (point)) 1040 ((and (>= bend start) (rassoc btok smie-closer-alist))
1038 (let ((beg-of-tok 1041 (funcall smie-backward-token-function)
1039 (lambda (&optional start) 1042 (when (< (point) start)
1040 "Move to the beginning of current token at START." 1043 (prog1 (list nil btok (point) bend)
1041 (let* ((token) 1044 (goto-char bend))))
1042 (start (or start (point))) 1045 ;; Token around point is an opener?
1043 (beg (progn 1046 ((and (> bend start) (assoc btok smie-closer-alist))
1047 (funcall smie-backward-token-function)
1048 (when (<= (point) start) (list t btok (point) bend)))
1049 ((<= bend start)
1050 (let ((atok (funcall smie-forward-token-function))
1051 (aend (point)))
1052 (cond
1053 ((< aend start) nil) ;Hopefully shouldn't happen.
1054 ;; Token after point is a closer?
1055 ((assoc atok smie-closer-alist)
1056 (funcall smie-backward-token-function)
1057 (when (<= (point) start)
1058 (list t atok (point) aend)))))))))
1059
1060(defun smie--matching-block-data (orig &rest args)
1061 "A function suitable for `show-paren-data-function' (which see)."
1062 (if (or (null smie-closer-alist)
1063 (eq (point) (car smie--matching-block-data-cache)))
1064 (or (cdr smie--matching-block-data-cache)
1065 (apply orig args))
1066 (setq smie--matching-block-data-cache (list (point)))
1067 (unless (nth 8 (syntax-ppss))
1068 (condition-case nil
1069 (let ((here (smie--opener/closer-at-point)))
1070 (when (and here
1071 (or smie-blink-matching-inners
1072 (not (numberp
1073 (nth (if (nth 0 here) 1 2)
1074 (assoc (nth 1 here) smie-grammar))))))
1075 (let ((there
1076 (cond
1077 ((car here) ; Opener.
1078 (let ((data (smie-forward-sexp 'halfsexp))
1079 (tend (point)))
1080 (unless (car data)
1044 (funcall smie-backward-token-function) 1081 (funcall smie-backward-token-function)
1045 (forward-comment (point-max)) 1082 (list (member (cons (nth 1 here) (nth 2 data))
1046 (point))) 1083 smie-closer-alist)
1047 (end (progn 1084 (point) tend))))
1048 (setq token (funcall smie-forward-token-function)) 1085 (t ;Closer.
1049 (forward-comment (- (point))) 1086 (let ((data (smie-backward-sexp 'halfsexp))
1050 (point)))) 1087 (htok (nth 1 here)))
1051 (if (and (<= beg start) (<= start end) 1088 (if (car data)
1052 (or (assoc token smie-closer-alist) 1089 (let* ((hprec (nth 2 (assoc htok smie-grammar)))
1053 (rassoc token smie-closer-alist))) 1090 (ttok (nth 2 data))
1054 (progn (goto-char beg) token) 1091 (tprec (nth 1 (assoc ttok smie-grammar))))
1055 (goto-char start) 1092 (when (and (numberp hprec) ;Here is an inner.
1056 nil)))) 1093 (eq hprec tprec))
1057 (highlight 1094 (goto-char (nth 1 data))
1058 (lambda (beg end) 1095 (let ((tbeg (point)))
1059 (move-overlay smie--highlight-matching-block-overlay 1096 (funcall smie-forward-token-function)
1060 beg end (current-buffer)) 1097 (list t tbeg (point)))))
1061 (overlay-put smie--highlight-matching-block-overlay 1098 (let ((tbeg (point)))
1062 'face 'smie-matching-block-highlight)))) 1099 (funcall smie-forward-token-function)
1063 (overlay-put smie--highlight-matching-block-overlay 'face nil) 1100 (list (member (cons (nth 2 data) htok)
1064 (unless (nth 8 (syntax-ppss)) 1101 smie-closer-alist)
1065 (save-excursion 1102 tbeg (point)))))))))
1066 (condition-case nil 1103 ;; Update the cache.
1067 (let ((token 1104 (setcdr smie--matching-block-data-cache
1068 (or (funcall beg-of-tok) 1105 (list (nth 2 here) (nth 3 here)
1069 (funcall beg-of-tok 1106 (nth 1 there) (nth 2 there)
1070 (prog1 (point) 1107 (not (nth 0 there)))))))
1071 (funcall smie-forward-token-function)))))) 1108 (scan-error nil))
1072 (cond 1109 (goto-char (car smie--matching-block-data-cache)))
1073 ((assoc token smie-closer-alist) ; opener 1110 (apply #'smie--matching-block-data orig args)))
1074 (forward-sexp 1)
1075 (let ((end (point))
1076 (closer (funcall smie-backward-token-function)))
1077 (when (rassoc closer smie-closer-alist)
1078 (funcall highlight (point) end))))
1079 ((rassoc token smie-closer-alist) ; closer
1080 (funcall smie-forward-token-function)
1081 (forward-sexp -1)
1082 (let ((beg (point))
1083 (opener (funcall smie-forward-token-function)))
1084 (when (assoc opener smie-closer-alist)
1085 (funcall highlight beg (point)))))))
1086 (scan-error)))))))
1087
1088(defvar smie--highlight-matching-block-timer nil)
1089
1090;;;###autoload
1091(define-minor-mode smie-highlight-matching-block-mode nil
1092 :global t :group 'smie
1093 (when (timerp smie--highlight-matching-block-timer)
1094 (cancel-timer smie--highlight-matching-block-timer))
1095 (setq smie--highlight-matching-block-timer nil)
1096 (if smie-highlight-matching-block-mode
1097 (progn
1098 (remove-hook 'post-self-insert-hook #'smie-blink-matching-open 'local)
1099 (setq smie--highlight-matching-block-timer
1100 (run-with-idle-timer 0.2 t #'smie-highlight-matching-block)))
1101 (when smie--highlight-matching-block-overlay
1102 (delete-overlay smie--highlight-matching-block-overlay)
1103 (setq smie--highlight-matching-block-overlay nil))
1104 (kill-local-variable 'smie--highlight-matching-block-lastpos)))
1105 1111
1106;;; The indentation engine. 1112;;; The indentation engine.
1107 1113
@@ -1799,9 +1805,10 @@ KEYWORDS are additional arguments, which can use the following keywords:
1799 (setq-local smie-closer-alist ca) 1805 (setq-local smie-closer-alist ca)
1800 ;; Only needed for interactive calls to blink-matching-open. 1806 ;; Only needed for interactive calls to blink-matching-open.
1801 (setq-local blink-matching-check-function #'smie-blink-matching-check) 1807 (setq-local blink-matching-check-function #'smie-blink-matching-check)
1802 (unless smie-highlight-matching-block-mode 1808 (add-hook 'post-self-insert-hook
1803 (add-hook 'post-self-insert-hook 1809 #'smie-blink-matching-open 'append 'local)
1804 #'smie-blink-matching-open 'append 'local)) 1810 (add-function :around (local 'show-paren-data-function)
1811 #'smie--matching-block-data)
1805 ;; Setup smie-blink-matching-triggers. Rather than wait for SPC to 1812 ;; Setup smie-blink-matching-triggers. Rather than wait for SPC to
1806 ;; blink, try to blink as soon as we type the last char of a block ender. 1813 ;; blink, try to blink as soon as we type the last char of a block ender.
1807 (let ((closers (sort (mapcar #'cdr smie-closer-alist) #'string-lessp)) 1814 (let ((closers (sort (mapcar #'cdr smie-closer-alist) #'string-lessp))
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-dirs.el b/lisp/eshell/em-dirs.el
index 106ca152c90..e8fbe0518ac 100644
--- a/lisp/eshell/em-dirs.el
+++ b/lisp/eshell/em-dirs.el
@@ -207,8 +207,8 @@ Thus, this does not include the current directory.")
207 (when eshell-cd-on-directory 207 (when eshell-cd-on-directory
208 (make-local-variable 'eshell-interpreter-alist) 208 (make-local-variable 'eshell-interpreter-alist)
209 (setq eshell-interpreter-alist 209 (setq eshell-interpreter-alist
210 (cons (cons (lambda (file args) 210 (cons (cons #'(lambda (file args)
211 (eshell-lone-directory-p file)) 211 (eshell-lone-directory-p file))
212 'eshell-dirs-substitute-cd) 212 'eshell-dirs-substitute-cd)
213 eshell-interpreter-alist))) 213 eshell-interpreter-alist)))
214 214
diff --git a/lisp/eshell/em-script.el b/lisp/eshell/em-script.el
index 13ae6941dde..b073928738f 100644
--- a/lisp/eshell/em-script.el
+++ b/lisp/eshell/em-script.el
@@ -61,9 +61,10 @@ This includes when running `eshell-command'."
61 "Initialize the script parsing code." 61 "Initialize the script parsing code."
62 (make-local-variable 'eshell-interpreter-alist) 62 (make-local-variable 'eshell-interpreter-alist)
63 (setq eshell-interpreter-alist 63 (setq eshell-interpreter-alist
64 (cons '((lambda (file args) 64 (cons (cons #'(lambda (file args)
65 (string= (file-name-nondirectory file) 65 (string= (file-name-nondirectory file)
66 "eshell")) . eshell/source) 66 "eshell"))
67 'eshell/source)
67 eshell-interpreter-alist)) 68 eshell-interpreter-alist))
68 (make-local-variable 'eshell-complex-commands) 69 (make-local-variable 'eshell-complex-commands)
69 (setq eshell-complex-commands 70 (setq eshell-complex-commands
diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el
index 0501544789d..2932f443e4f 100644
--- a/lisp/eshell/em-term.el
+++ b/lisp/eshell/em-term.el
@@ -31,6 +31,7 @@
31 31
32;;; Code: 32;;; Code:
33 33
34(require 'cl-lib)
34(require 'esh-util) 35(require 'esh-util)
35(require 'esh-ext) 36(require 'esh-ext)
36(eval-when-compile (require 'eshell)) 37(eval-when-compile (require 'eshell))
@@ -61,13 +62,19 @@ which commands are considered visual in nature."
61 "less" "more" ; M-x view-file 62 "less" "more" ; M-x view-file
62 "lynx" "ncftp" ; w3.el, ange-ftp 63 "lynx" "ncftp" ; w3.el, ange-ftp
63 "pine" "tin" "trn" "elm") ; GNUS!! 64 "pine" "tin" "trn" "elm") ; GNUS!!
64 "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'."
65 :type '(repeat string) 70 :type '(repeat string)
66 :group 'eshell-term) 71 :group 'eshell-term)
67 72
68(defcustom eshell-visual-subcommands 73(defcustom eshell-visual-subcommands
69 nil 74 nil
70 "An alist of the form 75 "An alist of subcommands that present their output in a visual fashion.
76
77An alist of the form
71 78
72 ((COMMAND1 SUBCOMMAND1 SUBCOMMAND2...) 79 ((COMMAND1 SUBCOMMAND1 SUBCOMMAND2...)
73 (COMMAND2 SUBCOMMAND1 ...)) 80 (COMMAND2 SUBCOMMAND1 ...))
@@ -77,7 +84,9 @@ visual fashion. A likely entry is
77 84
78 (\"git\" \"log\" \"diff\" \"show\") 85 (\"git\" \"log\" \"diff\" \"show\")
79 86
80because 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'."
81 :type '(repeat (cons (string :tag "Command") 90 :type '(repeat (cons (string :tag "Command")
82 (repeat (string :tag "Subcommand")))) 91 (repeat (string :tag "Subcommand"))))
83 :version "24.4" 92 :version "24.4"
@@ -96,7 +105,9 @@ fashion. For example, a sensible entry would be
96 (\"git\" \"--help\") 105 (\"git\" \"--help\")
97 106
98because \"git <command> --help\" shows the command's 107because \"git <command> --help\" shows the command's
99documentation with a pager." 108documentation with a pager.
109
110See also `eshell-visual-commands' and `eshell-visual-subcommands'."
100 :type '(repeat (cons (string :tag "Command") 111 :type '(repeat (cons (string :tag "Command")
101 (repeat (string :tag "Option")))) 112 (repeat (string :tag "Option"))))
102 :version "24.4" 113 :version "24.4"
@@ -131,18 +142,23 @@ character to the invoked process."
131 "Initialize the `term' interface code." 142 "Initialize the `term' interface code."
132 (make-local-variable 'eshell-interpreter-alist) 143 (make-local-variable 'eshell-interpreter-alist)
133 (setq eshell-interpreter-alist 144 (setq eshell-interpreter-alist
134 (cons (cons (function 145 (cons (cons #'eshell-visual-command-p
135 (lambda (command args)
136 (let ((command (file-name-nondirectory command)))
137 (or (member command eshell-visual-commands)
138 (member (car args)
139 (cdr (assoc command eshell-visual-subcommands)))
140 (cl-intersection args
141 (cdr (assoc command eshell-visual-options))
142 :test 'string=)))))
143 'eshell-exec-visual) 146 'eshell-exec-visual)
144 eshell-interpreter-alist))) 147 eshell-interpreter-alist)))
145 148
149(defun eshell-visual-command-p (command args)
150 "Returns non-nil when given a visual command.
151If either COMMAND or a subcommand in ARGS (e.g. git log) is a
152visual command, returns non-nil."
153 (let ((command (file-name-nondirectory command)))
154 (and (eshell-interactive-output-p)
155 (or (member command eshell-visual-commands)
156 (member (car args)
157 (cdr (assoc command eshell-visual-subcommands)))
158 (cl-intersection args
159 (cdr (assoc command eshell-visual-options))
160 :test 'string=)))))
161
146(defun eshell-exec-visual (&rest args) 162(defun eshell-exec-visual (&rest args)
147 "Run the specified PROGRAM in a terminal emulation buffer. 163 "Run the specified PROGRAM in a terminal emulation buffer.
148ARGS are passed to the program. At the moment, no piping of input is 164ARGS are passed to the program. At the moment, no piping of input is
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el
index ee857cf20f3..5346bd16fd2 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -326,11 +326,8 @@ and the hook `eshell-exit-hook'."
326 (if mode-line-elt 326 (if mode-line-elt
327 (setcar mode-line-elt 'eshell-command-running-string)))) 327 (setcar mode-line-elt 'eshell-command-running-string))))
328 328
329 (define-key eshell-mode-map [return] 'eshell-send-input) 329 (define-key eshell-mode-map "\r" 'eshell-send-input)
330 (define-key eshell-mode-map [(control ?m)] 'eshell-send-input) 330 (define-key eshell-mode-map "\M-\r" 'eshell-queue-input)
331 (define-key eshell-mode-map [(control ?j)] 'eshell-send-input)
332 (define-key eshell-mode-map [(meta return)] 'eshell-queue-input)
333 (define-key eshell-mode-map [(meta control ?m)] 'eshell-queue-input)
334 (define-key eshell-mode-map [(meta control ?l)] 'eshell-show-output) 331 (define-key eshell-mode-map [(meta control ?l)] 'eshell-show-output)
335 (define-key eshell-mode-map [(control ?a)] 'eshell-bol) 332 (define-key eshell-mode-map [(control ?a)] 'eshell-bol)
336 333
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/font-lock.el b/lisp/font-lock.el
index d18aea61236..8f4363b0bdf 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -2328,7 +2328,7 @@ in which C preprocessor directives are used. e.g. `asm-mode' and
2328 (1 font-lock-keyword-face) 2328 (1 font-lock-keyword-face)
2329 (2 font-lock-constant-face nil t)) 2329 (2 font-lock-constant-face nil t))
2330 ;; Erroneous structures. 2330 ;; Erroneous structures.
2331 ("(\\(abort\\|assert\\|warn\\|check-type\\|cerror\\|error\\|signal\\)\\_>" 1 font-lock-warning-face) 2331 ("(\\(abort\\|assert\\|warn\\|check-type\\|cerror\\|\\(?:user-\\)?error\\|signal\\)\\_>" 1 font-lock-warning-face)
2332 ;; Words inside \\[] tend to be for `substitute-command-keys'. 2332 ;; Words inside \\[] tend to be for `substitute-command-keys'.
2333 ("\\\\\\\\\\[\\(\\(?:\\sw\\|\\s_\\)+\\)\\]" 2333 ("\\\\\\\\\\[\\(\\(?:\\sw\\|\\s_\\)+\\)\\]"
2334 (1 font-lock-constant-face prepend)) 2334 (1 font-lock-constant-face prepend))
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 59e3e398788..83831264f58 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,112 @@
12013-06-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
2
3 * shr.el (shr-expand-url): Expansion should chop off the bits after the
4 last slash.
5
6 * eww.el (eww-tag-select): Use the first value as the default value.
7
82013-06-13 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
9
10 * eww.el (eww): Prepend urls with http:// if scheme is missing.
11 (eww-mode): Use `define-derived-mode'.
12 (eww-parse-headers): Parse headers from beginning of buffer so that
13 file:// links work.
14
152013-06-13 Katsumi Yamaoka <yamaoka@jpl.org>
16
17 * eww.el (eww-detect-charset): Detect charset from the <meta> tag.
18
192013-06-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
20
21 * shr.el (shr-tag-svg): Ignore SVG elements, because we don't know how
22 to handle them at all.
23
242013-06-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
25
26 * eww.el (eww-convert-widgets): Make widgets from non-tabular layouts
27 work, too.
28 (eww-tag-select): Implement <select>.
29
302013-06-10 Albert Krewinkel <krewinkel@moltkeplatz.de>
31
32 * sieve-manage.el (sieve-manage-open): work with STARTTLS: shorten
33 stream managing functions by using open-protocol-stream to do most of
34 the work. Has the nice benefit of enabling STARTTLS.
35 Wait for capabilities after STARTTLS: following RFC5804, the server
36 sends new capabilities after successfully establishing a TLS connection
37 with the client. The client should update the cached list of
38 capabilities, but we just ignore the answer for now.
39 (sieve-manage-network-p, sieve-manage-network-open)
40 (sieve-manage-starttls-p, sieve-manage-starttls-open)
41 (sieve-manage-forward, sieve-manage-streams)
42 (sieve-manage-stream-alist): Remove unneeded functions neither in the
43 API, nor called by any other function.
44 Enable Multibyte for SieveManage buffers: The parser won't properly
45 handle umlauts and line endings unless multibyte is turned on in the
46 process buffer.
47
482013-06-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
49
50 * eww.el (eww-tag-input): Support password fields.
51 (eww-submit): Support POST.
52
532013-06-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
54
55 * eww.el (eww-tag-form): Protect against degenerate forms.
56
57 * shr.el (shr-expand-url): Expand URLs that start with a slash
58 correctly.
59
60 * eww.el (eww-submit): Get submit button logic right.
61
62 * shr.el (shr-final-table-render): New variable to signal when we're
63 doing the final table rendering so that we can collect more data at
64 that point.
65
66 * eww.el (eww-submit): Make form submission work.
67 (eww-tag-input): Implement submit buttons.
68 (eww-click-radio): Implement radio and checkboxes.
69 (eww-submit): Handle hidden elements.
70
71 * shr.el (shr-descend): Allow other packages to override (or provide)
72 rendering of elements.
73 (shr-expand-url): Strip query strings from URLs before expanding them.
74
75 * eww.el: Don't require cl-lib.
76 (eww-tag-form): Start form support.
77
78 * eww.el: Start writing a new, tiny web browser.
79 (eww-previous-url): New command.
80 (eww-quit): New command.
81
822013-06-10 Albert Krewinkel <krewinkel@moltkeplatz.de>
83
84 * sieve.el: Put point at beginning of buffer when viewing a script.
85 (sieve-open-server): respect the PORT parameter. Show the correct port
86 number in sieve-buffer's header. Fixed code to also work with a string
87 as port specifier. Properly close the connection on pressing 'q'. Make
88 sieve-manage-quit close the connection and process buffer. Also, remove
89 duplicate keybinding for 'q'.
90
912013-06-10 Roy Hashimoto <roy.hashimoto@gmail.com> (tiny change)
92
93 * mm-view.el (mm-pkcs7-signed-magic): Allow newline in the regexp and
94 make it easier to read.
95 (mm-pkcs7-enveloped-magic): Ditto.
96
972013-06-06 Teodor Zlatanov <tzz@lifelogs.com>
98
99 * gnus-ems.el (gnus-image-type-available-p): Test `display-images-p'
100 before `image-type-available-p' to avoid loading the image libraries
101 needlessly.
102
1032013-06-04 Katsumi Yamaoka <yamaoka@jpl.org>
104
105 * gnus-art.el (article-date-ut, article-update-date-lapsed): Don't
106 assume Date header begins with "Date", that may be customized into
107 something like "X-Sent" using gnus-article-time-format.
108 (article-transform-date): Allow multi-line Date header.
109
12013-06-02 David Engster <deng@randomsample.de> 1102013-06-02 David Engster <deng@randomsample.de>
2 111
3 * registry.el (initialize-instance, registry-lookup) 112 * registry.el (initialize-instance, registry-lookup)
diff --git a/lisp/gnus/eww.el b/lisp/gnus/eww.el
new file mode 100644
index 00000000000..d4dd178fb70
--- /dev/null
+++ b/lisp/gnus/eww.el
@@ -0,0 +1,367 @@
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 (unless (string-match-p "\\`[a-zA-Z][-a-zA-Z0-9+.]*://" url)
40 (setq url (concat "http://" url)))
41 (url-retrieve url 'eww-render (list url)))
42
43(defun eww-detect-charset (html-p)
44 (let ((case-fold-search t)
45 (pt (point)))
46 (or (and html-p
47 (re-search-forward
48 "<meta[\t\n\r ]+[^>]*charset=\\([^\t\n\r \"/>]+\\)" nil t)
49 (goto-char pt)
50 (match-string 1))
51 (and (looking-at
52 "[\t\n\r ]*<\\?xml[\t\n\r ]+[^>]*encoding=\"\\([^\"]+\\)")
53 (match-string 1)))))
54
55(defun eww-render (status url &optional point)
56 (let* ((headers (eww-parse-headers))
57 (content-type
58 (mail-header-parse-content-type
59 (or (cdr (assoc "content-type" headers))
60 "text/plain")))
61 (charset (intern
62 (downcase
63 (or (cdr (assq 'charset (cdr content-type)))
64 (eww-detect-charset (equal (car content-type)
65 "text/html"))
66 "utf8"))))
67 (data-buffer (current-buffer)))
68 (unwind-protect
69 (progn
70 (cond
71 ((equal (car content-type) "text/html")
72 (eww-display-html charset url))
73 ((string-match "^image/" (car content-type))
74 (eww-display-image))
75 (t
76 (eww-display-raw charset)))
77 (when point
78 (goto-char point)))
79 (kill-buffer data-buffer))))
80
81(defun eww-parse-headers ()
82 (let ((headers nil))
83 (goto-char (point-min))
84 (while (and (not (eobp))
85 (not (eolp)))
86 (when (looking-at "\\([^:]+\\): *\\(.*\\)")
87 (push (cons (downcase (match-string 1))
88 (match-string 2))
89 headers))
90 (forward-line 1))
91 (unless (eobp)
92 (forward-line 1))
93 headers))
94
95(defun eww-display-html (charset url)
96 (unless (eq charset 'utf8)
97 (decode-coding-region (point) (point-max) charset))
98 (let ((document
99 (list
100 'base (list (cons 'href url))
101 (libxml-parse-html-region (point) (point-max)))))
102 (eww-setup-buffer)
103 (setq eww-current-url url)
104 (let ((inhibit-read-only t)
105 (shr-external-rendering-functions
106 '((form . eww-tag-form)
107 (input . eww-tag-input)
108 (select . eww-tag-select))))
109 (shr-insert-document document)
110 (eww-convert-widgets))
111 (goto-char (point-min))))
112
113(defun eww-display-raw (charset)
114 (let ((data (buffer-substring (point) (point-max))))
115 (eww-setup-buffer)
116 (let ((inhibit-read-only t))
117 (insert data))
118 (goto-char (point-min))))
119
120(defun eww-display-image ()
121 (let ((data (buffer-substring (point) (point-max))))
122 (eww-setup-buffer)
123 (let ((inhibit-read-only t))
124 (shr-put-image data nil))
125 (goto-char (point-min))))
126
127(defun eww-setup-buffer ()
128 (pop-to-buffer (get-buffer-create "*eww*"))
129 (remove-overlays)
130 (setq widget-field-list nil)
131 (let ((inhibit-read-only t))
132 (erase-buffer))
133 (eww-mode))
134
135(defvar eww-mode-map
136 (let ((map (make-sparse-keymap)))
137 (suppress-keymap map)
138 (define-key map "q" 'eww-quit)
139 (define-key map "g" 'eww-reload)
140 (define-key map [tab] 'widget-forward)
141 (define-key map [backtab] 'widget-backward)
142 (define-key map [delete] 'scroll-down-command)
143 (define-key map "\177" 'scroll-down-command)
144 (define-key map " " 'scroll-up-command)
145 (define-key map "p" 'eww-previous-url)
146 ;;(define-key map "n" 'eww-next-url)
147 map))
148
149(define-derived-mode eww-mode nil "eww"
150 "Mode for browsing the web.
151
152\\{eww-mode-map}"
153 (set (make-local-variable 'eww-current-url) 'author)
154 (set (make-local-variable 'browse-url-browser-function) 'eww-browse-url))
155
156(defun eww-browse-url (url &optional new-window)
157 (let ((url-request-extra-headers
158 (append '(("User-Agent" . "eww/1.0"))
159 url-request-extra-headers)))
160 (push (list eww-current-url (point))
161 eww-history)
162 (eww url)))
163
164(defun eww-quit ()
165 "Exit the Emacs Web Wowser."
166 (interactive)
167 (setq eww-history nil)
168 (kill-buffer (current-buffer)))
169
170(defun eww-previous-url ()
171 "Go to the previously displayed page."
172 (interactive)
173 (when (zerop (length eww-history))
174 (error "No previous page"))
175 (let ((prev (pop eww-history)))
176 (url-retrieve (car prev) 'eww-render (list (car prev) (cadr prev)))))
177
178(defun eww-reload ()
179 "Reload the current page."
180 (interactive)
181 (url-retrieve eww-current-url 'eww-render
182 (list eww-current-url (point))))
183
184;; Form support.
185
186(defvar eww-form nil)
187
188(defun eww-tag-form (cont)
189 (let ((eww-form
190 (list (assq :method cont)
191 (assq :action cont)))
192 (start (point)))
193 (shr-ensure-paragraph)
194 (shr-generic cont)
195 (shr-ensure-paragraph)
196 (when (> (point) start)
197 (put-text-property start (1+ start)
198 'eww-form eww-form))))
199
200(defun eww-tag-input (cont)
201 (let* ((start (point))
202 (type (downcase (or (cdr (assq :type cont))
203 "text")))
204 (widget
205 (cond
206 ((equal type "submit")
207 (list
208 'push-button
209 :notify 'eww-submit
210 :name (cdr (assq :name cont))
211 :eww-form eww-form
212 (or (cdr (assq :value cont)) "Submit")))
213 ((or (equal type "radio")
214 (equal type "checkbox"))
215 (list 'checkbox
216 :notify 'eww-click-radio
217 :name (cdr (assq :name cont))
218 :checkbox-value (cdr (assq :value cont))
219 :checkbox-type type
220 :eww-form eww-form
221 (cdr (assq :checked cont))))
222 ((equal type "hidden")
223 (list 'hidden
224 :name (cdr (assq :name cont))
225 :value (cdr (assq :value cont))))
226 (t
227 (list
228 'editable-field
229 :size (string-to-number
230 (or (cdr (assq :size cont))
231 "40"))
232 :value (or (cdr (assq :value cont)) "")
233 :secret (and (equal type "password") ?*)
234 :action 'eww-submit
235 :name (cdr (assq :name cont))
236 :eww-form eww-form)))))
237 (if (eq (car widget) 'hidden)
238 (when shr-final-table-render
239 (nconc eww-form (list widget)))
240 (apply 'widget-create widget))
241 (put-text-property start (point) 'eww-widget widget)
242 (insert " ")))
243
244(defun eww-tag-select (cont)
245 (shr-ensure-paragraph)
246 (let ((menu (list 'menu-choice
247 :name (cdr (assq :name cont))
248 :eww-form eww-form))
249 (options nil)
250 (start (point)))
251 (dolist (elem cont)
252 (when (eq (car elem) 'option)
253 (when (cdr (assq :selected (cdr elem)))
254 (nconc menu (list :value
255 (cdr (assq :value (cdr elem))))))
256 (push (list 'item
257 :value (cdr (assq :value (cdr elem)))
258 :tag (cdr (assq 'text (cdr elem))))
259 options)))
260 ;; If we have no selected values, default to the first value.
261 (unless (plist-get (cdr menu) :value)
262 (nconc menu (list :value (nth 2 (car options)))))
263 (nconc menu options)
264 (apply 'widget-create menu)
265 (put-text-property start (point) 'eww-widget menu)
266 (shr-ensure-paragraph)))
267
268(defun eww-click-radio (widget &rest ignore)
269 (let ((form (plist-get (cdr widget) :eww-form))
270 (name (plist-get (cdr widget) :name)))
271 (when (equal (plist-get (cdr widget) :type) "radio")
272 (if (widget-value widget)
273 ;; Switch all the other radio buttons off.
274 (dolist (overlay (overlays-in (point-min) (point-max)))
275 (let ((field (plist-get (overlay-properties overlay) 'button)))
276 (when (and (eq (plist-get (cdr field) :eww-form) form)
277 (equal name (plist-get (cdr field) :name)))
278 (unless (eq field widget)
279 (widget-value-set field nil)))))
280 (widget-value-set widget t)))
281 (eww-fix-widget-keymap)))
282
283(defun eww-submit (widget &rest ignore)
284 (let ((form (plist-get (cdr widget) :eww-form))
285 (first-button t)
286 values)
287 (dolist (overlay (sort (overlays-in (point-min) (point-max))
288 (lambda (o1 o2)
289 (< (overlay-start o1) (overlay-start o2)))))
290 (let ((field (or (plist-get (overlay-properties overlay) 'field)
291 (plist-get (overlay-properties overlay) 'button)
292 (plist-get (overlay-properties overlay) 'eww-hidden))))
293 (when (eq (plist-get (cdr field) :eww-form) form)
294 (let ((name (plist-get (cdr field) :name)))
295 (when name
296 (cond
297 ((eq (car field) 'checkbox)
298 (when (widget-value field)
299 (push (cons name (plist-get (cdr field) :checkbox-value))
300 values)))
301 ((eq (car field) 'eww-hidden)
302 (push (cons name (plist-get (cdr field) :value))
303 values))
304 ((eq (car field) 'push-button)
305 ;; We want the values from buttons if we hit a button,
306 ;; or we're submitting something and this is the first
307 ;; button displayed.
308 (when (or (and (eq (car widget) 'push-button)
309 (eq widget field))
310 (and (not (eq (car widget) 'push-button))
311 (eq (car field) 'push-button)
312 first-button))
313 (setq first-button nil)
314 (push (cons name (widget-value field))
315 values)))
316 (t
317 (push (cons name (widget-value field))
318 values))))))))
319 (dolist (elem form)
320 (when (and (consp elem)
321 (eq (car elem) 'hidden))
322 (push (cons (plist-get (cdr elem) :name)
323 (plist-get (cdr elem) :value))
324 values)))
325 (let ((shr-base eww-current-url))
326 (if (and (stringp (cdr (assq :method form)))
327 (equal (downcase (cdr (assq :method form))) "post"))
328 (let ((url-request-method "POST")
329 (url-request-extra-headers
330 '(("Content-Type" . "application/x-www-form-urlencoded")))
331 (url-request-data (mm-url-encode-www-form-urlencoded values)))
332 (eww-browse-url (shr-expand-url (cdr (assq :action form)))))
333 (eww-browse-url
334 (shr-expand-url
335 (concat
336 (cdr (assq :action form))
337 "?"
338 (mm-url-encode-www-form-urlencoded values))))))))
339
340(defun eww-convert-widgets ()
341 (let ((start (point-min))
342 widget)
343 ;; Some widgets come from different buffers (rendered for tables),
344 ;; so we need to nix out the list of widgets and recreate them.
345 (setq widget-field-list nil
346 widget-field-new nil)
347 (while (setq start (next-single-property-change start 'eww-widget))
348 (setq widget (get-text-property start 'eww-widget))
349 (goto-char start)
350 (let ((end (next-single-property-change start 'eww-widget)))
351 (dolist (overlay (overlays-in start end))
352 (when (or (plist-get (overlay-properties overlay) 'button)
353 (plist-get (overlay-properties overlay) 'field))
354 (delete-overlay overlay)))
355 (delete-region start end))
356 (apply 'widget-create widget))
357 (widget-setup)
358 (eww-fix-widget-keymap)))
359
360(defun eww-fix-widget-keymap ()
361 (dolist (overlay (overlays-in (point-min) (point-max)))
362 (when (plist-get (overlay-properties overlay) 'button)
363 (overlay-put overlay 'local-map widget-keymap))))
364
365(provide 'eww)
366
367;;; eww.el ends here
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 23603bc7722..65f4b76ad19 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -3430,15 +3430,13 @@ possible values."
3430 (visible-date (mail-fetch-field "Date")) 3430 (visible-date (mail-fetch-field "Date"))
3431 pos date bface eface) 3431 pos date bface eface)
3432 (save-excursion 3432 (save-excursion
3433 (goto-char (point-min))
3434 (when (re-search-forward "^Date:" nil t)
3435 (setq bface (get-text-property (point-at-bol) 'face)
3436 eface (get-text-property (1- (point-at-eol)) 'face)))
3437 ;; Delete any old Date headers.
3438 (if date-position 3433 (if date-position
3439 (progn 3434 (progn
3440 (goto-char date-position) 3435 (goto-char date-position)
3441 (setq date (get-text-property (point) 'original-date)) 3436 (setq date (get-text-property (point) 'original-date))
3437 (when (looking-at "[^:]+:[\t ]*")
3438 (setq bface (get-text-property (match-beginning 0) 'face)
3439 eface (get-text-property (match-end 0) 'face)))
3442 (delete-region (point) 3440 (delete-region (point)
3443 (progn 3441 (progn
3444 (gnus-article-forward-header) 3442 (gnus-article-forward-header)
@@ -3454,12 +3452,26 @@ possible values."
3454 (narrow-to-region pos (if (search-forward "\n\n" nil t) 3452 (narrow-to-region pos (if (search-forward "\n\n" nil t)
3455 (1+ (match-beginning 0)) 3453 (1+ (match-beginning 0))
3456 (point-max))) 3454 (point-max)))
3457 (goto-char (point-min)) 3455 (while (setq pos (text-property-not-all pos (point-max)
3458 (while (re-search-forward "^Date:" nil t) 3456 'gnus-date-type nil))
3459 (setq date (get-text-property (match-beginning 0) 'original-date)) 3457 (setq date (get-text-property pos 'original-date))
3460 (delete-region (point-at-bol) (progn 3458 (goto-char pos)
3461 (gnus-article-forward-header) 3459 (when (looking-at "[^:]+:[\t ]*")
3462 (point)))) 3460 (setq bface (get-text-property (match-beginning 0) 'face)
3461 eface (get-text-property (match-end 0) 'face)))
3462 (delete-region pos (or (text-property-any pos (point-max)
3463 'gnus-date-type nil)
3464 (point-max))))
3465 (unless date ;; the 1st time
3466 (goto-char (point-min))
3467 (while (re-search-forward "^Date:[\t ]*" nil t)
3468 (setq date (get-text-property (match-beginning 0)
3469 'original-date)
3470 bface (get-text-property (match-beginning 0) 'face)
3471 eface (get-text-property (match-end 0) 'face))
3472 (delete-region (point-at-bol) (progn
3473 (gnus-article-forward-header)
3474 (point)))))
3463 (when (and (not date) 3475 (when (and (not date)
3464 visible-date) 3476 visible-date)
3465 (setq date visible-date)) 3477 (setq date visible-date))
@@ -3476,20 +3488,25 @@ possible values."
3476 (list type)) 3488 (list type))
3477 (t 3489 (t
3478 type))) 3490 type)))
3479 (insert (article-make-date-line date (or this-type 'ut)) "\n") 3491 (goto-char
3480 (forward-line -1) 3492 (prog1
3481 (beginning-of-line) 3493 (point)
3482 (put-text-property (point) (1+ (point)) 3494 (add-text-properties
3483 'original-date date) 3495 (point)
3484 (put-text-property (point) (1+ (point)) 3496 (progn
3485 'gnus-date-type this-type) 3497 (insert (article-make-date-line date (or this-type 'ut)) "\n")
3498 (point))
3499 (list 'original-date date 'gnus-date-type this-type))))
3486 ;; Do highlighting. 3500 ;; Do highlighting.
3487 (when (looking-at "\\([^:]+\\): *\\(.*\\)$") 3501 (when (looking-at
3488 (put-text-property (match-beginning 1) (1+ (match-end 1)) 3502 "\\([^:]+:\\)[\t ]*\\(\\(?:[^\t\n ]+[\t ]+\\)*[^\t\n ]+\\)?")
3489 'face bface) 3503 (put-text-property (match-beginning 1) (match-end 1) 'face bface)
3490 (put-text-property (match-beginning 2) (match-end 2) 3504 (when (match-beginning 2)
3491 'face eface)) 3505 (put-text-property (match-beginning 2) (match-end 2) 'face eface))
3492 (forward-line 1))) 3506 (while (and (zerop (forward-line 1))
3507 (looking-at "[\t ]+\\(\\(?:[^\t\n ]+[\t ]+\\)*[^\t\n ]+\\)?"))
3508 (when (match-beginning 1)
3509 (put-text-property (match-beginning 1) (match-end 1) 'face eface))))))
3493 3510
3494(defun article-make-date-line (date type) 3511(defun article-make-date-line (date type)
3495 "Return a DATE line of TYPE." 3512 "Return a DATE line of TYPE."
@@ -3669,25 +3686,26 @@ function and want to see what the date was before converting."
3669 (when (eq major-mode 'gnus-article-mode) 3686 (when (eq major-mode 'gnus-article-mode)
3670 (let ((old-line (count-lines (point-min) (point))) 3687 (let ((old-line (count-lines (point-min) (point)))
3671 (old-column (- (point) (line-beginning-position))) 3688 (old-column (- (point) (line-beginning-position)))
3672 (window-start 3689 (window-start (window-start w))
3673 (window-start (get-buffer-window (current-buffer))))) 3690 (pos (point-min))
3674 (goto-char (point-min)) 3691 type next end)
3675 (while (re-search-forward "^Date:" nil t) 3692 (while (setq pos (text-property-not-all pos (point-max)
3676 (let ((type (get-text-property (match-beginning 0) 3693 'gnus-date-type nil))
3677 'gnus-date-type))) 3694 (setq next (or (next-single-property-change pos
3678 (when (memq type '(lapsed combined-lapsed user-format)) 3695 'gnus-date-type)
3679 (when (and window-start 3696 (point-max)))
3680 (not (= window-start 3697 (setq type (get-text-property pos 'gnus-date-type))
3681 (save-excursion 3698 (when (memq type '(lapsed combined-lapsed user-defined))
3682 (forward-line 1) 3699 (article-date-ut type t pos)
3683 (point))))) 3700 (setq end (or (next-single-property-change pos
3684 (setq window-start nil)) 3701 'gnus-date-type)
3685 (save-excursion 3702 (point-max)))
3686 (article-date-ut type t (match-beginning 0))) 3703 (when window-start
3687 (forward-line 1) 3704 (if (/= window-start next)
3688 (when window-start 3705 (setq window-start nil)
3689 (set-window-start (get-buffer-window (current-buffer)) 3706 (set-window-start w end)))
3690 (point)))))) 3707 (setq next end))
3708 (setq pos next))
3691 (goto-char (point-min)) 3709 (goto-char (point-min))
3692 (when (> old-column 0) 3710 (when (> old-column 0)
3693 (setq old-line (1- old-line))) 3711 (setq old-line (1- old-line)))
diff --git a/lisp/gnus/gnus-ems.el b/lisp/gnus/gnus-ems.el
index 4d9b5798247..f9ef70f9580 100644
--- a/lisp/gnus/gnus-ems.el
+++ b/lisp/gnus/gnus-ems.el
@@ -165,10 +165,10 @@
165 165
166(defun gnus-image-type-available-p (type) 166(defun gnus-image-type-available-p (type)
167 (and (fboundp 'image-type-available-p) 167 (and (fboundp 'image-type-available-p)
168 (image-type-available-p type)
169 (if (fboundp 'display-images-p) 168 (if (fboundp 'display-images-p)
170 (display-images-p) 169 (display-images-p)
171 t))) 170 t)
171 (image-type-available-p type)))
172 172
173(defun gnus-create-image (file &optional type data-p &rest props) 173(defun gnus-create-image (file &optional type data-p &rest props)
174 (let ((face (plist-get props :face))) 174 (let ((face (plist-get props :face)))
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..8cb16634e2b 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,30 @@ 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 ;; Chop off the bit after the last slash.
491 (not (string-match "\\`/" url))) 498 (when (string-match "\\`\\(.*\\)[/][^/]+" base)
492 (concat shr-base "/" url)) 499 (setq base (match-string 1 base)))
493 (t 500 (cond
494 (concat shr-base url)))) 501 ((and (string-match "\\`//" url)
502 (string-match "\\`[a-z]*:" base))
503 (concat (match-string 0 base) url))
504 ((and (not (string-match "/\\'" base))
505 (not (string-match "\\`/" url)))
506 (concat base "/" url))
507 ((and (string-match "\\`/" url)
508 (string-match "\\(\\`[^:]*://[^/]+\\)/" base))
509 (concat (match-string 1 base) url))
510 (t
511 (concat base url))))))
495 512
496(defun shr-ensure-newline () 513(defun shr-ensure-newline ()
497 (unless (zerop (current-column)) 514 (unless (zerop (current-column))
@@ -877,6 +894,9 @@ ones, in case fg and bg are nil."
877(defun shr-tag-comment (cont) 894(defun shr-tag-comment (cont)
878 ) 895 )
879 896
897(defun shr-tag-svg (cont)
898 )
899
880(defun shr-tag-sup (cont) 900(defun shr-tag-sup (cont)
881 (let ((start (point))) 901 (let ((start (point)))
882 (shr-generic cont) 902 (shr-generic cont)
@@ -945,7 +965,8 @@ ones, in case fg and bg are nil."
945 plist))) 965 plist)))
946 966
947(defun shr-tag-base (cont) 967(defun shr-tag-base (cont)
948 (setq shr-base (cdr (assq :href cont)))) 968 (setq shr-base (cdr (assq :href cont)))
969 (shr-generic cont))
949 970
950(defun shr-tag-a (cont) 971(defun shr-tag-a (cont)
951 (let ((url (cdr (assq :href cont))) 972 (let ((url (cdr (assq :href cont)))
@@ -1167,7 +1188,8 @@ ones, in case fg and bg are nil."
1167 (frame-width)) 1188 (frame-width))
1168 (setq truncate-lines t)) 1189 (setq truncate-lines t))
1169 ;; Then render the table again with these new "hard" widths. 1190 ;; Then render the table again with these new "hard" widths.
1170 (shr-insert-table (shr-make-table cont sketch-widths t) sketch-widths)) 1191 (let ((shr-final-table-render t))
1192 (shr-insert-table (shr-make-table cont sketch-widths t) sketch-widths)))
1171 ;; Finally, insert all the images after the table. The Emacs buffer 1193 ;; 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 1194 ;; model isn't strong enough to allow us to put the images actually
1173 ;; into the tables. 1195 ;; 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/ibuffer.el b/lisp/ibuffer.el
index 586c8306a36..8f7d584d00b 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -2652,7 +2652,7 @@ will be inserted before the group at point."
2652;;;;;; ibuffer-backward-filter-group ibuffer-forward-filter-group 2652;;;;;; ibuffer-backward-filter-group ibuffer-forward-filter-group
2653;;;;;; ibuffer-toggle-filter-group ibuffer-mouse-toggle-filter-group 2653;;;;;; ibuffer-toggle-filter-group ibuffer-mouse-toggle-filter-group
2654;;;;;; ibuffer-interactive-filter-by-mode ibuffer-mouse-filter-by-mode 2654;;;;;; ibuffer-interactive-filter-by-mode ibuffer-mouse-filter-by-mode
2655;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "9950bdf995e4b5e962a17d754a35f2c6") 2655;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "2c628e6cde385119c5f7b43cc1efe1a1")
2656;;; Generated autoloads from ibuf-ext.el 2656;;; Generated autoloads from ibuf-ext.el
2657 2657
2658(autoload 'ibuffer-auto-mode "ibuf-ext" "\ 2658(autoload 'ibuffer-auto-mode "ibuf-ext" "\
@@ -2984,7 +2984,7 @@ Mark all buffers whose associated file does not exist.
2984\(fn)" t nil) 2984\(fn)" t nil)
2985 2985
2986(autoload 'ibuffer-mark-help-buffers "ibuf-ext" "\ 2986(autoload 'ibuffer-mark-help-buffers "ibuf-ext" "\
2987Mark buffers like *Help*, *Apropos*, *Info*. 2987Mark buffers whose major mode is in variable `ibuffer-help-buffer-modes'.
2988 2988
2989\(fn)" t nil) 2989\(fn)" t nil)
2990 2990
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/image-dired.el b/lisp/image-dired.el
index bbb41d49a1d..afb940fe337 100644
--- a/lisp/image-dired.el
+++ b/lisp/image-dired.el
@@ -156,8 +156,9 @@
156(require 'format-spec) 156(require 'format-spec)
157(require 'widget) 157(require 'widget)
158 158
159(require 'cl-lib)
160
159(eval-when-compile 161(eval-when-compile
160 (require 'cl-lib)
161 (require 'wid-edit)) 162 (require 'wid-edit))
162 163
163(defgroup image-dired nil 164(defgroup image-dired nil
@@ -657,9 +658,12 @@ previous -ARG, if ARG<0) files."
657 (string-match-p (image-file-name-regexp) image-file)) 658 (string-match-p (image-file-name-regexp) image-file))
658 (setq thumb-file (image-dired-get-thumbnail-image image-file)) 659 (setq thumb-file (image-dired-get-thumbnail-image image-file))
659 ;; If image is not already added, then add it. 660 ;; If image is not already added, then add it.
660 (let ((cur-ov (overlays-in (point) (1+ (point))))) 661 (let* ((cur-ovs (overlays-in (point) (1+ (point))))
661 (if cur-ov 662 (thumb-ov (car (cl-remove-if-not
662 (delete-overlay (car cur-ov)) 663 (lambda (ov) (overlay-get ov 'thumb-file))
664 cur-ovs))))
665 (if thumb-ov
666 (delete-overlay thumb-ov)
663 (put-image thumb-file image-pos) 667 (put-image thumb-file image-pos)
664 (setq overlay 668 (setq overlay
665 (cl-loop for o in (overlays-in (point) (1+ (point))) 669 (cl-loop for o in (overlays-in (point) (1+ (point)))
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/isearch.el b/lisp/isearch.el
index c49b0d7fc59..d9f8b0891e4 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -2152,6 +2152,15 @@ If nil, scrolling commands will first cancel Isearch mode."
2152 :type 'boolean 2152 :type 'boolean
2153 :group 'isearch) 2153 :group 'isearch)
2154 2154
2155(defcustom isearch-allow-prefix t
2156 "Whether prefix arguments are allowed during incremental search.
2157If non-nil, entering a prefix argument will not terminate the
2158search. This option is ignored \(presumed t) when
2159`isearch-allow-scroll' is set."
2160 :version "24.4"
2161 :type 'boolean
2162 :group 'isearch)
2163
2155(defun isearch-string-out-of-window (isearch-point) 2164(defun isearch-string-out-of-window (isearch-point)
2156 "Test whether the search string is currently outside of the window. 2165 "Test whether the search string is currently outside of the window.
2157Return nil if it's completely visible, or if point is visible, 2166Return nil if it's completely visible, or if point is visible,
@@ -2304,12 +2313,19 @@ Isearch mode."
2304 (setq prefix-arg arg) 2313 (setq prefix-arg arg)
2305 (apply 'isearch-unread keylist) 2314 (apply 'isearch-unread keylist)
2306 (isearch-edit-string)) 2315 (isearch-edit-string))
2307 ;; Handle a scrolling function. 2316 ;; Handle a scrolling function or prefix argument.
2308 ((and isearch-allow-scroll 2317 ((progn
2309 (progn (setq key (isearch-reread-key-sequence-naturally keylist)) 2318 (setq key (isearch-reread-key-sequence-naturally keylist)
2310 (setq keylist (listify-key-sequence key)) 2319 keylist (listify-key-sequence key)
2311 (setq main-event (aref key 0)) 2320 main-event (aref key 0))
2312 (setq scroll-command (isearch-lookup-scroll-key key)))) 2321 (or (and isearch-allow-scroll
2322 (setq scroll-command (isearch-lookup-scroll-key key)))
2323 (and isearch-allow-prefix
2324 (let (overriding-terminal-local-map)
2325 (setq scroll-command (key-binding key))
2326 (memq scroll-command
2327 '(universal-argument
2328 negative-argument digit-argument))))))
2313 ;; From this point onwards, KEY, KEYLIST and MAIN-EVENT hold a 2329 ;; From this point onwards, KEY, KEYLIST and MAIN-EVENT hold a
2314 ;; complete key sequence, possibly as modified by function-key-map, 2330 ;; complete key sequence, possibly as modified by function-key-map,
2315 ;; not merely the one or two event fragment which invoked 2331 ;; not merely the one or two event fragment which invoked
diff --git a/lisp/loadup.el b/lisp/loadup.el
index 5764cdec7eb..7fb9526b360 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -210,6 +210,7 @@
210(load "textmodes/page") 210(load "textmodes/page")
211(load "register") 211(load "register")
212(load "textmodes/paragraphs") 212(load "textmodes/paragraphs")
213(load "progmodes/prog-mode")
213(load "emacs-lisp/lisp-mode") 214(load "emacs-lisp/lisp-mode")
214(load "textmodes/text-mode") 215(load "textmodes/text-mode")
215(load "textmodes/fill") 216(load "textmodes/fill")
diff --git a/lisp/mail/reporter.el b/lisp/mail/reporter.el
index cc20c5c06ea..8f6715018c4 100644
--- a/lisp/mail/reporter.el
+++ b/lisp/mail/reporter.el
@@ -341,10 +341,10 @@ mail-sending package is used for editing and sending the message."
341 (mail-position-on-field "to") 341 (mail-position-on-field "to")
342 (insert address) 342 (insert address)
343 ;; insert problem summary if available 343 ;; insert problem summary if available
344 (if (and reporter-prompt-for-summary-p problem pkgname) 344 (when (and reporter-prompt-for-summary-p problem)
345 (progn 345 (mail-position-on-field "subject")
346 (mail-position-on-field "subject") 346 (if pkgname (insert pkgname "; "))
347 (insert pkgname "; " problem))) 347 (insert problem))
348 ;; move point to the body of the message 348 ;; move point to the body of the message
349 (mail-text) 349 (mail-text)
350 (forward-line 1) 350 (forward-line 1)
diff --git a/lisp/net/secrets.el b/lisp/net/secrets.el
index 9555cb41cfe..1951b195886 100644
--- a/lisp/net/secrets.el
+++ b/lisp/net/secrets.el
@@ -208,9 +208,9 @@ It returns t if not."
208;; <arg name="Prompt" type="o" direction="out"/> 208;; <arg name="Prompt" type="o" direction="out"/>
209;; </method> 209;; </method>
210;; <method name="GetSecrets"> 210;; <method name="GetSecrets">
211;; <arg name="items" type="ao" direction="in"/> 211;; <arg name="items" type="ao" direction="in"/>
212;; <arg name="session" type="o" direction="in"/> 212;; <arg name="session" type="o" direction="in"/>
213;; <arg name="secrets" type="a{o(oayay)}" direction="out"/> 213;; <arg name="secrets" type="a{o(oayays)}" direction="out"/>
214;; </method> 214;; </method>
215;; <method name="ReadAlias"> 215;; <method name="ReadAlias">
216;; <arg name="name" type="s" direction="in"/> 216;; <arg name="name" type="s" direction="in"/>
@@ -234,7 +234,7 @@ It returns t if not."
234;; <interface name="org.freedesktop.Secret.Collection"> 234;; <interface name="org.freedesktop.Secret.Collection">
235;; <property name="Items" type="ao" access="read"/> 235;; <property name="Items" type="ao" access="read"/>
236;; <property name="Label" type="s" access="readwrite"/> 236;; <property name="Label" type="s" access="readwrite"/>
237;; <property name="Locked" type="s" access="read"/> 237;; <property name="Locked" type="b" access="read"/>
238;; <property name="Created" type="t" access="read"/> 238;; <property name="Created" type="t" access="read"/>
239;; <property name="Modified" type="t" access="read"/> 239;; <property name="Modified" type="t" access="read"/>
240;; <method name="Delete"> 240;; <method name="Delete">
@@ -245,11 +245,11 @@ It returns t if not."
245;; <arg name="results" type="ao" direction="out"/> 245;; <arg name="results" type="ao" direction="out"/>
246;; </method> 246;; </method>
247;; <method name="CreateItem"> 247;; <method name="CreateItem">
248;; <arg name="props" type="a{sv}" direction="in"/> 248;; <arg name="props" type="a{sv}" direction="in"/>
249;; <arg name="secret" type="(oayay)" direction="in"/> 249;; <arg name="secret" type="(oayays)" direction="in"/>
250;; <arg name="replace" type="b" direction="in"/> 250;; <arg name="replace" type="b" direction="in"/>
251;; <arg name="item" type="o" direction="out"/> 251;; <arg name="item" type="o" direction="out"/>
252;; <arg name="prompt" type="o" direction="out"/> 252;; <arg name="prompt" type="o" direction="out"/>
253;; </method> 253;; </method>
254;; <signal name="ItemCreated"> 254;; <signal name="ItemCreated">
255;; <arg name="item" type="o"/> 255;; <arg name="item" type="o"/>
@@ -293,11 +293,11 @@ It returns t if not."
293;; <arg name="prompt" type="o" direction="out"/> 293;; <arg name="prompt" type="o" direction="out"/>
294;; </method> 294;; </method>
295;; <method name="GetSecret"> 295;; <method name="GetSecret">
296;; <arg name="session" type="o" direction="in"/> 296;; <arg name="session" type="o" direction="in"/>
297;; <arg name="secret" type="(oayay)" direction="out"/> 297;; <arg name="secret" type="(oayays)" direction="out"/>
298;; </method> 298;; </method>
299;; <method name="SetSecret"> 299;; <method name="SetSecret">
300;; <arg name="secret" type="(oayay)" direction="in"/> 300;; <arg name="secret" type="(oayays)" direction="in"/>
301;; </method> 301;; </method>
302;; </interface> 302;; </interface>
303;; 303;;
@@ -305,10 +305,22 @@ It returns t if not."
305;; OBJECT PATH session 305;; OBJECT PATH session
306;; ARRAY BYTE parameters 306;; ARRAY BYTE parameters
307;; ARRAY BYTE value 307;; ARRAY BYTE value
308;; STRING content_type ;; Added 2011/2/9
308 309
309(defconst secrets-interface-item-type-generic "org.freedesktop.Secret.Generic" 310(defconst secrets-interface-item-type-generic "org.freedesktop.Secret.Generic"
310 "The default item type we are using.") 311 "The default item type we are using.")
311 312
313(defconst secrets-struct-secret-content-type
314 (when (string-equal
315 (dbus-introspect-get-signature
316 :session secrets-service secrets-path secrets-interface-service
317 "GetSecrets" "out")
318 "a{o(oayays)}")
319 '("text/plain"))
320 "The content_type of a secret struct.
321It must be wrapped as list, because we add it via `append'. This
322is an interface introduced in 2011.")
323
312(defconst secrets-interface-session "org.freedesktop.Secret.Session" 324(defconst secrets-interface-session "org.freedesktop.Secret.Session"
313 "A session tracks state between the service and a client application.") 325 "A session tracks state between the service and a client application.")
314 326
@@ -616,16 +628,21 @@ The object path of the created item is returned."
616 ;; Properties. 628 ;; Properties.
617 (append 629 (append
618 `(:array 630 `(:array
619 (:dict-entry "Label" (:variant ,item)) 631 (:dict-entry ,(concat secrets-interface-item ".Label")
620 (:dict-entry 632 (:variant ,item))
621 "Type" (:variant ,secrets-interface-item-type-generic))) 633 (:dict-entry ,(concat secrets-interface-item ".Type")
634 (:variant ,secrets-interface-item-type-generic)))
622 (when props 635 (when props
623 `((:dict-entry 636 `((:dict-entry ,(concat secrets-interface-item ".Attributes")
624 "Attributes" (:variant ,(append '(:array) props)))))) 637 (:variant ,(append '(:array) props))))))
625 ;; Secret. 638 ;; Secret.
626 `(:struct :object-path ,secrets-session-path 639 (append
627 (:array :signature "y") ;; no parameters. 640 `(:struct :object-path ,secrets-session-path
628 ,(dbus-string-to-byte-array password)) 641 (:array :signature "y") ;; No parameters.
642 ,(dbus-string-to-byte-array password))
643 ;; We add the content_type. In backward compatibility
644 ;; mode, nil is appended, which means nothing.
645 secrets-struct-secret-content-type)
629 ;; Do not replace. Replace does not seem to work. 646 ;; Do not replace. Replace does not seem to work.
630 nil)) 647 nil))
631 (secrets-prompt (cadr result)) 648 (secrets-prompt (cadr result))
diff --git a/lisp/net/tls.el b/lisp/net/tls.el
index 7fc314ef088..3d8d8decf47 100644
--- a/lisp/net/tls.el
+++ b/lisp/net/tls.el
@@ -286,7 +286,10 @@ NOT trusted. Accept anyway? " host)))))
286 (format "Host name in certificate doesn't \ 286 (format "Host name in certificate doesn't \
287match `%s'. Connect anyway? " host)))))) 287match `%s'. Connect anyway? " host))))))
288 (setq done nil) 288 (setq done nil)
289 (delete-process process))) 289 (delete-process process))
290 ;; Delete all the informational messages that could confuse
291 ;; future uses of `buffer'.
292 (delete-region (point-min) (point)))
290 (message "Opening TLS connection to `%s'...%s" 293 (message "Opening TLS connection to `%s'...%s"
291 host (if done "done" "failed")) 294 host (if done "done" "failed"))
292 (when use-temp-buffer 295 (when use-temp-buffer
diff --git a/lisp/newcomment.el b/lisp/newcomment.el
index e10b96f97f9..bcb5f721ae8 100644
--- a/lisp/newcomment.el
+++ b/lisp/newcomment.el
@@ -485,29 +485,27 @@ and raises an error or returns nil if NOERROR is non-nil."
485Moves point to inside the comment and returns the position of the 485Moves point to inside the comment and returns the position of the
486comment-starter. If no comment is found, moves point to LIMIT 486comment-starter. If no comment is found, moves point to LIMIT
487and raises an error or returns nil if NOERROR is non-nil." 487and raises an error or returns nil if NOERROR is non-nil."
488 (let (found end) 488 ;; FIXME: If a comment-start appears inside a comment, we may erroneously
489 (while (and (not found) 489 ;; stop there. This can be rather bad in general, but since
490 (re-search-backward comment-start-skip limit t)) 490 ;; comment-search-backward is only used to find the comment-column (in
491 (setq end (match-end 0)) 491 ;; comment-set-column) and to find the comment-start string (via
492 (unless (and comment-use-syntax 492 ;; comment-beginning) in indent-new-comment-line, it should be harmless.
493 (nth 8 (syntax-ppss (or (match-end 1) 493 (if (not (re-search-backward comment-start-skip limit t))
494 (match-beginning 0))))) 494 (unless noerror (error "No comment"))
495 (setq found t))) 495 (beginning-of-line)
496 (if (not found) 496 (let* ((end (match-end 0))
497 (unless noerror (error "No comment")) 497 (cs (comment-search-forward end t))
498 (beginning-of-line) 498 (pt (point)))
499 (let ((cs (comment-search-forward end t)) 499 (if (not cs)
500 (pt (point))) 500 (progn (beginning-of-line)
501 (if (not cs) 501 (comment-search-backward limit noerror))
502 (progn (beginning-of-line) 502 (while (progn (goto-char cs)
503 (comment-search-backward limit noerror)) 503 (comment-forward)
504 (while (progn (goto-char cs) 504 (and (< (point) end)
505 (comment-forward) 505 (setq cs (comment-search-forward end t))))
506 (and (< (point) end) 506 (setq pt (point)))
507 (setq cs (comment-search-forward end t)))) 507 (goto-char pt)
508 (setq pt (point))) 508 cs))))
509 (goto-char pt)
510 cs)))))
511 509
512(defun comment-beginning () 510(defun comment-beginning ()
513 "Find the beginning of the enclosing comment. 511 "Find the beginning of the enclosing comment.
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index b0c0bfd7bde..9077bdbb513 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -9355,10 +9355,6 @@ comment at the start of cc-engine.el for more info."
9355 containing-sexp nil))) 9355 containing-sexp nil)))
9356 (setq lim (1+ containing-sexp)))) 9356 (setq lim (1+ containing-sexp))))
9357 (setq lim (point-min))) 9357 (setq lim (point-min)))
9358 (when (c-beginning-of-macro)
9359 (goto-char indent-point)
9360 (let ((lim1 (c-determine-limit 2000)))
9361 (setq lim (max lim lim1))))
9362 9358
9363 ;; If we're in a parenthesis list then ',' delimits the 9359 ;; If we're in a parenthesis list then ',' delimits the
9364 ;; "statements" rather than being an operator (with the 9360 ;; "statements" rather than being an operator (with the
diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el
index 11eb0eeaf49..01b5faef5b3 100644
--- a/lisp/progmodes/cfengine.el
+++ b/lisp/progmodes/cfengine.el
@@ -527,6 +527,11 @@ Intended as the value of `indent-line-function'."
527 ;; Doze path separators. 527 ;; Doze path separators.
528 (modify-syntax-entry ?\\ "." table)) 528 (modify-syntax-entry ?\\ "." table))
529 529
530(defconst cfengine3--prettify-symbols-alist
531 '(("->" . ?→)
532 ("=>" . ?⇒)
533 ("::" . ?∷)))
534
530;;;###autoload 535;;;###autoload
531(define-derived-mode cfengine3-mode prog-mode "CFE3" 536(define-derived-mode cfengine3-mode prog-mode "CFE3"
532 "Major mode for editing CFEngine3 input. 537 "Major mode for editing CFEngine3 input.
@@ -538,8 +543,11 @@ to the action header."
538 (cfengine-common-syntax cfengine3-mode-syntax-table) 543 (cfengine-common-syntax cfengine3-mode-syntax-table)
539 544
540 (set (make-local-variable 'indent-line-function) #'cfengine3-indent-line) 545 (set (make-local-variable 'indent-line-function) #'cfengine3-indent-line)
546
541 (setq font-lock-defaults 547 (setq font-lock-defaults
542 '(cfengine3-font-lock-keywords nil nil nil beginning-of-defun)) 548 '(cfengine3-font-lock-keywords
549 nil nil nil beginning-of-defun))
550 (prog-prettify-install cfengine3--prettify-symbols-alist)
543 551
544 ;; Use defuns as the essential syntax block. 552 ;; Use defuns as the essential syntax block.
545 (set (make-local-variable 'beginning-of-defun-function) 553 (set (make-local-variable 'beginning-of-defun-function)
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index d6f136ec92d..d9c482330cc 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -1002,7 +1002,7 @@ POS and RES.")
1002 (let ((win (get-buffer-window buffer 0))) 1002 (let ((win (get-buffer-window buffer 0)))
1003 (if win (set-window-point win pos))) 1003 (if win (set-window-point win pos)))
1004 (if compilation-auto-jump-to-first-error 1004 (if compilation-auto-jump-to-first-error
1005 (compile-goto-error)))) 1005 (compile-goto-error nil t))))
1006 1006
1007;; This function is the central driver, called when font-locking to gather 1007;; This function is the central driver, called when font-locking to gather
1008;; all information needed to later jump to corresponding source code. 1008;; all information needed to later jump to corresponding source code.
@@ -2317,7 +2317,7 @@ Prefix arg N says how many files to move backwards (or forwards, if negative)."
2317 2317
2318(defalias 'compile-mouse-goto-error 'compile-goto-error) 2318(defalias 'compile-mouse-goto-error 'compile-goto-error)
2319 2319
2320(defun compile-goto-error (&optional event) 2320(defun compile-goto-error (&optional event nomsg)
2321 "Visit the source for the error message at point. 2321 "Visit the source for the error message at point.
2322Use this command in a compilation log buffer. Sets the mark at point there." 2322Use this command in a compilation log buffer. Sets the mark at point there."
2323 (interactive (list last-input-event)) 2323 (interactive (list last-input-event))
@@ -2328,7 +2328,7 @@ Use this command in a compilation log buffer. Sets the mark at point there."
2328 (if (get-text-property (point) 'compilation-directory) 2328 (if (get-text-property (point) 'compilation-directory)
2329 (dired-other-window 2329 (dired-other-window
2330 (car (get-text-property (point) 'compilation-directory))) 2330 (car (get-text-property (point) 'compilation-directory)))
2331 (push-mark) 2331 (push-mark nil nomsg)
2332 (setq compilation-current-error (point)) 2332 (setq compilation-current-error (point))
2333 (next-error-internal))) 2333 (next-error-internal)))
2334 2334
diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el
index c6e19fe3a15..b1936467274 100644
--- a/lisp/progmodes/octave.el
+++ b/lisp/progmodes/octave.el
@@ -89,7 +89,7 @@ Used in `octave-mode' and `inferior-octave-mode' buffers.")
89 89
90(defvar octave-function-header-regexp 90(defvar octave-function-header-regexp
91 (concat "^\\s-*\\_<\\(function\\)\\_>" 91 (concat "^\\s-*\\_<\\(function\\)\\_>"
92 "\\([^=;\n]*=[ \t]*\\|[ \t]*\\)\\(\\(?:\\w\\|\\s_\\)+\\)\\_>") 92 "\\([^=;(\n]*=[ \t]*\\|[ \t]*\\)\\(\\(?:\\w\\|\\s_\\)+\\)\\_>")
93 "Regexp to match an Octave function header. 93 "Regexp to match an Octave function header.
94The string `function' and its name are given by the first and third 94The string `function' and its name are given by the first and third
95parenthetical grouping.") 95parenthetical grouping.")
@@ -153,10 +153,10 @@ parenthetical grouping.")
153 'eldoc-mode)) 153 'eldoc-mode))
154 :style toggle :selected (or eldoc-post-insert-mode eldoc-mode) 154 :style toggle :selected (or eldoc-post-insert-mode eldoc-mode)
155 :help "Display function signatures after typing `SPC' or `('"] 155 :help "Display function signatures after typing `SPC' or `('"]
156 ["Delimiter Matching" smie-highlight-matching-block-mode 156 ["Delimiter Matching" show-paren-mode
157 :style toggle :selected smie-highlight-matching-block-mode 157 :style toggle :selected show-paren-mode
158 :help "Highlight matched pairs such as `if ... end'" 158 :help "Highlight matched pairs such as `if ... end'"
159 :visible (fboundp 'smie-highlight-matching-block-mode)] 159 :visible (fboundp 'smie--matching-block-data)]
160 ["Auto Fill" auto-fill-mode 160 ["Auto Fill" auto-fill-mode
161 :style toggle :selected auto-fill-function 161 :style toggle :selected auto-fill-function
162 :help "Automatic line breaking"] 162 :help "Automatic line breaking"]
@@ -540,6 +540,7 @@ definitions can also be stored in files and used in batch mode."
540 ;; a ";" at those places where it's correct (i.e. outside of parens). 540 ;; a ";" at those places where it's correct (i.e. outside of parens).
541 (setq-local electric-layout-rules '((?\; . after))) 541 (setq-local electric-layout-rules '((?\; . after)))
542 542
543 (setq-local comment-use-global-state t)
543 (setq-local comment-start octave-comment-start) 544 (setq-local comment-start octave-comment-start)
544 (setq-local comment-end "") 545 (setq-local comment-end "")
545 (setq-local comment-start-skip octave-comment-start-skip) 546 (setq-local comment-start-skip octave-comment-start-skip)
@@ -563,6 +564,8 @@ definitions can also be stored in files and used in batch mode."
563 (setq-local imenu-generic-expression octave-mode-imenu-generic-expression) 564 (setq-local imenu-generic-expression octave-mode-imenu-generic-expression)
564 (setq-local imenu-case-fold-search nil) 565 (setq-local imenu-case-fold-search nil)
565 566
567 (setq-local add-log-current-defun-function #'octave-add-log-current-defun)
568
566 (add-hook 'completion-at-point-functions 'octave-completion-at-point nil t) 569 (add-hook 'completion-at-point-functions 'octave-completion-at-point nil t)
567 (add-hook 'before-save-hook 'octave-sync-function-file-names nil t) 570 (add-hook 'before-save-hook 'octave-sync-function-file-names nil t)
568 (setq-local beginning-of-defun-function 'octave-beginning-of-defun) 571 (setq-local beginning-of-defun-function 'octave-beginning-of-defun)
@@ -605,12 +608,13 @@ startup."
605 :group 'octave 608 :group 'octave
606 :version "24.4") 609 :version "24.4")
607 610
608(defcustom inferior-octave-startup-args nil 611(defcustom inferior-octave-startup-args '("-i" "--no-line-editing")
609 "List of command line arguments for the inferior Octave process. 612 "List of command line arguments for the inferior Octave process.
610For example, for suppressing the startup message and using `traditional' 613For example, for suppressing the startup message and using `traditional'
611mode, set this to (\"-q\" \"--traditional\")." 614mode, include \"-q\" and \"--traditional\"."
612 :type '(repeat string) 615 :type '(repeat string)
613 :group 'octave) 616 :group 'octave
617 :version "24.4")
614 618
615(defcustom inferior-octave-mode-hook nil 619(defcustom inferior-octave-mode-hook nil
616 "Hook to be run when Inferior Octave mode is started." 620 "Hook to be run when Inferior Octave mode is started."
@@ -664,6 +668,7 @@ in the Inferior Octave buffer.")
664 :abbrev-table octave-abbrev-table 668 :abbrev-table octave-abbrev-table
665 (setq comint-prompt-regexp inferior-octave-prompt) 669 (setq comint-prompt-regexp inferior-octave-prompt)
666 670
671 (setq-local comment-use-global-state t)
667 (setq-local comment-start octave-comment-start) 672 (setq-local comment-start octave-comment-start)
668 (setq-local comment-end "") 673 (setq-local comment-end "")
669 (setq comment-column 32) 674 (setq comment-column 32)
@@ -719,13 +724,13 @@ startup file, `~/.emacs-octave'."
719 (substring inferior-octave-buffer 1 -1) 724 (substring inferior-octave-buffer 1 -1)
720 inferior-octave-buffer 725 inferior-octave-buffer
721 inferior-octave-program 726 inferior-octave-program
722 (append (list "-i" "--no-line-editing") 727 (append
723 ;; --no-gui is introduced in Octave > 3.7 728 inferior-octave-startup-args
724 (when (zerop (process-file inferior-octave-program 729 ;; --no-gui is introduced in Octave > 3.7
725 nil nil nil 730 (and (not (member "--no-gui" inferior-octave-startup-args))
726 "--no-gui" "--help")) 731 (zerop (process-file inferior-octave-program
727 (list "--no-gui")) 732 nil nil nil "--no-gui" "--help"))
728 inferior-octave-startup-args)))) 733 '("--no-gui"))))))
729 (set-process-filter proc 'inferior-octave-output-digest) 734 (set-process-filter proc 'inferior-octave-output-digest)
730 (setq inferior-octave-process proc 735 (setq inferior-octave-process proc
731 inferior-octave-output-list nil 736 inferior-octave-output-list nil
@@ -755,10 +760,10 @@ startup file, `~/.emacs-octave'."
755 (inferior-octave-send-list-and-digest (list "PS2\n")) 760 (inferior-octave-send-list-and-digest (list "PS2\n"))
756 (when (string-match "\\(PS2\\|ans\\) = *$" 761 (when (string-match "\\(PS2\\|ans\\) = *$"
757 (car inferior-octave-output-list)) 762 (car inferior-octave-output-list))
758 (inferior-octave-send-list-and-digest (list "PS2 (\"> \");\n"))) 763 (inferior-octave-send-list-and-digest (list "PS2 ('> ');\n")))
759 764
760 (inferior-octave-send-list-and-digest 765 (inferior-octave-send-list-and-digest
761 (list "disp(getenv(\"OCTAVE_SRCDIR\"))\n")) 766 (list "disp (getenv ('OCTAVE_SRCDIR'))\n"))
762 (process-put proc 'octave-srcdir 767 (process-put proc 'octave-srcdir
763 (unless (equal (car inferior-octave-output-list) "") 768 (unless (equal (car inferior-octave-output-list) "")
764 (car inferior-octave-output-list))) 769 (car inferior-octave-output-list)))
@@ -767,19 +772,19 @@ startup file, `~/.emacs-octave'."
767 (inferior-octave-send-list-and-digest 772 (inferior-octave-send-list-and-digest
768 (list "more off;\n" 773 (list "more off;\n"
769 (unless (equal inferior-octave-output-string ">> ") 774 (unless (equal inferior-octave-output-string ">> ")
770 "PS1 (\"\\\\s> \");\n") 775 "PS1 ('\\s> ');\n")
771 (when (and inferior-octave-startup-file 776 (when (and inferior-octave-startup-file
772 (file-exists-p inferior-octave-startup-file)) 777 (file-exists-p inferior-octave-startup-file))
773 (format "source (\"%s\");\n" inferior-octave-startup-file)))) 778 (format "source ('%s');\n" inferior-octave-startup-file))))
774 (when inferior-octave-output-list 779 (when inferior-octave-output-list
775 (insert-before-markers 780 (insert-before-markers
776 (mapconcat 'identity inferior-octave-output-list "\n"))) 781 (mapconcat 'identity inferior-octave-output-list "\n")))
777 782
778 ;; And finally, everything is back to normal. 783 ;; And finally, everything is back to normal.
779 (set-process-filter proc 'comint-output-filter) 784 (set-process-filter proc 'comint-output-filter)
780 ;; 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
781 ;; won't have detrimental effects. 786 ;; detrimental effects.
782 (inferior-octave-resync-dirs) 787 (with-demoted-errors (inferior-octave-resync-dirs))
783 ;; Generate a proper prompt, which is critical to 788 ;; Generate a proper prompt, which is critical to
784 ;; `comint-history-isearch-backward-regexp'. Bug#14433. 789 ;; `comint-history-isearch-backward-regexp'. Bug#14433.
785 (comint-send-string proc "\n"))) 790 (comint-send-string proc "\n")))
@@ -795,7 +800,7 @@ startup file, `~/.emacs-octave'."
795 (unless (and (equal (car cache) command) 800 (unless (and (equal (car cache) command)
796 (< (float-time) (+ 5 (cadr cache)))) 801 (< (float-time) (+ 5 (cadr cache))))
797 (inferior-octave-send-list-and-digest 802 (inferior-octave-send-list-and-digest
798 (list (concat "completion_matches (\"" command "\");\n"))) 803 (list (format "completion_matches ('%s');\n" command)))
799 (setq cache (list command (float-time) 804 (setq cache (list command (float-time)
800 (delete-consecutive-dups 805 (delete-consecutive-dups
801 (sort inferior-octave-output-list 'string-lessp))))) 806 (sort inferior-octave-output-list 'string-lessp)))))
@@ -894,8 +899,8 @@ output is passed to the filter `inferior-octave-output-digest'."
894 "Tracks `cd' commands issued to the inferior Octave process. 899 "Tracks `cd' commands issued to the inferior Octave process.
895Use \\[inferior-octave-resync-dirs] to resync if Emacs gets confused." 900Use \\[inferior-octave-resync-dirs] to resync if Emacs gets confused."
896 (when inferior-octave-directory-tracker-resync 901 (when inferior-octave-directory-tracker-resync
897 (setq inferior-octave-directory-tracker-resync nil) 902 (or (inferior-octave-resync-dirs 'noerror)
898 (inferior-octave-resync-dirs)) 903 (setq inferior-octave-directory-tracker-resync nil)))
899 (cond 904 (cond
900 ((string-match "^[ \t]*cd[ \t;]*$" string) 905 ((string-match "^[ \t]*cd[ \t;]*$" string)
901 (cd "~")) 906 (cd "~"))
@@ -907,13 +912,17 @@ Use \\[inferior-octave-resync-dirs] to resync if Emacs gets confused."
907 (error-message-string err) 912 (error-message-string err)
908 (match-string 1 string))))))) 913 (match-string 1 string)))))))
909 914
910(defun inferior-octave-resync-dirs () 915(defun inferior-octave-resync-dirs (&optional noerror)
911 "Resync the buffer's idea of the current directory. 916 "Resync the buffer's idea of the current directory.
912This command queries the inferior Octave process about its current 917This command queries the inferior Octave process about its current
913directory and makes this the current buffer's default directory." 918directory and makes this the current buffer's default directory."
914 (interactive) 919 (interactive)
915 (inferior-octave-send-list-and-digest '("disp (pwd ())\n")) 920 (inferior-octave-send-list-and-digest '("disp (pwd ())\n"))
916 (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))))))
917 926
918(defcustom inferior-octave-minimal-columns 80 927(defcustom inferior-octave-minimal-columns 80
919 "The minimal column width for the inferior Octave process." 928 "The minimal column width for the inferior Octave process."
@@ -931,7 +940,7 @@ directory and makes this the current buffer's default directory."
931 (when (and inferior-octave-process 940 (when (and inferior-octave-process
932 (process-live-p inferior-octave-process)) 941 (process-live-p inferior-octave-process))
933 (inferior-octave-send-list-and-digest 942 (inferior-octave-send-list-and-digest
934 (list (format "putenv(\"COLUMNS\", \"%s\");\n" width))))))) 943 (list (format "putenv ('COLUMNS', '%s');\n" width)))))))
935 944
936 945
937;;; Miscellaneous useful functions 946;;; Miscellaneous useful functions
@@ -975,16 +984,17 @@ directory and makes this the current buffer's default directory."
975 984
976(defun octave-goto-function-definition (fn) 985(defun octave-goto-function-definition (fn)
977 "Go to the function definition of FN in current buffer." 986 "Go to the function definition of FN in current buffer."
978 (goto-char (point-min))
979 (let ((search 987 (let ((search
980 (lambda (re sub) 988 (lambda (re sub)
981 (let (done) 989 (let ((orig (point)) found)
982 (while (and (not done) (re-search-forward re nil t)) 990 (goto-char (point-min))
991 (while (and (not found) (re-search-forward re nil t))
983 (when (and (equal (match-string sub) fn) 992 (when (and (equal (match-string sub) fn)
984 (not (nth 8 (syntax-ppss)))) 993 (not (nth 8 (syntax-ppss))))
985 (setq done t))) 994 (setq found t)))
986 (or done (goto-char (point-min))))))) 995 (unless found (goto-char orig))
987 (pcase (file-name-extension (buffer-file-name)) 996 found))))
997 (pcase (and buffer-file-name (file-name-extension buffer-file-name))
988 (`"cc" (funcall search 998 (`"cc" (funcall search
989 "\\_<DEFUN\\(?:_DLD\\)?\\s-*(\\s-*\\(\\(?:\\sw\\|\\s_\\)+\\)" 1)) 999 "\\_<DEFUN\\(?:_DLD\\)?\\s-*(\\s-*\\(\\(?:\\sw\\|\\s_\\)+\\)" 1))
990 (t (funcall search octave-function-header-regexp 3))))) 1000 (t (funcall search octave-function-header-regexp 3)))))
@@ -1345,8 +1355,6 @@ The block marked is the one that contains point or follows point."
1345 (forward-line 1)))) 1355 (forward-line 1))))
1346 t))) 1356 t)))
1347 1357
1348;;; Completions
1349
1350(defun octave-completion-at-point () 1358(defun octave-completion-at-point ()
1351 "Find the text to complete and the corresponding table." 1359 "Find the text to complete and the corresponding table."
1352 (let* ((beg (save-excursion (skip-syntax-backward "w_") (point))) 1360 (let* ((beg (save-excursion (skip-syntax-backward "w_") (point)))
@@ -1363,6 +1371,16 @@ The block marked is the one that contains point or follows point."
1363 1371
1364(define-obsolete-function-alias 'octave-complete-symbol 1372(define-obsolete-function-alias 'octave-complete-symbol
1365 'completion-at-point "24.1") 1373 'completion-at-point "24.1")
1374
1375(defun octave-add-log-current-defun ()
1376 "A function for `add-log-current-defun-function' (which see)."
1377 (save-excursion
1378 (end-of-line)
1379 (and (beginning-of-defun)
1380 (re-search-forward octave-function-header-regexp
1381 (line-end-position) t)
1382 (match-string 3))))
1383
1366 1384
1367;;; Electric characters && friends 1385;;; Electric characters && friends
1368(define-skeleton octave-insert-defun 1386(define-skeleton octave-insert-defun
@@ -1387,7 +1405,7 @@ entered without parens)."
1387 "function " > str \n 1405 "function " > str \n
1388 _ \n 1406 _ \n
1389 "endfunction" > \n) 1407 "endfunction" > \n)
1390 1408
1391;;; Communication with the inferior Octave process 1409;;; Communication with the inferior Octave process
1392(defun octave-kill-process () 1410(defun octave-kill-process ()
1393 "Kill inferior Octave process and its buffer." 1411 "Kill inferior Octave process and its buffer."
@@ -1506,9 +1524,7 @@ code line."
1506(defun octave-eldoc-function-signatures (fn) 1524(defun octave-eldoc-function-signatures (fn)
1507 (unless (equal fn (car octave-eldoc-cache)) 1525 (unless (equal fn (car octave-eldoc-cache))
1508 (inferior-octave-send-list-and-digest 1526 (inferior-octave-send-list-and-digest
1509 (list (format "\ 1527 (list (format "print_usage ('%s');\n" fn)))
1510if ismember(exist(\"%s\"), [2 3 5 103]) print_usage(\"%s\") endif\n"
1511 fn fn)))
1512 (let (result) 1528 (let (result)
1513 (dolist (line inferior-octave-output-list) 1529 (dolist (line inferior-octave-output-list)
1514 (when (string-match 1530 (when (string-match
@@ -1605,20 +1621,11 @@ if ismember(exist(\"%s\"), [2 3 5 103]) print_usage(\"%s\") endif\n"
1605 (when (or help-xref-stack help-xref-forward-stack) 1621 (when (or help-xref-stack help-xref-forward-stack)
1606 (insert "\n")))) 1622 (insert "\n"))))
1607 1623
1608(defvar octave-help-mode-finish-hook nil
1609 "Octave specific hook for `temp-buffer-show-hook'.")
1610
1611(defun octave-help-mode-finish ()
1612 (when (eq major-mode 'octave-help-mode)
1613 (run-hooks 'octave-help-mode-finish-hook)))
1614
1615(add-hook 'temp-buffer-show-hook 'octave-help-mode-finish)
1616
1617(defun octave-help (fn) 1624(defun octave-help (fn)
1618 "Display the documentation of FN." 1625 "Display the documentation of FN."
1619 (interactive (list (octave-completing-read))) 1626 (interactive (list (octave-completing-read)))
1620 (inferior-octave-send-list-and-digest 1627 (inferior-octave-send-list-and-digest
1621 (list (format "help \"%s\"\n" fn))) 1628 (list (format "help ('%s');\n" fn)))
1622 (let ((lines inferior-octave-output-list) 1629 (let ((lines inferior-octave-output-list)
1623 (inhibit-read-only t)) 1630 (inhibit-read-only t))
1624 (when (string-match "error: \\(.*\\)$" (car lines)) 1631 (when (string-match "error: \\(.*\\)$" (car lines))
@@ -1654,12 +1661,15 @@ if ismember(exist(\"%s\"), [2 3 5 103]) print_usage(\"%s\") endif\n"
1654 (help-insert-xref-button (file-relative-name file dir) 1661 (help-insert-xref-button (file-relative-name file dir)
1655 'octave-help-file fn) 1662 'octave-help-file fn)
1656 (insert "'"))) 1663 (insert "'")))
1657 ;; Make 'See also' clickable 1664 ;; Make 'See also' clickable.
1658 (with-syntax-table octave-mode-syntax-table 1665 (with-syntax-table octave-mode-syntax-table
1659 (when (re-search-forward "^\\s-*See also:" nil t) 1666 (when (re-search-forward "^\\s-*See also:" nil t)
1660 (let ((end (save-excursion (re-search-forward "^\\s-*$" nil t)))) 1667 (let ((end (save-excursion (re-search-forward "^\\s-*$" nil t))))
1661 (while (re-search-forward "\\_<\\(?:\\sw\\|\\s_\\)+\\_>" end t) 1668 (while (re-search-forward
1662 (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)
1663 :type 'octave-help-function))))) 1673 :type 'octave-help-function)))))
1664 (octave-help-mode))))) 1674 (octave-help-mode)))))
1665 1675
@@ -1710,23 +1720,30 @@ If the environment variable OCTAVE_SRCDIR is set, it is searched first."
1710Functions implemented in C++ can be found if 1720Functions implemented in C++ can be found if
1711`octave-source-directories' is set correctly." 1721`octave-source-directories' is set correctly."
1712 (interactive (list (octave-completing-read))) 1722 (interactive (list (octave-completing-read)))
1713 (inferior-octave-send-list-and-digest 1723 (require 'etags)
1714 ;; help NAME is more verbose 1724 (let ((orig (point)))
1715 (list (format "\ 1725 (if (and (derived-mode-p 'octave-mode)
1716if iskeyword(\"%s\") disp(\"`%s' is a keyword\") else which(\"%s\") endif\n" 1726 (octave-goto-function-definition fn))
1717 fn fn fn))) 1727 (ring-insert find-tag-marker-ring (copy-marker orig))
1718 (let* ((line (car inferior-octave-output-list)) 1728 (inferior-octave-send-list-and-digest
1719 (file (when (and line (string-match "from the file \\(.*\\)$" line)) 1729 ;; help NAME is more verbose
1720 (match-string 1 line)))) 1730 (list (format "\
1721 (if (not file) 1731if iskeyword('%s') disp('`%s'' is a keyword') else which('%s') endif\n"
1722 (user-error "%s" (or line (format "`%s' not found" fn))) 1732 fn fn fn)))
1723 (require 'etags) 1733 (let (line file)
1724 (ring-insert find-tag-marker-ring (point-marker)) 1734 ;; Skip garbage lines such as
1725 (setq file (funcall octave-find-definition-filename-function file)) 1735 ;; warning: fmincg.m: possible Matlab-style ....
1726 (when file 1736 (while (and (not file) (consp inferior-octave-output-list))
1727 (find-file file) 1737 (setq line (pop inferior-octave-output-list))
1728 (octave-goto-function-definition fn))))) 1738 (when (string-match "from the file \\(.*\\)$" line)
1729 1739 (setq file (match-string 1 line))))
1740 (if (not file)
1741 (user-error "%s" (or line (format "`%s' not found" fn)))
1742 (ring-insert find-tag-marker-ring (point-marker))
1743 (setq file (funcall octave-find-definition-filename-function file))
1744 (when file
1745 (find-file file)
1746 (octave-goto-function-definition fn)))))))
1730 1747
1731(provide 'octave) 1748(provide 'octave)
1732;;; octave.el ends here 1749;;; octave.el ends here
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index 01ac8584e19..1d5052bede4 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -158,44 +158,10 @@
158;; Regexps updated with help from Tom Tromey <tromey@cambric.colorado.edu> and 158;; Regexps updated with help from Tom Tromey <tromey@cambric.colorado.edu> and
159;; Jim Campbell <jec@murzim.ca.boeing.com>. 159;; Jim Campbell <jec@murzim.ca.boeing.com>.
160 160
161(defcustom perl-prettify-symbols t
162 "If non-nil, some symbols will be displayed using Unicode chars."
163 :version "24.4"
164 :type 'boolean)
165
166(defconst perl--prettify-symbols-alist 161(defconst perl--prettify-symbols-alist
167 '(;;("andalso" . ?∧) ("orelse" . ?∨) ("as" . ?≡)("not" . ?¬) 162 '(("->" . ?→)
168 ;;("div" . ?÷) ("*" . ?×) ("o" . ?○)
169 ("->" . ?→)
170 ("=>" . ?⇒) 163 ("=>" . ?⇒)
171 ;;("<-" . ?←) ("<>" . ?≠) (">=" . ?≥) ("<=" . ?≤) ("..." . ?⋯) 164 ("::" . ?∷)))
172 ("::" . ?∷)
173 ))
174
175(defun perl--font-lock-compose-symbol ()
176 "Compose a sequence of ascii chars into a symbol.
177Regexp match data 0 points to the chars."
178 ;; Check that the chars should really be composed into a symbol.
179 (let* ((start (match-beginning 0))
180 (end (match-end 0))
181 (syntaxes (if (eq (char-syntax (char-after start)) ?w)
182 '(?w) '(?. ?\\))))
183 (if (or (memq (char-syntax (or (char-before start) ?\ )) syntaxes)
184 (memq (char-syntax (or (char-after end) ?\ )) syntaxes)
185 (nth 8 (syntax-ppss)))
186 ;; No composition for you. Let's actually remove any composition
187 ;; we may have added earlier and which is now incorrect.
188 (remove-text-properties start end '(composition))
189 ;; That's a symbol alright, so add the composition.
190 (compose-region start end (cdr (assoc (match-string 0)
191 perl--prettify-symbols-alist)))))
192 ;; Return nil because we're not adding any face property.
193 nil)
194
195(defun perl--font-lock-symbols-keywords ()
196 (when perl-prettify-symbols
197 `((,(regexp-opt (mapcar 'car perl--prettify-symbols-alist) t)
198 (0 (perl--font-lock-compose-symbol))))))
199 165
200(defconst perl-font-lock-keywords-1 166(defconst perl-font-lock-keywords-1
201 '(;; What is this for? 167 '(;; What is this for?
@@ -243,8 +209,7 @@ Regexp match data 0 points to the chars."
243 ;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'. 209 ;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'.
244 ("\\<\\(continue\\|goto\\|last\\|next\\|redo\\)\\>[ \t]*\\(\\sw+\\)?" 210 ("\\<\\(continue\\|goto\\|last\\|next\\|redo\\)\\>[ \t]*\\(\\sw+\\)?"
245 (1 font-lock-keyword-face) (2 font-lock-constant-face nil t)) 211 (1 font-lock-keyword-face) (2 font-lock-constant-face nil t))
246 ("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-constant-face) 212 ("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-constant-face)))
247 ,@(perl--font-lock-symbols-keywords)))
248 "Gaudy level highlighting for Perl mode.") 213 "Gaudy level highlighting for Perl mode.")
249 214
250(defvar perl-font-lock-keywords perl-font-lock-keywords-1 215(defvar perl-font-lock-keywords perl-font-lock-keywords-1
@@ -685,13 +650,15 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'."
685 (setq-local comment-start-skip "\\(^\\|\\s-\\);?#+ *") 650 (setq-local comment-start-skip "\\(^\\|\\s-\\);?#+ *")
686 (setq-local comment-indent-function #'perl-comment-indent) 651 (setq-local comment-indent-function #'perl-comment-indent)
687 (setq-local parse-sexp-ignore-comments t) 652 (setq-local parse-sexp-ignore-comments t)
653
688 ;; Tell font-lock.el how to handle Perl. 654 ;; Tell font-lock.el how to handle Perl.
689 (setq font-lock-defaults '((perl-font-lock-keywords 655 (setq font-lock-defaults '((perl-font-lock-keywords
690 perl-font-lock-keywords-1 656 perl-font-lock-keywords-1
691 perl-font-lock-keywords-2) 657 perl-font-lock-keywords-2)
692 nil nil ((?\_ . "w")) nil 658 nil nil ((?\_ . "w")) nil
693 (font-lock-syntactic-face-function 659 (font-lock-syntactic-face-function
694 . perl-font-lock-syntactic-face-function))) 660 . perl-font-lock-syntactic-face-function)))
661 (prog-prettify-install perl--prettify-symbols-alist)
695 (setq-local syntax-propertize-function #'perl-syntax-propertize-function) 662 (setq-local syntax-propertize-function #'perl-syntax-propertize-function)
696 (add-hook 'syntax-propertize-extend-region-functions 663 (add-hook 'syntax-propertize-extend-region-functions
697 #'syntax-propertize-multiline 'append 'local) 664 #'syntax-propertize-multiline 'append 'local)
diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el
new file mode 100644
index 00000000000..e2700414636
--- /dev/null
+++ b/lisp/progmodes/prog-mode.el
@@ -0,0 +1,119 @@
1;;; prog-mode.el --- Generic major mode for programming -*- lexical-binding: t -*-
2
3;; Copyright (C) 2013 Free Software Foundation, Inc.
4
5;; Maintainer: FSF
6;; Keywords: internal
7;; Package: emacs
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software: you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23
24;;; Commentary:
25
26;; This major mode is mostly intended as a parent of other programming
27;; modes. All major modes for programming languages should derive from this
28;; mode so that users can put generic customization on prog-mode-hook.
29
30;;; Code:
31
32(eval-when-compile (require 'cl-lib))
33
34(defgroup prog-mode nil
35 "Generic programming mode, from which others derive."
36 :group 'languages)
37
38(defvar prog-mode-map
39 (let ((map (make-sparse-keymap)))
40 (define-key map [?\C-\M-q] 'prog-indent-sexp)
41 map)
42 "Keymap used for programming modes.")
43
44(defun prog-indent-sexp (&optional defun)
45 "Indent the expression after point.
46When interactively called with prefix, indent the enclosing defun
47instead."
48 (interactive "P")
49 (save-excursion
50 (when defun
51 (end-of-line)
52 (beginning-of-defun))
53 (let ((start (point))
54 (end (progn (forward-sexp 1) (point))))
55 (indent-region start end nil))))
56
57(defvar prog-prettify-symbols-alist nil)
58
59(defcustom prog-prettify-symbols nil
60 "Whether symbols should be prettified.
61When set to an alist in the form `((STRING . CHARACTER)...)' it
62will augment the mode's native prettify alist."
63 :type '(choice
64 (const :tag "No thanks" nil)
65 (const :tag "Mode defaults" t)
66 (alist :tag "Mode defaults augmented with your own list"
67 :key-type string :value-type character))
68 :version "24.4")
69
70(defun prog--prettify-font-lock-compose-symbol (alist)
71 "Compose a sequence of ascii chars into a symbol.
72Regexp match data 0 points to the chars."
73 ;; Check that the chars should really be composed into a symbol.
74 (let* ((start (match-beginning 0))
75 (end (match-end 0))
76 (syntaxes (if (eq (char-syntax (char-after start)) ?w)
77 '(?w) '(?. ?\\))))
78 (if (or (memq (char-syntax (or (char-before start) ?\ )) syntaxes)
79 (memq (char-syntax (or (char-after end) ?\ )) syntaxes)
80 (nth 8 (syntax-ppss)))
81 ;; No composition for you. Let's actually remove any composition
82 ;; we may have added earlier and which is now incorrect.
83 (remove-text-properties start end '(composition))
84 ;; That's a symbol alright, so add the composition.
85 (compose-region start end (cdr (assoc (match-string 0) alist)))))
86 ;; Return nil because we're not adding any face property.
87 nil)
88
89(defun prog-prettify-font-lock-symbols-keywords ()
90 (when prog-prettify-symbols
91 (let ((alist (append prog-prettify-symbols-alist
92 (if (listp prog-prettify-symbols)
93 prog-prettify-symbols
94 nil))))
95 `((,(regexp-opt (mapcar 'car alist) t)
96 (0 (prog--prettify-font-lock-compose-symbol ',alist)))))))
97
98(defun prog-prettify-install (alist)
99"Install prog-mode support to prettify symbols according to ALIST.
100
101ALIST is in the format `((STRING . CHARACTER)...)' like
102`prog-prettify-symbols'.
103
104Internally, `font-lock-add-keywords' is called."
105 (setq-local prog-prettify-symbols-alist alist)
106 (let ((keywords (prog-prettify-font-lock-symbols-keywords)))
107 (if keywords (font-lock-add-keywords nil keywords))))
108
109;;;###autoload
110(define-derived-mode prog-mode fundamental-mode "Prog"
111 "Major mode for editing programming language source code."
112 (set (make-local-variable 'require-final-newline) mode-require-final-newline)
113 (set (make-local-variable 'parse-sexp-ignore-comments) t)
114 ;; Any programming language is always written left to right.
115 (setq bidi-paragraph-direction 'left-to-right))
116
117(provide 'prog-mode)
118
119;;; prog-mode.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/simple.el b/lisp/simple.el
index 18a360faa61..15bf8779f56 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -372,34 +372,6 @@ Other major modes are defined by comparison with this one."
372 "Parent major mode from which special major modes should inherit." 372 "Parent major mode from which special major modes should inherit."
373 (setq buffer-read-only t)) 373 (setq buffer-read-only t))
374 374
375;; Major mode meant to be the parent of programming modes.
376
377(defvar prog-mode-map
378 (let ((map (make-sparse-keymap)))
379 (define-key map [?\C-\M-q] 'prog-indent-sexp)
380 map)
381 "Keymap used for programming modes.")
382
383(defun prog-indent-sexp (&optional defun)
384 "Indent the expression after point.
385When interactively called with prefix, indent the enclosing defun
386instead."
387 (interactive "P")
388 (save-excursion
389 (when defun
390 (end-of-line)
391 (beginning-of-defun))
392 (let ((start (point))
393 (end (progn (forward-sexp 1) (point))))
394 (indent-region start end nil))))
395
396(define-derived-mode prog-mode fundamental-mode "Prog"
397 "Major mode for editing programming language source code."
398 (set (make-local-variable 'require-final-newline) mode-require-final-newline)
399 (set (make-local-variable 'parse-sexp-ignore-comments) t)
400 ;; Any programming language is always written left to right.
401 (setq bidi-paragraph-direction 'left-to-right))
402
403;; Making and deleting lines. 375;; Making and deleting lines.
404 376
405(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard)) 377(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard))
diff --git a/lisp/skeleton.el b/lisp/skeleton.el
index 01288b89132..a7eae7464e2 100644
--- a/lisp/skeleton.el
+++ b/lisp/skeleton.el
@@ -31,6 +31,8 @@
31 31
32;;; Code: 32;;; Code:
33 33
34(eval-when-compile (require 'cl-lib))
35
34;; page 1: statement skeleton language definition & interpreter 36;; page 1: statement skeleton language definition & interpreter
35;; page 2: paired insertion 37;; page 2: paired insertion
36;; page 3: mirror-mode, an example for setting up paired insertion 38;; page 3: mirror-mode, an example for setting up paired insertion
@@ -84,13 +86,11 @@ The variables `v1' and `v2' are still set when calling this.")
84 "When non-nil, indent rigidly under current line for element `\\n'. 86 "When non-nil, indent rigidly under current line for element `\\n'.
85Else use mode's `indent-line-function'.") 87Else use mode's `indent-line-function'.")
86 88
87(defvar skeleton-further-elements () 89(defvar-local skeleton-further-elements ()
88 "A buffer-local varlist (see `let') of mode specific skeleton elements. 90 "A buffer-local varlist (see `let') of mode specific skeleton elements.
89These variables are bound while interpreting a skeleton. Their value may 91These variables are bound while interpreting a skeleton. Their value may
90in turn be any valid skeleton element if they are themselves to be used as 92in turn be any valid skeleton element if they are themselves to be used as
91skeleton elements.") 93skeleton elements.")
92(make-variable-buffer-local 'skeleton-further-elements)
93
94 94
95(defvar skeleton-subprompt 95(defvar skeleton-subprompt
96 (substitute-command-keys 96 (substitute-command-keys
@@ -260,8 +260,10 @@ When done with skeleton, but before going back to `_'-point call
260 skeleton-modified skeleton-point resume: help input v1 v2) 260 skeleton-modified skeleton-point resume: help input v1 v2)
261 (setq skeleton-positions nil) 261 (setq skeleton-positions nil)
262 (unwind-protect 262 (unwind-protect
263 (eval `(let ,skeleton-further-elements 263 (cl-progv
264 (skeleton-internal-list skeleton str))) 264 (mapcar #'car skeleton-further-elements)
265 (mapcar (lambda (x) (eval (cadr x))) skeleton-further-elements)
266 (skeleton-internal-list skeleton str))
265 (run-hooks 'skeleton-end-hook) 267 (run-hooks 'skeleton-end-hook)
266 (sit-for 0) 268 (sit-for 0)
267 (or (pos-visible-in-window-p beg) 269 (or (pos-visible-in-window-p beg)
diff --git a/lisp/subr.el b/lisp/subr.el
index f8fbe98b141..6f46e1189cf 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1,4 +1,4 @@
1;;; subr.el --- basic lisp subroutines for Emacs -*- coding: utf-8 -*- 1;;; subr.el --- basic lisp subroutines for Emacs -*- coding: utf-8; lexical-binding:t -*-
2 2
3;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2013 Free Software 3;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2013 Free Software
4;; Foundation, Inc. 4;; Foundation, Inc.
@@ -39,13 +39,13 @@ Each element of this list holds the arguments to one call to `defcustom'.")
39 (setq custom-declare-variable-list 39 (setq custom-declare-variable-list
40 (cons arguments custom-declare-variable-list))) 40 (cons arguments custom-declare-variable-list)))
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
@@ -1478,11 +1478,48 @@ ELEMENT is added at the end.
1478 1478
1479The return value is the new value of LIST-VAR. 1479The return value is the new value of LIST-VAR.
1480 1480
1481This is handy to add some elements to configuration variables,
1482but please do not abuse it in Elisp code, where you are usually better off
1483using `push' or `cl-pushnew'.
1484
1481If you want to use `add-to-list' on a variable that is not defined 1485If you want to use `add-to-list' on a variable that is not defined
1482until a certain package is loaded, you should put the call to `add-to-list' 1486until a certain package is loaded, you should put the call to `add-to-list'
1483into a hook function that will be run only after loading the package. 1487into a hook function that will be run only after loading the package.
1484`eval-after-load' provides one way to do this. In some cases 1488`eval-after-load' provides one way to do this. In some cases
1485other hooks, such as major mode hooks, can do the job." 1489other hooks, such as major mode hooks, can do the job."
1490 (declare
1491 (compiler-macro
1492 (lambda (exp)
1493 ;; FIXME: Something like this could be used for `set' as well.
1494 (if (or (not (eq 'quote (car-safe list-var)))
1495 (special-variable-p (cadr list-var))
1496 (and append compare-fn))
1497 exp
1498 (let* ((sym (cadr list-var))
1499 (msg (format "`add-to-list' can't use lexical var `%s'; use `push' or `cl-pushnew'"
1500 sym))
1501 ;; Big ugly hack so we only output a warning during
1502 ;; byte-compilation, and so we can use
1503 ;; byte-compile-not-lexical-var-p to silence the warning
1504 ;; when a defvar has been seen but not yet executed.
1505 (warnfun (lambda ()
1506 ;; FIXME: We should also emit a warning for let-bound
1507 ;; variables with dynamic binding.
1508 (when (assq sym byte-compile--lexical-environment)
1509 (byte-compile-log-warning msg t :error))))
1510 (code
1511 (if append
1512 (macroexp-let2 macroexp-copyable-p x element
1513 `(unless (member ,x ,sym)
1514 (setq ,sym (append ,sym (list ,x)))))
1515 (require 'cl-lib)
1516 `(cl-pushnew ,element ,sym
1517 :test ,(or compare-fn '#'equal)))))
1518 (if (not (macroexp--compiling-p))
1519 code
1520 `(progn
1521 (macroexp--funcall-if-compiled ',warnfun)
1522 ,code)))))))
1486 (if (cond 1523 (if (cond
1487 ((null compare-fn) 1524 ((null compare-fn)
1488 (member element (symbol-value list-var))) 1525 (member element (symbol-value list-var)))
@@ -1710,7 +1747,7 @@ If TOGGLE has a `:menu-tag', that is used for the menu item's label."
1710 (nconc found (list (cons toggle keymap)) rest)) 1747 (nconc found (list (cons toggle keymap)) rest))
1711 (push (cons toggle keymap) minor-mode-map-alist))))))) 1748 (push (cons toggle keymap) minor-mode-map-alist)))))))
1712 1749
1713;;; Load history 1750;;;; Load history
1714 1751
1715(defsubst autoloadp (object) 1752(defsubst autoloadp (object)
1716 "Non-nil if OBJECT is an autoload." 1753 "Non-nil if OBJECT is an autoload."
@@ -1793,173 +1830,6 @@ and the file name is displayed in the echo area."
1793 file)) 1830 file))
1794 1831
1795 1832
1796;;;; Specifying things to do later.
1797
1798(defun load-history-regexp (file)
1799 "Form a regexp to find FILE in `load-history'.
1800FILE, a string, is described in the function `eval-after-load'."
1801 (if (file-name-absolute-p file)
1802 (setq file (file-truename file)))
1803 (concat (if (file-name-absolute-p file) "\\`" "\\(\\`\\|/\\)")
1804 (regexp-quote file)
1805 (if (file-name-extension file)
1806 ""
1807 ;; Note: regexp-opt can't be used here, since we need to call
1808 ;; this before Emacs has been fully started. 2006-05-21
1809 (concat "\\(" (mapconcat 'regexp-quote load-suffixes "\\|") "\\)?"))
1810 "\\(" (mapconcat 'regexp-quote jka-compr-load-suffixes "\\|")
1811 "\\)?\\'"))
1812
1813(defun load-history-filename-element (file-regexp)
1814 "Get the first elt of `load-history' whose car matches FILE-REGEXP.
1815Return nil if there isn't one."
1816 (let* ((loads load-history)
1817 (load-elt (and loads (car loads))))
1818 (save-match-data
1819 (while (and loads
1820 (or (null (car load-elt))
1821 (not (string-match file-regexp (car load-elt)))))
1822 (setq loads (cdr loads)
1823 load-elt (and loads (car loads)))))
1824 load-elt))
1825
1826(put 'eval-after-load 'lisp-indent-function 1)
1827(defun eval-after-load (file form)
1828 "Arrange that if FILE is loaded, FORM will be run immediately afterwards.
1829If FILE is already loaded, evaluate FORM right now.
1830
1831If a matching file is loaded again, FORM will be evaluated again.
1832
1833If FILE is a string, it may be either an absolute or a relative file
1834name, and may have an extension \(e.g. \".el\") or may lack one, and
1835additionally may or may not have an extension denoting a compressed
1836format \(e.g. \".gz\").
1837
1838When FILE is absolute, this first converts it to a true name by chasing
1839symbolic links. Only a file of this name \(see next paragraph regarding
1840extensions) will trigger the evaluation of FORM. When FILE is relative,
1841a file whose absolute true name ends in FILE will trigger evaluation.
1842
1843When FILE lacks an extension, a file name with any extension will trigger
1844evaluation. Otherwise, its extension must match FILE's. A further
1845extension for a compressed format \(e.g. \".gz\") on FILE will not affect
1846this name matching.
1847
1848Alternatively, FILE can be a feature (i.e. a symbol), in which case FORM
1849is evaluated at the end of any file that `provide's this feature.
1850If the feature is provided when evaluating code not associated with a
1851file, FORM is evaluated immediately after the provide statement.
1852
1853Usually FILE is just a library name like \"font-lock\" or a feature name
1854like 'font-lock.
1855
1856This function makes or adds to an entry on `after-load-alist'."
1857 ;; Add this FORM into after-load-alist (regardless of whether we'll be
1858 ;; evaluating it now).
1859 (let* ((regexp-or-feature
1860 (if (stringp file)
1861 (setq file (purecopy (load-history-regexp file)))
1862 file))
1863 (elt (assoc regexp-or-feature after-load-alist)))
1864 (unless elt
1865 (setq elt (list regexp-or-feature))
1866 (push elt after-load-alist))
1867 ;; Make sure `form' is evalled in the current lexical/dynamic code.
1868 (setq form `(funcall ',(eval `(lambda () ,form) lexical-binding)))
1869 ;; Is there an already loaded file whose name (or `provide' name)
1870 ;; matches FILE?
1871 (prog1 (if (if (stringp file)
1872 (load-history-filename-element regexp-or-feature)
1873 (featurep file))
1874 (eval form))
1875 (when (symbolp regexp-or-feature)
1876 ;; For features, the after-load-alist elements get run when `provide' is
1877 ;; called rather than at the end of the file. So add an indirection to
1878 ;; make sure that `form' is really run "after-load" in case the provide
1879 ;; call happens early.
1880 (setq form
1881 `(if load-file-name
1882 (let ((fun (make-symbol "eval-after-load-helper")))
1883 (fset fun `(lambda (file)
1884 (if (not (equal file ',load-file-name))
1885 nil
1886 (remove-hook 'after-load-functions ',fun)
1887 ,',form)))
1888 (add-hook 'after-load-functions fun))
1889 ;; Not being provided from a file, run form right now.
1890 ,form)))
1891 ;; Add FORM to the element unless it's already there.
1892 (unless (member form (cdr elt))
1893 (nconc elt (list form))))))
1894
1895(defvar after-load-functions nil
1896 "Special hook run after loading a file.
1897Each function there is called with a single argument, the absolute
1898name of the file just loaded.")
1899
1900(defun do-after-load-evaluation (abs-file)
1901 "Evaluate all `eval-after-load' forms, if any, for ABS-FILE.
1902ABS-FILE, a string, should be the absolute true name of a file just loaded.
1903This function is called directly from the C code."
1904 ;; Run the relevant eval-after-load forms.
1905 (mapc #'(lambda (a-l-element)
1906 (when (and (stringp (car a-l-element))
1907 (string-match-p (car a-l-element) abs-file))
1908 ;; discard the file name regexp
1909 (mapc #'eval (cdr a-l-element))))
1910 after-load-alist)
1911 ;; Complain when the user uses obsolete files.
1912 (when (string-match-p "/obsolete/[^/]*\\'" abs-file)
1913 (run-with-timer 0 nil
1914 (lambda (file)
1915 (message "Package %s is obsolete!"
1916 (substring file 0
1917 (string-match "\\.elc?\\>" file))))
1918 (file-name-nondirectory abs-file)))
1919 ;; Finally, run any other hook.
1920 (run-hook-with-args 'after-load-functions abs-file))
1921
1922(defun eval-next-after-load (file)
1923 "Read the following input sexp, and run it whenever FILE is loaded.
1924This makes or adds to an entry on `after-load-alist'.
1925FILE should be the name of a library, with no directory name."
1926 (declare (obsolete eval-after-load "23.2"))
1927 (eval-after-load file (read)))
1928
1929(defun display-delayed-warnings ()
1930 "Display delayed warnings from `delayed-warnings-list'.
1931Used from `delayed-warnings-hook' (which see)."
1932 (dolist (warning (nreverse delayed-warnings-list))
1933 (apply 'display-warning warning))
1934 (setq delayed-warnings-list nil))
1935
1936(defun collapse-delayed-warnings ()
1937 "Remove duplicates from `delayed-warnings-list'.
1938Collapse identical adjacent warnings into one (plus count).
1939Used from `delayed-warnings-hook' (which see)."
1940 (let ((count 1)
1941 collapsed warning)
1942 (while delayed-warnings-list
1943 (setq warning (pop delayed-warnings-list))
1944 (if (equal warning (car delayed-warnings-list))
1945 (setq count (1+ count))
1946 (when (> count 1)
1947 (setcdr warning (cons (format "%s [%d times]" (cadr warning) count)
1948 (cddr warning)))
1949 (setq count 1))
1950 (push warning collapsed)))
1951 (setq delayed-warnings-list (nreverse collapsed))))
1952
1953;; At present this is only used for Emacs internals.
1954;; Ref http://lists.gnu.org/archive/html/emacs-devel/2012-02/msg00085.html
1955(defvar delayed-warnings-hook '(collapse-delayed-warnings
1956 display-delayed-warnings)
1957 "Normal hook run to process and display delayed warnings.
1958By default, this hook contains functions to consolidate the
1959warnings listed in `delayed-warnings-list', display them, and set
1960`delayed-warnings-list' back to nil.")
1961
1962
1963;;;; Process stuff. 1833;;;; Process stuff.
1964 1834
1965(defun process-lines (program &rest args) 1835(defun process-lines (program &rest args)
@@ -2054,8 +1924,8 @@ some sort of escape sequence, the ambiguity is resolved via `read-key-delay'."
2054 ;; disable quail's input methods, so although read-key-sequence 1924 ;; disable quail's input methods, so although read-key-sequence
2055 ;; always inherits the input method, in practice read-key does not 1925 ;; always inherits the input method, in practice read-key does not
2056 ;; inherit the input method (at least not if it's based on quail). 1926 ;; inherit the input method (at least not if it's based on quail).
2057 (let ((overriding-terminal-local-map read-key-empty-map) 1927 (let ((overriding-terminal-local-map nil)
2058 (overriding-local-map nil) 1928 (overriding-local-map read-key-empty-map)
2059 (echo-keystrokes 0) 1929 (echo-keystrokes 0)
2060 (old-global-map (current-global-map)) 1930 (old-global-map (current-global-map))
2061 (timer (run-with-idle-timer 1931 (timer (run-with-idle-timer
@@ -2670,7 +2540,7 @@ Set this to nil at your own risk..."
2670(defun locate-user-emacs-file (new-name &optional old-name) 2540(defun locate-user-emacs-file (new-name &optional old-name)
2671 "Return an absolute per-user Emacs-specific file name. 2541 "Return an absolute per-user Emacs-specific file name.
2672If NEW-NAME exists in `user-emacs-directory', return it. 2542If NEW-NAME exists in `user-emacs-directory', return it.
2673Else 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.
2674Else return NEW-NAME in `user-emacs-directory', creating the 2544Else return NEW-NAME in `user-emacs-directory', creating the
2675directory if it does not exist." 2545directory if it does not exist."
2676 (convert-standard-filename 2546 (convert-standard-filename
@@ -3361,7 +3231,7 @@ than cosmetic ones, undo data may become corrupted.
3361 3231
3362This macro will run BODY normally, but doesn't count its buffer 3232This macro will run BODY normally, but doesn't count its buffer
3363modifications as being buffer modifications. This affects things 3233modifications as being buffer modifications. This affects things
3364like buffer-modified-p, checking whether the file is locked by 3234like `buffer-modified-p', checking whether the file is locked by
3365someone else, running buffer modification hooks, and other things 3235someone else, running buffer modification hooks, and other things
3366of that nature. 3236of that nature.
3367 3237
@@ -3666,7 +3536,7 @@ which separates, but is not part of, the substrings. If nil it defaults to
3666`split-string-default-separators', normally \"[ \\f\\t\\n\\r\\v]+\", and 3536`split-string-default-separators', normally \"[ \\f\\t\\n\\r\\v]+\", and
3667OMIT-NULLS is forced to t. 3537OMIT-NULLS is forced to t.
3668 3538
3669If 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
3670that for the default value of SEPARATORS leading and trailing whitespace 3540that for the default value of SEPARATORS leading and trailing whitespace
3671are effectively trimmed). If nil, all zero-length substrings are retained, 3541are effectively trimmed). If nil, all zero-length substrings are retained,
3672which correctly parses CSV format, for example. 3542which correctly parses CSV format, for example.
@@ -3825,6 +3695,173 @@ consisting of STR followed by an invisible left-to-right mark
3825 (concat str (propertize (string ?\x200e) 'invisible t)) 3695 (concat str (propertize (string ?\x200e) 'invisible t))
3826 str)) 3696 str))
3827 3697
3698;;;; Specifying things to do later.
3699
3700(defun load-history-regexp (file)
3701 "Form a regexp to find FILE in `load-history'.
3702FILE, a string, is described in the function `eval-after-load'."
3703 (if (file-name-absolute-p file)
3704 (setq file (file-truename file)))
3705 (concat (if (file-name-absolute-p file) "\\`" "\\(\\`\\|/\\)")
3706 (regexp-quote file)
3707 (if (file-name-extension file)
3708 ""
3709 ;; Note: regexp-opt can't be used here, since we need to call
3710 ;; this before Emacs has been fully started. 2006-05-21
3711 (concat "\\(" (mapconcat 'regexp-quote load-suffixes "\\|") "\\)?"))
3712 "\\(" (mapconcat 'regexp-quote jka-compr-load-suffixes "\\|")
3713 "\\)?\\'"))
3714
3715(defun load-history-filename-element (file-regexp)
3716 "Get the first elt of `load-history' whose car matches FILE-REGEXP.
3717Return nil if there isn't one."
3718 (let* ((loads load-history)
3719 (load-elt (and loads (car loads))))
3720 (save-match-data
3721 (while (and loads
3722 (or (null (car load-elt))
3723 (not (string-match file-regexp (car load-elt)))))
3724 (setq loads (cdr loads)
3725 load-elt (and loads (car loads)))))
3726 load-elt))
3727
3728(put 'eval-after-load 'lisp-indent-function 1)
3729(defun eval-after-load (file form)
3730 "Arrange that if FILE is loaded, FORM will be run immediately afterwards.
3731If FILE is already loaded, evaluate FORM right now.
3732
3733If a matching file is loaded again, FORM will be evaluated again.
3734
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
3737additionally may or may not have an extension denoting a compressed
3738format (e.g. \".gz\").
3739
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
3742extensions) will trigger the evaluation of FORM. When FILE is relative,
3743a file whose absolute true name ends in FILE will trigger evaluation.
3744
3745When FILE lacks an extension, a file name with any extension will trigger
3746evaluation. Otherwise, its extension must match FILE's. A further
3747extension for a compressed format (e.g. \".gz\") on FILE will not affect
3748this name matching.
3749
3750Alternatively, FILE can be a feature (i.e. a symbol), in which case FORM
3751is evaluated at the end of any file that `provide's this feature.
3752If the feature is provided when evaluating code not associated with a
3753file, FORM is evaluated immediately after the provide statement.
3754
3755Usually FILE is just a library name like \"font-lock\" or a feature name
3756like 'font-lock.
3757
3758This function makes or adds to an entry on `after-load-alist'."
3759 ;; Add this FORM into after-load-alist (regardless of whether we'll be
3760 ;; evaluating it now).
3761 (let* ((regexp-or-feature
3762 (if (stringp file)
3763 (setq file (purecopy (load-history-regexp file)))
3764 file))
3765 (elt (assoc regexp-or-feature after-load-alist)))
3766 (unless elt
3767 (setq elt (list regexp-or-feature))
3768 (push elt after-load-alist))
3769 ;; Make sure `form' is evalled in the current lexical/dynamic code.
3770 (setq form `(funcall ',(eval `(lambda () ,form) lexical-binding)))
3771 ;; Is there an already loaded file whose name (or `provide' name)
3772 ;; matches FILE?
3773 (prog1 (if (if (stringp file)
3774 (load-history-filename-element regexp-or-feature)
3775 (featurep file))
3776 (eval form))
3777 (when (symbolp regexp-or-feature)
3778 ;; For features, the after-load-alist elements get run when `provide' is
3779 ;; called rather than at the end of the file. So add an indirection to
3780 ;; make sure that `form' is really run "after-load" in case the provide
3781 ;; call happens early.
3782 (setq form
3783 `(if load-file-name
3784 (let ((fun (make-symbol "eval-after-load-helper")))
3785 (fset fun `(lambda (file)
3786 (if (not (equal file ',load-file-name))
3787 nil
3788 (remove-hook 'after-load-functions ',fun)
3789 ,',form)))
3790 (add-hook 'after-load-functions fun))
3791 ;; Not being provided from a file, run form right now.
3792 ,form)))
3793 ;; Add FORM to the element unless it's already there.
3794 (unless (member form (cdr elt))
3795 (nconc elt (list form))))))
3796
3797(defvar after-load-functions nil
3798 "Special hook run after loading a file.
3799Each function there is called with a single argument, the absolute
3800name of the file just loaded.")
3801
3802(defun do-after-load-evaluation (abs-file)
3803 "Evaluate all `eval-after-load' forms, if any, for ABS-FILE.
3804ABS-FILE, a string, should be the absolute true name of a file just loaded.
3805This function is called directly from the C code."
3806 ;; Run the relevant eval-after-load forms.
3807 (mapc #'(lambda (a-l-element)
3808 (when (and (stringp (car a-l-element))
3809 (string-match-p (car a-l-element) abs-file))
3810 ;; discard the file name regexp
3811 (mapc #'eval (cdr a-l-element))))
3812 after-load-alist)
3813 ;; Complain when the user uses obsolete files.
3814 (when (string-match-p "/obsolete/[^/]*\\'" abs-file)
3815 (run-with-timer 0 nil
3816 (lambda (file)
3817 (message "Package %s is obsolete!"
3818 (substring file 0
3819 (string-match "\\.elc?\\>" file))))
3820 (file-name-nondirectory abs-file)))
3821 ;; Finally, run any other hook.
3822 (run-hook-with-args 'after-load-functions abs-file))
3823
3824(defun eval-next-after-load (file)
3825 "Read the following input sexp, and run it whenever FILE is loaded.
3826This makes or adds to an entry on `after-load-alist'.
3827FILE should be the name of a library, with no directory name."
3828 (declare (obsolete eval-after-load "23.2"))
3829 (eval-after-load file (read)))
3830
3831(defun display-delayed-warnings ()
3832 "Display delayed warnings from `delayed-warnings-list'.
3833Used from `delayed-warnings-hook' (which see)."
3834 (dolist (warning (nreverse delayed-warnings-list))
3835 (apply 'display-warning warning))
3836 (setq delayed-warnings-list nil))
3837
3838(defun collapse-delayed-warnings ()
3839 "Remove duplicates from `delayed-warnings-list'.
3840Collapse identical adjacent warnings into one (plus count).
3841Used from `delayed-warnings-hook' (which see)."
3842 (let ((count 1)
3843 collapsed warning)
3844 (while delayed-warnings-list
3845 (setq warning (pop delayed-warnings-list))
3846 (if (equal warning (car delayed-warnings-list))
3847 (setq count (1+ count))
3848 (when (> count 1)
3849 (setcdr warning (cons (format "%s [%d times]" (cadr warning) count)
3850 (cddr warning)))
3851 (setq count 1))
3852 (push warning collapsed)))
3853 (setq delayed-warnings-list (nreverse collapsed))))
3854
3855;; At present this is only used for Emacs internals.
3856;; Ref http://lists.gnu.org/archive/html/emacs-devel/2012-02/msg00085.html
3857(defvar delayed-warnings-hook '(collapse-delayed-warnings
3858 display-delayed-warnings)
3859 "Normal hook run to process and display delayed warnings.
3860By default, this hook contains functions to consolidate the
3861warnings listed in `delayed-warnings-list', display them, and set
3862`delayed-warnings-list' back to nil.")
3863
3864
3828;;;; invisibility specs 3865;;;; invisibility specs
3829 3866
3830(defun add-to-invisibility-spec (element) 3867(defun add-to-invisibility-spec (element)
@@ -4197,32 +4234,6 @@ use `called-interactively-p'."
4197 (declare (obsolete called-interactively-p "23.2")) 4234 (declare (obsolete called-interactively-p "23.2"))
4198 (called-interactively-p 'interactive)) 4235 (called-interactively-p 'interactive))
4199 4236
4200(defun function-arity (f &optional num)
4201 "Return the (MIN . MAX) arity of F.
4202If the maximum arity is infinite, MAX is `many'.
4203F can be a function or a macro.
4204If NUM is non-nil, return non-nil iff F can be called with NUM args."
4205 (if (symbolp f) (setq f (indirect-function f)))
4206 (if (eq (car-safe f) 'macro) (setq f (cdr f)))
4207 (let ((res
4208 (if (subrp f)
4209 (let ((x (subr-arity f)))
4210 (if (eq (cdr x) 'unevalled) (cons (car x) 'many)))
4211 (let* ((args (if (consp f) (cadr f) (aref f 0)))
4212 (max (length args))
4213 (opt (memq '&optional args))
4214 (rest (memq '&rest args))
4215 (min (- max (length opt))))
4216 (if opt
4217 (cons min (if rest 'many (1- max)))
4218 (if rest
4219 (cons (- max (length rest)) 'many)
4220 (cons min max)))))))
4221 (if (not num)
4222 res
4223 (and (>= num (car res))
4224 (or (eq 'many (cdr res)) (<= num (cdr res)))))))
4225
4226(defun set-temporary-overlay-map (map &optional keep-pred) 4237(defun set-temporary-overlay-map (map &optional keep-pred)
4227 "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.
4228Note 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/term.el b/lisp/term.el
index 1c67057d3a7..31889a78273 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -560,6 +560,13 @@ This variable is buffer-local."
560 :type 'boolean 560 :type 'boolean
561 :group 'term) 561 :group 'term)
562 562
563(defcustom term-suppress-hard-newline nil
564 "Non-nil means interpreter should not break long lines with newlines.
565This means text can automatically reflow if the window is resized."
566 :version "24.4"
567 :type 'boolean
568 :group 'term)
569
563;; Where gud-display-frame should put the debugging arrow. This is 570;; Where gud-display-frame should put the debugging arrow. This is
564;; set by the marker-filter, which scans the debugger's output for 571;; set by the marker-filter, which scans the debugger's output for
565;; indications of the current pc. 572;; indications of the current pc.
@@ -2828,8 +2835,9 @@ See `term-prompt-regexp'."
2828 (setq count (length decoded-substring)) 2835 (setq count (length decoded-substring))
2829 (setq temp (- (+ (term-horizontal-column) count) 2836 (setq temp (- (+ (term-horizontal-column) count)
2830 term-width)) 2837 term-width))
2831 (cond ((<= temp 0)) ;; All count chars fit in line. 2838 (cond ((or term-suppress-hard-newline (<= temp 0)))
2832 ((> count temp) ;; Some chars fit. 2839 ;; All count chars fit in line.
2840 ((> count temp) ;; Some chars fit.
2833 ;; This iteration, handle only what fits. 2841 ;; This iteration, handle only what fits.
2834 (setq count (- count temp)) 2842 (setq count (- count temp))
2835 (setq count-bytes 2843 (setq count-bytes
diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el
index ca29709de2e..6c103294a06 100644
--- a/lisp/textmodes/reftex-cite.el
+++ b/lisp/textmodes/reftex-cite.el
@@ -25,18 +25,16 @@
25;;; Code: 25;;; Code:
26 26
27(eval-when-compile (require 'cl)) 27(eval-when-compile (require 'cl))
28(provide 'reftex-cite)
29(require 'reftex)
30;;;
31 28
32;; Variables and constants 29(require 'reftex)
33 30
34;; The history list of regular expressions used for citations 31;;; Variables and constants
35(defvar reftex-cite-regexp-hist nil) 32(defvar reftex-cite-regexp-hist nil
33 "The history list of regular expressions used for citations")
36 34
37;; Prompt and help string for citation selection
38(defconst reftex-citation-prompt 35(defconst reftex-citation-prompt
39 "Select: [n]ext [p]revious [r]estrict [ ]full_entry [q]uit RET [?]Help+more") 36 "Select: [n]ext [p]revious [r]estrict [ ]full_entry [q]uit RET [?]Help+more"
37 "Prompt and help string for citation selection")
40 38
41(defconst reftex-citation-help 39(defconst reftex-citation-help
42 " n / p Go to next/previous entry (Cursor motion works as well). 40 " n / p Go to next/previous entry (Cursor motion works as well).
@@ -51,8 +49,7 @@
51 e / E Create BibTeX file with all (marked/unmarked) entries 49 e / E Create BibTeX file with all (marked/unmarked) entries
52 a / A Put all (marked) entries into one/many \\cite commands.") 50 a / A Put all (marked) entries into one/many \\cite commands.")
53 51
54;; Find bibtex files 52;;; Find bibtex files
55
56(defmacro reftex-with-special-syntax-for-bib (&rest body) 53(defmacro reftex-with-special-syntax-for-bib (&rest body)
57 `(let ((saved-syntax (syntax-table))) 54 `(let ((saved-syntax (syntax-table)))
58 (unwind-protect 55 (unwind-protect
@@ -62,8 +59,8 @@
62 (set-syntax-table saved-syntax)))) 59 (set-syntax-table saved-syntax))))
63 60
64(defun reftex-default-bibliography () 61(defun reftex-default-bibliography ()
65 ;; Return the expanded value of `reftex-default-bibliography'. 62 "Return the expanded value of variable `reftex-default-bibliography'.
66 ;; The expanded value is cached. 63The expanded value is cached."
67 (unless (eq (get 'reftex-default-bibliography :reftex-raw) 64 (unless (eq (get 'reftex-default-bibliography :reftex-raw)
68 reftex-default-bibliography) 65 reftex-default-bibliography)
69 (put 'reftex-default-bibliography :reftex-expanded 66 (put 'reftex-default-bibliography :reftex-expanded
@@ -74,9 +71,8 @@
74 (get 'reftex-default-bibliography :reftex-expanded)) 71 (get 'reftex-default-bibliography :reftex-expanded))
75 72
76(defun reftex-bib-or-thebib () 73(defun reftex-bib-or-thebib ()
77 ;; Tests if BibTeX or \begin{thebibliography} should be used for the 74 "Test if BibTeX or \begin{thebibliography} should be used for the citation.
78 ;; citation 75Find the bof of the current file"
79 ;; Find the bof of the current file
80 (let* ((docstruct (symbol-value reftex-docstruct-symbol)) 76 (let* ((docstruct (symbol-value reftex-docstruct-symbol))
81 (rest (or (member (list 'bof (buffer-file-name)) docstruct) 77 (rest (or (member (list 'bof (buffer-file-name)) docstruct)
82 docstruct)) 78 docstruct))
@@ -94,11 +90,11 @@
94 (if thebib 'thebib nil)))) 90 (if thebib 'thebib nil))))
95 91
96(defun reftex-get-bibfile-list () 92(defun reftex-get-bibfile-list ()
97 ;; Return list of bibfiles for current document. 93 "Return list of bibfiles for current document.
98 ;; When using the chapterbib or bibunits package you should either 94When using the chapterbib or bibunits package you should either
99 ;; use the same database files everywhere, or separate parts using 95use the same database files everywhere, or separate parts using
100 ;; different databases into different files (included into the mater file). 96different databases into different files (included into the mater file).
101 ;; Then this function will return the applicable database files. 97Then this function will return the applicable database files."
102 98
103 ;; Ensure access to scanning info 99 ;; Ensure access to scanning info
104 (reftex-access-scan-info) 100 (reftex-access-scan-info)
@@ -115,16 +111,14 @@
115 (cdr (assq 'bib (symbol-value reftex-docstruct-symbol))) 111 (cdr (assq 'bib (symbol-value reftex-docstruct-symbol)))
116 (error "\\bibliography statement missing or .bib files not found"))) 112 (error "\\bibliography statement missing or .bib files not found")))
117 113
118;; Find a certain reference in any of the BibTeX files. 114;;; Find a certain reference in any of the BibTeX files.
119
120(defun reftex-pop-to-bibtex-entry (key file-list &optional mark-to-kill 115(defun reftex-pop-to-bibtex-entry (key file-list &optional mark-to-kill
121 highlight item return) 116 highlight item return)
122 ;; Find BibTeX KEY in any file in FILE-LIST in another window. 117 "Find BibTeX KEY in any file in FILE-LIST in another window.
123 ;; If MARK-TO-KILL is non-nil, mark new buffer to kill. 118If MARK-TO-KILL is non-nil, mark new buffer to kill.
124 ;; If HIGHLIGHT is non-nil, highlight the match. 119If HIGHLIGHT is non-nil, highlight the match.
125 ;; If ITEM in non-nil, search for bibitem instead of database entry. 120If ITEM in non-nil, search for bibitem instead of database entry.
126 ;; If RETURN is non-nil, just return the entry and restore point. 121If RETURN is non-nil, just return the entry and restore point."
127
128 (let* ((re 122 (let* ((re
129 (if item 123 (if item
130 (concat "\\\\bibitem[ \t]*\\(\\[[^]]*\\]\\)?[ \t]*{" 124 (concat "\\\\bibitem[ \t]*\\(\\[[^]]*\\]\\)?[ \t]*{"
@@ -178,12 +172,11 @@
178 (progn (forward-list 1) (point))) 172 (progn (forward-list 1) (point)))
179 (error (min (point-max) (+ 300 (point))))))) 173 (error (min (point-max) (+ 300 (point)))))))
180 174
181;; Parse bibtex buffers 175;;; Parse bibtex buffers
182
183(defun reftex-extract-bib-entries (buffers) 176(defun reftex-extract-bib-entries (buffers)
184 ;; Extract bib entries which match regexps from BUFFERS. 177 "Extract bib entries which match regexps from BUFFERS.
185 ;; BUFFERS is a list of buffers or file names. 178BUFFERS is a list of buffers or file names.
186 ;; Return list with entries." 179Return list with entries."
187 (let* (re-list first-re rest-re 180 (let* (re-list first-re rest-re
188 (buffer-list (if (listp buffers) buffers (list buffers))) 181 (buffer-list (if (listp buffers) buffers (list buffers)))
189 found-list entry buffer1 buffer alist 182 found-list entry buffer1 buffer alist
@@ -309,6 +302,8 @@
309 (t found-list)))) 302 (t found-list))))
310 303
311(defun reftex-bib-sort-author (e1 e2) 304(defun reftex-bib-sort-author (e1 e2)
305 "Compare bib entries E1 and E2 by author.
306The name of the first different author/editor is used."
312 (let ((al1 (reftex-get-bib-names "author" e1)) 307 (let ((al1 (reftex-get-bib-names "author" e1))
313 (al2 (reftex-get-bib-names "author" e2))) 308 (al2 (reftex-get-bib-names "author" e2)))
314 (while (and al1 al2 (string= (car al1) (car al2))) 309 (while (and al1 al2 (string= (car al1) (car al2)))
@@ -320,15 +315,17 @@
320 (not (stringp (car al1)))))) 315 (not (stringp (car al1))))))
321 316
322(defun reftex-bib-sort-year (e1 e2) 317(defun reftex-bib-sort-year (e1 e2)
318 "Compare bib entries E1 and E2 by year in ascending order."
323 (< (string-to-number (or (cdr (assoc "year" e1)) "0")) 319 (< (string-to-number (or (cdr (assoc "year" e1)) "0"))
324 (string-to-number (or (cdr (assoc "year" e2)) "0")))) 320 (string-to-number (or (cdr (assoc "year" e2)) "0"))))
325 321
326(defun reftex-bib-sort-year-reverse (e1 e2) 322(defun reftex-bib-sort-year-reverse (e1 e2)
323 "Compare bib entries E1 and E2 by year in descending order."
327 (> (string-to-number (or (cdr (assoc "year" e1)) "0")) 324 (> (string-to-number (or (cdr (assoc "year" e1)) "0"))
328 (string-to-number (or (cdr (assoc "year" e2)) "0")))) 325 (string-to-number (or (cdr (assoc "year" e2)) "0"))))
329 326
330(defun reftex-get-crossref-alist (entry) 327(defun reftex-get-crossref-alist (entry)
331 ;; return the alist from a crossref entry 328 "Return the alist from a crossref ENTRY."
332 (let ((crkey (cdr (assoc "crossref" entry))) 329 (let ((crkey (cdr (assoc "crossref" entry)))
333 start) 330 start)
334 (save-excursion 331 (save-excursion
@@ -347,10 +344,9 @@
347 344
348;; Parse the bibliography environment 345;; Parse the bibliography environment
349(defun reftex-extract-bib-entries-from-thebibliography (files) 346(defun reftex-extract-bib-entries-from-thebibliography (files)
350 ;; Extract bib-entries from the \begin{thebibliography} environment. 347 "Extract bib-entries from the \begin{thebibliography} environment.
351 ;; Parsing is not as good as for the BibTeX database stuff. 348Parsing is not as good as for the BibTeX database stuff.
352 ;; The environment should be located in file FILE. 349The environment should be located in FILES."
353
354 (let* (start end buf entries re re-list file default) 350 (let* (start end buf entries re re-list file default)
355 (unless files 351 (unless files
356 (error "Need file name to find thebibliography environment")) 352 (error "Need file name to find thebibliography environment"))
@@ -430,8 +426,8 @@
430 entries)) 426 entries))
431 427
432(defun reftex-get-bibkey-default () 428(defun reftex-get-bibkey-default ()
433 ;; Return the word before the cursor. If the cursor is in a 429 "Return the word before the cursor.
434 ;; citation macro, return the word before the macro. 430If the cursor is in a citation macro, return the word before the macro."
435 (let* ((macro (reftex-what-macro 1))) 431 (let* ((macro (reftex-what-macro 1)))
436 (save-excursion 432 (save-excursion
437 (if (and macro (string-match "cite" (car macro))) 433 (if (and macro (string-match "cite" (car macro)))
@@ -439,10 +435,10 @@
439 (skip-chars-backward "^a-zA-Z0-9") 435 (skip-chars-backward "^a-zA-Z0-9")
440 (reftex-this-word)))) 436 (reftex-this-word))))
441 437
442;; Parse and format individual entries 438;;; Parse and format individual entries
443
444(defun reftex-get-bib-names (field entry) 439(defun reftex-get-bib-names (field entry)
445 ;; Return a list with the author or editor names in ENTRY 440 "Return a list with the author or editor names in ENTRY.
441If FIELD is empty try \"editor\" field."
446 (let ((names (reftex-get-bib-field field entry))) 442 (let ((names (reftex-get-bib-field field entry)))
447 (if (equal "" names) 443 (if (equal "" names)
448 (setq names (reftex-get-bib-field "editor" entry))) 444 (setq names (reftex-get-bib-field "editor" entry)))
@@ -457,7 +453,9 @@
457 (split-string names "\n"))) 453 (split-string names "\n")))
458 454
459(defun reftex-parse-bibtex-entry (entry &optional from to raw) 455(defun reftex-parse-bibtex-entry (entry &optional from to raw)
460 ; if RAW is non-nil, keep double quotes/curly braces delimiting fields 456 "Parse BibTeX ENTRY.
457If ENTRY is nil then parse the entry in current buffer between FROM and TO.
458If RAW is non-nil, keep double quotes/curly braces delimiting fields."
461 (let (alist key start field) 459 (let (alist key start field)
462 (save-excursion 460 (save-excursion
463 (save-restriction 461 (save-restriction
@@ -518,7 +516,8 @@
518 alist)) 516 alist))
519 517
520(defun reftex-get-bib-field (fieldname entry &optional format) 518(defun reftex-get-bib-field (fieldname entry &optional format)
521 ;; Extract the field FIELDNAME from an ENTRY 519 "Extract the field FIELDNAME from ENTRY.
520If FORMAT is non-nil `format' entry accordingly."
522 (let ((cell (assoc fieldname entry))) 521 (let ((cell (assoc fieldname entry)))
523 (if cell 522 (if cell
524 (if format 523 (if format
@@ -527,7 +526,7 @@
527 ""))) 526 "")))
528 527
529(defun reftex-format-bib-entry (entry) 528(defun reftex-format-bib-entry (entry)
530 ;; Format a BibTeX ENTRY so that it is nice to look at 529 "Format a BibTeX ENTRY so that it is nice to look at."
531 (let* 530 (let*
532 ((auth-list (reftex-get-bib-names "author" entry)) 531 ((auth-list (reftex-get-bib-names "author" entry))
533 (authors (mapconcat 'identity auth-list ", ")) 532 (authors (mapconcat 'identity auth-list ", "))
@@ -570,7 +569,7 @@
570 (concat key "\n " authors " " year " " extra "\n " title "\n\n"))) 569 (concat key "\n " authors " " year " " extra "\n " title "\n\n")))
571 570
572(defun reftex-parse-bibitem (item) 571(defun reftex-parse-bibitem (item)
573 ;; Parse a \bibitem entry 572 "Parse a \bibitem entry in ITEM."
574 (let ((key "") (text "")) 573 (let ((key "") (text ""))
575 (when (string-match "\\`{\\([^}]+\\)}\\([^\000]*\\)" item) 574 (when (string-match "\\`{\\([^}]+\\)}\\([^\000]*\\)" item)
576 (setq key (match-string 1 item) 575 (setq key (match-string 1 item)
@@ -586,7 +585,7 @@
586 (cons "&entry" (concat key " " text))))) 585 (cons "&entry" (concat key " " text)))))
587 586
588(defun reftex-format-bibitem (item) 587(defun reftex-format-bibitem (item)
589 ;; Format a \bibitem entry so that it is (relatively) nice to look at. 588 "Format a \bibitem entry in ITEM so that it is (relatively) nice to look at."
590 (let ((text (reftex-get-bib-field "&text" item)) 589 (let ((text (reftex-get-bib-field "&text" item))
591 (key (reftex-get-bib-field "&key" item)) 590 (key (reftex-get-bib-field "&key" item))
592 (lines nil)) 591 (lines nil))
@@ -603,7 +602,7 @@
603 (put-text-property 0 (length text) 'face reftex-bib-author-face text)) 602 (put-text-property 0 (length text) 'face reftex-bib-author-face text))
604 (concat key "\n " text "\n\n"))) 603 (concat key "\n " text "\n\n")))
605 604
606;; Make a citation 605;;; Make a citation
607 606
608;;;###autoload 607;;;###autoload
609(defun reftex-citation (&optional no-insert format-key) 608(defun reftex-citation (&optional no-insert format-key)
@@ -627,7 +626,6 @@ The regular expression uses an expanded syntax: && is interpreted as `and'.
627Thus, `aaaa&&bbb' matches entries which contain both `aaaa' and `bbb'. 626Thus, `aaaa&&bbb' matches entries which contain both `aaaa' and `bbb'.
628While entering the regexp, completion on knows citation keys is possible. 627While entering the regexp, completion on knows citation keys is possible.
629`=' is a good regular expression to match all entries in all files." 628`=' is a good regular expression to match all entries in all files."
630
631 (interactive) 629 (interactive)
632 630
633 ;; check for recursive edit 631 ;; check for recursive edit
@@ -645,8 +643,7 @@ While entering the regexp, completion on knows citation keys is possible.
645 (reftex-kill-temporary-buffers))) 643 (reftex-kill-temporary-buffers)))
646 644
647(defun reftex-do-citation (&optional arg no-insert format-key) 645(defun reftex-do-citation (&optional arg no-insert format-key)
648 ;; This really does the work of reftex-citation. 646 "This really does the work of `reftex-citation'."
649
650 (let* ((format (reftex-figure-out-cite-format arg no-insert format-key)) 647 (let* ((format (reftex-figure-out-cite-format arg no-insert format-key))
651 (docstruct-symbol reftex-docstruct-symbol) 648 (docstruct-symbol reftex-docstruct-symbol)
652 (selected-entries (reftex-offer-bib-menu)) 649 (selected-entries (reftex-offer-bib-menu))
@@ -743,8 +740,8 @@ While entering the regexp, completion on knows citation keys is possible.
743 (mapcar 'car selected-entries))) 740 (mapcar 'car selected-entries)))
744 741
745(defun reftex-figure-out-cite-format (arg &optional no-insert format-key) 742(defun reftex-figure-out-cite-format (arg &optional no-insert format-key)
746 ;; Check if there is already a cite command at point and change cite format 743 "Check if there is already a cite command at point and change cite format
747 ;; in order to only add another reference in the same cite command. 744in order to only add another reference in the same cite command."
748 (let ((macro (car (reftex-what-macro 1))) 745 (let ((macro (car (reftex-what-macro 1)))
749 (cite-format-value (reftex-get-cite-format)) 746 (cite-format-value (reftex-get-cite-format))
750 key format) 747 key format)
@@ -802,8 +799,7 @@ While entering the regexp, completion on knows citation keys is possible.
802 799
803(defvar reftex-select-bib-map) 800(defvar reftex-select-bib-map)
804(defun reftex-offer-bib-menu () 801(defun reftex-offer-bib-menu ()
805 ;; Offer bib menu and return list of selected items 802 "Offer bib menu and return list of selected items."
806
807 (let ((bibtype (reftex-bib-or-thebib)) 803 (let ((bibtype (reftex-bib-or-thebib))
808 found-list rtn key data selected-entries) 804 found-list rtn key data selected-entries)
809 (while 805 (while
@@ -917,7 +913,7 @@ While entering the regexp, completion on knows citation keys is possible.
917 selected-entries)) 913 selected-entries))
918 914
919(defun reftex-restrict-bib-matches (found-list) 915(defun reftex-restrict-bib-matches (found-list)
920 ;; Limit FOUND-LIST with more regular expressions 916 "Limit FOUND-LIST with more regular expressions."
921 (let ((re-list (split-string (read-string 917 (let ((re-list (split-string (read-string
922 "RegExp [ && RegExp...]: " 918 "RegExp [ && RegExp...]: "
923 nil 'reftex-cite-regexp-hist) 919 nil 'reftex-cite-regexp-hist)
@@ -940,7 +936,7 @@ While entering the regexp, completion on knows citation keys is possible.
940 found-list))) 936 found-list)))
941 937
942(defun reftex-extract-bib-file (all &optional marked complement) 938(defun reftex-extract-bib-file (all &optional marked complement)
943 ;; Limit FOUND-LIST with more regular expressions 939 "Limit FOUND-LIST with more regular expressions."
944 (let ((file (read-file-name "File to create: "))) 940 (let ((file (read-file-name "File to create: ")))
945 (find-file-other-window file) 941 (find-file-other-window file)
946 (if (> (buffer-size) 0) 942 (if (> (buffer-size) 0)
@@ -963,7 +959,7 @@ While entering the regexp, completion on knows citation keys is possible.
963 (goto-char (point-min)))) 959 (goto-char (point-min))))
964 960
965(defun reftex-insert-bib-matches (list) 961(defun reftex-insert-bib-matches (list)
966 ;; Insert the bib matches and number them correctly 962 "Insert the bib matches and number them correctly."
967 (let ((mouse-face 963 (let ((mouse-face
968 (if (memq reftex-highlight-selection '(mouse both)) 964 (if (memq reftex-highlight-selection '(mouse both))
969 reftex-mouse-selected-face 965 reftex-mouse-selected-face
@@ -996,8 +992,7 @@ While entering the regexp, completion on knows citation keys is possible.
996 last))))) 992 last)))))
997 993
998(defun reftex-format-citation (entry format) 994(defun reftex-format-citation (entry format)
999 ;; Format a citation from the info in the BibTeX ENTRY 995 "Format a citation from the info in the BibTeX ENTRY according to FORMAT."
1000
1001 (unless (stringp format) (setq format "\\cite{%l}")) 996 (unless (stringp format) (setq format "\\cite{%l}"))
1002 997
1003 (if (and reftex-comment-citations 998 (if (and reftex-comment-citations
@@ -1064,7 +1059,7 @@ While entering the regexp, completion on knows citation keys is possible.
1064 format) 1059 format)
1065 1060
1066(defun reftex-make-cite-echo-string (entry docstruct-symbol) 1061(defun reftex-make-cite-echo-string (entry docstruct-symbol)
1067 ;; Format a bibtex entry for the echo area and cache the result. 1062 "Format a bibtex ENTRY for the echo area and cache the result."
1068 (let* ((key (reftex-get-bib-field "&key" entry)) 1063 (let* ((key (reftex-get-bib-field "&key" entry))
1069 (string 1064 (string
1070 (let* ((reftex-cite-punctuation '(" " " & " " etal."))) 1065 (let* ((reftex-cite-punctuation '(" " " & " " etal.")))
@@ -1088,9 +1083,9 @@ While entering the regexp, completion on knows citation keys is possible.
1088 string)) 1083 string))
1089 1084
1090(defun reftex-bibtex-selection-callback (data ignore no-revisit) 1085(defun reftex-bibtex-selection-callback (data ignore no-revisit)
1091 ;; Callback function to be called from the BibTeX selection, in 1086 "Callback function to be called from the BibTeX selection, in
1092 ;; order to display context. This function is relatively slow and not 1087order to display context. This function is relatively slow and not
1093 ;; recommended for follow mode. It works OK for individual lookups. 1088recommended for follow mode. It works OK for individual lookups."
1094 (let ((win (selected-window)) 1089 (let ((win (selected-window))
1095 (key (reftex-get-bib-field "&key" data)) 1090 (key (reftex-get-bib-field "&key" data))
1096 bibfile-list item bibtype) 1091 bibfile-list item bibtype)
@@ -1157,7 +1152,7 @@ While entering the regexp, completion on knows citation keys is possible.
1157 alist)))) 1152 alist))))
1158 1153
1159(defun reftex-create-bibtex-file (bibfile) 1154(defun reftex-create-bibtex-file (bibfile)
1160 "Create a new BibTeX database file with all entries referenced in document. 1155 "Create a new BibTeX database BIBFILE with all entries referenced in document.
1161The command prompts for a filename and writes the collected 1156The command prompts for a filename and writes the collected
1162entries to that file. Only entries referenced in the current 1157entries to that file. Only entries referenced in the current
1163document with any \\cite-like macros are used. The sequence in 1158document with any \\cite-like macros are used. The sequence in
@@ -1247,5 +1242,5 @@ created files in the variables `reftex-create-bibtex-header' or
1247 (message "%d entries extracted and copied to new database" 1242 (message "%d entries extracted and copied to new database"
1248 (length entries)))) 1243 (length entries))))
1249 1244
1250 1245(provide 'reftex-cite)
1251;;; reftex-cite.el ends here 1246;;; reftex-cite.el ends here
diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el
index 3a64aad6a06..a99791e5427 100644
--- a/lisp/textmodes/reftex-parse.el
+++ b/lisp/textmodes/reftex-parse.el
@@ -49,7 +49,8 @@
49 (reftex-access-scan-info '(16))) 49 (reftex-access-scan-info '(16)))
50 50
51(defun reftex-do-parse (rescan &optional file) 51(defun reftex-do-parse (rescan &optional file)
52 "Do a document rescan. When allowed, do only a partial scan from FILE." 52 "Do a document rescan.
53When allowed, do only a partial scan from FILE."
53 54
54 ;; Normalize the rescan argument 55 ;; Normalize the rescan argument
55 (setq rescan (cond ((eq rescan t) t) 56 (setq rescan (cond ((eq rescan t) t)
@@ -191,7 +192,7 @@ of master file."
191(defvar index-tags) 192(defvar index-tags)
192 193
193(defun reftex-parse-from-file (file docstruct master-dir) 194(defun reftex-parse-from-file (file docstruct master-dir)
194 ;; Scan the buffer for labels and save them in a list. 195 "Scan the buffer for labels and save them in a list."
195 (let ((regexp (reftex-everything-regexp)) 196 (let ((regexp (reftex-everything-regexp))
196 (bound 0) 197 (bound 0)
197 file-found tmp include-file 198 file-found tmp include-file
@@ -350,8 +351,7 @@ of master file."
350 docstruct)) 351 docstruct))
351 352
352(defun reftex-locate-bibliography-files (master-dir &optional files) 353(defun reftex-locate-bibliography-files (master-dir &optional files)
353 ;; Scan buffer for bibliography macro and return file list. 354 "Scan buffer for bibliography macro and return file list."
354
355 (unless files 355 (unless files
356 (save-excursion 356 (save-excursion
357 (goto-char (point-min)) 357 (goto-char (point-min))
@@ -379,10 +379,10 @@ of master file."
379 (delq nil files))) 379 (delq nil files)))
380 380
381(defun reftex-replace-label-list-segment (old insert &optional entirely) 381(defun reftex-replace-label-list-segment (old insert &optional entirely)
382 ;; Replace the segment in OLD which corresponds to INSERT. 382 "Replace the segment in OLD which corresponds to INSERT.
383 ;; Works with side effects, directly changes old. 383Works with side effects, directly changes old.
384 ;; If entirely is t, just return INSERT. 384If ENTIRELY is t, just return INSERT.
385 ;; This function also makes sure the old toc markers do not point anywhere. 385This function also makes sure the old toc markers do not point anywhere."
386 386
387 (cond 387 (cond
388 (entirely 388 (entirely
@@ -404,8 +404,8 @@ of master file."
404 new)))) 404 new))))
405 405
406(defun reftex-section-info (file) 406(defun reftex-section-info (file)
407 ;; Return a section entry for the current match. 407 "Return a section entry for the current match.
408 ;; Careful: This function expects the match-data to be still in place! 408Careful: This function expects the match-data to be still in place!"
409 (let* ((marker (set-marker (make-marker) (1- (match-beginning 3)))) 409 (let* ((marker (set-marker (make-marker) (1- (match-beginning 3))))
410 (macro (reftex-match-string 3)) 410 (macro (reftex-match-string 3))
411 (prefix (save-match-data 411 (prefix (save-match-data
@@ -440,9 +440,9 @@ of master file."
440 literal (marker-position marker)))) 440 literal (marker-position marker))))
441 441
442(defun reftex-ensure-index-support (&optional abort) 442(defun reftex-ensure-index-support (&optional abort)
443 ;; When index support is turned off, ask to turn it on and 443 "When index support is turned off, ask to turn it on and
444 ;; set the current prefix argument so that `reftex-access-scan-info' 444set the current prefix argument so that `reftex-access-scan-info'
445 ;; will rescan the entire document. 445will rescan the entire document."
446 (cond 446 (cond
447 (reftex-support-index t) 447 (reftex-support-index t)
448 ((y-or-n-p "Turn on index support and rescan entire document? ") 448 ((y-or-n-p "Turn on index support and rescan entire document? ")
@@ -460,8 +460,8 @@ of master file."
460 460
461(defvar test-dummy) 461(defvar test-dummy)
462(defun reftex-index-info (file) 462(defun reftex-index-info (file)
463 ;; Return an index entry for the current match. 463 "Return an index entry for the current match.
464 ;; Careful: This function expects the match-data to be still in place! 464Careful: This function expects the match-data to be still in place!"
465 (catch 'exit 465 (catch 'exit
466 (let* ((macro (reftex-match-string 10)) 466 (let* ((macro (reftex-match-string 10))
467 (bom (match-beginning 10)) 467 (bom (match-beginning 10))
@@ -508,7 +508,7 @@ of master file."
508 (list 'index index-tag context file bom arg key showkey sortkey key-end)))) 508 (list 'index index-tag context file bom arg key showkey sortkey key-end))))
509 509
510(defun reftex-short-context (env parse &optional bound derive) 510(defun reftex-short-context (env parse &optional bound derive)
511 ;; Get about one line of useful context for the label definition at point. 511 "Get about one line of useful context for the label definition at point."
512 512
513 (if (consp parse) 513 (if (consp parse)
514 (setq parse (if derive (cdr parse) (car parse)))) 514 (setq parse (if derive (cdr parse) (car parse))))
@@ -568,9 +568,9 @@ of master file."
568 "INVALID VALUE OF PARSE")))) 568 "INVALID VALUE OF PARSE"))))
569 569
570(defun reftex-where-am-I () 570(defun reftex-where-am-I ()
571 ;; Return the docstruct entry above point. Actually returns a cons 571 "Return the docstruct entry above point.
572 ;; cell in which the cdr is a flag indicating if the information is 572Actually returns a cons cell in which the cdr is a flag indicating
573 ;; exact (t) or approximate (nil). 573if the information is exact (t) or approximate (nil)."
574 574
575 (let ((docstruct (symbol-value reftex-docstruct-symbol)) 575 (let ((docstruct (symbol-value reftex-docstruct-symbol))
576 (cnt 0) rtn rtn-if-no-other 576 (cnt 0) rtn rtn-if-no-other
@@ -748,10 +748,10 @@ of master file."
748 ) 748 )
749 749
750(defsubst reftex-move-to-previous-arg (&optional bound) 750(defsubst reftex-move-to-previous-arg (&optional bound)
751 ;; Assuming that we are in front of a macro argument, 751 "Assuming that we are in front of a macro argument,
752 ;; move backward to the closing parenthesis of the previous argument. 752move backward to the closing parenthesis of the previous argument.
753 ;; This function understands the splitting of macros over several lines 753This function understands the splitting of macros over several lines
754 ;; in TeX. 754in TeX."
755 (cond 755 (cond
756 ;; Just to be quick: 756 ;; Just to be quick:
757 ((memq (preceding-char) '(?\] ?\}))) 757 ((memq (preceding-char) '(?\] ?\})))
@@ -764,28 +764,27 @@ of master file."
764 (t nil))) 764 (t nil)))
765 765
766(defun reftex-what-macro-safe (which &optional bound) 766(defun reftex-what-macro-safe (which &optional bound)
767 ;; reftex-what-macro with special syntax table. 767 "Call `reftex-what-macro' with special syntax table."
768 (reftex-with-special-syntax 768 (reftex-with-special-syntax
769 (reftex-what-macro which bound))) 769 (reftex-what-macro which bound)))
770 770
771(defun reftex-what-macro (which &optional bound) 771(defun reftex-what-macro (which &optional bound)
772 ;; Find out if point is within the arguments of any TeX-macro. 772 "Find out if point is within the arguments of any TeX-macro.
773 ;; The return value is either ("\\macro" . (point)) or a list of them. 773The return value is either (\"\\macro\" . (point)) or a list of them.
774 774
775 ;; If WHICH is nil, immediately return nil. 775If WHICH is nil, immediately return nil.
776 ;; If WHICH is 1, return innermost enclosing macro. 776If WHICH is 1, return innermost enclosing macro.
777 ;; If WHICH is t, return list of all macros enclosing point. 777If WHICH is t, return list of all macros enclosing point.
778 ;; If WHICH is a list of macros, look only for those macros and return the 778If WHICH is a list of macros, look only for those macros and return the
779 ;; name of the first macro in this list found to enclose point. 779 name of the first macro in this list found to enclose point.
780 ;; If the optional BOUND is an integer, bound backwards directed 780If the optional BOUND is an integer, bound backwards directed
781 ;; searches to this point. If it is nil, limit to nearest \section - 781 searches to this point. If it is nil, limit to nearest \\section -
782 ;; like statement. 782 like statement.
783 783
784 ;; This function is pretty stable, but can be fooled if the text contains 784This function is pretty stable, but can be fooled if the text contains
785 ;; things like \macro{aa}{bb} where \macro is defined to take only one 785things like \\macro{aa}{bb} where \\macro is defined to take only one
786 ;; argument. As RefTeX cannot know this, the string "bb" would still be 786argument. As RefTeX cannot know this, the string \"bb\" would still be
787 ;; considered an argument of macro \macro. 787considered an argument of macro \\macro."
788
789 (unless reftex-section-regexp (reftex-compile-variables)) 788 (unless reftex-section-regexp (reftex-compile-variables))
790 (catch 'exit 789 (catch 'exit
791 (if (null which) (throw 'exit nil)) 790 (if (null which) (throw 'exit nil))
@@ -832,20 +831,19 @@ of master file."
832 (nreverse cmd-list))))) 831 (nreverse cmd-list)))))
833 832
834(defun reftex-what-environment (which &optional bound) 833(defun reftex-what-environment (which &optional bound)
835 ;; Find out if point is inside a LaTeX environment. 834 "Find out if point is inside a LaTeX environment.
836 ;; The return value is (e.g.) either ("equation" . (point)) or a list of 835The return value is (e.g.) either (\"equation\" . (point)) or a list of
837 ;; them. 836them.
838 837
839 ;; If WHICH is nil, immediately return nil. 838If WHICH is nil, immediately return nil.
840 ;; If WHICH is 1, return innermost enclosing environment. 839If WHICH is 1, return innermost enclosing environment.
841 ;; If WHICH is t, return list of all environments enclosing point. 840If WHICH is t, return list of all environments enclosing point.
842 ;; If WHICH is a list of environments, look only for those environments and 841If WHICH is a list of environments, look only for those environments and
843 ;; return the name of the first environment in this list found to enclose 842 return the name of the first environment in this list found to enclose
844 ;; point. 843 point.
845 844
846 ;; If the optional BOUND is an integer, bound backwards directed searches to 845If the optional BOUND is an integer, bound backwards directed searches to
847 ;; this point. If it is nil, limit to nearest \section - like statement. 846this point. If it is nil, limit to nearest \\section - like statement."
848
849 (unless reftex-section-regexp (reftex-compile-variables)) 847 (unless reftex-section-regexp (reftex-compile-variables))
850 (catch 'exit 848 (catch 'exit
851 (save-excursion 849 (save-excursion
@@ -870,18 +868,17 @@ of master file."
870 (nreverse env-list))))) 868 (nreverse env-list)))))
871 869
872(defun reftex-what-special-env (which &optional bound) 870(defun reftex-what-special-env (which &optional bound)
873 ;; Run the special environment parsers and return the matches. 871 "Run the special environment parsers and return the matches.
874 ;; 872
875 ;; The return value is (e.g.) either ("my-parser-function" . (point)) 873The return value is (e.g.) either (\"my-parser-function\" . (point))
876 ;; or a list of them. 874or a list of them.
877
878 ;; If WHICH is nil, immediately return nil.
879 ;; If WHICH is 1, return innermost enclosing environment.
880 ;; If WHICH is t, return list of all environments enclosing point.
881 ;; If WHICH is a list of environments, look only for those environments and
882 ;; return the name of the first environment in this list found to enclose
883 ;; point.
884 875
876If WHICH is nil, immediately return nil.
877If WHICH is 1, return innermost enclosing environment.
878If WHICH is t, return list of all environments enclosing point.
879If WHICH is a list of environments, look only for those environments and
880 return the name of the first environment in this list found to enclose
881 point."
885 (unless reftex-section-regexp (reftex-compile-variables)) 882 (unless reftex-section-regexp (reftex-compile-variables))
886 (catch 'exit 883 (catch 'exit
887 (save-excursion 884 (save-excursion
@@ -911,10 +908,10 @@ of master file."
911 (car specials)))))) 908 (car specials))))))
912 909
913(defsubst reftex-move-to-next-arg (&optional ignore) 910(defsubst reftex-move-to-next-arg (&optional ignore)
914 ;; Assuming that we are at the end of a macro name or a macro argument, 911 "Assuming that we are at the end of a macro name or a macro argument,
915 ;; move forward to the opening parenthesis of the next argument. 912move forward to the opening parenthesis of the next argument.
916 ;; This function understands the splitting of macros over several lines 913This function understands the splitting of macros over several lines
917 ;; in TeX. 914in TeX."
918 (cond 915 (cond
919 ;; Just to be quick: 916 ;; Just to be quick:
920 ((memq (following-char) '(?\[ ?\{))) 917 ((memq (following-char) '(?\[ ?\{)))
@@ -930,8 +927,8 @@ of master file."
930 (reftex-nth-arg (nth 5 entry) (nth 6 entry)))) 927 (reftex-nth-arg (nth 5 entry) (nth 6 entry))))
931 928
932(defun reftex-nth-arg (n &optional opt-args) 929(defun reftex-nth-arg (n &optional opt-args)
933 ;; Return the nth following {} or [] parentheses content. 930 "Return the Nth following {} or [] parentheses content.
934 ;; OPT-ARGS is a list of argument numbers which are optional. 931OPT-ARGS is a list of argument numbers which are optional."
935 932
936 ;; If we are sitting at a macro start, skip to end of macro name. 933 ;; If we are sitting at a macro start, skip to end of macro name.
937 (and (eq (following-char) ?\\) (skip-chars-forward "a-zA-Z*\\\\")) 934 (and (eq (following-char) ?\\) (skip-chars-forward "a-zA-Z*\\\\"))
@@ -974,8 +971,8 @@ of master file."
974 (error nil))) 971 (error nil)))
975 972
976(defun reftex-context-substring (&optional to-end) 973(defun reftex-context-substring (&optional to-end)
977 ;; Return up to 150 chars from point 974 "Return up to 150 chars from point.
978 ;; When point is just after a { or [, limit string to matching parenthesis 975When point is just after a { or [, limit string to matching parenthesis"
979 (cond 976 (cond
980 (to-end 977 (to-end
981 ;; Environment - find next \end 978 ;; Environment - find next \end
@@ -1007,8 +1004,7 @@ of master file."
1007(defvar reftex-section-numbers (make-vector reftex-max-section-depth 0)) 1004(defvar reftex-section-numbers (make-vector reftex-max-section-depth 0))
1008 1005
1009(defun reftex-init-section-numbers (&optional toc-entry appendix) 1006(defun reftex-init-section-numbers (&optional toc-entry appendix)
1010 ;; Initialize the section numbers with zeros or with what is found 1007 "Initialize the section numbers with zeros or with what is found in the TOC-ENTRY."
1011 ;; in the toc entry.
1012 (let* ((level (or (nth 5 toc-entry) -1)) 1008 (let* ((level (or (nth 5 toc-entry) -1))
1013 (numbers (nreverse (split-string (or (nth 6 toc-entry) "") "\\."))) 1009 (numbers (nreverse (split-string (or (nth 6 toc-entry) "") "\\.")))
1014 (depth (1- (length reftex-section-numbers))) 1010 (depth (1- (length reftex-section-numbers)))
@@ -1026,8 +1022,8 @@ of master file."
1026 (put 'reftex-section-numbers 'appendix appendix)) 1022 (put 'reftex-section-numbers 'appendix appendix))
1027 1023
1028(defun reftex-section-number (&optional level star) 1024(defun reftex-section-number (&optional level star)
1029 ;; Return a string with the current section number. 1025 "Return a string with the current section number.
1030 ;; When LEVEL is non-nil, increase section numbers on that level. 1026When LEVEL is non-nil, increase section numbers on that level."
1031 (let* ((depth (1- (length reftex-section-numbers))) idx n (string "") 1027 (let* ((depth (1- (length reftex-section-numbers))) idx n (string "")
1032 (appendix (get 'reftex-section-numbers 'appendix)) 1028 (appendix (get 'reftex-section-numbers 'appendix))
1033 (partspecial (and (not reftex-part-resets-chapter) 1029 (partspecial (and (not reftex-part-resets-chapter)
@@ -1073,7 +1069,7 @@ of master file."
1073 string)))) 1069 string))))
1074 1070
1075(defun reftex-roman-number (n) 1071(defun reftex-roman-number (n)
1076 ;; Return as a string the roman number equal to N. 1072 "Return as a string the roman number equal to N."
1077 (let ((nrest n) 1073 (let ((nrest n)
1078 (string "") 1074 (string "")
1079 (list '((1000 . "M") ( 900 . "CM") ( 500 . "D") ( 400 . "CD") 1075 (list '((1000 . "M") ( 900 . "CM") ( 500 . "D") ( 400 . "CD")
diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el
index b633b7be403..de103c0cdb6 100644
--- a/lisp/vc/log-view.el
+++ b/lisp/vc/log-view.el
@@ -1,9 +1,9 @@
1;;; log-view.el --- Major mode for browsing RCS/CVS/SCCS log output -*- lexical-binding: t -*- 1;;; log-view.el --- Major mode for browsing revision log histories -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1999-2013 Free Software Foundation, Inc. 3;; Copyright (C) 1999-2013 Free Software Foundation, Inc.
4 4
5;; Author: Stefan Monnier <monnier@iro.umontreal.ca> 5;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
6;; Keywords: rcs, sccs, cvs, log, vc, tools 6;; Keywords: tools, vc
7 7
8;; This file is part of GNU Emacs. 8;; This file is part of GNU Emacs.
9 9
@@ -24,10 +24,12 @@
24 24
25;; Major mode to browse revision log histories. 25;; Major mode to browse revision log histories.
26;; Currently supports the format output by: 26;; Currently supports the format output by:
27;; RCS, SCCS, CVS, Subversion, and DaRCS. 27;; SCCS, RCS, CVS, Subversion, DaRCS, and Mercurial.
28 28
29;; Examples of log output: 29;; Examples of log output:
30 30
31;;;; SCCS:
32
31;;;; RCS/CVS: 33;;;; RCS/CVS:
32 34
33;; ---------------------------- 35;; ----------------------------
@@ -43,8 +45,6 @@
43;; Change release version from 21.4 to 22.1 throughout. 45;; Change release version from 21.4 to 22.1 throughout.
44;; Change development version from 21.3.50 to 22.0.50. 46;; Change development version from 21.3.50 to 22.0.50.
45 47
46;;;; SCCS:
47
48;;;; Subversion: 48;;;; Subversion:
49 49
50;; ------------------------------------------------------------------------ 50;; ------------------------------------------------------------------------
@@ -117,18 +117,25 @@
117(defvar cvs-force-command) 117(defvar cvs-force-command)
118 118
119(defgroup log-view nil 119(defgroup log-view nil
120 "Major mode for browsing log output of RCS/CVS/SCCS." 120 "Major mode for browsing log output of revision log histories."
121 :group 'pcl-cvs 121 :group 'pcl-cvs
122 :prefix "log-view-") 122 :prefix "log-view-")
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 126 ("-" . negative-argument)
127 ("z" . kill-this-buffer) 127 ("0" . digit-argument)
128 ("q" . quit-window) 128 ("1" . digit-argument)
129 ("g" . revert-buffer) 129 ("2" . digit-argument)
130 ("\C-m" . log-view-toggle-entry-display) 130 ("3" . digit-argument)
131 ("4" . digit-argument)
132 ("5" . digit-argument)
133 ("6" . digit-argument)
134 ("7" . digit-argument)
135 ("8" . digit-argument)
136 ("9" . digit-argument)
131 137
138 ("\C-m" . log-view-toggle-entry-display)
132 ("m" . log-view-toggle-mark-entry) 139 ("m" . log-view-toggle-mark-entry)
133 ("e" . log-view-modify-change-comment) 140 ("e" . log-view-modify-change-comment)
134 ("d" . log-view-diff) 141 ("d" . log-view-diff)
@@ -145,6 +152,7 @@
145 ("\M-n" . log-view-file-next) 152 ("\M-n" . log-view-file-next)
146 ("\M-p" . log-view-file-prev)) 153 ("\M-p" . log-view-file-prev))
147 "Log-View's keymap." 154 "Log-View's keymap."
155 :inherit special-mode-map
148 :group 'log-view) 156 :group 'log-view)
149 157
150(easy-menu-define log-view-mode-menu log-view-mode-map 158(easy-menu-define log-view-mode-menu log-view-mode-map
@@ -275,6 +283,7 @@ The match group number 1 should match the revision number itself.")
275(easy-mmode-define-navigation log-view-file log-view-file-re "file") 283(easy-mmode-define-navigation log-view-file log-view-file-re "file")
276 284
277(defun log-view-goto-rev (rev) 285(defun log-view-goto-rev (rev)
286 "Go to revision REV."
278 (goto-char (point-min)) 287 (goto-char (point-min))
279 (ignore-errors 288 (ignore-errors
280 (while (not (equal rev (log-view-current-tag))) 289 (while (not (equal rev (log-view-current-tag)))
@@ -288,6 +297,7 @@ The match group number 1 should match the revision number itself.")
288(defconst log-view-dir-re "^cvs[.ex]* [a-z]+: Logging \\(.+\\)$") 297(defconst log-view-dir-re "^cvs[.ex]* [a-z]+: Logging \\(.+\\)$")
289 298
290(defun log-view-current-file () 299(defun log-view-current-file ()
300 "Return the current file."
291 (save-excursion 301 (save-excursion
292 (forward-line 1) 302 (forward-line 1)
293 (or (re-search-backward log-view-file-re nil t) 303 (or (re-search-backward log-view-file-re nil t)
@@ -340,7 +350,7 @@ if POS is omitted or nil, it defaults to point."
340 350
341(defun log-view-toggle-mark-entry () 351(defun log-view-toggle-mark-entry ()
342 "Toggle the marked state for the log entry at point. 352 "Toggle the marked state for the log entry at point.
343Individual log entries can be marked and unmarked. The marked 353Individual log entries can be marked and unmarked. The marked
344entries are denoted by changing their background color. 354entries are denoted by changing their background color.
345`log-view-get-marked' returns the list of tags for the marked 355`log-view-get-marked' returns the list of tags for the marked
346log entries." 356log entries."
@@ -479,7 +489,8 @@ It assumes that a log entry starts with a line matching
479 (funcall f)))) 489 (funcall f))))
480 490
481(defun log-view-find-revision (pos) 491(defun log-view-find-revision (pos)
482 "Visit the version at point." 492 "Visit the version at POS.
493If called interactively, visit the version at point."
483 (interactive "d") 494 (interactive "d")
484 (unless log-view-per-file-logs 495 (unless log-view-per-file-logs
485 (when (> (length log-view-vc-fileset) 1) 496 (when (> (length log-view-vc-fileset) 1)
@@ -521,7 +532,8 @@ It assumes that a log entry starts with a line matching
521 (log-view-extract-comment))) 532 (log-view-extract-comment)))
522 533
523(defun log-view-annotate-version (pos) 534(defun log-view-annotate-version (pos)
524 "Annotate the version at point." 535 "Annotate the version at POS.
536If called interactively, annotate the version at point."
525 (interactive "d") 537 (interactive "d")
526 (unless log-view-per-file-logs 538 (unless log-view-per-file-logs
527 (when (> (length log-view-vc-fileset) 1) 539 (when (> (length log-view-vc-fileset) 1)
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index eee896056c6..17b278d1ce4 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -115,7 +115,7 @@ This is only meaningful if you don't use the implicit checkout model
115This avoids slow queries over the network and instead uses heuristics 115This avoids slow queries over the network and instead uses heuristics
116and past information to determine the current status of a file. 116and past information to determine the current status of a file.
117 117
118If value is the symbol `only-file' `vc-dir' will connect to the 118If value is the symbol `only-file', `vc-dir' will connect to the
119server, but heuristics will be used to determine the status for 119server, but heuristics will be used to determine the status for
120all other VC operations. 120all other VC operations.
121 121
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index 5c8a4515b7e..284481ee524 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -128,7 +128,7 @@ See also variable `vc-consult-headers'."
128This avoids slow queries over the network and instead uses heuristics 128This avoids slow queries over the network and instead uses heuristics
129and past information to determine the current status of a file. 129and past information to determine the current status of a file.
130 130
131If value is the symbol `only-file' `vc-dir' will connect to the 131If value is the symbol `only-file', `vc-dir' will connect to the
132server, but heuristics will be used to determine the status for 132server, but heuristics will be used to determine the status for
133all other VC operations. 133all other VC operations.
134 134
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