aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorDaniel Colascione2012-09-17 04:07:36 -0800
committerDaniel Colascione2012-09-17 04:07:36 -0800
commit2ab329f3b5d52a39f0a45c3d9c129f1c19560142 (patch)
tree6dd6784d63e54cb18071df8e28fbdbc27d418728 /lisp
parentf701ab72dd55460d23c8b029550aa4d7ecef3cfa (diff)
parentbb7dce392f6d9d5fc4b9d7de09ff920a52f07669 (diff)
downloademacs-2ab329f3b5d52a39f0a45c3d9c129f1c19560142.tar.gz
emacs-2ab329f3b5d52a39f0a45c3d9c129f1c19560142.zip
Merge from trunk
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog616
-rw-r--r--lisp/align.el7
-rw-r--r--lisp/autoinsert.el2
-rw-r--r--lisp/bookmark.el5
-rw-r--r--lisp/calc/calc-ext.el4
-rw-r--r--lisp/calc/calc-forms.el2
-rw-r--r--lisp/calc/calc.el2
-rw-r--r--lisp/calendar/calendar.el4
-rw-r--r--lisp/calendar/diary-lib.el24
-rw-r--r--lisp/calendar/holidays.el8
-rw-r--r--lisp/calendar/lunar.el2
-rw-r--r--lisp/calendar/solar.el2
-rw-r--r--lisp/calendar/timeclock.el4
-rw-r--r--lisp/comint.el2
-rw-r--r--lisp/custom.el47
-rw-r--r--lisp/desktop.el2
-rw-r--r--lisp/dired-aux.el63
-rw-r--r--lisp/dired.el61
-rw-r--r--lisp/ehelp.el13
-rw-r--r--lisp/emacs-lisp/advice.el193
-rw-r--r--lisp/emacs-lisp/benchmark.el6
-rw-r--r--lisp/emacs-lisp/byte-run.el9
-rw-r--r--lisp/emacs-lisp/bytecomp.el4
-rw-r--r--lisp/emacs-lisp/cl-lib.el2
-rw-r--r--lisp/emacs-lisp/cl-loaddefs.el28
-rw-r--r--lisp/emacs-lisp/cl-macs.el83
-rw-r--r--lisp/emacs-lisp/debug.el198
-rw-r--r--lisp/emacs-lisp/easymenu.el2
-rw-r--r--lisp/emacs-lisp/edebug.el751
-rw-r--r--lisp/emacs-lisp/lisp-mode.el77
-rw-r--r--lisp/emacs-lisp/macroexp.el110
-rw-r--r--lisp/emacs-lisp/map-ynp.el10
-rw-r--r--lisp/emacs-lisp/pcase.el2
-rw-r--r--lisp/emacs-lisp/timer.el6
-rw-r--r--lisp/emulation/cua-rect.el2
-rw-r--r--lisp/emulation/edt-mapper.el4
-rw-r--r--lisp/emulation/edt.el10
-rw-r--r--lisp/emulation/tpu-edt.el6
-rw-r--r--lisp/emulation/tpu-extras.el2
-rw-r--r--lisp/emulation/tpu-mapper.el2
-rw-r--r--lisp/emulation/vi.el2
-rw-r--r--lisp/emulation/viper.el4
-rw-r--r--lisp/epa-mail.el38
-rw-r--r--lisp/erc/ChangeLog6
-rw-r--r--lisp/erc/erc-button.el2
-rw-r--r--lisp/erc/erc-capab.el2
-rw-r--r--lisp/erc/erc-match.el2
-rw-r--r--lisp/erc/erc-netsplit.el2
-rw-r--r--lisp/erc/erc-page.el2
-rw-r--r--lisp/erc/erc-replace.el2
-rw-r--r--lisp/erc/erc-stamp.el2
-rw-r--r--lisp/erc/erc-track.el2
-rw-r--r--lisp/eshell/em-alias.el8
-rw-r--r--lisp/eshell/em-unix.el2
-rw-r--r--lisp/eshell/esh-util.el2
-rw-r--r--lisp/ffap.el4
-rw-r--r--lisp/files.el145
-rw-r--r--lisp/filesets.el2
-rw-r--r--lisp/flow-ctrl.el2
-rw-r--r--lisp/font-lock.el2
-rw-r--r--lisp/frame.el6
-rw-r--r--lisp/generic-x.el2
-rw-r--r--lisp/gnus/ChangeLog128
-rw-r--r--lisp/gnus/gnus-art.el2
-rw-r--r--lisp/gnus/gnus-demon.el9
-rw-r--r--lisp/gnus/gnus-fun.el4
-rw-r--r--lisp/gnus/gnus-group.el7
-rw-r--r--lisp/gnus/gnus-logic.el73
-rw-r--r--lisp/gnus/gnus-notifications.el22
-rw-r--r--lisp/gnus/gnus-score.el231
-rw-r--r--lisp/gnus/gnus-srvr.el3
-rw-r--r--lisp/gnus/gnus-util.el17
-rw-r--r--lisp/gnus/gnus.el45
-rw-r--r--lisp/gnus/message.el32
-rw-r--r--lisp/gnus/nnmaildir.el286
-rw-r--r--lisp/gnus/qp.el16
-rw-r--r--lisp/help-fns.el2
-rw-r--r--lisp/help.el71
-rw-r--r--lisp/hi-lock.el6
-rw-r--r--lisp/ibuffer.el12
-rw-r--r--lisp/ielm.el2
-rw-r--r--lisp/image.el4
-rw-r--r--lisp/info.el49
-rw-r--r--lisp/international/ogonek.el7
-rw-r--r--lisp/isearch.el19
-rw-r--r--lisp/language/chinese.el10
-rw-r--r--lisp/loadup.el28
-rw-r--r--lisp/locate.el2
-rw-r--r--lisp/mail/feedmail.el5
-rw-r--r--lisp/mail/mail-hist.el2
-rw-r--r--lisp/mail/mailabbrev.el47
-rw-r--r--lisp/mail/smtpmail.el12
-rw-r--r--lisp/mail/uce.el2
-rw-r--r--lisp/minibuffer.el2
-rw-r--r--lisp/mouse-copy.el2
-rw-r--r--lisp/mouse-drag.el2
-rw-r--r--lisp/net/ange-ftp.el14
-rw-r--r--lisp/net/browse-url.el5
-rw-r--r--lisp/net/goto-addr.el2
-rw-r--r--lisp/net/newsticker.el2
-rw-r--r--lisp/net/quickurl.el2
-rw-r--r--lisp/net/tramp-cmds.el2
-rw-r--r--lisp/net/tramp.el4
-rw-r--r--lisp/net/trampver.el4
-rw-r--r--lisp/net/webjump.el2
-rw-r--r--lisp/novice.el4
-rw-r--r--lisp/pcomplete.el2
-rw-r--r--lisp/play/blackbox.el2
-rw-r--r--lisp/play/bubbles.el2
-rw-r--r--lisp/play/decipher.el14
-rw-r--r--lisp/play/handwrite.el2
-rw-r--r--lisp/printing.el10
-rw-r--r--lisp/progmodes/antlr-mode.el2
-rw-r--r--lisp/progmodes/cc-cmds.el17
-rw-r--r--lisp/progmodes/cc-defs.el2
-rw-r--r--lisp/progmodes/cc-engine.el8
-rw-r--r--lisp/progmodes/cc-langs.el7
-rw-r--r--lisp/progmodes/cc-styles.el4
-rw-r--r--lisp/progmodes/cmacexp.el2
-rw-r--r--lisp/progmodes/compile.el22
-rw-r--r--lisp/progmodes/ebnf2ps.el4
-rw-r--r--lisp/progmodes/ebrowse.el2
-rw-r--r--lisp/progmodes/f90.el5
-rw-r--r--lisp/progmodes/flymake.el5
-rw-r--r--lisp/progmodes/hideshow.el2
-rw-r--r--lisp/progmodes/idlw-complete-structtag.el4
-rw-r--r--lisp/progmodes/idlw-shell.el6
-rw-r--r--lisp/progmodes/idlwave.el4
-rw-r--r--lisp/progmodes/inf-lisp.el4
-rw-r--r--lisp/progmodes/mixal-mode.el2
-rw-r--r--lisp/progmodes/octave-mod.el4
-rw-r--r--lisp/progmodes/perl-mode.el4
-rw-r--r--lisp/progmodes/prolog.el4
-rw-r--r--lisp/progmodes/python.el16
-rw-r--r--lisp/progmodes/ruby-mode.el173
-rw-r--r--lisp/progmodes/sh-script.el31
-rw-r--r--lisp/progmodes/sql.el57
-rw-r--r--lisp/progmodes/verilog-mode.el4
-rw-r--r--lisp/progmodes/vhdl-mode.el15
-rw-r--r--lisp/ps-print.el2
-rw-r--r--lisp/register.el51
-rw-r--r--lisp/replace.el110
-rw-r--r--lisp/saveplace.el12
-rw-r--r--lisp/ses.el4
-rw-r--r--lisp/shell.el36
-rw-r--r--lisp/simple.el8
-rw-r--r--lisp/speedbar.el8
-rw-r--r--lisp/startup.el27
-rw-r--r--lisp/strokes.el9
-rw-r--r--lisp/subr.el81
-rw-r--r--lisp/term/iris-ansi.el2
-rw-r--r--lisp/term/lk201.el2
-rw-r--r--lisp/term/rxvt.el2
-rw-r--r--lisp/term/tvi970.el2
-rw-r--r--lisp/term/wyse50.el2
-rw-r--r--lisp/term/xterm.el2
-rw-r--r--lisp/textmodes/flyspell.el6
-rw-r--r--lisp/textmodes/ispell.el5
-rw-r--r--lisp/textmodes/picture.el8
-rw-r--r--lisp/textmodes/reftex.el4
-rw-r--r--lisp/textmodes/rst.el2
-rw-r--r--lisp/textmodes/sgml-mode.el2
-rw-r--r--lisp/textmodes/table.el10
-rw-r--r--lisp/textmodes/two-column.el5
-rw-r--r--lisp/time-stamp.el4
-rw-r--r--lisp/time.el3
-rw-r--r--lisp/url/url-methods.el2
-rw-r--r--lisp/userlock.el48
-rw-r--r--lisp/vc/diff-mode.el2
-rw-r--r--lisp/vc/pcvs-defs.el4
-rw-r--r--lisp/vc/vc-bzr.el14
-rw-r--r--lisp/vc/vc-git.el2
-rw-r--r--lisp/vc/vc.el8
-rw-r--r--lisp/version.el103
-rw-r--r--lisp/windmove.el2
-rw-r--r--lisp/window.el318
176 files changed, 3292 insertions, 1882 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 62d3097ccaa..d56e0e88f91 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,599 @@
12012-09-17 Richard Stallman <rms@gnu.org>
2
3 * epa-mail.el (epa-mail-encrypt): Fix bug when a name has no key.
4
52012-09-17 Chong Yidong <cyd@gnu.org>
6
7 * shell.el (shell-file-name-chars, shell-file-name-quote-list)
8 (shell-dynamic-complete-functions): Convert to defcustom.
9 (shell-prompt-pattern, shell-completion-fignore): Doc fix.
10
11 * bookmark.el (bookmark-bmenu-toggle-filenames): Doc fixes.
12 * comint.el (comint-prompt-read-only):
13 * custom.el (defcustom):
14 * hi-lock.el (hi-lock-mode):
15 * ibuffer.el (ibuffer-formats):
16 * ielm.el (ielm-prompt-read-only):
17 * novice.el (disable-command):
18 * saveplace.el (toggle-save-place):
19 * speedbar.el (speedbar-supported-extension-expressions):
20 * startup.el (auto-save-list-file-prefix, init-file-user)
21 (after-init-hook, inhibit-startup-echo-area-message):
22 * strokes.el (strokes-help):
23 * time-stamp.el (time-stamp):
24 * calendar/calendar.el (calendar, diary-file):
25 * calendar/diary-lib.el (diary-mail-entries, diary)
26 (diary-list-entries-hook):
27 * calendar/holidays.el (holidays, calendar-holidays):
28 * calendar/lunar.el (lunar-phases):
29 * calendar/solar.el (sunrise-sunset):
30 * emulation/edt.el (edt-load-keys):
31 * emulation/viper.el (viper-mode):
32 * eshell/em-alias.el (eshell-command-aliases-list):
33 * eshell/esh-util.el (eshell-convert-numeric-arguments):
34 * international/ogonek.el (ogonek-information):
35 * net/tramp-cmds.el (tramp-bug):
36 * net/quickurl.el (quickurl-reread-hook-postfix):
37 * play/decipher.el (decipher-font-lock-keywords):
38 * progmodes/cc-styles.el (c-set-style):
39 * progmodes/idlw-shell.el (idlwave-shell-prompt-pattern):
40 * progmodes/inf-lisp.el (inferior-lisp-prompt):
41 * progmodes/octave-mod.el (octave-mode):
42 * progmodes/sql.el (sql-mode, sql-interactive-mode, sql-password):
43 * progmodes/verilog-mode.el (verilog-read-defines):
44 * textmodes/two-column.el (2C-mode): Likewise.
45
462012-09-16 Katsumi Yamaoka <yamaoka@jpl.org>
47
48 * mail/mailabbrev.el (mail-abbrev-expand-hook): Work for a mail aliasee
49 that holds many addresses.
50
512012-09-16 Chong Yidong <cyd@gnu.org>
52
53 * align.el (align-areas): Call the indication function with
54 positions instead of markers for arguments (Bug#12343).
55
56 * files.el (parse-colon-path): Use split-string (Bug#12351).
57
58 * window.el (special-display-popup-frame): Doc fix (Bug#8853).
59 (display-buffer-function): Mark as obsolete.
60
61 * progmodes/compile.el (compilation-parse-errors): Accept list
62 values similar to font-lock-keywords (Bug#12136). Suggested by
63 Oleksandr Manzyuk.
64 (compilation-error-regexp-alist): Doc fix.
65
662012-09-15 Glenn Morris <rgm@gnu.org>
67
68 * version.el (emacs-bzr-version-bzr): New function.
69 (emacs-bzr-get-version): Add optional EXTERNAL argument.
70
71 * vc/vc-bzr.el (vc-bzr-working-revision): For lightweight local
72 checkouts, check the parent dirstate matches the branch.
73 Add "--tree" to "bzr revno" arguments. Don't try to shorten the
74 empty string.
75
76 * version.el (emacs-bzr-version): Doc fix.
77 (emacs-bzr-version-dirstate): New function.
78 (emacs-bzr-get-version): For lightweight checkouts, if the parent
79 is local try and check that it matches the branch. If not, just
80 use dirstate information. (Bug#12441)
81
822012-09-14 Juri Linkov <juri@jurta.org>
83
84 * dired-aux.el (dired-do-chmod): Use `eq' to detect empty input.
85 (Bug#12399)
86
872012-09-14 Stefan Monnier <monnier@iro.umontreal.ca>
88
89 * emacs-lisp/advice.el (ad-prognify): Remove, use macroexp-progn.
90
91 * emacs-lisp/edebug.el: Miscellaneous cleanup.
92 Remove obsolete byte-compiler hack that tried to silence some warnings.
93 (edebug-submit-bug-report): Remove.
94 (edebug-get-buffer-window, edebug-sit-for, edebug-input-pending-p):
95 Remove aliases, use the un-prefixed name instead.
96 (edebug-pop-to-buffer): Consider other frames.
97 (edebug-original-read):: Make it more obvious that it's always defined.
98 (edebug--make-form-data-entry, edebug--form-data-name)
99 (edebug--form-data-begin, edebug--form-data-end): Rename from the
100 single-dashed name, and implement with cl-defstruct.
101 (edebug-set-form-data-entry): Use the standard accessors.
102 (edebug-make-top-form-data-entry): Use push.
103 (edebug-no-match): Drop useless `funcall'.
104 (mapcar, mapconcat, mapatoms, apply, funcall): Don't add debug specs
105 to functions.
106 (defsubst, dont-compile, eval-when-compile, eval-and-compile)
107 (delay-mode-hooks, with-temp-file, with-temp-message, ad-dolist)
108 (with-syntax-table, push, pop, 1value, noreturn, defadvice)
109 (easy-menu-define, with-custom-print): Remove redundant specs.
110 (edebug-outside-overriding-local-map)
111 (edebug-outside-overriding-terminal-local-map): Remove, unused.
112 (edebug--display): Bind unread-command-events directly to nil rather
113 than binding it to unread-command-events and later setting it to nil.
114 (edebug--display): Kill edebug-eval-buffer here...
115 (edebug--recursive-edit): ...rather than here.
116 Bind standard-output and standard-input.
117 (edebug-eval): Check cl-macroexpand-all is fboundp.
118 (edebug-temp-display-freq-count): Fix last change.
119
120 * emacs-lisp/easymenu.el (easy-menu-define): Add `debug' spec.
121 * subr.el (noreturn, 1value): Add `debug' spec.
122 * emacs-lisp/advice.el: Require cl-lib.
123 (ad-copy-tree): Remove, use copy-tree instead.
124 (ad-dolist): Remove use dolist or cl-dolist instead.
125 (ad-do-return): Remove, use cl-return instead.
126 (defadvice): Add `debug' spec.
127
1282012-09-13 Juri Linkov <juri@jurta.org>
129
130 * dired-aux.el (dired-do-chxxx): Use `eq' to detect empty input.
131 (Bug#12399)
132
1332012-09-13 Glenn Morris <rgm@gnu.org>
134
135 * calc/calc.el (math-compose-expr):
136 * calc/calc-ext.el (math-compose-expr):
137 * progmodes/cc-defs.el (cl-macroexpand-all):
138 * progmodes/cc-langs.el (delete-duplicates, mapcan)
139 (cl-macroexpand-all): Update declarations.
140
141 * vc/vc.el: No need to require ediff.
142 (ediff-load-version-control): Declare.
143 (ediff-vc-internal): Fix declaration.
144 (vc-version-ediff): Require ediff.
145
1462012-09-13 Paul Eggert <eggert@cs.ucla.edu>
147
148 Use a more backwards-compatible timer format (Bug#12430).
149 * emacs-lisp/timer.el (timer): PSECS is now at the end, rather than
150 being right after USECS, as that better supports old code that
151 inadvisedly looked directly at the timer vector.
152
1532012-09-13 Kenichi Handa <handa@gnu.org>
154
155 * language/chinese.el ("Chinese-GB", "Chinese-BIG5")
156 ("Chinese-CNS", "Chinese-EUC-TW"): Add chinese-gbk to
157 `coding-priority' property of these language environment.
158
1592012-09-13 Paul Eggert <eggert@cs.ucla.edu>
160
161 Fix glitches caused by addition of psec to timers (Bug#12430).
162 * image.el (image-animate-timer):
163 * time.el (display-time-world-timer):
164 Use timer--function and timer--args rather than raw access to
165 timer vector.
166
1672012-09-13 Glenn Morris <rgm@gnu.org>
168
169 * emacs-lisp/bytecomp.el (byte-compile-warning-prefix):
170 If not compiling a file, try using load-file-name.
171
1722012-09-13 Stefan Monnier <monnier@iro.umontreal.ca>
173
174 * emacs-lisp/edebug.el (edebug-outside-unread-command-events):
175 Fix last change.
176 (edebug-update-eval-list): Use `push'.
177
178 * emacs-lisp/edebug.el: Use lexical-binding.
179 Remove the "edebug-" prefix from non-dynamically-scoped variables.
180 Mark unused args with underscore.
181 (edebug-save-restriction, edebug-outside-excursion): Use `declare'.
182 (edebug-form-data): Use defvar-local.
183 (edebug-make-before-and-after-form, edebug-make-after-form):
184 Use backquote.
185 (edebug-args, edebug-value, edebug-after-index, edebug-arg-mode):
186 Not dynamically scoped any more.
187 (edebug--enter-trace): Add arguments `function' and `args'.
188 Rename from edebug-enter-trace.
189 (edebug-enter): Call it accordingly. Bind edebug-function explicitly.
190 (edebug--update-coverage): Add `after-index' and `value' args.
191 Rename from edebug-update-coverage.
192 (edebug-slow-after): Call it accordingly.
193 (edebug--recursive-edit): Add arg `arg-mode'. Rename from
194 edebug-recursive-edit.
195 (edebug--display): Call it accordingly. Add args `value',
196 `offset-index', and `arg-mode'. Rename from edebug-display.
197 (edebug-debugger, edebug): Call it accordingly.
198 (edebug-eval-display-list): Use dolist.
199
2002012-09-12 Juri Linkov <juri@jurta.org>
201
202 * info.el (Info-search): Don't check for isearch-mode and
203 isearch-regexp before let-binding search-spaces-regexp to
204 Info-search-whitespace-regexp.
205 (Info-isearch-search): Let-bind Info-search-whitespace-regexp to
206 search-whitespace-regexp if isearch-lax-whitespace or
207 isearch-regexp-lax-whitespace is non-nil.
208 (Info-mode): Don't set local variable search-whitespace-regexp.
209 http://lists.gnu.org/archive/html/emacs-devel/2012-08/msg00811.html
210
2112012-09-12 Stefan Monnier <monnier@iro.umontreal.ca>
212
213 * emacs-lisp/debug.el (debugger-outer-unread-command-char, debug)
214 (debugger-env-macro): Remove support for unread-command-char.
215
216 * subr.el (set-temporary-overlay-map): Minimize slightly the impact of
217 the temporary map re-appearing on emulation-mode-map-alists.
218
219 * emacs-lisp/edebug.el (def-edebug-form-spec): Remove, it's been broken
220 since 22.1.
221
222 * ehelp.el (with-electric-help): Accept functions in
223 electric-help-form-to-execute.
224 (electric-help-execute-extended, electric-help-ctrl-x-prefix): Use it.
225 And replace unread-command-char -> unread-command-events.
226
2272012-09-12 Michael Albinus <michael.albinus@gmx.de>
228
229 Sync with Tramp 2.2.6.
230
231 * net/tramp.el (tramp-accept-process-output): Don't use
232 JUST-THIS-ONE in the XEmacs case.
233
234 * net/trampver.el: Update release number.
235
2362012-09-12 Martin Rudalics <rudalics@gmx.at>
237
238 * emacs-lisp/debug.el (debugger-previous-window-height):
239 New variable.
240 (debug): When debugger-jumping-flag is non-nil try to restore
241 height of debugger window. (Bug#8789)
242
2432012-09-12 Stefan Monnier <monnier@iro.umontreal.ca>
244
245 * emacs-lisp/edebug.el (edebug-enter): Don't mess with
246 overriding-local-map and pre/post-command-hook here.
247 (edebug-recursive-edit): Do it here instead (bug#12345).
248 (edebug-outside-unread-command-char): Remove all uses of
249 unread-command-char.
250
251 * emacs-lisp/debug.el (debug): Don't bind debug-on-error since
252 inhibit-debugger is bound instead.
253
2542012-09-11 Bastien Guerry <bzg@gnu.org>
255
256 * subr.el (set-temporary-overlay-map): Add a docstring.
257 (Bug#12346)
258
2592012-09-11 Bastien Guerry <bzg@gnu.org>
260
261 * minibuffer.el (completion-table-subvert): Fix docstring.
262 (Bug#12347)
263
2642012-09-11 Bastien Guerry <bzg@gnu.org>
265
266 * help-fns.el (describe-variable): Fix typo. (Bug#12346)
267
2682012-09-10 Michael R. Mauger <mmaug@yahoo.com>
269
270 * progmodes/sql.el: Version 3.1
271 (sql-db2-escape-newlines): New variable.
272 (sql-escape-newlines-filter): Use it.
273
2742012-09-10 Juanma Barranquero <lekktu@gmail.com>
275
276 * custom.el (custom-theme-load-confirm): Remove unneeded assignment.
277
2782012-09-10 Dan Nicolaescu <dann@gnu.org>
279
280 * vc/diff-mode.el (diff-mode-menu):
281 Bind diff-remove-trailing-whitespace.
282
2832012-09-10 Stefan Monnier <monnier@iro.umontreal.ca>
284
285 * emacs-lisp/lisp-mode.el (emacs-list-byte-code-comment-re): New var.
286 (emacs-lisp-byte-code-comment, emacs-lisp-byte-code-syntax-propertize)
287 (emacs-lisp-byte-code-mode): New functions.
288 (eval-sexp-add-defvars): Don't skip defvars in column >0.
289 (eval-defun-2): Remove bogus interactive spec.
290 (lisp-indent-line): Remove redundant whole-exp code, now done in
291 indent-according-to-mode.
292 (save-match-data): Remove redundant indent data.
293
294 * emacs-lisp/benchmark.el (benchmark-run, benchmark-run-compiled):
295 Use `declare'.
296
2972012-09-09 Juri Linkov <juri@jurta.org>
298
299 * replace.el (replace-regexp-lax-whitespace): New defcustom.
300 (replace-lax-whitespace, query-replace-regexp)
301 (query-replace-regexp-eval, replace-regexp): Doc fix.
302 (perform-replace, replace-highlight): Let-bind
303 isearch-lax-whitespace to replace-lax-whitespace and
304 isearch-regexp-lax-whitespace to replace-regexp-lax-whitespace.
305
306 * isearch.el (isearch-query-replace): Let-bind
307 replace-lax-whitespace to isearch-lax-whitespace and
308 replace-regexp-lax-whitespace to
309 isearch-regexp-lax-whitespace. (Bug#10885)
310
3112012-09-09 Stefan Monnier <monnier@iro.umontreal.ca>
312
313 * eshell/em-unix.el (eshell/sudo): Explicitly drop return value.
314
3152012-09-09 Alan Mackenzie <acm@muc.de>
316
317 * progmodes/cc-engine.el (c-state-cache-init):
318 Initialise c-state-semi-nonlit-pos-cache\(-limit\)? properly.
319 (c-record-parse-state-state):
320 Record c-state-semi-nonlit-pos-cache\(-limit\)?.
321
3222012-09-09 Andreas Schwab <schwab@linux-m68k.org>
323
324 * register.el (register-separator): Rename from
325 separator-register. All uses changed. Doc fix.
326 (register): Fix version.
327
3282012-09-09 Chong Yidong <cyd@gnu.org>
329
330 * replace.el (query-replace-map): Bind four new symbols for
331 requesting window scrolling.
332
333 * subr.el (y-or-n-p): Handle the window-scrolling bindings in
334 query-replace-map (Bug#8948).
335
336 * custom.el (custom-theme-load-confirm): Use y-or-n-p.
337
338 * emacs-lisp/map-ynp.el (map-y-or-n-p): Don't bind scrolling keys
339 since they are now in query-replace-map.
340
341 * window.el (scroll-other-window-down): Make the arg optional.
342
3432012-09-09 Chong Yidong <cyd@gnu.org>
344
345 * files.el (hack-local-variables-confirm): Use quit-window to kill
346 the *Local Variables* buffer.
347
3482012-09-08 Dmitry Gutov <dgutov@yandex.ru>
349
350 * progmodes/ruby-mode.el (ruby-toggle-block): Guess the current block,
351 not just expect to be at its beginning. Adjust callees.
352 Succeed when do-end block has no space before the pipe character.
353 (ruby-brace-to-do-end): When the original block is one-liner,
354 convert to multiline. Reindent the result.
355
3562012-09-08 Jambunathan K <kjambunathan@gmail.com>
357
358 * register.el (register): New group.
359 (register-separator): New user option.
360 (increment-register): Route it to `append-to-register', if
361 register contains text. Implication is that `C-x r +' can now be
362 used for appending to a text register (bug#12217).
363 (append-to-register, prepend-to-register): Add separator based on
364 `register-separator.
365
3662012-09-08 Alan Mackenzie <acm@muc.de>
367
368 AWK Mode: make auto-newline work when there's "==" in the pattern.
369 * progmodes/cc-cmds.el (c-point-syntax): Handle virtual semicolons
370 correctly.
371 * progmodes/cc-engine.el (c-guess-basic-syntax CASE 5A.3):
372 Test more rigorously for "=" token.
373
3742012-09-08 Dmitry Gutov <dgutov@yandex.ru>
375
376 * progmodes/ruby-mode.el (ruby-match-expression-expansion):
377 Only fail when reached LIMIT.
378
3792012-09-08 Chong Yidong <cyd@gnu.org>
380
381 * dired.el (dired-mode-map): Don't bind M-=.
382
383 * dired-aux.el (dired-diff): Use backup file as default.
384
3852012-09-08 Drew Adams <drew.adams@oracle.com>
386
387 * subr.el (add-to-history): Fix delete usage (Bug#12314).
388
3892012-09-08 Chong Yidong <cyd@gnu.org>
390
391 * subr.el (syntax-after, syntax-class): Doc fix.
392
3932012-09-08 Martin Rudalics <rudalics@gmx.at>
394
395 * window.el (display-buffer-in-previous-window): New buffer
396 display action function.
397
398 * emacs-lisp/debug.el (debugger-bury-or-kill): New option.
399 (debugger-previous-window): New variable.
400 (debug): Rewrite using display-buffer-in-previous-window,
401 quit-restore-window and debugger-bury-or-kill. (Bug#8789)
402
4032012-09-07 Stefan Monnier <monnier@iro.umontreal.ca>
404
405 * emacs-lisp/byte-run.el (defun): Tweak message. Simplify code.
406
4072012-09-07 Matt McClure <mlm@aya.yale.edu> (tiny change)
408
409 * progmodes/python.el (python-shell-send-string):
410 When default-directory is remote, create temp file on remote
411 filesystem.
412 (python-shell-send-file): When file is remote, pass local view of
413 file paths to remote Python interpreter. (Bug#12340)
414
4152012-09-07 Chong Yidong <cyd@gnu.org>
416
417 * window.el (switch-to-buffer): Doc fix (Bug#12181).
418
419 * files.el (after-find-file): Don't fail on a read-only buffer if
420 require-final-newline is `visit' or `visit-save' (Bug#11156).
421
422 * subr.el (read-char-choice): Allow quitting via ESC ESC.
423
424 * userlock.el (ask-user-about-supersession-threat):
425 Use read-char-choice (Bug#12093).
426
4272012-09-07 Chong Yidong <cyd@gnu.org>
428
429 * subr.el (buffer-narrowed-p): New function.
430
431 * ses.el (ses-widen):
432 * simple.el (count-words--buffer-message):
433 * net/browse-url.el (browse-url-of-buffer): Use it
434
435 * simple.el (count-words-region): Don't signal an error if there
436 is a non-nil prefix arg and the mark is not set.
437
438 * help.el (describe-key-briefly): Allow the message to be seen
439 when invoked from the minibuffer (Bug#7014).
440
4412012-09-07 Dmitry Gutov <dgutov@yandex.ru>
442
443 * progmodes/ruby-mode.el (ruby-end-of-defun)
444 (ruby-beginning-of-defun): Simplify, allow indentation before
445 block beginning and end keywords.
446 (ruby-beginning-of-defun): Only consider 3 keywords defun beginners.
447 (ruby-end-of-defun): Expect that the point is at the beginning of
448 the defun.
449
4502012-09-06 Stefan Monnier <monnier@iro.umontreal.ca>
451
452 * emacs-lisp/cl-macs.el (cl--do-arglist): Understand _ on &key args
453 (bug#12367).
454 (cl--make-usage-args): Strip _ from argument names.
455
4562012-09-06 Rüdiger Sonderfeld <ruediger@c-plusplus.de>
457
458 * progmodes/vhdl-mode.el (vhdl-speedbar-initialize): Don't use
459 obsolete alias speedbar-key-map.
460 (vhdl-doc-variable, vhdl-doc-mode): Use called-interactively-p.
461 (vhdl-index-menu-init): Don't use obsolete variable
462 font-lock-maximum-size.
463
4642012-09-06 Chong Yidong <cyd@gnu.org>
465
466 * frame.el (window-system-version): Mark as obsolete.
467
468 * speedbar.el (speedbar-update-flag, speedbar-mode): Remove uses
469 of obsolete variable speedbar-key-map.
470
4712012-09-06 Juri Linkov <juri@jurta.org>
472
473 * replace.el (replace-lax-whitespace): New defcustom.
474 (query-replace, query-replace-regexp, query-replace-regexp-eval)
475 (replace-string, replace-regexp): Mention it in docstrings.
476 (perform-replace, replace-highlight): Let-bind
477 isearch-lax-whitespace and isearch-regexp-lax-whitespace according
478 to the values of replace-lax-whitespace and regexp-flag.
479 Don't let-bind search-whitespace-regexp. (Bug#10885)
480
481 * isearch.el (isearch-query-replace): Let-bind
482 replace-lax-whitespace instead of let-binding
483 replace-search-function and replace-re-search-function.
484 (isearch-lazy-highlight-search): Let-bind isearch-lax-whitespace
485 and isearch-regexp-lax-whitespace to lazy-highlight variables.
486 (isearch-toggle-symbol): Set isearch-regexp to nil
487 in isearch-word mode (like in isearch-toggle-word).
488
4892012-09-06 Juri Linkov <juri@jurta.org>
490
491 * replace.el (replace-search-function)
492 (replace-re-search-function): Set default values to nil.
493 (perform-replace): Let-bind isearch-related variables based on
494 replace-related values, call `isearch-search-fun' and let-bind
495 the result to `search-function'. Remove code that sets
496 `search-function' and `search-string' separately for
497 `delimited-flag'.
498 (replace-highlight): Add new argument `delimited-flag' and
499 rename other arguments to the names used in `perform-replace'.
500 Let-bind `isearch-word' to the argument `delimited-flag'.
501 (Bug#10885, bug#10887)
502
5032012-09-07 Dmitry Gutov <dgutov@yandex.ru>
504
505 * progmodes/ruby-mode.el (ruby-indent-beg-re): Add pieces from
506 ruby-beginning-of-indent, simplify, allow all keywords to have
507 indentation before them.
508 (ruby-beginning-of-indent): Adjust for above. Search until the
509 found point is not inside a string or comment.
510 (ruby-font-lock-keywords): Allow symbols to start with "@"
511 character, give them higher priority than variables.
512 (ruby-syntax-propertize-function)
513 (ruby-font-lock-syntactic-keywords): Remove the "not comments"
514 matchers. Expression expansions are not comments when inside a
515 string, and there comment syntax status is irrelevant.
516 (ruby-match-expression-expansion): New function. Check that
517 expression expansion is inside a string, and it's not escaped.
518 (ruby-font-lock-keywords): Use it.
519
5202012-09-05 Martin Rudalics <rudalics@gmx.at>
521
522 * help.el (temp-buffer-max-height): New default value.
523 (temp-buffer-resize-frames): New option.
524 (resize-temp-buffer-window): Optionally resize frame.
525
526 * window.el (fit-frame-to-buffer-bottom-margin): New option.
527 (fit-frame-to-buffer): New function.
528
5292012-09-05 Glenn Morris <rgm@gnu.org>
530
531 * emulation/cua-rect.el (cua--init-rectangles):
532 * textmodes/picture.el (picture-mode-map):
533 * play/blackbox.el (blackbox-mode-map): Remap right-char and left-char
534 like forward-char and backward-char. (Bug#12317)
535
5362012-09-05 Leo Liu <sdl.web@gmail.com>
537
538 * progmodes/flymake.el (flymake-warning-re): New variable.
539 (flymake-parse-line): Use it.
540
5412012-09-05 Glenn Morris <rgm@gnu.org>
542
543 * calendar/holidays.el (holiday-christian-holidays):
544 Rename an entry. (Bug#12289)
545
5462012-09-05 Stefan Monnier <monnier@iro.umontreal.ca>
547
548 * progmodes/sh-script.el (sh-font-lock-paren): Don't burp at BOB
549 (bug#12222).
550
5512012-09-04 Stefan Monnier <monnier@iro.umontreal.ca>
552
553 * loadup.el: Load macroexp. Remove hack.
554 * emacs-lisp/macroexp.el (macroexp--eval-if-compile): New function.
555 (macroexp--expand-all): Use it to get better warnings.
556 (macroexp--backtrace, macroexp--trim-backtrace-frame)
557 (internal-macroexpand-for-load): New functions.
558 (macroexp--pending-eager-loads): New var.
559 (emacs-startup-hook): New hack to replace one in loadup.el.
560 * emacs-lisp/cl-macs.el (cl--compiler-macro-list*)
561 (cl--compiler-macro-cXXr): Move to top, before they can be used.
562 (cl-psetf): Simplify.
563 (cl-defstruct): Add indent rule.
564
5652012-09-04 Lars Ingebrigtsen <larsi@gnus.org>
566
567 * mail/smtpmail.el (smtpmail-send-it): Prefer the From: header
568 over `user-mail-address' for the SMTP MAIL FROM envelope.
569 (smtpmail-via-smtp): Ditto.
570
5712012-09-04 Dmitry Gutov <dgutov@yandex.ru>
572
573 * progmodes/ruby-mode.el: Clean up keybindings.
574 (ruby-mode-map): Don't bind ruby-electric-brace,
575 ruby-beginning-of-defun, ruby-end-of-defun, ruby-mark-defun,
576 backward-kill-word, reindent-then-newline-and-indent.
577 (ruby-mark-defun): Remove.
578 (ruby-electric-brace): Remove. Obsoleted by electric-indent-chars.
579 (ruby-mode): Set local beginning-of-defun-function and
580 end-of-defun-function values.
581
5822012-09-03 Martin Rudalics <rudalics@gmx.at>
583
584 * window.el (temp-buffer-window-setup-hook)
585 (temp-buffer-window-show-hook): New hooks.
586 (temp-buffer-window-setup, temp-buffer-window-show)
587 (with-temp-buffer-window): New functions.
588 (fit-window-to-buffer): Remove unused optional argument OVERRIDE.
589 (special-display-popup-frame): Make sure the window used shows BUFFER.
590
591 * help.el (temp-buffer-resize-mode): Fix doc-string.
592 (resize-temp-buffer-window): New optional argument WINDOW.
593
594 * files.el (recover-file, save-buffers-kill-emacs):
595 * dired.el (dired-mark-pop-up): Use with-temp-buffer-window.
596
12012-09-02 Michael Albinus <michael.albinus@gmx.de> 5972012-09-02 Michael Albinus <michael.albinus@gmx.de>
2 598
3 * eshell/em-unix.el (eshell/sudo): When we have an ad-hoc 599 * eshell/em-unix.el (eshell/sudo): When we have an ad-hoc
@@ -132,8 +728,8 @@
1322012-08-29 Michael Albinus <michael.albinus@gmx.de> 7282012-08-29 Michael Albinus <michael.albinus@gmx.de>
133 729
134 * eshell/esh-ext.el (eshell-external-command): Do not examine 730 * eshell/esh-ext.el (eshell-external-command): Do not examine
135 remote shell scripts. See 731 remote shell scripts.
136 <https://bugs.launchpad.net/ubuntu/+source/emacs23/+bug/1035790>. 732 See <https://bugs.launchpad.net/ubuntu/+source/emacs23/+bug/1035790>.
137 733
138 * net/tramp-sh.el (tramp-remote-path): Add "/sbin" and 734 * net/tramp-sh.el (tramp-remote-path): Add "/sbin" and
139 "/usr/local/sbin". 735 "/usr/local/sbin".
@@ -1175,7 +1771,7 @@
1175 * calc-mode.el (calc-basic-simplification-mode): Rename from 1771 * calc-mode.el (calc-basic-simplification-mode): Rename from
1176 `calc-limited-simplification-mode'. 1772 `calc-limited-simplification-mode'.
1177 (calc-alg-simplification-mode): New function. 1773 (calc-alg-simplification-mode): New function.
1178 (calc-set-simplify-mode): Adjust message. 1774 (calc-set-simplify-mode): Adjust message.
1179 1775
1180 * calc.el (calc-set-mode-line): Adjust mode line display for 1776 * calc.el (calc-set-mode-line): Adjust mode line display for
1181 basic simplification mode. 1777 basic simplification mode.
@@ -1373,7 +1969,7 @@
1373 * notifications.el (notifications-on-action-signal) 1969 * notifications.el (notifications-on-action-signal)
1374 (notifications-on-closed-signal): Use also the bus address for the map. 1970 (notifications-on-closed-signal): Use also the bus address for the map.
1375 (notifications-notify, notifications-close-notification) 1971 (notifications-notify, notifications-close-notification)
1376 (notifications-get-capabilities): Add optional argument BUS. 1972 (notifications-get-capabilities): Add optional argument BUS.
1377 1973
13782012-07-27 Tassilo Horn <tsdh@gnu.org> 19742012-07-27 Tassilo Horn <tsdh@gnu.org>
1379 1975
@@ -1493,7 +2089,7 @@
1493 ses-cell-set-formula or ses-set-cell to change the cell and handle 2089 ses-cell-set-formula or ses-set-cell to change the cell and handle
1494 the undo at the same time, but rather use lower level new macros 2090 the undo at the same time, but rather use lower level new macros
1495 `ses-cell-formula-aset' and `ses-cell-references-aset' and handle 2091 `ses-cell-formula-aset' and `ses-cell-references-aset' and handle
1496 the undo directly. Refresh the mode line. 2092 the undo directly. Refresh the mode line.
1497 2093
14982012-07-21 Leo Liu <sdl.web@gmail.com> 20942012-07-21 Leo Liu <sdl.web@gmail.com>
1499 2095
@@ -4909,13 +5505,13 @@
4909 * progmodes/verilog-mode.el (font-lock-keywords): 5505 * progmodes/verilog-mode.el (font-lock-keywords):
4910 Fix mis-highligting auto. Reported by Craig Barner. 5506 Fix mis-highligting auto. Reported by Craig Barner.
4911 (verilog-auto, verilog-auto-undef): Add AUTOUNDEF to remove 5507 (verilog-auto, verilog-auto-undef): Add AUTOUNDEF to remove
4912 defines from global name space. Reported by Dan Dever. 5508 defines from global name space. Reported by Dan Dever.
4913 (verilog-auto-reset, verilog-auto-reset-widths) 5509 (verilog-auto-reset, verilog-auto-reset-widths)
4914 (verilog-auto-tieoff): Support using unbased numbers for 5510 (verilog-auto-tieoff): Support using unbased numbers for
4915 AUTORESET and AUTOTIEOFF. 5511 AUTORESET and AUTOTIEOFF.
4916 (verilog-submit-bug-report): Update variable list. 5512 (verilog-submit-bug-report): Update variable list.
4917 (verilog-read-auto-params): Fix AUTOINPUT regexps containing 5513 (verilog-read-auto-params): Fix AUTOINPUT regexps containing
4918 parenthesis from not matching. Reported by Michael Rytting. 5514 parenthesis from not matching. Reported by Michael Rytting.
4919 (verilog-auto-template-lint): Fix hash error when linting modules 5515 (verilog-auto-template-lint): Fix hash error when linting modules
4920 with no used templates. 5516 with no used templates.
4921 (verilog-warn, verilog-warn-error) 5517 (verilog-warn, verilog-warn-error)
@@ -4925,12 +5521,12 @@
4925 (verilog-read-auto-template): Add `verilog-auto-template-warn-unused' 5521 (verilog-read-auto-template): Add `verilog-auto-template-warn-unused'
4926 to report unused template errors. Reported by Brad Dobbie. 5522 to report unused template errors. Reported by Brad Dobbie.
4927 (verilog-read-decls): Fix AUTOWIRE etc on supply0, supply1 type 5523 (verilog-read-decls): Fix AUTOWIRE etc on supply0, supply1 type
4928 nets, bug438. Reported by Vns Blore. 5524 nets, bug438. Reported by Vns Blore.
4929 (verilog-auto-inout-module, verilog-auto-reg) 5525 (verilog-auto-inout-module, verilog-auto-reg)
4930 (verilog-read-decls, verilog-read-sub-decls-sig) 5526 (verilog-read-decls, verilog-read-sub-decls-sig)
4931 (verilog-signals-edit-wire-reg, verilog-signals-with): 5527 (verilog-signals-edit-wire-reg, verilog-signals-with):
4932 Fix passing of Verilog data types in ANSI input/output ports 5528 Fix passing of Verilog data types in ANSI input/output ports
4933 such as "output logic" into the AUTOs. Special case "wire" and 5529 such as "output logic" into the AUTOs. Special case "wire" and
4934 "reg" for backwards compatibility presuming Verilog 2001. 5530 "reg" for backwards compatibility presuming Verilog 2001.
4935 (verilog-auto-ascii-enum): Add "auto enum" as alias. 5531 (verilog-auto-ascii-enum): Add "auto enum" as alias.
4936 (verilog-preprocess): Fix replication of preprocess output. 5532 (verilog-preprocess): Fix replication of preprocess output.
@@ -4951,7 +5547,7 @@
4951 (verilog-read-decls): Fix 'parameter type' not appearing in 5547 (verilog-read-decls): Fix 'parameter type' not appearing in
4952 AUTOINSTPARAM, bug340. Reported by Jonathan Greenlaw. 5548 AUTOINSTPARAM, bug340. Reported by Jonathan Greenlaw.
4953 (verilog-auto-logic): Fix when AUTOLOGIC present to properly do 5549 (verilog-auto-logic): Fix when AUTOLOGIC present to properly do
4954 AUTOINPUTs, bug411. Reported by Jonathan Greenlaw. 5550 AUTOINPUTs, bug411. Reported by Jonathan Greenlaw.
4955 (verilog-read-auto-lisp): Avoid syntax-ppss warning on AUTOLISP. 5551 (verilog-read-auto-lisp): Avoid syntax-ppss warning on AUTOLISP.
4956 Reported by David Kravitz. 5552 Reported by David Kravitz.
4957 5553
diff --git a/lisp/align.el b/lisp/align.el
index 4c82d7bea81..0af5e56c668 100644
--- a/lisp/align.el
+++ b/lisp/align.el
@@ -74,7 +74,7 @@
74;; align-?-modes variables (for example, `align-dq-string-modes'), use 74;; align-?-modes variables (for example, `align-dq-string-modes'), use
75;; `add-to-list', or some similar function which checks first to see 75;; `add-to-list', or some similar function which checks first to see
76;; if the value is already there. Since the user may customize that 76;; if the value is already there. Since the user may customize that
77;; mode list, and then write your mode name into their .emacs file, 77;; mode list, and then write your mode name into their init file,
78;; causing the symbol already to be present the next time they load 78;; causing the symbol already to be present the next time they load
79;; your package. 79;; your package.
80 80
@@ -1201,7 +1201,10 @@ have been aligned. No changes will be made to the buffer."
1201 (gocol col) cur) 1201 (gocol col) cur)
1202 (when area 1202 (when area
1203 (if func 1203 (if func
1204 (funcall func (car area) (cdr area) change) 1204 (funcall func
1205 (marker-position (car area))
1206 (marker-position (cdr area))
1207 change)
1205 (if (not (and justify 1208 (if (not (and justify
1206 (consp (cdr area)))) 1209 (consp (cdr area))))
1207 (goto-char (cdr area)) 1210 (goto-char (cdr area))
diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el
index fbf8c466585..21c35811ac3 100644
--- a/lisp/autoinsert.el
+++ b/lisp/autoinsert.el
@@ -36,7 +36,7 @@
36;; setq auto-insert-directory to an appropriate slash-terminated value 36;; setq auto-insert-directory to an appropriate slash-terminated value
37;; 37;;
38;; You can also customize the variable `auto-insert-mode' to load the 38;; You can also customize the variable `auto-insert-mode' to load the
39;; package. Alternatively, add the following to your .emacs file: 39;; package. Alternatively, add the following to your init file:
40;; (auto-insert-mode 1) 40;; (auto-insert-mode 1)
41;; 41;;
42;; Author: Charlie Martin 42;; Author: Charlie Martin
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index 75a8d9f59dc..31bbc13acf9 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -144,10 +144,7 @@ You can toggle whether files are shown with \\<bookmark-bmenu-mode-map>\\[bookma
144 144
145(defcustom bookmark-bmenu-toggle-filenames t 145(defcustom bookmark-bmenu-toggle-filenames t
146 "Non-nil means show filenames when listing bookmarks. 146 "Non-nil means show filenames when listing bookmarks.
147This may result in truncated bookmark names. To disable this, put the 147A non-nil value may result in truncated bookmark names."
148following in your `.emacs' file:
149
150\(setq bookmark-bmenu-toggle-filenames nil)"
151 :type 'boolean 148 :type 'boolean
152 :group 'bookmark) 149 :group 'bookmark)
153 150
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index 7089070df59..c7d93530fd7 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -61,7 +61,7 @@
61(declare-function math-vector-is-string "calccomp" (a)) 61(declare-function math-vector-is-string "calccomp" (a))
62(declare-function math-vector-to-string "calccomp" (a &optional quoted)) 62(declare-function math-vector-to-string "calccomp" (a &optional quoted))
63(declare-function math-format-radix-float "calc-bin" (a prec)) 63(declare-function math-format-radix-float "calc-bin" (a prec))
64(declare-function math-compose-expr "calccomp" (a prec)) 64(declare-function math-compose-expr "calccomp" (a prec &optional div))
65(declare-function math-abs "calc-arith" (a)) 65(declare-function math-abs "calc-arith" (a))
66(declare-function math-format-bignum-binary "calc-bin" (a)) 66(declare-function math-format-bignum-binary "calc-bin" (a))
67(declare-function math-format-bignum-octal "calc-bin" (a)) 67(declare-function math-format-bignum-octal "calc-bin" (a))
@@ -3483,7 +3483,7 @@ If X is not an error form, return 1."
3483 (substring str i)))) 3483 (substring str i))))
3484 str)) 3484 str))
3485 3485
3486;;; Users can redefine this in their .emacs files. 3486;;; Users can redefine this in their init files.
3487(defvar calc-keypad-user-menu nil 3487(defvar calc-keypad-user-menu nil
3488 "If non-nil, this describes an additional menu for calc-keypad. 3488 "If non-nil, this describes an additional menu for calc-keypad.
3489It should contain a list of three rows. 3489It should contain a list of three rows.
diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el
index dfc5dfc6588..bd748158d66 100644
--- a/lisp/calc/calc-forms.el
+++ b/lisp/calc/calc-forms.el
@@ -494,7 +494,7 @@
494 (car res)))))))) 494 (car res))))))))
495 495
496 496
497;;; It is safe to redefine these in your .emacs file to use a different 497;;; It is safe to redefine these in your init file to use a different
498;;; language. 498;;; language.
499 499
500(defvar math-long-weekday-names '( "Sunday" "Monday" "Tuesday" "Wednesday" 500(defvar math-long-weekday-names '( "Sunday" "Monday" "Tuesday" "Wednesday"
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 3e6ae1c7404..17f0998d30b 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -199,7 +199,7 @@
199(declare-function calc-div-fractions "calc-frac" (a b)) 199(declare-function calc-div-fractions "calc-frac" (a b))
200(declare-function math-div-objects-fancy "calc-arith" (a b)) 200(declare-function math-div-objects-fancy "calc-arith" (a b))
201(declare-function math-div-symb-fancy "calc-arith" (a b)) 201(declare-function math-div-symb-fancy "calc-arith" (a b))
202(declare-function math-compose-expr "calccomp" (a prec)) 202(declare-function math-compose-expr "calccomp" (a prec &optional div))
203(declare-function math-comp-width "calccomp" (c)) 203(declare-function math-comp-width "calccomp" (c))
204(declare-function math-composition-to-string "calccomp" (c &optional width)) 204(declare-function math-composition-to-string "calccomp" (c &optional width))
205(declare-function math-stack-value-offset-fancy "calccomp" ()) 205(declare-function math-stack-value-offset-fancy "calccomp" ())
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index d5514d14a32..cdbf8d7aa86 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -593,7 +593,7 @@ You can customize `diary-date-forms' to your preferred format.
593Three default styles are provided: `diary-american-date-forms', 593Three default styles are provided: `diary-american-date-forms',
594`diary-european-date-forms', and `diary-iso-date-forms'. 594`diary-european-date-forms', and `diary-iso-date-forms'.
595You can choose between these by setting `calendar-date-style' in your 595You can choose between these by setting `calendar-date-style' in your
596.emacs file, or by using `calendar-set-date-style' when in the calendar. 596init file, or by using `calendar-set-date-style' when in the calendar.
597 597
598A diary entry can be preceded by the character `diary-nonmarking-symbol' 598A diary entry can be preceded by the character `diary-nonmarking-symbol'
599\(ordinarily `&') to make that entry nonmarking--that is, it will not be 599\(ordinarily `&') to make that entry nonmarking--that is, it will not be
@@ -1276,7 +1276,7 @@ Runs the following hooks:
1276 generating a calendar, if today's date is visible or not, respectively 1276 generating a calendar, if today's date is visible or not, respectively
1277`calendar-initial-window-hook' - after first creating a calendar 1277`calendar-initial-window-hook' - after first creating a calendar
1278 1278
1279This function is suitable for execution in a .emacs file." 1279This function is suitable for execution in an init file."
1280 (interactive "P") 1280 (interactive "P")
1281 ;; Avoid loading cal-x unless it will be used. 1281 ;; Avoid loading cal-x unless it will be used.
1282 (if (and (memq calendar-setup '(one-frame two-frames calendar-only)) 1282 (if (and (memq calendar-setup '(one-frame two-frames calendar-only))
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index 8fa5b0ddb07..4bce8ec0927 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -200,19 +200,21 @@ holidays), or hard copy output."
200 'diary-list-entries-hook "23.1") 200 'diary-list-entries-hook "23.1")
201 201
202(defcustom diary-list-entries-hook nil 202(defcustom diary-list-entries-hook nil
203 "List of functions called after diary file is culled for relevant entries. 203 "Hook run after diary file is culled for relevant entries.
204You might wish to add `diary-include-other-diary-files', in which case 204
205you will probably also want to add `diary-mark-included-diary-files' to 205If you add `diary-include-other-diary-files' to this hook, you
206`diary-mark-entries-hook'. For example, you could use 206will probably also want to add `diary-mark-included-diary-files'
207to `diary-mark-entries-hook'. For example, to cause the fancy
208diary buffer to be displayed with diary entries from various
209included files, each day's entries sorted into lexicographic
210order, add the following to your init file:
207 211
208 (setq diary-display-function 'diary-fancy-display) 212 (setq diary-display-function 'diary-fancy-display)
209 (add-hook 'diary-list-entries-hook 'diary-include-other-diary-files) 213 (add-hook 'diary-list-entries-hook 'diary-include-other-diary-files)
210 (add-hook 'diary-list-entries-hook 'diary-sort-entries t) 214 (add-hook 'diary-list-entries-hook 'diary-sort-entries t)
211 215
212in your `.emacs' file to cause the fancy diary buffer to be displayed with 216Note how the sort function is placed last, so that it can sort
213diary entries from various included files, each day's entries sorted into 217the entries included from other files.
214lexicographic order. Note how the sort function is placed last,
215so that it can sort the entries included from other files.
216 218
217This hook runs after `diary-nongregorian-listing-hook'. These two hooks 219This hook runs after `diary-nongregorian-listing-hook'. These two hooks
218differ only if you are using included diary files. In that case, 220differ only if you are using included diary files. In that case,
@@ -532,7 +534,7 @@ If so, return the expanded file name, otherwise signal an error."
532 "Generate the diary window for ARG days starting with the current date. 534 "Generate the diary window for ARG days starting with the current date.
533If no argument is provided, the number of days of diary entries is governed 535If no argument is provided, the number of days of diary entries is governed
534by the variable `diary-number-of-entries'. A value of ARG less than 1 536by the variable `diary-number-of-entries'. A value of ARG less than 1
535does nothing. This function is suitable for execution in a `.emacs' file." 537does nothing. This function is suitable for execution in an init file."
536 (interactive "P") 538 (interactive "P")
537 (diary-check-diary-file) 539 (diary-check-diary-file)
538 (diary-list-entries (calendar-current-date) 540 (diary-list-entries (calendar-current-date)
@@ -1230,8 +1232,8 @@ Mail is sent to the address specified by `diary-mail-addr'.
1230 1232
1231Here is an example of a script to call `diary-mail-entries', 1233Here is an example of a script to call `diary-mail-entries',
1232suitable for regular scheduling using cron (or at). Note that 1234suitable for regular scheduling using cron (or at). Note that
1233since `emacs -script' does not load your `.emacs' file, you 1235since `emacs -script' does not load your init file, you should
1234should ensure that all relevant variables are set. 1236ensure that all relevant variables are set.
1235 1237
1236#!/usr/bin/emacs -script 1238#!/usr/bin/emacs -script
1237;; diary-rem.el - run the Emacs diary-reminder 1239;; diary-rem.el - run the Emacs diary-reminder
diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el
index 043d402f612..b94815f98ea 100644
--- a/lisp/calendar/holidays.el
+++ b/lisp/calendar/holidays.el
@@ -250,7 +250,7 @@ See the documentation for `calendar-holidays' for details."
250 (if calendar-christian-all-holidays-flag 250 (if calendar-christian-all-holidays-flag
251 (append 251 (append
252 (holiday-fixed 1 6 "Epiphany") 252 (holiday-fixed 1 6 "Epiphany")
253 (holiday-julian 12 25 "Eastern Orthodox Christmas") 253 (holiday-julian 12 25 "Christmas (Julian calendar)")
254 (holiday-greek-orthodox-easter) 254 (holiday-greek-orthodox-easter)
255 (holiday-fixed 8 15 "Assumption") 255 (holiday-fixed 8 15 "Assumption")
256 (holiday-advent 0 "Advent"))))) 256 (holiday-advent 0 "Advent")))))
@@ -343,12 +343,12 @@ See the documentation for `calendar-holidays' for details."
343 "List of notable days for the command \\[holidays]. 343 "List of notable days for the command \\[holidays].
344 344
345Additional holidays are easy to add to the list, just put them in the 345Additional holidays are easy to add to the list, just put them in the
346list `holiday-other-holidays' in your .emacs file. Similarly, by setting 346list `holiday-other-holidays' in your init file. Similarly, by setting
347any of `holiday-general-holidays', `holiday-local-holidays', 347any of `holiday-general-holidays', `holiday-local-holidays',
348`holiday-christian-holidays', `holiday-hebrew-holidays', 348`holiday-christian-holidays', `holiday-hebrew-holidays',
349`holiday-islamic-holidays', `holiday-bahai-holidays', 349`holiday-islamic-holidays', `holiday-bahai-holidays',
350`holiday-oriental-holidays', or `holiday-solar-holidays' to nil in your 350`holiday-oriental-holidays', or `holiday-solar-holidays' to nil in your
351.emacs file, you can eliminate unwanted categories of holidays. 351init file, you can eliminate unwanted categories of holidays.
352 352
353The aforementioned variables control the holiday choices offered 353The aforementioned variables control the holiday choices offered
354by the function `holiday-list' when it is called interactively. 354by the function `holiday-list' when it is called interactively.
@@ -523,7 +523,7 @@ use instead of point."
523(defun holidays (&optional arg) 523(defun holidays (&optional arg)
524 "Display the holidays for last month, this month, and next month. 524 "Display the holidays for last month, this month, and next month.
525If called with an optional prefix argument ARG, prompts for month and year. 525If called with an optional prefix argument ARG, prompts for month and year.
526This function is suitable for execution in a .emacs file." 526This function is suitable for execution in a init file."
527 (interactive "P") 527 (interactive "P")
528 (save-excursion 528 (save-excursion
529 (let* ((completion-ignore-case t) 529 (let* ((completion-ignore-case t)
diff --git a/lisp/calendar/lunar.el b/lisp/calendar/lunar.el
index 8f09d20f50e..2761df0bdb1 100644
--- a/lisp/calendar/lunar.el
+++ b/lisp/calendar/lunar.el
@@ -236,7 +236,7 @@ use instead of point."
236(defun lunar-phases (&optional arg) 236(defun lunar-phases (&optional arg)
237 "Display the quarters of the moon for last month, this month, and next month. 237 "Display the quarters of the moon for last month, this month, and next month.
238If called with an optional prefix argument ARG, prompts for month and year. 238If called with an optional prefix argument ARG, prompts for month and year.
239This function is suitable for execution in a .emacs file." 239This function is suitable for execution in an init file."
240 (interactive "P") 240 (interactive "P")
241 (save-excursion 241 (save-excursion
242 (let* ((date (if arg (calendar-read-date t) 242 (let* ((date (if arg (calendar-read-date t)
diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el
index a8d7d44af3b..3ccdf135fb6 100644
--- a/lisp/calendar/solar.el
+++ b/lisp/calendar/solar.el
@@ -797,7 +797,7 @@ If called with an optional prefix argument ARG, prompt for date.
797If called with an optional double prefix argument, prompt for 797If called with an optional double prefix argument, prompt for
798longitude, latitude, time zone, and date, and always use standard time. 798longitude, latitude, time zone, and date, and always use standard time.
799 799
800This function is suitable for execution in a .emacs file." 800This function is suitable for execution in an init file."
801 (interactive "p") 801 (interactive "p")
802 (or arg (setq arg 1)) 802 (or arg (setq arg 1))
803 (if (and (< arg 16) 803 (if (and (< arg 16)
diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el
index 2ebb8c7c3ae..3151ce145de 100644
--- a/lisp/calendar/timeclock.el
+++ b/lisp/calendar/timeclock.el
@@ -49,7 +49,7 @@
49;; If you want Emacs to display the amount of time "left" to your 49;; If you want Emacs to display the amount of time "left" to your
50;; workday in the mode-line, you can either set the value of 50;; workday in the mode-line, you can either set the value of
51;; `timeclock-mode-line-display' to t using M-x customize, or you can 51;; `timeclock-mode-line-display' to t using M-x customize, or you can
52;; add this code to your .emacs file: 52;; add this code to your init file:
53;; 53;;
54;; (require 'timeclock) 54;; (require 'timeclock)
55;; (timeclock-mode-line-display) 55;; (timeclock-mode-line-display)
@@ -60,7 +60,7 @@
60;; You may also want Emacs to ask you before exiting, if you are 60;; You may also want Emacs to ask you before exiting, if you are
61;; currently working on a project. This can be done either by setting 61;; currently working on a project. This can be done either by setting
62;; `timeclock-ask-before-exiting' to t using M-x customize (this is 62;; `timeclock-ask-before-exiting' to t using M-x customize (this is
63;; the default), or by adding the following to your .emacs file: 63;; the default), or by adding the following to your init file:
64;; 64;;
65;; (add-hook 'kill-emacs-query-functions 'timeclock-query-out) 65;; (add-hook 'kill-emacs-query-functions 'timeclock-query-out)
66 66
diff --git a/lisp/comint.el b/lisp/comint.el
index 5b0eb3027e6..638ef73d53d 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -181,7 +181,7 @@ override the read-only-ness of comint prompts is to call
181`comint-kill-whole-line' or `comint-kill-region' with no 181`comint-kill-whole-line' or `comint-kill-region' with no
182narrowing in effect. This way you will be certain that none of 182narrowing in effect. This way you will be certain that none of
183the remaining prompts will be accidentally messed up. You may 183the remaining prompts will be accidentally messed up. You may
184wish to put something like the following in your `.emacs' file: 184wish to put something like the following in your init file:
185 185
186\(add-hook 'comint-mode-hook 186\(add-hook 'comint-mode-hook
187 (lambda () 187 (lambda ()
diff --git a/lisp/custom.el b/lisp/custom.el
index fb166dd35f7..01b0e6d1650 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -237,7 +237,7 @@ The following keywords are meaningful:
237 is `default-value'. 237 is `default-value'.
238:require 238:require
239 VALUE should be a feature symbol. If you save a value 239 VALUE should be a feature symbol. If you save a value
240 for this option, then when your `.emacs' file loads the value, 240 for this option, then when your init file loads the value,
241 it does (require VALUE) first. 241 it does (require VALUE) first.
242:set-after VARIABLES 242:set-after VARIABLES
243 Specifies that SYMBOL should be set after the list of variables 243 Specifies that SYMBOL should be set after the list of variables
@@ -1223,38 +1223,19 @@ Return t if THEME was successfully loaded, nil otherwise."
1223 "Query the user about loading a Custom theme that may not be safe. 1223 "Query the user about loading a Custom theme that may not be safe.
1224The theme should be in the current buffer. If the user agrees, 1224The theme should be in the current buffer. If the user agrees,
1225query also about adding HASH to `custom-safe-themes'." 1225query also about adding HASH to `custom-safe-themes'."
1226 (if noninteractive 1226 (unless noninteractive
1227 nil 1227 (save-window-excursion
1228 (let ((exit-chars '(?y ?n ?\s)) 1228 (rename-buffer "*Custom Theme*" t)
1229 window prompt char) 1229 (emacs-lisp-mode)
1230 (save-window-excursion 1230 (pop-to-buffer (current-buffer))
1231 (rename-buffer "*Custom Theme*" t) 1231 (goto-char (point-min))
1232 (emacs-lisp-mode) 1232 (prog1 (when (y-or-n-p "Loading a theme can run Lisp code. Really load? ")
1233 (setq window (display-buffer (current-buffer))) 1233 ;; Offer to save to `custom-safe-themes'.
1234 (setq prompt 1234 (and (or custom-file user-init-file)
1235 (format "Loading a theme can run Lisp code. Really load?%s" 1235 (y-or-n-p "Treat this theme as safe in future sessions? ")
1236 (if (and window 1236 (customize-push-and-save 'custom-safe-themes (list hash)))
1237 (< (line-number-at-pos (point-max)) 1237 t)
1238 (window-body-height))) 1238 (quit-window)))))
1239 " (y or n) "
1240 (push ?\C-v exit-chars)
1241 "\nType y or n, or C-v to scroll: ")))
1242 (goto-char (point-min))
1243 (while (null char)
1244 (setq char (read-char-choice prompt exit-chars))
1245 (when (eq char ?\C-v)
1246 (if window
1247 (with-selected-window window
1248 (condition-case nil
1249 (scroll-up)
1250 (error (goto-char (point-min))))))
1251 (setq char nil)))
1252 (when (memq char '(?\s ?y))
1253 ;; Offer to save to `custom-safe-themes'.
1254 (and (or custom-file user-init-file)
1255 (y-or-n-p "Treat this theme as safe in future sessions? ")
1256 (customize-push-and-save 'custom-safe-themes (list hash)))
1257 t)))))
1258 1239
1259(defun custom-theme-name-valid-p (name) 1240(defun custom-theme-name-valid-p (name)
1260 "Return t if NAME is a valid name for a Custom theme, nil otherwise. 1241 "Return t if NAME is a valid name for a Custom theme, nil otherwise.
diff --git a/lisp/desktop.el b/lisp/desktop.el
index a873a6b63bf..75deb58b4d8 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -34,7 +34,7 @@
34;; - some local variables 34;; - some local variables
35 35
36;; To use this, use customize to turn on desktop-save-mode or add the 36;; To use this, use customize to turn on desktop-save-mode or add the
37;; following line somewhere in your .emacs file: 37;; following line somewhere in your init file:
38;; 38;;
39;; (desktop-save-mode 1) 39;; (desktop-save-mode 1)
40;; 40;;
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 6186f762e0a..e5ca463e8d4 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -54,43 +54,30 @@ into this list; they also should call `dired-log' to log the errors.")
54;;;###autoload 54;;;###autoload
55(defun dired-diff (file &optional switches) 55(defun dired-diff (file &optional switches)
56 "Compare file at point with file FILE using `diff'. 56 "Compare file at point with file FILE using `diff'.
57FILE defaults to the file at the mark. (That's the mark set by 57If called interactively, prompt for FILE; if the file at point
58\\[set-mark-command], not by Dired's \\[dired-mark] command.) 58has a backup file, use that as the default.
59The prompted-for FILE is the first file given to `diff'. 59
60FILE is the first file given to `diff'.
60With prefix arg, prompt for second argument SWITCHES, 61With prefix arg, prompt for second argument SWITCHES,
61which is the string of command switches for `diff'." 62which is the string of command switches for `diff'."
62 (interactive 63 (interactive
63 (let* ((current (dired-get-filename t)) 64 (let* ((current (dired-get-filename t))
64 ;; Get the file at the mark. 65 (oldf (file-newest-backup current))
65 (file-at-mark (if (mark t) 66 (dir (if oldf (file-name-directory oldf))))
66 (save-excursion (goto-char (mark t)) 67 (list (read-file-name
67 (dired-get-filename t t)))) 68 (format "Diff %s with%s: "
68 ;; Use it as default if it's not the same as the current file, 69 (file-name-nondirectory current)
69 ;; and the target dir is the current dir or the mark is active. 70 (if oldf
70 (default (if (and (not (equal file-at-mark current)) 71 (concat " (default "
71 (or (equal (dired-dwim-target-directory) 72 (file-name-nondirectory oldf)
72 (dired-current-directory)) 73 ")")
73 mark-active)) 74 ""))
74 file-at-mark)) 75 dir oldf t)
75 (target-dir (if default 76 (if current-prefix-arg
76 (dired-current-directory) 77 (read-string "Options for diff: "
77 (dired-dwim-target-directory))) 78 (if (stringp diff-switches)
78 (defaults (dired-dwim-target-defaults (list current) target-dir))) 79 diff-switches
79 (require 'diff) 80 (mapconcat 'identity diff-switches " ")))))))
80 (list
81 (minibuffer-with-setup-hook
82 (lambda ()
83 (set (make-local-variable 'minibuffer-default-add-function) nil)
84 (setq minibuffer-default defaults))
85 (read-file-name
86 (format "Diff %s with%s: " current
87 (if default (format " (default %s)" default) ""))
88 target-dir default t))
89 (if current-prefix-arg
90 (read-string "Options for diff: "
91 (if (stringp diff-switches)
92 diff-switches
93 (mapconcat 'identity diff-switches " ")))))))
94 (let ((current (dired-get-filename t))) 81 (let ((current (dired-get-filename t)))
95 (when (or (equal (expand-file-name file) 82 (when (or (equal (expand-file-name file)
96 (expand-file-name current)) 83 (expand-file-name current))
@@ -257,7 +244,10 @@ List has a form of (file-name full-file-name (attribute-list))."
257 (function dired-check-process) 244 (function dired-check-process)
258 (append 245 (append
259 (list operation program) 246 (list operation program)
260 (unless (string-equal new-attribute "") 247 (unless (or (string-equal new-attribute "")
248 ;; Use `eq' instead of `equal'
249 ;; to detect empty input (bug#12399).
250 (eq new-attribute default))
261 (if (eq op-symbol 'touch) 251 (if (eq op-symbol 'touch)
262 (list "-t" new-attribute) 252 (list "-t" new-attribute)
263 (list new-attribute))) 253 (list new-attribute)))
@@ -291,7 +281,10 @@ Symbolic modes like `g+w' are allowed."
291 "Change mode of %s to: " 281 "Change mode of %s to: "
292 nil 'chmod arg files default)) 282 nil 'chmod arg files default))
293 num-modes) 283 num-modes)
294 (cond ((equal modes "") 284 (cond ((or (equal modes "")
285 ;; Use `eq' instead of `equal'
286 ;; to detect empty input (bug#12399).
287 (eq modes default))
295 ;; We used to treat empty input as DEFAULT, but that is not 288 ;; We used to treat empty input as DEFAULT, but that is not
296 ;; such a good idea (Bug#9361). 289 ;; such a good idea (Bug#9361).
297 (error "No file mode specified")) 290 (error "No file mode specified"))
diff --git a/lisp/dired.el b/lisp/dired.el
index 5ae0e026172..54921a4ea66 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1410,7 +1410,6 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
1410 (define-key map "&" 'dired-do-async-shell-command) 1410 (define-key map "&" 'dired-do-async-shell-command)
1411 ;; Comparison commands 1411 ;; Comparison commands
1412 (define-key map "=" 'dired-diff) 1412 (define-key map "=" 'dired-diff)
1413 (define-key map "\M-=" 'dired-backup-diff)
1414 ;; Tree Dired commands 1413 ;; Tree Dired commands
1415 (define-key map "\M-\C-?" 'dired-unmark-all-files) 1414 (define-key map "\M-\C-?" 'dired-unmark-all-files)
1416 (define-key map "\M-\C-d" 'dired-tree-down) 1415 (define-key map "\M-\C-d" 'dired-tree-down)
@@ -2973,36 +2972,43 @@ If t, confirmation is never needed."
2973 (const shell) (const symlink) (const touch) 2972 (const shell) (const symlink) (const touch)
2974 (const uncompress)))) 2973 (const uncompress))))
2975 2974
2976(defun dired-mark-pop-up (bufname op-symbol files function &rest args) 2975(defun dired-mark-pop-up (buffer-or-name op-symbol files function &rest args)
2977 "Return FUNCTION's result on ARGS after showing which files are marked. 2976 "Return FUNCTION's result on ARGS after showing which files are marked.
2978Displays the file names in a buffer named BUFNAME; 2977Displays the file names in a window showing a buffer named
2979 nil gives \" *Marked Files*\". 2978BUFFER-OR-NAME; the default name being \" *Marked Files*\". The
2980This uses function `dired-pop-to-buffer' to do that. 2979window is not shown if there is just one file, `dired-no-confirm'
2981 2980is t, or OP-SYMBOL is a member of the list in `dired-no-confirm'.
2982FUNCTION should not manipulate files, just read input 2981
2983 (an argument or confirmation).
2984The window is not shown if there is just one file or
2985 OP-SYMBOL is a member of the list in `dired-no-confirm'.
2986FILES is the list of marked files. It can also be (t FILENAME) 2982FILES is the list of marked files. It can also be (t FILENAME)
2987in the case of one marked file, to distinguish that from using 2983in the case of one marked file, to distinguish that from using
2988just the current file." 2984just the current file.
2989 (or bufname (setq bufname " *Marked Files*")) 2985
2986FUNCTION should not manipulate files, just read input \(an
2987argument or confirmation)."
2990 (if (or (eq dired-no-confirm t) 2988 (if (or (eq dired-no-confirm t)
2991 (memq op-symbol dired-no-confirm) 2989 (memq op-symbol dired-no-confirm)
2992 ;; If FILES defaulted to the current line's file. 2990 ;; If FILES defaulted to the current line's file.
2993 (= (length files) 1)) 2991 (= (length files) 1))
2994 (apply function args) 2992 (apply function args)
2995 (with-current-buffer (get-buffer-create bufname) 2993 (let ((buffer (get-buffer-create (or buffer-or-name " *Marked Files*"))))
2996 (erase-buffer) 2994 (with-current-buffer buffer
2997 ;; Handle (t FILE) just like (FILE), here. 2995 (let ((split-height-threshold 0))
2998 ;; That value is used (only in some cases), to mean 2996 (with-temp-buffer-window
2999 ;; just one file that was marked, rather than the current line file. 2997 buffer
3000 (dired-format-columns-of-files (if (eq (car files) t) (cdr files) files)) 2998 (cons 'display-buffer-below-selected nil)
3001 (remove-text-properties (point-min) (point-max) 2999 #'(lambda (window _value)
3002 '(mouse-face nil help-echo nil))) 3000 (with-selected-window window
3003 (save-window-excursion 3001 (unwind-protect
3004 (dired-pop-to-buffer bufname) 3002 (apply function args)
3005 (apply function args)))) 3003 (when (window-live-p window)
3004 (quit-restore-window window 'kill)))))
3005 ;; Handle (t FILE) just like (FILE), here. That value is
3006 ;; used (only in some cases), to mean just one file that was
3007 ;; marked, rather than the current line file.
3008 (dired-format-columns-of-files
3009 (if (eq (car files) t) (cdr files) files))
3010 (remove-text-properties (point-min) (point-max)
3011 '(mouse-face nil help-echo nil))))))))
3006 3012
3007(defun dired-format-columns-of-files (files) 3013(defun dired-format-columns-of-files (files)
3008 (let ((beg (point))) 3014 (let ((beg (point)))
@@ -3738,14 +3744,15 @@ Ask means pop up a menu for the user to select one of copy, move or link."
3738;;;;;; dired-run-shell-command dired-do-shell-command dired-do-async-shell-command 3744;;;;;; dired-run-shell-command dired-do-shell-command dired-do-async-shell-command
3739;;;;;; dired-clean-directory dired-do-print dired-do-touch dired-do-chown 3745;;;;;; dired-clean-directory dired-do-print dired-do-touch dired-do-chown
3740;;;;;; dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff 3746;;;;;; dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff
3741;;;;;; dired-diff) "dired-aux" "dired-aux.el" "9499f79f5853da0aa93d26465c7bf3a1") 3747;;;;;; dired-diff) "dired-aux" "dired-aux.el" "3c768e470d5d053d0049e0286ce38da7")
3742;;; Generated autoloads from dired-aux.el 3748;;; Generated autoloads from dired-aux.el
3743 3749
3744(autoload 'dired-diff "dired-aux" "\ 3750(autoload 'dired-diff "dired-aux" "\
3745Compare file at point with file FILE using `diff'. 3751Compare file at point with file FILE using `diff'.
3746FILE defaults to the file at the mark. (That's the mark set by 3752If called interactively, prompt for FILE; if the file at point
3747\\[set-mark-command], not by Dired's \\[dired-mark] command.) 3753has a backup file, use that as the default.
3748The prompted-for FILE is the first file given to `diff'. 3754
3755FILE is the first file given to `diff'.
3749With prefix arg, prompt for second argument SWITCHES, 3756With prefix arg, prompt for second argument SWITCHES,
3750which is the string of command switches for `diff'. 3757which is the string of command switches for `diff'.
3751 3758
diff --git a/lisp/ehelp.el b/lisp/ehelp.el
index abb897f73f6..281148d9cf6 100644
--- a/lisp/ehelp.el
+++ b/lisp/ehelp.el
@@ -193,7 +193,9 @@ BUFFER is put back into its original major mode."
193 (replace-buffer-in-windows buffer) 193 (replace-buffer-in-windows buffer)
194 ;; must do this outside of save-window-excursion 194 ;; must do this outside of save-window-excursion
195 (bury-buffer buffer)) 195 (bury-buffer buffer))
196 (eval electric-help-form-to-execute)))) 196 (if (functionp electric-help-form-to-execute)
197 (funcall electric-help-form-to-execute)
198 (eval electric-help-form-to-execute)))))
197 199
198(defun electric-help-command-loop () 200(defun electric-help-command-loop ()
199 (catch 'exit 201 (catch 'exit
@@ -349,14 +351,19 @@ will select it.)"
349;; continues with execute-extended-command. 351;; continues with execute-extended-command.
350(defun electric-help-execute-extended (_prefixarg) 352(defun electric-help-execute-extended (_prefixarg)
351 (interactive "p") 353 (interactive "p")
352 (setq electric-help-form-to-execute '(execute-extended-command nil)) 354 (setq electric-help-form-to-execute
355 (lambda () (execute-extended-command nil)))
353 (electric-help-retain)) 356 (electric-help-retain))
354 357
355;; This is to be buond to C-x in ehelp mode. Retains ehelp buffer and then 358;; This is to be buond to C-x in ehelp mode. Retains ehelp buffer and then
356;; continues with ctrl-x prefix. 359;; continues with ctrl-x prefix.
357(defun electric-help-ctrl-x-prefix (_prefixarg) 360(defun electric-help-ctrl-x-prefix (_prefixarg)
358 (interactive "p") 361 (interactive "p")
359 (setq electric-help-form-to-execute '(progn (message nil) (setq unread-command-char ?\C-x))) 362 (setq electric-help-form-to-execute
363 (lambda ()
364 (message nil)
365 (setq unread-command-events
366 (append unread-command-events '(?\C-x)))))
360 (electric-help-retain)) 367 (electric-help-retain))
361 368
362 369
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index cac76d2bce1..d96076d17a6 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -1,4 +1,4 @@
1;;; advice.el --- an overloading mechanism for Emacs Lisp functions 1;;; advice.el --- An overloading mechanism for Emacs Lisp functions
2 2
3;; Copyright (C) 1993-1994, 2000-2012 Free Software Foundation, Inc. 3;; Copyright (C) 1993-1994, 2000-2012 Free Software Foundation, Inc.
4 4
@@ -1746,7 +1746,8 @@
1746(provide 'advice-preload) 1746(provide 'advice-preload)
1747;; During a normal load this is a noop: 1747;; During a normal load this is a noop:
1748(require 'advice-preload "advice.el") 1748(require 'advice-preload "advice.el")
1749 1749(require 'macroexp)
1750(eval-when-compile (require 'cl-lib))
1750 1751
1751;; @@ Variable definitions: 1752;; @@ Variable definitions:
1752;; ======================== 1753;; ========================
@@ -1812,54 +1813,6 @@ generates a copy of TREE."
1812 (funcall fUnCtIoN tReE)) 1813 (funcall fUnCtIoN tReE))
1813 (t tReE))) 1814 (t tReE)))
1814 1815
1815;; this is just faster than `ad-substitute-tree':
1816(defun ad-copy-tree (tree)
1817 "Return a copy of the list structure of TREE."
1818 (cond ((consp tree)
1819 (cons (ad-copy-tree (car tree))
1820 (ad-copy-tree (cdr tree))))
1821 (t tree)))
1822
1823(defmacro ad-dolist (varform &rest body)
1824 "A Common-Lisp-style dolist iterator with the following syntax:
1825
1826 (ad-dolist (VAR INIT-FORM [RESULT-FORM])
1827 BODY-FORM...)
1828
1829which will iterate over the list yielded by INIT-FORM binding VAR to the
1830current head at every iteration. If RESULT-FORM is supplied its value will
1831be returned at the end of the iteration, nil otherwise. The iteration can be
1832exited prematurely with `(ad-do-return [VALUE])'."
1833 (let ((expansion
1834 `(let ((ad-dO-vAr ,(car (cdr varform)))
1835 ,(car varform))
1836 (while ad-dO-vAr
1837 (setq ,(car varform) (car ad-dO-vAr))
1838 ,@body
1839 ;;work around a backquote bug:
1840 ;;(` ((,@ '(foo)) (bar))) => (append '(foo) '(((bar)))) wrong
1841 ;;(` ((,@ '(foo)) (, '(bar)))) => (append '(foo) (list '(bar)))
1842 ,'(setq ad-dO-vAr (cdr ad-dO-vAr)))
1843 ,(car (cdr (cdr varform))))))
1844 ;;ok, this wastes some cons cells but only during compilation:
1845 (if (catch 'contains-return
1846 (ad-substitute-tree
1847 (function (lambda (subtree)
1848 (cond ((eq (car-safe subtree) 'ad-dolist))
1849 ((eq (car-safe subtree) 'ad-do-return)
1850 (throw 'contains-return t)))))
1851 'identity body)
1852 nil)
1853 `(catch 'ad-dO-eXiT ,expansion)
1854 expansion)))
1855
1856(defmacro ad-do-return (value)
1857 `(throw 'ad-dO-eXiT ,value))
1858
1859(if (not (get 'ad-dolist 'lisp-indent-hook))
1860 (put 'ad-dolist 'lisp-indent-hook 1))
1861
1862
1863;; @@ Save real definitions of subrs used by Advice: 1816;; @@ Save real definitions of subrs used by Advice:
1864;; ================================================= 1817;; =================================================
1865;; Advice depends on the real, unmodified functionality of various subrs, 1818;; Advice depends on the real, unmodified functionality of various subrs,
@@ -1924,16 +1877,16 @@ exited prematurely with `(ad-do-return [VALUE])'."
1924 ad-advised-functions))) 1877 ad-advised-functions)))
1925 1878
1926(defmacro ad-do-advised-functions (varform &rest body) 1879(defmacro ad-do-advised-functions (varform &rest body)
1927 "`ad-dolist'-style iterator that maps over `ad-advised-functions'. 1880 "`dolist'-style iterator that maps over `ad-advised-functions'.
1928\(ad-do-advised-functions (VAR [RESULT-FORM]) 1881\(ad-do-advised-functions (VAR [RESULT-FORM])
1929 BODY-FORM...) 1882 BODY-FORM...)
1930On each iteration VAR will be bound to the name of an advised function 1883On each iteration VAR will be bound to the name of an advised function
1931\(a symbol)." 1884\(a symbol)."
1932 `(ad-dolist (,(car varform) 1885 `(cl-dolist (,(car varform)
1933 ad-advised-functions 1886 ad-advised-functions
1934 ,(car (cdr varform))) 1887 ,(car (cdr varform)))
1935 (setq ,(car varform) (intern (car ,(car varform)))) 1888 (setq ,(car varform) (intern (car ,(car varform))))
1936 ,@body)) 1889 ,@body))
1937 1890
1938(if (not (get 'ad-do-advised-functions 'lisp-indent-hook)) 1891(if (not (get 'ad-do-advised-functions 'lisp-indent-hook))
1939 (put 'ad-do-advised-functions 'lisp-indent-hook 1)) 1892 (put 'ad-do-advised-functions 'lisp-indent-hook 1))
@@ -1948,7 +1901,7 @@ On each iteration VAR will be bound to the name of an advised function
1948 `(put ,function 'ad-advice-info ,advice-info)) 1901 `(put ,function 'ad-advice-info ,advice-info))
1949 1902
1950(defmacro ad-copy-advice-info (function) 1903(defmacro ad-copy-advice-info (function)
1951 `(ad-copy-tree (get ,function 'ad-advice-info))) 1904 `(copy-tree (get ,function 'ad-advice-info)))
1952 1905
1953(defmacro ad-is-advised (function) 1906(defmacro ad-is-advised (function)
1954 "Return non-nil if FUNCTION has any advice info associated with it. 1907 "Return non-nil if FUNCTION has any advice info associated with it.
@@ -2022,8 +1975,8 @@ either t or nil, and DEFINITION should be a list of the form
2022 1975
2023(defun ad-has-enabled-advice (function class) 1976(defun ad-has-enabled-advice (function class)
2024 "True if at least one of FUNCTION's advices in CLASS is enabled." 1977 "True if at least one of FUNCTION's advices in CLASS is enabled."
2025 (ad-dolist (advice (ad-get-advice-info-field function class)) 1978 (cl-dolist (advice (ad-get-advice-info-field function class))
2026 (if (ad-advice-enabled advice) (ad-do-return t)))) 1979 (if (ad-advice-enabled advice) (cl-return t))))
2027 1980
2028(defun ad-has-redefining-advice (function) 1981(defun ad-has-redefining-advice (function)
2029 "True if FUNCTION's advice info defines at least 1 redefining advice. 1982 "True if FUNCTION's advice info defines at least 1 redefining advice.
@@ -2036,14 +1989,14 @@ Redefining advices affect the construction of an advised definition."
2036(defun ad-has-any-advice (function) 1989(defun ad-has-any-advice (function)
2037 "True if the advice info of FUNCTION defines at least one advice." 1990 "True if the advice info of FUNCTION defines at least one advice."
2038 (and (ad-is-advised function) 1991 (and (ad-is-advised function)
2039 (ad-dolist (class ad-advice-classes nil) 1992 (cl-dolist (class ad-advice-classes nil)
2040 (if (ad-get-advice-info-field function class) 1993 (if (ad-get-advice-info-field function class)
2041 (ad-do-return t))))) 1994 (cl-return t)))))
2042 1995
2043(defun ad-get-enabled-advices (function class) 1996(defun ad-get-enabled-advices (function class)
2044 "Return the list of enabled advices of FUNCTION in CLASS." 1997 "Return the list of enabled advices of FUNCTION in CLASS."
2045 (let (enabled-advices) 1998 (let (enabled-advices)
2046 (ad-dolist (advice (ad-get-advice-info-field function class)) 1999 (dolist (advice (ad-get-advice-info-field function class))
2047 (if (ad-advice-enabled advice) 2000 (if (ad-advice-enabled advice)
2048 (push advice enabled-advices))) 2001 (push advice enabled-advices)))
2049 (reverse enabled-advices))) 2002 (reverse enabled-advices)))
@@ -2151,7 +2104,7 @@ function at point for which PREDICATE returns non-nil)."
2151 (ad-do-advised-functions (function) 2104 (ad-do-advised-functions (function)
2152 (if (or (null predicate) 2105 (if (or (null predicate)
2153 (funcall predicate function)) 2106 (funcall predicate function))
2154 (ad-do-return function))) 2107 (cl-return function)))
2155 (error "ad-read-advised-function: %s" 2108 (error "ad-read-advised-function: %s"
2156 "There are no qualifying advised functions"))) 2109 "There are no qualifying advised functions")))
2157 (let* ((ad-pReDiCaTe predicate) 2110 (let* ((ad-pReDiCaTe predicate)
@@ -2184,9 +2137,9 @@ be returned on empty input (defaults to the first non-empty advice
2184class of FUNCTION)." 2137class of FUNCTION)."
2185 (setq default 2138 (setq default
2186 (or default 2139 (or default
2187 (ad-dolist (class ad-advice-classes) 2140 (cl-dolist (class ad-advice-classes)
2188 (if (ad-get-advice-info-field function class) 2141 (if (ad-get-advice-info-field function class)
2189 (ad-do-return class))) 2142 (cl-return class)))
2190 (error "ad-read-advice-class: `%s' has no advices" function))) 2143 (error "ad-read-advice-class: `%s' has no advices" function)))
2191 (let ((class (completing-read 2144 (let ((class (completing-read
2192 (format "%s (default %s): " (or prompt "Class") default) 2145 (format "%s (default %s): " (or prompt "Class") default)
@@ -2255,18 +2208,18 @@ NAME can be a symbol or a regular expression matching part of an advice name.
2255If CLASS is `any' all valid advice classes will be checked." 2208If CLASS is `any' all valid advice classes will be checked."
2256 (if (ad-is-advised function) 2209 (if (ad-is-advised function)
2257 (let (found-advice) 2210 (let (found-advice)
2258 (ad-dolist (advice-class ad-advice-classes) 2211 (cl-dolist (advice-class ad-advice-classes)
2259 (if (or (eq class 'any) (eq advice-class class)) 2212 (if (or (eq class 'any) (eq advice-class class))
2260 (setq found-advice 2213 (setq found-advice
2261 (ad-dolist (advice (ad-get-advice-info-field 2214 (cl-dolist (advice (ad-get-advice-info-field
2262 function advice-class)) 2215 function advice-class))
2263 (if (or (and (stringp name) 2216 (if (or (and (stringp name)
2264 (string-match 2217 (string-match
2265 name (symbol-name 2218 name (symbol-name
2266 (ad-advice-name advice)))) 2219 (ad-advice-name advice))))
2267 (eq name (ad-advice-name advice))) 2220 (eq name (ad-advice-name advice)))
2268 (ad-do-return advice))))) 2221 (cl-return advice)))))
2269 (if found-advice (ad-do-return found-advice)))))) 2222 (if found-advice (cl-return found-advice))))))
2270 2223
2271(defun ad-enable-advice-internal (function class name flag) 2224(defun ad-enable-advice-internal (function class name flag)
2272 "Set enable FLAG of FUNCTION's advices in CLASS matching NAME. 2225 "Set enable FLAG of FUNCTION's advices in CLASS matching NAME.
@@ -2277,10 +2230,10 @@ considered. The number of changed advices will be returned (or nil if
2277FUNCTION was not advised)." 2230FUNCTION was not advised)."
2278 (if (ad-is-advised function) 2231 (if (ad-is-advised function)
2279 (let ((matched-advices 0)) 2232 (let ((matched-advices 0))
2280 (ad-dolist (advice-class ad-advice-classes) 2233 (dolist (advice-class ad-advice-classes)
2281 (if (or (eq class 'any) (eq advice-class class)) 2234 (if (or (eq class 'any) (eq advice-class class))
2282 (ad-dolist (advice (ad-get-advice-info-field 2235 (dolist (advice (ad-get-advice-info-field
2283 function advice-class)) 2236 function advice-class))
2284 (cond ((or (and (stringp name) 2237 (cond ((or (and (stringp name)
2285 (string-match 2238 (string-match
2286 name (symbol-name (ad-advice-name advice)))) 2239 name (symbol-name (ad-advice-name advice))))
@@ -2586,11 +2539,6 @@ For that it has to be fbound with a non-autoload definition."
2586 (byte-compile symbol) 2539 (byte-compile symbol)
2587 (fset function (symbol-function symbol)))))) 2540 (fset function (symbol-function symbol))))))
2588 2541
2589(defun ad-prognify (forms)
2590 (cond ((<= (length forms) 1)
2591 (car forms))
2592 (t (cons 'progn forms))))
2593
2594;; @@@ Accessing argument lists: 2542;; @@@ Accessing argument lists:
2595;; ============================= 2543;; =============================
2596 2544
@@ -2868,8 +2816,8 @@ in any of these classes."
2868 (if origdoc (setq paragraphs (list origdoc))) 2816 (if origdoc (setq paragraphs (list origdoc)))
2869 (unless (eq style 'plain) 2817 (unless (eq style 'plain)
2870 (push (concat "This " origtype " is advised.") paragraphs)) 2818 (push (concat "This " origtype " is advised.") paragraphs))
2871 (ad-dolist (class ad-advice-classes) 2819 (dolist (class ad-advice-classes)
2872 (ad-dolist (advice (ad-get-enabled-advices function class)) 2820 (dolist (advice (ad-get-enabled-advices function class))
2873 (setq advice-docstring 2821 (setq advice-docstring
2874 (ad-make-single-advice-docstring advice class style)) 2822 (ad-make-single-advice-docstring advice class style))
2875 (if advice-docstring 2823 (if advice-docstring
@@ -2891,24 +2839,24 @@ in any of these classes."
2891 2839
2892(defun ad-advised-arglist (function) 2840(defun ad-advised-arglist (function)
2893 "Find first defined arglist in FUNCTION's redefining advices." 2841 "Find first defined arglist in FUNCTION's redefining advices."
2894 (ad-dolist (advice (append (ad-get-enabled-advices function 'before) 2842 (cl-dolist (advice (append (ad-get-enabled-advices function 'before)
2895 (ad-get-enabled-advices function 'around) 2843 (ad-get-enabled-advices function 'around)
2896 (ad-get-enabled-advices function 'after))) 2844 (ad-get-enabled-advices function 'after)))
2897 (let ((arglist (ad-arglist (ad-advice-definition advice)))) 2845 (let ((arglist (ad-arglist (ad-advice-definition advice))))
2898 (if arglist 2846 (if arglist
2899 ;; We found the first one, use it: 2847 ;; We found the first one, use it:
2900 (ad-do-return arglist))))) 2848 (cl-return arglist)))))
2901 2849
2902(defun ad-advised-interactive-form (function) 2850(defun ad-advised-interactive-form (function)
2903 "Find first interactive form in FUNCTION's redefining advices." 2851 "Find first interactive form in FUNCTION's redefining advices."
2904 (ad-dolist (advice (append (ad-get-enabled-advices function 'before) 2852 (cl-dolist (advice (append (ad-get-enabled-advices function 'before)
2905 (ad-get-enabled-advices function 'around) 2853 (ad-get-enabled-advices function 'around)
2906 (ad-get-enabled-advices function 'after))) 2854 (ad-get-enabled-advices function 'after)))
2907 (let ((interactive-form 2855 (let ((interactive-form
2908 (ad-interactive-form (ad-advice-definition advice)))) 2856 (ad-interactive-form (ad-advice-definition advice))))
2909 (if interactive-form 2857 (if interactive-form
2910 ;; We found the first one, use it: 2858 ;; We found the first one, use it:
2911 (ad-do-return interactive-form))))) 2859 (cl-return interactive-form)))))
2912 2860
2913;; @@@ Putting it all together: 2861;; @@@ Putting it all together:
2914;; ============================ 2862;; ============================
@@ -2997,47 +2945,47 @@ and BEFORES, AROUNDS and AFTERS are the lists of advices with which ORIG
2997should be modified. The assembled function will be returned." 2945should be modified. The assembled function will be returned."
2998 2946
2999 (let (before-forms around-form around-form-protected after-forms definition) 2947 (let (before-forms around-form around-form-protected after-forms definition)
3000 (ad-dolist (advice befores) 2948 (dolist (advice befores)
3001 (cond ((and (ad-advice-protected advice) 2949 (cond ((and (ad-advice-protected advice)
3002 before-forms) 2950 before-forms)
3003 (setq before-forms 2951 (setq before-forms
3004 `((unwind-protect 2952 `((unwind-protect
3005 ,(ad-prognify before-forms) 2953 ,(macroexp-progn before-forms)
3006 ,@(ad-body-forms 2954 ,@(ad-body-forms
3007 (ad-advice-definition advice)))))) 2955 (ad-advice-definition advice))))))
3008 (t (setq before-forms 2956 (t (setq before-forms
3009 (append before-forms 2957 (append before-forms
3010 (ad-body-forms (ad-advice-definition advice))))))) 2958 (ad-body-forms (ad-advice-definition advice)))))))
3011 2959
3012 (setq around-form `(setq ad-return-value ,orig)) 2960 (setq around-form `(setq ad-return-value ,orig))
3013 (ad-dolist (advice (reverse arounds)) 2961 (dolist (advice (reverse arounds))
3014 ;; If any of the around advices is protected then we 2962 ;; If any of the around advices is protected then we
3015 ;; protect the complete around advice onion: 2963 ;; protect the complete around advice onion:
3016 (if (ad-advice-protected advice) 2964 (if (ad-advice-protected advice)
3017 (setq around-form-protected t)) 2965 (setq around-form-protected t))
3018 (setq around-form 2966 (setq around-form
3019 (ad-substitute-tree 2967 (ad-substitute-tree
3020 (function (lambda (form) (eq form 'ad-do-it))) 2968 (function (lambda (form) (eq form 'ad-do-it)))
3021 (function (lambda (form) around-form)) 2969 (function (lambda (form) around-form))
3022 (ad-prognify (ad-body-forms (ad-advice-definition advice)))))) 2970 (macroexp-progn (ad-body-forms (ad-advice-definition advice))))))
3023 2971
3024 (setq after-forms 2972 (setq after-forms
3025 (if (and around-form-protected before-forms) 2973 (if (and around-form-protected before-forms)
3026 `((unwind-protect 2974 `((unwind-protect
3027 ,(ad-prognify before-forms) 2975 ,(macroexp-progn before-forms)
3028 ,around-form)) 2976 ,around-form))
3029 (append before-forms (list around-form)))) 2977 (append before-forms (list around-form))))
3030 (ad-dolist (advice afters) 2978 (dolist (advice afters)
3031 (cond ((and (ad-advice-protected advice) 2979 (cond ((and (ad-advice-protected advice)
3032 after-forms) 2980 after-forms)
3033 (setq after-forms 2981 (setq after-forms
3034 `((unwind-protect 2982 `((unwind-protect
3035 ,(ad-prognify after-forms) 2983 ,(macroexp-progn after-forms)
3036 ,@(ad-body-forms 2984 ,@(ad-body-forms
3037 (ad-advice-definition advice)))))) 2985 (ad-advice-definition advice))))))
3038 (t (setq after-forms 2986 (t (setq after-forms
3039 (append after-forms 2987 (append after-forms
3040 (ad-body-forms (ad-advice-definition advice))))))) 2988 (ad-body-forms (ad-advice-definition advice)))))))
3041 2989
3042 (setq definition 2990 (setq definition
3043 `(,@(if (memq type '(macro special-form)) '(macro)) 2991 `(,@(if (memq type '(macro special-form)) '(macro))
@@ -3061,7 +3009,7 @@ should be modified. The assembled function will be returned."
3061 (ad-body-forms (ad-advice-definition advice)))) 3009 (ad-body-forms (ad-advice-definition advice))))
3062 (ad-get-enabled-advices function hook-name)))) 3010 (ad-get-enabled-advices function hook-name))))
3063 (if hook-forms 3011 (if hook-forms
3064 (ad-prognify (apply 'append hook-forms))))) 3012 (macroexp-progn (apply 'append hook-forms)))))
3065 3013
3066 3014
3067;; @@ Caching: 3015;; @@ Caching:
@@ -3171,11 +3119,11 @@ advised definition from scratch."
3171 (nth 2 cache-id))))) 3119 (nth 2 cache-id)))))
3172 3120
3173(defun ad-verify-cache-class-id (cache-class-id advices) 3121(defun ad-verify-cache-class-id (cache-class-id advices)
3174 (ad-dolist (advice advices (null cache-class-id)) 3122 (cl-dolist (advice advices (null cache-class-id))
3175 (if (ad-advice-enabled advice) 3123 (if (ad-advice-enabled advice)
3176 (if (eq (car cache-class-id) (ad-advice-name advice)) 3124 (if (eq (car cache-class-id) (ad-advice-name advice))
3177 (setq cache-class-id (cdr cache-class-id)) 3125 (setq cache-class-id (cdr cache-class-id))
3178 (ad-do-return nil))))) 3126 (cl-return nil)))))
3179 3127
3180;; There should be a way to monitor if and why a cache verification failed 3128;; There should be a way to monitor if and why a cache verification failed
3181;; in order to determine whether a certain preactivation could be used or 3129;; in order to determine whether a certain preactivation could be used or
@@ -3670,7 +3618,16 @@ See Info node `(elisp)Advising Functions' for comprehensive documentation.
3670usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) 3618usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
3671 [DOCSTRING] [INTERACTIVE-FORM] 3619 [DOCSTRING] [INTERACTIVE-FORM]
3672 BODY...)" 3620 BODY...)"
3673 (declare (doc-string 3)) 3621 (declare (doc-string 3)
3622 (debug (&define name ;; thing being advised.
3623 (name ;; class is [&or "before" "around" "after"
3624 ;; "activation" "deactivation"]
3625 name ;; name of advice
3626 &rest sexp ;; optional position and flags
3627 )
3628 [&optional stringp]
3629 [&optional ("interactive" interactive)]
3630 def-body)))
3674 (if (not (ad-name-p function)) 3631 (if (not (ad-name-p function))
3675 (error "defadvice: Invalid function name: %s" function)) 3632 (error "defadvice: Invalid function name: %s" function))
3676 (let* ((class (car args)) 3633 (let* ((class (car args))
diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el
index 646be3e1b71..9029c81f279 100644
--- a/lisp/emacs-lisp/benchmark.el
+++ b/lisp/emacs-lisp/benchmark.el
@@ -53,6 +53,7 @@ FORMS once.
53Return a list of the total elapsed time for execution, the number of 53Return a list of the total elapsed time for execution, the number of
54garbage collections that ran, and the time taken by garbage collection. 54garbage collections that ran, and the time taken by garbage collection.
55See also `benchmark-run-compiled'." 55See also `benchmark-run-compiled'."
56 (declare (indent 1) (debug t))
56 (unless (natnump repetitions) 57 (unless (natnump repetitions)
57 (setq forms (cons repetitions forms) 58 (setq forms (cons repetitions forms)
58 repetitions 1)) 59 repetitions 1))
@@ -69,8 +70,6 @@ See also `benchmark-run-compiled'."
69 `(benchmark-elapse ,@forms)) 70 `(benchmark-elapse ,@forms))
70 (- gcs-done ,gcs) 71 (- gcs-done ,gcs)
71 (- gc-elapsed ,gc))))) 72 (- gc-elapsed ,gc)))))
72(put 'benchmark-run 'edebug-form-spec t)
73(put 'benchmark-run 'lisp-indent-function 2)
74 73
75;;;###autoload 74;;;###autoload
76(defmacro benchmark-run-compiled (&optional repetitions &rest forms) 75(defmacro benchmark-run-compiled (&optional repetitions &rest forms)
@@ -78,6 +77,7 @@ See also `benchmark-run-compiled'."
78This is like `benchmark-run', but what is timed is a funcall of the 77This is like `benchmark-run', but what is timed is a funcall of the
79byte code obtained by wrapping FORMS in a `lambda' and compiling the 78byte code obtained by wrapping FORMS in a `lambda' and compiling the
80result. The overhead of the `lambda's is accounted for." 79result. The overhead of the `lambda's is accounted for."
80 (declare (indent 1) (debug t))
81 (unless (natnump repetitions) 81 (unless (natnump repetitions)
82 (setq forms (cons repetitions forms) 82 (setq forms (cons repetitions forms)
83 repetitions 1)) 83 repetitions 1))
@@ -96,8 +96,6 @@ result. The overhead of the `lambda's is accounted for."
96 (funcall ,lambda-code)))) 96 (funcall ,lambda-code))))
97 `(benchmark-elapse (funcall ,code))) 97 `(benchmark-elapse (funcall ,code)))
98 (- gcs-done ,gcs) (- gc-elapsed ,gc))))) 98 (- gcs-done ,gcs) (- gc-elapsed ,gc)))))
99(put 'benchmark-run-compiled 'edebug-form-spec t)
100(put 'benchmark-run-compiled 'lisp-indent-function 2)
101 99
102;;;###autoload 100;;;###autoload
103(defun benchmark (repetitions form) 101(defun benchmark (repetitions form)
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 9b66c8ffd60..93e890a20c9 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -185,11 +185,10 @@ The return value is undefined.
185 ((and (featurep 'cl) 185 ((and (featurep 'cl)
186 (memq (car x) ;C.f. cl-do-proclaim. 186 (memq (car x) ;C.f. cl-do-proclaim.
187 '(special inline notinline optimize warn))) 187 '(special inline notinline optimize warn)))
188 (if (null (stringp docstring)) 188 (push (list 'declare x)
189 (push (list 'declare x) body) 189 (if (stringp docstring) (cdr body) body))
190 (setcdr body (cons (list 'declare x) (cdr body))))
191 nil) 190 nil)
192 (t (message "Warning: Unknown defun property %S in %S" 191 (t (message "Warning: Unknown defun property `%S' in %S"
193 (car x) name))))) 192 (car x) name)))))
194 decls)) 193 decls))
195 (def (list 'defalias 194 (def (list 'defalias
@@ -313,7 +312,7 @@ This uses `defvaralias' and `make-obsolete-variable' (which see).
313See the Info node `(elisp)Variable Aliases' for more details. 312See the Info node `(elisp)Variable Aliases' for more details.
314 313
315If CURRENT-NAME is a defcustom (more generally, any variable 314If CURRENT-NAME is a defcustom (more generally, any variable
316where OBSOLETE-NAME may be set, e.g. in a .emacs file, before the 315where OBSOLETE-NAME may be set, e.g. in an init file, before the
317alias is defined), then the define-obsolete-variable-alias 316alias is defined), then the define-obsolete-variable-alias
318statement should be evaluated before the defcustom, if user 317statement should be evaluated before the defcustom, if user
319customizations are to be respected. The simplest way to achieve 318customizations are to be respected. The simplest way to achieve
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 10bc37c6dcd..c42ae21aae5 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1016,6 +1016,10 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
1016 ((bufferp byte-compile-current-file) 1016 ((bufferp byte-compile-current-file)
1017 (format "Buffer %s:" 1017 (format "Buffer %s:"
1018 (buffer-name byte-compile-current-file))) 1018 (buffer-name byte-compile-current-file)))
1019 ;; We might be simply loading a file that
1020 ;; contains explicit calls to byte-compile functions.
1021 ((stringp load-file-name)
1022 (format "%s:" (file-relative-name load-file-name dir)))
1019 (t ""))) 1023 (t "")))
1020 (pos (if (and byte-compile-current-file 1024 (pos (if (and byte-compile-current-file
1021 (integerp byte-compile-read-position)) 1025 (integerp byte-compile-read-position))
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 532c81c502c..5749ff91b40 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -121,7 +121,7 @@ a future Emacs interpreter will be able to use it.")
121 121
122;;; Generalized variables. 122;;; Generalized variables.
123;; These macros are defined here so that they 123;; These macros are defined here so that they
124;; can safely be used in .emacs files. 124;; can safely be used in init files.
125 125
126(defmacro cl-incf (place &optional x) 126(defmacro cl-incf (place &optional x)
127 "Increment PLACE by X (1 by default). 127 "Increment PLACE by X (1 by default).
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el
index 470ca17d3a0..c12e8ccacb1 100644
--- a/lisp/emacs-lisp/cl-loaddefs.el
+++ b/lisp/emacs-lisp/cl-loaddefs.el
@@ -249,8 +249,7 @@ Remove from SYMBOL's plist the property PROPNAME and its value.
249 249
250;;;*** 250;;;***
251 251
252;;;### (autoloads (cl--compiler-macro-cXXr cl--compiler-macro-list* 252;;;### (autoloads (cl--compiler-macro-adjoin cl-defsubst cl-compiler-macroexpand
253;;;;;; cl--compiler-macro-adjoin cl-defsubst cl-compiler-macroexpand
254;;;;;; cl-define-compiler-macro cl-assert cl-check-type cl-typep 253;;;;;; cl-define-compiler-macro cl-assert cl-check-type cl-typep
255;;;;;; cl-deftype cl-defstruct cl-callf2 cl-callf cl-letf* cl-letf 254;;;;;; cl-deftype cl-defstruct cl-callf2 cl-callf cl-letf* cl-letf
256;;;;;; cl-rotatef cl-shiftf cl-remf cl-psetf cl-declare cl-the cl-locally 255;;;;;; cl-rotatef cl-shiftf cl-remf cl-psetf cl-declare cl-the cl-locally
@@ -260,9 +259,20 @@ Remove from SYMBOL's plist the property PROPNAME and its value.
260;;;;;; cl-do cl-loop cl-return-from cl-return cl-block cl-etypecase 259;;;;;; cl-do cl-loop cl-return-from cl-return cl-block cl-etypecase
261;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when 260;;;;;; cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when
262;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp 261;;;;;; cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp
263;;;;;; cl-gensym) "cl-macs" "cl-macs.el" "9676d5517e8b9246c09fe78984c68bef") 262;;;;;; cl-gensym cl--compiler-macro-cXXr cl--compiler-macro-list*)
263;;;;;; "cl-macs" "cl-macs.el" "6d0676869af66e5b5a671f95ee069461")
264;;; Generated autoloads from cl-macs.el 264;;; Generated autoloads from cl-macs.el
265 265
266(autoload 'cl--compiler-macro-list* "cl-macs" "\
267
268
269\(fn FORM ARG &rest OTHERS)" nil nil)
270
271(autoload 'cl--compiler-macro-cXXr "cl-macs" "\
272
273
274\(fn FORM X)" nil nil)
275
266(autoload 'cl-gensym "cl-macs" "\ 276(autoload 'cl-gensym "cl-macs" "\
267Generate a new uninterned symbol. 277Generate a new uninterned symbol.
268The name is made by appending a number to PREFIX, default \"G\". 278The name is made by appending a number to PREFIX, default \"G\".
@@ -659,6 +669,8 @@ value, that slot cannot be set via `setf'.
659 669
660(put 'cl-defstruct 'doc-string-elt '2) 670(put 'cl-defstruct 'doc-string-elt '2)
661 671
672(put 'cl-defstruct 'lisp-indent-function '1)
673
662(autoload 'cl-deftype "cl-macs" "\ 674(autoload 'cl-deftype "cl-macs" "\
663Define NAME as a new data type. 675Define NAME as a new data type.
664The type name can then be used in `cl-typecase', `cl-check-type', etc. 676The type name can then be used in `cl-typecase', `cl-check-type', etc.
@@ -722,16 +734,6 @@ surrounded by (cl-block NAME ...).
722 734
723\(fn FORM A LIST &rest KEYS)" nil nil) 735\(fn FORM A LIST &rest KEYS)" nil nil)
724 736
725(autoload 'cl--compiler-macro-list* "cl-macs" "\
726
727
728\(fn FORM ARG &rest OTHERS)" nil nil)
729
730(autoload 'cl--compiler-macro-cXXr "cl-macs" "\
731
732
733\(fn FORM X)" nil nil)
734
735;;;*** 737;;;***
736 738
737;;;### (autoloads (cl-tree-equal cl-nsublis cl-sublis cl-nsubst-if-not 739;;;### (autoloads (cl-tree-equal cl-nsublis cl-sublis cl-nsubst-if-not
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 9a59aa0c6db..16ac14f8fe9 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -58,6 +58,33 @@
58 58
59;;; Initialization. 59;;; Initialization.
60 60
61;; Place compiler macros at the beginning, otherwise uses of the corresponding
62;; functions can lead to recursive-loads that prevent the calls from
63;; being optimized.
64
65;;;###autoload
66(defun cl--compiler-macro-list* (_form arg &rest others)
67 (let* ((args (reverse (cons arg others)))
68 (form (car args)))
69 (while (setq args (cdr args))
70 (setq form `(cons ,(car args) ,form)))
71 form))
72
73;;;###autoload
74(defun cl--compiler-macro-cXXr (form x)
75 (let* ((head (car form))
76 (n (symbol-name (car form)))
77 (i (- (length n) 2)))
78 (if (not (string-match "c[ad]+r\\'" n))
79 (if (and (fboundp head) (symbolp (symbol-function head)))
80 (cl--compiler-macro-cXXr (cons (symbol-function head) (cdr form))
81 x)
82 (error "Compiler macro for cXXr applied to non-cXXr form"))
83 (while (> i (match-beginning 0))
84 (setq x (list (if (eq (aref n i) ?a) 'car 'cdr) x))
85 (setq i (1- i)))
86 x)))
87
61;;; Some predicates for analyzing Lisp forms. 88;;; Some predicates for analyzing Lisp forms.
62;; These are used by various 89;; These are used by various
63;; macro expanders to optimize the results in certain common cases. 90;; macro expanders to optimize the results in certain common cases.
@@ -366,9 +393,14 @@ its argument list allows full Common Lisp conventions."
366 (mapcar (lambda (x) 393 (mapcar (lambda (x)
367 (cond 394 (cond
368 ((symbolp x) 395 ((symbolp x)
369 (if (eq ?\& (aref (symbol-name x) 0)) 396 (let ((first (aref (symbol-name x) 0)))
370 (setq state x) 397 (if (eq ?\& first)
371 (make-symbol (upcase (symbol-name x))))) 398 (setq state x)
399 ;; Strip a leading underscore, since it only
400 ;; means that this argument is unused.
401 (make-symbol (upcase (if (eq ?_ first)
402 (substring (symbol-name x) 1)
403 (symbol-name x)))))))
372 ((not (consp x)) x) 404 ((not (consp x)) x)
373 ((memq state '(nil &rest)) (cl--make-usage-args x)) 405 ((memq state '(nil &rest)) (cl--make-usage-args x))
374 (t ;(VAR INITFORM SVAR) or ((KEYWORD VAR) INITFORM SVAR). 406 (t ;(VAR INITFORM SVAR) or ((KEYWORD VAR) INITFORM SVAR).
@@ -452,7 +484,13 @@ its argument list allows full Common Lisp conventions."
452 (let ((arg (pop args))) 484 (let ((arg (pop args)))
453 (or (consp arg) (setq arg (list arg))) 485 (or (consp arg) (setq arg (list arg)))
454 (let* ((karg (if (consp (car arg)) (caar arg) 486 (let* ((karg (if (consp (car arg)) (caar arg)
455 (intern (format ":%s" (car arg))))) 487 (let ((name (symbol-name (car arg))))
488 ;; Strip a leading underscore, since it only
489 ;; means that this argument is unused, but
490 ;; shouldn't affect the key's name (bug#12367).
491 (if (eq ?_ (aref name 0))
492 (setq name (substring name 1)))
493 (intern (format ":%s" name)))))
456 (varg (if (consp (car arg)) (cl-cadar arg) (car arg))) 494 (varg (if (consp (car arg)) (cl-cadar arg) (car arg)))
457 (def (if (cdr arg) (cadr arg) 495 (def (if (cdr arg) (cadr arg)
458 (or (car cl--bind-defs) (cadr (assq varg cl--bind-defs))))) 496 (or (car cl--bind-defs) (cadr (assq varg cl--bind-defs)))))
@@ -1425,8 +1463,15 @@ Valid clauses are:
1425 cl--loop-accum-var)))) 1463 cl--loop-accum-var))))
1426 1464
1427(defun cl--loop-build-ands (clauses) 1465(defun cl--loop-build-ands (clauses)
1466 "Return various representations of (and . CLAUSES).
1467CLAUSES is a list of Elisp expressions, where clauses of the form
1468\(progn E1 E2 E3 .. t) are the focus of particular optimizations.
1469The return value has shape (COND BODY COMBO)
1470such that COMBO is equivalent to (and . CLAUSES)."
1428 (let ((ands nil) 1471 (let ((ands nil)
1429 (body nil)) 1472 (body nil))
1473 ;; Look through `clauses', trying to optimize (progn ,@A t) (progn ,@B) ,@C
1474 ;; into (progn ,@A ,@B) ,@C.
1430 (while clauses 1475 (while clauses
1431 (if (and (eq (car-safe (car clauses)) 'progn) 1476 (if (and (eq (car-safe (car clauses)) 'progn)
1432 (eq (car (last (car clauses))) t)) 1477 (eq (car (last (car clauses))) t))
@@ -1437,6 +1482,7 @@ Valid clauses are:
1437 (cl-cdadr clauses) 1482 (cl-cdadr clauses)
1438 (list (cadr clauses)))) 1483 (list (cadr clauses))))
1439 (cddr clauses))) 1484 (cddr clauses)))
1485 ;; A final (progn ,@A t) is moved outside of the `and'.
1440 (setq body (cdr (butlast (pop clauses))))) 1486 (setq body (cdr (butlast (pop clauses)))))
1441 (push (pop clauses) ands))) 1487 (push (pop clauses) ands)))
1442 (setq ands (or (nreverse ands) (list t))) 1488 (setq ands (or (nreverse ands) (list t)))
@@ -1905,8 +1951,6 @@ See Info node `(cl)Declarations' for details."
1905 (cl-do-proclaim (pop specs) nil))) 1951 (cl-do-proclaim (pop specs) nil)))
1906 nil) 1952 nil)
1907 1953
1908
1909
1910;;; The standard modify macros. 1954;;; The standard modify macros.
1911 1955
1912;; `setf' is now part of core Elisp, defined in gv.el. 1956;; `setf' is now part of core Elisp, defined in gv.el.
@@ -1929,7 +1973,7 @@ before assigning any PLACEs to the corresponding values.
1929 (or p (error "Odd number of arguments to cl-psetf")) 1973 (or p (error "Odd number of arguments to cl-psetf"))
1930 (pop p)) 1974 (pop p))
1931 (if simple 1975 (if simple
1932 `(progn (setf ,@args) nil) 1976 `(progn (setq ,@args) nil)
1933 (setq args (reverse args)) 1977 (setq args (reverse args))
1934 (let ((expr `(setf ,(cadr args) ,(car args)))) 1978 (let ((expr `(setf ,(cadr args) ,(car args))))
1935 (while (setq args (cddr args)) 1979 (while (setq args (cddr args))
@@ -2119,7 +2163,7 @@ one keyword is supported, `:read-only'. If this has a non-nil
2119value, that slot cannot be set via `setf'. 2163value, that slot cannot be set via `setf'.
2120 2164
2121\(fn NAME SLOTS...)" 2165\(fn NAME SLOTS...)"
2122 (declare (doc-string 2) 2166 (declare (doc-string 2) (indent 1)
2123 (debug 2167 (debug
2124 (&define ;Makes top-level form not be wrapped. 2168 (&define ;Makes top-level form not be wrapped.
2125 [&or symbolp 2169 [&or symbolp
@@ -2597,14 +2641,6 @@ surrounded by (cl-block NAME ...).
2597 `(if (cl-member ,a ,list ,@keys) ,list (cons ,a ,list)) 2641 `(if (cl-member ,a ,list ,@keys) ,list (cons ,a ,list))
2598 form)) 2642 form))
2599 2643
2600;;;###autoload
2601(defun cl--compiler-macro-list* (_form arg &rest others)
2602 (let* ((args (reverse (cons arg others)))
2603 (form (car args)))
2604 (while (setq args (cdr args))
2605 (setq form `(cons ,(car args) ,form)))
2606 form))
2607
2608(defun cl--compiler-macro-get (_form sym prop &optional def) 2644(defun cl--compiler-macro-get (_form sym prop &optional def)
2609 (if def 2645 (if def
2610 `(cl-getf (symbol-plist ,sym) ,prop ,def) 2646 `(cl-getf (symbol-plist ,sym) ,prop ,def)
@@ -2616,21 +2652,6 @@ surrounded by (cl-block NAME ...).
2616 (cl--make-type-test temp (cl--const-expr-val type))) 2652 (cl--make-type-test temp (cl--const-expr-val type)))
2617 form)) 2653 form))
2618 2654
2619;;;###autoload
2620(defun cl--compiler-macro-cXXr (form x)
2621 (let* ((head (car form))
2622 (n (symbol-name (car form)))
2623 (i (- (length n) 2)))
2624 (if (not (string-match "c[ad]+r\\'" n))
2625 (if (and (fboundp head) (symbolp (symbol-function head)))
2626 (cl--compiler-macro-cXXr (cons (symbol-function head) (cdr form))
2627 x)
2628 (error "Compiler macro for cXXr applied to non-cXXr form"))
2629 (while (> i (match-beginning 0))
2630 (setq x (list (if (eq (aref n i) ?a) 'car 'cdr) x))
2631 (setq i (1- i)))
2632 x)))
2633
2634(dolist (y '(cl-first cl-second cl-third cl-fourth 2655(dolist (y '(cl-first cl-second cl-third cl-fourth
2635 cl-fifth cl-sixth cl-seventh 2656 cl-fifth cl-sixth cl-seventh
2636 cl-eighth cl-ninth cl-tenth 2657 cl-eighth cl-ninth cl-tenth
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 7bc93a19d1a..774b4d3d600 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -48,6 +48,39 @@ the middle is discarded, and just the beginning and end are displayed."
48 :group 'debugger 48 :group 'debugger
49 :version "21.1") 49 :version "21.1")
50 50
51(defcustom debugger-bury-or-kill 'bury
52 "How to proceed with the debugger buffer when exiting `debug'.
53The value used here affects the behavior of operations on any
54window previously showing the debugger buffer.
55
56`nil' means that if its window is not deleted when exiting the
57 debugger, invoking `switch-to-prev-buffer' will usually show
58 the debugger buffer again.
59
60`append' means that if the window is not deleted, the debugger
61 buffer moves to the end of the window's previous buffers so
62 it's less likely that a future invocation of
63 `switch-to-prev-buffer' will switch to it. Also, it moves the
64 buffer to the end of the frame's buffer list.
65
66`bury' means that if the window is not deleted, its buffer is
67 removed from the window's list of previous buffers. Also, it
68 moves the buffer to the end of the frame's buffer list. This
69 value provides the most reliable remedy to not have
70 `switch-to-prev-buffer' switch to the debugger buffer again
71 without killing the buffer.
72
73`kill' means to kill the debugger buffer.
74
75The value used here is passed to `quit-restore-window'."
76 :type '(choice
77 (const :tag "Keep alive" nil)
78 (const :tag "Append" 'append)
79 (const :tag "Bury" 'bury)
80 (const :tag "Kill" 'kill))
81 :group 'debugger
82 :version "24.2")
83
51(defvar debug-function-list nil 84(defvar debug-function-list nil
52 "List of functions currently set for debug on entry.") 85 "List of functions currently set for debug on entry.")
53 86
@@ -60,6 +93,12 @@ the middle is discarded, and just the beginning and end are displayed."
60(defvar debugger-old-buffer nil 93(defvar debugger-old-buffer nil
61 "This is the buffer that was current when the debugger was entered.") 94 "This is the buffer that was current when the debugger was entered.")
62 95
96(defvar debugger-previous-window nil
97 "This is the window last showing the debugger buffer.")
98
99(defvar debugger-previous-window-height nil
100 "The last recorded height of `debugger-previous-window'.")
101
63(defvar debugger-previous-backtrace nil 102(defvar debugger-previous-backtrace nil
64 "The contents of the previous backtrace (including text properties). 103 "The contents of the previous backtrace (including text properties).
65This is to optimize `debugger-make-xrefs'.") 104This is to optimize `debugger-make-xrefs'.")
@@ -71,10 +110,6 @@ This is to optimize `debugger-make-xrefs'.")
71(defvar debugger-outer-track-mouse) 110(defvar debugger-outer-track-mouse)
72(defvar debugger-outer-last-command) 111(defvar debugger-outer-last-command)
73(defvar debugger-outer-this-command) 112(defvar debugger-outer-this-command)
74;; unread-command-char is obsolete,
75;; but we still save and restore it
76;; in case some user program still tries to set it.
77(defvar debugger-outer-unread-command-char)
78(defvar debugger-outer-unread-command-events) 113(defvar debugger-outer-unread-command-events)
79(defvar debugger-outer-unread-post-input-method-events) 114(defvar debugger-outer-unread-post-input-method-events)
80(defvar debugger-outer-last-input-event) 115(defvar debugger-outer-last-input-event)
@@ -126,14 +161,12 @@ first will be printed into the backtrace buffer."
126 (unless noninteractive 161 (unless noninteractive
127 (message "Entering debugger...")) 162 (message "Entering debugger..."))
128 (let (debugger-value 163 (let (debugger-value
129 (debug-on-error nil)
130 (debug-on-quit nil)
131 (debugger-previous-state 164 (debugger-previous-state
132 (if (get-buffer "*Backtrace*") 165 (if (get-buffer "*Backtrace*")
133 (with-current-buffer (get-buffer "*Backtrace*") 166 (with-current-buffer (get-buffer "*Backtrace*")
134 (list major-mode (buffer-string))))) 167 (list major-mode (buffer-string)))))
135 (debugger-buffer (get-buffer-create "*Backtrace*")) 168 (debugger-buffer (get-buffer-create "*Backtrace*"))
136 (debugger-old-buffer (current-buffer)) 169 (debugger-window nil)
137 (debugger-step-after-exit nil) 170 (debugger-step-after-exit nil)
138 (debugger-will-be-back nil) 171 (debugger-will-be-back nil)
139 ;; Don't keep reading from an executing kbd macro! 172 ;; Don't keep reading from an executing kbd macro!
@@ -148,8 +181,6 @@ first will be printed into the backtrace buffer."
148 (debugger-outer-track-mouse track-mouse) 181 (debugger-outer-track-mouse track-mouse)
149 (debugger-outer-last-command last-command) 182 (debugger-outer-last-command last-command)
150 (debugger-outer-this-command this-command) 183 (debugger-outer-this-command this-command)
151 (debugger-outer-unread-command-char
152 (with-no-warnings unread-command-char))
153 (debugger-outer-unread-command-events unread-command-events) 184 (debugger-outer-unread-command-events unread-command-events)
154 (debugger-outer-unread-post-input-method-events 185 (debugger-outer-unread-post-input-method-events
155 unread-post-input-method-events) 186 unread-post-input-method-events)
@@ -184,78 +215,74 @@ first will be printed into the backtrace buffer."
184 (cursor-in-echo-area nil)) 215 (cursor-in-echo-area nil))
185 (unwind-protect 216 (unwind-protect
186 (save-excursion 217 (save-excursion
187 (save-window-excursion 218 (when (eq (car debugger-args) 'debug)
188 (with-no-warnings 219 ;; Skip the frames for backtrace-debug, byte-code,
189 (setq unread-command-char -1)) 220 ;; and implement-debug-on-entry.
190 (when (eq (car debugger-args) 'debug) 221 (backtrace-debug 4 t)
191 ;; Skip the frames for backtrace-debug, byte-code, 222 ;; Place an extra debug-on-exit for macro's.
192 ;; and implement-debug-on-entry. 223 (when (eq 'lambda (car-safe (cadr (backtrace-frame 4))))
193 (backtrace-debug 4 t) 224 (backtrace-debug 5 t)))
194 ;; Place an extra debug-on-exit for macro's. 225 (pop-to-buffer
195 (when (eq 'lambda (car-safe (cadr (backtrace-frame 4)))) 226 debugger-buffer
196 (backtrace-debug 5 t))) 227 `((display-buffer-reuse-window
197 (pop-to-buffer debugger-buffer) 228 display-buffer-in-previous-window)
198 (debugger-mode) 229 . (,(when debugger-previous-window
199 (debugger-setup-buffer debugger-args) 230 `(previous-window . ,debugger-previous-window)))))
200 (when noninteractive 231 (setq debugger-window (selected-window))
201 ;; If the backtrace is long, save the beginning 232 (if (eq debugger-previous-window debugger-window)
202 ;; and the end, but discard the middle. 233 (when debugger-jumping-flag
203 (when (> (count-lines (point-min) (point-max)) 234 ;; Try to restore previous height of debugger
204 debugger-batch-max-lines) 235 ;; window.
205 (goto-char (point-min)) 236 (condition-case nil
206 (forward-line (/ 2 debugger-batch-max-lines)) 237 (window-resize
207 (let ((middlestart (point))) 238 debugger-window
208 (goto-char (point-max)) 239 (- debugger-previous-window-height
209 (forward-line (- (/ 2 debugger-batch-max-lines) 240 (window-total-size debugger-window)))
210 debugger-batch-max-lines)) 241 (error nil)))
211 (delete-region middlestart (point))) 242 (setq debugger-previous-window debugger-window))
212 (insert "...\n")) 243 (debugger-mode)
244 (debugger-setup-buffer debugger-args)
245 (when noninteractive
246 ;; If the backtrace is long, save the beginning
247 ;; and the end, but discard the middle.
248 (when (> (count-lines (point-min) (point-max))
249 debugger-batch-max-lines)
213 (goto-char (point-min)) 250 (goto-char (point-min))
214 (message "%s" (buffer-string)) 251 (forward-line (/ 2 debugger-batch-max-lines))
215 (kill-emacs -1)) 252 (let ((middlestart (point)))
253 (goto-char (point-max))
254 (forward-line (- (/ 2 debugger-batch-max-lines)
255 debugger-batch-max-lines))
256 (delete-region middlestart (point)))
257 (insert "...\n"))
258 (goto-char (point-min))
259 (message "%s" (buffer-string))
260 (kill-emacs -1))
261 (message "")
262 (let ((standard-output nil)
263 (buffer-read-only t))
216 (message "") 264 (message "")
217 (let ((standard-output nil) 265 ;; Make sure we unbind buffer-read-only in the right buffer.
218 (buffer-read-only t)) 266 (save-excursion
219 (message "") 267 (recursive-edit))))
220 ;; Make sure we unbind buffer-read-only in the right buffer. 268 (when (and (window-live-p debugger-window)
221 (save-excursion 269 (eq (window-buffer debugger-window) debugger-buffer))
222 (recursive-edit))))) 270 ;; Record height of debugger window.
223 ;; Kill or at least neuter the backtrace buffer, so that users 271 (setq debugger-previous-window-height
224 ;; don't try to execute debugger commands in an invalid context. 272 (window-total-size debugger-window))
225 (if (get-buffer-window debugger-buffer 0) 273 ;; Unshow debugger-buffer.
226 ;; Still visible despite the save-window-excursion? Maybe it 274 (quit-restore-window debugger-window debugger-bury-or-kill))
227 ;; it's in a pop-up frame. It would be annoying to delete and 275 ;; Restore previous state of debugger-buffer in case we were
228 ;; recreate it every time the debugger stops, so instead we'll 276 ;; in a recursive invocation of the debugger, otherwise just
229 ;; erase it (and maybe hide it) but keep it alive. 277 ;; erase the buffer and put it into fundamental mode.
230 (with-current-buffer debugger-buffer 278 (when (buffer-live-p debugger-buffer)
231 (with-selected-window (get-buffer-window debugger-buffer 0) 279 (with-current-buffer debugger-buffer
232 (when (and (window-dedicated-p (selected-window)) 280 (let ((inhibit-read-only t))
233 (not debugger-will-be-back)) 281 (erase-buffer)
234 ;; If the window is not dedicated, burying the buffer 282 (if (null debugger-previous-state)
235 ;; will mean that the frame created for it is left 283 (fundamental-mode)
236 ;; around showing some random buffer, and next time we 284 (insert (nth 1 debugger-previous-state))
237 ;; pop to the debugger buffer we'll create yet 285 (funcall (nth 0 debugger-previous-state))))))
238 ;; another frame.
239 ;; If debugger-will-be-back is non-nil, the frame
240 ;; would need to be de-iconified anyway immediately
241 ;; after when we re-enter the debugger, so iconifying it
242 ;; here would cause flashing.
243 ;; Drew Adams is not happy with this: he wants to frame
244 ;; to be left at the top-level, still working on how
245 ;; best to do that.
246 (bury-buffer))))
247 (unless debugger-previous-state
248 (kill-buffer debugger-buffer)))
249 ;; Restore the previous state of the debugger-buffer, in case we were
250 ;; in a recursive invocation of the debugger.
251 (when (buffer-live-p debugger-buffer)
252 (with-current-buffer debugger-buffer
253 (let ((inhibit-read-only t))
254 (erase-buffer)
255 (if (null debugger-previous-state)
256 (fundamental-mode)
257 (insert (nth 1 debugger-previous-state))
258 (funcall (nth 0 debugger-previous-state))))))
259 (with-timeout-unsuspend debugger-with-timeout-suspend) 286 (with-timeout-unsuspend debugger-with-timeout-suspend)
260 (set-match-data debugger-outer-match-data))) 287 (set-match-data debugger-outer-match-data)))
261 ;; Put into effect the modified values of these variables 288 ;; Put into effect the modified values of these variables
@@ -267,8 +294,6 @@ first will be printed into the backtrace buffer."
267 (setq track-mouse debugger-outer-track-mouse) 294 (setq track-mouse debugger-outer-track-mouse)
268 (setq last-command debugger-outer-last-command) 295 (setq last-command debugger-outer-last-command)
269 (setq this-command debugger-outer-this-command) 296 (setq this-command debugger-outer-this-command)
270 (with-no-warnings
271 (setq unread-command-char debugger-outer-unread-command-char))
272 (setq unread-command-events debugger-outer-unread-command-events) 297 (setq unread-command-events debugger-outer-unread-command-events)
273 (setq unread-post-input-method-events 298 (setq unread-post-input-method-events
274 debugger-outer-unread-post-input-method-events) 299 debugger-outer-unread-post-input-method-events)
@@ -570,16 +595,7 @@ Applies to the frame whose line point is on in the backtrace."
570 (cursor-in-echo-area debugger-outer-cursor-in-echo-area)) 595 (cursor-in-echo-area debugger-outer-cursor-in-echo-area))
571 (set-match-data debugger-outer-match-data) 596 (set-match-data debugger-outer-match-data)
572 (prog1 597 (prog1
573 (let ((save-ucc (with-no-warnings unread-command-char))) 598 (progn ,@body)
574 (unwind-protect
575 (progn
576 (with-no-warnings
577 (setq unread-command-char debugger-outer-unread-command-char))
578 (prog1 (progn ,@body)
579 (with-no-warnings
580 (setq debugger-outer-unread-command-char unread-command-char))))
581 (with-no-warnings
582 (setq unread-command-char save-ucc))))
583 (setq debugger-outer-match-data (match-data)) 599 (setq debugger-outer-match-data (match-data))
584 (setq debugger-outer-load-read-function load-read-function) 600 (setq debugger-outer-load-read-function load-read-function)
585 (setq debugger-outer-overriding-terminal-local-map 601 (setq debugger-outer-overriding-terminal-local-map
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
index 7f9f8a33634..939fab78942 100644
--- a/lisp/emacs-lisp/easymenu.el
+++ b/lisp/emacs-lisp/easymenu.el
@@ -148,7 +148,7 @@ unselectable text. A string consisting solely of hyphens is displayed
148as a solid horizontal line. 148as a solid horizontal line.
149 149
150A menu item can be a list with the same format as MENU. This is a submenu." 150A menu item can be a list with the same format as MENU. This is a submenu."
151 (declare (indent defun)) 151 (declare (indent defun) (debug (symbolp body)))
152 `(progn 152 `(progn
153 ,(if symbol `(defvar ,symbol nil ,doc)) 153 ,(if symbol `(defvar ,symbol nil ,doc))
154 (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu))) 154 (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu)))
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 7fcd339d6d2..d656dcf9526 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -1,4 +1,4 @@
1;;; edebug.el --- a source-level debugger for Emacs Lisp 1;;; edebug.el --- a source-level debugger for Emacs Lisp -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 1988-1995, 1997, 1999-2012 Free Software Foundation, Inc. 3;; Copyright (C) 1988-1995, 1997, 1999-2012 Free Software Foundation, Inc.
4 4
@@ -52,10 +52,7 @@
52;;; Code: 52;;; Code:
53 53
54(require 'macroexp) 54(require 'macroexp)
55 55(eval-when-compile (require 'cl-lib))
56;;; Bug reporting
57
58(defalias 'edebug-submit-bug-report 'report-emacs-bug)
59 56
60;;; Options 57;;; Options
61 58
@@ -235,14 +232,9 @@ If the result is non-nil, then break. Errors are ignored."
235 232
236;;; Form spec utilities. 233;;; Form spec utilities.
237 234
238(defmacro def-edebug-form-spec (symbol spec-form)
239 "For compatibility with old version."
240 (def-edebug-spec symbol (eval spec-form)))
241(make-obsolete 'def-edebug-form-spec 'def-edebug-spec "22.1")
242
243(defun get-edebug-spec (symbol) 235(defun get-edebug-spec (symbol)
244 ;; Get the spec of symbol resolving all indirection. 236 ;; Get the spec of symbol resolving all indirection.
245 (let ((edebug-form-spec nil) 237 (let ((spec nil)
246 (indirect symbol)) 238 (indirect symbol))
247 (while 239 (while
248 (progn 240 (progn
@@ -250,9 +242,8 @@ If the result is non-nil, then break. Errors are ignored."
250 (setq indirect 242 (setq indirect
251 (function-get indirect 'edebug-form-spec 'macro)))) 243 (function-get indirect 'edebug-form-spec 'macro))))
252 ;; (edebug-trace "indirection: %s" edebug-form-spec) 244 ;; (edebug-trace "indirection: %s" edebug-form-spec)
253 (setq edebug-form-spec indirect)) 245 (setq spec indirect))
254 edebug-form-spec 246 spec))
255 ))
256 247
257;;;###autoload 248;;;###autoload
258(defun edebug-basic-spec (spec) 249(defun edebug-basic-spec (spec)
@@ -342,9 +333,7 @@ A lambda list keyword is a symbol that starts with `&'."
342 (lambda (e1 e2) 333 (lambda (e1 e2)
343 (funcall function (car e1) (car e2)))))) 334 (funcall function (car e1) (car e2))))))
344 335
345;;(def-edebug-spec edebug-save-restriction t) 336;; Not used.
346
347;; Not used. If it is used, def-edebug-spec must be defined before use.
348'(defmacro edebug-save-restriction (&rest body) 337'(defmacro edebug-save-restriction (&rest body)
349 "Evaluate BODY while saving the current buffers restriction. 338 "Evaluate BODY while saving the current buffers restriction.
350BODY may change buffer outside of current restriction, unlike 339BODY may change buffer outside of current restriction, unlike
@@ -352,6 +341,7 @@ save-restriction. BODY may change the current buffer,
352and the restriction will be restored to the original buffer, 341and the restriction will be restored to the original buffer,
353and the current buffer remains current. 342and the current buffer remains current.
354Return the result of the last expression in BODY." 343Return the result of the last expression in BODY."
344 (declare (debug t))
355 `(let ((edebug:s-r-beg (point-min-marker)) 345 `(let ((edebug:s-r-beg (point-min-marker))
356 (edebug:s-r-end (point-max-marker))) 346 (edebug:s-r-end (point-max-marker)))
357 (unwind-protect 347 (unwind-protect
@@ -369,6 +359,7 @@ Return the result of the last expression in BODY."
369 ;; Select WINDOW if it is provided and still exists. Otherwise, 359 ;; Select WINDOW if it is provided and still exists. Otherwise,
370 ;; if buffer is currently shown in several windows, choose one. 360 ;; if buffer is currently shown in several windows, choose one.
371 ;; Otherwise, find a new window, possibly splitting one. 361 ;; Otherwise, find a new window, possibly splitting one.
362 ;; FIXME: We should probably just be using `pop-to-buffer'.
372 (setq window 363 (setq window
373 (cond 364 (cond
374 ((and (edebug-window-live-p window) 365 ((and (edebug-window-live-p window)
@@ -377,7 +368,7 @@ Return the result of the last expression in BODY."
377 ((eq (window-buffer (selected-window)) buffer) 368 ((eq (window-buffer (selected-window)) buffer)
378 ;; Selected window already displays BUFFER. 369 ;; Selected window already displays BUFFER.
379 (selected-window)) 370 (selected-window))
380 ((edebug-get-buffer-window buffer)) 371 ((get-buffer-window buffer 0))
381 ((one-window-p 'nomini) 372 ((one-window-p 'nomini)
382 ;; When there's one window only, split it. 373 ;; When there's one window only, split it.
383 (split-window)) 374 (split-window))
@@ -450,18 +441,14 @@ Return the result of the last expression in BODY."
450 window-info) 441 window-info)
451 (set-window-configuration window-info))) 442 (set-window-configuration window-info)))
452 443
453(defalias 'edebug-get-buffer-window 'get-buffer-window)
454(defalias 'edebug-sit-for 'sit-for)
455(defalias 'edebug-input-pending-p 'input-pending-p)
456
457
458;;; Redefine read and eval functions 444;;; Redefine read and eval functions
459;; read is redefined to maybe instrument forms. 445;; read is redefined to maybe instrument forms.
460;; eval-defun is redefined to check edebug-all-forms and edebug-all-defs. 446;; eval-defun is redefined to check edebug-all-forms and edebug-all-defs.
461 447
462;; Save the original read function 448;; Save the original read function
463(or (fboundp 'edebug-original-read) 449(defalias 'edebug-original-read
464 (defalias 'edebug-original-read (symbol-function 'read))) 450 (symbol-function (if (fboundp 'edebug-original-read)
451 'edebug-original-read 'read)))
465 452
466(defun edebug-read (&optional stream) 453(defun edebug-read (&optional stream)
467 "Read one Lisp expression as text from STREAM, return as Lisp object. 454 "Read one Lisp expression as text from STREAM, return as Lisp object.
@@ -626,36 +613,29 @@ already is one.)"
626;; The internal data that is needed for edebugging is kept in the 613;; The internal data that is needed for edebugging is kept in the
627;; buffer-local variable `edebug-form-data'. 614;; buffer-local variable `edebug-form-data'.
628 615
629(make-variable-buffer-local 'edebug-form-data) 616(defvar-local edebug-form-data nil
630 617 "A list of entries associating symbols with buffer regions.
631(defvar edebug-form-data nil) 618Each entry is an `edebug--form-data' struct with fields:
632;; A list of entries associating symbols with buffer regions. 619SYMBOL, BEGIN-MARKER, and END-MARKER. The markers
633;; This is an automatic buffer local variable. Each entry looks like: 620are at the beginning and end of an entry level form and SYMBOL is
634;; @code{(@var{symbol} @var{begin-marker} @var{end-marker}). The markers 621a symbol that holds all edebug related information for the form on its
635;; are at the beginning and end of an entry level form and @var{symbol} is 622property list.
636;; a symbol that holds all edebug related information for the form on its 623
637;; property list. 624In the future (haha!), the symbol will be irrelevant and edebug data will
638 625be stored in the definitions themselves rather than in the property
639;; In the future, the symbol will be irrelevant and edebug data will 626list of a symbol.")
640;; be stored in the definitions themselves rather than in the property 627
641;; list of a symbol. 628(cl-defstruct (edebug--form-data
642 629 ;; Some callers expect accessors to return nil when passed nil.
643(defun edebug-make-form-data-entry (symbol begin end) 630 (:type list)
644 (list symbol begin end)) 631 (:constructor edebug--make-form-data-entry (name begin end))
645 632 (:predicate nil) (:constructor nil) (:copier nil))
646(defsubst edebug-form-data-name (entry) 633 name begin end)
647 (car entry))
648
649(defsubst edebug-form-data-begin (entry)
650 (nth 1 entry))
651
652(defsubst edebug-form-data-end (entry)
653 (nth 2 entry))
654 634
655(defsubst edebug-set-form-data-entry (entry name begin end) 635(defsubst edebug-set-form-data-entry (entry name begin end)
656 (setcar entry name);; in case name is changed 636 (setf (edebug--form-data-name entry) name) ;; In case name is changed.
657 (set-marker (nth 1 entry) begin) 637 (set-marker (edebug--form-data-begin entry) begin)
658 (set-marker (nth 2 entry) end)) 638 (set-marker (edebug--form-data-end entry) end))
659 639
660(defun edebug-get-form-data-entry (pnt &optional end-point) 640(defun edebug-get-form-data-entry (pnt &optional end-point)
661 ;; Find the edebug form data entry which is closest to PNT. 641 ;; Find the edebug form data entry which is closest to PNT.
@@ -663,17 +643,17 @@ already is one.)"
663 ;; Return `nil' if none found. 643 ;; Return `nil' if none found.
664 (let ((rest edebug-form-data) 644 (let ((rest edebug-form-data)
665 closest-entry 645 closest-entry
666 (closest-dist 999999)) ;; need maxint here 646 (closest-dist 999999)) ;; Need maxint here.
667 (while (and rest (< 0 closest-dist)) 647 (while (and rest (< 0 closest-dist))
668 (let* ((entry (car rest)) 648 (let* ((entry (car rest))
669 (begin (edebug-form-data-begin entry)) 649 (begin (edebug--form-data-begin entry))
670 (dist (- pnt begin))) 650 (dist (- pnt begin)))
671 (setq rest (cdr rest)) 651 (setq rest (cdr rest))
672 (if (and (<= 0 dist) 652 (if (and (<= 0 dist)
673 (< dist closest-dist) 653 (< dist closest-dist)
674 (or (not end-point) 654 (or (not end-point)
675 (= end-point (edebug-form-data-end entry))) 655 (= end-point (edebug--form-data-end entry)))
676 (<= pnt (edebug-form-data-end entry))) 656 (<= pnt (edebug--form-data-end entry)))
677 (setq closest-dist dist 657 (setq closest-dist dist
678 closest-entry entry)))) 658 closest-entry entry))))
679 closest-entry)) 659 closest-entry))
@@ -682,19 +662,19 @@ already is one.)"
682;; and find an entry given a symbol, which should be just assq. 662;; and find an entry given a symbol, which should be just assq.
683 663
684(defun edebug-form-data-symbol () 664(defun edebug-form-data-symbol ()
685;; Return the edebug data symbol of the form where point is in. 665 "Return the edebug data symbol of the form where point is in.
686;; If point is not inside a edebuggable form, cause error. 666If point is not inside a edebuggable form, cause error."
687 (or (edebug-form-data-name (edebug-get-form-data-entry (point))) 667 (or (edebug--form-data-name (edebug-get-form-data-entry (point)))
688 (error "Not inside instrumented form"))) 668 (error "Not inside instrumented form")))
689 669
690(defun edebug-make-top-form-data-entry (new-entry) 670(defun edebug-make-top-form-data-entry (new-entry)
691 ;; Make NEW-ENTRY the first element in the `edebug-form-data' list. 671 ;; Make NEW-ENTRY the first element in the `edebug-form-data' list.
692 (edebug-clear-form-data-entry new-entry) 672 (edebug-clear-form-data-entry new-entry)
693 (setq edebug-form-data (cons new-entry edebug-form-data))) 673 (push new-entry edebug-form-data))
694 674
695(defun edebug-clear-form-data-entry (entry) 675(defun edebug-clear-form-data-entry (entry)
696;; If non-nil, clear ENTRY out of the form data. 676 "If non-nil, clear ENTRY out of the form data.
697;; Maybe clear the markers and delete the symbol's edebug property? 677Maybe clear the markers and delete the symbol's edebug property?"
698 (if entry 678 (if entry
699 (progn 679 (progn
700 ;; Instead of this, we could just find all contained forms. 680 ;; Instead of this, we could just find all contained forms.
@@ -1086,7 +1066,8 @@ already is one.)"
1086 ;; If it gets an error, make it nil. 1066 ;; If it gets an error, make it nil.
1087 (let ((temp-hook edebug-setup-hook)) 1067 (let ((temp-hook edebug-setup-hook))
1088 (setq edebug-setup-hook nil) 1068 (setq edebug-setup-hook nil)
1089 (run-hooks 'temp-hook)) 1069 (if (functionp temp-hook) (funcall temp-hook)
1070 (mapc #'funcall temp-hook)))
1090 1071
1091 (let (result 1072 (let (result
1092 edebug-top-window-data 1073 edebug-top-window-data
@@ -1223,8 +1204,8 @@ already is one.)"
1223(defvar edebug-offset-list) ; the list of offset positions. 1204(defvar edebug-offset-list) ; the list of offset positions.
1224 1205
1225(defun edebug-inc-offset (offset) 1206(defun edebug-inc-offset (offset)
1226 ;; modifies edebug-offset-index and edebug-offset-list 1207 ;; Modifies edebug-offset-index and edebug-offset-list
1227 ;; accesses edebug-func-marc and buffer point 1208 ;; accesses edebug-func-marc and buffer point.
1228 (prog1 1209 (prog1
1229 edebug-offset-index 1210 edebug-offset-index
1230 (setq edebug-offset-list (cons (- offset edebug-form-begin-marker) 1211 (setq edebug-offset-list (cons (- offset edebug-form-begin-marker)
@@ -1237,13 +1218,11 @@ already is one.)"
1237 ;; given FORM. Looks like: 1218 ;; given FORM. Looks like:
1238 ;; (edebug-after (edebug-before BEFORE-INDEX) AFTER-INDEX FORM) 1219 ;; (edebug-after (edebug-before BEFORE-INDEX) AFTER-INDEX FORM)
1239 ;; Also increment the offset index for subsequent use. 1220 ;; Also increment the offset index for subsequent use.
1240 (list 'edebug-after 1221 `(edebug-after (edebug-before ,before-index) ,after-index ,form))
1241 (list 'edebug-before before-index)
1242 after-index form))
1243 1222
1244(defun edebug-make-after-form (form after-index) 1223(defun edebug-make-after-form (form after-index)
1245 ;; Like edebug-make-before-and-after-form, but only after. 1224 ;; Like edebug-make-before-and-after-form, but only after.
1246 (list 'edebug-after 0 after-index form)) 1225 `(edebug-after 0 ,after-index ,form))
1247 1226
1248 1227
1249(defun edebug-unwrap (sexp) 1228(defun edebug-unwrap (sexp)
@@ -1293,7 +1272,7 @@ expressions; a `progn' form will be returned enclosing these forms."
1293 ;; Set this marker before parsing. 1272 ;; Set this marker before parsing.
1294 (edebug-form-begin-marker 1273 (edebug-form-begin-marker
1295 (if form-data-entry 1274 (if form-data-entry
1296 (edebug-form-data-begin form-data-entry) 1275 (edebug--form-data-begin form-data-entry)
1297 ;; Buffer must be current-buffer for this to work: 1276 ;; Buffer must be current-buffer for this to work:
1298 (set-marker (make-marker) form-begin)))) 1277 (set-marker (make-marker) form-begin))))
1299 1278
@@ -1303,7 +1282,7 @@ expressions; a `progn' form will be returned enclosing these forms."
1303 ;; For definitions. 1282 ;; For definitions.
1304 ;; (edebug-containing-def-name edebug-def-name) 1283 ;; (edebug-containing-def-name edebug-def-name)
1305 ;; Get name from form-data, if any. 1284 ;; Get name from form-data, if any.
1306 (edebug-old-def-name (edebug-form-data-name form-data-entry)) 1285 (edebug-old-def-name (edebug--form-data-name form-data-entry))
1307 edebug-def-name 1286 edebug-def-name
1308 edebug-def-args 1287 edebug-def-args
1309 edebug-def-interactive 1288 edebug-def-interactive
@@ -1333,7 +1312,7 @@ expressions; a `progn' form will be returned enclosing these forms."
1333 ;; In the latter case, pointers to the entry remain eq. 1312 ;; In the latter case, pointers to the entry remain eq.
1334 (if (not form-data-entry) 1313 (if (not form-data-entry)
1335 (setq form-data-entry 1314 (setq form-data-entry
1336 (edebug-make-form-data-entry 1315 (edebug--make-form-data-entry
1337 edebug-def-name 1316 edebug-def-name
1338 edebug-form-begin-marker 1317 edebug-form-begin-marker
1339 ;; Buffer must be current-buffer. 1318 ;; Buffer must be current-buffer.
@@ -1519,18 +1498,18 @@ expressions; a `progn' form will be returned enclosing these forms."
1519;; Otherwise it signals an error. The place of the error is found 1498;; Otherwise it signals an error. The place of the error is found
1520;; with the two before- and after-offset functions. 1499;; with the two before- and after-offset functions.
1521 1500
1522(defun edebug-no-match (cursor &rest edebug-args) 1501(defun edebug-no-match (cursor &rest args)
1523 ;; Throw a no-match, or signal an error immediately if gate is active. 1502 ;; Throw a no-match, or signal an error immediately if gate is active.
1524 ;; Remember this point in case we need to report this error. 1503 ;; Remember this point in case we need to report this error.
1525 (setq edebug-error-point (or edebug-error-point 1504 (setq edebug-error-point (or edebug-error-point
1526 (edebug-before-offset cursor)) 1505 (edebug-before-offset cursor))
1527 edebug-best-error (or edebug-best-error edebug-args)) 1506 edebug-best-error (or edebug-best-error args))
1528 (if (and edebug-gate (not edebug-&optional)) 1507 (if (and edebug-gate (not edebug-&optional))
1529 (progn 1508 (progn
1530 (if edebug-error-point 1509 (if edebug-error-point
1531 (goto-char edebug-error-point)) 1510 (goto-char edebug-error-point))
1532 (apply 'edebug-syntax-error edebug-args)) 1511 (apply 'edebug-syntax-error args))
1533 (funcall 'throw 'no-match edebug-args))) 1512 (throw 'no-match args)))
1534 1513
1535 1514
1536(defun edebug-match (cursor specs) 1515(defun edebug-match (cursor specs)
@@ -1757,7 +1736,7 @@ expressions; a `progn' form will be returned enclosing these forms."
1757 specs)))) 1736 specs))))
1758 1737
1759 1738
1760(defun edebug-match-gate (cursor) 1739(defun edebug-match-gate (_cursor)
1761 ;; Simply set the gate to prevent backtracking at this level. 1740 ;; Simply set the gate to prevent backtracking at this level.
1762 (setq edebug-gate t) 1741 (setq edebug-gate t)
1763 nil) 1742 nil)
@@ -1846,7 +1825,7 @@ expressions; a `progn' form will be returned enclosing these forms."
1846 nil)) 1825 nil))
1847 1826
1848 1827
1849(defun edebug-match-function (cursor) 1828(defun edebug-match-function (_cursor)
1850 (error "Use function-form instead of function in edebug spec")) 1829 (error "Use function-form instead of function in edebug spec"))
1851 1830
1852(defun edebug-match-&define (cursor specs) 1831(defun edebug-match-&define (cursor specs)
@@ -1903,7 +1882,7 @@ expressions; a `progn' form will be returned enclosing these forms."
1903 (edebug-move-cursor cursor) 1882 (edebug-move-cursor cursor)
1904 (list name))) 1883 (list name)))
1905 1884
1906(defun edebug-match-colon-name (cursor spec) 1885(defun edebug-match-colon-name (_cursor spec)
1907 ;; Set the edebug-def-name to the spec. 1886 ;; Set the edebug-def-name to the spec.
1908 (setq edebug-def-name 1887 (setq edebug-def-name
1909 (if edebug-def-name 1888 (if edebug-def-name
@@ -1988,6 +1967,8 @@ expressions; a `progn' form will be returned enclosing these forms."
1988 def-body)) 1967 def-body))
1989;; FIXME? Isn't this missing the doc-string? Cf defun. 1968;; FIXME? Isn't this missing the doc-string? Cf defun.
1990(def-edebug-spec defmacro 1969(def-edebug-spec defmacro
1970 ;; FIXME: Improve `declare' so we can Edebug gv-expander and
1971 ;; gv-setter declarations.
1991 (&define name lambda-list [&optional ("declare" &rest sexp)] def-body)) 1972 (&define name lambda-list [&optional ("declare" &rest sexp)] def-body))
1992 1973
1993(def-edebug-spec arglist lambda-list) ;; deprecated - use lambda-list. 1974(def-edebug-spec arglist lambda-list) ;; deprecated - use lambda-list.
@@ -2018,11 +1999,6 @@ expressions; a `progn' form will be returned enclosing these forms."
2018;; (def-edebug-spec anonymous-form ((&or ["lambda" lambda] ["macro" macro]))) 1999;; (def-edebug-spec anonymous-form ((&or ["lambda" lambda] ["macro" macro])))
2019 2000
2020;; Standard functions that take function-forms arguments. 2001;; Standard functions that take function-forms arguments.
2021(def-edebug-spec mapcar (function-form form))
2022(def-edebug-spec mapconcat (function-form form form))
2023(def-edebug-spec mapatoms (function-form &optional form))
2024(def-edebug-spec apply (function-form &rest form))
2025(def-edebug-spec funcall (function-form &rest form))
2026 2002
2027;; FIXME? The manual uses this form (maybe that's just for illustration?): 2003;; FIXME? The manual uses this form (maybe that's just for illustration?):
2028;; (def-edebug-spec let 2004;; (def-edebug-spec let
@@ -2088,49 +2064,12 @@ expressions; a `progn' form will be returned enclosing these forms."
2088 &or ("quote" edebug-\`) def-form)) 2064 &or ("quote" edebug-\`) def-form))
2089 2065
2090;; New byte compiler. 2066;; New byte compiler.
2091(def-edebug-spec defsubst defun)
2092(def-edebug-spec dont-compile t)
2093(def-edebug-spec eval-when-compile t)
2094(def-edebug-spec eval-and-compile t)
2095 2067
2096(def-edebug-spec save-selected-window t) 2068(def-edebug-spec save-selected-window t)
2097(def-edebug-spec save-current-buffer t) 2069(def-edebug-spec save-current-buffer t)
2098(def-edebug-spec delay-mode-hooks t)
2099(def-edebug-spec with-temp-file t)
2100(def-edebug-spec with-temp-message t)
2101(def-edebug-spec with-syntax-table t)
2102(def-edebug-spec push (form sexp))
2103(def-edebug-spec pop (sexp))
2104
2105(def-edebug-spec 1value (form))
2106(def-edebug-spec noreturn (form))
2107
2108 2070
2109;; Anything else? 2071;; Anything else?
2110 2072
2111
2112;; Some miscellaneous specs for macros in public packages.
2113;; Send me yours.
2114
2115;; advice.el by Hans Chalupsky (hans@cs.buffalo.edu)
2116
2117(def-edebug-spec ad-dolist ((symbolp form &optional form) body))
2118(def-edebug-spec defadvice
2119 (&define name ;; thing being advised.
2120 (name ;; class is [&or "before" "around" "after"
2121 ;; "activation" "deactivation"]
2122 name ;; name of advice
2123 &rest sexp ;; optional position and flags
2124 )
2125 [&optional stringp]
2126 [&optional ("interactive" interactive)]
2127 def-body))
2128
2129(def-edebug-spec easy-menu-define (symbolp body))
2130
2131(def-edebug-spec with-custom-print body)
2132
2133
2134;;; The debugger itself 2073;;; The debugger itself
2135 2074
2136(defvar edebug-active nil) ;; Non-nil when edebug is active 2075(defvar edebug-active nil) ;; Non-nil when edebug is active
@@ -2167,10 +2106,7 @@ expressions; a `progn' form will be returned enclosing these forms."
2167 2106
2168;; Dynamically bound variables, declared globally but left unbound. 2107;; Dynamically bound variables, declared globally but left unbound.
2169(defvar edebug-function) ; the function being executed. change name!! 2108(defvar edebug-function) ; the function being executed. change name!!
2170(defvar edebug-args) ; the arguments of the function
2171(defvar edebug-data) ; the edebug data for the function 2109(defvar edebug-data) ; the edebug data for the function
2172(defvar edebug-value) ; the result of the expression
2173(defvar edebug-after-index)
2174(defvar edebug-def-mark) ; the mark for the definition 2110(defvar edebug-def-mark) ; the mark for the definition
2175(defvar edebug-freq-count) ; the count of expression visits. 2111(defvar edebug-freq-count) ; the count of expression visits.
2176(defvar edebug-coverage) ; the coverage results of each expression of function. 2112(defvar edebug-coverage) ; the coverage results of each expression of function.
@@ -2186,8 +2122,6 @@ expressions; a `progn' form will be returned enclosing these forms."
2186(defvar edebug-outside-debug-on-error) ; the value of debug-on-error outside 2122(defvar edebug-outside-debug-on-error) ; the value of debug-on-error outside
2187(defvar edebug-outside-debug-on-quit) ; the value of debug-on-quit outside 2123(defvar edebug-outside-debug-on-quit) ; the value of debug-on-quit outside
2188 2124
2189(defvar edebug-outside-overriding-local-map)
2190(defvar edebug-outside-overriding-terminal-local-map)
2191 2125
2192(defvar edebug-outside-pre-command-hook) 2126(defvar edebug-outside-pre-command-hook)
2193(defvar edebug-outside-post-command-hook) 2127(defvar edebug-outside-post-command-hook)
@@ -2196,7 +2130,7 @@ expressions; a `progn' form will be returned enclosing these forms."
2196 2130
2197;;; Handling signals 2131;;; Handling signals
2198 2132
2199(defun edebug-signal (edebug-signal-name edebug-signal-data) 2133(defun edebug-signal (signal-name signal-data)
2200 "Signal an error. Args are SIGNAL-NAME, and associated DATA. 2134 "Signal an error. Args are SIGNAL-NAME, and associated DATA.
2201A signal name is a symbol with an `error-conditions' property 2135A signal name is a symbol with an `error-conditions' property
2202that is a list of condition names. 2136that is a list of condition names.
@@ -2210,19 +2144,18 @@ See `condition-case'.
2210This is the Edebug replacement for the standard `signal'. It should 2144This is the Edebug replacement for the standard `signal'. It should
2211only be active while Edebug is. It checks `debug-on-error' to see 2145only be active while Edebug is. It checks `debug-on-error' to see
2212whether it should call the debugger. When execution is resumed, the 2146whether it should call the debugger. When execution is resumed, the
2213error is signaled again. 2147error is signaled again."
2214\n(fn SIGNAL-NAME DATA)" 2148 (if (and (listp debug-on-error) (memq signal-name debug-on-error))
2215 (if (and (listp debug-on-error) (memq edebug-signal-name debug-on-error)) 2149 (edebug 'error (cons signal-name signal-data)))
2216 (edebug 'error (cons edebug-signal-name edebug-signal-data)))
2217 ;; If we reach here without another non-local exit, then send signal again. 2150 ;; If we reach here without another non-local exit, then send signal again.
2218 ;; i.e. the signal is not continuable, yet. 2151 ;; i.e. the signal is not continuable, yet.
2219 ;; Avoid infinite recursion. 2152 ;; Avoid infinite recursion.
2220 (let ((signal-hook-function nil)) 2153 (let ((signal-hook-function nil))
2221 (signal edebug-signal-name edebug-signal-data))) 2154 (signal signal-name signal-data)))
2222 2155
2223;;; Entering Edebug 2156;;; Entering Edebug
2224 2157
2225(defun edebug-enter (edebug-function edebug-args edebug-body) 2158(defun edebug-enter (function args body)
2226 ;; Entering FUNC. The arguments are ARGS, and the body is BODY. 2159 ;; Entering FUNC. The arguments are ARGS, and the body is BODY.
2227 ;; Setup edebug variables and evaluate BODY. This function is called 2160 ;; Setup edebug variables and evaluate BODY. This function is called
2228 ;; when a function evaluated with edebug-eval-top-level-form is entered. 2161 ;; when a function evaluated with edebug-eval-top-level-form is entered.
@@ -2231,83 +2164,51 @@ error is signaled again.
2231 ;; Is this the first time we are entering edebug since 2164 ;; Is this the first time we are entering edebug since
2232 ;; lower-level recursive-edit command? 2165 ;; lower-level recursive-edit command?
2233 ;; More precisely, this tests whether Edebug is currently active. 2166 ;; More precisely, this tests whether Edebug is currently active.
2234 (if (not edebug-entered) 2167 (let ((edebug-function function))
2235 (let ((edebug-entered t) 2168 (if (not edebug-entered)
2236 ;; Binding max-lisp-eval-depth here is OK, 2169 (let ((edebug-entered t)
2237 ;; but not inside an unwind-protect. 2170 ;; Binding max-lisp-eval-depth here is OK,
2238 ;; Doing it here also keeps it from growing too large. 2171 ;; but not inside an unwind-protect.
2239 (max-lisp-eval-depth (+ 100 max-lisp-eval-depth)) ; too much?? 2172 ;; Doing it here also keeps it from growing too large.
2240 (max-specpdl-size (+ 200 max-specpdl-size)) 2173 (max-lisp-eval-depth (+ 100 max-lisp-eval-depth)) ; too much??
2241 2174 (max-specpdl-size (+ 200 max-specpdl-size))
2242 (debugger edebug-debugger) ; only while edebug is active. 2175
2243 (edebug-outside-debug-on-error debug-on-error) 2176 (debugger edebug-debugger) ; only while edebug is active.
2244 (edebug-outside-debug-on-quit debug-on-quit) 2177 (edebug-outside-debug-on-error debug-on-error)
2245 ;; Binding these may not be the right thing to do. 2178 (edebug-outside-debug-on-quit debug-on-quit)
2246 ;; We want to allow the global values to be changed. 2179 ;; Binding these may not be the right thing to do.
2247 (debug-on-error (or debug-on-error edebug-on-error)) 2180 ;; We want to allow the global values to be changed.
2248 (debug-on-quit edebug-on-quit) 2181 (debug-on-error (or debug-on-error edebug-on-error))
2249 2182 (debug-on-quit edebug-on-quit)
2250 ;; Lexical bindings must be uncompiled for this to work. 2183
2251 (cl-lexical-debug t) 2184 ;; Lexical bindings must be uncompiled for this to work.
2252 2185 (cl-lexical-debug t))
2253 (edebug-outside-overriding-local-map overriding-local-map) 2186 (unwind-protect
2254 (edebug-outside-overriding-terminal-local-map 2187 (let ((signal-hook-function 'edebug-signal))
2255 overriding-terminal-local-map) 2188 (setq edebug-execution-mode (or edebug-next-execution-mode
2256 2189 edebug-initial-mode
2257 ;; Save the outside value of executing macro. (here??) 2190 edebug-execution-mode)
2258 (edebug-outside-executing-macro executing-kbd-macro) 2191 edebug-next-execution-mode nil)
2259 (edebug-outside-pre-command-hook 2192 (edebug-enter function args body))))
2260 (edebug-var-status 'pre-command-hook)) 2193
2261 (edebug-outside-post-command-hook 2194 (let* ((edebug-data (get function 'edebug))
2262 (edebug-var-status 'post-command-hook))) 2195 (edebug-def-mark (car edebug-data)) ; mark at def start
2263 (unwind-protect 2196 (edebug-freq-count (get function 'edebug-freq-count))
2264 (let (;; Don't keep reading from an executing kbd macro 2197 (edebug-coverage (get function 'edebug-coverage))
2265 ;; within edebug unless edebug-continue-kbd-macro is 2198 (edebug-buffer (marker-buffer edebug-def-mark))
2266 ;; non-nil. Again, local binding may not be best. 2199
2267 (executing-kbd-macro 2200 (edebug-stack (cons function edebug-stack))
2268 (if edebug-continue-kbd-macro executing-kbd-macro)) 2201 (edebug-offset-indices (cons 0 edebug-offset-indices))
2269 2202 )
2270 ;; Don't get confused by the user's keymap changes. 2203 (if (get function 'edebug-on-entry)
2271 (overriding-local-map nil) 2204 (progn
2272 (overriding-terminal-local-map nil) 2205 (setq edebug-execution-mode 'step)
2273 2206 (if (eq (get function 'edebug-on-entry) 'temp)
2274 (signal-hook-function 'edebug-signal) 2207 (put function 'edebug-on-entry nil))))
2275 2208 (if edebug-trace
2276 ;; Disable command hooks. This is essential when 2209 (edebug--enter-trace function args body)
2277 ;; a hook function is instrumented - to avoid infinite loop. 2210 (funcall body))
2278 ;; This may be more than we need, however. 2211 ))))
2279 (pre-command-hook nil)
2280 (post-command-hook nil))
2281 (setq edebug-execution-mode (or edebug-next-execution-mode
2282 edebug-initial-mode
2283 edebug-execution-mode)
2284 edebug-next-execution-mode nil)
2285 (edebug-enter edebug-function edebug-args edebug-body))
2286 ;; Reset global variables in case outside value was changed.
2287 (setq executing-kbd-macro edebug-outside-executing-macro)
2288 (edebug-restore-status
2289 'post-command-hook edebug-outside-post-command-hook)
2290 (edebug-restore-status
2291 'pre-command-hook edebug-outside-pre-command-hook)))
2292
2293 (let* ((edebug-data (get edebug-function 'edebug))
2294 (edebug-def-mark (car edebug-data)) ; mark at def start
2295 (edebug-freq-count (get edebug-function 'edebug-freq-count))
2296 (edebug-coverage (get edebug-function 'edebug-coverage))
2297 (edebug-buffer (marker-buffer edebug-def-mark))
2298
2299 (edebug-stack (cons edebug-function edebug-stack))
2300 (edebug-offset-indices (cons 0 edebug-offset-indices))
2301 )
2302 (if (get edebug-function 'edebug-on-entry)
2303 (progn
2304 (setq edebug-execution-mode 'step)
2305 (if (eq (get edebug-function 'edebug-on-entry) 'temp)
2306 (put edebug-function 'edebug-on-entry nil))))
2307 (if edebug-trace
2308 (edebug-enter-trace edebug-body)
2309 (funcall edebug-body))
2310 )))
2311 2212
2312(defun edebug-var-status (var) 2213(defun edebug-var-status (var)
2313 "Return a cons cell describing the status of VAR's current binding. 2214 "Return a cons cell describing the status of VAR's current binding.
@@ -2334,14 +2235,14 @@ STATUS should be a list returned by `edebug-var-status'."
2334 (t 2235 (t
2335 (set var value))))) 2236 (set var value)))))
2336 2237
2337(defun edebug-enter-trace (edebug-body) 2238(defun edebug--enter-trace (function args body)
2338 (let ((edebug-stack-depth (1+ edebug-stack-depth)) 2239 (let ((edebug-stack-depth (1+ edebug-stack-depth))
2339 edebug-result) 2240 edebug-result)
2340 (edebug-print-trace-before 2241 (edebug-print-trace-before
2341 (format "%s args: %s" edebug-function edebug-args)) 2242 (format "%s args: %s" function args))
2342 (prog1 (setq edebug-result (funcall edebug-body)) 2243 (prog1 (setq edebug-result (funcall body))
2343 (edebug-print-trace-after 2244 (edebug-print-trace-after
2344 (format "%s result: %s" edebug-function edebug-result))))) 2245 (format "%s result: %s" function edebug-result)))))
2345 2246
2346(def-edebug-spec edebug-tracing (form body)) 2247(def-edebug-spec edebug-tracing (form body))
2347 2248
@@ -2369,49 +2270,49 @@ MSG is printed after `::::} '."
2369 2270
2370 2271
2371 2272
2372(defun edebug-slow-before (edebug-before-index) 2273(defun edebug-slow-before (before-index)
2373 (unless edebug-active 2274 (unless edebug-active
2374 ;; Debug current function given BEFORE position. 2275 ;; Debug current function given BEFORE position.
2375 ;; Called from functions compiled with edebug-eval-top-level-form. 2276 ;; Called from functions compiled with edebug-eval-top-level-form.
2376 ;; Return the before index. 2277 ;; Return the before index.
2377 (setcar edebug-offset-indices edebug-before-index) 2278 (setcar edebug-offset-indices before-index)
2378 2279
2379 ;; Increment frequency count 2280 ;; Increment frequency count
2380 (aset edebug-freq-count edebug-before-index 2281 (aset edebug-freq-count before-index
2381 (1+ (aref edebug-freq-count edebug-before-index))) 2282 (1+ (aref edebug-freq-count before-index)))
2382 2283
2383 (if (or (not (memq edebug-execution-mode '(Go-nonstop next))) 2284 (if (or (not (memq edebug-execution-mode '(Go-nonstop next)))
2384 (edebug-input-pending-p)) 2285 (input-pending-p))
2385 (edebug-debugger edebug-before-index 'before nil))) 2286 (edebug-debugger before-index 'before nil)))
2386 edebug-before-index) 2287 before-index)
2387 2288
2388(defun edebug-fast-before (edebug-before-index) 2289(defun edebug-fast-before (_before-index)
2389 ;; Do nothing. 2290 ;; Do nothing.
2390 ) 2291 )
2391 2292
2392(defun edebug-slow-after (edebug-before-index edebug-after-index edebug-value) 2293(defun edebug-slow-after (_before-index after-index value)
2393 (if edebug-active 2294 (if edebug-active
2394 edebug-value 2295 value
2395 ;; Debug current function given AFTER position and VALUE. 2296 ;; Debug current function given AFTER position and VALUE.
2396 ;; Called from functions compiled with edebug-eval-top-level-form. 2297 ;; Called from functions compiled with edebug-eval-top-level-form.
2397 ;; Return VALUE. 2298 ;; Return VALUE.
2398 (setcar edebug-offset-indices edebug-after-index) 2299 (setcar edebug-offset-indices after-index)
2399 2300
2400 ;; Increment frequency count 2301 ;; Increment frequency count
2401 (aset edebug-freq-count edebug-after-index 2302 (aset edebug-freq-count after-index
2402 (1+ (aref edebug-freq-count edebug-after-index))) 2303 (1+ (aref edebug-freq-count after-index)))
2403 (if edebug-test-coverage (edebug-update-coverage)) 2304 (if edebug-test-coverage (edebug--update-coverage after-index value))
2404 2305
2405 (if (and (eq edebug-execution-mode 'Go-nonstop) 2306 (if (and (eq edebug-execution-mode 'Go-nonstop)
2406 (not (edebug-input-pending-p))) 2307 (not (input-pending-p)))
2407 ;; Just return result. 2308 ;; Just return result.
2408 edebug-value 2309 value
2409 (edebug-debugger edebug-after-index 'after edebug-value) 2310 (edebug-debugger after-index 'after value)
2410 ))) 2311 )))
2411 2312
2412(defun edebug-fast-after (edebug-before-index edebug-after-index edebug-value) 2313(defun edebug-fast-after (_before-index _after-index value)
2413 ;; Do nothing but return the value. 2314 ;; Do nothing but return the value.
2414 edebug-value) 2315 value)
2415 2316
2416(defun edebug-run-slow () 2317(defun edebug-run-slow ()
2417 (defalias 'edebug-before 'edebug-slow-before) 2318 (defalias 'edebug-before 'edebug-slow-before)
@@ -2425,19 +2326,18 @@ MSG is printed after `::::} '."
2425(edebug-run-slow) 2326(edebug-run-slow)
2426 2327
2427 2328
2428(defun edebug-update-coverage () 2329(defun edebug--update-coverage (after-index value)
2429 (let ((old-result (aref edebug-coverage edebug-after-index))) 2330 (let ((old-result (aref edebug-coverage after-index)))
2430 (cond 2331 (cond
2431 ((eq 'ok-coverage old-result)) 2332 ((eq 'ok-coverage old-result))
2432 ((eq 'unknown old-result) 2333 ((eq 'unknown old-result)
2433 (aset edebug-coverage edebug-after-index edebug-value)) 2334 (aset edebug-coverage after-index value))
2434 ;; Test if a different result. 2335 ;; Test if a different result.
2435 ((not (eq edebug-value old-result)) 2336 ((not (eq value old-result))
2436 (aset edebug-coverage edebug-after-index 'ok-coverage))))) 2337 (aset edebug-coverage after-index 'ok-coverage)))))
2437 2338
2438 2339
2439;; Dynamically declared unbound variables. 2340;; Dynamically declared unbound variables.
2440(defvar edebug-arg-mode) ; the mode, either before, after, or error
2441(defvar edebug-breakpoints) 2341(defvar edebug-breakpoints)
2442(defvar edebug-break-data) ; break data for current function. 2342(defvar edebug-break-data) ; break data for current function.
2443(defvar edebug-break) ; whether a break occurred. 2343(defvar edebug-break) ; whether a break occurred.
@@ -2448,16 +2348,16 @@ MSG is printed after `::::} '."
2448(defvar edebug-global-break-result nil) 2348(defvar edebug-global-break-result nil)
2449 2349
2450 2350
2451(defun edebug-debugger (edebug-offset-index edebug-arg-mode edebug-value) 2351(defun edebug-debugger (offset-index arg-mode value)
2452 (if inhibit-redisplay 2352 (if inhibit-redisplay
2453 ;; Don't really try to enter edebug within an eval from redisplay. 2353 ;; Don't really try to enter edebug within an eval from redisplay.
2454 edebug-value 2354 value
2455 ;; Check breakpoints and pending input. 2355 ;; Check breakpoints and pending input.
2456 ;; If edebug display should be updated, call edebug-display. 2356 ;; If edebug display should be updated, call edebug--display.
2457 ;; Return edebug-value. 2357 ;; Return value.
2458 (let* ( ;; This needs to be here since breakpoints may be changed. 2358 (let* ( ;; This needs to be here since breakpoints may be changed.
2459 (edebug-breakpoints (car (cdr edebug-data))) ; list of breakpoints 2359 (edebug-breakpoints (car (cdr edebug-data))) ; list of breakpoints
2460 (edebug-break-data (assq edebug-offset-index edebug-breakpoints)) 2360 (edebug-break-data (assq offset-index edebug-breakpoints))
2461 (edebug-break-condition (car (cdr edebug-break-data))) 2361 (edebug-break-condition (car (cdr edebug-break-data)))
2462 (edebug-global-break 2362 (edebug-global-break
2463 (if edebug-global-break-condition 2363 (if edebug-global-break-condition
@@ -2468,7 +2368,7 @@ MSG is printed after `::::} '."
2468 (error nil)))) 2368 (error nil))))
2469 (edebug-break)) 2369 (edebug-break))
2470 2370
2471;;; (edebug-trace "exp: %s" edebug-value) 2371 ;;(edebug-trace "exp: %s" value)
2472 ;; Test whether we should break. 2372 ;; Test whether we should break.
2473 (setq edebug-break 2373 (setq edebug-break
2474 (or edebug-global-break 2374 (or edebug-global-break
@@ -2488,11 +2388,10 @@ MSG is printed after `::::} '."
2488 ;; or break, or input is pending, 2388 ;; or break, or input is pending,
2489 (if (or (not (memq edebug-execution-mode '(go continue Continue-fast))) 2389 (if (or (not (memq edebug-execution-mode '(go continue Continue-fast)))
2490 edebug-break 2390 edebug-break
2491 (edebug-input-pending-p)) 2391 (input-pending-p))
2492 (edebug-display)) ; <--------------- display 2392 (edebug--display value offset-index arg-mode)) ; <---------- display
2493 2393
2494 edebug-value 2394 value)))
2495 )))
2496 2395
2497 2396
2498;; window-start now stored with each function. 2397;; window-start now stored with each function.
@@ -2524,8 +2423,9 @@ MSG is printed after `::::} '."
2524;; Emacs 19 adds an arg to mark and mark-marker. 2423;; Emacs 19 adds an arg to mark and mark-marker.
2525(defalias 'edebug-mark-marker 'mark-marker) 2424(defalias 'edebug-mark-marker 'mark-marker)
2526 2425
2426(defvar edebug-outside-unread-command-events)
2527 2427
2528(defun edebug-display () 2428(defun edebug--display (value offset-index arg-mode)
2529 (unless (marker-position edebug-def-mark) 2429 (unless (marker-position edebug-def-mark)
2530 ;; The buffer holding the source has been killed. 2430 ;; The buffer holding the source has been killed.
2531 ;; Let's at least show a backtrace so the user can figure out 2431 ;; Let's at least show a backtrace so the user can figure out
@@ -2534,11 +2434,11 @@ MSG is printed after `::::} '."
2534 ;; Setup windows for edebug, determine mode, maybe enter recursive-edit. 2434 ;; Setup windows for edebug, determine mode, maybe enter recursive-edit.
2535 ;; Uses local variables of edebug-enter, edebug-before, edebug-after 2435 ;; Uses local variables of edebug-enter, edebug-before, edebug-after
2536 ;; and edebug-debugger. 2436 ;; and edebug-debugger.
2537 (let ((edebug-active t) ; for minor mode alist 2437 (let ((edebug-active t) ; For minor mode alist.
2538 (edebug-with-timeout-suspend (with-timeout-suspend)) 2438 (edebug-with-timeout-suspend (with-timeout-suspend))
2539 edebug-stop ; should we enter recursive-edit 2439 edebug-stop ; Should we enter recursive-edit?
2540 (edebug-point (+ edebug-def-mark 2440 (edebug-point (+ edebug-def-mark
2541 (aref (nth 2 edebug-data) edebug-offset-index))) 2441 (aref (nth 2 edebug-data) offset-index)))
2542 edebug-buffer-outside-point ; current point in edebug-buffer 2442 edebug-buffer-outside-point ; current point in edebug-buffer
2543 ;; window displaying edebug-buffer 2443 ;; window displaying edebug-buffer
2544 (edebug-window-data (nth 3 edebug-data)) 2444 (edebug-window-data (nth 3 edebug-data))
@@ -2547,12 +2447,12 @@ MSG is printed after `::::} '."
2547 (edebug-outside-point (point)) 2447 (edebug-outside-point (point))
2548 (edebug-outside-mark (edebug-mark)) 2448 (edebug-outside-mark (edebug-mark))
2549 (edebug-outside-unread-command-events unread-command-events) 2449 (edebug-outside-unread-command-events unread-command-events)
2550 edebug-outside-windows ; window or screen configuration 2450 edebug-outside-windows ; Window or screen configuration.
2551 edebug-buffer-points 2451 edebug-buffer-points
2552 2452
2553 edebug-eval-buffer ; declared here so we can kill it below 2453 edebug-eval-buffer ; Declared here so we can kill it below.
2554 (edebug-eval-result-list (and edebug-eval-list 2454 (eval-result-list (and edebug-eval-list
2555 (edebug-eval-result-list))) 2455 (edebug-eval-result-list)))
2556 edebug-trace-window 2456 edebug-trace-window
2557 edebug-trace-window-start 2457 edebug-trace-window-start
2558 2458
@@ -2565,7 +2465,7 @@ MSG is printed after `::::} '."
2565 (let ((overlay-arrow-position overlay-arrow-position) 2465 (let ((overlay-arrow-position overlay-arrow-position)
2566 (overlay-arrow-string overlay-arrow-string) 2466 (overlay-arrow-string overlay-arrow-string)
2567 (cursor-in-echo-area nil) 2467 (cursor-in-echo-area nil)
2568 (unread-command-events unread-command-events) 2468 (unread-command-events nil)
2569 ;; any others?? 2469 ;; any others??
2570 ) 2470 )
2571 (setq-default cursor-in-non-selected-windows t) 2471 (setq-default cursor-in-non-selected-windows t)
@@ -2573,9 +2473,9 @@ MSG is printed after `::::} '."
2573 (let ((debug-on-error nil)) 2473 (let ((debug-on-error nil))
2574 (error "Buffer defining %s not found" edebug-function))) 2474 (error "Buffer defining %s not found" edebug-function)))
2575 2475
2576 (if (eq 'after edebug-arg-mode) 2476 (if (eq 'after arg-mode)
2577 ;; Compute result string now before windows are modified. 2477 ;; Compute result string now before windows are modified.
2578 (edebug-compute-previous-result edebug-value)) 2478 (edebug-compute-previous-result value))
2579 2479
2580 (if edebug-save-windows 2480 (if edebug-save-windows
2581 ;; Save windows now before we modify them. 2481 ;; Save windows now before we modify them.
@@ -2599,7 +2499,7 @@ MSG is printed after `::::} '."
2599 ;; Now display eval list, if any. 2499 ;; Now display eval list, if any.
2600 ;; This is done after the pop to edebug-buffer 2500 ;; This is done after the pop to edebug-buffer
2601 ;; so that buffer-window correspondence is correct after quitting. 2501 ;; so that buffer-window correspondence is correct after quitting.
2602 (edebug-eval-display edebug-eval-result-list) 2502 (edebug-eval-display eval-result-list)
2603 ;; The evaluation list better not have deleted edebug-window-data. 2503 ;; The evaluation list better not have deleted edebug-window-data.
2604 (select-window (car edebug-window-data)) 2504 (select-window (car edebug-window-data))
2605 (set-buffer edebug-buffer) 2505 (set-buffer edebug-buffer)
@@ -2607,7 +2507,7 @@ MSG is printed after `::::} '."
2607 (setq edebug-buffer-outside-point (point)) 2507 (setq edebug-buffer-outside-point (point))
2608 (goto-char edebug-point) 2508 (goto-char edebug-point)
2609 2509
2610 (if (eq 'before edebug-arg-mode) 2510 (if (eq 'before arg-mode)
2611 ;; Check whether positions are up-to-date. 2511 ;; Check whether positions are up-to-date.
2612 ;; This assumes point is never before symbol. 2512 ;; This assumes point is never before symbol.
2613 (if (not (memq (following-char) '(?\( ?\# ?\` ))) 2513 (if (not (memq (following-char) '(?\( ?\# ?\` )))
@@ -2620,7 +2520,7 @@ MSG is printed after `::::} '."
2620 (edebug-adjust-window (cdr edebug-window-data))) 2520 (edebug-adjust-window (cdr edebug-window-data)))
2621 2521
2622 ;; Test if there is input, not including keyboard macros. 2522 ;; Test if there is input, not including keyboard macros.
2623 (if (edebug-input-pending-p) 2523 (if (input-pending-p)
2624 (progn 2524 (progn
2625 (setq edebug-execution-mode 'step 2525 (setq edebug-execution-mode 'step
2626 edebug-stop t) 2526 edebug-stop t)
@@ -2631,14 +2531,14 @@ MSG is printed after `::::} '."
2631 (edebug-overlay-arrow) 2531 (edebug-overlay-arrow)
2632 2532
2633 (cond 2533 (cond
2634 ((eq 'error edebug-arg-mode) 2534 ((eq 'error arg-mode)
2635 ;; Display error message 2535 ;; Display error message
2636 (setq edebug-execution-mode 'step) 2536 (setq edebug-execution-mode 'step)
2637 (edebug-overlay-arrow) 2537 (edebug-overlay-arrow)
2638 (beep) 2538 (beep)
2639 (if (eq 'quit (car edebug-value)) 2539 (if (eq 'quit (car value))
2640 (message "Quit") 2540 (message "Quit")
2641 (edebug-report-error edebug-value))) 2541 (edebug-report-error value)))
2642 (edebug-break 2542 (edebug-break
2643 (cond 2543 (cond
2644 (edebug-global-break 2544 (edebug-global-break
@@ -2655,41 +2555,40 @@ MSG is printed after `::::} '."
2655 2555
2656 (t (message ""))) 2556 (t (message "")))
2657 2557
2658 (setq unread-command-events nil) 2558 (if (eq 'after arg-mode)
2659 (if (eq 'after edebug-arg-mode)
2660 (progn 2559 (progn
2661 ;; Display result of previous evaluation. 2560 ;; Display result of previous evaluation.
2662 (if (and edebug-break 2561 (if (and edebug-break
2663 (not (eq edebug-execution-mode 'Continue-fast))) 2562 (not (eq edebug-execution-mode 'Continue-fast)))
2664 (edebug-sit-for edebug-sit-for-seconds)) ; Show message. 2563 (sit-for edebug-sit-for-seconds)) ; Show message.
2665 (edebug-previous-result))) 2564 (edebug-previous-result)))
2666 2565
2667 (cond 2566 (cond
2668 (edebug-break 2567 (edebug-break
2669 (cond 2568 (cond
2670 ((eq edebug-execution-mode 'continue) 2569 ((eq edebug-execution-mode 'continue)
2671 (edebug-sit-for edebug-sit-for-seconds)) 2570 (sit-for edebug-sit-for-seconds))
2672 ((eq edebug-execution-mode 'Continue-fast) (edebug-sit-for 0)) 2571 ((eq edebug-execution-mode 'Continue-fast) (sit-for 0))
2673 (t (setq edebug-stop t)))) 2572 (t (setq edebug-stop t))))
2674 ;; not edebug-break 2573 ;; not edebug-break
2675 ((eq edebug-execution-mode 'trace) 2574 ((eq edebug-execution-mode 'trace)
2676 (edebug-sit-for edebug-sit-for-seconds)) ; Force update and pause. 2575 (sit-for edebug-sit-for-seconds)) ; Force update and pause.
2677 ((eq edebug-execution-mode 'Trace-fast) 2576 ((eq edebug-execution-mode 'Trace-fast)
2678 (edebug-sit-for 0))) ; Force update and continue. 2577 (sit-for 0))) ; Force update and continue.
2679 2578
2680 (unwind-protect 2579 (unwind-protect
2681 (if (or edebug-stop 2580 (if (or edebug-stop
2682 (memq edebug-execution-mode '(step next)) 2581 (memq edebug-execution-mode '(step next))
2683 (eq edebug-arg-mode 'error)) 2582 (eq arg-mode 'error))
2684 (progn 2583 (progn
2685 ;; (setq edebug-execution-mode 'step) 2584 ;; (setq edebug-execution-mode 'step)
2686 ;; (edebug-overlay-arrow) ; This doesn't always show up. 2585 ;; (edebug-overlay-arrow) ; This doesn't always show up.
2687 (edebug-recursive-edit))) ; <---------- Recursive edit 2586 (edebug--recursive-edit arg-mode))) ; <----- Recursive edit
2688 2587
2689 ;; Reset the edebug-window-data to whatever it is now. 2588 ;; Reset the edebug-window-data to whatever it is now.
2690 (let ((window (if (eq (window-buffer) edebug-buffer) 2589 (let ((window (if (eq (window-buffer) edebug-buffer)
2691 (selected-window) 2590 (selected-window)
2692 (edebug-get-buffer-window edebug-buffer)))) 2591 (get-buffer-window edebug-buffer))))
2693 ;; Remember window-start for edebug-buffer, if still displayed. 2592 ;; Remember window-start for edebug-buffer, if still displayed.
2694 (if window 2593 (if window
2695 (progn 2594 (progn
@@ -2767,6 +2666,8 @@ MSG is printed after `::::} '."
2767 (goto-char edebug-buffer-outside-point)) 2666 (goto-char edebug-buffer-outside-point))
2768 ;; ... nothing more. 2667 ;; ... nothing more.
2769 ) 2668 )
2669 ;; Could be an option to keep eval display up.
2670 (if edebug-eval-buffer (kill-buffer edebug-eval-buffer))
2770 (with-timeout-unsuspend edebug-with-timeout-suspend) 2671 (with-timeout-unsuspend edebug-with-timeout-suspend)
2771 ;; Reset global variables to outside values in case they were changed. 2672 ;; Reset global variables to outside values in case they were changed.
2772 (setq 2673 (setq
@@ -2804,26 +2705,15 @@ MSG is printed after `::::} '."
2804;; in versions where the variable is *not* built-in. 2705;; in versions where the variable is *not* built-in.
2805 2706
2806;; Emacs 18 FIXME 2707;; Emacs 18 FIXME
2807(defvar edebug-outside-unread-command-char)
2808 2708
2809;; Emacs 19. 2709;; Emacs 19.
2810(defvar edebug-outside-last-command-event) 2710(defvar edebug-outside-last-command-event)
2811(defvar edebug-outside-unread-command-events)
2812(defvar edebug-outside-last-input-event) 2711(defvar edebug-outside-last-input-event)
2813(defvar edebug-outside-last-event-frame) 2712(defvar edebug-outside-last-event-frame)
2814(defvar edebug-outside-last-nonmenu-event) 2713(defvar edebug-outside-last-nonmenu-event)
2815(defvar edebug-outside-track-mouse) 2714(defvar edebug-outside-track-mouse)
2816 2715
2817;; Disable byte compiler warnings about unread-command-char and -event 2716(defun edebug--recursive-edit (arg-mode)
2818;; (maybe works with byte-compile-version 2.22 at least)
2819(defvar edebug-unread-command-char-warning)
2820(defvar edebug-unread-command-event-warning)
2821(eval-when-compile ; FIXME
2822 (setq edebug-unread-command-char-warning
2823 (get 'unread-command-char 'byte-obsolete-variable))
2824 (put 'unread-command-char 'byte-obsolete-variable nil))
2825
2826(defun edebug-recursive-edit ()
2827 ;; Start up a recursive edit inside of edebug. 2717 ;; Start up a recursive edit inside of edebug.
2828 ;; The current buffer is the edebug-buffer, which is put into edebug-mode. 2718 ;; The current buffer is the edebug-buffer, which is put into edebug-mode.
2829 ;; Assume that none of the variables below are buffer-local. 2719 ;; Assume that none of the variables below are buffer-local.
@@ -2844,14 +2734,20 @@ MSG is printed after `::::} '."
2844 2734
2845 (edebug-outside-map (current-local-map)) 2735 (edebug-outside-map (current-local-map))
2846 2736
2847 (edebug-outside-standard-output standard-output) 2737 ;; Save the outside value of executing macro. (here??)
2738 (edebug-outside-executing-macro executing-kbd-macro)
2739 (edebug-outside-pre-command-hook
2740 (edebug-var-status 'pre-command-hook))
2741 (edebug-outside-post-command-hook
2742 (edebug-var-status 'post-command-hook))
2743
2744 (edebug-outside-standard-output standard-output)
2848 (edebug-outside-standard-input standard-input) 2745 (edebug-outside-standard-input standard-input)
2849 (edebug-outside-defining-kbd-macro defining-kbd-macro) 2746 (edebug-outside-defining-kbd-macro defining-kbd-macro)
2850 2747
2851 (edebug-outside-last-command last-command) 2748 (edebug-outside-last-command last-command)
2852 (edebug-outside-this-command this-command) 2749 (edebug-outside-this-command this-command)
2853 2750
2854 (edebug-outside-unread-command-char unread-command-char) ; FIXME
2855 (edebug-outside-current-prefix-arg current-prefix-arg) 2751 (edebug-outside-current-prefix-arg current-prefix-arg)
2856 2752
2857 (edebug-outside-last-input-event last-input-event) 2753 (edebug-outside-last-input-event last-input-event)
@@ -2867,9 +2763,6 @@ MSG is printed after `::::} '."
2867 ;; We could set these to the values for previous edebug call. 2763 ;; We could set these to the values for previous edebug call.
2868 (last-command last-command) 2764 (last-command last-command)
2869 (this-command this-command) 2765 (this-command this-command)
2870
2871 ;; Assume no edebug command sets unread-command-char.
2872 (unread-command-char -1)
2873 (current-prefix-arg nil) 2766 (current-prefix-arg nil)
2874 2767
2875 ;; More for Emacs 19 2768 ;; More for Emacs 19
@@ -2879,7 +2772,20 @@ MSG is printed after `::::} '."
2879 (last-nonmenu-event nil) 2772 (last-nonmenu-event nil)
2880 (track-mouse nil) 2773 (track-mouse nil)
2881 2774
2882 ;; Bind again to outside values. 2775 (standard-output t)
2776 (standard-input t)
2777
2778 ;; Don't keep reading from an executing kbd macro
2779 ;; within edebug unless edebug-continue-kbd-macro is
2780 ;; non-nil. Again, local binding may not be best.
2781 (executing-kbd-macro
2782 (if edebug-continue-kbd-macro executing-kbd-macro))
2783
2784 ;; Don't get confused by the user's keymap changes.
2785 (overriding-local-map nil)
2786 (overriding-terminal-local-map nil)
2787
2788 ;; Bind again to outside values.
2883 (debug-on-error edebug-outside-debug-on-error) 2789 (debug-on-error edebug-outside-debug-on-error)
2884 (debug-on-quit edebug-outside-debug-on-quit) 2790 (debug-on-quit edebug-outside-debug-on-quit)
2885 2791
@@ -2887,11 +2793,17 @@ MSG is printed after `::::} '."
2887 (defining-kbd-macro 2793 (defining-kbd-macro
2888 (if edebug-continue-kbd-macro defining-kbd-macro)) 2794 (if edebug-continue-kbd-macro defining-kbd-macro))
2889 2795
2796 ;; Disable command hooks. This is essential when
2797 ;; a hook function is instrumented - to avoid infinite loop.
2798 ;; This may be more than we need, however.
2799 (pre-command-hook nil)
2800 (post-command-hook nil)
2801
2890 ;; others?? 2802 ;; others??
2891 ) 2803 )
2892 2804
2893 (if (and (eq edebug-execution-mode 'go) 2805 (if (and (eq edebug-execution-mode 'go)
2894 (not (memq edebug-arg-mode '(after error)))) 2806 (not (memq arg-mode '(after error))))
2895 (message "Break")) 2807 (message "Break"))
2896 2808
2897 (setq buffer-read-only t) 2809 (setq buffer-read-only t)
@@ -2905,8 +2817,6 @@ MSG is printed after `::::} '."
2905 (setq signal-hook-function 'edebug-signal) 2817 (setq signal-hook-function 'edebug-signal)
2906 (if edebug-backtrace-buffer 2818 (if edebug-backtrace-buffer
2907 (kill-buffer edebug-backtrace-buffer)) 2819 (kill-buffer edebug-backtrace-buffer))
2908 ;; Could be an option to keep eval display up.
2909 (if edebug-eval-buffer (kill-buffer edebug-eval-buffer))
2910 2820
2911 ;; Remember selected-window after recursive-edit. 2821 ;; Remember selected-window after recursive-edit.
2912 ;; (setq edebug-inside-window (selected-window)) 2822 ;; (setq edebug-inside-window (selected-window))
@@ -2933,7 +2843,6 @@ MSG is printed after `::::} '."
2933 last-command-event edebug-outside-last-command-event 2843 last-command-event edebug-outside-last-command-event
2934 last-command edebug-outside-last-command 2844 last-command edebug-outside-last-command
2935 this-command edebug-outside-this-command 2845 this-command edebug-outside-this-command
2936 unread-command-char edebug-outside-unread-command-char
2937 current-prefix-arg edebug-outside-current-prefix-arg 2846 current-prefix-arg edebug-outside-current-prefix-arg
2938 last-input-event edebug-outside-last-input-event 2847 last-input-event edebug-outside-last-input-event
2939 last-event-frame edebug-outside-last-event-frame 2848 last-event-frame edebug-outside-last-event-frame
@@ -2942,17 +2851,21 @@ MSG is printed after `::::} '."
2942 2851
2943 standard-output edebug-outside-standard-output 2852 standard-output edebug-outside-standard-output
2944 standard-input edebug-outside-standard-input 2853 standard-input edebug-outside-standard-input
2945 defining-kbd-macro edebug-outside-defining-kbd-macro 2854 defining-kbd-macro edebug-outside-defining-kbd-macro)
2946 )) 2855
2947 )) 2856 (setq executing-kbd-macro edebug-outside-executing-macro)
2857 (edebug-restore-status
2858 'post-command-hook edebug-outside-post-command-hook)
2859 (edebug-restore-status
2860 'pre-command-hook edebug-outside-pre-command-hook))))
2948 2861
2949 2862
2950;;; Display related functions 2863;;; Display related functions
2951 2864
2952(defun edebug-adjust-window (old-start) 2865(defun edebug-adjust-window (old-start)
2953 ;; If pos is not visible, adjust current window to fit following context. 2866 ;; If pos is not visible, adjust current window to fit following context.
2954;;; (message "window: %s old-start: %s window-start: %s pos: %s" 2867 ;; (message "window: %s old-start: %s window-start: %s pos: %s"
2955;;; (selected-window) old-start (window-start) (point)) (sit-for 5) 2868 ;; (selected-window) old-start (window-start) (point)) (sit-for 5)
2956 (if (not (pos-visible-in-window-p)) 2869 (if (not (pos-visible-in-window-p))
2957 (progn 2870 (progn
2958 ;; First try old-start 2871 ;; First try old-start
@@ -2960,7 +2873,7 @@ MSG is printed after `::::} '."
2960 (set-window-start (selected-window) old-start)) 2873 (set-window-start (selected-window) old-start))
2961 (if (not (pos-visible-in-window-p)) 2874 (if (not (pos-visible-in-window-p))
2962 (progn 2875 (progn
2963;; (message "resetting window start") (sit-for 2) 2876 ;; (message "resetting window start") (sit-for 2)
2964 (set-window-start 2877 (set-window-start
2965 (selected-window) 2878 (selected-window)
2966 (save-excursion 2879 (save-excursion
@@ -3099,12 +3012,12 @@ before returning. The default is one second."
3099 (current-buffer) (point) 3012 (current-buffer) (point)
3100 (if (marker-buffer (edebug-mark-marker)) 3013 (if (marker-buffer (edebug-mark-marker))
3101 (marker-position (edebug-mark-marker)) "<not set>")) 3014 (marker-position (edebug-mark-marker)) "<not set>"))
3102 (edebug-sit-for arg) 3015 (sit-for arg)
3103 (edebug-pop-to-buffer edebug-buffer (car edebug-window-data))))) 3016 (edebug-pop-to-buffer edebug-buffer (car edebug-window-data)))))
3104 3017
3105 3018
3106;; Joe Wells, here is a start at your idea of adding a buffer to the internal 3019;; Joe Wells, here is a start at your idea of adding a buffer to the internal
3107;; display list. Still need to use this list in edebug-display. 3020;; display list. Still need to use this list in edebug--display.
3108 3021
3109'(defvar edebug-display-buffer-list nil 3022'(defvar edebug-display-buffer-list nil
3110 "List of buffers that edebug will display when it is active.") 3023 "List of buffers that edebug will display when it is active.")
@@ -3426,7 +3339,7 @@ function or macro is called, Edebug will be called there as well."
3426 (save-excursion 3339 (save-excursion
3427 (down-list 1) 3340 (down-list 1)
3428 (if (looking-at "\(") 3341 (if (looking-at "\(")
3429 (edebug-form-data-name 3342 (edebug--form-data-name
3430 (edebug-get-form-data-entry (point))) 3343 (edebug-get-form-data-entry (point)))
3431 (edebug-original-read (current-buffer)))))) 3344 (edebug-original-read (current-buffer))))))
3432 (edebug-instrument-function func)))) 3345 (edebug-instrument-function func))))
@@ -3539,11 +3452,10 @@ edebug-mode."
3539 3452
3540;;; Evaluation of expressions 3453;;; Evaluation of expressions
3541 3454
3542(def-edebug-spec edebug-outside-excursion t)
3543
3544(defmacro edebug-outside-excursion (&rest body) 3455(defmacro edebug-outside-excursion (&rest body)
3545 "Evaluate an expression list in the outside context. 3456 "Evaluate an expression list in the outside context.
3546Return the result of the last expression." 3457Return the result of the last expression."
3458 (declare (debug t))
3547 `(save-excursion ; of current-buffer 3459 `(save-excursion ; of current-buffer
3548 (if edebug-save-windows 3460 (if edebug-save-windows
3549 (progn 3461 (progn
@@ -3562,7 +3474,6 @@ Return the result of the last expression."
3562 (last-command-event edebug-outside-last-command-event) 3474 (last-command-event edebug-outside-last-command-event)
3563 (last-command edebug-outside-last-command) 3475 (last-command edebug-outside-last-command)
3564 (this-command edebug-outside-this-command) 3476 (this-command edebug-outside-this-command)
3565 (unread-command-char edebug-outside-unread-command-char)
3566 (unread-command-events edebug-outside-unread-command-events) 3477 (unread-command-events edebug-outside-unread-command-events)
3567 (current-prefix-arg edebug-outside-current-prefix-arg) 3478 (current-prefix-arg edebug-outside-current-prefix-arg)
3568 (last-input-event edebug-outside-last-input-event) 3479 (last-input-event edebug-outside-last-input-event)
@@ -3578,7 +3489,7 @@ Return the result of the last expression."
3578 (pre-command-hook (cdr edebug-outside-pre-command-hook)) 3489 (pre-command-hook (cdr edebug-outside-pre-command-hook))
3579 (post-command-hook (cdr edebug-outside-post-command-hook)) 3490 (post-command-hook (cdr edebug-outside-post-command-hook))
3580 3491
3581 ;; See edebug-display 3492 ;; See edebug-display.
3582 (overlay-arrow-position edebug-outside-o-a-p) 3493 (overlay-arrow-position edebug-outside-o-a-p)
3583 (overlay-arrow-string edebug-outside-o-a-s) 3494 (overlay-arrow-string edebug-outside-o-a-s)
3584 (cursor-in-echo-area edebug-outside-c-i-e-a) 3495 (cursor-in-echo-area edebug-outside-c-i-e-a)
@@ -3602,7 +3513,6 @@ Return the result of the last expression."
3602 edebug-outside-last-command-event last-command-event 3513 edebug-outside-last-command-event last-command-event
3603 edebug-outside-last-command last-command 3514 edebug-outside-last-command last-command
3604 edebug-outside-this-command this-command 3515 edebug-outside-this-command this-command
3605 edebug-outside-unread-command-char unread-command-char
3606 edebug-outside-unread-command-events unread-command-events 3516 edebug-outside-unread-command-events unread-command-events
3607 edebug-outside-current-prefix-arg current-prefix-arg 3517 edebug-outside-current-prefix-arg current-prefix-arg
3608 edebug-outside-last-input-event last-input-event 3518 edebug-outside-last-input-event last-input-event
@@ -3633,18 +3543,19 @@ Return the result of the last expression."
3633 3543
3634(defvar cl-debug-env) ; defined in cl; non-nil when lexical env used. 3544(defvar cl-debug-env) ; defined in cl; non-nil when lexical env used.
3635 3545
3636(defun edebug-eval (edebug-expr) 3546(defun edebug-eval (expr)
3637 ;; Are there cl lexical variables active? 3547 ;; Are there cl lexical variables active?
3638 (eval (if (bound-and-true-p cl-debug-env) 3548 (eval (if (and (bound-and-true-p cl-debug-env)
3639 (cl-macroexpand-all edebug-expr cl-debug-env) 3549 (fboundp 'cl-macroexpand-all))
3640 edebug-expr) 3550 (cl-macroexpand-all expr cl-debug-env)
3551 expr)
3641 lexical-binding)) 3552 lexical-binding))
3642 3553
3643(defun edebug-safe-eval (edebug-expr) 3554(defun edebug-safe-eval (expr)
3644 ;; Evaluate EXPR safely. 3555 ;; Evaluate EXPR safely.
3645 ;; If there is an error, a string is returned describing the error. 3556 ;; If there is an error, a string is returned describing the error.
3646 (condition-case edebug-err 3557 (condition-case edebug-err
3647 (edebug-eval edebug-expr) 3558 (edebug-eval expr)
3648 (error (edebug-format "%s: %s" ;; could 3559 (error (edebug-format "%s: %s" ;; could
3649 (get (car edebug-err) 'error-message) 3560 (get (car edebug-err) 'error-message)
3650 (car (cdr edebug-err)))))) 3561 (car (cdr edebug-err))))))
@@ -3652,17 +3563,17 @@ Return the result of the last expression."
3652;;; Printing 3563;;; Printing
3653 3564
3654 3565
3655(defun edebug-report-error (edebug-value) 3566(defun edebug-report-error (value)
3656 ;; Print an error message like command level does. 3567 ;; Print an error message like command level does.
3657 ;; This also prints the error name if it has no error-message. 3568 ;; This also prints the error name if it has no error-message.
3658 (message "%s: %s" 3569 (message "%s: %s"
3659 (or (get (car edebug-value) 'error-message) 3570 (or (get (car value) 'error-message)
3660 (format "peculiar error (%s)" (car edebug-value))) 3571 (format "peculiar error (%s)" (car value)))
3661 (mapconcat (function (lambda (edebug-arg) 3572 (mapconcat (function (lambda (edebug-arg)
3662 ;; continuing after an error may 3573 ;; continuing after an error may
3663 ;; complain about edebug-arg. why?? 3574 ;; complain about edebug-arg. why??
3664 (prin1-to-string edebug-arg))) 3575 (prin1-to-string edebug-arg)))
3665 (cdr edebug-value) ", "))) 3576 (cdr value) ", ")))
3666 3577
3667(defvar print-readably) ; defined by lemacs 3578(defvar print-readably) ; defined by lemacs
3668;; Alternatively, we could change the definition of 3579;; Alternatively, we could change the definition of
@@ -3678,14 +3589,14 @@ Return the result of the last expression."
3678 (edebug-prin1-to-string value) 3589 (edebug-prin1-to-string value)
3679 (error "#Apparently circular structure#")))) 3590 (error "#Apparently circular structure#"))))
3680 3591
3681(defun edebug-compute-previous-result (edebug-previous-value) 3592(defun edebug-compute-previous-result (previous-value)
3682 (if edebug-unwrap-results 3593 (if edebug-unwrap-results
3683 (setq edebug-previous-value 3594 (setq previous-value
3684 (edebug-unwrap* edebug-previous-value))) 3595 (edebug-unwrap* previous-value)))
3685 (setq edebug-previous-result 3596 (setq edebug-previous-result
3686 (concat "Result: " 3597 (concat "Result: "
3687 (edebug-safe-prin1-to-string edebug-previous-value) 3598 (edebug-safe-prin1-to-string previous-value)
3688 (eval-expression-print-format edebug-previous-value)))) 3599 (eval-expression-print-format previous-value))))
3689 3600
3690(defun edebug-previous-result () 3601(defun edebug-previous-result ()
3691 "Print the previous result." 3602 "Print the previous result."
@@ -3700,7 +3611,7 @@ Return the result of the last expression."
3700(defalias 'edebug-format 'format) 3611(defalias 'edebug-format 'format)
3701(defalias 'edebug-message 'message) 3612(defalias 'edebug-message 'message)
3702 3613
3703(defun edebug-eval-expression (edebug-expr) 3614(defun edebug-eval-expression (expr)
3704 "Evaluate an expression in the outside environment. 3615 "Evaluate an expression in the outside environment.
3705If interactive, prompt for the expression. 3616If interactive, prompt for the expression.
3706Print result in minibuffer." 3617Print result in minibuffer."
@@ -3709,7 +3620,7 @@ Print result in minibuffer."
3709 'read-expression-history))) 3620 'read-expression-history)))
3710 (princ 3621 (princ
3711 (edebug-outside-excursion 3622 (edebug-outside-excursion
3712 (setq values (cons (edebug-eval edebug-expr) values)) 3623 (setq values (cons (edebug-eval expr) values))
3713 (concat (edebug-safe-prin1-to-string (car values)) 3624 (concat (edebug-safe-prin1-to-string (car values))
3714 (eval-expression-print-format (car values)))))) 3625 (eval-expression-print-format (car values))))))
3715 3626
@@ -3723,14 +3634,14 @@ Print value in minibuffer."
3723 "Evaluate sexp before point in outside environment; insert value. 3634 "Evaluate sexp before point in outside environment; insert value.
3724This prints the value into current buffer." 3635This prints the value into current buffer."
3725 (interactive) 3636 (interactive)
3726 (let* ((edebug-form (edebug-last-sexp)) 3637 (let* ((form (edebug-last-sexp))
3727 (edebug-result-string 3638 (result-string
3728 (edebug-outside-excursion 3639 (edebug-outside-excursion
3729 (edebug-safe-prin1-to-string (edebug-safe-eval edebug-form)))) 3640 (edebug-safe-prin1-to-string (edebug-safe-eval form))))
3730 (standard-output (current-buffer))) 3641 (standard-output (current-buffer)))
3731 (princ "\n") 3642 (princ "\n")
3732 ;; princ the string to get rid of quotes. 3643 ;; princ the string to get rid of quotes.
3733 (princ edebug-result-string) 3644 (princ result-string)
3734 (princ "\n") 3645 (princ "\n")
3735 )) 3646 ))
3736 3647
@@ -3922,44 +3833,38 @@ Options:
3922 (edebug-trace nil)) 3833 (edebug-trace nil))
3923 (mapcar 'edebug-safe-eval edebug-eval-list))) 3834 (mapcar 'edebug-safe-eval edebug-eval-list)))
3924 3835
3925(defun edebug-eval-display-list (edebug-eval-result-list) 3836(defun edebug-eval-display-list (eval-result-list)
3926 ;; Assumes edebug-eval-buffer exists. 3837 ;; Assumes edebug-eval-buffer exists.
3927 (let ((edebug-eval-list-temp edebug-eval-list) 3838 (let ((standard-output edebug-eval-buffer)
3928 (standard-output edebug-eval-buffer)
3929 (edebug-comment-line 3839 (edebug-comment-line
3930 (format ";%s\n" (make-string (- (window-width) 2) ?-)))) 3840 (format ";%s\n" (make-string (- (window-width) 2) ?-))))
3931 (set-buffer edebug-eval-buffer) 3841 (set-buffer edebug-eval-buffer)
3932 (erase-buffer) 3842 (erase-buffer)
3933 (while edebug-eval-list-temp 3843 (dolist (exp edebug-eval-list)
3934 (prin1 (car edebug-eval-list-temp)) (terpri) 3844 (prin1 exp) (terpri)
3935 (prin1 (car edebug-eval-result-list)) (terpri) 3845 (prin1 (pop eval-result-list)) (terpri)
3936 (princ edebug-comment-line) 3846 (princ edebug-comment-line))
3937 (setq edebug-eval-list-temp (cdr edebug-eval-list-temp))
3938 (setq edebug-eval-result-list (cdr edebug-eval-result-list)))
3939 (edebug-pop-to-buffer edebug-eval-buffer) 3847 (edebug-pop-to-buffer edebug-eval-buffer)
3940 )) 3848 ))
3941 3849
3942(defun edebug-create-eval-buffer () 3850(defun edebug-create-eval-buffer ()
3943 (if (not (and edebug-eval-buffer (buffer-name edebug-eval-buffer))) 3851 (unless (and edebug-eval-buffer (buffer-name edebug-eval-buffer))
3944 (progn 3852 (set-buffer (setq edebug-eval-buffer (get-buffer-create "*edebug*")))
3945 (set-buffer (setq edebug-eval-buffer (get-buffer-create "*edebug*"))) 3853 (edebug-eval-mode)))
3946 (edebug-eval-mode))))
3947 3854
3948;; Should generalize this to be callable outside of edebug 3855;; Should generalize this to be callable outside of edebug
3949;; with calls in user functions, e.g. (edebug-eval-display) 3856;; with calls in user functions, e.g. (edebug-eval-display)
3950 3857
3951(defun edebug-eval-display (edebug-eval-result-list) 3858(defun edebug-eval-display (eval-result-list)
3952 "Display expressions and evaluations in EDEBUG-EVAL-RESULT-LIST. 3859 "Display expressions and evaluations in EVAL-RESULT-LIST.
3953It modifies the context by popping up the eval display." 3860It modifies the context by popping up the eval display."
3954 (if edebug-eval-result-list 3861 (when eval-result-list
3955 (progn 3862 (edebug-create-eval-buffer)
3956 (edebug-create-eval-buffer) 3863 (edebug-eval-display-list eval-result-list)))
3957 (edebug-eval-display-list edebug-eval-result-list)
3958 )))
3959 3864
3960(defun edebug-eval-redisplay () 3865(defun edebug-eval-redisplay ()
3961 "Redisplay eval list in outside environment. 3866 "Redisplay eval list in outside environment.
3962May only be called from within `edebug-recursive-edit'." 3867May only be called from within `edebug--recursive-edit'."
3963 (edebug-create-eval-buffer) 3868 (edebug-create-eval-buffer)
3964 (edebug-outside-excursion 3869 (edebug-outside-excursion
3965 (edebug-eval-display-list (edebug-eval-result-list)) 3870 (edebug-eval-display-list (edebug-eval-result-list))
@@ -3983,7 +3888,7 @@ May only be called from within `edebug-recursive-edit'."
3983 (if (not (eobp)) 3888 (if (not (eobp))
3984 (progn 3889 (progn
3985 (forward-sexp 1) 3890 (forward-sexp 1)
3986 (setq new-list (cons (edebug-last-sexp) new-list)))) 3891 (push (edebug-last-sexp) new-list)))
3987 3892
3988 (while (re-search-forward "^;" nil t) 3893 (while (re-search-forward "^;" nil t)
3989 (forward-line 1) 3894 (forward-line 1)
@@ -3992,7 +3897,7 @@ May only be called from within `edebug-recursive-edit'."
3992 (not (eobp))) 3897 (not (eobp)))
3993 (progn 3898 (progn
3994 (forward-sexp 1) 3899 (forward-sexp 1)
3995 (setq new-list (cons (edebug-last-sexp) new-list))))) 3900 (push (edebug-last-sexp) new-list))))
3996 3901
3997 (setq edebug-eval-list (nreverse new-list)) 3902 (setq edebug-eval-list (nreverse new-list))
3998 (edebug-eval-redisplay) 3903 (edebug-eval-redisplay)
@@ -4021,8 +3926,8 @@ May only be called from within `edebug-recursive-edit'."
4021 (define-key map "\C-c\C-u" 'edebug-update-eval-list) 3926 (define-key map "\C-c\C-u" 'edebug-update-eval-list)
4022 (define-key map "\C-x\C-e" 'edebug-eval-last-sexp) 3927 (define-key map "\C-x\C-e" 'edebug-eval-last-sexp)
4023 (define-key map "\C-j" 'edebug-eval-print-last-sexp) 3928 (define-key map "\C-j" 'edebug-eval-print-last-sexp)
4024 map) 3929 map)
4025"Keymap for Edebug Eval mode. Superset of Lisp Interaction mode.") 3930 "Keymap for Edebug Eval mode. Superset of Lisp Interaction mode.")
4026 3931
4027(put 'edebug-eval-mode 'mode-class 'special) 3932(put 'edebug-eval-mode 'mode-class 'special)
4028 3933
@@ -4049,32 +3954,32 @@ Global commands prefixed by `global-edebug-prefix':
4049;; since they depend on the backtrace looking a certain way. But 3954;; since they depend on the backtrace looking a certain way. But
4050;; edebug is not dependent on this, yet. 3955;; edebug is not dependent on this, yet.
4051 3956
4052(defun edebug (&optional edebug-arg-mode &rest debugger-args) 3957(defun edebug (&optional arg-mode &rest args)
4053 "Replacement for `debug'. 3958 "Replacement for `debug'.
4054If we are running an edebugged function, show where we last were. 3959If we are running an edebugged function, show where we last were.
4055Otherwise call `debug' normally." 3960Otherwise call `debug' normally."
4056;; (message "entered: %s depth: %s edebug-recursion-depth: %s" 3961 ;;(message "entered: %s depth: %s edebug-recursion-depth: %s"
4057;; edebug-entered (recursion-depth) edebug-recursion-depth) (sit-for 1) 3962 ;; edebug-entered (recursion-depth) edebug-recursion-depth) (sit-for 1)
4058 (if (and edebug-entered ; anything active? 3963 (if (and edebug-entered ; anything active?
4059 (eq (recursion-depth) edebug-recursion-depth)) 3964 (eq (recursion-depth) edebug-recursion-depth))
4060 (let (;; Where were we before the error occurred? 3965 (let (;; Where were we before the error occurred?
4061 (edebug-offset-index (car edebug-offset-indices)) 3966 (offset-index (car edebug-offset-indices))
4062 ;; Bind variables required by edebug-display 3967 (value (car args))
4063 (edebug-value (car debugger-args)) 3968 ;; Bind variables required by edebug--display.
4064 edebug-breakpoints 3969 edebug-breakpoints
4065 edebug-break-data 3970 edebug-break-data
4066 edebug-break-condition 3971 edebug-break-condition
4067 edebug-global-break 3972 edebug-global-break
4068 (edebug-break (null edebug-arg-mode)) ;; if called explicitly 3973 (edebug-break (null arg-mode)) ;; If called explicitly.
4069 ) 3974 )
4070 (edebug-display) 3975 (edebug--display value offset-index arg-mode)
4071 (if (eq edebug-arg-mode 'error) 3976 (if (eq arg-mode 'error)
4072 nil 3977 nil
4073 edebug-value)) 3978 value))
4074 3979
4075 ;; Otherwise call debug normally. 3980 ;; Otherwise call debug normally.
4076 ;; Still need to remove extraneous edebug calls from stack. 3981 ;; Still need to remove extraneous edebug calls from stack.
4077 (apply 'debug edebug-arg-mode debugger-args) 3982 (apply 'debug arg-mode args)
4078 )) 3983 ))
4079 3984
4080 3985
@@ -4085,7 +3990,7 @@ Otherwise call `debug' normally."
4085 (null (buffer-name edebug-backtrace-buffer))) 3990 (null (buffer-name edebug-backtrace-buffer)))
4086 (setq edebug-backtrace-buffer 3991 (setq edebug-backtrace-buffer
4087 (generate-new-buffer "*Backtrace*")) 3992 (generate-new-buffer "*Backtrace*"))
4088 ;; else, could just display edebug-backtrace-buffer 3993 ;; Else, could just display edebug-backtrace-buffer.
4089 ) 3994 )
4090 (with-output-to-temp-buffer (buffer-name edebug-backtrace-buffer) 3995 (with-output-to-temp-buffer (buffer-name edebug-backtrace-buffer)
4091 (setq edebug-backtrace-buffer standard-output) 3996 (setq edebug-backtrace-buffer standard-output)
@@ -4107,7 +4012,7 @@ Otherwise call `debug' normally."
4107 (beginning-of-line) 4012 (beginning-of-line)
4108 (cond 4013 (cond
4109 ((looking-at "^ \(edebug-after") 4014 ((looking-at "^ \(edebug-after")
4110 ;; Previous lines may contain code, so just delete this line 4015 ;; Previous lines may contain code, so just delete this line.
4111 (setq last-ok-point (point)) 4016 (setq last-ok-point (point))
4112 (forward-line 1) 4017 (forward-line 1)
4113 (delete-region last-ok-point (point))) 4018 (delete-region last-ok-point (point)))
@@ -4125,15 +4030,15 @@ Otherwise call `debug' normally."
4125 "In buffer BUF-NAME, display FMT and ARGS at the end and make it visible. 4030 "In buffer BUF-NAME, display FMT and ARGS at the end and make it visible.
4126The buffer is created if it does not exist. 4031The buffer is created if it does not exist.
4127You must include newlines in FMT to break lines, but one newline is appended." 4032You must include newlines in FMT to break lines, but one newline is appended."
4128;; e.g. 4033 ;; e.g.
4129;; (edebug-trace-display "*trace-point*" 4034 ;; (edebug-trace-display "*trace-point*"
4130;; "saving: point = %s window-start = %s" 4035 ;; "saving: point = %s window-start = %s"
4131;; (point) (window-start)) 4036 ;; (point) (window-start))
4132 (let* ((oldbuf (current-buffer)) 4037 (let* ((oldbuf (current-buffer))
4133 (selected-window (selected-window)) 4038 (selected-window (selected-window))
4134 (buffer (get-buffer-create buf-name)) 4039 (buffer (get-buffer-create buf-name))
4135 buf-window) 4040 buf-window)
4136;; (message "before pop-to-buffer") (sit-for 1) 4041 ;; (message "before pop-to-buffer") (sit-for 1)
4137 (edebug-pop-to-buffer buffer) 4042 (edebug-pop-to-buffer buffer)
4138 (setq truncate-lines t) 4043 (setq truncate-lines t)
4139 (setq buf-window (selected-window)) 4044 (setq buf-window (selected-window))
@@ -4143,8 +4048,8 @@ You must include newlines in FMT to break lines, but one newline is appended."
4143 (vertical-motion (- 1 (window-height))) 4048 (vertical-motion (- 1 (window-height)))
4144 (set-window-start buf-window (point)) 4049 (set-window-start buf-window (point))
4145 (goto-char (point-max)) 4050 (goto-char (point-max))
4146;; (set-window-point buf-window (point)) 4051 ;; (set-window-point buf-window (point))
4147;; (edebug-sit-for 0) 4052 ;; (sit-for 0)
4148 (bury-buffer buffer) 4053 (bury-buffer buffer)
4149 (select-window selected-window) 4054 (select-window selected-window)
4150 (set-buffer oldbuf)) 4055 (set-buffer oldbuf))
@@ -4207,8 +4112,8 @@ reinstrument it."
4207 ;; Insert all the indices for this line. 4112 ;; Insert all the indices for this line.
4208 (forward-line 1) 4113 (forward-line 1)
4209 (setq start-of-count-line (point) 4114 (setq start-of-count-line (point)
4210 first-index i ; really last index for line above this one. 4115 first-index i ; Really, last index for line above this one.
4211 last-count -1) ; cause first count to always appear. 4116 last-count -1) ; Cause first count to always appear.
4212 (insert ";#") 4117 (insert ";#")
4213 ;; i == first-index still 4118 ;; i == first-index still
4214 (while (<= (setq i (1+ i)) last-index) 4119 (while (<= (setq i (1+ i)) last-index)
@@ -4240,7 +4145,8 @@ It is removed when you hit any char."
4240 (let ((buffer-read-only nil)) 4145 (let ((buffer-read-only nil))
4241 (undo-boundary) 4146 (undo-boundary)
4242 (edebug-display-freq-count) 4147 (edebug-display-freq-count)
4243 (setq unread-command-char (read-char)) 4148 (setq unread-command-events
4149 (append unread-command-events (list (read-event))))
4244 ;; Yuck! This doesn't seem to work at all for me. 4150 ;; Yuck! This doesn't seem to work at all for me.
4245 (undo))) 4151 (undo)))
4246 4152
@@ -4352,87 +4258,6 @@ With prefix argument, make it a temporary breakpoint."
4352 4258
4353(easy-menu-define edebug-menu edebug-mode-map "Edebug menus" edebug-mode-menus) 4259(easy-menu-define edebug-menu edebug-mode-map "Edebug menus" edebug-mode-menus)
4354 4260
4355;;; Byte-compiler
4356
4357;; Extension for bytecomp to resolve undefined function references.
4358;; Requires new byte compiler.
4359
4360;; Reenable byte compiler warnings about unread-command-char and -event.
4361;; Disabled before edebug-recursive-edit.
4362(eval-when-compile
4363 (if edebug-unread-command-char-warning
4364 (put 'unread-command-char 'byte-obsolete-variable
4365 edebug-unread-command-char-warning)))
4366
4367(eval-when-compile
4368 ;; The body of eval-when-compile seems to get evaluated with eval-defun.
4369 ;; We only want to evaluate when actually byte compiling.
4370 ;; But it is OK to evaluate as long as byte-compiler has been loaded.
4371 (if (featurep 'byte-compile) (progn
4372
4373 (defun byte-compile-resolve-functions (funcs)
4374 "Say it is OK for the named functions to be unresolved."
4375 (mapc
4376 (function
4377 (lambda (func)
4378 (setq byte-compile-unresolved-functions
4379 (delq (assq func byte-compile-unresolved-functions)
4380 byte-compile-unresolved-functions))))
4381 funcs)
4382 nil)
4383
4384 '(defun byte-compile-resolve-free-references (vars)
4385 "Say it is OK for the named variables to be referenced."
4386 (mapcar
4387 (function
4388 (lambda (var)
4389 (setq byte-compile-free-references
4390 (delq var byte-compile-free-references))))
4391 vars)
4392 nil)
4393
4394 '(defun byte-compile-resolve-free-assignments (vars)
4395 "Say it is OK for the named variables to be assigned."
4396 (mapcar
4397 (function
4398 (lambda (var)
4399 (setq byte-compile-free-assignments
4400 (delq var byte-compile-free-assignments))))
4401 vars)
4402 nil)
4403
4404 (byte-compile-resolve-functions
4405 '(reporter-submit-bug-report
4406 edebug-gensym ;; also in cl.el
4407 ;; Interfaces to standard functions.
4408 edebug-original-eval-defun
4409 edebug-original-read
4410 edebug-get-buffer-window
4411 edebug-mark
4412 edebug-mark-marker
4413 edebug-input-pending-p
4414 edebug-sit-for
4415 edebug-prin1-to-string
4416 edebug-format
4417 ;; lemacs
4418 zmacs-deactivate-region
4419 popup-menu
4420 ;; CL
4421 cl-macroexpand-all
4422 ;; And believe it or not, the byte compiler doesn't know about:
4423 byte-compile-resolve-functions
4424 ))
4425
4426 '(byte-compile-resolve-free-references
4427 '(read-expression-history
4428 read-expression-map))
4429
4430 '(byte-compile-resolve-free-assignments
4431 '(read-expression-history))
4432
4433 )))
4434
4435
4436;;; Autoloading of Edebug accessories 4261;;; Autoloading of Edebug accessories
4437 4262
4438;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu 4263;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 666e31f690f..64aac4b81db 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -431,6 +431,61 @@ if that value is non-nil."
431 (add-hook 'completion-at-point-functions 431 (add-hook 'completion-at-point-functions
432 'lisp-completion-at-point nil 'local)) 432 'lisp-completion-at-point nil 'local))
433 433
434;;; Emacs Lisp Byte-Code mode
435
436(eval-and-compile
437 (defconst emacs-list-byte-code-comment-re
438 (concat "\\(#\\)@\\([0-9]+\\) "
439 ;; Make sure it's a docstring and not a lazy-loaded byte-code.
440 "\\(?:[^(]\\|([^\"]\\)")))
441
442(defun emacs-lisp-byte-code-comment (end &optional _point)
443 "Try to syntactically mark the #@NNN ....^_ docstrings in byte-code files."
444 (let ((ppss (syntax-ppss)))
445 (when (and (nth 4 ppss)
446 (eq (char-after (nth 8 ppss)) ?#))
447 (let* ((n (save-excursion
448 (goto-char (nth 8 ppss))
449 (when (looking-at emacs-list-byte-code-comment-re)
450 (string-to-number (match-string 2)))))
451 ;; `maxdiff' tries to make sure the loop below terminates.
452 (maxdiff n))
453 (when n
454 (let* ((bchar (match-end 2))
455 (b (position-bytes bchar)))
456 (goto-char (+ b n))
457 (while (let ((diff (- (position-bytes (point)) b n)))
458 (unless (zerop diff)
459 (when (> diff maxdiff) (setq diff maxdiff))
460 (forward-char (- diff))
461 (setq maxdiff (if (> diff 0) diff
462 (max (1- maxdiff) 1)))
463 t))))
464 (if (<= (point) end)
465 (put-text-property (1- (point)) (point)
466 'syntax-table
467 (string-to-syntax "> b"))
468 (goto-char end)))))))
469
470(defun emacs-lisp-byte-code-syntax-propertize (start end)
471 (emacs-lisp-byte-code-comment end (point))
472 (funcall
473 (syntax-propertize-rules
474 (emacs-list-byte-code-comment-re
475 (1 (prog1 "< b" (emacs-lisp-byte-code-comment end (point))))))
476 start end))
477
478(add-to-list 'auto-mode-alist '("\\.elc\\'" . emacs-lisp-byte-code-mode))
479(define-derived-mode emacs-lisp-byte-code-mode emacs-lisp-mode
480 "Elisp-Byte-Code"
481 "Major mode for *.elc files."
482 ;; TODO: Add way to disassemble byte-code under point.
483 (setq-local open-paren-in-column-0-is-defun-start nil)
484 (setq-local syntax-propertize-function
485 #'emacs-lisp-byte-code-syntax-propertize))
486
487;;; Generic Lisp mode.
488
434(defvar lisp-mode-map 489(defvar lisp-mode-map
435 (let ((map (make-sparse-keymap)) 490 (let ((map (make-sparse-keymap))
436 (menu-map (make-sparse-keymap "Lisp"))) 491 (menu-map (make-sparse-keymap "Lisp")))
@@ -730,10 +785,12 @@ POS specifies the starting position where EXP was found and defaults to point."
730 (let ((vars ())) 785 (let ((vars ()))
731 (goto-char (point-min)) 786 (goto-char (point-min))
732 (while (re-search-forward 787 (while (re-search-forward
733 "^(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)" 788 "(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)"
734 pos t) 789 pos t)
735 (let ((var (intern (match-string 1)))) 790 (let ((var (intern (match-string 1))))
736 (unless (special-variable-p var) 791 (and (not (special-variable-p var))
792 (save-excursion
793 (zerop (car (syntax-ppss (match-beginning 0)))))
737 (push var vars)))) 794 (push var vars))))
738 `(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp))))) 795 `(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp)))))
739 796
@@ -820,7 +877,6 @@ if it already has a value.\)
820 877
821With argument, insert value in current buffer after the defun. 878With argument, insert value in current buffer after the defun.
822Return the result of evaluation." 879Return the result of evaluation."
823 (interactive "P")
824 ;; FIXME: the print-length/level bindings should only be applied while 880 ;; FIXME: the print-length/level bindings should only be applied while
825 ;; printing, not while evaluating. 881 ;; printing, not while evaluating.
826 (let ((debug-on-error eval-expression-debug-on-error) 882 (let ((debug-on-error eval-expression-debug-on-error)
@@ -925,6 +981,7 @@ rigidly along with this one."
925 (if (or (null indent) (looking-at "\\s<\\s<\\s<")) 981 (if (or (null indent) (looking-at "\\s<\\s<\\s<"))
926 ;; Don't alter indentation of a ;;; comment line 982 ;; Don't alter indentation of a ;;; comment line
927 ;; or a line that starts in a string. 983 ;; or a line that starts in a string.
984 ;; FIXME: inconsistency: comment-indent moves ;;; to column 0.
928 (goto-char (- (point-max) pos)) 985 (goto-char (- (point-max) pos))
929 (if (and (looking-at "\\s<") (not (looking-at "\\s<\\s<"))) 986 (if (and (looking-at "\\s<") (not (looking-at "\\s<\\s<")))
930 ;; Single-semicolon comment lines should be indented 987 ;; Single-semicolon comment lines should be indented
@@ -939,18 +996,7 @@ rigidly along with this one."
939 ;; If initial point was within line's indentation, 996 ;; If initial point was within line's indentation,
940 ;; position after the indentation. Else stay at same point in text. 997 ;; position after the indentation. Else stay at same point in text.
941 (if (> (- (point-max) pos) (point)) 998 (if (> (- (point-max) pos) (point))
942 (goto-char (- (point-max) pos))) 999 (goto-char (- (point-max) pos))))))
943 ;; If desired, shift remaining lines of expression the same amount.
944 (and whole-exp (not (zerop shift-amt))
945 (save-excursion
946 (goto-char beg)
947 (forward-sexp 1)
948 (setq end (point))
949 (goto-char beg)
950 (forward-line 1)
951 (setq beg (point))
952 (> end beg))
953 (indent-code-rigidly beg end shift-amt)))))
954 1000
955(defvar calculate-lisp-indent-last-sexp) 1001(defvar calculate-lisp-indent-last-sexp)
956 1002
@@ -1230,7 +1276,6 @@ Lisp function does not specify a special indentation."
1230(put 'prog2 'lisp-indent-function 2) 1276(put 'prog2 'lisp-indent-function 2)
1231(put 'save-excursion 'lisp-indent-function 0) 1277(put 'save-excursion 'lisp-indent-function 0)
1232(put 'save-restriction 'lisp-indent-function 0) 1278(put 'save-restriction 'lisp-indent-function 0)
1233(put 'save-match-data 'lisp-indent-function 0)
1234(put 'save-current-buffer 'lisp-indent-function 0) 1279(put 'save-current-buffer 'lisp-indent-function 0)
1235(put 'let 'lisp-indent-function 1) 1280(put 'let 'lisp-indent-function 1)
1236(put 'let* 'lisp-indent-function 1) 1281(put 'let* 'lisp-indent-function 1)
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 70eab149837..394225d697e 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -100,6 +100,17 @@ each clause."
100 (error (message "Compiler-macro error for %S: %S" (car form) err) 100 (error (message "Compiler-macro error for %S: %S" (car form) err)
101 form))) 101 form)))
102 102
103(defun macroexp--eval-if-compile (&rest _forms)
104 "Pseudo function used internally by macroexp to delay warnings.
105The purpose is to delay warnings to bytecomp.el, so they can use things
106like `byte-compile-log-warning' to get better file-and-line-number data
107and also to avoid outputting the warning during normal execution."
108 nil)
109(put 'macroexp--eval-if-compile 'byte-compile
110 (lambda (form)
111 (mapc (lambda (x) (funcall (eval x))) (cdr form))
112 (byte-compile-constant nil)))
113
103(defun macroexp--expand-all (form) 114(defun macroexp--expand-all (form)
104 "Expand all macros in FORM. 115 "Expand all macros in FORM.
105This is an internal version of `macroexpand-all'. 116This is an internal version of `macroexpand-all'.
@@ -112,14 +123,17 @@ Assumes the caller has bound `macroexpand-all-environment'."
112 (macroexpand (macroexp--all-forms form 1) 123 (macroexpand (macroexp--all-forms form 1)
113 macroexpand-all-environment) 124 macroexpand-all-environment)
114 ;; Normal form; get its expansion, and then expand arguments. 125 ;; Normal form; get its expansion, and then expand arguments.
115 (let ((new-form (macroexpand form macroexpand-all-environment))) 126 (let ((new-form
116 (when (and (not (eq form new-form)) ;It was a macro call. 127 (macroexpand form macroexpand-all-environment)))
117 (car-safe form) 128 (setq form
118 (symbolp (car form)) 129 (if (and (not (eq form new-form)) ;It was a macro call.
119 (get (car form) 'byte-obsolete-info) 130 (car-safe form)
120 (fboundp 'byte-compile-warn-obsolete)) 131 (symbolp (car form))
121 (byte-compile-warn-obsolete (car form))) 132 (get (car form) 'byte-obsolete-info))
122 (setq form new-form)) 133 `(progn (macroexp--eval-if-compile
134 (lambda () (byte-compile-warn-obsolete ',(car form))))
135 ,new-form)
136 new-form)))
123 (pcase form 137 (pcase form
124 (`(cond . ,clauses) 138 (`(cond . ,clauses)
125 (macroexp--cons 'cond (macroexp--all-clauses clauses) form)) 139 (macroexp--cons 'cond (macroexp--all-clauses clauses) form))
@@ -323,6 +337,86 @@ symbol itself."
323 "Return non-nil if EXP can be copied without extra cost." 337 "Return non-nil if EXP can be copied without extra cost."
324 (or (symbolp exp) (macroexp-const-p exp))) 338 (or (symbolp exp) (macroexp-const-p exp)))
325 339
340;;; Load-time macro-expansion.
341
342;; Because macro-expansion used to be more lazy, eager macro-expansion
343;; tends to bump into previously harmless/unnoticeable cyclic-dependencies.
344;; So, we have to delay macro-expansion like we used to when we detect
345;; such a cycle, and we also want to help coders resolve those cycles (since
346;; they can be non-obvious) by providing a usefully trimmed backtrace
347;; (hopefully) highlighting the problem.
348
349(defun macroexp--backtrace ()
350 "Return the Elisp backtrace, more recent frames first."
351 (let ((bt ())
352 (i 0))
353 (while
354 (let ((frame (backtrace-frame i)))
355 (when frame
356 (push frame bt)
357 (setq i (1+ i)))))
358 (nreverse bt)))
359
360(defun macroexp--trim-backtrace-frame (frame)
361 (pcase frame
362 (`(,_ macroexpand (,head . ,_) . ,_) `(macroexpand (,head …)))
363 (`(,_ internal-macroexpand-for-load (,head ,second . ,_) . ,_)
364 (if (or (symbolp second)
365 (and (eq 'quote (car-safe second))
366 (symbolp (cadr second))))
367 `(macroexpand-all (,head ,second …))
368 '(macroexpand-all …)))
369 (`(,_ load-with-code-conversion ,name . ,_)
370 `(load ,(file-name-nondirectory name)))))
371
372(defvar macroexp--pending-eager-loads nil
373 "Stack of files currently undergoing eager macro-expansion.")
374
375(defun internal-macroexpand-for-load (form)
376 ;; Called from the eager-macroexpansion in readevalloop.
377 (cond
378 ;; Don't repeat the same warning for every top-level element.
379 ((eq 'skip (car macroexp--pending-eager-loads)) form)
380 ;; If we detect a cycle, skip macro-expansion for now, and output a warning
381 ;; with a trimmed backtrace.
382 ((and load-file-name (member load-file-name macroexp--pending-eager-loads))
383 (let* ((bt (delq nil
384 (mapcar #'macroexp--trim-backtrace-frame
385 (macroexp--backtrace))))
386 (elem `(load ,(file-name-nondirectory load-file-name)))
387 (tail (member elem (cdr (member elem bt)))))
388 (if tail (setcdr tail (list '…)))
389 (if (eq (car-safe (car bt)) 'macroexpand-all) (setq bt (cdr bt)))
390 (message "Warning: Eager macro-expansion skipped due to cycle:\n %s"
391 (mapconcat #'prin1-to-string (nreverse bt) " => "))
392 (push 'skip macroexp--pending-eager-loads)
393 form))
394 (t
395 (condition-case err
396 (let ((macroexp--pending-eager-loads
397 (cons load-file-name macroexp--pending-eager-loads)))
398 (macroexpand-all form))
399 (error
400 ;; Hopefully this shouldn't happen thanks to the cycle detection,
401 ;; but in case it does happen, let's catch the error and give the
402 ;; code a chance to macro-expand later.
403 (message "Eager macro-expansion failure: %S" err)
404 form)))))
405
406;; ¡¡¡ Big Ugly Hack !!!
407;; src/bootstrap-emacs is mostly used to compile .el files, so it needs
408;; macroexp, bytecomp, cconv, and byte-opt to be fast. Generally this is done
409;; by compiling those files first, but this only makes a difference if those
410;; files are not preloaded. But macroexp.el is preloaded so we reload it if
411;; the current version is interpreted and there's a compiled version available.
412(eval-when-compile
413 (add-hook 'emacs-startup-hook
414 (lambda ()
415 (and (not (byte-code-function-p
416 (symbol-function 'macroexpand-all)))
417 (locate-library "macroexp.elc")
418 (load "macroexp.elc")))))
419
326(provide 'macroexp) 420(provide 'macroexp)
327 421
328;;; macroexp.el ends here 422;;; macroexp.el ends here
diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el
index e7806440bf3..289751f4944 100644
--- a/lisp/emacs-lisp/map-ynp.el
+++ b/lisp/emacs-lisp/map-ynp.el
@@ -123,16 +123,6 @@ Returns the number of actions taken."
123 map 123 map
124 (let ((map (make-sparse-keymap))) 124 (let ((map (make-sparse-keymap)))
125 (set-keymap-parent map query-replace-map) 125 (set-keymap-parent map query-replace-map)
126 (define-key map [?\C-\M-v] 'scroll-other-window)
127 (define-key map [M-next] 'scroll-other-window)
128 (define-key map [?\C-\M-\S-v] 'scroll-other-window-down)
129 (define-key map [M-prior] 'scroll-other-window-down)
130 ;; The above are rather inconvenient, so maybe we should
131 ;; provide the non-other keys for the other-scroll as well.
132 ;; (define-key map [?\C-v] 'scroll-other-window)
133 ;; (define-key map [next] 'scroll-other-window)
134 ;; (define-key map [?\M-v] 'scroll-other-window-down)
135 ;; (define-key map [prior] 'scroll-other-window-down)
136 (dolist (elt action-alist) 126 (dolist (elt action-alist)
137 (define-key map (vector (car elt)) (vector (nth 1 elt)))) 127 (define-key map (vector (car elt)) (vector (nth 1 elt))))
138 map))) 128 map)))
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 4aeed7e4d0e..09e47b69b91 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -60,6 +60,8 @@
60;; is in a loop, the repeated macro-expansion becomes terribly costly, so we 60;; is in a loop, the repeated macro-expansion becomes terribly costly, so we
61;; memoize previous macro expansions to try and avoid recomputing them 61;; memoize previous macro expansions to try and avoid recomputing them
62;; over and over again. 62;; over and over again.
63;; FIXME: Now that macroexpansion is also performed when loading an interpreted
64;; file, this is not a real problem any more.
63(defconst pcase--memoize (make-hash-table :weakness 'key :test 'eq)) 65(defconst pcase--memoize (make-hash-table :weakness 'key :test 'eq))
64;; (defconst pcase--memoize-1 (make-hash-table :test 'eq)) 66;; (defconst pcase--memoize-1 (make-hash-table :test 'eq))
65;; (defconst pcase--memoize-2 (make-hash-table :weakness 'key :test 'equal)) 67;; (defconst pcase--memoize-2 (make-hash-table :weakness 'key :test 'equal))
diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index a66d5972d82..2248dde8c03 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -28,8 +28,8 @@
28;;; Code: 28;;; Code:
29 29
30;; Layout of a timer vector: 30;; Layout of a timer vector:
31;; [triggered-p high-seconds low-seconds usecs psecs repeat-delay 31;; [triggered-p high-seconds low-seconds usecs repeat-delay
32;; function args idle-delay] 32;; function args idle-delay psecs]
33;; triggered-p is nil if the timer is active (waiting to be triggered), 33;; triggered-p is nil if the timer is active (waiting to be triggered),
34;; t if it is inactive ("already triggered", in theory) 34;; t if it is inactive ("already triggered", in theory)
35 35
@@ -42,7 +42,7 @@
42 (:type vector) 42 (:type vector)
43 (:conc-name timer--)) 43 (:conc-name timer--))
44 (triggered t) 44 (triggered t)
45 high-seconds low-seconds usecs psecs repeat-delay function args idle-delay) 45 high-seconds low-seconds usecs repeat-delay function args idle-delay psecs)
46 46
47(defun timerp (object) 47(defun timerp (object)
48 "Return t if OBJECT is a timer." 48 "Return t if OBJECT is a timer."
diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el
index 39ce5901524..f63d79adf47 100644
--- a/lisp/emulation/cua-rect.el
+++ b/lisp/emulation/cua-rect.el
@@ -1423,7 +1423,9 @@ With prefix arg, indent to that column."
1423 (define-key cua--rectangle-keymap [remap set-mark-command] 'cua-toggle-rectangle-mark) 1423 (define-key cua--rectangle-keymap [remap set-mark-command] 'cua-toggle-rectangle-mark)
1424 1424
1425 (define-key cua--rectangle-keymap [remap forward-char] 'cua-resize-rectangle-right) 1425 (define-key cua--rectangle-keymap [remap forward-char] 'cua-resize-rectangle-right)
1426 (define-key cua--rectangle-keymap [remap right-char] 'cua-resize-rectangle-right)
1426 (define-key cua--rectangle-keymap [remap backward-char] 'cua-resize-rectangle-left) 1427 (define-key cua--rectangle-keymap [remap backward-char] 'cua-resize-rectangle-left)
1428 (define-key cua--rectangle-keymap [remap left-char] 'cua-resize-rectangle-left)
1427 (define-key cua--rectangle-keymap [remap next-line] 'cua-resize-rectangle-down) 1429 (define-key cua--rectangle-keymap [remap next-line] 'cua-resize-rectangle-down)
1428 (define-key cua--rectangle-keymap [remap previous-line] 'cua-resize-rectangle-up) 1430 (define-key cua--rectangle-keymap [remap previous-line] 'cua-resize-rectangle-up)
1429 (define-key cua--rectangle-keymap [remap end-of-line] 'cua-resize-rectangle-eol) 1431 (define-key cua--rectangle-keymap [remap end-of-line] 'cua-resize-rectangle-eol)
diff --git a/lisp/emulation/edt-mapper.el b/lisp/emulation/edt-mapper.el
index 7fc24773b9e..87b6bcf0aa9 100644
--- a/lisp/emulation/edt-mapper.el
+++ b/lisp/emulation/edt-mapper.el
@@ -61,7 +61,7 @@
61 61
62;; emacs -q -l edt-mapper.el 62;; emacs -q -l edt-mapper.el
63 63
64;; The "-q" option prevents loading of your .emacs file (commands 64;; The "-q" option prevents loading of your init file (commands
65;; therein might confuse this program). 65;; therein might confuse this program).
66 66
67;; An instruction screen showing the typical LK-201 terminal 67;; An instruction screen showing the typical LK-201 terminal
@@ -74,7 +74,7 @@
74;; and loaded automatically when the EDT emulation is started. If 74;; and loaded automatically when the EDT emulation is started. If
75;; you specify a different file name, you will need to set the 75;; you specify a different file name, you will need to set the
76;; variable "edt-keys-file" before starting the EDT emulation. 76;; variable "edt-keys-file" before starting the EDT emulation.
77;; Here's how you might go about doing that in your .emacs file. 77;; Here's how you might go about doing that in your init file:
78 78
79;; (setq edt-keys-file (expand-file-name "~/.my-emacs-keys")) 79;; (setq edt-keys-file (expand-file-name "~/.my-emacs-keys"))
80 80
diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el
index dbd13a01a8b..3810dcccbb3 100644
--- a/lisp/emulation/edt.el
+++ b/lisp/emulation/edt.el
@@ -48,7 +48,7 @@
48 48
49;; You can have the EDT Emulation start up automatically, each time 49;; You can have the EDT Emulation start up automatically, each time
50;; you initiate a GNU Emacs session, by adding the following line to 50;; you initiate a GNU Emacs session, by adding the following line to
51;; your .emacs file: 51;; your init file:
52;; 52;;
53;; (add-hook term-setup-hook 'edt-emulation-on) 53;; (add-hook term-setup-hook 'edt-emulation-on)
54 54
@@ -75,7 +75,7 @@
75;; default, this feature is enabled, with the top margin set to 75;; default, this feature is enabled, with the top margin set to
76;; 10% of the window and the bottom margin set to 15% of the 76;; 10% of the window and the bottom margin set to 15% of the
77;; window. To change these settings, you can invoke the function 77;; window. To change these settings, you can invoke the function
78;; edt-set-scroll-margins in your .emacs file. For example, the 78;; edt-set-scroll-margins in your init file. For example, the
79;; following line 79;; following line
80;; 80;;
81;; (edt-set-scroll-margins "20%" "25%") 81;; (edt-set-scroll-margins "20%" "25%")
@@ -363,7 +363,7 @@ This means that an edt-user.el file was found in the user's `load-path'.")
363;;; 363;;;
364;;; (setq edt-keep-current-page-delimiter t) 364;;; (setq edt-keep-current-page-delimiter t)
365;;; 365;;;
366;;; in your .emacs file. 366;;; in your init file.
367 367
368(defun edt-page-forward (num) 368(defun edt-page-forward (num)
369 "Move forward to just after next page delimiter. 369 "Move forward to just after next page delimiter.
@@ -1961,14 +1961,14 @@ created."
1961 Ack!! You're running the Enhanced EDT Emulation without loading an 1961 Ack!! You're running the Enhanced EDT Emulation without loading an
1962 EDT key mapping file. To create an EDT key mapping file, run the 1962 EDT key mapping file. To create an EDT key mapping file, run the
1963 edt-mapper program. It is safest to run it from an Emacs loaded 1963 edt-mapper program. It is safest to run it from an Emacs loaded
1964 without any of your own customizations found in your .emacs file, etc. 1964 without any of your own customizations found in your init file, etc.
1965 The reason for this is that some user customizations confuse edt-mapper. 1965 The reason for this is that some user customizations confuse edt-mapper.
1966 You can do this by quitting Emacs and then invoking Emacs again as 1966 You can do this by quitting Emacs and then invoking Emacs again as
1967 follows: 1967 follows:
1968 1968
1969 emacs -q -l edt-mapper 1969 emacs -q -l edt-mapper
1970 1970
1971 [NOTE: If you do nothing out of the ordinary in your .emacs file, and 1971 [NOTE: If you do nothing out of the ordinary in your init file, and
1972 the search for edt-mapper is successful, you can try running it now.] 1972 the search for edt-mapper is successful, you can try running it now.]
1973 1973
1974 The library edt-mapper includes these same directions on how to 1974 The library edt-mapper includes these same directions on how to
diff --git a/lisp/emulation/tpu-edt.el b/lisp/emulation/tpu-edt.el
index b8d07e8b744..d375725af56 100644
--- a/lisp/emulation/tpu-edt.el
+++ b/lisp/emulation/tpu-edt.el
@@ -163,8 +163,8 @@
163;; and type `tpu-edt' followed by a carriage return. 163;; and type `tpu-edt' followed by a carriage return.
164 164
165;; If you like TPU-edt and want to use it all the time, you can start 165;; If you like TPU-edt and want to use it all the time, you can start
166;; TPU-edt using the Emacs initialization file, .emacs. Simply create 166;; TPU-edt using the Emacs initialization file, .emacs. Simply add
167;; a .emacs file in your home directory containing the line: 167;; the following line to your init file:
168 168
169;; (tpu-edt) 169;; (tpu-edt)
170 170
@@ -2440,7 +2440,7 @@ If FILE is nil, try to load a default file. The default file names are
2440 2440
2441 2441
2442;;;### (autoloads (tpu-set-cursor-bound tpu-set-cursor-free tpu-set-scroll-margins 2442;;;### (autoloads (tpu-set-cursor-bound tpu-set-cursor-free tpu-set-scroll-margins
2443;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "76f06905db4c5bfb3b86491a51512a0e") 2443;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "bf5e7322f9a2c324a3bb306415813374")
2444;;; Generated autoloads from tpu-extras.el 2444;;; Generated autoloads from tpu-extras.el
2445 2445
2446(autoload 'tpu-cursor-free-mode "tpu-extras" "\ 2446(autoload 'tpu-cursor-free-mode "tpu-extras" "\
diff --git a/lisp/emulation/tpu-extras.el b/lisp/emulation/tpu-extras.el
index 521b189e3bc..4cf9eee037b 100644
--- a/lisp/emulation/tpu-extras.el
+++ b/lisp/emulation/tpu-extras.el
@@ -26,7 +26,7 @@
26 26
27;; Use the functions defined here to customize TPU-edt to your tastes by 27;; Use the functions defined here to customize TPU-edt to your tastes by
28;; setting scroll margins and/or turning on free cursor mode. Here's an 28;; setting scroll margins and/or turning on free cursor mode. Here's an
29;; example for your .emacs file. 29;; example for your init file.
30 30
31;; (tpu-set-cursor-free) ; Set cursor free. 31;; (tpu-set-cursor-free) ; Set cursor free.
32;; (tpu-set-scroll-margins "10%" "15%") ; Set scroll margins. 32;; (tpu-set-scroll-margins "10%" "15%") ; Set scroll margins.
diff --git a/lisp/emulation/tpu-mapper.el b/lisp/emulation/tpu-mapper.el
index ef4e9b305fc..9cced60816c 100644
--- a/lisp/emulation/tpu-mapper.el
+++ b/lisp/emulation/tpu-mapper.el
@@ -81,7 +81,7 @@ Finally, you will be prompted for the name of the file to store the key
81definitions. If you chose the default, TPU-edt will find it and load it 81definitions. If you chose the default, TPU-edt will find it and load it
82automatically. If you specify a different file name, you will need to 82automatically. If you specify a different file name, you will need to
83set the variable ``tpu-xkeys-file'' before starting TPU-edt. Here's how 83set the variable ``tpu-xkeys-file'' before starting TPU-edt. Here's how
84you might go about doing that in your .emacs file. 84you might go about doing that in your init file.
85 85
86 (setq tpu-xkeys-file (expand-file-name \"~/.my-emacs-x-keys\")) 86 (setq tpu-xkeys-file (expand-file-name \"~/.my-emacs-x-keys\"))
87 (tpu-edt) 87 (tpu-edt)
diff --git a/lisp/emulation/vi.el b/lisp/emulation/vi.el
index 9bf108c8c38..a59dd610c21 100644
--- a/lisp/emulation/vi.el
+++ b/lisp/emulation/vi.el
@@ -28,7 +28,7 @@
28;; (if (not (or (eq major-mode 'Info-mode) 28;; (if (not (or (eq major-mode 'Info-mode)
29;; (eq major-mode 'vi-mode))) 29;; (eq major-mode 'vi-mode)))
30;; (vi-mode)))))) 30;; (vi-mode))))))
31;; 3) In your .emacs file you can define the command "vi-mode" to be "autoload" 31;; 3) In your init file you can define the command "vi-mode" to be "autoload"
32;; or you can execute the "load" command to load "vi" directly. 32;; or you can execute the "load" command to load "vi" directly.
33;; 4) Read the comments for command "vi-mode" before you start using it. 33;; 4) Read the comments for command "vi-mode" before you start using it.
34 34
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index 81fbfb0394c..8de253d19b0 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -351,7 +351,7 @@ user decide when to invoke Viper in a major mode."
351If t, viperize Emacs. If nil -- don't. If `ask', ask the user. 351If t, viperize Emacs. If nil -- don't. If `ask', ask the user.
352This variable is used primarily when Viper is being loaded. 352This variable is used primarily when Viper is being loaded.
353 353
354Must be set in `~/.emacs' before Viper is loaded. 354Must be set in your init file before Viper is loaded.
355DO NOT set this variable interactively, unless you are using the customization 355DO NOT set this variable interactively, unless you are using the customization
356widget." 356widget."
357 :type '(choice (const nil) (const t) (const ask)) 357 :type '(choice (const nil) (const t) (const ask))
@@ -1173,7 +1173,7 @@ If you wish to Viperize AND make this your way of life, please put
1173 (setq viper-mode t) 1173 (setq viper-mode t)
1174 (require 'viper) 1174 (require 'viper)
1175 1175
1176in your .emacs file (preferably, close to the top). 1176in your init file (preferably, close to the top).
1177These two lines must come in the order given. 1177These two lines must come in the order given.
1178 1178
1179** Viper users: 1179** Viper users:
diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el
index be5b849651c..a16fa5abdd4 100644
--- a/lisp/epa-mail.el
+++ b/lisp/epa-mail.el
@@ -170,24 +170,26 @@ Don't use this command in Lisp programs!"
170If no one is selected, symmetric encryption will be performed. " 170If no one is selected, symmetric encryption will be performed. "
171 recipients) 171 recipients)
172 (if recipients 172 (if recipients
173 (mapcar 173 (apply
174 (lambda (recipient) 174 'nconc
175 (setq recipient-key 175 (mapcar
176 (epa-mail--find-usable-key 176 (lambda (recipient)
177 (epg-list-keys 177 (setq recipient-key
178 (epg-make-context epa-protocol) 178 (epa-mail--find-usable-key
179 (if (string-match "@" recipient) 179 (epg-list-keys
180 (concat "<" recipient ">") 180 (epg-make-context epa-protocol)
181 recipient)) 181 (if (string-match "@" recipient)
182 'encrypt)) 182 (concat "<" recipient ">")
183 (unless (or recipient-key 183 recipient))
184 (y-or-n-p 184 'encrypt))
185 (format 185 (unless (or recipient-key
186 "No public key for %s; skip it? " 186 (y-or-n-p
187 recipient))) 187 (format
188 (error "No public key for %s" recipient)) 188 "No public key for %s; skip it? "
189 recipient-key) 189 recipient)))
190 recipients))) 190 (error "No public key for %s" recipient))
191 (if recipient-key (list recipient-key)))
192 recipients))))
191 (setq sign (if verbose (y-or-n-p "Sign? "))) 193 (setq sign (if verbose (y-or-n-p "Sign? ")))
192 (if sign 194 (if sign
193 (epa-select-keys context 195 (epa-select-keys context
diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog
index 37e755e7655..674a6c97eec 100644
--- a/lisp/erc/ChangeLog
+++ b/lisp/erc/ChangeLog
@@ -1,3 +1,9 @@
12012-09-17 Chong Yidong <cyd@gnu.org>
2
3 * erc-page.el (erc-page-function):
4
5 * erc-stamp.el (erc-stamp): Doc fix.
6
12012-08-21 Josh Feinstein <jlf@foxtail.org> 72012-08-21 Josh Feinstein <jlf@foxtail.org>
2 8
3 * erc-join.el (erc-autojoin-timing): Fix defcustom type. 9 * erc-join.el (erc-autojoin-timing): Fix defcustom type.
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index c8a7fec32bd..a0593dcb743 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -25,7 +25,7 @@
25 25
26;; Heavily borrowed from gnus-art.el. Thanks to the original authors. 26;; Heavily borrowed from gnus-art.el. Thanks to the original authors.
27;; This buttonizes nicks and other stuff to make it all clickable. 27;; This buttonizes nicks and other stuff to make it all clickable.
28;; To enable, add to your ~/.emacs: 28;; To enable, add to your init file:
29;; (require 'erc-button) 29;; (require 'erc-button)
30;; (erc-button-mode 1) 30;; (erc-button-mode 1)
31;; 31;;
diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el
index 4f6361ee923..c7103d6dc61 100644
--- a/lisp/erc/erc-capab.el
+++ b/lisp/erc/erc-capab.el
@@ -48,7 +48,7 @@
48 48
49;;; Usage: 49;;; Usage:
50 50
51;; Put the following in your ~/.emacs file. 51;; Put the following in your init file.
52 52
53;; (require 'erc-capab) 53;; (require 'erc-capab)
54;; (erc-capab-identify-mode 1) 54;; (erc-capab-identify-mode 1)
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index cac042c0298..de7f2137197 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -29,7 +29,7 @@
29;; customizable variables. 29;; customizable variables.
30 30
31;; Usage: 31;; Usage:
32;; Put (erc-match-mode 1) into your ~/.emacs file. 32;; Put (erc-match-mode 1) into your init file.
33 33
34;;; Code: 34;;; Code:
35 35
diff --git a/lisp/erc/erc-netsplit.el b/lisp/erc/erc-netsplit.el
index 44fbc9563d6..355b345492c 100644
--- a/lisp/erc/erc-netsplit.el
+++ b/lisp/erc/erc-netsplit.el
@@ -23,7 +23,7 @@
23;;; Commentary: 23;;; Commentary:
24 24
25;; This module hides quit/join messages if a netsplit occurs. 25;; This module hides quit/join messages if a netsplit occurs.
26;; To enable, add the following to your ~/.emacs: 26;; To enable, add the following to your init file:
27;; (require 'erc-netsplit) 27;; (require 'erc-netsplit)
28;; (erc-netsplit-mode 1) 28;; (erc-netsplit-mode 1)
29 29
diff --git a/lisp/erc/erc-page.el b/lisp/erc/erc-page.el
index e6b670c91ba..51ddc33e1c0 100644
--- a/lisp/erc/erc-page.el
+++ b/lisp/erc/erc-page.el
@@ -45,7 +45,7 @@ If nil, this prints the page message in the minibuffer and calls
45`beep'. If non-nil, it must be a function that takes two arguments: 45`beep'. If non-nil, it must be a function that takes two arguments:
46SENDER and MSG, both strings. 46SENDER and MSG, both strings.
47 47
48Example for your ~/.emacs file: 48Example for your init file:
49 49
50\(setq erc-page-function 50\(setq erc-page-function
51 (lambda (sender msg) 51 (lambda (sender msg)
diff --git a/lisp/erc/erc-replace.el b/lisp/erc/erc-replace.el
index 04c5885bc3e..6c5804c62a4 100644
--- a/lisp/erc/erc-replace.el
+++ b/lisp/erc/erc-replace.el
@@ -25,7 +25,7 @@
25 25
26;; This module allows you to systematically replace text in incoming 26;; This module allows you to systematically replace text in incoming
27;; messages. Load erc-replace, and customize `erc-replace-alist'. 27;; messages. Load erc-replace, and customize `erc-replace-alist'.
28;; Then add to your ~/.emacs: 28;; Then add to your init file:
29 29
30;; (require 'erc-replace) 30;; (require 'erc-replace)
31;; (erc-replace-mode 1) 31;; (erc-replace-mode 1)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 5831233affe..4ce2f18e041 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -43,7 +43,7 @@ group provides settings related to the format and display
43of timestamp information in `erc-mode' buffer. 43of timestamp information in `erc-mode' buffer.
44 44
45For timestamping to be activated, you just need to load `erc-stamp' 45For timestamping to be activated, you just need to load `erc-stamp'
46in your .emacs file or interactively using `load-library'." 46in your init file or interactively using `load-library'."
47 :group 'erc) 47 :group 'erc)
48 48
49(defcustom erc-timestamp-format "[%H:%M]" 49(defcustom erc-timestamp-format "[%H:%M]"
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index 9c56c724224..88a3285730d 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -24,7 +24,7 @@
24;;; Commentary: 24;;; Commentary:
25 25
26;; Highlights keywords and pals (friends), and hides or highlights fools 26;; Highlights keywords and pals (friends), and hides or highlights fools
27;; (using a dark color). Add to your ~/.emacs: 27;; (using a dark color). Add to your init file:
28 28
29;; (require 'erc-track) 29;; (require 'erc-track)
30;; (erc-track-mode 1) 30;; (erc-track-mode 1)
diff --git a/lisp/eshell/em-alias.el b/lisp/eshell/em-alias.el
index 4b62fec95e6..940056b6438 100644
--- a/lisp/eshell/em-alias.el
+++ b/lisp/eshell/em-alias.el
@@ -133,10 +133,10 @@ Each element of this alias is a list of the form:
133Where NAME is the textual name of the alias, and DEFINITION is the 133Where NAME is the textual name of the alias, and DEFINITION is the
134command string to replace that command with. 134command string to replace that command with.
135 135
136Note: this list should not be modified in your '.emacs' file. Rather, 136Note: this list should not be modified in your init file.
137any desired alias definitions should be declared using the `alias' 137Rather, any desired alias definitions should be declared using
138command, which will automatically write them to the file named by 138the `alias' command, which will automatically write them to the
139`eshell-aliases-file'.") 139file named by `eshell-aliases-file'.")
140 140
141(put 'eshell-command-aliases-list 'risky-local-variable t) 141(put 'eshell-command-aliases-list 'risky-local-variable t)
142 142
diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el
index 58402e37508..d3ddab8af1b 100644
--- a/lisp/eshell/em-unix.el
+++ b/lisp/eshell/em-unix.el
@@ -1111,7 +1111,7 @@ Execute a COMMAND as the superuser or another USER.")
1111 (substring prefix 0 -1) user host dir) 1111 (substring prefix 0 -1) user host dir)
1112 (format "/sudo:%s@%s:%s" user host dir)))) 1112 (format "/sudo:%s@%s:%s" user host dir))))
1113 ;; Ensure, that Tramp has connected to that construct already. 1113 ;; Ensure, that Tramp has connected to that construct already.
1114 (file-exists-p default-directory) 1114 (ignore (file-exists-p default-directory))
1115 (eshell-named-command (car orig-args) (cdr orig-args)))))))) 1115 (eshell-named-command (car orig-args) (cdr orig-args))))))))
1116 1116
1117(put 'eshell/sudo 'eshell-no-numeric-conversions t) 1117(put 'eshell/sudo 'eshell-no-numeric-conversions t)
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index 8218e91ddc7..fa0336232f9 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -84,7 +84,7 @@ Numeric form is tested using the regular expression
84NOTE: If you find that numeric conversions are interfering with the 84NOTE: If you find that numeric conversions are interfering with the
85specification of filenames (for example, in calling `find-file', or 85specification of filenames (for example, in calling `find-file', or
86some other Lisp function that deals with files, not numbers), add the 86some other Lisp function that deals with files, not numbers), add the
87following in your .emacs file: 87following in your init file:
88 88
89 (put 'find-file 'eshell-no-numeric-conversions t) 89 (put 'find-file 'eshell-no-numeric-conversions t)
90 90
diff --git a/lisp/ffap.el b/lisp/ffap.el
index ebe8b6dee94..f3e8d4c194e 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -34,7 +34,7 @@
34;; README's, MANIFEST's, and so on. Submit bugs or suggestions with 34;; README's, MANIFEST's, and so on. Submit bugs or suggestions with
35;; M-x ffap-bug. 35;; M-x ffap-bug.
36;; 36;;
37;; For the default installation, add this line to your .emacs file: 37;; For the default installation, add this line to your init file:
38;; 38;;
39;; (ffap-bindings) ; do default key bindings 39;; (ffap-bindings) ; do default key bindings
40;; 40;;
@@ -206,7 +206,7 @@ Sensible values are nil, \"news\", or \"mailto\"."
206;; those features interesting but not clear winners (a matter of 206;; those features interesting but not clear winners (a matter of
207;; personal taste) I try to leave options to enable them. Read 207;; personal taste) I try to leave options to enable them. Read
208;; through this section for features that you like, put an appropriate 208;; through this section for features that you like, put an appropriate
209;; enabler in your .emacs file. 209;; enabler in your init file.
210 210
211(defcustom ffap-dired-wildcards "[*?][^/]*\\'" 211(defcustom ffap-dired-wildcards "[*?][^/]*\\'"
212 "A regexp matching filename wildcard characters, or nil. 212 "A regexp matching filename wildcard characters, or nil.
diff --git a/lisp/files.el b/lisp/files.el
index ef7f8e43a41..289f5c6b0b6 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -658,22 +658,13 @@ Not actually set up until the first time you use it.")
658 658
659(defun parse-colon-path (search-path) 659(defun parse-colon-path (search-path)
660 "Explode a search path into a list of directory names. 660 "Explode a search path into a list of directory names.
661Directories are separated by occurrences of `path-separator' 661Directories are separated by `path-separator' (which is colon in
662\(which is colon in GNU and GNU-like systems)." 662GNU and Unix systems). Substitute environment variables into the
663 ;; We could use split-string here. 663resulting list of directory names."
664 (and search-path 664 (when (stringp search-path)
665 (let (cd-list (cd-start 0) cd-colon) 665 (mapcar (lambda (f)
666 (setq search-path (concat search-path path-separator)) 666 (substitute-in-file-name (file-name-as-directory f)))
667 (while (setq cd-colon (string-match path-separator search-path cd-start)) 667 (split-string search-path path-separator t))))
668 (setq cd-list
669 (nconc cd-list
670 (list (if (= cd-start cd-colon)
671 nil
672 (substitute-in-file-name
673 (file-name-as-directory
674 (substring search-path cd-start cd-colon)))))))
675 (setq cd-start (+ cd-colon 1)))
676 cd-list)))
677 668
678(defun cd-absolute (dir) 669(defun cd-absolute (dir)
679 "Change current directory to given absolute file name DIR." 670 "Change current directory to given absolute file name DIR."
@@ -2145,7 +2136,7 @@ unless NOMODES is non-nil."
2145 (not buffer-read-only) 2136 (not buffer-read-only)
2146 (save-excursion 2137 (save-excursion
2147 (goto-char (point-max)) 2138 (goto-char (point-max))
2148 (insert "\n"))) 2139 (ignore-errors (insert "\n"))))
2149 (when (and buffer-read-only 2140 (when (and buffer-read-only
2150 view-read-only 2141 view-read-only
2151 (not (eq (get major-mode 'mode-class) 'special))) 2142 (not (eq (get major-mode 'mode-class) 'special)))
@@ -2951,20 +2942,16 @@ UNSAFE-VARS is the list of those that aren't marked as safe or risky.
2951RISKY-VARS is the list of those that are marked as risky. 2942RISKY-VARS is the list of those that are marked as risky.
2952If these settings come from directory-local variables, then 2943If these settings come from directory-local variables, then
2953DIR-NAME is the name of the associated directory. Otherwise it is nil." 2944DIR-NAME is the name of the associated directory. Otherwise it is nil."
2954 (if noninteractive 2945 (unless noninteractive
2955 nil 2946 (let ((name (cond (dir-name)
2956 (save-window-excursion 2947 (buffer-file-name
2957 (let* ((name (or dir-name 2948 (file-name-nondirectory buffer-file-name))
2958 (if buffer-file-name 2949 ((concat "buffer " (buffer-name)))))
2959 (file-name-nondirectory buffer-file-name) 2950 (offer-save (and (eq enable-local-variables t)
2960 (concat "buffer " (buffer-name))))) 2951 unsafe-vars))
2961 (offer-save (and (eq enable-local-variables t) 2952 (buf (get-buffer-create "*Local Variables*")))
2962 unsafe-vars)) 2953 ;; Set up the contents of the *Local Variables* buffer.
2963 (exit-chars 2954 (with-current-buffer buf
2964 (if offer-save '(?! ?y ?n ?\s ?\C-g) '(?y ?n ?\s ?\C-g)))
2965 (buf (pop-to-buffer "*Local Variables*"))
2966 prompt char)
2967 (set (make-local-variable 'cursor-type) nil)
2968 (erase-buffer) 2955 (erase-buffer)
2969 (cond 2956 (cond
2970 (unsafe-vars 2957 (unsafe-vars
@@ -2999,25 +2986,35 @@ n -- to ignore the local variables list.")
2999 (let ((print-escape-newlines t)) 2986 (let ((print-escape-newlines t))
3000 (prin1 (cdr elt) buf)) 2987 (prin1 (cdr elt) buf))
3001 (insert "\n")) 2988 (insert "\n"))
3002 (setq prompt 2989 (set (make-local-variable 'cursor-type) nil)
3003 (format "Please type %s%s: " 2990 (set-buffer-modified-p nil)
3004 (if offer-save "y, n, or !" "y or n") 2991 (goto-char (point-min)))
3005 (if (< (line-number-at-pos) (window-body-height)) 2992
3006 "" 2993 ;; Display the buffer and read a choice.
3007 (push ?\C-v exit-chars) 2994 (save-window-excursion
3008 ", or C-v to scroll"))) 2995 (pop-to-buffer buf)
3009 (goto-char (point-min)) 2996 (let* ((exit-chars '(?y ?n ?\s ?\C-g ?\C-v))
3010 (while (null char) 2997 (prompt (format "Please type %s%s: "
3011 (setq char (read-char-choice prompt exit-chars t)) 2998 (if offer-save "y, n, or !" "y or n")
3012 (when (eq char ?\C-v) 2999 (if (< (line-number-at-pos (point-max))
3013 (condition-case nil 3000 (window-body-height))
3014 (scroll-up) 3001 ""
3015 (error (goto-char (point-min)))) 3002 (push ?\C-v exit-chars)
3016 (setq char nil))) 3003 ", or C-v to scroll")))
3017 (kill-buffer buf) 3004 char)
3018 (when (and offer-save (= char ?!) unsafe-vars) 3005 (if offer-save (push ?! exit-chars))
3019 (customize-push-and-save 'safe-local-variable-values unsafe-vars)) 3006 (while (null char)
3020 (memq char '(?! ?\s ?y)))))) 3007 (setq char (read-char-choice prompt exit-chars t))
3008 (when (eq char ?\C-v)
3009 (condition-case nil
3010 (scroll-up)
3011 (error (goto-char (point-min))
3012 (recenter 1)))
3013 (setq char nil)))
3014 (when (and offer-save (= char ?!) unsafe-vars)
3015 (customize-push-and-save 'safe-local-variable-values unsafe-vars))
3016 (prog1 (memq char '(?! ?\s ?y))
3017 (quit-window t)))))))
3021 3018
3022(defun hack-local-variables-prop-line (&optional mode-only) 3019(defun hack-local-variables-prop-line (&optional mode-only)
3023 "Return local variables specified in the -*- line. 3020 "Return local variables specified in the -*- line.
@@ -5350,23 +5347,26 @@ non-nil, it is called instead of rereading visited file contents."
5350 (not (file-exists-p file-name))) 5347 (not (file-exists-p file-name)))
5351 (error "Auto-save file %s not current" 5348 (error "Auto-save file %s not current"
5352 (abbreviate-file-name file-name))) 5349 (abbreviate-file-name file-name)))
5353 ((save-window-excursion 5350 ((with-temp-buffer-window
5354 (with-output-to-temp-buffer "*Directory*" 5351 "*Directory*" nil
5355 (buffer-disable-undo standard-output) 5352 #'(lambda (window _value)
5356 (save-excursion 5353 (with-selected-window window
5357 (let ((switches dired-listing-switches)) 5354 (unwind-protect
5358 (if (file-symlink-p file) 5355 (yes-or-no-p (format "Recover auto save file %s? " file-name))
5359 (setq switches (concat switches " -L"))) 5356 (when (window-live-p window)
5360 (set-buffer standard-output) 5357 (quit-restore-window window 'kill)))))
5361 ;; Use insert-directory-safely, not insert-directory, 5358 (with-current-buffer standard-output
5362 ;; because these files might not exist. In particular, 5359 (let ((switches dired-listing-switches))
5363 ;; FILE might not exist if the auto-save file was for 5360 (if (file-symlink-p file)
5364 ;; a buffer that didn't visit a file, such as "*mail*". 5361 (setq switches (concat switches " -L")))
5365 ;; The code in v20.x called `ls' directly, so we need 5362 ;; Use insert-directory-safely, not insert-directory,
5366 ;; to emulate what `ls' did in that case. 5363 ;; because these files might not exist. In particular,
5367 (insert-directory-safely file switches) 5364 ;; FILE might not exist if the auto-save file was for
5368 (insert-directory-safely file-name switches)))) 5365 ;; a buffer that didn't visit a file, such as "*mail*".
5369 (yes-or-no-p (format "Recover auto save file %s? " file-name))) 5366 ;; The code in v20.x called `ls' directly, so we need
5367 ;; to emulate what `ls' did in that case.
5368 (insert-directory-safely file switches)
5369 (insert-directory-safely file-name switches))))
5370 (switch-to-buffer (find-file-noselect file t)) 5370 (switch-to-buffer (find-file-noselect file t))
5371 (let ((inhibit-read-only t) 5371 (let ((inhibit-read-only t)
5372 ;; Keep the current buffer-file-coding-system. 5372 ;; Keep the current buffer-file-coding-system.
@@ -6327,8 +6327,15 @@ if any returns nil. If `confirm-kill-emacs' is non-nil, calls it."
6327 (setq active t)) 6327 (setq active t))
6328 (setq processes (cdr processes))) 6328 (setq processes (cdr processes)))
6329 (or (not active) 6329 (or (not active)
6330 (progn (list-processes t) 6330 (with-temp-buffer-window
6331 (yes-or-no-p "Active processes exist; kill them and exit anyway? "))))) 6331 (get-buffer-create "*Process List*") nil
6332 #'(lambda (window _value)
6333 (with-selected-window window
6334 (unwind-protect
6335 (yes-or-no-p "Active processes exist; kill them and exit anyway? ")
6336 (when (window-live-p window)
6337 (quit-restore-window window 'kill)))))
6338 (list-processes t)))))
6332 ;; Query the user for other things, perhaps. 6339 ;; Query the user for other things, perhaps.
6333 (run-hook-with-args-until-failure 'kill-emacs-query-functions) 6340 (run-hook-with-args-until-failure 'kill-emacs-query-functions)
6334 (or (null confirm-kill-emacs) 6341 (or (null confirm-kill-emacs)
diff --git a/lisp/filesets.el b/lisp/filesets.el
index 6c24a4f43d6..a91d8cf0fcb 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -35,7 +35,7 @@
35;; inclusion group (i.e. a base file including other files). 35;; inclusion group (i.e. a base file including other files).
36 36
37;; Usage: 37;; Usage:
38;; 1. Put (require 'filesets) and (filesets-init) in your .emacs file. 38;; 1. Put (require 'filesets) and (filesets-init) in your init file.
39;; 2. Type ;; M-x filesets-edit or choose "Edit Filesets" from the menu. 39;; 2. Type ;; M-x filesets-edit or choose "Edit Filesets" from the menu.
40;; 3. Save your customizations. 40;; 3. Save your customizations.
41 41
diff --git a/lisp/flow-ctrl.el b/lisp/flow-ctrl.el
index 747a4ca018c..b301886de5b 100644
--- a/lisp/flow-ctrl.el
+++ b/lisp/flow-ctrl.el
@@ -31,7 +31,7 @@
31;; 31;;
32;; To invoke these adjustments, a user need only invoke the function 32;; To invoke these adjustments, a user need only invoke the function
33;; enable-flow-control-on with a list of terminal types in his/her own 33;; enable-flow-control-on with a list of terminal types in his/her own
34;; .emacs file. As arguments, give it the names of one or more terminal 34;; init file. As arguments, give it the names of one or more terminal
35;; types in use by that user which require flow control adjustments. 35;; types in use by that user which require flow control adjustments.
36;; Here's an example: 36;; Here's an example:
37;; 37;;
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 77c21d26535..6404af7703a 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -37,7 +37,7 @@
37;; When this minor mode is on, the faces of the current line are updated with 37;; When this minor mode is on, the faces of the current line are updated with
38;; every insertion or deletion. 38;; every insertion or deletion.
39;; 39;;
40;; To turn Font Lock mode on automatically, add this to your ~/.emacs file: 40;; To turn Font Lock mode on automatically, add this to your init file:
41;; 41;;
42;; (add-hook 'emacs-lisp-mode-hook 'turn-on-font-lock) 42;; (add-hook 'emacs-lisp-mode-hook 'turn-on-font-lock)
43;; 43;;
diff --git a/lisp/frame.el b/lisp/frame.el
index 1e8883eb98e..b7b61bcc576 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -309,7 +309,7 @@ there (in decreasing order of priority)."
309 ;; existing frame. We need to explicitly include 309 ;; existing frame. We need to explicitly include
310 ;; default-frame-alist in the parameters of the screen we 310 ;; default-frame-alist in the parameters of the screen we
311 ;; create here, so that its new value, gleaned from the user's 311 ;; create here, so that its new value, gleaned from the user's
312 ;; .emacs file, will be applied to the existing screen. 312 ;; init file, will be applied to the existing screen.
313 (if (not (eq (cdr (or (assq 'minibuffer initial-frame-alist) 313 (if (not (eq (cdr (or (assq 'minibuffer initial-frame-alist)
314 (assq 'minibuffer window-system-frame-alist) 314 (assq 'minibuffer window-system-frame-alist)
315 (assq 'minibuffer default-frame-alist) 315 (assq 'minibuffer default-frame-alist)
@@ -1668,6 +1668,10 @@ terminals, cursor blinking is controlled by the terminal."
1668 1668
1669(make-variable-buffer-local 'show-trailing-whitespace) 1669(make-variable-buffer-local 'show-trailing-whitespace)
1670 1670
1671;; Defined in dispnew.c.
1672(make-obsolete-variable
1673 'window-system-version "it does not give useful information." "24.3")
1674
1671(provide 'frame) 1675(provide 'frame)
1672 1676
1673;;; frame.el ends here 1677;;; frame.el ends here
diff --git a/lisp/generic-x.el b/lisp/generic-x.el
index cc7963b1711..a97c5649c95 100644
--- a/lisp/generic-x.el
+++ b/lisp/generic-x.el
@@ -28,7 +28,7 @@
28;; 28;;
29;; INSTALLATION: 29;; INSTALLATION:
30;; 30;;
31;; Add this line to your .emacs file: 31;; Add this line to your init file:
32;; 32;;
33;; (require 'generic-x) 33;; (require 'generic-x)
34;; 34;;
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index a4e3d9bde2b..69f0025b524 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,129 @@
12012-09-13 Katsumi Yamaoka <yamaoka@jpl.org>
2
3 * gnus-util.el (gnus-timer--function): New function.
4
5 * gnus-art.el (gnus-article-stop-animations): Use it.
6
72012-09-13 Paul Eggert <eggert@cs.ucla.edu>
8
9 Fix glitches caused by addition of psec to timers.
10 * gnus-art.el (gnus-article-stop-animations): Use timer--function
11 rather than raw access to timer vector.
12
132012-09-11 Julien Danjou <julien@danjou.info>
14
15 * gnus-notifications.el (gnus-notifications): Check for nil values in
16 ignored addresses check.
17
182012-09-10 Stefan Monnier <monnier@iro.umontreal.ca>
19
20 * qp.el (quoted-printable-decode-region): Inline+CSE+strength-reduction.
21
222012-09-07 Chong Yidong <cyd@gnu.org>
23
24 * gnus-util.el
25 (gnus-put-text-property-excluding-characters-with-faces): Restore.
26
27 * gnus-salt.el (gnus-tree-highlight-node):
28 * gnus-sum.el (gnus-summary-highlight-line):
29 * gnus-group.el (gnus-group-highlight-line): Revert use of add-face.
30
312012-09-06 Lars Ingebrigtsen <larsi@gnus.org>
32
33 * gnus-util.el: Fix compilation error on XEmacs 21.4.
34
352012-09-06 Juri Linkov <juri@jurta.org>
36
37 * gnus-group.el (gnus-read-ephemeral-gmane-group): Change the naming
38 scheme for buffer names to be more consistent with other group and
39 article buffer names in Gnus.
40
412012-09-06 Lars Ingebrigtsen <larsi@gnus.org>
42
43 * gnus-util.el
44 (gnus-put-text-property-excluding-characters-with-faces): Remove.
45
46 * gnus-compat.el: Define compat function `add-face' from Wolfgang
47 Jenkner.
48
49 * gnus-group.el (gnus-group-highlight-line): Use combining faces.
50
51 * gnus-sum.el (gnus-summary-highlight-line): Ditto.
52
53 * gnus-salt.el (gnus-tree-highlight-node): Ditto.
54
552012-09-06 Katsumi Yamaoka <yamaoka@jpl.org>
56
57 * gnus-score.el (gnus-score-decode-text-parts): Use #' for
58 mm-text-parts used in labels macro to make it work with XEmacs 21.5.
59
60 * gnus-util.el (gnus-string-prefix-p): New function, an alias to
61 string-prefix-p in Emacs >=23.2.
62
63 * nnmaildir.el (nnmaildir--ensure-suffix, nnmaildir--add-flag)
64 (nnmaildir--remove-flag, nnmaildir--scan): Use gnus-string-match-p
65 instead of string-match-p.
66 (nnmaildir--scan): Use gnus-string-prefix-p instead of string-prefix-p.
67
682012-09-06 Kenichi Handa <handa@gnu.org>
69
70 * qp.el (quoted-printable-decode-region): Fix previous change; handle
71 lowercase a..f.
72
732012-09-05 Magnus Henoch <magnus.henoch@gmail.com>
74
75 * nnmaildir.el (nnmaildir--article-set-flags): Fix compilation error.
76
772012-09-05 Martin Stjernholm <mast@lysator.liu.se>
78
79 * gnus-demon.el (gnus-demon-init): Fixed regression when IDLE is t and
80 TIME is set.
81
822012-09-05 Juri Linkov <juri@jurta.org>
83
84 * gnus-group.el (gnus-read-ephemeral-bug-group): Allow opening more
85 than one group at a time (bug#11961).
86
872012-09-05 Julien Danjou <julien@danjou.info>
88
89 * gnus-srvr.el (gnus-server-open-server): Don't message on failure:
90 this hide the real reason with a message giving absolutely no hint.
91
922012-09-05 Lars Ingebrigtsen <larsi@gnus.org>
93
94 * gnus-group.el (gnus-group-mark-article-read): Propagate the read mark
95 to the backend (bug#11804).
96
97 * message.el (message-insert-newsgroups): Don't insert newsgroup
98 duplicates (bug#12275).
99
1002012-09-05 John Wiegley <johnw@newartisans.com>
101
102 * gnus.el (gnus-expand-group-parameters): Allow regexp substitutions in
103 sieve rules.
104
1052012-09-05 Jan Tatarik <jan.tatarik@gmail.com>
106
107 * gnus-score.el (gnus-score-decode-text-parts): Use #' for the local
108 function.
109
110 * gnus-logic.el (gnus-advanced-body): Allow scoring on decoded bodies.
111
112 * gnus-score.el (gnus-score-decode-text-parts): Ditto.
113
1142012-09-05 Magnus Henoch <magnus.henoch@gmail.com>
115
116 * nnmaildir.el: Make nnmaildir understand and write maildir flags.
117 That is, rename files from "unique:2," to "unique:2,S" for "seen", etc.
118 This should make nnmaildir more usable with offlineimap.
119
1202012-09-03 Lars Ingebrigtsen <larsi@gnus.org>
121
122 * gnus-notifications.el (gnus-notifications-notify): Use it.
123
124 * gnus-fun.el (gnus-funcall-no-warning): New function to silence
125 warnings on XEmacs.
126
12012-09-01 Paul Eggert <eggert@cs.ucla.edu> 1272012-09-01 Paul Eggert <eggert@cs.ucla.edu>
2 128
3 Better seeds for (random). 129 Better seeds for (random).
@@ -2291,8 +2417,6 @@
2291 2417
22922011-06-30 Lars Magne Ingebrigtsen <larsi@gnus.org> 24182011-06-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
2293 2419
2294 * dgnushack.el: Autoload sha1 on XEmacs.
2295
2296 * gnus-group.el (gnus-read-ephemeral-emacs-bug-group): Take an optional 2420 * gnus-group.el (gnus-read-ephemeral-emacs-bug-group): Take an optional
2297 quit window configuration. 2421 quit window configuration.
2298 2422
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index b9020a40b75..7dcbd61316f 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -4554,7 +4554,7 @@ commands:
4554(defun gnus-article-stop-animations () 4554(defun gnus-article-stop-animations ()
4555 (dolist (timer (and (boundp 'timer-list) 4555 (dolist (timer (and (boundp 'timer-list)
4556 timer-list)) 4556 timer-list))
4557 (when (eq (elt timer 5) 'image-animate-timeout) 4557 (when (eq (gnus-timer--function timer) 'image-animate-timeout)
4558 (cancel-timer timer)))) 4558 (cancel-timer timer))))
4559 4559
4560(defun gnus-stop-downloads () 4560(defun gnus-stop-downloads ()
diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el
index 115c5777448..671c566d09f 100644
--- a/lisp/gnus/gnus-demon.el
+++ b/lisp/gnus/gnus-demon.el
@@ -144,9 +144,12 @@ marked with SPECIAL."
144 (* (gnus-demon-time-to-step time) gnus-demon-timestep)) 144 (* (gnus-demon-time-to-step time) gnus-demon-timestep))
145 (t 145 (t
146 (* time gnus-demon-timestep)))) 146 (* time gnus-demon-timestep))))
147 (idle (if (numberp idle) 147 (idle (cond ((numberp idle)
148 (* idle gnus-demon-timestep) 148 (* idle gnus-demon-timestep))
149 idle)) 149 ((and (eq idle t) (numberp time))
150 time)
151 (t
152 idle)))
150 153
151 (timer 154 (timer
152 (cond 155 (cond
diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el
index f33eb910c6a..f5e1c5ad691 100644
--- a/lisp/gnus/gnus-fun.el
+++ b/lisp/gnus/gnus-fun.el
@@ -278,6 +278,10 @@ colors of the displayed X-Faces."
278 values)) 278 values))
279 (mapconcat 'identity values " "))) 279 (mapconcat 'identity values " ")))
280 280
281(defun gnus-funcall-no-warning (function &rest args)
282 (when (fboundp function)
283 (apply function args)))
284
281(provide 'gnus-fun) 285(provide 'gnus-fun)
282 286
283;;; gnus-fun.el ends here 287;;; gnus-fun.el ends here
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 2f6fc0ccd19..8c7d0165976 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -2388,7 +2388,7 @@ specified by `gnus-gmane-group-download-format'."
2388 group start (+ start range))) 2388 group start (+ start range)))
2389 (write-region (point-min) (point-max) tmpfile) 2389 (write-region (point-min) (point-max) tmpfile)
2390 (gnus-group-read-ephemeral-group 2390 (gnus-group-read-ephemeral-group
2391 (format "%s.start-%s.range-%s" group start range) 2391 (format "nndoc+ephemeral:%s.start-%s.range-%s" group start range)
2392 `(nndoc ,tmpfile 2392 `(nndoc ,tmpfile
2393 (nndoc-article-type mbox)))) 2393 (nndoc-article-type mbox))))
2394 (delete-file tmpfile))) 2394 (delete-file tmpfile)))
@@ -2481,7 +2481,8 @@ the bug number, and browsing the URL must return mbox output."
2481 "/.*$" "")))) 2481 "/.*$" ""))))
2482 (write-region (point-min) (point-max) tmpfile) 2482 (write-region (point-min) (point-max) tmpfile)
2483 (gnus-group-read-ephemeral-group 2483 (gnus-group-read-ephemeral-group
2484 "gnus-read-ephemeral-bug" 2484 (format "nndoc+ephemeral:bug#%s"
2485 (mapconcat 'number-to-string ids ","))
2485 `(nndoc ,tmpfile 2486 `(nndoc ,tmpfile
2486 (nndoc-article-type mbox)) 2487 (nndoc-article-type mbox))
2487 nil window-conf)) 2488 nil window-conf))
@@ -4670,6 +4671,8 @@ you the groups that have both dormant articles and cached articles."
4670 (setq mark gnus-expirable-mark)) 4671 (setq mark gnus-expirable-mark))
4671 (setq mark (gnus-request-update-mark 4672 (setq mark (gnus-request-update-mark
4672 group article mark)) 4673 group article mark))
4674 (gnus-request-set-mark
4675 group (list (list (list article) 'add '(read))))
4673 (gnus-mark-article-as-read article mark) 4676 (gnus-mark-article-as-read article mark)
4674 (setq gnus-newsgroup-active (gnus-active group)) 4677 (setq gnus-newsgroup-active (gnus-active group))
4675 (when active 4678 (when active
diff --git a/lisp/gnus/gnus-logic.el b/lisp/gnus/gnus-logic.el
index 954295438c9..a440b779930 100644
--- a/lisp/gnus/gnus-logic.el
+++ b/lisp/gnus/gnus-logic.el
@@ -180,46 +180,51 @@
180 (setq header "article")) 180 (setq header "article"))
181 (with-current-buffer nntp-server-buffer 181 (with-current-buffer nntp-server-buffer
182 (let* ((request-func (cond ((string= "head" header) 182 (let* ((request-func (cond ((string= "head" header)
183 'gnus-request-head) 183 'gnus-request-head)
184 ((string= "body" header) 184 ;; We need to peek at the headers to detect the
185 'gnus-request-body) 185 ;; content encoding
186 (t 'gnus-request-article))) 186 ((string= "body" header)
187 ofunc article) 187 'gnus-request-article)
188 (t 'gnus-request-article)))
189 ofunc article handles)
188 ;; Not all backends support partial fetching. In that case, we 190 ;; Not all backends support partial fetching. In that case, we
189 ;; just fetch the entire article. 191 ;; just fetch the entire article.
190 (unless (gnus-check-backend-function 192 (unless (gnus-check-backend-function
191 (intern (concat "request-" header)) 193 (intern (concat "request-" header))
192 gnus-newsgroup-name) 194 gnus-newsgroup-name)
193 (setq ofunc request-func) 195 (setq ofunc request-func)
194 (setq request-func 'gnus-request-article)) 196 (setq request-func 'gnus-request-article))
195 (setq article (mail-header-number gnus-advanced-headers)) 197 (setq article (mail-header-number gnus-advanced-headers))
196 (gnus-message 7 "Scoring article %s..." article) 198 (gnus-message 7 "Scoring article %s..." article)
197 (when (funcall request-func article gnus-newsgroup-name) 199 (when (funcall request-func article gnus-newsgroup-name)
198 (goto-char (point-min)) 200 (when (string= "body" header)
199 ;; If just parts of the article is to be searched and the 201 (setq handles (gnus-score-decode-text-parts)))
200 ;; backend didn't support partial fetching, we just narrow to 202 (goto-char (point-min))
201 ;; the relevant parts. 203 ;; If just parts of the article is to be searched and the
202 (when ofunc 204 ;; backend didn't support partial fetching, we just narrow to
203 (if (eq ofunc 'gnus-request-head) 205 ;; the relevant parts.
204 (narrow-to-region 206 (when ofunc
205 (point) 207 (if (eq ofunc 'gnus-request-head)
206 (or (search-forward "\n\n" nil t) (point-max))) 208 (narrow-to-region
207 (narrow-to-region 209 (point)
208 (or (search-forward "\n\n" nil t) (point)) 210 (or (search-forward "\n\n" nil t) (point-max)))
209 (point-max)))) 211 (narrow-to-region
210 (let* ((case-fold-search (not (eq (downcase (symbol-name type)) 212 (or (search-forward "\n\n" nil t) (point))
211 (symbol-name type)))) 213 (point-max))))
212 (search-func 214 (let* ((case-fold-search (not (eq (downcase (symbol-name type))
213 (cond ((memq type '(r R regexp Regexp)) 215 (symbol-name type))))
214 're-search-forward) 216 (search-func
215 ((memq type '(s S string String)) 217 (cond ((memq type '(r R regexp Regexp))
216 'search-forward) 218 're-search-forward)
217 (t 219 ((memq type '(s S string String))
218 (error "Invalid match type: %s" type))))) 220 'search-forward)
219 (goto-char (point-min)) 221 (t
220 (prog1 222 (error "Invalid match type: %s" type)))))
221 (funcall search-func match nil t) 223 (goto-char (point-min))
222 (widen))))))) 224 (prog1
225 (funcall search-func match nil t)
226 (widen)))
227 (when handles (mm-destroy-parts handles))))))
223 228
224(provide 'gnus-logic) 229(provide 'gnus-logic)
225 230
diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el
index c5129958997..5104a56c6e7 100644
--- a/lisp/gnus/gnus-notifications.el
+++ b/lisp/gnus/gnus-notifications.el
@@ -29,13 +29,16 @@
29 29
30;;; Code: 30;;; Code:
31 31
32(require 'notifications nil t) 32(ignore-errors
33 (require 'notifications))
33(require 'gnus-sum) 34(require 'gnus-sum)
34(require 'gnus-group) 35(require 'gnus-group)
35(require 'gnus-int) 36(require 'gnus-int)
36(require 'gnus-art) 37(require 'gnus-art)
37(require 'gnus-util) 38(require 'gnus-util)
38(require 'google-contacts nil t) ; Optional 39(ignore-errors
40 (require 'google-contacts)) ; Optional
41(require 'gnus-fun)
39 42
40(defgroup gnus-notifications nil 43(defgroup gnus-notifications nil
41 "Send notifications on new message in Gnus." 44 "Send notifications on new message in Gnus."
@@ -81,12 +84,14 @@ not get notifications."
81 "Send a notification about a new mail. 84 "Send a notification about a new mail.
82Return a notification id if any, or t on success." 85Return a notification id if any, or t on success."
83 (if (fboundp 'notifications-notify) 86 (if (fboundp 'notifications-notify)
84 (notifications-notify 87 (gnus-funcall-no-warning
88 'notifications-notify
85 :title from 89 :title from
86 :body subject 90 :body subject
87 :actions '("read" "Read") 91 :actions '("read" "Read")
88 :on-action 'gnus-notifications-action 92 :on-action 'gnus-notifications-action
89 :app-icon (image-search-load-path "gnus/gnus.png") 93 :app-icon (gnus-funcall-no-warning
94 'image-search-load-path "gnus/gnus.png")
90 :app-name "Gnus" 95 :app-name "Gnus"
91 :category "email.arrived" 96 :category "email.arrived"
92 :timeout gnus-notifications-timeout 97 :timeout gnus-notifications-timeout
@@ -100,7 +105,8 @@ Return a notification id if any, or t on success."
100 (let ((google-photo (when (and gnus-notifications-use-google-contacts 105 (let ((google-photo (when (and gnus-notifications-use-google-contacts
101 (fboundp 'google-contacts-get-photo)) 106 (fboundp 'google-contacts-get-photo))
102 (ignore-errors 107 (ignore-errors
103 (google-contacts-get-photo mail-address))))) 108 (gnus-funcall-no-warning
109 'google-contacts-get-photo mail-address)))))
104 (if google-photo 110 (if google-photo
105 google-photo 111 google-photo
106 (when gnus-notifications-use-gravatar 112 (when gnus-notifications-use-gravatar
@@ -160,8 +166,10 @@ This is typically a function to add in
160 (or (mail-fetch-field "From") ""))) 166 (or (mail-fetch-field "From") "")))
161 (address (cadr address-components))) 167 (address (cadr address-components)))
162 ;; Ignore mails from ourselves 168 ;; Ignore mails from ourselves
163 (unless (gnus-string-match-p gnus-ignored-from-addresses 169 (unless (and gnus-ignored-from-addresses
164 address) 170 address
171 (gnus-string-match-p gnus-ignored-from-addresses
172 address))
165 (let* ((photo-file (gnus-notifications-get-photo-file address)) 173 (let* ((photo-file (gnus-notifications-get-photo-file address))
166 (notification-id (gnus-notifications-notify 174 (notification-id (gnus-notifications-notify
167 (or (car address-components) address) 175 (or (car address-components) address)
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index f24d889216e..f215b845514 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -1717,105 +1717,140 @@ score in `gnus-newsgroup-scored' by SCORE."
1717 (setq entries rest))))) 1717 (setq entries rest)))))
1718 nil) 1718 nil)
1719 1719
1720(defun gnus-score-decode-text-parts ()
1721 (labels ((mm-text-parts (handle)
1722 (cond ((stringp (car handle))
1723 (let ((parts (mapcan #'mm-text-parts (cdr handle))))
1724 (if (equal "multipart/alternative" (car handle))
1725 ;; pick the first supported alternative
1726 (list (car parts))
1727 parts)))
1728
1729 ((bufferp (car handle))
1730 (when (string-match "^text/" (mm-handle-media-type handle))
1731 (list handle)))
1732
1733 (t (mapcan #'mm-text-parts handle))))
1734 (my-mm-display-part (handle)
1735 (when handle
1736 (save-restriction
1737 (narrow-to-region (point) (point))
1738 (mm-display-inline handle)
1739 (goto-char (point-max))))))
1740
1741 (let (;(mm-text-html-renderer 'w3m-standalone)
1742 (handles (mm-dissect-buffer t)))
1743 (save-excursion
1744 (article-goto-body)
1745 (delete-region (point) (point-max))
1746 (mapc #'my-mm-display-part (mm-text-parts handles))
1747 handles))))
1748
1720(defun gnus-score-body (scores header now expire &optional trace) 1749(defun gnus-score-body (scores header now expire &optional trace)
1721 (if gnus-agent-fetching 1750 (if gnus-agent-fetching
1722 nil 1751 nil
1723 (save-excursion 1752 (save-excursion
1724 (setq gnus-scores-articles 1753 (setq gnus-scores-articles
1725 (sort gnus-scores-articles 1754 (sort gnus-scores-articles
1726 (lambda (a1 a2) 1755 (lambda (a1 a2)
1727 (< (mail-header-number (car a1)) 1756 (< (mail-header-number (car a1))
1728 (mail-header-number (car a2)))))) 1757 (mail-header-number (car a2))))))
1729 (set-buffer nntp-server-buffer) 1758 (set-buffer nntp-server-buffer)
1730 (save-restriction 1759 (save-restriction
1731 (let* ((buffer-read-only nil) 1760 (let* ((buffer-read-only nil)
1732 (articles gnus-scores-articles) 1761 (articles gnus-scores-articles)
1733 (all-scores scores) 1762 (all-scores scores)
1734 (request-func (cond ((string= "head" header) 1763 (request-func (cond ((string= "head" header)
1735 'gnus-request-head) 1764 'gnus-request-head)
1736 ((string= "body" header) 1765 ;; We need to peek at the headers to detect
1737 'gnus-request-body) 1766 ;; the content encoding
1738 (t 'gnus-request-article))) 1767 ((string= "body" header)
1739 entries alist ofunc article last) 1768 'gnus-request-article)
1740 (when articles 1769 (t 'gnus-request-article)))
1741 (setq last (mail-header-number (caar (last articles)))) 1770 entries alist ofunc article last)
1742 ;; Not all backends support partial fetching. In that case, 1771 (when articles
1743 ;; we just fetch the entire article. 1772 (setq last (mail-header-number (caar (last articles))))
1744 (unless (gnus-check-backend-function 1773 ;; Not all backends support partial fetching. In that case,
1745 (and (string-match "^gnus-" (symbol-name request-func)) 1774 ;; we just fetch the entire article.
1746 (intern (substring (symbol-name request-func) 1775 (unless (gnus-check-backend-function
1747 (match-end 0)))) 1776 (and (string-match "^gnus-" (symbol-name request-func))
1748 gnus-newsgroup-name) 1777 (intern (substring (symbol-name request-func)
1749 (setq ofunc request-func) 1778 (match-end 0))))
1750 (setq request-func 'gnus-request-article)) 1779 gnus-newsgroup-name)
1751 (while articles 1780 (setq ofunc request-func)
1752 (setq article (mail-header-number (caar articles))) 1781 (setq request-func 'gnus-request-article))
1753 (gnus-message 7 "Scoring article %s of %s..." article last) 1782 (while articles
1754 (widen) 1783 (setq article (mail-header-number (caar articles)))
1755 (when (funcall request-func article gnus-newsgroup-name) 1784 (gnus-message 7 "Scoring article %s of %s..." article last)
1756 (goto-char (point-min)) 1785 (widen)
1757 ;; If just parts of the article is to be searched, but the 1786 (let (handles)
1758 ;; backend didn't support partial fetching, we just narrow 1787 (when (funcall request-func article gnus-newsgroup-name)
1759 ;; to the relevant parts. 1788 (when (string= "body" header)
1760 (when ofunc 1789 (setq handles (gnus-score-decode-text-parts)))
1761 (if (eq ofunc 'gnus-request-head) 1790 (goto-char (point-min))
1762 (narrow-to-region 1791 ;; If just parts of the article is to be searched, but the
1763 (point) 1792 ;; backend didn't support partial fetching, we just narrow
1764 (or (search-forward "\n\n" nil t) (point-max))) 1793 ;; to the relevant parts.
1765 (narrow-to-region 1794 (when ofunc
1766 (or (search-forward "\n\n" nil t) (point)) 1795 (if (eq ofunc 'gnus-request-head)
1767 (point-max)))) 1796 (narrow-to-region
1768 (setq scores all-scores) 1797 (point)
1769 ;; Find matches. 1798 (or (search-forward "\n\n" nil t) (point-max)))
1770 (while scores 1799 (narrow-to-region
1771 (setq alist (pop scores) 1800 (or (search-forward "\n\n" nil t) (point))
1772 entries (assoc header alist)) 1801 (point-max))))
1773 (while (cdr entries) ;First entry is the header index. 1802 (setq scores all-scores)
1774 (let* ((rest (cdr entries)) 1803 ;; Find matches.
1775 (kill (car rest)) 1804 (while scores
1776 (match (nth 0 kill)) 1805 (setq alist (pop scores)
1777 (type (or (nth 3 kill) 's)) 1806 entries (assoc header alist))
1778 (score (or (nth 1 kill) 1807 (while (cdr entries) ;First entry is the header index.
1779 gnus-score-interactive-default-score)) 1808 (let* ((rest (cdr entries))
1780 (date (nth 2 kill)) 1809 (kill (car rest))
1781 (found nil) 1810 (match (nth 0 kill))
1782 (case-fold-search 1811 (type (or (nth 3 kill) 's))
1783 (not (or (eq type 'R) (eq type 'S) 1812 (score (or (nth 1 kill)
1784 (eq type 'Regexp) (eq type 'String)))) 1813 gnus-score-interactive-default-score))
1785 (search-func 1814 (date (nth 2 kill))
1786 (cond ((or (eq type 'r) (eq type 'R) 1815 (found nil)
1787 (eq type 'regexp) (eq type 'Regexp)) 1816 (case-fold-search
1788 're-search-forward) 1817 (not (or (eq type 'R) (eq type 'S)
1789 ((or (eq type 's) (eq type 'S) 1818 (eq type 'Regexp) (eq type 'String))))
1790 (eq type 'string) (eq type 'String)) 1819 (search-func
1791 'search-forward) 1820 (cond ((or (eq type 'r) (eq type 'R)
1792 (t 1821 (eq type 'regexp) (eq type 'Regexp))
1793 (error "Invalid match type: %s" type))))) 1822 're-search-forward)
1794 (goto-char (point-min)) 1823 ((or (eq type 's) (eq type 'S)
1795 (when (funcall search-func match nil t) 1824 (eq type 'string) (eq type 'String))
1796 ;; Found a match, update scores. 1825 'search-forward)
1797 (setcdr (car articles) (+ score (cdar articles))) 1826 (t
1798 (setq found t) 1827 (error "Invalid match type: %s" type)))))
1799 (when trace 1828 (goto-char (point-min))
1800 (push 1829 (when (funcall search-func match nil t)
1801 (cons (car-safe (rassq alist gnus-score-cache)) 1830 ;; Found a match, update scores.
1802 kill) 1831 (setcdr (car articles) (+ score (cdar articles)))
1803 gnus-score-trace))) 1832 (setq found t)
1804 ;; Update expire date 1833 (when trace
1805 (unless trace 1834 (push
1806 (cond 1835 (cons (car-safe (rassq alist gnus-score-cache))
1807 ((null date)) ;Permanent entry. 1836 kill)
1808 ((and found gnus-update-score-entry-dates) 1837 gnus-score-trace)))
1809 ;; Match, update date. 1838 ;; Update expire date
1810 (gnus-score-set 'touched '(t) alist) 1839 (unless trace
1811 (setcar (nthcdr 2 kill) now)) 1840 (cond
1812 ((and expire (< date expire)) ;Old entry, remove. 1841 ((null date)) ;Permanent entry.
1813 (gnus-score-set 'touched '(t) alist) 1842 ((and found gnus-update-score-entry-dates)
1814 (setcdr entries (cdr rest)) 1843 ;; Match, update date.
1815 (setq rest entries)))) 1844 (gnus-score-set 'touched '(t) alist)
1816 (setq entries rest))))) 1845 (setcar (nthcdr 2 kill) now))
1817 (setq articles (cdr articles))))))) 1846 ((and expire (< date expire)) ;Old entry, remove.
1818 nil)) 1847 (gnus-score-set 'touched '(t) alist)
1848 (setcdr entries (cdr rest))
1849 (setq rest entries))))
1850 (setq entries rest))))
1851 (when handles (mm-destroy-parts handles))))
1852 (setq articles (cdr articles)))))))
1853 nil))
1819 1854
1820(defun gnus-score-thread (scores header now expire &optional trace) 1855(defun gnus-score-thread (scores header now expire &optional trace)
1821 (gnus-score-followup scores header now expire trace t)) 1856 (gnus-score-followup scores header now expire trace t))
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index 66509c939dc..f58cb80311a 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -490,8 +490,7 @@ The following commands are available:
490 (error "No such server: %s" server)) 490 (error "No such server: %s" server))
491 (gnus-server-set-status method 'ok) 491 (gnus-server-set-status method 'ok)
492 (prog1 492 (prog1
493 (or (gnus-open-server method) 493 (gnus-open-server method)
494 (progn (message "Couldn't open %s" server) nil))
495 (gnus-server-update-server server) 494 (gnus-server-update-server server)
496 (gnus-server-position-point)))) 495 (gnus-server-position-point))))
497 496
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index 26178afa864..f5e1077f8c4 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -1926,6 +1926,18 @@ Same as `string-match' except this function does not change the match data."
1926 (save-match-data 1926 (save-match-data
1927 (string-match regexp string start)))) 1927 (string-match regexp string start))))
1928 1928
1929(if (fboundp 'string-prefix-p)
1930 (defalias 'gnus-string-prefix-p 'string-prefix-p)
1931 (defun gnus-string-prefix-p (str1 str2 &optional ignore-case)
1932 "Return non-nil if STR1 is a prefix of STR2.
1933If IGNORE-CASE is non-nil, the comparison is done without paying attention
1934to case differences."
1935 (and (<= (length str1) (length str2))
1936 (let ((prefix (substring str2 0 (length str1))))
1937 (if ignore-case
1938 (string-equal (downcase str1) (downcase prefix))
1939 (string-equal str1 prefix))))))
1940
1929(eval-and-compile 1941(eval-and-compile
1930 (if (fboundp 'macroexpand-all) 1942 (if (fboundp 'macroexpand-all)
1931 (defalias 'gnus-macroexpand-all 'macroexpand-all) 1943 (defalias 'gnus-macroexpand-all 'macroexpand-all)
@@ -1952,6 +1964,11 @@ definitions to shadow the loaded ones for use in file byte-compilation."
1952(defun gnus-bound-and-true-p (sym) 1964(defun gnus-bound-and-true-p (sym)
1953 (and (boundp sym) (symbol-value sym))) 1965 (and (boundp sym) (symbol-value sym)))
1954 1966
1967(if (fboundp 'timer--function)
1968 (defalias 'gnus-timer--function 'timer--function)
1969 (defun gnus-timer--function (timer)
1970 (elt timer 5)))
1971
1955(provide 'gnus-util) 1972(provide 'gnus-util)
1956 1973
1957;;; gnus-util.el ends here 1974;;; gnus-util.el ends here
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 5862e7807a2..8fbde5c8ecc 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -3824,12 +3824,28 @@ You should probably use `gnus-find-method-for-group' instead."
3824 "Go through PARAMETERS and expand them according to the match data." 3824 "Go through PARAMETERS and expand them according to the match data."
3825 (let (new) 3825 (let (new)
3826 (dolist (elem parameters) 3826 (dolist (elem parameters)
3827 (if (and (stringp (cdr elem)) 3827 (cond
3828 (string-match "\\\\[0-9&]" (cdr elem))) 3828 ((and (stringp (cdr elem))
3829 (push (cons (car elem) 3829 (string-match "\\\\[0-9&]" (cdr elem)))
3830 (gnus-expand-group-parameter match (cdr elem) group)) 3830 (push (cons (car elem)
3831 new) 3831 (gnus-expand-group-parameter match (cdr elem) group))
3832 (push elem new))) 3832 new))
3833 ;; For `sieve' group parameters, perform substitutions for every
3834 ;; string within the match rule. This allows for parameters such
3835 ;; as:
3836 ;; ("list\\.\\(.*\\)"
3837 ;; (sieve header :is "list-id" "<\\1.domain.org>"))
3838 ((eq 'sieve (car elem))
3839 (push (mapcar (lambda (sieve-elem)
3840 (if (and (stringp sieve-elem)
3841 (string-match "\\\\[0-9&]" sieve-elem))
3842 (gnus-expand-group-parameter match sieve-elem
3843 group)
3844 sieve-elem))
3845 (cdr elem))
3846 new))
3847 (t
3848 (push elem new))))
3833 new)) 3849 new))
3834 3850
3835(defun gnus-group-fast-parameter (group symbol &optional allow-list) 3851(defun gnus-group-fast-parameter (group symbol &optional allow-list)
@@ -3861,9 +3877,20 @@ The function `gnus-group-find-parameter' will do that for you."
3861 (when this-result 3877 (when this-result
3862 (setq result (car this-result)) 3878 (setq result (car this-result))
3863 ;; Expand if necessary. 3879 ;; Expand if necessary.
3864 (if (and (stringp result) (string-match "\\\\[0-9&]" result)) 3880 (cond
3865 (setq result (gnus-expand-group-parameter 3881 ((and (stringp result) (string-match "\\\\[0-9&]" result))
3866 (car head) result group))))))) 3882 (setq result (gnus-expand-group-parameter
3883 (car head) result group)))
3884 ;; For `sieve' group parameters, perform substitutions
3885 ;; for every string within the match rule (see above).
3886 ((eq symbol 'sieve)
3887 (setq result
3888 (mapcar (lambda (elem)
3889 (if (stringp elem)
3890 (gnus-expand-group-parameter (car head)
3891 elem group)
3892 elem))
3893 result))))))))
3867 ;; Done. 3894 ;; Done.
3868 result)))) 3895 result))))
3869 3896
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 18088423eb0..42911ce0648 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -3292,11 +3292,33 @@ or in the synonym headers, defined by `message-header-synonyms'."
3292(defun message-insert-newsgroups () 3292(defun message-insert-newsgroups ()
3293 "Insert the Newsgroups header from the article being replied to." 3293 "Insert the Newsgroups header from the article being replied to."
3294 (interactive) 3294 (interactive)
3295 (when (and (message-position-on-field "Newsgroups") 3295 (let ((old-newsgroups (mail-fetch-field "newsgroups"))
3296 (mail-fetch-field "newsgroups") 3296 (new-newsgroups (message-fetch-reply-field "newsgroups"))
3297 (not (string-match "\\` *\\'" (mail-fetch-field "newsgroups")))) 3297 (first t)
3298 (insert ",")) 3298 insert-newsgroups)
3299 (insert (or (message-fetch-reply-field "newsgroups") ""))) 3299 (message-position-on-field "Newsgroups")
3300 (cond
3301 ((not new-newsgroups)
3302 (error "No Newsgroups to insert"))
3303 ((not old-newsgroups)
3304 (insert new-newsgroups))
3305 (t
3306 (setq new-newsgroups (split-string new-newsgroups "[, ]+")
3307 old-newsgroups (split-string old-newsgroups "[, ]+"))
3308 (dolist (group new-newsgroups)
3309 (unless (member group old-newsgroups)
3310 (push group insert-newsgroups)))
3311 (if (null insert-newsgroups)
3312 (error "Newgroup%s already in the header"
3313 (if (> (length new-newsgroups) 1)
3314 "s" ""))
3315 (when old-newsgroups
3316 (setq first nil))
3317 (dolist (group insert-newsgroups)
3318 (unless first
3319 (insert ","))
3320 (setq first nil)
3321 (insert group)))))))
3300 3322
3301 3323
3302 3324
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index 7139a528e11..74a693a9c61 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -77,6 +77,56 @@
77 77
78(defconst nnmaildir-version "Gnus") 78(defconst nnmaildir-version "Gnus")
79 79
80(defconst nnmaildir-flag-mark-mapping
81 '((?F . tick)
82 (?R . reply)
83 (?S . read))
84 "Alist mapping Maildir filename flags to Gnus marks.
85Maildir filenames are of the form \"unique-id:2,FLAGS\",
86where FLAGS are a string of characters in ASCII order.
87Some of the FLAGS correspond to Gnus marks.")
88
89(defsubst nnmaildir--mark-to-flag (mark)
90 "Find the Maildir flag that corresponds to MARK (an atom).
91Return a character, or `nil' if not found.
92See `nnmaildir-flag-mark-mapping'."
93 (car (rassq mark nnmaildir-flag-mark-mapping)))
94
95(defsubst nnmaildir--flag-to-mark (flag)
96 "Find the Gnus mark that corresponds to FLAG (a character).
97Return an atom, or `nil' if not found.
98See `nnmaildir-flag-mark-mapping'."
99 (cdr (assq flag nnmaildir-flag-mark-mapping)))
100
101(defun nnmaildir--ensure-suffix (filename)
102 "Ensure that FILENAME contains the suffix \":2,\"."
103 (if (gnus-string-match-p ":2," filename)
104 filename
105 (concat filename ":2,")))
106
107(defun nnmaildir--add-flag (flag suffix)
108 "Return a copy of SUFFIX where FLAG is set.
109SUFFIX should start with \":2,\"."
110 (unless (gnus-string-match-p "^:2," suffix)
111 (error "Invalid suffix `%s'" suffix))
112 (let* ((flags (substring suffix 3))
113 (flags-as-list (append flags nil))
114 (new-flags
115 (concat (gnus-delete-duplicates
116 ;; maildir flags must be sorted
117 (sort (cons flag flags-as-list) '<)))))
118 (concat ":2," new-flags)))
119
120(defun nnmaildir--remove-flag (flag suffix)
121 "Return a copy of SUFFIX where FLAG is cleared.
122SUFFIX should start with \":2,\"."
123 (unless (gnus-string-match-p "^:2," suffix)
124 (error "Invalid suffix `%s'" suffix))
125 (let* ((flags (substring suffix 3))
126 (flags-as-list (append flags nil))
127 (new-flags (concat (delq flag flags-as-list))))
128 (concat ":2," new-flags)))
129
80(defvar nnmaildir-article-file-name nil 130(defvar nnmaildir-article-file-name nil
81 "*The filename of the most recently requested article. This variable is set 131 "*The filename of the most recently requested article. This variable is set
82by nnmaildir-request-article.") 132by nnmaildir-request-article.")
@@ -152,6 +202,16 @@ by nnmaildir-request-article.")
152 (gnm nil) ;; flag: split from mail-sources? 202 (gnm nil) ;; flag: split from mail-sources?
153 (target-prefix nil :type string)) ;; symlink target prefix 203 (target-prefix nil :type string)) ;; symlink target prefix
154 204
205(defun nnmaildir--article-set-flags (article new-suffix curdir)
206 (let* ((prefix (nnmaildir--art-prefix article))
207 (suffix (nnmaildir--art-suffix article))
208 (article-file (concat curdir prefix suffix))
209 (new-name (concat curdir prefix new-suffix)))
210 (unless (file-exists-p article-file)
211 (error "Couldn't find article file %s" article-file))
212 (rename-file article-file new-name 'replace)
213 (setf (nnmaildir--art-suffix article) new-suffix)))
214
155(defun nnmaildir--expired-article (group article) 215(defun nnmaildir--expired-article (group article)
156 (setf (nnmaildir--art-nov article) nil) 216 (setf (nnmaildir--art-nov article) nil)
157 (let ((flist (nnmaildir--grp-flist group)) 217 (let ((flist (nnmaildir--grp-flist group))
@@ -208,29 +268,33 @@ by nnmaildir-request-article.")
208 (eval param)) 268 (eval param))
209 269
210(defmacro nnmaildir--with-nntp-buffer (&rest body) 270(defmacro nnmaildir--with-nntp-buffer (&rest body)
271 (declare (debug (body)))
211 `(with-current-buffer nntp-server-buffer 272 `(with-current-buffer nntp-server-buffer
212 ,@body)) 273 ,@body))
213(defmacro nnmaildir--with-work-buffer (&rest body) 274(defmacro nnmaildir--with-work-buffer (&rest body)
275 (declare (debug (body)))
214 `(with-current-buffer (get-buffer-create " *nnmaildir work*") 276 `(with-current-buffer (get-buffer-create " *nnmaildir work*")
215 ,@body)) 277 ,@body))
216(defmacro nnmaildir--with-nov-buffer (&rest body) 278(defmacro nnmaildir--with-nov-buffer (&rest body)
279 (declare (debug (body)))
217 `(with-current-buffer (get-buffer-create " *nnmaildir nov*") 280 `(with-current-buffer (get-buffer-create " *nnmaildir nov*")
218 ,@body)) 281 ,@body))
219(defmacro nnmaildir--with-move-buffer (&rest body) 282(defmacro nnmaildir--with-move-buffer (&rest body)
283 (declare (debug (body)))
220 `(with-current-buffer (get-buffer-create " *nnmaildir move*") 284 `(with-current-buffer (get-buffer-create " *nnmaildir move*")
221 ,@body)) 285 ,@body))
222 286
223(defmacro nnmaildir--subdir (dir subdir) 287(defsubst nnmaildir--subdir (dir subdir)
224 `(file-name-as-directory (concat ,dir ,subdir))) 288 (file-name-as-directory (concat dir subdir)))
225(defmacro nnmaildir--srvgrp-dir (srv-dir gname) 289(defsubst nnmaildir--srvgrp-dir (srv-dir gname)
226 `(nnmaildir--subdir ,srv-dir ,gname)) 290 (nnmaildir--subdir srv-dir gname))
227(defmacro nnmaildir--tmp (dir) `(nnmaildir--subdir ,dir "tmp")) 291(defsubst nnmaildir--tmp (dir) (nnmaildir--subdir dir "tmp"))
228(defmacro nnmaildir--new (dir) `(nnmaildir--subdir ,dir "new")) 292(defsubst nnmaildir--new (dir) (nnmaildir--subdir dir "new"))
229(defmacro nnmaildir--cur (dir) `(nnmaildir--subdir ,dir "cur")) 293(defsubst nnmaildir--cur (dir) (nnmaildir--subdir dir "cur"))
230(defmacro nnmaildir--nndir (dir) `(nnmaildir--subdir ,dir ".nnmaildir")) 294(defsubst nnmaildir--nndir (dir) (nnmaildir--subdir dir ".nnmaildir"))
231(defmacro nnmaildir--nov-dir (dir) `(nnmaildir--subdir ,dir "nov")) 295(defsubst nnmaildir--nov-dir (dir) (nnmaildir--subdir dir "nov"))
232(defmacro nnmaildir--marks-dir (dir) `(nnmaildir--subdir ,dir "marks")) 296(defsubst nnmaildir--marks-dir (dir) (nnmaildir--subdir dir "marks"))
233(defmacro nnmaildir--num-dir (dir) `(nnmaildir--subdir ,dir "num")) 297(defsubst nnmaildir--num-dir (dir) (nnmaildir--subdir dir "num"))
234 298
235(defmacro nnmaildir--unlink (file-arg) 299(defmacro nnmaildir--unlink (file-arg)
236 `(let ((file ,file-arg)) 300 `(let ((file ,file-arg))
@@ -305,6 +369,7 @@ by nnmaildir-request-article.")
305 string) 369 string)
306 370
307(defmacro nnmaildir--condcase (errsym body &rest handler) 371(defmacro nnmaildir--condcase (errsym body &rest handler)
372 (declare (debug (sexp form body)))
308 `(condition-case ,errsym 373 `(condition-case ,errsym
309 (let ((system-messages-locale "C")) ,body) 374 (let ((system-messages-locale "C")) ,body)
310 (error . ,handler))) 375 (error . ,handler)))
@@ -759,7 +824,7 @@ by nnmaildir-request-article.")
759 (dolist (file (funcall ls ndir nil "\\`[^.]" 'nosort)) 824 (dolist (file (funcall ls ndir nil "\\`[^.]" 'nosort))
760 (setq x (concat ndir file)) 825 (setq x (concat ndir file))
761 (and (time-less-p (nth 5 (file-attributes x)) (current-time)) 826 (and (time-less-p (nth 5 (file-attributes x)) (current-time))
762 (rename-file x (concat cdir file ":2,")))) 827 (rename-file x (concat cdir (nnmaildir--ensure-suffix file)))))
763 (setf (nnmaildir--grp-new group) nattr)) 828 (setf (nnmaildir--grp-new group) nattr))
764 (setq cattr (nth 5 (file-attributes cdir))) 829 (setq cattr (nth 5 (file-attributes cdir)))
765 (if (equal cattr (nnmaildir--grp-cur group)) 830 (if (equal cattr (nnmaildir--grp-cur group))
@@ -784,11 +849,23 @@ by nnmaildir-request-article.")
784 cdir (nnmaildir--marks-dir nndir) 849 cdir (nnmaildir--marks-dir nndir)
785 ndir (nnmaildir--subdir cdir "tick") 850 ndir (nnmaildir--subdir cdir "tick")
786 cdir (nnmaildir--subdir cdir "read")) 851 cdir (nnmaildir--subdir cdir "read"))
787 (dolist (file files) 852 (dolist (prefix-suffix files)
788 (setq file (car file)) 853 (let ((prefix (car prefix-suffix))
789 (if (or (not (file-exists-p (concat cdir file))) 854 (suffix (cdr prefix-suffix)))
790 (file-exists-p (concat ndir file))) 855 ;; increase num for each unread or ticked article
791 (setq num (1+ num))))) 856 (when (or
857 ;; first look for marks in suffix, if it's valid...
858 (when (and (stringp suffix)
859 (gnus-string-prefix-p ":2," suffix))
860 (or
861 (not (gnus-string-match-p
862 (string (nnmaildir--mark-to-flag 'read)) suffix))
863 (gnus-string-match-p
864 (string (nnmaildir--mark-to-flag 'tick)) suffix)))
865 ;; then look in marks directories
866 (not (file-exists-p (concat cdir prefix)))
867 (file-exists-p (concat ndir prefix)))
868 (incf num)))))
792 (setf (nnmaildir--grp-cache group) (make-vector num nil)) 869 (setf (nnmaildir--grp-cache group) (make-vector num nil))
793 (let ((inhibit-quit t)) 870 (let ((inhibit-quit t))
794 (set (intern gname groups) group)) 871 (set (intern gname groups) group))
@@ -916,12 +993,15 @@ by nnmaildir-request-article.")
916 "\n"))))) 993 "\n")))))
917 'group) 994 'group)
918 995
919(defun nnmaildir-request-marks (gname info &optional server) 996(defun nnmaildir-request-update-info (gname info &optional server)
920 (let ((group (nnmaildir--prepare server gname)) 997 (let* ((group (nnmaildir--prepare server gname))
921 pgname flist always-marks never-marks old-marks dotfile num dir 998 (curdir (nnmaildir--cur
922 markdirs marks mark ranges markdir article read end new-marks ls 999 (nnmaildir--srvgrp-dir
923 old-mmth new-mmth mtime mark-sym existing missing deactivate-mark 1000 (nnmaildir--srv-dir nnmaildir--cur-server) gname)))
924 article-list) 1001 (curdir-mtime (nth 5 (file-attributes curdir)))
1002 pgname flist always-marks never-marks old-marks dotfile num dir
1003 all-marks marks mark ranges markdir read end new-marks ls
1004 old-mmth new-mmth mtime mark-sym existing missing deactivate-mark)
925 (catch 'return 1005 (catch 'return
926 (unless group 1006 (unless group
927 (setf (nnmaildir--srv-error nnmaildir--cur-server) 1007 (setf (nnmaildir--srv-error nnmaildir--cur-server)
@@ -950,34 +1030,71 @@ by nnmaildir-request-article.")
950 dir (nnmaildir--nndir dir) 1030 dir (nnmaildir--nndir dir)
951 dir (nnmaildir--marks-dir dir) 1031 dir (nnmaildir--marks-dir dir)
952 ls (nnmaildir--group-ls nnmaildir--cur-server pgname) 1032 ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
953 markdirs (funcall ls dir nil "\\`[^.]" 'nosort) 1033 all-marks (gnus-delete-duplicates
954 new-mmth (nnmaildir--up2-1 (length markdirs)) 1034 ;; get mark names from mark dirs and from flag
1035 ;; mappings
1036 (append
1037 (mapcar 'cdr nnmaildir-flag-mark-mapping)
1038 (mapcar 'intern (funcall ls dir nil "\\`[^.]" 'nosort))))
1039 new-mmth (nnmaildir--up2-1 (length all-marks))
955 new-mmth (make-vector new-mmth 0) 1040 new-mmth (make-vector new-mmth 0)
956 old-mmth (nnmaildir--grp-mmth group)) 1041 old-mmth (nnmaildir--grp-mmth group))
957 (dolist (mark markdirs) 1042 (dolist (mark all-marks)
958 (setq markdir (nnmaildir--subdir dir mark) 1043 (setq markdir (nnmaildir--subdir dir (symbol-name mark))
959 mark-sym (intern mark)
960 ranges nil) 1044 ranges nil)
961 (catch 'got-ranges 1045 (catch 'got-ranges
962 (if (memq mark-sym never-marks) (throw 'got-ranges nil)) 1046 (if (memq mark never-marks) (throw 'got-ranges nil))
963 (when (memq mark-sym always-marks) 1047 (when (memq mark always-marks)
964 (setq ranges existing) 1048 (setq ranges existing)
965 (throw 'got-ranges nil)) 1049 (throw 'got-ranges nil))
966 (setq mtime (nth 5 (file-attributes markdir))) 1050 ;; Find the mtime for this mark. If this mark can be expressed as
967 (set (intern mark new-mmth) mtime) 1051 ;; a filename flag, get the later of the mtimes for markdir and
968 (when (equal mtime (symbol-value (intern-soft mark old-mmth))) 1052 ;; curdir, otherwise only the markdir counts.
969 (setq ranges (assq mark-sym old-marks)) 1053 (setq mtime
1054 (let ((markdir-mtime (nth 5 (file-attributes markdir))))
1055 (cond
1056 ((null (nnmaildir--mark-to-flag mark))
1057 markdir-mtime)
1058 ((null markdir-mtime)
1059 curdir-mtime)
1060 ((null curdir-mtime)
1061 ;; this should never happen...
1062 markdir-mtime)
1063 ((time-less-p markdir-mtime curdir-mtime)
1064 curdir-mtime)
1065 (t
1066 markdir-mtime))))
1067 (set (intern (symbol-name mark) new-mmth) mtime)
1068 (when (equal mtime (symbol-value (intern-soft (symbol-name mark) old-mmth)))
1069 (setq ranges (assq mark old-marks))
970 (if ranges (setq ranges (cdr ranges))) 1070 (if ranges (setq ranges (cdr ranges)))
971 (throw 'got-ranges nil)) 1071 (throw 'got-ranges nil))
972 (setq article-list nil) 1072 (let ((article-list nil))
973 (dolist (prefix (funcall ls markdir nil "\\`[^.]" 'nosort)) 1073 ;; Consider the article marked if it either has the flag in the
974 (setq article (nnmaildir--flist-art flist prefix)) 1074 ;; filename, or is in the markdir. As you'd rarely remove a
975 (if article 1075 ;; flag/mark, this should avoid losing information in the most
976 (setq article-list 1076 ;; common usage pattern.
977 (cons (nnmaildir--art-num article) article-list)))) 1077 (or
978 (setq ranges (gnus-add-to-range ranges (sort article-list '<)))) 1078 (let ((flag (nnmaildir--mark-to-flag mark)))
979 (if (eq mark-sym 'read) (setq read ranges) 1079 ;; If this mark has a corresponding maildir flag...
980 (if ranges (setq marks (cons (cons mark-sym ranges) marks))))) 1080 (when flag
1081 (let ((regexp
1082 (concat "\\`[^.].*:2,[A-Z]*" (string flag))))
1083 ;; ...then find all files with that flag.
1084 (dolist (filename (funcall ls curdir nil regexp 'nosort))
1085 (let* ((prefix (car (split-string filename ":2,")))
1086 (article (nnmaildir--flist-art flist prefix)))
1087 (when article
1088 (push (nnmaildir--art-num article) article-list)))))))
1089 ;; Also check Gnus-specific mark directory, if it exists.
1090 (when (file-directory-p markdir)
1091 (dolist (prefix (funcall ls markdir nil "\\`[^.]" 'nosort))
1092 (let ((article (nnmaildir--flist-art flist prefix)))
1093 (when article
1094 (push (nnmaildir--art-num article) article-list))))))
1095 (setq ranges (gnus-add-to-range ranges (sort article-list '<)))))
1096 (if (eq mark 'read) (setq read ranges)
1097 (if ranges (setq marks (cons (cons mark ranges) marks)))))
981 (gnus-info-set-read info (gnus-range-add read missing)) 1098 (gnus-info-set-read info (gnus-range-add read missing))
982 (gnus-info-set-marks info marks 'extend) 1099 (gnus-info-set-marks info marks 'extend)
983 (setf (nnmaildir--grp-mmth group) new-mmth) 1100 (setf (nnmaildir--grp-mmth group) new-mmth)
@@ -1525,39 +1642,63 @@ by nnmaildir-request-article.")
1525 didnt))) 1642 didnt)))
1526 1643
1527(defun nnmaildir-request-set-mark (gname actions &optional server) 1644(defun nnmaildir-request-set-mark (gname actions &optional server)
1528 (let ((group (nnmaildir--prepare server gname)) 1645 (let* ((group (nnmaildir--prepare server gname))
1529 (coding-system-for-write nnheader-file-coding-system) 1646 (curdir (nnmaildir--cur
1530 (buffer-file-coding-system nil) 1647 (nnmaildir--srvgrp-dir
1531 (file-coding-system-alist nil) 1648 (nnmaildir--srv-dir nnmaildir--cur-server)
1532 del-mark del-action add-action set-action marksdir nlist 1649 gname)))
1533 ranges begin end article all-marks todo-marks mdir mfile 1650 (coding-system-for-write nnheader-file-coding-system)
1534 pgname ls permarkfile deactivate-mark) 1651 (buffer-file-coding-system nil)
1652 (file-coding-system-alist nil)
1653 del-mark del-action add-action set-action marksdir nlist
1654 ranges begin end article all-marks todo-marks mdir mfile
1655 pgname ls permarkfile deactivate-mark)
1535 (setq del-mark 1656 (setq del-mark
1536 (lambda (mark) 1657 (lambda (mark)
1537 (setq mfile (nnmaildir--subdir marksdir (symbol-name mark)) 1658 (let ((prefix (nnmaildir--art-prefix article))
1538 mfile (concat mfile (nnmaildir--art-prefix article))) 1659 (suffix (nnmaildir--art-suffix article))
1539 (nnmaildir--unlink mfile)) 1660 (flag (nnmaildir--mark-to-flag mark)))
1661 (when flag
1662 ;; If this mark corresponds to a flag, remove the flag from
1663 ;; the file name.
1664 (nnmaildir--article-set-flags
1665 article (nnmaildir--remove-flag flag suffix) curdir))
1666 ;; We still want to delete the hardlink in the marks dir if
1667 ;; present, regardless of whether this mark has a maildir flag or
1668 ;; not, to avoid getting out of sync.
1669 (setq mfile (nnmaildir--subdir marksdir (symbol-name mark))
1670 mfile (concat mfile prefix))
1671 (nnmaildir--unlink mfile)))
1540 del-action (lambda (article) (mapcar del-mark todo-marks)) 1672 del-action (lambda (article) (mapcar del-mark todo-marks))
1541 add-action 1673 add-action
1542 (lambda (article) 1674 (lambda (article)
1543 (mapcar 1675 (mapcar
1544 (lambda (mark) 1676 (lambda (mark)
1545 (setq mdir (nnmaildir--subdir marksdir (symbol-name mark)) 1677 (let ((prefix (nnmaildir--art-prefix article))
1546 permarkfile (concat mdir ":") 1678 (suffix (nnmaildir--art-suffix article))
1547 mfile (concat mdir (nnmaildir--art-prefix article))) 1679 (flag (nnmaildir--mark-to-flag mark)))
1548 (nnmaildir--condcase err (add-name-to-file permarkfile mfile) 1680 (if flag
1549 (cond 1681 ;; If there is a corresponding maildir flag, just rename
1550 ((nnmaildir--eexist-p err)) 1682 ;; the file.
1551 ((nnmaildir--enoent-p err) 1683 (nnmaildir--article-set-flags
1552 (nnmaildir--mkdir mdir) 1684 article (nnmaildir--add-flag flag suffix) curdir)
1553 (nnmaildir--mkfile permarkfile) 1685 ;; Otherwise, use nnmaildir-specific marks dir.
1554 (add-name-to-file permarkfile mfile)) 1686 (setq mdir (nnmaildir--subdir marksdir (symbol-name mark))
1555 ((nnmaildir--emlink-p err) 1687 permarkfile (concat mdir ":")
1556 (let ((permarkfilenew (concat permarkfile "{new}"))) 1688 mfile (concat mdir prefix))
1557 (nnmaildir--mkfile permarkfilenew) 1689 (nnmaildir--condcase err (add-name-to-file permarkfile mfile)
1558 (rename-file permarkfilenew permarkfile 'replace) 1690 (cond
1559 (add-name-to-file permarkfile mfile))) 1691 ((nnmaildir--eexist-p err))
1560 (t (signal (car err) (cdr err)))))) 1692 ((nnmaildir--enoent-p err)
1693 (nnmaildir--mkdir mdir)
1694 (nnmaildir--mkfile permarkfile)
1695 (add-name-to-file permarkfile mfile))
1696 ((nnmaildir--emlink-p err)
1697 (let ((permarkfilenew (concat permarkfile "{new}")))
1698 (nnmaildir--mkfile permarkfilenew)
1699 (rename-file permarkfilenew permarkfile 'replace)
1700 (add-name-to-file permarkfile mfile)))
1701 (t (signal (car err) (cdr err))))))))
1561 todo-marks)) 1702 todo-marks))
1562 set-action (lambda (article) 1703 set-action (lambda (article)
1563 (funcall add-action article) 1704 (funcall add-action article)
@@ -1581,7 +1722,12 @@ by nnmaildir-request-article.")
1581 pgname (nnmaildir--pgname nnmaildir--cur-server gname) 1722 pgname (nnmaildir--pgname nnmaildir--cur-server gname)
1582 ls (nnmaildir--group-ls nnmaildir--cur-server pgname) 1723 ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
1583 all-marks (funcall ls marksdir nil "\\`[^.]" 'nosort) 1724 all-marks (funcall ls marksdir nil "\\`[^.]" 'nosort)
1584 all-marks (mapcar 'intern all-marks)) 1725 all-marks (gnus-delete-duplicates
1726 ;; get mark names from mark dirs and from flag
1727 ;; mappings
1728 (append
1729 (mapcar 'cdr nnmaildir-flag-mark-mapping)
1730 (mapcar 'intern all-marks))))
1585 (dolist (action actions) 1731 (dolist (action actions)
1586 (setq ranges (car action) 1732 (setq ranges (car action)
1587 todo-marks (caddr action)) 1733 todo-marks (caddr action))
diff --git a/lisp/gnus/qp.el b/lisp/gnus/qp.el
index 87252684a48..c4487c68b5c 100644
--- a/lisp/gnus/qp.el
+++ b/lisp/gnus/qp.el
@@ -53,10 +53,7 @@ them into characters should be done separately."
53 ;; or both of which are lowercase letters in "abcdef", is 53 ;; or both of which are lowercase letters in "abcdef", is
54 ;; formally illegal. A robust implementation might choose to 54 ;; formally illegal. A robust implementation might choose to
55 ;; recognize them as the corresponding uppercase letters.'' 55 ;; recognize them as the corresponding uppercase letters.''
56 (let ((case-fold-search t) 56 (let ((case-fold-search t))
57 (decode-hex #'(lambda (n1 n2)
58 (+ (* (if (<= n1 ?9) (- n1 ?0) (+ (- n1 ?A) 10)) 16)
59 (if (<= n2 ?9) (- n2 ?0) (+ (- n2 ?A) 10))))))
60 (narrow-to-region from to) 57 (narrow-to-region from to)
61 ;; Do this in case we're called from Gnus, say, in a buffer 58 ;; Do this in case we're called from Gnus, say, in a buffer
62 ;; which already contains non-ASCII characters which would 59 ;; which already contains non-ASCII characters which would
@@ -74,8 +71,15 @@ them into characters should be done separately."
74 (let* ((n (/ (- (match-end 0) (point)) 3)) 71 (let* ((n (/ (- (match-end 0) (point)) 3))
75 (str (make-string n 0))) 72 (str (make-string n 0)))
76 (dotimes (i n) 73 (dotimes (i n)
77 (aset str i (funcall decode-hex (char-after (1+ (point))) 74 (let ((n1 (char-after (1+ (point))))
78 (char-after (+ 2 (point))))) 75 (n2 (char-after (+ 2 (point)))))
76 (aset str i
77 (+ (* 16 (- n1 (if (<= n1 ?9) ?0
78 (if (<= n1 ?F) (- ?A 10)
79 (- ?a 10)))))
80 (- n2 (if (<= n2 ?9) ?0
81 (if (<= n2 ?F) (- ?A 10)
82 (- ?a 10)))))))
79 (forward-char 3)) 83 (forward-char 3))
80 (delete-region (match-beginning 0) (match-end 0)) 84 (delete-region (match-beginning 0) (match-end 0))
81 (insert str))) 85 (insert str)))
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 5791f1225c1..fa0484ff4e5 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -936,7 +936,7 @@ file-local variable.\n")
936 (princ " This variable is safe as a file local variable ") 936 (princ " This variable is safe as a file local variable ")
937 (princ "if its value\n satisfies the predicate ") 937 (princ "if its value\n satisfies the predicate ")
938 (princ (if (byte-code-function-p safe-var) 938 (princ (if (byte-code-function-p safe-var)
939 "which is byte-compiled expression.\n" 939 "which is a byte-compiled expression.\n"
940 (format "`%s'.\n" safe-var)))) 940 (format "`%s'.\n" safe-var))))
941 941
942 (if extra-line (terpri)) 942 (if extra-line (terpri))
diff --git a/lisp/help.el b/lisp/help.el
index 19db7c255d1..da11389d87c 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -39,9 +39,10 @@
39;; `help-window-point-marker' is a marker you can move to a valid 39;; `help-window-point-marker' is a marker you can move to a valid
40;; position of the buffer shown in the help window in order to override 40;; position of the buffer shown in the help window in order to override
41;; the standard positioning mechanism (`point-min') chosen by 41;; the standard positioning mechanism (`point-min') chosen by
42;; `with-output-to-temp-buffer'. `with-help-window' has this point 42;; `with-output-to-temp-buffer' and `with-temp-buffer-window'.
43;; nowhere before exiting. Currently used by `view-lossage' to assert 43;; `with-help-window' has this point nowhere before exiting. Currently
44;; that the last keystrokes are always visible. 44;; used by `view-lossage' to assert that the last keystrokes are always
45;; visible.
45(defvar help-window-point-marker (make-marker) 46(defvar help-window-point-marker (make-marker)
46 "Marker to override default `window-point' in help windows.") 47 "Marker to override default `window-point' in help windows.")
47 48
@@ -584,6 +585,8 @@ temporarily enables it to allow getting help on disabled items and buttons."
584 (setq saved-yank-menu (copy-sequence yank-menu)) 585 (setq saved-yank-menu (copy-sequence yank-menu))
585 (menu-bar-update-yank-menu "(any string)" nil)) 586 (menu-bar-update-yank-menu "(any string)" nil))
586 (setq key (read-key-sequence "Describe key (or click or menu item): ")) 587 (setq key (read-key-sequence "Describe key (or click or menu item): "))
588 ;; Clear the echo area message (Bug#7014).
589 (message nil)
587 ;; If KEY is a down-event, read and discard the 590 ;; If KEY is a down-event, read and discard the
588 ;; corresponding up-event. Note that there are also 591 ;; corresponding up-event. Note that there are also
589 ;; down-events on scroll bars and mode lines: the actual 592 ;; down-events on scroll bars and mode lines: the actual
@@ -961,7 +964,11 @@ is currently activated with completion."
961 result)) 964 result))
962 965
963;;; Automatic resizing of temporary buffers. 966;;; Automatic resizing of temporary buffers.
964(defcustom temp-buffer-max-height (lambda (buffer) (/ (- (frame-height) 2) 2)) 967(defcustom temp-buffer-max-height
968 (lambda (buffer)
969 (if (eq (selected-window) (frame-root-window))
970 (/ (x-display-pixel-height) (frame-char-height) 2)
971 (/ (- (frame-height) 2) 2)))
965 "Maximum height of a window displaying a temporary buffer. 972 "Maximum height of a window displaying a temporary buffer.
966This is effective only when Temp Buffer Resize mode is enabled. 973This is effective only when Temp Buffer Resize mode is enabled.
967The value is the maximum height (in lines) which 974The value is the maximum height (in lines) which
@@ -972,16 +979,25 @@ buffer, and should return a positive integer. At the time the
972function is called, the window to be resized is selected." 979function is called, the window to be resized is selected."
973 :type '(choice integer function) 980 :type '(choice integer function)
974 :group 'help 981 :group 'help
975 :version "20.4") 982 :version "24.2")
983
984(defcustom temp-buffer-resize-frames nil
985 "Non-nil means `temp-buffer-resize-mode' can resize frames.
986A frame can be resized if and only if its root window is a live
987window. The height of the root window is subject to the values of
988`temp-buffer-max-height' and `window-min-height'."
989 :type 'boolean
990 :version "24.2"
991 :group 'help)
976 992
977(define-minor-mode temp-buffer-resize-mode 993(define-minor-mode temp-buffer-resize-mode
978 "Toggle auto-shrinking temp buffer windows (Temp Buffer Resize mode). 994 "Toggle auto-resizing temporary buffer windows (Temp Buffer Resize Mode).
979With a prefix argument ARG, enable Temp Buffer Resize mode if ARG 995With a prefix argument ARG, enable Temp Buffer Resize mode if ARG
980is positive, and disable it otherwise. If called from Lisp, 996is positive, and disable it otherwise. If called from Lisp,
981enable the mode if ARG is omitted or nil. 997enable the mode if ARG is omitted or nil.
982 998
983When Temp Buffer Resize mode is enabled, the windows in which we 999When Temp Buffer Resize mode is enabled, the windows in which we
984show a temporary buffer are automatically reduced in height to 1000show a temporary buffer are automatically resized in height to
985fit the buffer's contents, but never more than 1001fit the buffer's contents, but never more than
986`temp-buffer-max-height' nor less than `window-min-height'. 1002`temp-buffer-max-height' nor less than `window-min-height'.
987 1003
@@ -994,19 +1010,34 @@ and some others."
994 (add-hook 'temp-buffer-show-hook 'resize-temp-buffer-window 'append) 1010 (add-hook 'temp-buffer-show-hook 'resize-temp-buffer-window 'append)
995 (remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window))) 1011 (remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window)))
996 1012
997(defun resize-temp-buffer-window () 1013(defun resize-temp-buffer-window (&optional window)
998 "Resize the selected window to fit its contents. 1014 "Resize WINDOW to fit its contents.
999Will not make it higher than `temp-buffer-max-height' nor smaller 1015WINDOW can be any live window and defaults to the selected one.
1000than `window-min-height'. Do nothing if the selected window is 1016
1001not vertically combined or some of its contents are scrolled out 1017Do not make WINDOW higher than `temp-buffer-max-height' nor
1002of view." 1018smaller than `window-min-height'. Do nothing if WINDOW is not
1003 (when (and (pos-visible-in-window-p (point-min)) 1019vertically combined or some of its contents are scrolled out of
1004 (window-combined-p)) 1020view."
1005 (fit-window-to-buffer 1021 (setq window (window-normalize-window window t))
1006 nil 1022 (let ((height (if (functionp temp-buffer-max-height)
1007 (if (functionp temp-buffer-max-height) 1023 (with-selected-window window
1008 (funcall temp-buffer-max-height (window-buffer)) 1024 (funcall temp-buffer-max-height (window-buffer)))
1009 temp-buffer-max-height)))) 1025 temp-buffer-max-height)))
1026 (cond
1027 ((and (pos-visible-in-window-p (point-min) window)
1028 (window-combined-p window))
1029 (fit-window-to-buffer window height))
1030 ((and temp-buffer-resize-frames
1031 (eq window (frame-root-window window))
1032 (memq (car (window-parameter window 'quit-restore))
1033 ;; If 'same is too strong, we might additionally check
1034 ;; whether the second element is 'frame.
1035 '(same frame)))
1036 (let ((frame (window-frame window)))
1037 (fit-frame-to-buffer
1038 frame (+ (frame-height frame)
1039 (- (window-total-size window))
1040 height)))))))
1010 1041
1011;;; Help windows. 1042;;; Help windows.
1012(defcustom help-window-select 'other 1043(defcustom help-window-select 'other
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index 644024a4b86..f92e2ab0af2 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -52,14 +52,14 @@
52;; 52;;
53;; Setup: 53;; Setup:
54;; 54;;
55;; Put the following code in your .emacs file. This turns on 55;; Put the following code in your init file. This turns on
56;; hi-lock mode and adds a "Regexp Highlighting" entry 56;; hi-lock mode and adds a "Regexp Highlighting" entry
57;; to the edit menu. 57;; to the edit menu.
58;; 58;;
59;; (global-hi-lock-mode 1) 59;; (global-hi-lock-mode 1)
60;; 60;;
61;; To enable the use of patterns found in files (presumably placed 61;; To enable the use of patterns found in files (presumably placed
62;; there by hi-lock) include the following in your .emacs file: 62;; there by hi-lock) include the following in your init file:
63;; 63;;
64;; (setq hi-lock-file-patterns-policy 'ask) 64;; (setq hi-lock-file-patterns-policy 'ask)
65;; 65;;
@@ -356,7 +356,7 @@ Hi-lock: end is found. A mode is excluded if it's in the list
356 "Possible archaic use of (hi-lock-mode). 356 "Possible archaic use of (hi-lock-mode).
357Use (global-hi-lock-mode 1) in .emacs to enable hi-lock for all buffers, 357Use (global-hi-lock-mode 1) in .emacs to enable hi-lock for all buffers,
358use (hi-lock-mode 1) for individual buffers. For compatibility with Emacs 358use (hi-lock-mode 1) for individual buffers. For compatibility with Emacs
359versions before 22 use the following in your .emacs file: 359versions before 22 use the following in your init file:
360 360
361 (if (functionp 'global-hi-lock-mode) 361 (if (functionp 'global-hi-lock-mode)
362 (global-hi-lock-mode 1) 362 (global-hi-lock-mode 1)
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index c6e799252a2..77461469044 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -123,13 +123,13 @@ own!):
123 no upper limit on its size. The size will also be aligned to the 123 no upper limit on its size. The size will also be aligned to the
124 right. 124 right.
125 125
126Thus, if you wanted to use these two formats, add 126Thus, if you wanted to use these two formats, the appropriate
127value for this variable would be
127 128
128 (setq ibuffer-formats '((mark \" \" name) 129 '((mark \" \" name)
129 (mark modified read-only 130 (mark modified read-only
130 (name 16 16 :left) (size 6 -1 :right)))) 131 (name 16 16 :left)
131 132 (size 6 -1 :right)))
132to your ~/.emacs file.
133 133
134Using \\[ibuffer-switch-format], you can rotate the display between 134Using \\[ibuffer-switch-format], you can rotate the display between
135the specified formats in the list." 135the specified formats in the list."
diff --git a/lisp/ielm.el b/lisp/ielm.el
index c93f235d81f..ba05bbcfc0f 100644
--- a/lisp/ielm.el
+++ b/lisp/ielm.el
@@ -59,7 +59,7 @@ override the read-only-ness of IELM prompts is to call
59`comint-kill-whole-line' or `comint-kill-region' with no 59`comint-kill-whole-line' or `comint-kill-region' with no
60narrowing in effect. This way you will be certain that none of 60narrowing in effect. This way you will be certain that none of
61the remaining prompts will be accidentally messed up. You may 61the remaining prompts will be accidentally messed up. You may
62wish to put something like the following in your `.emacs' file: 62wish to put something like the following in your init file:
63 63
64\(add-hook 'ielm-mode-hook 64\(add-hook 'ielm-mode-hook
65 (lambda () 65 (lambda ()
diff --git a/lisp/image.el b/lisp/image.el
index 7801923c3fe..99c0a74a512 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -645,8 +645,8 @@ number, play until that number of seconds has elapsed."
645 (while tail 645 (while tail
646 (setq timer (car tail) 646 (setq timer (car tail)
647 tail (cdr tail)) 647 tail (cdr tail))
648 (if (and (eq (aref timer 5) 'image-animate-timeout) 648 (if (and (eq (timer--function timer) 'image-animate-timeout)
649 (eq (car-safe (aref timer 6)) image)) 649 (eq (car-safe (timer--args timer)) image))
650 (setq tail nil) 650 (setq tail nil)
651 (setq timer nil))) 651 (setq timer nil)))
652 timer)) 652 timer))
diff --git a/lisp/info.el b/lisp/info.el
index fe4afd72163..5862e5e850f 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -1882,9 +1882,7 @@ If DIRECTION is `backward', search in the reverse direction."
1882 (while (and (not give-up) 1882 (while (and (not give-up)
1883 (or (null found) 1883 (or (null found)
1884 (not (funcall isearch-filter-predicate beg-found found)))) 1884 (not (funcall isearch-filter-predicate beg-found found))))
1885 (let ((search-spaces-regexp 1885 (let ((search-spaces-regexp Info-search-whitespace-regexp))
1886 (if (or (not isearch-mode) isearch-regexp)
1887 Info-search-whitespace-regexp)))
1888 (if (if backward 1886 (if (if backward
1889 (re-search-backward regexp bound t) 1887 (re-search-backward regexp bound t)
1890 (re-search-forward regexp bound t)) 1888 (re-search-forward regexp bound t))
@@ -1904,9 +1902,7 @@ If DIRECTION is `backward', search in the reverse direction."
1904 (if (null Info-current-subfile) 1902 (if (null Info-current-subfile)
1905 (if isearch-mode 1903 (if isearch-mode
1906 (signal 'search-failed (list regexp "end of manual")) 1904 (signal 'search-failed (list regexp "end of manual"))
1907 (let ((search-spaces-regexp 1905 (let ((search-spaces-regexp Info-search-whitespace-regexp))
1908 (if (or (not isearch-mode) isearch-regexp)
1909 Info-search-whitespace-regexp)))
1910 (if backward 1906 (if backward
1911 (re-search-backward regexp) 1907 (re-search-backward regexp)
1912 (re-search-forward regexp)))) 1908 (re-search-forward regexp))))
@@ -1964,9 +1960,7 @@ If DIRECTION is `backward', search in the reverse direction."
1964 (while (and (not give-up) 1960 (while (and (not give-up)
1965 (or (null found) 1961 (or (null found)
1966 (not (funcall isearch-filter-predicate beg-found found)))) 1962 (not (funcall isearch-filter-predicate beg-found found))))
1967 (let ((search-spaces-regexp 1963 (let ((search-spaces-regexp Info-search-whitespace-regexp))
1968 (if (or (not isearch-mode) isearch-regexp)
1969 Info-search-whitespace-regexp)))
1970 (if (if backward 1964 (if (if backward
1971 (re-search-backward regexp nil t) 1965 (re-search-backward regexp nil t)
1972 (re-search-forward regexp nil t)) 1966 (re-search-forward regexp nil t))
@@ -2034,21 +2028,26 @@ If DIRECTION is `backward', search in the reverse direction."
2034(defun Info-isearch-search () 2028(defun Info-isearch-search ()
2035 (if Info-isearch-search 2029 (if Info-isearch-search
2036 (lambda (string &optional bound noerror count) 2030 (lambda (string &optional bound noerror count)
2037 (Info-search 2031 (let ((Info-search-whitespace-regexp
2038 (cond 2032 (if (if isearch-regexp
2039 (isearch-word 2033 isearch-regexp-lax-whitespace
2040 ;; Lax version of word search 2034 isearch-lax-whitespace)
2041 (let ((lax (not (or isearch-nonincremental 2035 search-whitespace-regexp)))
2042 (eq (length string) 2036 (Info-search
2043 (length (isearch--state-string 2037 (cond
2044 (car isearch-cmds)))))))) 2038 (isearch-word
2045 (if (functionp isearch-word) 2039 ;; Lax version of word search
2046 (funcall isearch-word string lax) 2040 (let ((lax (not (or isearch-nonincremental
2047 (word-search-regexp string lax)))) 2041 (eq (length string)
2048 (isearch-regexp string) 2042 (length (isearch--state-string
2049 (t (regexp-quote string))) 2043 (car isearch-cmds))))))))
2050 bound noerror count 2044 (if (functionp isearch-word)
2051 (unless isearch-forward 'backward)) 2045 (funcall isearch-word string lax)
2046 (word-search-regexp string lax))))
2047 (isearch-regexp string)
2048 (t (regexp-quote string)))
2049 bound noerror count
2050 (unless isearch-forward 'backward)))
2052 (point)) 2051 (point))
2053 (isearch-search-fun-default))) 2052 (isearch-search-fun-default)))
2054 2053
@@ -4157,8 +4156,6 @@ Advanced commands:
4157 'Info-isearch-push-state) 4156 'Info-isearch-push-state)
4158 (set (make-local-variable 'isearch-filter-predicate) 4157 (set (make-local-variable 'isearch-filter-predicate)
4159 'Info-isearch-filter) 4158 'Info-isearch-filter)
4160 (set (make-local-variable 'search-whitespace-regexp)
4161 Info-search-whitespace-regexp)
4162 (set (make-local-variable 'revert-buffer-function) 4159 (set (make-local-variable 'revert-buffer-function)
4163 'Info-revert-buffer-function) 4160 'Info-revert-buffer-function)
4164 (Info-set-mode-line) 4161 (Info-set-mode-line)
diff --git a/lisp/international/ogonek.el b/lisp/international/ogonek.el
index 39a88001112..3c34e5d9a2a 100644
--- a/lisp/international/ogonek.el
+++ b/lisp/international/ogonek.el
@@ -224,13 +224,14 @@ The functions come in the following groups.
224 ogonek-prefix-to-encoding iso8859-2 224 ogonek-prefix-to-encoding iso8859-2
225 225
226 The above default values can be changed by placing appropriate settings 226 The above default values can be changed by placing appropriate settings
227 in the '~/.emacs' file: 227 in your init file:
228 228
229 (setq ogonek-prefix-char ?/) 229 (setq ogonek-prefix-char ?/)
230 (setq ogonek-prefix-to-encoding \"iso8859-2\") 230 (setq ogonek-prefix-to-encoding \"iso8859-2\")
231 231
232 Instead of loading the whole library `ogonek' it may be better to 232 Instead of loading the whole library `ogonek' it may be better
233 autoload the needed functions, for example by placing in `~/.emacs': 233 to autoload the needed functions, for example by adding the
234 following lines to your init file:
234 235
235 (autoload 'ogonek-how \"ogonek\") 236 (autoload 'ogonek-how \"ogonek\")
236 (autoload 'ogonek-recode-region \"ogonek\") 237 (autoload 'ogonek-recode-region \"ogonek\")
diff --git a/lisp/isearch.el b/lisp/isearch.el
index e6e0a01566a..04f5a7acc2c 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -1405,6 +1405,7 @@ Use `isearch-exit' to quit without signaling."
1405 (interactive) 1405 (interactive)
1406 (setq isearch-word (unless (eq isearch-word 'isearch-symbol-regexp) 1406 (setq isearch-word (unless (eq isearch-word 'isearch-symbol-regexp)
1407 'isearch-symbol-regexp)) 1407 'isearch-symbol-regexp))
1408 (if isearch-word (setq isearch-regexp nil))
1408 (setq isearch-success t isearch-adjusted t) 1409 (setq isearch-success t isearch-adjusted t)
1409 (isearch-update)) 1410 (isearch-update))
1410 1411
@@ -1579,14 +1580,10 @@ way to run word replacements from Isearch is `M-s w ... M-%'."
1579 ;; set `search-upper-case' to nil to not call 1580 ;; set `search-upper-case' to nil to not call
1580 ;; `isearch-no-upper-case-p' in `perform-replace' 1581 ;; `isearch-no-upper-case-p' in `perform-replace'
1581 (search-upper-case nil) 1582 (search-upper-case nil)
1582 (replace-search-function 1583 (replace-lax-whitespace
1583 (if (and isearch-lax-whitespace (not regexp-flag)) 1584 isearch-lax-whitespace)
1584 #'search-forward-lax-whitespace 1585 (replace-regexp-lax-whitespace
1585 replace-search-function)) 1586 isearch-regexp-lax-whitespace)
1586 (replace-re-search-function
1587 (if (and isearch-regexp-lax-whitespace regexp-flag)
1588 #'re-search-forward-lax-whitespace
1589 replace-re-search-function))
1590 ;; Set `isearch-recursive-edit' to nil to prevent calling 1587 ;; Set `isearch-recursive-edit' to nil to prevent calling
1591 ;; `exit-recursive-edit' in `isearch-done' that terminates 1588 ;; `exit-recursive-edit' in `isearch-done' that terminates
1592 ;; the execution of this command when it is non-nil. 1589 ;; the execution of this command when it is non-nil.
@@ -2956,10 +2953,14 @@ Attempt to do the search exactly the way the pending Isearch would."
2956 (let ((case-fold-search isearch-lazy-highlight-case-fold-search) 2953 (let ((case-fold-search isearch-lazy-highlight-case-fold-search)
2957 (isearch-regexp isearch-lazy-highlight-regexp) 2954 (isearch-regexp isearch-lazy-highlight-regexp)
2958 (isearch-word isearch-lazy-highlight-word) 2955 (isearch-word isearch-lazy-highlight-word)
2956 (isearch-lax-whitespace
2957 isearch-lazy-highlight-lax-whitespace)
2958 (isearch-regexp-lax-whitespace
2959 isearch-lazy-highlight-regexp-lax-whitespace)
2960 (isearch-forward isearch-lazy-highlight-forward)
2959 (search-invisible nil) ; don't match invisible text 2961 (search-invisible nil) ; don't match invisible text
2960 (retry t) 2962 (retry t)
2961 (success nil) 2963 (success nil)
2962 (isearch-forward isearch-lazy-highlight-forward)
2963 (bound (if isearch-lazy-highlight-forward 2964 (bound (if isearch-lazy-highlight-forward
2964 (min (or isearch-lazy-highlight-end-limit (point-max)) 2965 (min (or isearch-lazy-highlight-end-limit (point-max))
2965 (if isearch-lazy-highlight-wrapped 2966 (if isearch-lazy-highlight-wrapped
diff --git a/lisp/language/chinese.el b/lisp/language/chinese.el
index ac2afa373c4..782b5a363ad 100644
--- a/lisp/language/chinese.el
+++ b/lisp/language/chinese.el
@@ -110,7 +110,8 @@
110 (use-cjk-char-width-table 'zh_CN))) 110 (use-cjk-char-width-table 'zh_CN)))
111 (exit-function . use-default-char-width-table) 111 (exit-function . use-default-char-width-table)
112 (coding-system chinese-iso-8bit iso-2022-cn chinese-hz) 112 (coding-system chinese-iso-8bit iso-2022-cn chinese-hz)
113 (coding-priority chinese-iso-8bit chinese-big5 iso-2022-cn) 113 (coding-priority chinese-iso-8bit chinese-gbk chinese-big5
114 iso-2022-cn)
114 (input-method . "chinese-py-punct") 115 (input-method . "chinese-py-punct")
115 (features china-util) 116 (features china-util)
116 (sample-text . "Chinese ($AVPND(B,$AFUM(;0(B,$A::So(B) $ADc:C(B") 117 (sample-text . "Chinese ($AVPND(B,$AFUM(;0(B,$A::So(B) $ADc:C(B")
@@ -140,7 +141,8 @@
140 (use-cjk-char-width-table 'zh_HK))) 141 (use-cjk-char-width-table 'zh_HK)))
141 (exit-function . use-default-char-width-table) 142 (exit-function . use-default-char-width-table)
142 (coding-system chinese-big5 chinese-iso-7bit) 143 (coding-system chinese-big5 chinese-iso-7bit)
143 (coding-priority chinese-big5 iso-2022-cn chinese-iso-8bit) 144 (coding-priority chinese-big5 iso-2022-cn chinese-iso-8bit
145 chinese-gbk)
144 (input-method . "chinese-py-punct-b5") 146 (input-method . "chinese-py-punct-b5")
145 (ctext-non-standard-encodings "big5-0") 147 (ctext-non-standard-encodings "big5-0")
146 (features china-util) 148 (features china-util)
@@ -196,7 +198,7 @@
196 (exit-function . use-default-char-width-table) 198 (exit-function . use-default-char-width-table)
197 (coding-system iso-2022-cn euc-tw) 199 (coding-system iso-2022-cn euc-tw)
198 (coding-priority iso-2022-cn euc-tw chinese-big5 200 (coding-priority iso-2022-cn euc-tw chinese-big5
199 chinese-iso-8bit) 201 chinese-iso-8bit chinese-gbk)
200 (features china-util) 202 (features china-util)
201 (input-method . "chinese-cns-quick") 203 (input-method . "chinese-cns-quick")
202 ;; Fixme: presumably it won't accept big5 now. 204 ;; Fixme: presumably it won't accept big5 now.
@@ -216,7 +218,7 @@ accepts Big5 for input also (which is then converted to CNS)."))
216 (exit-function . use-default-char-width-table) 218 (exit-function . use-default-char-width-table)
217 (coding-system euc-tw iso-2022-cn) 219 (coding-system euc-tw iso-2022-cn)
218 (coding-priority euc-tw chinese-big5 iso-2022-cn 220 (coding-priority euc-tw chinese-big5 iso-2022-cn
219 chinese-iso-8bit) 221 chinese-iso-8bit chinese-gbk)
220 (features china-util) 222 (features china-util)
221 (input-method . "chinese-cns-quick") 223 (input-method . "chinese-cns-quick")
222 (documentation . "\ 224 (documentation . "\
diff --git a/lisp/loadup.el b/lisp/loadup.el
index c70b417822f..e0f5c6265b9 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -102,6 +102,19 @@
102(setq load-source-file-function 'load-with-code-conversion) 102(setq load-source-file-function 'load-with-code-conversion)
103(load "files") 103(load "files")
104 104
105;; Load-time macro-expansion can only take effect after setting
106;; load-source-file-function because of where it is called in lread.c.
107(load "emacs-lisp/macroexp")
108(if (byte-code-function-p (symbol-function 'macroexpand-all))
109 nil
110 ;; Since loaddefs is not yet loaded, macroexp's uses of pcase will simply
111 ;; fail until pcase is explicitly loaded. This also means that we have to
112 ;; disable eager macro-expansion while loading pcase.
113 (let ((macroexp--pending-eager-loads '(skip)))
114 (load "emacs-lisp/pcase"))
115 ;; Re-load macroexp so as to eagerly macro-expand its uses of pcase.
116 (load "emacs-lisp/macroexp"))
117
105(load "cus-face") 118(load "cus-face")
106(load "faces") ; after here, `defface' may be used. 119(load "faces") ; after here, `defface' may be used.
107 120
@@ -269,21 +282,6 @@
269;For other systems, you must edit ../src/Makefile.in. 282;For other systems, you must edit ../src/Makefile.in.
270(load "site-load" t) 283(load "site-load" t)
271 284
272;; ¡¡¡ Big Ugly Hack !!!
273;; src/bootstrap-emacs is mostly used to compile .el files, so it needs
274;; macroexp, bytecomp, cconv, and byte-opt to be fast. Generally this is done
275;; by compiling those files first, but this only makes a difference if those
276;; files are not preloaded. As it so happens, macroexp.el tends to be
277;; accidentally preloaded in src/bootstrap-emacs because cl.el and cl-macs.el
278;; require it. So let's unload it here, if needed, to make sure the
279;; byte-compiled version is used.
280(if (or (not (fboundp 'macroexpand-all))
281 (byte-code-function-p (symbol-function 'macroexpand-all)))
282 nil
283 (fmakunbound 'macroexpand-all)
284 (setq features (delq 'macroexp features))
285 (autoload 'macroexpand-all "macroexp"))
286
287;; Determine which last version number to use 285;; Determine which last version number to use
288;; based on the executables that now exist. 286;; based on the executables that now exist.
289(if (and (or (equal (nth 3 command-line-args) "dump") 287(if (and (or (equal (nth 3 command-line-args) "dump")
diff --git a/lisp/locate.el b/lisp/locate.el
index 29d7c75cbb2..d172ce3d6c4 100644
--- a/lisp/locate.el
+++ b/lisp/locate.el
@@ -34,7 +34,7 @@
34;; 34;;
35;; SHELLPROGRAM Name-to-find 35;; SHELLPROGRAM Name-to-find
36;; 36;;
37;; set the variable `locate-command' in your .emacs file. 37;; set the variable `locate-command' in your init file.
38;; 38;;
39;; To use a more complicated expression, create a function which 39;; To use a more complicated expression, create a function which
40;; takes a string (the name to find) as input and returns a list. 40;; takes a string (the name to find) as input and returns a list.
diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el
index 520271940f2..4305094611a 100644
--- a/lisp/mail/feedmail.el
+++ b/lisp/mail/feedmail.el
@@ -139,9 +139,8 @@
139;; feedmail-send-it. Hers's the best way to use the stuff in this 139;; feedmail-send-it. Hers's the best way to use the stuff in this
140;; file: 140;; file:
141;; 141;;
142;; Save this file as feedmail.el somewhere on your elisp 142;; Save this file as feedmail.el somewhere on your elisp loadpath;
143;; loadpath; byte-compile it. Put the following lines somewhere in 143;; byte-compile it. Put the following lines in your init file:
144;; your ~/.emacs stuff:
145;; 144;;
146;; (setq send-mail-function 'feedmail-send-it) 145;; (setq send-mail-function 'feedmail-send-it)
147;; (autoload 'feedmail-send-it "feedmail") 146;; (autoload 'feedmail-send-it "feedmail")
diff --git a/lisp/mail/mail-hist.el b/lisp/mail/mail-hist.el
index dd489e3c6a9..40d67b4e904 100644
--- a/lisp/mail/mail-hist.el
+++ b/lisp/mail/mail-hist.el
@@ -28,7 +28,7 @@
28;; time. 28;; time.
29;; 29;;
30;; To use this package, put it in a directory in your load-path, and 30;; To use this package, put it in a directory in your load-path, and
31;; put this in your .emacs file: 31;; put this in your init file:
32;; 32;;
33;; (load "mail-hist" nil t) 33;; (load "mail-hist" nil t)
34;; 34;;
diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el
index 290c57c1c55..2e4ffec1383 100644
--- a/lisp/mail/mailabbrev.el
+++ b/lisp/mail/mailabbrev.el
@@ -391,35 +391,24 @@ double-quotes."
391(defun mail-abbrev-expand-hook () 391(defun mail-abbrev-expand-hook ()
392 "For use as the fourth arg to `define-abbrev'. 392 "For use as the fourth arg to `define-abbrev'.
393After expanding a mail-abbrev, if Auto Fill mode is on and we're past the 393After expanding a mail-abbrev, if Auto Fill mode is on and we're past the
394fill-column, break the line at the previous comma, and indent the next line." 394fill-column, break the line at the previous comma, and indent the next line
395 ;; Disable abbrev mode to avoid recursion in indent-relative expanding 395with a space."
396 ;; part of the abbrev expansion as an abbrev itself. 396 (when auto-fill-function
397 (let ((abbrev-mode nil)) 397 (let (p)
398 (save-excursion 398 (save-excursion
399 (let ((p (point)) 399 (while (>= (current-column) fill-column)
400 bol comma fp) 400 (while (and (search-backward "," (point-at-bol) 'move)
401 (beginning-of-line) 401 (>= (current-column) (1- fill-column))
402 (setq bol (point)) 402 (setq p (point))))
403 (goto-char p) 403 (when (or (not (bolp))
404 (while (and auto-fill-function 404 (and p (goto-char p)))
405 (>= (current-column) fill-column) 405 (setq p nil)
406 (search-backward "," bol t)) 406 (forward-char 1)
407 (setq comma (point)) 407 (insert "\n")
408 (forward-char 1) ; Now we are just past the comma. 408 (when (looking-at "[\t ]+")
409 (insert "\n") 409 (delete-region (point) (match-end 0)))
410 (delete-horizontal-space) 410 (insert " ")
411 (setq p (point)) 411 (end-of-line)))))))
412 (indent-relative)
413 (setq fp (buffer-substring p (point)))
414 ;; Go to the end of the new line.
415 (end-of-line)
416 (if (> (current-column) fill-column)
417 ;; It's still too long; do normal auto-fill.
418 (let ((fill-prefix (or fp "\t")))
419 (do-auto-fill)))
420 ;; Resume the search.
421 (goto-char comma)
422 )))))
423 412
424;;; Syntax tables and abbrev-expansion 413;;; Syntax tables and abbrev-expansion
425 414
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index 804fe7a8798..69a405436a7 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -200,10 +200,10 @@ The list is in preference order.")
200 ;; local binding in the mail buffer will take effect. 200 ;; local binding in the mail buffer will take effect.
201 (smtpmail-mail-address 201 (smtpmail-mail-address
202 (or (and mail-specify-envelope-from (mail-envelope-from)) 202 (or (and mail-specify-envelope-from (mail-envelope-from))
203 (smtpmail-user-mail-address) 203 (let ((from (mail-fetch-field "from")))
204 (let ((from (mail-fetch-field "from")))
205 (and from 204 (and from
206 (cadr (mail-extract-address-components from)))))) 205 (cadr (mail-extract-address-components from))))
206 (smtpmail-user-mail-address)))
207 (smtpmail-code-conv-from 207 (smtpmail-code-conv-from
208 (if enable-multibyte-characters 208 (if enable-multibyte-characters
209 (let ((sendmail-coding-system smtpmail-code-conv-from)) 209 (let ((sendmail-coding-system smtpmail-code-conv-from))
@@ -653,12 +653,10 @@ Returns an error if the server cannot be contacted."
653 (or smtpmail-mail-address 653 (or smtpmail-mail-address
654 (and mail-specify-envelope-from 654 (and mail-specify-envelope-from
655 (mail-envelope-from)) 655 (mail-envelope-from))
656 (smtpmail-user-mail-address)
657 ;; Fall back on the From: header as the envelope From
658 ;; address.
659 (let ((from (mail-fetch-field "from"))) 656 (let ((from (mail-fetch-field "from")))
660 (and from 657 (and from
661 (cadr (mail-extract-address-components from)))))) 658 (cadr (mail-extract-address-components from))))
659 (smtpmail-user-mail-address)))
662 response-code 660 response-code
663 process-buffer 661 process-buffer
664 result 662 result
diff --git a/lisp/mail/uce.el b/lisp/mail/uce.el
index fdfe17a1a07..3d7495ffd1a 100644
--- a/lisp/mail/uce.el
+++ b/lisp/mail/uce.el
@@ -63,7 +63,7 @@
63;; Usage: 63;; Usage:
64 64
65;; Place uce.el in your load-path (and optionally byte-compile it). 65;; Place uce.el in your load-path (and optionally byte-compile it).
66;; Add the following line to your ~/.emacs: 66;; Add the following line to your init file:
67;; (autoload 'uce-reply-to-uce "uce" "Reply to UCEs" t nil) 67;; (autoload 'uce-reply-to-uce "uce" "Reply to UCEs" t nil)
68;; If you want to use it with Gnus rather than Rmail: 68;; If you want to use it with Gnus rather than Rmail:
69;; (setq uce-mail-reader 'gnus) 69;; (setq uce-mail-reader 'gnus)
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index a696fff7dc7..27c53744d54 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -211,7 +211,7 @@ case sensitive instead."
211 (complete-with-action action table string pred)))) 211 (complete-with-action action table string pred))))
212 212
213(defun completion-table-subvert (table s1 s2) 213(defun completion-table-subvert (table s1 s2)
214 "Completion table that replaces the prefix S1 with S2 in STRING. 214 "Return a completion table from TABLE with S1 replaced by S2.
215The result is a completion table which completes strings of the 215The result is a completion table which completes strings of the
216form (concat S1 S) in the same way as TABLE completes strings of 216form (concat S1 S) in the same way as TABLE completes strings of
217the form (concat S2 S)." 217the form (concat S2 S)."
diff --git a/lisp/mouse-copy.el b/lisp/mouse-copy.el
index 8d043b4495f..a8e32bec1ae 100644
--- a/lisp/mouse-copy.el
+++ b/lisp/mouse-copy.el
@@ -35,7 +35,7 @@
35;; If you like mouse-copy, you should also check out mouse-drag 35;; If you like mouse-copy, you should also check out mouse-drag
36;; for ``one-click scrolling''. 36;; for ``one-click scrolling''.
37;; 37;;
38;; To use mouse-copy, place the following in your .emacs file: 38;; To use mouse-copy, place the following in your init file:
39;; (require 'mouse-copy) 39;; (require 'mouse-copy)
40;; (global-set-key [M-down-mouse-1] 'mouse-drag-secondary-pasting) 40;; (global-set-key [M-down-mouse-1] 'mouse-drag-secondary-pasting)
41;; (global-set-key [M-S-down-mouse-1] 'mouse-drag-secondary-moving) 41;; (global-set-key [M-S-down-mouse-1] 'mouse-drag-secondary-moving)
diff --git a/lisp/mouse-drag.el b/lisp/mouse-drag.el
index 7fb10505355..acdad9a42cf 100644
--- a/lisp/mouse-drag.el
+++ b/lisp/mouse-drag.el
@@ -46,7 +46,7 @@
46;; If you like mouse-drag, you should also check out mouse-copy 46;; If you like mouse-drag, you should also check out mouse-copy
47;; for ``one-click text copy and move''. 47;; for ``one-click text copy and move''.
48;; 48;;
49;; To use mouse-drag, place the following in your .emacs file: 49;; To use mouse-drag, place the following in your init file:
50;; -either- 50;; -either-
51;; (global-set-key [down-mouse-2] 'mouse-drag-throw) 51;; (global-set-key [down-mouse-2] 'mouse-drag-throw)
52;; -or- 52;; -or-
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 1501fa41baa..265a855b842 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -79,7 +79,7 @@
79;; that this change will take effect for the current GNU Emacs session only. 79;; that this change will take effect for the current GNU Emacs session only.
80;; See below for a discussion of non-UNIX hosts. If a large number of 80;; See below for a discussion of non-UNIX hosts. If a large number of
81;; machines with similar hostnames have this problem then it is easier to set 81;; machines with similar hostnames have this problem then it is easier to set
82;; the value of ange-ftp-dumb-unix-host-regexp in your .emacs file. ange-ftp 82;; the value of ange-ftp-dumb-unix-host-regexp in your init file. ange-ftp
83;; is unable to automatically recognize dumb unix hosts. 83;; is unable to automatically recognize dumb unix hosts.
84 84
85;; File name completion: 85;; File name completion:
@@ -275,10 +275,10 @@
275 275
276;; VMS support: 276;; VMS support:
277;; 277;;
278;; Ange-ftp has full support for VMS hosts. It 278;; Ange-ftp has full support for VMS hosts. It should be able to
279;; should be able to automatically recognize any VMS machine. However, if it 279;; automatically recognize any VMS machine. However, if it fails to do
280;; fails to do this, you can use the command ange-ftp-add-vms-host. As well, 280;; this, you can use the command ange-ftp-add-vms-host. Also, you can
281;; you can set the variable ange-ftp-vms-host-regexp in your .emacs file. We 281;; set the variable ange-ftp-vms-host-regexp in your init file. We
282;; would be grateful if you would report any failures to automatically 282;; would be grateful if you would report any failures to automatically
283;; recognize a VMS host as a bug. 283;; recognize a VMS host as a bug.
284;; 284;;
@@ -332,7 +332,7 @@
332;; the Michigan terminal system. It should be able to automatically 332;; the Michigan terminal system. It should be able to automatically
333;; recognize any MTS machine. However, if it fails to do this, you can use 333;; recognize any MTS machine. However, if it fails to do this, you can use
334;; the command ange-ftp-add-mts-host. As well, you can set the variable 334;; the command ange-ftp-add-mts-host. As well, you can set the variable
335;; ange-ftp-mts-host-regexp in your .emacs file. We would be grateful if you 335;; ange-ftp-mts-host-regexp in your init file. We would be grateful if you
336;; would report any failures to automatically recognize a MTS host as a bug. 336;; would report any failures to automatically recognize a MTS host as a bug.
337;; 337;;
338;; Filename syntax: 338;; Filename syntax:
@@ -358,7 +358,7 @@
358;; CMS. It should be able to automatically recognize any CMS machine. 358;; CMS. It should be able to automatically recognize any CMS machine.
359;; However, if it fails to do this, you can use the command 359;; However, if it fails to do this, you can use the command
360;; ange-ftp-add-cms-host. As well, you can set the variable 360;; ange-ftp-add-cms-host. As well, you can set the variable
361;; ange-ftp-cms-host-regexp in your .emacs file. We would be grateful if you 361;; ange-ftp-cms-host-regexp in your init file. We would be grateful if you
362;; would report any failures to automatically recognize a CMS host as a bug. 362;; would report any failures to automatically recognize a CMS host as a bug.
363;; 363;;
364;; Filename syntax: 364;; Filename syntax:
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 20d71215926..c1c83d2245e 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -122,8 +122,7 @@
122;; the buffer, use: 122;; the buffer, use:
123;; M-x browse-url 123;; M-x browse-url
124 124
125;; To display a URL by shift-clicking on it, put this in your ~/.emacs 125;; To display a URL by shift-clicking on it, put this in your init file:
126;; file:
127;; (global-set-key [S-mouse-2] 'browse-url-at-mouse) 126;; (global-set-key [S-mouse-2] 'browse-url-at-mouse)
128;; (Note that using Shift-mouse-1 is not desirable because 127;; (Note that using Shift-mouse-1 is not desirable because
129;; that event has a standard meaning in Emacs.) 128;; that event has a standard meaning in Emacs.)
@@ -743,7 +742,7 @@ narrowed."
743 (and buffer (set-buffer buffer)) 742 (and buffer (set-buffer buffer))
744 (let ((file-name 743 (let ((file-name
745 ;; Ignore real name if restricted 744 ;; Ignore real name if restricted
746 (and (= (- (point-max) (point-min)) (buffer-size)) 745 (and (not (buffer-narrowed-p))
747 (or buffer-file-name 746 (or buffer-file-name
748 (and (boundp 'dired-directory) dired-directory))))) 747 (and (boundp 'dired-directory) dired-directory)))))
749 (or file-name 748 (or file-name
diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el
index 6a9d80f9672..f9e31788527 100644
--- a/lisp/net/goto-addr.el
+++ b/lisp/net/goto-addr.el
@@ -33,7 +33,7 @@
33;; INSTALLATION 33;; INSTALLATION
34;; 34;;
35;; To use goto-address in a particular mode (for example, while 35;; To use goto-address in a particular mode (for example, while
36;; reading mail in mh-e), add something like this in your .emacs file: 36;; reading mail in mh-e), add this to your init file:
37;; 37;;
38;; (add-hook 'mh-show-mode-hook 'goto-address) 38;; (add-hook 'mh-show-mode-hook 'goto-address)
39;; 39;;
diff --git a/lisp/net/newsticker.el b/lisp/net/newsticker.el
index 5d673faf0db..91eca84ce53 100644
--- a/lisp/net/newsticker.el
+++ b/lisp/net/newsticker.el
@@ -87,7 +87,7 @@
87;; If you are using Newsticker as part of GNU Emacs there is no need to 87;; If you are using Newsticker as part of GNU Emacs there is no need to
88;; perform any installation steps in order to use Newsticker. Otherwise 88;; perform any installation steps in order to use Newsticker. Otherwise
89;; place Newsticker in a directory where Emacs can find it. Add the 89;; place Newsticker in a directory where Emacs can find it. Add the
90;; following line to your Emacs startup file (`~/.emacs'). 90;; following line to your init file:
91;; (add-to-list 'load-path "/path/to/newsticker/") 91;; (add-to-list 'load-path "/path/to/newsticker/")
92;; (autoload 'newsticker-start "newsticker" "Emacs Newsticker" t) 92;; (autoload 'newsticker-start "newsticker" "Emacs Newsticker" t)
93;; (autoload 'newsticker-show-news "newsticker" "Emacs Newsticker" t) 93;; (autoload 'newsticker-show-news "newsticker" "Emacs Newsticker" t)
diff --git a/lisp/net/quickurl.el b/lisp/net/quickurl.el
index f3b0e372de4..f7d41fcd97a 100644
--- a/lisp/net/quickurl.el
+++ b/lisp/net/quickurl.el
@@ -164,7 +164,7 @@ To make use of this do something like:
164 164
165 (setq quickurl-postfix quickurl-reread-hook-postfix) 165 (setq quickurl-postfix quickurl-reread-hook-postfix)
166 166
167in your ~/.emacs (after loading/requiring quickurl).") 167in your init file (after loading/requiring quickurl).")
168 168
169;; Non-customize variables. 169;; Non-customize variables.
170 170
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 06aae1f6af2..abca6b3ea01 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -204,7 +204,7 @@ useful thing to do is to put
204 204
205 (setq tramp-verbose 9) 205 (setq tramp-verbose 9)
206 206
207in the ~/.emacs file and to repeat the bug. Then, include the 207in your init file and to repeat the bug. Then, include the
208contents of the *tramp/foo* buffer and the *debug tramp/foo* 208contents of the *tramp/foo* buffer and the *debug tramp/foo*
209buffer in your bug report. 209buffer in your bug report.
210 210
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index a17bbfa0d14..019ab1eef0f 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3293,7 +3293,9 @@ for process communication also."
3293 ;; Under Windows XP, accept-process-output doesn't return 3293 ;; Under Windows XP, accept-process-output doesn't return
3294 ;; sometimes. So we add an additional timeout. 3294 ;; sometimes. So we add an additional timeout.
3295 (with-timeout ((or timeout 1)) 3295 (with-timeout ((or timeout 1))
3296 (accept-process-output proc timeout timeout-msecs (and proc t)))) 3296 (if (featurep 'xemacs)
3297 (accept-process-output proc timeout timeout-msecs)
3298 (accept-process-output proc timeout timeout-msecs (and proc t)))))
3297 (tramp-message proc 10 "\n%s" (buffer-string)))) 3299 (tramp-message proc 10 "\n%s" (buffer-string))))
3298 3300
3299(defun tramp-check-for-regexp (proc regexp) 3301(defun tramp-check-for-regexp (proc regexp)
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 499af730788..2d0a8e3d23d 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -31,7 +31,7 @@
31;; should be changed only there. 31;; should be changed only there.
32 32
33;;;###tramp-autoload 33;;;###tramp-autoload
34(defconst tramp-version "2.2.6-pre" 34(defconst tramp-version "2.2.6"
35 "This version of Tramp.") 35 "This version of Tramp.")
36 36
37;;;###tramp-autoload 37;;;###tramp-autoload
@@ -44,7 +44,7 @@
44 (= emacs-major-version 21) 44 (= emacs-major-version 21)
45 (>= emacs-minor-version 4))) 45 (>= emacs-minor-version 4)))
46 "ok" 46 "ok"
47 (format "Tramp 2.2.6-pre is not fit for %s" 47 (format "Tramp 2.2.6 is not fit for %s"
48 (when (string-match "^.*$" (emacs-version)) 48 (when (string-match "^.*$" (emacs-version))
49 (match-string 0 (emacs-version))))))) 49 (match-string 0 (emacs-version)))))))
50 (unless (string-match "\\`ok\\'" x) (error "%s" x))) 50 (unless (string-match "\\`ok\\'" x) (error "%s" x)))
diff --git a/lisp/net/webjump.el b/lisp/net/webjump.el
index 232e5ca581a..d5de2f410c5 100644
--- a/lisp/net/webjump.el
+++ b/lisp/net/webjump.el
@@ -38,7 +38,7 @@
38;; example sites. You'll probably want to override it with your own favorite 38;; example sites. You'll probably want to override it with your own favorite
39;; sites. The documentation for the variable describes the syntax. 39;; sites. The documentation for the variable describes the syntax.
40 40
41;; You may wish to add something like the following to your `.emacs' file: 41;; You may wish to add something like the following to your init file:
42;; 42;;
43;; (require 'webjump) 43;; (require 'webjump)
44;; (global-set-key "\C-cj" 'webjump) 44;; (global-set-key "\C-cj" 'webjump)
diff --git a/lisp/novice.el b/lisp/novice.el
index bcc94c86c9d..c621ac4b692 100644
--- a/lisp/novice.el
+++ b/lisp/novice.el
@@ -159,8 +159,8 @@ to future sessions."
159(defun disable-command (command) 159(defun disable-command (command)
160 "Require special confirmation to execute COMMAND from now on. 160 "Require special confirmation to execute COMMAND from now on.
161COMMAND must be a symbol. 161COMMAND must be a symbol.
162This command alters the user's .emacs file so that this will apply 162This command alters your init file so that this choice applies to
163to future sessions." 163future sessions."
164 (interactive "CDisable command: ") 164 (interactive "CDisable command: ")
165 (en/disable-command command t)) 165 (en/disable-command command t))
166 166
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index d357da685e5..97d8b4652a9 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -28,7 +28,7 @@
28;; argument position. 28;; argument position.
29;; 29;;
30;; To use pcomplete with shell-mode, for example, you will need the 30;; To use pcomplete with shell-mode, for example, you will need the
31;; following in your .emacs file: 31;; following in your init file:
32;; 32;;
33;; (add-hook 'shell-mode-hook 'pcomplete-shell-setup) 33;; (add-hook 'shell-mode-hook 'pcomplete-shell-setup)
34;; 34;;
diff --git a/lisp/play/blackbox.el b/lisp/play/blackbox.el
index db2e18188e5..16189600156 100644
--- a/lisp/play/blackbox.el
+++ b/lisp/play/blackbox.el
@@ -97,7 +97,9 @@
97 (let ((map (make-keymap))) 97 (let ((map (make-keymap)))
98 (suppress-keymap map t) 98 (suppress-keymap map t)
99 (blackbox-redefine-key map 'backward-char 'bb-left) 99 (blackbox-redefine-key map 'backward-char 'bb-left)
100 (blackbox-redefine-key map 'left-char 'bb-left)
100 (blackbox-redefine-key map 'forward-char 'bb-right) 101 (blackbox-redefine-key map 'forward-char 'bb-right)
102 (blackbox-redefine-key map 'right-char 'bb-right)
101 (blackbox-redefine-key map 'previous-line 'bb-up) 103 (blackbox-redefine-key map 'previous-line 'bb-up)
102 (blackbox-redefine-key map 'next-line 'bb-down) 104 (blackbox-redefine-key map 'next-line 'bb-down)
103 (blackbox-redefine-key map 'move-end-of-line 'bb-eol) 105 (blackbox-redefine-key map 'move-end-of-line 'bb-eol)
diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el
index 1f04099a6ae..3b6035473fd 100644
--- a/lisp/play/bubbles.el
+++ b/lisp/play/bubbles.el
@@ -33,7 +33,7 @@
33;; Installation 33;; Installation
34;; ------------ 34;; ------------
35 35
36;; Add the following lines to your Emacs startup file (`~/.emacs'). 36;; Add the following lines to your init file:
37;; (add-to-list 'load-path "/path/to/bubbles/") 37;; (add-to-list 'load-path "/path/to/bubbles/")
38;; (autoload 'bubbles "bubbles" "Play Bubbles" t) 38;; (autoload 'bubbles "bubbles" "Play Bubbles" t)
39 39
diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el
index 8d9506a1614..ade0d15006a 100644
--- a/lisp/play/decipher.el
+++ b/lisp/play/decipher.el
@@ -138,19 +138,7 @@ the tail of the list."
138 ("^)\\([A-Z ]+\\)\\([a-z ]+\\)" 138 ("^)\\([A-Z ]+\\)\\([a-z ]+\\)"
139 (1 font-lock-keyword-face) 139 (1 font-lock-keyword-face)
140 (2 font-lock-string-face))) 140 (2 font-lock-string-face)))
141 "Expressions to fontify in Decipher mode. 141 "Font Lock keywords for Decipher mode.")
142
143Ciphertext uses `font-lock-keyword-face', plaintext uses
144`font-lock-string-face', comments use `font-lock-comment-face', and
145checkpoints use `font-lock-constant-face'. You can customize the
146display by changing these variables. For best results, I recommend
147that all faces use the same background color.
148
149For example, to display ciphertext in the `bold' face, use
150 (add-hook 'decipher-mode-hook
151 (lambda () (set (make-local-variable 'font-lock-keyword-face)
152 'bold)))
153in your `.emacs' file.")
154 142
155(defvar decipher-mode-map 143(defvar decipher-mode-map
156 (let ((map (make-keymap))) 144 (let ((map (make-keymap)))
diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el
index d2e307c0145..85c128b08e2 100644
--- a/lisp/play/handwrite.el
+++ b/lisp/play/handwrite.el
@@ -45,7 +45,7 @@
45;; Installation 45;; Installation
46;; 46;;
47;; type at your prompt "emacs -l handwrite.el" or put this file on your 47;; type at your prompt "emacs -l handwrite.el" or put this file on your
48;; Emacs-Lisp load path, add the following into your ~/.emacs startup file 48;; Emacs-Lisp load path, add the following into your init file:
49;; 49;;
50;; (require 'handwrite) 50;; (require 'handwrite)
51;; 51;;
diff --git a/lisp/printing.el b/lisp/printing.el
index 0152ed63dbb..02b2fb0139c 100644
--- a/lisp/printing.el
+++ b/lisp/printing.el
@@ -139,10 +139,9 @@ Please send all bug fixes and enhancements to
139;; 139;;
140;; One way to set variables is by calling `pr-customize', customize all 140;; One way to set variables is by calling `pr-customize', customize all
141;; variables and save the customization by future sessions (see Options 141;; variables and save the customization by future sessions (see Options
142;; section). Other way is by coding your settings on Emacs init file (that is, 142;; section). Other way is by adding code to your init file; see below
143;; ~/.emacs file), see below for a first setting template that it should be 143;; for a first setting template that it should be inserted on your
144;; inserted on your ~/.emacs file (or c:/_emacs, if you're using Windows 9x/NT 144;; init file:
145;; or MS-DOS):
146;; 145;;
147;; * Example of setting for Windows system: 146;; * Example of setting for Windows system:
148;; 147;;
@@ -297,8 +296,7 @@ Please send all bug fixes and enhancements to
297;; Using `printing' 296;; Using `printing'
298;; ---------------- 297;; ----------------
299;; 298;;
300;; To use `printing' insert in your ~/.emacs file (or c:/_emacs, if you're 299;; To use `printing' insert in your init file:
301;; using Windows 9x/NT or MS-DOS):
302;; 300;;
303;; (require 'printing) 301;; (require 'printing)
304;; ;; ...some user settings... 302;; ;; ...some user settings...
diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el
index 4062646c967..5a054af9883 100644
--- a/lisp/progmodes/antlr-mode.el
+++ b/lisp/progmodes/antlr-mode.el
@@ -69,7 +69,7 @@
69;; This file requires Emacs-20.3, XEmacs-20.4 or higher and package cc-mode. 69;; This file requires Emacs-20.3, XEmacs-20.4 or higher and package cc-mode.
70 70
71;; If antlr-mode is not part of your distribution, put this file into your 71;; If antlr-mode is not part of your distribution, put this file into your
72;; load-path and the following into your ~/.emacs: 72;; load-path and the following into your init file:
73;; (autoload 'antlr-mode "antlr-mode" nil t) 73;; (autoload 'antlr-mode "antlr-mode" nil t)
74;; (setq auto-mode-alist (cons '("\\.g\\'" . antlr-mode) auto-mode-alist)) 74;; (setq auto-mode-alist (cons '("\\.g\\'" . antlr-mode) auto-mode-alist))
75;; (add-hook 'speedbar-load-hook ; would be too late in antlr-mode.el 75;; (add-hook 'speedbar-load-hook ; would be too late in antlr-mode.el
diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el
index 7cd0a0b0ae2..eec6873dc19 100644
--- a/lisp/progmodes/cc-cmds.el
+++ b/lisp/progmodes/cc-cmds.el
@@ -493,13 +493,16 @@ inside a literal or a macro, nothing special happens."
493 (insert-char ?\n 1) 493 (insert-char ?\n 1)
494 ;; In AWK (etc.) or in a macro, make sure this CR hasn't changed 494 ;; In AWK (etc.) or in a macro, make sure this CR hasn't changed
495 ;; the syntax. (There might already be an escaped NL there.) 495 ;; the syntax. (There might already be an escaped NL there.)
496 (when (or (c-at-vsemi-p (1- (point))) 496 (when (or
497 (let ((pt (point))) 497 (save-excursion
498 (save-excursion 498 (c-skip-ws-backward (c-point 'bopl))
499 (backward-char) 499 (c-at-vsemi-p))
500 (and (c-beginning-of-macro) 500 (let ((pt (point)))
501 (progn (c-end-of-macro) 501 (save-excursion
502 (< (point) pt)))))) 502 (backward-char)
503 (and (c-beginning-of-macro)
504 (progn (c-end-of-macro)
505 (< (point) pt))))))
503 (backward-char) 506 (backward-char)
504 (insert-char ?\\ 1) 507 (insert-char ?\\ 1)
505 (forward-char)) 508 (forward-char))
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index 8bccb44f308..0dc596a472b 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -1829,7 +1829,7 @@ itself is evaluated."
1829 (eval form)) 1829 (eval form))
1830 1830
1831;; Only used at compile time - suppress "might not be defined at runtime". 1831;; Only used at compile time - suppress "might not be defined at runtime".
1832(declare-function cl-macroexpand-all "cl-extra" (form &optional env)) 1832(declare-function cl-macroexpand-all "cl" (form &optional env))
1833 1833
1834(defmacro c-lang-defconst (name &rest args) 1834(defmacro c-lang-defconst (name &rest args)
1835 "Set the language specific values of the language constant NAME. 1835 "Set the language specific values of the language constant NAME.
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 142ec4cdd66..2aa04cb2b0b 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -3091,6 +3091,8 @@ comment at the start of cc-engine.el for more info."
3091 c-state-cache-good-pos 1 3091 c-state-cache-good-pos 1
3092 c-state-nonlit-pos-cache nil 3092 c-state-nonlit-pos-cache nil
3093 c-state-nonlit-pos-cache-limit 1 3093 c-state-nonlit-pos-cache-limit 1
3094 c-state-semi-nonlit-pos-cache nil
3095 c-state-semi-nonlit-pos-cache-limit 1
3094 c-state-brace-pair-desert nil 3096 c-state-brace-pair-desert nil
3095 c-state-point-min 1 3097 c-state-point-min 1
3096 c-state-point-min-lit-type nil 3098 c-state-point-min-lit-type nil
@@ -3350,6 +3352,8 @@ comment at the start of cc-engine.el for more info."
3350 c-state-cache-good-pos 3352 c-state-cache-good-pos
3351 c-state-nonlit-pos-cache 3353 c-state-nonlit-pos-cache
3352 c-state-nonlit-pos-cache-limit 3354 c-state-nonlit-pos-cache-limit
3355 c-state-semi-nonlit-pos-cache
3356 c-state-semi-nonlit-pos-cache-limit
3353 c-state-brace-pair-desert 3357 c-state-brace-pair-desert
3354 c-state-point-min 3358 c-state-point-min
3355 c-state-point-min-lit-type 3359 c-state-point-min-lit-type
@@ -9579,12 +9583,12 @@ comment at the start of cc-engine.el for more info."
9579 (setq tmpsymbol nil) 9583 (setq tmpsymbol nil)
9580 (while (and (> (point) placeholder) 9584 (while (and (> (point) placeholder)
9581 (zerop (c-backward-token-2 1 t)) 9585 (zerop (c-backward-token-2 1 t))
9582 (/= (char-after) ?=)) 9586 (not (looking-at "=\\([^=]\\|$\\)")))
9583 (and c-opt-inexpr-brace-list-key 9587 (and c-opt-inexpr-brace-list-key
9584 (not tmpsymbol) 9588 (not tmpsymbol)
9585 (looking-at c-opt-inexpr-brace-list-key) 9589 (looking-at c-opt-inexpr-brace-list-key)
9586 (setq tmpsymbol 'topmost-intro-cont))) 9590 (setq tmpsymbol 'topmost-intro-cont)))
9587 (eq (char-after) ?=)) 9591 (looking-at "=\\([^=]\\|$\\)"))
9588 (looking-at c-brace-list-key)) 9592 (looking-at c-brace-list-key))
9589 (save-excursion 9593 (save-excursion
9590 (while (and (< (point) indent-point) 9594 (while (and (< (point) indent-point)
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 78be8ac2cc4..d5a1be572ba 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -208,9 +208,10 @@ the evaluated constant value at compile time."
208 208
209;; Suppress "might not be defined at runtime" warning. 209;; Suppress "might not be defined at runtime" warning.
210;; This file is only used when compiling other cc files. 210;; This file is only used when compiling other cc files.
211(declare-function delete-duplicates "cl-seq" (cl-seq &rest cl-keys)) 211;; These are defined in cl as aliases to the cl- versions.
212(declare-function mapcan "cl-extra" (cl-func cl-seq &rest cl-rest)) 212(declare-function delete-duplicates "cl-seq" (cl-seq &rest cl-keys) t)
213(declare-function cl-macroexpand-all "cl-extra" (form &optional env)) 213(declare-function mapcan "cl-extra" (cl-func cl-seq &rest cl-rest) t)
214(declare-function cl-macroexpand-all "cl" (form &optional env))
214 215
215(eval-and-compile 216(eval-and-compile
216 ;; Some helper functions used when building the language constants. 217 ;; Some helper functions used when building the language constants.
diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el
index cf628e44de0..20aa2bc2775 100644
--- a/lisp/progmodes/cc-styles.el
+++ b/lisp/progmodes/cc-styles.el
@@ -352,8 +352,8 @@ might get set too.
352If DONT-OVERRIDE is neither nil nor t, style variables whose default values 352If DONT-OVERRIDE is neither nil nor t, style variables whose default values
353have been set (more precisely, whose default values are not the symbol 353have been set (more precisely, whose default values are not the symbol
354`set-from-style') will not be changed. This avoids overriding global settings 354`set-from-style') will not be changed. This avoids overriding global settings
355done in ~/.emacs. It is useful to call c-set-style from a mode hook in this 355done in your init file. It is useful to call c-set-style from a mode hook
356way. 356in this way.
357 357
358If DONT-OVERRIDE is t, style variables that already have values (i.e., whose 358If DONT-OVERRIDE is t, style variables that already have values (i.e., whose
359values are not the symbol `set-from-style') will not be overridden. CC Mode 359values are not the symbol `set-from-style') will not be overridden. CC Mode
diff --git a/lisp/progmodes/cmacexp.el b/lisp/progmodes/cmacexp.el
index 943b5c6a067..525b1c9671e 100644
--- a/lisp/progmodes/cmacexp.el
+++ b/lisp/progmodes/cmacexp.el
@@ -49,7 +49,7 @@
49 49
50;; INSTALLATION ====================================================== 50;; INSTALLATION ======================================================
51 51
52;; Put the following in your ~/.emacs file. 52;; Put the following in your init file.
53 53
54;; If you want the *Macroexpansion* window to be not higher than 54;; If you want the *Macroexpansion* window to be not higher than
55;; necessary: 55;; necessary:
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index fbb0c9e204a..f5dedf0cd59 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -488,9 +488,12 @@ What matched the HYPERLINK'th subexpression has `mouse-face' and
488`compilation-message-face' applied. If this is nil, the text 488`compilation-message-face' applied. If this is nil, the text
489matched by the whole REGEXP becomes the hyperlink. 489matched by the whole REGEXP becomes the hyperlink.
490 490
491Additional HIGHLIGHTs take the shape (SUBMATCH FACE), where SUBMATCH is 491Additional HIGHLIGHTs take the shape (SUBMATCH FACE), where
492the number of a submatch that should be highlighted when it matches, 492SUBMATCH is the number of a submatch and FACE is an expression
493and FACE is an expression returning the face to use for that submatch.." 493which evaluates to a face name (a symbol or string).
494Alternatively, FACE can evaluate to a property list of the
495form (face FACE PROP1 VAL1 PROP2 VAL2 ...), in which case all the
496listed text properties PROP# are given values VAL# as well."
494 :type '(repeat (choice (symbol :tag "Predefined symbol") 497 :type '(repeat (choice (symbol :tag "Predefined symbol")
495 (sexp :tag "Error specification"))) 498 (sexp :tag "Error specification")))
496 :link `(file-link :tag "example file" 499 :link `(file-link :tag "example file"
@@ -1328,16 +1331,27 @@ to `compilation-error-regexp-alist' if RULES is nil."
1328 (compilation--put-prop 1331 (compilation--put-prop
1329 end-col 'font-lock-face compilation-column-face) 1332 end-col 'font-lock-face compilation-column-face)
1330 1333
1334 ;; Obey HIGHLIGHT.
1331 (dolist (extra-item (nthcdr 6 item)) 1335 (dolist (extra-item (nthcdr 6 item))
1332 (let ((mn (pop extra-item))) 1336 (let ((mn (pop extra-item)))
1333 (when (match-beginning mn) 1337 (when (match-beginning mn)
1334 (let ((face (eval (car extra-item)))) 1338 (let ((face (eval (car extra-item))))
1335 (cond 1339 (cond
1336 ((null face)) 1340 ((null face))
1337 ((symbolp face) 1341 ((or (symbolp face) (stringp face))
1338 (put-text-property 1342 (put-text-property
1339 (match-beginning mn) (match-end mn) 1343 (match-beginning mn) (match-end mn)
1340 'font-lock-face face)) 1344 'font-lock-face face))
1345 ((and (listp face)
1346 (eq (car face) 'face)
1347 (or (symbolp (cadr face))
1348 (stringp (cadr face))))
1349 (put-text-property
1350 (match-beginning mn) (match-end mn)
1351 'font-lock-face (cadr face))
1352 (add-text-properties
1353 (match-beginning mn) (match-end mn)
1354 (nthcdr 2 face)))
1341 (t 1355 (t
1342 (error "Don't know how to handle face %S" 1356 (error "Don't know how to handle face %S"
1343 face))))))) 1357 face)))))))
diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el
index cdbaf4708a7..0f18cffc3de 100644
--- a/lisp/progmodes/ebnf2ps.el
+++ b/lisp/progmodes/ebnf2ps.el
@@ -43,7 +43,7 @@ Please send all bug fixes and enhancements to
43;; 43;;
44;; This package translates an EBNF to a syntactic chart on PostScript. 44;; This package translates an EBNF to a syntactic chart on PostScript.
45;; 45;;
46;; To use ebnf2ps, insert in your ~/.emacs: 46;; To use ebnf2ps, insert in your init file:
47;; 47;;
48;; (require 'ebnf2ps) 48;; (require 'ebnf2ps)
49;; 49;;
@@ -772,7 +772,7 @@ Please send all bug fixes and enhancements to
772;; 772;;
773;; To set the above options you may: 773;; To set the above options you may:
774;; 774;;
775;; a) insert the code in your ~/.emacs, like: 775;; a) insert the code in your init file, like:
776;; 776;;
777;; (setq ebnf-terminal-shape 'bevel) 777;; (setq ebnf-terminal-shape 'bevel)
778;; 778;;
diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el
index 1d29011762e..8ac54d6524e 100644
--- a/lisp/progmodes/ebrowse.el
+++ b/lisp/progmodes/ebrowse.el
@@ -4210,7 +4210,7 @@ NUMBER-OF-STATIC-VARIABLES:"
4210;; this will select the buffer from which the buffer menu was 4210;; this will select the buffer from which the buffer menu was
4211;; invoked. But this buffer is not displayed in the buffer list if 4211;; invoked. But this buffer is not displayed in the buffer list if
4212;; it isn't a tree buffer. I therefore let the buffer menu command 4212;; it isn't a tree buffer. I therefore let the buffer menu command
4213;; loop read the command `p' via `unread-command-char'. This command 4213;; loop read the command `p' via `unread-command-events'. This command
4214;; has no effect since we are on the first line of the buffer. 4214;; has no effect since we are on the first line of the buffer.
4215 4215
4216(defvar electric-buffer-menu-mode-hook nil) 4216(defvar electric-buffer-menu-mode-hook nil)
diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el
index cc1251f6a75..f42952685d0 100644
--- a/lisp/progmodes/f90.el
+++ b/lisp/progmodes/f90.el
@@ -102,10 +102,9 @@
102;; (abbrev-mode 1) ; turn on abbreviation mode 102;; (abbrev-mode 1) ; turn on abbreviation mode
103;; (f90-add-imenu-menu) ; extra menu with functions etc. 103;; (f90-add-imenu-menu) ; extra menu with functions etc.
104;; (if f90-auto-keyword-case ; change case of all keywords on startup 104;; (if f90-auto-keyword-case ; change case of all keywords on startup
105;; (f90-change-keywords f90-auto-keyword-case)) 105;; (f90-change-keywords f90-auto-keyword-case))))
106;; ))
107;; 106;;
108;; in your .emacs file. You can also customize the lists 107;; in your init file. You can also customize the lists
109;; f90-font-lock-keywords, etc. 108;; f90-font-lock-keywords, etc.
110;; 109;;
111;; The auto-fill and abbreviation minor modes are accessible from the F90 menu, 110;; The auto-fill and abbreviation minor modes are accessible from the F90 menu,
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index ad285274928..10d5fdf9c64 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -977,6 +977,9 @@ from compile.el")
977;; :type '(repeat (string number number number)) 977;; :type '(repeat (string number number number))
978;;) 978;;)
979 979
980(defvar flymake-warning-re "^[wW]arning"
981 "Regexp matching against err-text to detect a warning.")
982
980(defun flymake-parse-line (line) 983(defun flymake-parse-line (line)
981 "Parse LINE to see if it is an error or warning. 984 "Parse LINE to see if it is an error or warning.
982Return its components if so, nil otherwise." 985Return its components if so, nil otherwise."
@@ -997,7 +1000,7 @@ Return its components if so, nil otherwise."
997 (match-string (nth 4 (car patterns)) line) 1000 (match-string (nth 4 (car patterns)) line)
998 (flymake-patch-err-text (substring line (match-end 0))))) 1001 (flymake-patch-err-text (substring line (match-end 0)))))
999 (or err-text (setq err-text "<no error text>")) 1002 (or err-text (setq err-text "<no error text>"))
1000 (if (and err-text (string-match "^[wW]arning" err-text)) 1003 (if (and err-text (string-match flymake-warning-re err-text))
1001 (setq err-type "w") 1004 (setq err-type "w")
1002 ) 1005 )
1003 (flymake-log 3 "parse line: file-idx=%s line-idx=%s file=%s line=%s text=%s" file-idx line-idx 1006 (flymake-log 3 "parse line: file-idx=%s line-idx=%s file=%s line=%s text=%s" file-idx line-idx
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index 233b9a5212e..2a77ad013c7 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -52,7 +52,7 @@
52;; 52;;
53;; First make sure hideshow.el is in a directory in your `load-path'. 53;; First make sure hideshow.el is in a directory in your `load-path'.
54;; You can optionally byte-compile it using `M-x byte-compile-file'. 54;; You can optionally byte-compile it using `M-x byte-compile-file'.
55;; Then, add the following to your ~/.emacs: 55;; Then, add the following to your init file:
56;; 56;;
57;; (load-library "hideshow") 57;; (load-library "hideshow")
58;; (add-hook 'X-mode-hook ; other modes similarly 58;; (add-hook 'X-mode-hook ; other modes similarly
diff --git a/lisp/progmodes/idlw-complete-structtag.el b/lisp/progmodes/idlw-complete-structtag.el
index 246ba8f29cd..24613d14634 100644
--- a/lisp/progmodes/idlw-complete-structtag.el
+++ b/lisp/progmodes/idlw-complete-structtag.el
@@ -53,8 +53,8 @@
53;; 53;;
54;; INSTALLATION 54;; INSTALLATION
55;; ============ 55;; ============
56;; Put this file on the emacs load path and load it with the following 56;; Put this file on the emacs load path and load it with the following
57;; line in your .emacs file: 57;; line in your init file:
58;; 58;;
59;; (add-hook 'idlwave-load-hook 59;; (add-hook 'idlwave-load-hook
60;; (lambda () (require 'idlw-complete-structtag))) 60;; (lambda () (require 'idlw-complete-structtag)))
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el
index 4f9109284ae..08d1461c008 100644
--- a/lisp/progmodes/idlw-shell.el
+++ b/lisp/progmodes/idlw-shell.el
@@ -48,7 +48,7 @@
48;; 48;;
49;; Follow the instructions in the INSTALL file of the distribution. 49;; Follow the instructions in the INSTALL file of the distribution.
50;; In short, put this file on your load path and add the following 50;; In short, put this file on your load path and add the following
51;; lines to your .emacs file: 51;; lines to your init file:
52;; 52;;
53;; (autoload 'idlwave-shell "idlw-shell" "IDLWAVE Shell" t) 53;; (autoload 'idlwave-shell "idlw-shell" "IDLWAVE Shell" t)
54;; 54;;
@@ -111,9 +111,7 @@ For example, \"^\r?IDL> \" or \"^\r?WAVE> \".
111The \"^\r?\" is needed, to indicate the beginning of the line, with 111The \"^\r?\" is needed, to indicate the beginning of the line, with
112optional return character (which IDL seems to output randomly). 112optional return character (which IDL seems to output randomly).
113This variable is used to initialize `comint-prompt-regexp' in the 113This variable is used to initialize `comint-prompt-regexp' in the
114process buffer. 114process buffer."
115
116This is a fine thing to set in your `.emacs' file."
117 :group 'idlwave-shell-general-setup 115 :group 'idlwave-shell-general-setup
118 :type 'regexp) 116 :type 'regexp)
119 117
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index a35ffd3e45d..9b634328fa7 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -51,7 +51,7 @@
51;; 51;;
52;; Follow the instructions in the INSTALL file of the distribution. 52;; Follow the instructions in the INSTALL file of the distribution.
53;; In short, put this file on your load path and add the following 53;; In short, put this file on your load path and add the following
54;; lines to your .emacs file: 54;; lines to your init file:
55;; 55;;
56;; (autoload 'idlwave-mode "idlwave" "IDLWAVE Mode" t) 56;; (autoload 'idlwave-mode "idlwave" "IDLWAVE Mode" t)
57;; (autoload 'idlwave-shell "idlw-shell" "IDLWAVE Shell" t) 57;; (autoload 'idlwave-shell "idlw-shell" "IDLWAVE Shell" t)
@@ -746,7 +746,7 @@ or even '?'. '.' is not a good choice because it can make structure
746field names act like abbrevs in certain circumstances. 746field names act like abbrevs in certain circumstances.
747 747
748Changes to this in `idlwave-mode-hook' will have no effect. Instead a user 748Changes to this in `idlwave-mode-hook' will have no effect. Instead a user
749must set it directly using `setq' in the .emacs file before idlwave.el 749must set it directly using `setq' in the init file before idlwave.el
750is loaded." 750is loaded."
751 :group 'idlwave-abbrev-and-indent-action 751 :group 'idlwave-abbrev-and-indent-action
752 :type 'string) 752 :type 'string)
diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el
index cd6c8869d9f..401970b2ce8 100644
--- a/lisp/progmodes/inf-lisp.el
+++ b/lisp/progmodes/inf-lisp.el
@@ -168,9 +168,7 @@ This variable is only used if the variable
168More precise choices: 168More precise choices:
169Lucid Common Lisp: \"^\\\\(>\\\\|\\\\(->\\\\)+\\\\) *\" 169Lucid Common Lisp: \"^\\\\(>\\\\|\\\\(->\\\\)+\\\\) *\"
170franz: \"^\\\\(->\\\\|<[0-9]*>:\\\\) *\" 170franz: \"^\\\\(->\\\\|<[0-9]*>:\\\\) *\"
171kcl: \"^>+ *\" 171kcl: \"^>+ *\""
172
173This is a fine thing to set in your .emacs file or through Custom."
174 :type 'regexp 172 :type 'regexp
175 :group 'inferior-lisp) 173 :group 'inferior-lisp)
176 174
diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el
index 54d857dd4b1..a59176a5aa6 100644
--- a/lisp/progmodes/mixal-mode.el
+++ b/lisp/progmodes/mixal-mode.el
@@ -32,7 +32,7 @@
32;; GNU MDK from `https://savannah.gnu.org/projects/mdk/' and 32;; GNU MDK from `https://savannah.gnu.org/projects/mdk/' and
33;; `ftp://ftp.gnu.org/pub/gnu/mdk'. 33;; `ftp://ftp.gnu.org/pub/gnu/mdk'.
34;; 34;;
35;; To use this mode, place the following in your .emacs file: 35;; To use this mode, place the following in your init file:
36;; `(load-file "/PATH-TO-FILE/mixal-mode.el")'. 36;; `(load-file "/PATH-TO-FILE/mixal-mode.el")'.
37;; When you load a file with the extension .mixal the mode will be started 37;; When you load a file with the extension .mixal the mode will be started
38;; automatic. If you want to start the mode manual, use `M-x mixal-mode'. 38;; automatic. If you want to start the mode manual, use `M-x mixal-mode'.
diff --git a/lisp/progmodes/octave-mod.el b/lisp/progmodes/octave-mod.el
index 79b3fcee720..ab5a19f8a2f 100644
--- a/lisp/progmodes/octave-mod.el
+++ b/lisp/progmodes/octave-mod.el
@@ -585,12 +585,12 @@ Variables you can use to customize Octave mode
585Turning on Octave mode runs the hook `octave-mode-hook'. 585Turning on Octave mode runs the hook `octave-mode-hook'.
586 586
587To begin using this mode for all `.m' files that you edit, add the 587To begin using this mode for all `.m' files that you edit, add the
588following lines to your `.emacs' file: 588following lines to your init file:
589 589
590 (add-to-list 'auto-mode-alist '(\"\\\\.m\\\\'\" . octave-mode)) 590 (add-to-list 'auto-mode-alist '(\"\\\\.m\\\\'\" . octave-mode))
591 591
592To automatically turn on the abbrev and auto-fill features, 592To automatically turn on the abbrev and auto-fill features,
593add the following lines to your `.emacs' file as well: 593add the following lines to your init file as well:
594 594
595 (add-hook 'octave-mode-hook 595 (add-hook 'octave-mode-hook
596 (lambda () 596 (lambda ()
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index e13b67e596d..3dd9a48bb33 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -28,14 +28,14 @@
28;;; Commentary: 28;;; Commentary:
29 29
30;; To enter perl-mode automatically, add (autoload 'perl-mode "perl-mode") 30;; To enter perl-mode automatically, add (autoload 'perl-mode "perl-mode")
31;; to your .emacs file and change the first line of your perl script to: 31;; to your init file and change the first line of your perl script to:
32;; #!/usr/bin/perl -- # -*-Perl-*- 32;; #!/usr/bin/perl -- # -*-Perl-*-
33;; With arguments to perl: 33;; With arguments to perl:
34;; #!/usr/bin/perl -P- # -*-Perl-*- 34;; #!/usr/bin/perl -P- # -*-Perl-*-
35;; To handle files included with do 'filename.pl';, add something like 35;; To handle files included with do 'filename.pl';, add something like
36;; (setq auto-mode-alist (append (list (cons "\\.pl\\'" 'perl-mode)) 36;; (setq auto-mode-alist (append (list (cons "\\.pl\\'" 'perl-mode))
37;; auto-mode-alist)) 37;; auto-mode-alist))
38;; to your .emacs file; otherwise the .pl suffix defaults to prolog-mode. 38;; to your init file; otherwise the .pl suffix defaults to prolog-mode.
39 39
40;; This code is based on the 18.53 version c-mode.el, with extensive 40;; This code is based on the 18.53 version c-mode.el, with extensive
41;; rewriting. Most of the features of c-mode survived intact. 41;; rewriting. Most of the features of c-mode survived intact.
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index 16d85cb2d79..33d43cb3d5a 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -60,9 +60,7 @@
60 60
61;;; Installation: 61;;; Installation:
62;; 62;;
63;; Insert the following lines in your init file--typically ~/.emacs 63;; Insert the following lines in your init file:
64;; (GNU Emacs and XEmacs <21.4), or ~/.xemacs/init.el (XEmacs
65;; 21.4)--to use this mode when editing Prolog files under Emacs:
66;; 64;;
67;; (setq load-path (cons "/usr/lib/xemacs/site-lisp" load-path)) 65;; (setq load-path (cons "/usr/lib/xemacs/site-lisp" load-path))
68;; (autoload 'run-prolog "prolog" "Start a Prolog sub-process." t) 66;; (autoload 'run-prolog "prolog" "Start a Prolog sub-process." t)
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 601850ed0fb..ffc6c1ac885 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -1824,7 +1824,11 @@ When MSG is non-nil messages the first line of STRING."
1824 (lines (split-string string "\n" t))) 1824 (lines (split-string string "\n" t)))
1825 (and msg (message "Sent: %s..." (nth 0 lines))) 1825 (and msg (message "Sent: %s..." (nth 0 lines)))
1826 (if (> (length lines) 1) 1826 (if (> (length lines) 1)
1827 (let* ((temp-file-name (make-temp-file "py")) 1827 (let* ((temporary-file-directory
1828 (if (file-remote-p default-directory)
1829 (concat (file-remote-p default-directory) "/tmp")
1830 temporary-file-directory))
1831 (temp-file-name (make-temp-file "py"))
1828 (file-name (or (buffer-file-name) temp-file-name))) 1832 (file-name (or (buffer-file-name) temp-file-name)))
1829 (with-temp-file temp-file-name 1833 (with-temp-file temp-file-name
1830 (insert string) 1834 (insert string)
@@ -1931,8 +1935,14 @@ FILE-NAME."
1931 (interactive "fFile to send: ") 1935 (interactive "fFile to send: ")
1932 (let* ((process (or process (python-shell-get-or-create-process))) 1936 (let* ((process (or process (python-shell-get-or-create-process)))
1933 (temp-file-name (when temp-file-name 1937 (temp-file-name (when temp-file-name
1934 (expand-file-name temp-file-name))) 1938 (expand-file-name
1935 (file-name (or (expand-file-name file-name) temp-file-name))) 1939 (or (file-remote-p temp-file-name 'localname)
1940 temp-file-name))))
1941 (file-name (or (when file-name
1942 (expand-file-name
1943 (or (file-remote-p file-name 'localname)
1944 file-name)))
1945 temp-file-name)))
1936 (when (not file-name) 1946 (when (not file-name)
1937 (error "If FILE-NAME is nil then TEMP-FILE-NAME must be non-nil")) 1947 (error "If FILE-NAME is nil then TEMP-FILE-NAME must be non-nil"))
1938 (python-shell-send-string 1948 (python-shell-send-string
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index 457c7fee36c..77ec8084ea2 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -64,8 +64,8 @@
64 "Regexp to match keywords that nest without blocks.") 64 "Regexp to match keywords that nest without blocks.")
65 65
66(defconst ruby-indent-beg-re 66(defconst ruby-indent-beg-re
67 (concat "\\(\\s *" (regexp-opt '("class" "module" "def") t) "\\)\\|" 67 (concat "^\\s *" (regexp-opt '("class" "module" "def" "if" "unless" "case"
68 (regexp-opt '("if" "unless" "case" "while" "until" "for" "begin"))) 68 "while" "until" "for" "begin")) "\\_>")
69 "Regexp to match where the indentation gets deeper.") 69 "Regexp to match where the indentation gets deeper.")
70 70
71(defconst ruby-modifier-beg-keywords 71(defconst ruby-modifier-beg-keywords
@@ -98,6 +98,10 @@
98 98
99(defconst ruby-block-end-re "\\_<end\\_>") 99(defconst ruby-block-end-re "\\_<end\\_>")
100 100
101(defconst ruby-defun-beg-re
102 '"\\(def\\|class\\|module\\)"
103 "Regexp to match the beginning of a defun, in the general sense.")
104
101(eval-and-compile 105(eval-and-compile
102 (defconst ruby-here-doc-beg-re 106 (defconst ruby-here-doc-beg-re
103 "\\(<\\)<\\(-\\)?\\(\\([a-zA-Z0-9_]+\\)\\|[\"]\\([^\"]+\\)[\"]\\|[']\\([^']+\\)[']\\)" 107 "\\(<\\)<\\(-\\)?\\(\\([a-zA-Z0-9_]+\\)\\|[\"]\\([^\"]+\\)[\"]\\|[']\\([^']+\\)[']\\)"
@@ -138,18 +142,11 @@ This should only be called after matching against `ruby-here-doc-beg-re'."
138 142
139(defvar ruby-mode-map 143(defvar ruby-mode-map
140 (let ((map (make-sparse-keymap))) 144 (let ((map (make-sparse-keymap)))
141 (define-key map "{" 'ruby-electric-brace)
142 (define-key map "}" 'ruby-electric-brace)
143 (define-key map (kbd "M-C-a") 'ruby-beginning-of-defun)
144 (define-key map (kbd "M-C-e") 'ruby-end-of-defun)
145 (define-key map (kbd "M-C-b") 'ruby-backward-sexp) 145 (define-key map (kbd "M-C-b") 'ruby-backward-sexp)
146 (define-key map (kbd "M-C-f") 'ruby-forward-sexp) 146 (define-key map (kbd "M-C-f") 'ruby-forward-sexp)
147 (define-key map (kbd "M-C-p") 'ruby-beginning-of-block) 147 (define-key map (kbd "M-C-p") 'ruby-beginning-of-block)
148 (define-key map (kbd "M-C-n") 'ruby-end-of-block) 148 (define-key map (kbd "M-C-n") 'ruby-end-of-block)
149 (define-key map (kbd "M-C-h") 'ruby-mark-defun)
150 (define-key map (kbd "M-C-q") 'ruby-indent-exp) 149 (define-key map (kbd "M-C-q") 'ruby-indent-exp)
151 (define-key map (kbd "C-M-h") 'backward-kill-word)
152 (define-key map (kbd "C-j") 'reindent-then-newline-and-indent)
153 (define-key map (kbd "C-c {") 'ruby-toggle-block) 150 (define-key map (kbd "C-c {") 'ruby-toggle-block)
154 map) 151 map)
155 "Keymap used in Ruby mode.") 152 "Keymap used in Ruby mode.")
@@ -840,20 +837,13 @@ and `\\' when preceded by `?'."
840 (+ indent ruby-indent-level) 837 (+ indent ruby-indent-level)
841 indent)))) 838 indent))))
842 839
843(defun ruby-electric-brace (arg)
844 "Insert a brace and re-indent the current line."
845 (interactive "P")
846 (self-insert-command (prefix-numeric-value arg))
847 (ruby-indent-line t))
848
849;; TODO: Why isn't one ruby-*-of-defun written in terms of the other?
850(defun ruby-beginning-of-defun (&optional arg) 840(defun ruby-beginning-of-defun (&optional arg)
851 "Move backward to the beginning of the current top-level defun. 841 "Move backward to the beginning of the current top-level defun.
852With ARG, move backward multiple defuns. Negative ARG means 842With ARG, move backward multiple defuns. Negative ARG means
853move forward." 843move forward."
854 (interactive "p") 844 (interactive "p")
855 (and (re-search-backward (concat "^\\(" ruby-block-beg-re "\\)\\b") 845 (and (re-search-backward (concat "^\\s *" ruby-defun-beg-re "\\_>")
856 nil 'move (or arg 1)) 846 nil t (or arg 1))
857 (beginning-of-line))) 847 (beginning-of-line)))
858 848
859(defun ruby-end-of-defun (&optional arg) 849(defun ruby-end-of-defun (&optional arg)
@@ -861,19 +851,18 @@ move forward."
861With ARG, move forward multiple defuns. Negative ARG means 851With ARG, move forward multiple defuns. Negative ARG means
862move backward." 852move backward."
863 (interactive "p") 853 (interactive "p")
864 (and (re-search-forward (concat "^\\(" ruby-block-end-re "\\)\\($\\|\\b[^_]\\)") 854 (ruby-forward-sexp)
865 nil 'move (or arg 1)) 855 (when (looking-back (concat "^\\s *" ruby-block-end-re))
866 (beginning-of-line)) 856 (forward-line 1)))
867 (forward-line 1))
868 857
869(defun ruby-beginning-of-indent () 858(defun ruby-beginning-of-indent ()
870 "TODO: document" 859 "Backtrack to a line which can be used as a reference for
871 ;; I don't understand this function. 860calculating indentation on the lines after it."
872 ;; It seems like it should move to the line where indentation should deepen, 861 (while (and (re-search-backward ruby-indent-beg-re nil 'move)
873 ;; but ruby-indent-beg-re only accounts for whitespace before class, module and def, 862 (if (ruby-in-ppss-context-p 'anything)
874 ;; so this will only match other block beginners at the beginning of the line. 863 t
875 (and (re-search-backward (concat "^\\(" ruby-indent-beg-re "\\)\\_>") nil 'move) 864 ;; We can stop, then.
876 (beginning-of-line))) 865 (beginning-of-line)))))
877 866
878(defun ruby-move-to-block (n) 867(defun ruby-move-to-block (n)
879 "Move to the beginning (N < 0) or the end (N > 0) of the current block 868 "Move to the beginning (N < 0) or the end (N > 0) of the current block
@@ -1024,15 +1013,6 @@ With ARG, do it many times. Negative ARG means move forward."
1024 ((error))) 1013 ((error)))
1025 i))) 1014 i)))
1026 1015
1027(defun ruby-mark-defun ()
1028 "Put mark at end of this Ruby function, point at beginning."
1029 (interactive)
1030 (push-mark (point))
1031 (ruby-end-of-defun)
1032 (push-mark (point) nil t)
1033 (ruby-beginning-of-defun)
1034 (re-search-backward "^\n" (- (point) 1) t))
1035
1036(defun ruby-indent-exp (&optional ignored) 1016(defun ruby-indent-exp (&optional ignored)
1037 "Indent each line in the balanced expression following the point." 1017 "Indent each line in the balanced expression following the point."
1038 (interactive "*P") 1018 (interactive "*P")
@@ -1073,7 +1053,7 @@ See `add-log-current-defun-function'."
1073 (let (mname mlist (indent 0)) 1053 (let (mname mlist (indent 0))
1074 ;; get current method (or class/module) 1054 ;; get current method (or class/module)
1075 (if (re-search-backward 1055 (if (re-search-backward
1076 (concat "^[ \t]*\\(def\\|class\\|module\\)[ \t]+" 1056 (concat "^[ \t]*" ruby-defun-beg-re "[ \t]+"
1077 "\\(" 1057 "\\("
1078 ;; \\. and :: for class method 1058 ;; \\. and :: for class method
1079 "\\([A-Za-z_]" ruby-symbol-re "*\\|\\.\\|::" "\\)" 1059 "\\([A-Za-z_]" ruby-symbol-re "*\\|\\.\\|::" "\\)"
@@ -1127,46 +1107,65 @@ See `add-log-current-defun-function'."
1127 (if mlist (concat mlist mname) mname) 1107 (if mlist (concat mlist mname) mname)
1128 mlist))))) 1108 mlist)))))
1129 1109
1130(defun ruby-brace-to-do-end () 1110(defun ruby-brace-to-do-end (orig end)
1131 (when (looking-at "{") 1111 (let (beg-marker end-marker)
1132 (let ((orig (point)) (end (progn (ruby-forward-sexp) (point)))) 1112 (goto-char end)
1133 (when (eq (char-before) ?\}) 1113 (when (eq (char-before) ?\})
1134 (delete-char -1) 1114 (delete-char -1)
1135 (if (eq (char-syntax (char-before)) ?w) 1115 (skip-chars-backward " \t")
1136 (insert " ")) 1116 (when (not (bolp))
1137 (insert "end") 1117 (insert "\n"))
1138 (if (eq (char-syntax (char-after)) ?w) 1118 (insert "end")
1139 (insert " ")) 1119 (setq end-marker (point-marker))
1140 (goto-char orig) 1120 (when (and (not (eobp)) (eq (char-syntax (char-after)) ?w))
1141 (delete-char 1) 1121 (insert " "))
1142 (if (eq (char-syntax (char-before)) ?w) 1122 (goto-char orig)
1143 (insert " ")) 1123 (delete-char 1)
1144 (insert "do") 1124 (when (eq (char-syntax (char-before)) ?w)
1145 (when (looking-at "\\sw\\||") 1125 (insert " "))
1146 (insert " ") 1126 (insert "do")
1147 (backward-char)) 1127 (setq beg-marker (point-marker))
1148 t)))) 1128 (when (looking-at "\\(\\s \\)*|")
1149 1129 (unless (match-beginning 1)
1150(defun ruby-do-end-to-brace () 1130 (insert " "))
1151 (when (and (or (bolp) 1131 (goto-char (1+ (match-end 0)))
1152 (not (memq (char-syntax (char-before)) '(?w ?_)))) 1132 (search-forward "|"))
1153 (looking-at "\\<do\\(\\s \\|$\\)")) 1133 (unless (looking-at "\\s *$")
1154 (let ((orig (point)) (end (progn (ruby-forward-sexp) (point)))) 1134 (insert "\n"))
1155 (backward-char 3) 1135 (indent-region beg-marker end-marker)
1156 (when (looking-at ruby-block-end-re) 1136 (goto-char beg-marker)
1157 (delete-char 3) 1137 t)))
1158 (insert "}") 1138
1159 (goto-char orig) 1139(defun ruby-do-end-to-brace (orig end)
1160 (delete-char 2) 1140 (goto-char (- end 3))
1161 (insert "{") 1141 (when (looking-at ruby-block-end-re)
1162 (if (looking-at "\\s +|") 1142 (delete-char 3)
1163 (delete-char (- (match-end 0) (match-beginning 0) 1))) 1143 (insert "}")
1164 t)))) 1144 (goto-char orig)
1145 (delete-char 2)
1146 (insert "{")
1147 (if (looking-at "\\s +|")
1148 (delete-char (- (match-end 0) (match-beginning 0) 1)))
1149 t))
1165 1150
1166(defun ruby-toggle-block () 1151(defun ruby-toggle-block ()
1152 "Toggle block type from do-end to braces or back.
1153The block must begin on the current line or above it and end after the point.
1154If the result is do-end block, it will always be multiline."
1167 (interactive) 1155 (interactive)
1168 (or (ruby-brace-to-do-end) 1156 (let ((start (point)) beg end)
1169 (ruby-do-end-to-brace))) 1157 (end-of-line)
1158 (unless
1159 (if (and (re-search-backward "\\({\\)\\|\\_<do\\(\\s \\|$\\||\\)")
1160 (progn
1161 (setq beg (point))
1162 (save-match-data (ruby-forward-sexp))
1163 (setq end (point))
1164 (> end start)))
1165 (if (match-beginning 1)
1166 (ruby-brace-to-do-end beg end)
1167 (ruby-do-end-to-brace beg end)))
1168 (goto-char start))))
1170 1169
1171(declare-function ruby-syntax-propertize-heredoc "ruby-mode" (limit)) 1170(declare-function ruby-syntax-propertize-heredoc "ruby-mode" (limit))
1172(declare-function ruby-syntax-enclosing-percent-literal "ruby-mode" (limit)) 1171(declare-function ruby-syntax-enclosing-percent-literal "ruby-mode" (limit))
@@ -1193,8 +1192,6 @@ It will be properly highlighted even when the call omits parens."))
1193 (ruby-syntax-enclosing-percent-literal end) 1192 (ruby-syntax-enclosing-percent-literal end)
1194 (funcall 1193 (funcall
1195 (syntax-propertize-rules 1194 (syntax-propertize-rules
1196 ;; #{ }, #$hoge, #@foo are not comments.
1197 ("\\(#\\)[{$@]" (1 "."))
1198 ;; $' $" $` .... are variables. 1195 ;; $' $" $` .... are variables.
1199 ;; ?' ?" ?` are ascii codes. 1196 ;; ?' ?" ?` are ascii codes.
1200 ("\\([?$]\\)[#\"'`]" 1197 ("\\([?$]\\)[#\"'`]"
@@ -1326,8 +1323,7 @@ This should only be called after matching against `ruby-here-doc-end-re'."
1326 (concat "-?\\([\"']\\|\\)" contents "\\1")))))) 1323 (concat "-?\\([\"']\\|\\)" contents "\\1"))))))
1327 1324
1328 (defconst ruby-font-lock-syntactic-keywords 1325 (defconst ruby-font-lock-syntactic-keywords
1329 `( ;; #{ }, #$hoge, #@foo are not comments 1326 `(
1330 ("\\(#\\)[{$@]" 1 (1 . nil))
1331 ;; the last $', $", $` in the respective string is not variable 1327 ;; the last $', $", $` in the respective string is not variable
1332 ;; the last ?', ?", ?` in the respective string is not ascii code 1328 ;; the last ?', ?", ?` in the respective string is not ascii code
1333 ("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)" 1329 ("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)"
@@ -1549,6 +1545,9 @@ See `font-lock-syntax-table'.")
1549 ;; variables 1545 ;; variables
1550 '("\\(^\\|[^_:.@$]\\|\\.\\.\\)\\b\\(nil\\|self\\|true\\|false\\)\\>" 1546 '("\\(^\\|[^_:.@$]\\|\\.\\.\\)\\b\\(nil\\|self\\|true\\|false\\)\\>"
1551 2 font-lock-variable-name-face) 1547 2 font-lock-variable-name-face)
1548 ;; symbols
1549 '("\\(^\\|[^:]\\)\\(:\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|![~=]?\\|\\[\\]=?\\|@?\\(\\w\\|_\\)+\\([!?=]\\|\\b_*\\)\\|#{[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\)\\)"
1550 2 font-lock-reference-face)
1552 ;; variables 1551 ;; variables
1553 '("\\(\\$\\([^a-zA-Z0-9 \n]\\|[0-9]\\)\\)\\W" 1552 '("\\(\\$\\([^a-zA-Z0-9 \n]\\|[0-9]\\)\\)\\W"
1554 1 font-lock-variable-name-face) 1553 1 font-lock-variable-name-face)
@@ -1557,12 +1556,9 @@ See `font-lock-syntax-table'.")
1557 ;; constants 1556 ;; constants
1558 '("\\(^\\|[^_]\\)\\b\\([A-Z]+\\(\\w\\|_\\)*\\)" 1557 '("\\(^\\|[^_]\\)\\b\\([A-Z]+\\(\\w\\|_\\)*\\)"
1559 2 font-lock-type-face) 1558 2 font-lock-type-face)
1560 ;; symbols
1561 '("\\(^\\|[^:]\\)\\(:\\([-+~]@?\\|[/%&|^`]\\|\\*\\*?\\|<\\(<\\|=>?\\)?\\|>[>=]?\\|===?\\|=~\\|![~=]?\\|\\[\\]=?\\|\\(\\w\\|_\\)+\\([!?=]\\|\\b_*\\)\\|#{[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\)\\)"
1562 2 font-lock-reference-face)
1563 '("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" 2 font-lock-reference-face) 1559 '("\\(^\\s *\\|[\[\{\(,]\\s *\\|\\sw\\s +\\)\\(\\(\\sw\\|_\\)+\\):[^:]" 2 font-lock-reference-face)
1564 ;; expression expansion 1560 ;; expression expansion
1565 '("#\\({[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\|\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\)" 1561 '(ruby-match-expression-expansion
1566 0 font-lock-variable-name-face t) 1562 0 font-lock-variable-name-face t)
1567 ;; warn lower camel case 1563 ;; warn lower camel case
1568 ;'("\\<[a-z]+[a-z0-9]*[A-Z][A-Za-z0-9]*\\([!?]?\\|\\>\\)" 1564 ;'("\\<[a-z]+[a-z0-9]*[A-Z][A-Za-z0-9]*\\([!?]?\\|\\>\\)"
@@ -1570,6 +1566,11 @@ See `font-lock-syntax-table'.")
1570 ) 1566 )
1571 "Additional expressions to highlight in Ruby mode.") 1567 "Additional expressions to highlight in Ruby mode.")
1572 1568
1569(defun ruby-match-expression-expansion (limit)
1570 (when (re-search-forward "[^\\]\\(\\\\\\\\\\)*\\(#\\({[^}\n\\\\]*\\(\\\\.[^}\n\\\\]*\\)*}\\|\\(\\$\\|@\\|@@\\)\\(\\w\\|_\\)+\\)\\)" limit 'move)
1571 (or (ruby-in-ppss-context-p 'string)
1572 (ruby-match-expression-expansion limit))))
1573
1573;;;###autoload 1574;;;###autoload
1574(define-derived-mode ruby-mode prog-mode "Ruby" 1575(define-derived-mode ruby-mode prog-mode "Ruby"
1575 "Major mode for editing Ruby scripts. 1576 "Major mode for editing Ruby scripts.
@@ -1586,6 +1587,10 @@ The variable `ruby-indent-level' controls the amount of indentation.
1586 'ruby-imenu-create-index) 1587 'ruby-imenu-create-index)
1587 (set (make-local-variable 'add-log-current-defun-function) 1588 (set (make-local-variable 'add-log-current-defun-function)
1588 'ruby-add-log-current-method) 1589 'ruby-add-log-current-method)
1590 (set (make-local-variable 'beginning-of-defun-function)
1591 'ruby-beginning-of-defun)
1592 (set (make-local-variable 'end-of-defun-function)
1593 'ruby-end-of-defun)
1589 1594
1590 (add-hook 1595 (add-hook
1591 (cond ((boundp 'before-save-hook) 'before-save-hook) 1596 (cond ((boundp 'before-save-hook) 'before-save-hook)
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index a422462775d..b4d550bcee0 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -1062,21 +1062,22 @@ subshells can nest."
1062 (backward-char 1)) 1062 (backward-char 1))
1063 (when (eq (char-before) ?|) 1063 (when (eq (char-before) ?|)
1064 (backward-char 1) t))) 1064 (backward-char 1) t)))
1065 (when (progn (backward-char 2) 1065 (and (> (point) (1+ (point-min)))
1066 (if (> start (line-end-position)) 1066 (progn (backward-char 2)
1067 (put-text-property (point) (1+ start) 1067 (if (> start (line-end-position))
1068 'syntax-multiline t)) 1068 (put-text-property (point) (1+ start)
1069 ;; FIXME: The `in' may just be a random argument to 1069 'syntax-multiline t))
1070 ;; a normal command rather than the real `in' keyword. 1070 ;; FIXME: The `in' may just be a random argument to
1071 ;; I.e. we should look back to try and find the 1071 ;; a normal command rather than the real `in' keyword.
1072 ;; corresponding `case'. 1072 ;; I.e. we should look back to try and find the
1073 (and (looking-at ";[;&]\\|\\_<in") 1073 ;; corresponding `case'.
1074 ;; ";; esac )" is a case that looks like a case-pattern 1074 (and (looking-at ";[;&]\\|\\_<in")
1075 ;; but it's really just a close paren after a case 1075 ;; ";; esac )" is a case that looks like a case-pattern
1076 ;; statement. I.e. if we skipped over `esac' just now, 1076 ;; but it's really just a close paren after a case
1077 ;; we're not looking at a case-pattern. 1077 ;; statement. I.e. if we skipped over `esac' just now,
1078 (not (looking-at "..[ \t\n]+esac[^[:word:]_]")))) 1078 ;; we're not looking at a case-pattern.
1079 sh-st-punc)))) 1079 (not (looking-at "..[ \t\n]+esac[^[:word:]_]"))))
1080 sh-st-punc))))
1080 1081
1081(defun sh-font-lock-backslash-quote () 1082(defun sh-font-lock-backslash-quote ()
1082 (if (eq (save-excursion (nth 3 (syntax-ppss (match-beginning 0)))) ?\') 1083 (if (eq (save-excursion (nth 3 (syntax-ppss (match-beginning 0)))) ?\')
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index 030cc02f3f4..3d5abc4df62 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -4,7 +4,7 @@
4 4
5;; Author: Alex Schroeder <alex@gnu.org> 5;; Author: Alex Schroeder <alex@gnu.org>
6;; Maintainer: Michael Mauger <mmaug@yahoo.com> 6;; Maintainer: Michael Mauger <mmaug@yahoo.com>
7;; Version: 3.0 7;; Version: 3.1
8;; Keywords: comm languages processes 8;; Keywords: comm languages processes
9;; URL: http://savannah.gnu.org/projects/emacs/ 9;; URL: http://savannah.gnu.org/projects/emacs/
10 10
@@ -218,9 +218,12 @@
218;; Michael Mauger <mmaug@yahoo.com> -- improved product support 218;; Michael Mauger <mmaug@yahoo.com> -- improved product support
219;; Drew Adams <drew.adams@oracle.com> -- Emacs 20 support 219;; Drew Adams <drew.adams@oracle.com> -- Emacs 20 support
220;; Harald Maier <maierh@myself.com> -- sql-send-string 220;; Harald Maier <maierh@myself.com> -- sql-send-string
221;; Stefan Monnier <monnier@iro.umontreal.ca> -- font-lock corrections; code polish 221;; Stefan Monnier <monnier@iro.umontreal.ca> -- font-lock corrections;
222;; code polish
222;; Paul Sleigh <bat@flurf.net> -- MySQL keyword enhancement 223;; Paul Sleigh <bat@flurf.net> -- MySQL keyword enhancement
223;; Andrew Schein <andrew@andrewschein.com> -- sql-port bug 224;; Andrew Schein <andrew@andrewschein.com> -- sql-port bug
225;; Ian Bjorhovde <idbjorh@dataproxy.com> -- db2 escape newlines
226;; incorrectly enabled by default
224 227
225 228
226 229
@@ -265,9 +268,8 @@
265 268
266(defcustom sql-password "" 269(defcustom sql-password ""
267 "Default password. 270 "Default password.
268 271If you customize this, the value will be stored in your init
269Storing your password in a textfile such as ~/.emacs could be dangerous. 272file. Since that is a plaintext file, this could be dangerous."
270Customizing your password will store it in your ~/.emacs file."
271 :type 'string 273 :type 'string
272 :group 'SQL 274 :group 'SQL
273 :risky t) 275 :risky t)
@@ -879,6 +881,16 @@ In older versions of SQL*Plus, this was the SET SCAN OFF command."
879 :type 'boolean 881 :type 'boolean
880 :group 'SQL) 882 :group 'SQL)
881 883
884(defcustom sql-db2-escape-newlines nil
885 "Non-nil if newlines should be escaped by a backslash in DB2 SQLi.
886
887When non-nil, Emacs will automatically insert a space and
888backslash prior to every newline in multi-line SQL statements as
889they are submitted to an interactive DB2 session."
890 :version "24.3"
891 :type 'boolean
892 :group 'SQL)
893
882;; Customization for SQLite 894;; Customization for SQLite
883 895
884(defcustom sql-sqlite-program (or (executable-find "sqlite3") 896(defcustom sql-sqlite-program (or (executable-find "sqlite3")
@@ -1272,8 +1284,8 @@ Based on `comint-mode-map'.")
1272 ["List all objects" sql-list-all (sql-get-product-feature sql-product :list-all)] 1284 ["List all objects" sql-list-all (sql-get-product-feature sql-product :list-all)]
1273 ["List table details" sql-list-table (sql-get-product-feature sql-product :list-table)])) 1285 ["List table details" sql-list-table (sql-get-product-feature sql-product :list-table)]))
1274 1286
1275;; Abbreviations -- if you want more of them, define them in your 1287;; Abbreviations -- if you want more of them, define them in your init
1276;; ~/.emacs file. Abbrevs have to be enabled in your ~/.emacs, too. 1288;; file. Abbrevs have to be enabled in your init file, too.
1277 1289
1278(defvar sql-mode-abbrev-table nil 1290(defvar sql-mode-abbrev-table nil
1279 "Abbrev table used in `sql-mode' and `sql-interactive-mode'.") 1291 "Abbrev table used in `sql-mode' and `sql-interactive-mode'.")
@@ -3188,20 +3200,23 @@ Placeholders are words starting with an ampersand like &this."
3188 3200
3189;; Using DB2 interactively, newlines must be escaped with " \". 3201;; Using DB2 interactively, newlines must be escaped with " \".
3190;; The space before the backslash is relevant. 3202;; The space before the backslash is relevant.
3203
3191(defun sql-escape-newlines-filter (string) 3204(defun sql-escape-newlines-filter (string)
3192 "Escape newlines in STRING. 3205 "Escape newlines in STRING.
3193Every newline in STRING will be preceded with a space and a backslash." 3206Every newline in STRING will be preceded with a space and a backslash."
3194 (let ((result "") (start 0) mb me) 3207 (if (not sql-db2-escape-newlines)
3195 (while (string-match "\n" string start) 3208 string
3196 (setq mb (match-beginning 0) 3209 (let ((result "") (start 0) mb me)
3197 me (match-end 0) 3210 (while (string-match "\n" string start)
3198 result (concat result 3211 (setq mb (match-beginning 0)
3199 (substring string start mb) 3212 me (match-end 0)
3200 (if (and (> mb 1) 3213 result (concat result
3201 (string-equal " \\" (substring string (- mb 2) mb))) 3214 (substring string start mb)
3202 "" " \\\n")) 3215 (if (and (> mb 1)
3203 start me)) 3216 (string-equal " \\" (substring string (- mb 2) mb)))
3204 (concat result (substring string start)))) 3217 "" " \\\n"))
3218 start me))
3219 (concat result (substring string start)))))
3205 3220
3206 3221
3207 3222
@@ -3699,8 +3714,8 @@ For information on how to create multiple SQLi buffers, see
3699`sql-interactive-mode'. 3714`sql-interactive-mode'.
3700 3715
3701Note that SQL doesn't have an escape character unless you specify 3716Note that SQL doesn't have an escape character unless you specify
3702one. If you specify backslash as escape character in SQL, 3717one. If you specify backslash as escape character in SQL, you
3703you must tell Emacs. Here's how to do that in your `~/.emacs' file: 3718must tell Emacs. Here's how to do that in your init file:
3704 3719
3705\(add-hook 'sql-mode-hook 3720\(add-hook 'sql-mode-hook
3706 (lambda () 3721 (lambda ()
@@ -3790,7 +3805,7 @@ cause the window to scroll to the end of the buffer.
3790If you want to make SQL buffers limited in length, add the function 3805If you want to make SQL buffers limited in length, add the function
3791`comint-truncate-buffer' to `comint-output-filter-functions'. 3806`comint-truncate-buffer' to `comint-output-filter-functions'.
3792 3807
3793Here is an example for your .emacs file. It keeps the SQLi buffer a 3808Here is an example for your init file. It keeps the SQLi buffer a
3794certain length. 3809certain length.
3795 3810
3796\(add-hook 'sql-interactive-mode-hook 3811\(add-hook 'sql-interactive-mode-hook
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index c072754e66d..835d548c19f 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -8790,7 +8790,7 @@ Note these are only read when the file is first visited, you must use
8790\\[find-alternate-file] RET to have these take effect after editing them! 8790\\[find-alternate-file] RET to have these take effect after editing them!
8791 8791
8792If you want to disable the \"Process `eval' or hook local variables\" 8792If you want to disable the \"Process `eval' or hook local variables\"
8793warning message, you need to add to your .emacs file: 8793warning message, you need to add to your init file:
8794 8794
8795 (setq enable-local-eval t)" 8795 (setq enable-local-eval t)"
8796 (let ((origbuf (current-buffer))) 8796 (let ((origbuf (current-buffer)))
@@ -11756,7 +11756,7 @@ An example:
11756 11756
11757 // For this example we declare the function in the 11757 // For this example we declare the function in the
11758 // module's file itself. Often you'd define it instead 11758 // module's file itself. Often you'd define it instead
11759 // in a site-start.el or .emacs file. 11759 // in a site-start.el or init file.
11760 /* 11760 /*
11761 Local Variables: 11761 Local Variables:
11762 eval: 11762 eval:
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index 607ccd8b7e7..0ca3439dd60 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -4138,10 +4138,7 @@ STRING are replaced by `-' and substrings are converted to lower case."
4138 (set (make-local-variable 'imenu-generic-expression) 4138 (set (make-local-variable 'imenu-generic-expression)
4139 vhdl-imenu-generic-expression) 4139 vhdl-imenu-generic-expression)
4140 (when (and vhdl-index-menu (fboundp 'imenu)) 4140 (when (and vhdl-index-menu (fboundp 'imenu))
4141 (if (or (not (boundp 'font-lock-maximum-size)) 4141 (imenu-add-to-menubar "Index")))
4142 (> font-lock-maximum-size (buffer-size)))
4143 (imenu-add-to-menubar "Index")
4144 (message "Scanning buffer for index...buffer too big"))))
4145 4142
4146;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4143;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4147;; Source file menu (using `easy-menu.el') 4144;; Source file menu (using `easy-menu.el')
@@ -14385,10 +14382,10 @@ if required."
14385 (define-key vhdl-speedbar-key-map (int-to-string key) 14382 (define-key vhdl-speedbar-key-map (int-to-string key)
14386 `(lambda () (interactive) (vhdl-speedbar-set-depth ,key))) 14383 `(lambda () (interactive) (vhdl-speedbar-set-depth ,key)))
14387 (setq key (1+ key))))) 14384 (setq key (1+ key)))))
14388 (define-key speedbar-key-map "h" 14385 (define-key speedbar-mode-map "h"
14389 (lambda () (interactive) 14386 (lambda () (interactive)
14390 (speedbar-change-initial-expansion-list "vhdl directory"))) 14387 (speedbar-change-initial-expansion-list "vhdl directory")))
14391 (define-key speedbar-key-map "H" 14388 (define-key speedbar-mode-map "H"
14392 (lambda () (interactive) 14389 (lambda () (interactive)
14393 (speedbar-change-initial-expansion-list "vhdl project"))) 14390 (speedbar-change-initial-expansion-list "vhdl project")))
14394 ;; menu 14391 ;; menu
@@ -17400,7 +17397,8 @@ to visually support naming conventions.")
17400 "Display VARIABLE's documentation in *Help* buffer." 17397 "Display VARIABLE's documentation in *Help* buffer."
17401 (interactive) 17398 (interactive)
17402 (unless (featurep 'xemacs) 17399 (unless (featurep 'xemacs)
17403 (help-setup-xref (list #'vhdl-doc-variable variable) (interactive-p))) 17400 (help-setup-xref (list #'vhdl-doc-variable variable)
17401 (called-interactively-p 'interactive)))
17404 (with-output-to-temp-buffer 17402 (with-output-to-temp-buffer
17405 (if (fboundp 'help-buffer) (help-buffer) "*Help*") 17403 (if (fboundp 'help-buffer) (help-buffer) "*Help*")
17406 (princ (documentation-property variable 'variable-documentation)) 17404 (princ (documentation-property variable 'variable-documentation))
@@ -17412,7 +17410,8 @@ to visually support naming conventions.")
17412 "Display VHDL Mode documentation in *Help* buffer." 17410 "Display VHDL Mode documentation in *Help* buffer."
17413 (interactive) 17411 (interactive)
17414 (unless (featurep 'xemacs) 17412 (unless (featurep 'xemacs)
17415 (help-setup-xref (list #'vhdl-doc-mode) (interactive-p))) 17413 (help-setup-xref (list #'vhdl-doc-mode)
17414 (called-interactively-p 'interactive)))
17416 (with-output-to-temp-buffer 17415 (with-output-to-temp-buffer
17417 (if (fboundp 'help-buffer) (help-buffer) "*Help*") 17416 (if (fboundp 'help-buffer) (help-buffer) "*Help*")
17418 (princ mode-name) 17417 (princ mode-name)
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index addf2975c5f..930e750ab27 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -1042,7 +1042,7 @@ Please send all bug fixes and enhancements to
1042;; variables `ps-bold-faces', `ps-italic-faces' and `ps-underlined-faces'. 1042;; variables `ps-bold-faces', `ps-italic-faces' and `ps-underlined-faces'.
1043;; These variables contain lists of faces that ps-print should consider bold, 1043;; These variables contain lists of faces that ps-print should consider bold,
1044;; italic or underline; to set them, put code like the following into your 1044;; italic or underline; to set them, put code like the following into your
1045;; .emacs file: 1045;; init file:
1046;; 1046;;
1047;; (setq ps-bold-faces '(my-blue-face)) 1047;; (setq ps-bold-faces '(my-blue-face))
1048;; (setq ps-italic-faces '(my-red-face)) 1048;; (setq ps-italic-faces '(my-red-face))
diff --git a/lisp/register.el b/lisp/register.el
index 2816c9831de..fb35a26a653 100644
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -76,6 +76,22 @@ A list of the form (WINDOW-CONFIGURATION POSITION)
76A list of the form (FRAME-CONFIGURATION POSITION) 76A list of the form (FRAME-CONFIGURATION POSITION)
77 represents a saved frame configuration plus a saved value of point.") 77 represents a saved frame configuration plus a saved value of point.")
78 78
79(defgroup register nil
80 "Register commands."
81 :group 'convenience
82 :version "24.3")
83
84(defcustom register-separator nil
85 "Register containing the text to put between collected texts, or nil if none.
86
87When collecting text with
88`append-to-register' (resp. `prepend-to-register') contents of
89this register is added to the beginning (resp. end) of the marked
90text."
91 :group 'register
92 :type '(choice (const :tag "None" nil)
93 (character :tag "Use register" :value ?+)))
94
79(defun get-register (register) 95(defun get-register (register)
80 "Return contents of Emacs register named REGISTER, or nil if none." 96 "Return contents of Emacs register named REGISTER, or nil if none."
81 (cdr (assq register register-alist))) 97 (cdr (assq register register-alist)))
@@ -192,13 +208,24 @@ Interactively, NUMBER is the prefix arg (none means nil)."
192 (string-to-number (match-string 0))) 208 (string-to-number (match-string 0)))
193 0)))) 209 0))))
194 210
195(defun increment-register (number register) 211(defun increment-register (prefix register)
196 "Add NUMBER to the contents of register REGISTER. 212 "Augment contents of REGISTER.
197Interactively, NUMBER is the prefix arg." 213Interactively, PREFIX is in raw form.
198 (interactive "p\ncIncrement register: ") 214
199 (or (numberp (get-register register)) 215If REGISTER contains a number, add `prefix-numeric-value' of
200 (error "Register does not contain a number")) 216PREFIX to it.
201 (set-register register (+ number (get-register register)))) 217
218If REGISTER is empty or if it contains text, call
219`append-to-register' with `delete-flag' set to PREFIX."
220 (interactive "P\ncIncrement register: ")
221 (let ((register-val (get-register register)))
222 (cond
223 ((numberp register-val)
224 (let ((number (prefix-numeric-value prefix)))
225 (set-register register (+ number register-val))))
226 ((or (not register-val) (stringp register-val))
227 (append-to-register register (region-beginning) (region-end) prefix))
228 (t (error "Register does not contain a number or text")))))
202 229
203(defun view-register (register) 230(defun view-register (register)
204 "Display what is contained in register named REGISTER. 231 "Display what is contained in register named REGISTER.
@@ -349,10 +376,11 @@ Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
349START and END are buffer positions indicating what to append." 376START and END are buffer positions indicating what to append."
350 (interactive "cAppend to register: \nr\nP") 377 (interactive "cAppend to register: \nr\nP")
351 (let ((reg (get-register register)) 378 (let ((reg (get-register register))
352 (text (filter-buffer-substring start end))) 379 (text (filter-buffer-substring start end))
380 (separator (and register-separator (get-register register-separator))))
353 (set-register 381 (set-register
354 register (cond ((not reg) text) 382 register (cond ((not reg) text)
355 ((stringp reg) (concat reg text)) 383 ((stringp reg) (concat reg separator text))
356 (t (error "Register does not contain text"))))) 384 (t (error "Register does not contain text")))))
357 (cond (delete-flag 385 (cond (delete-flag
358 (delete-region start end)) 386 (delete-region start end))
@@ -366,10 +394,11 @@ Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
366START and END are buffer positions indicating what to prepend." 394START and END are buffer positions indicating what to prepend."
367 (interactive "cPrepend to register: \nr\nP") 395 (interactive "cPrepend to register: \nr\nP")
368 (let ((reg (get-register register)) 396 (let ((reg (get-register register))
369 (text (filter-buffer-substring start end))) 397 (text (filter-buffer-substring start end))
398 (separator (and register-separator (get-register register-separator))))
370 (set-register 399 (set-register
371 register (cond ((not reg) text) 400 register (cond ((not reg) text)
372 ((stringp reg) (concat text reg)) 401 ((stringp reg) (concat text separator reg))
373 (t (error "Register does not contain text"))))) 402 (t (error "Register does not contain text")))))
374 (cond (delete-flag 403 (cond (delete-flag
375 (delete-region start end)) 404 (delete-region start end))
diff --git a/lisp/replace.el b/lisp/replace.el
index 3373ee8e512..001f7d1a78d 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -33,6 +33,22 @@
33 :type 'boolean 33 :type 'boolean
34 :group 'matching) 34 :group 'matching)
35 35
36(defcustom replace-lax-whitespace nil
37 "Non-nil means `query-replace' matches a sequence of whitespace chars.
38When you enter a space or spaces in the strings to be replaced,
39it will match any sequence matched by the regexp `search-whitespace-regexp'."
40 :type 'boolean
41 :group 'matching
42 :version "24.3")
43
44(defcustom replace-regexp-lax-whitespace nil
45 "Non-nil means `query-replace-regexp' matches a sequence of whitespace chars.
46When you enter a space or spaces in the regexps to be replaced,
47it will match any sequence matched by the regexp `search-whitespace-regexp'."
48 :type 'boolean
49 :group 'matching
50 :version "24.3")
51
36(defvar query-replace-history nil 52(defvar query-replace-history nil
37 "Default history list for query-replace commands. 53 "Default history list for query-replace commands.
38See `query-replace-from-history-variable' and 54See `query-replace-from-history-variable' and
@@ -226,6 +242,10 @@ letters. \(Transferring the case pattern means that if the old text
226matched is all caps, or capitalized, then its replacement is upcased 242matched is all caps, or capitalized, then its replacement is upcased
227or capitalized.) 243or capitalized.)
228 244
245If `replace-lax-whitespace' is non-nil, a space or spaces in the string
246to be replaced will match a sequence of whitespace chars defined by the
247regexp in `search-whitespace-regexp'.
248
229Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace 249Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
230only matches surrounded by word boundaries. 250only matches surrounded by word boundaries.
231Fourth and fifth arg START and END specify the region to operate on. 251Fourth and fifth arg START and END specify the region to operate on.
@@ -270,6 +290,10 @@ pattern of the old text to the new text, if `case-replace' and
270all caps, or capitalized, then its replacement is upcased or 290all caps, or capitalized, then its replacement is upcased or
271capitalized.) 291capitalized.)
272 292
293If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp
294to be replaced will match a sequence of whitespace chars defined by the
295regexp in `search-whitespace-regexp'.
296
273Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace 297Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
274only matches surrounded by word boundaries. 298only matches surrounded by word boundaries.
275Fourth and fifth arg START and END specify the region to operate on. 299Fourth and fifth arg START and END specify the region to operate on.
@@ -346,6 +370,10 @@ minibuffer.
346Preserves case in each replacement if `case-replace' and `case-fold-search' 370Preserves case in each replacement if `case-replace' and `case-fold-search'
347are non-nil and REGEXP has no uppercase letters. 371are non-nil and REGEXP has no uppercase letters.
348 372
373If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp
374to be replaced will match a sequence of whitespace chars defined by the
375regexp in `search-whitespace-regexp'.
376
349Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace 377Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
350only matches that are surrounded by word boundaries. 378only matches that are surrounded by word boundaries.
351Fourth and fifth arg START and END specify the region to operate on." 379Fourth and fifth arg START and END specify the region to operate on."
@@ -437,6 +465,10 @@ are non-nil and FROM-STRING has no uppercase letters.
437\(Preserving case means that if the string matched is all caps, or capitalized, 465\(Preserving case means that if the string matched is all caps, or capitalized,
438then its replacement is upcased or capitalized.) 466then its replacement is upcased or capitalized.)
439 467
468If `replace-lax-whitespace' is non-nil, a space or spaces in the string
469to be replaced will match a sequence of whitespace chars defined by the
470regexp in `search-whitespace-regexp'.
471
440In Transient Mark mode, if the mark is active, operate on the contents 472In Transient Mark mode, if the mark is active, operate on the contents
441of the region. Otherwise, operate from point to the end of the buffer. 473of the region. Otherwise, operate from point to the end of the buffer.
442 474
@@ -475,6 +507,10 @@ and TO-STRING is also null.)"
475Preserve case in each match if `case-replace' and `case-fold-search' 507Preserve case in each match if `case-replace' and `case-fold-search'
476are non-nil and REGEXP has no uppercase letters. 508are non-nil and REGEXP has no uppercase letters.
477 509
510If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp
511to be replaced will match a sequence of whitespace chars defined by the
512regexp in `search-whitespace-regexp'.
513
478In Transient Mark mode, if the mark is active, operate on the contents 514In Transient Mark mode, if the mark is active, operate on the contents
479of the region. Otherwise, operate from point to the end of the buffer. 515of the region. Otherwise, operate from point to the end of the buffer.
480 516
@@ -1589,14 +1625,28 @@ E to edit the replacement string"
1589 (define-key map "?" 'help) 1625 (define-key map "?" 'help)
1590 (define-key map "\C-g" 'quit) 1626 (define-key map "\C-g" 'quit)
1591 (define-key map "\C-]" 'quit) 1627 (define-key map "\C-]" 'quit)
1592 (define-key map "\e" 'exit-prefix) 1628 (define-key map "\C-v" 'scroll-up)
1629 (define-key map "\M-v" 'scroll-down)
1630 (define-key map [next] 'scroll-up)
1631 (define-key map [prior] 'scroll-down)
1632 (define-key map [?\C-\M-v] 'scroll-other-window)
1633 (define-key map [M-next] 'scroll-other-window)
1634 (define-key map [?\C-\M-\S-v] 'scroll-other-window-down)
1635 (define-key map [M-prior] 'scroll-other-window-down)
1636 ;; Binding ESC would prohibit the M-v binding. Instead, callers
1637 ;; should check for ESC specially.
1638 ;; (define-key map "\e" 'exit-prefix)
1593 (define-key map [escape] 'exit-prefix) 1639 (define-key map [escape] 'exit-prefix)
1594 map) 1640 map)
1595 "Keymap that defines the responses to questions in `query-replace'. 1641 "Keymap of responses to questions posed by commands like `query-replace'.
1596The \"bindings\" in this map are not commands; they are answers. 1642The \"bindings\" in this map are not commands; they are answers.
1597The valid answers include `act', `skip', `act-and-show', 1643The valid answers include `act', `skip', `act-and-show',
1598`exit', `act-and-exit', `edit', `edit-replacement', `delete-and-edit', 1644`act-and-exit', `exit', `exit-prefix', `recenter', `scroll-up',
1599`recenter', `automatic', `backup', `exit-prefix', `quit', and `help'.") 1645`scroll-down', `scroll-other-window', `scroll-other-window-down',
1646`edit', `edit-replacement', `delete-and-edit', `automatic',
1647`backup', `quit', and `help'.
1648
1649This keymap is used by `y-or-n-p' as well as `query-replace'.")
1600 1650
1601(defvar multi-query-replace-map 1651(defvar multi-query-replace-map
1602 (let ((map (make-sparse-keymap))) 1652 (let ((map (make-sparse-keymap)))
@@ -1717,12 +1767,12 @@ passed in. If LITERAL is set, no checking is done, anyway."
1717 (replace-match newtext fixedcase literal) 1767 (replace-match newtext fixedcase literal)
1718 noedit) 1768 noedit)
1719 1769
1720(defvar replace-search-function 'search-forward 1770(defvar replace-search-function nil
1721 "Function to use when searching for strings to replace. 1771 "Function to use when searching for strings to replace.
1722It is used by `query-replace' and `replace-string', and is called 1772It is used by `query-replace' and `replace-string', and is called
1723with three arguments, as if it were `search-forward'.") 1773with three arguments, as if it were `search-forward'.")
1724 1774
1725(defvar replace-re-search-function 're-search-forward 1775(defvar replace-re-search-function nil
1726 "Function to use when searching for regexps to replace. 1776 "Function to use when searching for regexps to replace.
1727It is used by `query-replace-regexp', `replace-regexp', 1777It is used by `query-replace-regexp', `replace-regexp',
1728`query-replace-regexp-eval', and `map-query-replace-regexp'. 1778`query-replace-regexp-eval', and `map-query-replace-regexp'.
@@ -1755,9 +1805,18 @@ make, or the user didn't cancel the call."
1755 (nocasify (not (and case-replace case-fold-search))) 1805 (nocasify (not (and case-replace case-fold-search)))
1756 (literal (or (not regexp-flag) (eq regexp-flag 'literal))) 1806 (literal (or (not regexp-flag) (eq regexp-flag 'literal)))
1757 (search-function 1807 (search-function
1758 (if regexp-flag 1808 (or (if regexp-flag
1759 replace-re-search-function 1809 replace-re-search-function
1760 replace-search-function)) 1810 replace-search-function)
1811 (let ((isearch-regexp regexp-flag)
1812 (isearch-word delimited-flag)
1813 (isearch-lax-whitespace
1814 replace-lax-whitespace)
1815 (isearch-regexp-lax-whitespace
1816 replace-regexp-lax-whitespace)
1817 (isearch-case-fold-search case-fold-search)
1818 (isearch-forward t))
1819 (isearch-search-fun))))
1761 (search-string from-string) 1820 (search-string from-string)
1762 (real-match-data nil) ; The match data for the current match. 1821 (real-match-data nil) ; The match data for the current match.
1763 (next-replacement nil) 1822 (next-replacement nil)
@@ -1811,12 +1870,6 @@ make, or the user didn't cancel the call."
1811 (vector repeat-count repeat-count 1870 (vector repeat-count repeat-count
1812 replacements replacements))))) 1871 replacements replacements)))))
1813 1872
1814 (if delimited-flag
1815 (setq search-function 're-search-forward
1816 search-string (concat "\\b"
1817 (if regexp-flag from-string
1818 (regexp-quote from-string))
1819 "\\b")))
1820 (when query-replace-lazy-highlight 1873 (when query-replace-lazy-highlight
1821 (setq isearch-lazy-highlight-last-string nil)) 1874 (setq isearch-lazy-highlight-last-string nil))
1822 1875
@@ -1898,7 +1951,7 @@ make, or the user didn't cancel the call."
1898 (replace-highlight 1951 (replace-highlight
1899 (nth 0 real-match-data) (nth 1 real-match-data) 1952 (nth 0 real-match-data) (nth 1 real-match-data)
1900 start end search-string 1953 start end search-string
1901 (or delimited-flag regexp-flag) case-fold-search)) 1954 regexp-flag delimited-flag case-fold-search))
1902 (setq noedit 1955 (setq noedit
1903 (replace-match-maybe-edit 1956 (replace-match-maybe-edit
1904 next-replacement nocasify literal 1957 next-replacement nocasify literal
@@ -1917,7 +1970,7 @@ make, or the user didn't cancel the call."
1917 (replace-highlight 1970 (replace-highlight
1918 (match-beginning 0) (match-end 0) 1971 (match-beginning 0) (match-end 0)
1919 start end search-string 1972 start end search-string
1920 (or delimited-flag regexp-flag) case-fold-search) 1973 regexp-flag delimited-flag case-fold-search)
1921 ;; Bind message-log-max so we don't fill up the message log 1974 ;; Bind message-log-max so we don't fill up the message log
1922 ;; with a bunch of identical messages. 1975 ;; with a bunch of identical messages.
1923 (let ((message-log-max nil) 1976 (let ((message-log-max nil)
@@ -2099,15 +2152,11 @@ make, or the user didn't cancel the call."
2099 (if (= replace-count 1) "" "s"))) 2152 (if (= replace-count 1) "" "s")))
2100 (or (and keep-going stack) multi-buffer))) 2153 (or (and keep-going stack) multi-buffer)))
2101 2154
2102(defvar isearch-error)
2103(defvar isearch-forward)
2104(defvar isearch-case-fold-search)
2105(defvar isearch-string)
2106
2107(defvar replace-overlay nil) 2155(defvar replace-overlay nil)
2108 2156
2109(defun replace-highlight (match-beg match-end range-beg range-end 2157(defun replace-highlight (match-beg match-end range-beg range-end
2110 string regexp case-fold) 2158 search-string regexp-flag delimited-flag
2159 case-fold-search)
2111 (if query-replace-highlight 2160 (if query-replace-highlight
2112 (if replace-overlay 2161 (if replace-overlay
2113 (move-overlay replace-overlay match-beg match-end (current-buffer)) 2162 (move-overlay replace-overlay match-beg match-end (current-buffer))
@@ -2115,13 +2164,14 @@ make, or the user didn't cancel the call."
2115 (overlay-put replace-overlay 'priority 1001) ;higher than lazy overlays 2164 (overlay-put replace-overlay 'priority 1001) ;higher than lazy overlays
2116 (overlay-put replace-overlay 'face 'query-replace))) 2165 (overlay-put replace-overlay 'face 'query-replace)))
2117 (if query-replace-lazy-highlight 2166 (if query-replace-lazy-highlight
2118 (let ((isearch-string string) 2167 (let ((isearch-string search-string)
2119 (isearch-regexp regexp) 2168 (isearch-regexp regexp-flag)
2120 ;; Set isearch-word to nil because word-replace is regexp-based, 2169 (isearch-word delimited-flag)
2121 ;; so `isearch-search-fun' should not use `word-search-forward'. 2170 (isearch-lax-whitespace
2122 (isearch-word nil) 2171 replace-lax-whitespace)
2123 (search-whitespace-regexp nil) 2172 (isearch-regexp-lax-whitespace
2124 (isearch-case-fold-search case-fold) 2173 replace-regexp-lax-whitespace)
2174 (isearch-case-fold-search case-fold-search)
2125 (isearch-forward t) 2175 (isearch-forward t)
2126 (isearch-error nil)) 2176 (isearch-error nil))
2127 (isearch-lazy-highlight-new-loop range-beg range-end)))) 2177 (isearch-lazy-highlight-new-loop range-beg range-end))))
diff --git a/lisp/saveplace.el b/lisp/saveplace.el
index 43dad63a140..0c082169462 100644
--- a/lisp/saveplace.el
+++ b/lisp/saveplace.el
@@ -56,13 +56,12 @@ This means when you visit a file, point goes to the last place
56where it was when you previously visited the same file. 56where it was when you previously visited the same file.
57This variable is automatically buffer-local. 57This variable is automatically buffer-local.
58 58
59If you wish your place in any file to always be automatically saved, 59If you wish your place in any file to always be automatically
60simply put this in your `~/.emacs' file: 60saved, set this to t using the Customize facility, or put the
61following code in your init file:
61 62
62\(setq-default save-place t) 63\(setq-default save-place t)
63\(require 'saveplace) 64\(require 'saveplace)"
64
65or else use the Custom facility to set this option."
66 :type 'boolean 65 :type 'boolean
67 :require 'saveplace 66 :require 'saveplace
68 :group 'save-place) 67 :group 'save-place)
@@ -148,7 +147,8 @@ even in a later Emacs session.
148If called with a prefix arg, the mode is enabled if and only if 147If called with a prefix arg, the mode is enabled if and only if
149the argument is positive. 148the argument is positive.
150 149
151To save places automatically in all files, put this in your `.emacs' file: 150To save places automatically in all files, put this in your init
151file:
152 152
153\(setq-default save-place t\)" 153\(setq-default save-place t\)"
154 (interactive "P") 154 (interactive "P")
diff --git a/lisp/ses.el b/lisp/ses.el
index 8add16a6996..7cdac74e310 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -1270,11 +1270,9 @@ when the width of cell (ROW,COL) has changed."
1270;; The data area 1270;; The data area
1271;;---------------------------------------------------------------------------- 1271;;----------------------------------------------------------------------------
1272 1272
1273(defun ses-narrowed-p () (/= (- (point-max) (point-min)) (buffer-size)))
1274
1275(defun ses-widen () 1273(defun ses-widen ()
1276 "Turn off narrowing, to be reenabled at end of command loop." 1274 "Turn off narrowing, to be reenabled at end of command loop."
1277 (if (ses-narrowed-p) 1275 (if (buffer-narrowed-p)
1278 (setq ses--deferred-narrow t)) 1276 (setq ses--deferred-narrow t))
1279 (widen)) 1277 (widen))
1280 1278
diff --git a/lisp/shell.el b/lisp/shell.el
index b98efceefbf..77a42389785 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -46,7 +46,7 @@
46 46
47;; YOUR .EMACS FILE 47;; YOUR .EMACS FILE
48;;============================================================================= 48;;=============================================================================
49;; Some suggestions for your .emacs file. 49;; Some suggestions for your init file.
50;; 50;;
51;; ;; Define M-# to run some strange command: 51;; ;; Define M-# to run some strange command:
52;; (eval-after-load "shell" 52;; (eval-after-load "shell"
@@ -136,9 +136,7 @@ how Shell mode treats paragraphs.
136 136
137The pattern should probably not match more than one line. If it does, 137The pattern should probably not match more than one line. If it does,
138Shell mode may become confused trying to distinguish prompt from input 138Shell mode may become confused trying to distinguish prompt from input
139on lines which don't start with a prompt. 139on lines which don't start with a prompt."
140
141This is a fine thing to set in your `.emacs' file."
142 :type 'regexp 140 :type 'regexp
143 :group 'shell) 141 :group 'shell)
144 142
@@ -146,9 +144,7 @@ This is a fine thing to set in your `.emacs' file."
146 "List of suffixes to be disregarded during file/command completion. 144 "List of suffixes to be disregarded during file/command completion.
147This variable is used to initialize `comint-completion-fignore' in the shell 145This variable is used to initialize `comint-completion-fignore' in the shell
148buffer. The default is nil, for compatibility with most shells. 146buffer. The default is nil, for compatibility with most shells.
149Some people like (\"~\" \"#\" \"%\"). 147Some people like (\"~\" \"#\" \"%\")."
150
151This is a fine thing to set in your `.emacs' file."
152 :type '(repeat (string :tag "Suffix")) 148 :type '(repeat (string :tag "Suffix"))
153 :group 'shell) 149 :group 'shell)
154 150
@@ -158,31 +154,29 @@ This variable is used to initialize `comint-delimiter-argument-list' in the
158shell buffer. The value may depend on the operating system or shell." 154shell buffer. The value may depend on the operating system or shell."
159 :type '(choice (const nil) 155 :type '(choice (const nil)
160 (repeat :tag "List of characters" character)) 156 (repeat :tag "List of characters" character))
161 ;; Reverted.
162;; :version "24.1" ; changed to nil (bug#8027)
163 :group 'shell) 157 :group 'shell)
164 158
165(defvar shell-file-name-chars 159(defcustom shell-file-name-chars
166 (if (memq system-type '(ms-dos windows-nt cygwin)) 160 (if (memq system-type '(ms-dos windows-nt cygwin))
167 "~/A-Za-z0-9_^$!#%&{}@`'.,:()-" 161 "~/A-Za-z0-9_^$!#%&{}@`'.,:()-"
168 "[]~/A-Za-z0-9+@:_.$#%,={}-") 162 "[]~/A-Za-z0-9+@:_.$#%,={}-")
169 "String of characters valid in a file name. 163 "String of characters valid in a file name.
170This variable is used to initialize `comint-file-name-chars' in the 164This variable is used to initialize `comint-file-name-chars' in the
171shell buffer. The value may depend on the operating system or shell. 165shell buffer. The value may depend on the operating system or shell."
172 166 :type 'string
173This is a fine thing to set in your `.emacs' file.") 167 :group 'shell)
174 168
175(defvar shell-file-name-quote-list 169(defcustom shell-file-name-quote-list
176 (if (memq system-type '(ms-dos windows-nt)) 170 (if (memq system-type '(ms-dos windows-nt))
177 nil 171 nil
178 (append shell-delimiter-argument-list '(?\s ?$ ?\* ?\! ?\" ?\' ?\` ?\# ?\\))) 172 (append shell-delimiter-argument-list '(?\s ?$ ?\* ?\! ?\" ?\' ?\` ?\# ?\\)))
179 "List of characters to quote when in a file name. 173 "List of characters to quote when in a file name.
180This variable is used to initialize `comint-file-name-quote-list' in the 174This variable is used to initialize `comint-file-name-quote-list' in the
181shell buffer. The value may depend on the operating system or shell. 175shell buffer. The value may depend on the operating system or shell."
182 176 :type '(repeat character)
183This is a fine thing to set in your `.emacs' file.") 177 :group 'shell)
184 178
185(defvar shell-dynamic-complete-functions 179(defcustom shell-dynamic-complete-functions
186 '(comint-c-a-p-replace-by-expanded-history 180 '(comint-c-a-p-replace-by-expanded-history
187 shell-environment-variable-completion 181 shell-environment-variable-completion
188 shell-command-completion 182 shell-command-completion
@@ -192,9 +186,9 @@ This is a fine thing to set in your `.emacs' file.")
192 comint-filename-completion) 186 comint-filename-completion)
193 "List of functions called to perform completion. 187 "List of functions called to perform completion.
194This variable is used to initialize `comint-dynamic-complete-functions' in the 188This variable is used to initialize `comint-dynamic-complete-functions' in the
195shell buffer. 189shell buffer."
196 190 :type '(repeat function)
197This is a fine thing to set in your `.emacs' file.") 191 :group 'shell)
198 192
199(defcustom shell-command-regexp "[^;&|\n]+" 193(defcustom shell-command-regexp "[^;&|\n]+"
200 "Regexp to match a single command within a pipeline. 194 "Regexp to match a single command within a pipeline.
diff --git a/lisp/simple.el b/lisp/simple.el
index b81e0d7ee88..6e37700b912 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -974,7 +974,9 @@ rather than the region.
974 974
975If called from Lisp, return the number of words between positions 975If called from Lisp, return the number of words between positions
976START and END." 976START and END."
977 (interactive "r\nP") 977 (interactive (if current-prefix-arg
978 (list nil nil current-prefix-arg)
979 (list (region-beginning) (region-end) nil)))
978 (cond ((not (called-interactively-p 'any)) 980 (cond ((not (called-interactively-p 'any))
979 (count-words start end)) 981 (count-words start end))
980 (arg 982 (arg
@@ -1008,9 +1010,7 @@ END, without printing any message."
1008 1010
1009(defun count-words--buffer-message () 1011(defun count-words--buffer-message ()
1010 (count-words--message 1012 (count-words--message
1011 (if (= (point-max) (1+ (buffer-size))) 1013 (if (buffer-narrowed-p) "Narrowed part of buffer" "Buffer")
1012 "Buffer"
1013 "Narrowed part of buffer")
1014 (point-min) (point-max))) 1014 (point-min) (point-max)))
1015 1015
1016(defun count-words--message (str start end) 1016(defun count-words--message (str start end)
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index 16993ce1891..25a6fbfd998 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -706,7 +706,7 @@ will be stripped by a simplified optimizer when compiled into a
706singular expression. This variable will be turned into 706singular expression. This variable will be turned into
707`speedbar-file-regexp' for use with speedbar. You should use the 707`speedbar-file-regexp' for use with speedbar. You should use the
708function `speedbar-add-supported-extension' to add a new extension at 708function `speedbar-add-supported-extension' to add a new extension at
709runtime, or use the configuration dialog to set it in your .emacs file. 709runtime, or use the configuration dialog to set it in your init file.
710If you add an extension to this list, and it does not appear, you may 710If you add an extension to this list, and it does not appear, you may
711need to also modify `completion-ignored-extension' which will also help 711need to also modify `completion-ignored-extension' which will also help
712file completion." 712file completion."
@@ -763,7 +763,7 @@ DIRECTORY-EXPRESSION to `speedbar-ignored-directory-expressions'."
763 "Non-nil means to automatically update the display. 763 "Non-nil means to automatically update the display.
764When this is nil then speedbar will not follow the attached frame's directory. 764When this is nil then speedbar will not follow the attached frame's directory.
765If you want to change this while speedbar is active, either use 765If you want to change this while speedbar is active, either use
766\\[customize] or call \\<speedbar-key-map> `\\[speedbar-toggle-updates]'." 766\\[customize] or call \\<speedbar-mode-map> `\\[speedbar-toggle-updates]'."
767 :group 'speedbar 767 :group 'speedbar
768 :initialize 'custom-initialize-default 768 :initialize 'custom-initialize-default
769 :set (lambda (sym val) 769 :set (lambda (sym val)
@@ -1083,7 +1083,7 @@ Return nil if it doesn't exist."
1083 1083
1084(define-derived-mode speedbar-mode fundamental-mode "Speedbar" 1084(define-derived-mode speedbar-mode fundamental-mode "Speedbar"
1085 "Major mode for managing a display of directories and tags. 1085 "Major mode for managing a display of directories and tags.
1086\\<speedbar-key-map> 1086\\<speedbar-mode-map>
1087The first line represents the default directory of the speedbar frame. 1087The first line represents the default directory of the speedbar frame.
1088Each directory segment is a button which jumps speedbar's default 1088Each directory segment is a button which jumps speedbar's default
1089directory to that directory. Buttons are activated by clicking `\\[speedbar-click]'. 1089directory to that directory. Buttons are activated by clicking `\\[speedbar-click]'.
@@ -1120,7 +1120,7 @@ category of tags. Click the {+} to expand the category. Jump-able
1120tags start with >. Click the name of the tag to go to that position 1120tags start with >. Click the name of the tag to go to that position
1121in the selected file. 1121in the selected file.
1122 1122
1123\\{speedbar-key-map}" 1123\\{speedbar-mode-map}"
1124 (save-excursion 1124 (save-excursion
1125 (setq font-lock-keywords nil) ;; no font-locking please 1125 (setq font-lock-keywords nil) ;; no font-locking please
1126 (setq truncate-lines t) 1126 (setq truncate-lines t)
diff --git a/lisp/startup.el b/lisp/startup.el
index dd216638905..a0122c74555 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -71,12 +71,13 @@ once you are familiar with the contents of the startup screen."
71 "Non-nil inhibits the initial startup echo area message. 71 "Non-nil inhibits the initial startup echo area message.
72Setting this variable takes effect 72Setting this variable takes effect
73only if you do it with the customization buffer 73only if you do it with the customization buffer
74or if your `.emacs' file contains a line of this form: 74or if your init file contains a line of this form:
75 (setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\") 75 (setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\")
76If your `.emacs' file is byte-compiled, use the following form instead: 76If your init file is byte-compiled, use the following form
77instead:
77 (eval '(setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\")) 78 (eval '(setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\"))
78Thus, someone else using a copy of your `.emacs' file will see 79Thus, someone else using a copy of your init file will see the
79the startup message unless he personally acts to inhibit it." 80startup message unless he personally acts to inhibit it."
80 :type '(choice (const :tag "Don't inhibit") 81 :type '(choice (const :tag "Don't inhibit")
81 (string :tag "Enter your user name, to inhibit")) 82 (string :tag "Enter your user name, to inhibit"))
82 :group 'initialization) 83 :group 'initialization)
@@ -261,10 +262,14 @@ and VALUE is the value which is given to that frame parameter
261 "Normal hook run after handling urgent options but before loading init files.") 262 "Normal hook run after handling urgent options but before loading init files.")
262 263
263(defvar after-init-hook nil 264(defvar after-init-hook nil
264 "Normal hook run after loading the init files, `~/.emacs' and `default.el'. 265 "Normal hook run after initializing the Emacs session.
265There is no `condition-case' around the running of these functions; 266It is run after Emacs loads the init file, `default' library, the
266therefore, if you set `debug-on-error' non-nil in `.emacs', 267abbrevs file, and additional Lisp packages (if any), and setting
267an error in one of these functions will invoke the debugger.") 268the value of `after-init-time'.
269
270There is no `condition-case' around the running of this hook;
271therefore, if `debug-on-error' is non-nil, an error in one of
272these functions will invoke the debugger.")
268 273
269(defvar emacs-startup-hook nil 274(defvar emacs-startup-hook nil
270 "Normal hook run after loading init files and handling the command line.") 275 "Normal hook run after loading init files and handling the command line.")
@@ -296,7 +301,7 @@ the user's init file.")
296 :group 'initialization) 301 :group 'initialization)
297 302
298(defvar init-file-user nil 303(defvar init-file-user nil
299 "Identity of user whose `.emacs' file is or was read. 304 "Identity of user whose init file is or was read.
300The value is nil if `-q' or `--no-init-file' was specified, 305The value is nil if `-q' or `--no-init-file' was specified,
301meaning do not load any init file. 306meaning do not load any init file.
302 307
@@ -306,7 +311,7 @@ or it may be a string containing a user's name meaning
306use that person's init file. 311use that person's init file.
307 312
308In either of the latter cases, `(concat \"~\" init-file-user \"/\")' 313In either of the latter cases, `(concat \"~\" init-file-user \"/\")'
309evaluates to the name of the directory where the `.emacs' file was 314evaluates to the name of the directory where the init file was
310looked for. 315looked for.
311 316
312Setting `init-file-user' does not prevent Emacs from loading 317Setting `init-file-user' does not prevent Emacs from loading
@@ -365,7 +370,7 @@ init file is read, in case it sets `mail-host-address'."
365 (t 370 (t
366 (concat user-emacs-directory "auto-save-list/.saves-"))) 371 (concat user-emacs-directory "auto-save-list/.saves-")))
367 "Prefix for generating `auto-save-list-file-name'. 372 "Prefix for generating `auto-save-list-file-name'.
368This is used after reading your `.emacs' file to initialize 373This is used after reading your init file to initialize
369`auto-save-list-file-name', by appending Emacs's pid and the system name, 374`auto-save-list-file-name', by appending Emacs's pid and the system name,
370if you have not already set `auto-save-list-file-name' yourself. 375if you have not already set `auto-save-list-file-name' yourself.
371Directories in the prefix will be created if necessary. 376Directories in the prefix will be created if necessary.
diff --git a/lisp/strokes.el b/lisp/strokes.el
index dfd0e95f61a..62a8528f25d 100644
--- a/lisp/strokes.el
+++ b/lisp/strokes.el
@@ -933,14 +933,7 @@ and then safely save them for later use, send letters to friends
933extracting the strokes for editing use once again, so the editing 933extracting the strokes for editing use once again, so the editing
934cycle can continue. 934cycle can continue.
935 935
936Strokes are easy to program and fun to use. To start strokes going, 936To toggle strokes-mode, invoke the command
937you'll want to put the following line in your .emacs file as mentioned
938in the commentary to strokes.el.
939
940This will load strokes when and only when you start Emacs on a window
941system, with a mouse or other pointer device defined.
942
943To toggle strokes-mode, you just do
944 937
945> M-x strokes-mode 938> M-x strokes-mode
946 939
diff --git a/lisp/subr.el b/lisp/subr.el
index 74afd59f8d5..e9b85ff1f38 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -80,6 +80,7 @@ For more information, see Info node `(elisp)Declaring Functions'."
80(defmacro noreturn (form) 80(defmacro noreturn (form)
81 "Evaluate FORM, expecting it not to return. 81 "Evaluate FORM, expecting it not to return.
82If FORM does return, signal an error." 82If FORM does return, signal an error."
83 (declare (debug t))
83 `(prog1 ,form 84 `(prog1 ,form
84 (error "Form marked with `noreturn' did return"))) 85 (error "Form marked with `noreturn' did return")))
85 86
@@ -87,6 +88,7 @@ If FORM does return, signal an error."
87 "Evaluate FORM, expecting a constant return value. 88 "Evaluate FORM, expecting a constant return value.
88This is the global do-nothing version. There is also `testcover-1value' 89This is the global do-nothing version. There is also `testcover-1value'
89that complains if FORM ever does return differing values." 90that complains if FORM ever does return differing values."
91 (declare (debug t))
90 form) 92 form)
91 93
92(defmacro def-edebug-spec (symbol spec) 94(defmacro def-edebug-spec (symbol spec)
@@ -1250,11 +1252,6 @@ is converted into a string by expressing it in decimal."
1250 'mode-line-inverse-video 1252 'mode-line-inverse-video
1251 "use the appropriate faces instead." 1253 "use the appropriate faces instead."
1252 "21.1") 1254 "21.1")
1253(make-obsolete-variable
1254 'unread-command-char
1255 "use `unread-command-events' instead. That variable is a list of events
1256to reread, so it now uses nil to mean `no event', instead of -1."
1257 "before 19.15")
1258 1255
1259;; Lisp manual only updated in 22.1. 1256;; Lisp manual only updated in 22.1.
1260(define-obsolete-variable-alias 'executing-macro 'executing-kbd-macro 1257(define-obsolete-variable-alias 'executing-macro 'executing-kbd-macro
@@ -1548,7 +1545,7 @@ if it is empty or a duplicate."
1548 (or keep-all 1545 (or keep-all
1549 (not (equal (car history) newelt)))) 1546 (not (equal (car history) newelt))))
1550 (if history-delete-duplicates 1547 (if history-delete-duplicates
1551 (delete newelt history)) 1548 (setq history (delete newelt history)))
1552 (setq history (cons newelt history)) 1549 (setq history (cons newelt history))
1553 (when (integerp maxelt) 1550 (when (integerp maxelt)
1554 (if (= 0 maxelt) 1551 (if (= 0 maxelt)
@@ -2237,7 +2234,8 @@ keyboard-quit events while waiting for a valid input."
2237 (error "Called `read-char-choice' without valid char choices")) 2234 (error "Called `read-char-choice' without valid char choices"))
2238 (let (char done show-help (helpbuf " *Char Help*")) 2235 (let (char done show-help (helpbuf " *Char Help*"))
2239 (let ((cursor-in-echo-area t) 2236 (let ((cursor-in-echo-area t)
2240 (executing-kbd-macro executing-kbd-macro)) 2237 (executing-kbd-macro executing-kbd-macro)
2238 (esc-flag nil))
2241 (save-window-excursion ; in case we call help-form-show 2239 (save-window-excursion ; in case we call help-form-show
2242 (while (not done) 2240 (while (not done)
2243 (unless (get-text-property 0 'face prompt) 2241 (unless (get-text-property 0 'face prompt)
@@ -2261,8 +2259,12 @@ keyboard-quit events while waiting for a valid input."
2261 ;; there are no more events in the macro. Attempt to 2259 ;; there are no more events in the macro. Attempt to
2262 ;; get an event interactively. 2260 ;; get an event interactively.
2263 (setq executing-kbd-macro nil)) 2261 (setq executing-kbd-macro nil))
2264 ((and (not inhibit-keyboard-quit) (eq char ?\C-g)) 2262 ((not inhibit-keyboard-quit)
2265 (keyboard-quit)))))) 2263 (cond
2264 ((and (null esc-flag) (eq char ?\e))
2265 (setq esc-flag t))
2266 ((memq char '(?\C-g ?\e))
2267 (keyboard-quit))))))))
2266 ;; Display the question with the answer. But without cursor-in-echo-area. 2268 ;; Display the question with the answer. But without cursor-in-echo-area.
2267 (message "%s%s" prompt (char-to-string char)) 2269 (message "%s%s" prompt (char-to-string char))
2268 char)) 2270 char))
@@ -2314,11 +2316,19 @@ floating point support."
2314PROMPT is the string to display to ask the question. It should 2316PROMPT is the string to display to ask the question. It should
2315end in a space; `y-or-n-p' adds \"(y or n) \" to it. 2317end in a space; `y-or-n-p' adds \"(y or n) \" to it.
2316 2318
2317No confirmation of the answer is requested; a single character is enough. 2319No confirmation of the answer is requested; a single character is
2318Also accepts Space to mean yes, or Delete to mean no. \(Actually, it uses 2320enough. SPC also means yes, and DEL means no.
2319the bindings in `query-replace-map'; see the documentation of that variable 2321
2320for more information. In this case, the useful bindings are `act', `skip', 2322To be precise, this function translates user input into responses
2321`recenter', and `quit'.\) 2323by consulting the bindings in `query-replace-map'; see the
2324documentation of that variable for more information. In this
2325case, the useful bindings are `act', `skip', `recenter',
2326`scroll-up', `scroll-down', and `quit'.
2327An `act' response means yes, and a `skip' response means no.
2328A `quit' response means to invoke `keyboard-quit'.
2329If the user enters `recenter', `scroll-up', or `scroll-down'
2330responses, perform the requested window recentering or scrolling
2331and ask again.
2322 2332
2323Under a windowing system a dialog box will be used if `last-nonmenu-event' 2333Under a windowing system a dialog box will be used if `last-nonmenu-event'
2324is nil and `use-dialog-box' is non-nil." 2334is nil and `use-dialog-box' is non-nil."
@@ -2350,21 +2360,33 @@ is nil and `use-dialog-box' is non-nil."
2350 "" " ") 2360 "" " ")
2351 "(y or n) ")) 2361 "(y or n) "))
2352 (while 2362 (while
2353 (let* ((key 2363 (let* ((scroll-actions '(recenter scroll-up scroll-down
2364 scroll-other-window scroll-other-window-down))
2365 (key
2354 (let ((cursor-in-echo-area t)) 2366 (let ((cursor-in-echo-area t))
2355 (when minibuffer-auto-raise 2367 (when minibuffer-auto-raise
2356 (raise-frame (window-frame (minibuffer-window)))) 2368 (raise-frame (window-frame (minibuffer-window))))
2357 (read-key (propertize (if (eq answer 'recenter) 2369 (read-key (propertize (if (memq answer scroll-actions)
2358 prompt 2370 prompt
2359 (concat "Please answer y or n. " 2371 (concat "Please answer y or n. "
2360 prompt)) 2372 prompt))
2361 'face 'minibuffer-prompt))))) 2373 'face 'minibuffer-prompt)))))
2362 (setq answer (lookup-key query-replace-map (vector key) t)) 2374 (setq answer (lookup-key query-replace-map (vector key) t))
2363 (cond 2375 (cond
2364 ((memq answer '(skip act)) nil) 2376 ((memq answer '(skip act)) nil)
2365 ((eq answer 'recenter) (recenter) t) 2377 ((eq answer 'recenter)
2366 ((memq answer '(exit-prefix quit)) (signal 'quit nil) t) 2378 (recenter) t)
2367 (t t))) 2379 ((eq answer 'scroll-up)
2380 (ignore-errors (scroll-up-command)) t)
2381 ((eq answer 'scroll-down)
2382 (ignore-errors (scroll-down-command)) t)
2383 ((eq answer 'scroll-other-window)
2384 (ignore-errors (scroll-other-window)) t)
2385 ((eq answer 'scroll-other-window-down)
2386 (ignore-errors (scroll-other-window-down)) t)
2387 ((or (memq answer '(exit-prefix quit)) (eq key ?\e))
2388 (signal 'quit nil) t)
2389 (t t)))
2368 (ding) 2390 (ding)
2369 (discard-input)))) 2391 (discard-input))))
2370 (let ((ret (eq answer 'act))) 2392 (let ((ret (eq answer 'act)))
@@ -2647,6 +2669,10 @@ directory if it does not exist."
2647 2669
2648;;;; Misc. useful functions. 2670;;;; Misc. useful functions.
2649 2671
2672(defsubst buffer-narrowed-p ()
2673 "Return non-nil if the current buffer is narrowed."
2674 (/= (- (point-max) (point-min)) (buffer-size)))
2675
2650(defun find-tag-default () 2676(defun find-tag-default ()
2651 "Determine default tag to search for, based on text at point. 2677 "Determine default tag to search for, based on text at point.
2652If there is no plausible default, return nil." 2678If there is no plausible default, return nil."
@@ -3728,7 +3754,7 @@ from `standard-syntax-table' otherwise."
3728 table)) 3754 table))
3729 3755
3730(defun syntax-after (pos) 3756(defun syntax-after (pos)
3731 "Return the raw syntax of the char after POS. 3757 "Return the raw syntax descriptor for the char after POS.
3732If POS is outside the buffer's accessible portion, return nil." 3758If POS is outside the buffer's accessible portion, return nil."
3733 (unless (or (< pos (point-min)) (>= pos (point-max))) 3759 (unless (or (< pos (point-min)) (>= pos (point-max)))
3734 (let ((st (if parse-sexp-lookup-properties 3760 (let ((st (if parse-sexp-lookup-properties
@@ -3737,7 +3763,12 @@ If POS is outside the buffer's accessible portion, return nil."
3737 (aref (or st (syntax-table)) (char-after pos)))))) 3763 (aref (or st (syntax-table)) (char-after pos))))))
3738 3764
3739(defun syntax-class (syntax) 3765(defun syntax-class (syntax)
3740 "Return the syntax class part of the syntax descriptor SYNTAX. 3766 "Return the code for the syntax class described by SYNTAX.
3767
3768SYNTAX should be a raw syntax descriptor; the return value is a
3769integer which encodes the corresponding syntax class. See Info
3770node `(elisp)Syntax Table Internals' for a list of codes.
3771
3741If SYNTAX is nil, return nil." 3772If SYNTAX is nil, return nil."
3742 (and syntax (logand (car syntax) 65535))) 3773 (and syntax (logand (car syntax) 65535)))
3743 3774
@@ -3877,6 +3908,11 @@ The properties used on SYMBOL are `composefunc', `sendfunc',
3877 (put symbol 'hookvar (or hookvar 'mail-send-hook))) 3908 (put symbol 'hookvar (or hookvar 'mail-send-hook)))
3878 3909
3879(defun set-temporary-overlay-map (map &optional keep-pred) 3910(defun set-temporary-overlay-map (map &optional keep-pred)
3911 "Set MAP as a temporary overlay map.
3912When KEEP-PRED is `t', using a key from the temporary keymap
3913leaves this keymap activated. KEEP-PRED can also be a function,
3914which will have the same effect when it returns `t'.
3915When KEEP-PRED is nil, the temporary keymap is used only once."
3880 (let* ((clearfunsym (make-symbol "clear-temporary-overlay-map")) 3916 (let* ((clearfunsym (make-symbol "clear-temporary-overlay-map"))
3881 (overlaysym (make-symbol "t")) 3917 (overlaysym (make-symbol "t"))
3882 (alist (list (cons overlaysym map))) 3918 (alist (list (cons overlaysym map)))
@@ -3889,6 +3925,7 @@ The properties used on SYMBOL are `composefunc', `sendfunc',
3889 (lookup-key ',map 3925 (lookup-key ',map
3890 (this-command-keys-vector)))) 3926 (this-command-keys-vector))))
3891 (t `(funcall ',keep-pred))) 3927 (t `(funcall ',keep-pred)))
3928 (set ',overlaysym nil) ;Just in case.
3892 (remove-hook 'pre-command-hook ',clearfunsym) 3929 (remove-hook 'pre-command-hook ',clearfunsym)
3893 (setq emulation-mode-map-alists 3930 (setq emulation-mode-map-alists
3894 (delq ',alist emulation-mode-map-alists)))))) 3931 (delq ',alist emulation-mode-map-alists))))))
diff --git a/lisp/term/iris-ansi.el b/lisp/term/iris-ansi.el
index 9a9a31f4253..aea2e8c1092 100644
--- a/lisp/term/iris-ansi.el
+++ b/lisp/term/iris-ansi.el
@@ -322,7 +322,7 @@
322 "Terminal initialization function for iris-ansi." 322 "Terminal initialization function for iris-ansi."
323 ;; Use inheritance to let the main keymap override these defaults. 323 ;; Use inheritance to let the main keymap override these defaults.
324 ;; This way we don't override terminfo-derived settings or settings 324 ;; This way we don't override terminfo-derived settings or settings
325 ;; made in the .emacs file. 325 ;; made in the init file.
326 (let ((m (copy-keymap iris-function-map))) 326 (let ((m (copy-keymap iris-function-map)))
327 (set-keymap-parent m (keymap-parent input-decode-map)) 327 (set-keymap-parent m (keymap-parent input-decode-map))
328 (set-keymap-parent input-decode-map m))) 328 (set-keymap-parent input-decode-map m)))
diff --git a/lisp/term/lk201.el b/lisp/term/lk201.el
index 76a3a31cedc..6b9e1301003 100644
--- a/lisp/term/lk201.el
+++ b/lisp/term/lk201.el
@@ -75,7 +75,7 @@
75(defun terminal-init-lk201 () 75(defun terminal-init-lk201 ()
76 ;; Use inheritance to let the main keymap override these defaults. 76 ;; Use inheritance to let the main keymap override these defaults.
77 ;; This way we don't override terminfo-derived settings or settings 77 ;; This way we don't override terminfo-derived settings or settings
78 ;; made in the .emacs file. 78 ;; made in the init file.
79 (let ((m (copy-keymap lk201-function-map))) 79 (let ((m (copy-keymap lk201-function-map)))
80 (set-keymap-parent m (keymap-parent input-decode-map)) 80 (set-keymap-parent m (keymap-parent input-decode-map))
81 (set-keymap-parent input-decode-map m))) 81 (set-keymap-parent input-decode-map m)))
diff --git a/lisp/term/rxvt.el b/lisp/term/rxvt.el
index 481d6b498cf..98141563006 100644
--- a/lisp/term/rxvt.el
+++ b/lisp/term/rxvt.el
@@ -166,7 +166,7 @@
166 166
167 ;; Use inheritance to let the main keymap override those defaults. 167 ;; Use inheritance to let the main keymap override those defaults.
168 ;; This way we don't override terminfo-derived settings or settings 168 ;; This way we don't override terminfo-derived settings or settings
169 ;; made in the .emacs file. 169 ;; made in the init file.
170 (let ((m (copy-keymap rxvt-function-map))) 170 (let ((m (copy-keymap rxvt-function-map)))
171 (set-keymap-parent m (keymap-parent input-decode-map)) 171 (set-keymap-parent m (keymap-parent input-decode-map))
172 (set-keymap-parent input-decode-map m)) 172 (set-keymap-parent input-decode-map m))
diff --git a/lisp/term/tvi970.el b/lisp/term/tvi970.el
index b02d39c1e0f..f1b6eea8875 100644
--- a/lisp/term/tvi970.el
+++ b/lisp/term/tvi970.el
@@ -93,7 +93,7 @@
93 "Terminal initialization function for tvi970." 93 "Terminal initialization function for tvi970."
94 ;; Use inheritance to let the main keymap override these defaults. 94 ;; Use inheritance to let the main keymap override these defaults.
95 ;; This way we don't override terminfo-derived settings or settings 95 ;; This way we don't override terminfo-derived settings or settings
96 ;; made in the .emacs file. 96 ;; made in the init file.
97 (let ((m (copy-keymap tvi970-terminal-map))) 97 (let ((m (copy-keymap tvi970-terminal-map)))
98 (set-keymap-parent m (keymap-parent input-decode-map)) 98 (set-keymap-parent m (keymap-parent input-decode-map))
99 (set-keymap-parent input-decode-map m)) 99 (set-keymap-parent input-decode-map m))
diff --git a/lisp/term/wyse50.el b/lisp/term/wyse50.el
index d037962af19..ce148b62dba 100644
--- a/lisp/term/wyse50.el
+++ b/lisp/term/wyse50.el
@@ -109,7 +109,7 @@
109 "Terminal initialization function for wyse50." 109 "Terminal initialization function for wyse50."
110 ;; Use inheritance to let the main keymap override these defaults. 110 ;; Use inheritance to let the main keymap override these defaults.
111 ;; This way we don't override terminfo-derived settings or settings 111 ;; This way we don't override terminfo-derived settings or settings
112 ;; made in the .emacs file. 112 ;; made in the init file.
113 (let ((m (copy-keymap wyse50-terminal-map))) 113 (let ((m (copy-keymap wyse50-terminal-map)))
114 (set-keymap-parent m (keymap-parent input-decode-map)) 114 (set-keymap-parent m (keymap-parent input-decode-map))
115 (set-keymap-parent input-decode-map m)) 115 (set-keymap-parent input-decode-map m))
diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el
index 28fb9da0b9d..e4871658b98 100644
--- a/lisp/term/xterm.el
+++ b/lisp/term/xterm.el
@@ -480,7 +480,7 @@ The relevant features are:
480 480
481 ;; Use inheritance to let the main keymap override those defaults. 481 ;; Use inheritance to let the main keymap override those defaults.
482 ;; This way we don't override terminfo-derived settings or settings 482 ;; This way we don't override terminfo-derived settings or settings
483 ;; made in the .emacs file. 483 ;; made in the init file.
484 (set-keymap-parent map (keymap-parent input-decode-map)) 484 (set-keymap-parent map (keymap-parent input-decode-map))
485 (set-keymap-parent input-decode-map map))) 485 (set-keymap-parent input-decode-map map)))
486 486
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index a9320d945ef..42f0418b690 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -290,9 +290,9 @@ If this variable is nil, all regions are treated as small."
290;;* Mode specific options enable users to disable flyspell on */ 290;;* Mode specific options enable users to disable flyspell on */
291;;* certain word depending of the emacs mode. For instance, when */ 291;;* certain word depending of the emacs mode. For instance, when */
292;;* using flyspell with mail-mode add the following expression */ 292;;* using flyspell with mail-mode add the following expression */
293;;* in your .emacs file: */ 293;;* in your init file: */
294;;* (add-hook 'mail-mode */ 294;;* (add-hook 'mail-mode */
295;;* (lambda () (setq flyspell-generic-check-word-predicate */ 295;;* (lambda () (setq flyspell-generic-check-word-predicate */
296;;* 'mail-mode-flyspell-verify))) */ 296;;* 'mail-mode-flyspell-verify))) */
297;;*---------------------------------------------------------------------*/ 297;;*---------------------------------------------------------------------*/
298(defvar flyspell-generic-check-word-predicate nil 298(defvar flyspell-generic-check-word-predicate nil
@@ -488,7 +488,7 @@ invoking `ispell-change-dictionary'.
488Consider using the `ispell-parser' to check your text. For instance 488Consider using the `ispell-parser' to check your text. For instance
489consider adding: 489consider adding:
490\(add-hook 'tex-mode-hook (function (lambda () (setq ispell-parser 'tex)))) 490\(add-hook 'tex-mode-hook (function (lambda () (setq ispell-parser 'tex))))
491in your .emacs file. 491in your init file.
492 492
493\\[flyspell-region] checks all words inside a region. 493\\[flyspell-region] checks all words inside a region.
494\\[flyspell-buffer] checks the whole buffer." 494\\[flyspell-buffer] checks the whole buffer."
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 0c7966f22d3..51a4800de52 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -1127,7 +1127,8 @@ aspell is used along with Emacs).")
1127 1127
1128 ;; If Emacs flavor supports [:alpha:] use it for global dicts. If 1128 ;; If Emacs flavor supports [:alpha:] use it for global dicts. If
1129 ;; spellchecker also supports UTF-8 via command-line option use it 1129 ;; spellchecker also supports UTF-8 via command-line option use it
1130 ;; in communication. This does not affect definitions in ~/.emacs. 1130 ;; in communication. This does not affect definitions in your
1131 ;; init file.
1131 (if ispell-emacs-alpha-regexp 1132 (if ispell-emacs-alpha-regexp
1132 (let (tmp-dicts-alist) 1133 (let (tmp-dicts-alist)
1133 (dolist (adict ispell-dictionary-alist) 1134 (dolist (adict ispell-dictionary-alist)
@@ -3680,7 +3681,7 @@ use the `x' command. (Any subsequent regions will be checked.)
3680The `X' command aborts sending the message so that you can edit the buffer. 3681The `X' command aborts sending the message so that you can edit the buffer.
3681 3682
3682To spell-check whenever a message is sent, include the appropriate lines 3683To spell-check whenever a message is sent, include the appropriate lines
3683in your .emacs file: 3684in your init file:
3684 (add-hook 'message-send-hook 'ispell-message) ;; GNUS 5 3685 (add-hook 'message-send-hook 'ispell-message) ;; GNUS 5
3685 (add-hook 'news-inews-hook 'ispell-message) ;; GNUS 4 3686 (add-hook 'news-inews-hook 'ispell-message) ;; GNUS 4
3686 (add-hook 'mail-send-hook 'ispell-message) 3687 (add-hook 'mail-send-hook 'ispell-message)
diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el
index 24a4ac1b033..e663c1b45f4 100644
--- a/lisp/textmodes/picture.el
+++ b/lisp/textmodes/picture.el
@@ -612,13 +612,15 @@ Leaves the region surrounding the rectangle."
612 (define-key map [remap self-insert-command] 'picture-self-insert) 612 (define-key map [remap self-insert-command] 'picture-self-insert)
613 (define-key map [remap self-insert-command] 'picture-self-insert) 613 (define-key map [remap self-insert-command] 'picture-self-insert)
614 (define-key map [remap completion-separator-self-insert-command] 614 (define-key map [remap completion-separator-self-insert-command]
615 'picture-self-insert) 615 'picture-self-insert)
616 (define-key map [remap completion-separator-self-insert-autofilling] 616 (define-key map [remap completion-separator-self-insert-autofilling]
617 'picture-self-insert) 617 'picture-self-insert)
618 (define-key map [remap forward-char] 'picture-forward-column) 618 (define-key map [remap forward-char] 'picture-forward-column)
619 (define-key map [remap right-char] 'picture-forward-column)
619 (define-key map [remap backward-char] 'picture-backward-column) 620 (define-key map [remap backward-char] 'picture-backward-column)
621 (define-key map [remap left-char] 'picture-backward-column)
620 (define-key map [remap delete-char] 'picture-clear-column) 622 (define-key map [remap delete-char] 'picture-clear-column)
621 ;; There are two possibilities for what is normally on DEL. 623 ;; There are two possibilities for what is normally on DEL.
622 (define-key map [remap backward-delete-char-untabify] 624 (define-key map [remap backward-delete-char-untabify]
623 'picture-backward-clear-column) 625 'picture-backward-clear-column)
624 (define-key map [remap delete-backward-char] 'picture-backward-clear-column) 626 (define-key map [remap delete-backward-char] 'picture-backward-clear-column)
diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el
index d8afb3e5544..8584c496a97 100644
--- a/lisp/textmodes/reftex.el
+++ b/lisp/textmodes/reftex.el
@@ -47,7 +47,7 @@
47;; To turn RefTeX Mode on and off in a buffer, use `M-x reftex-mode'. 47;; To turn RefTeX Mode on and off in a buffer, use `M-x reftex-mode'.
48;; 48;;
49;; To turn on RefTeX Mode for all LaTeX files, add the following lines 49;; To turn on RefTeX Mode for all LaTeX files, add the following lines
50;; to your .emacs file: 50;; to your init file:
51;; 51;;
52;; (add-hook 'LaTeX-mode-hook 'turn-on-reftex) ; AUCTeX LaTeX mode 52;; (add-hook 'LaTeX-mode-hook 'turn-on-reftex) ; AUCTeX LaTeX mode
53;; (add-hook 'latex-mode-hook 'turn-on-reftex) ; Emacs latex mode 53;; (add-hook 'latex-mode-hook 'turn-on-reftex) ; Emacs latex mode
@@ -99,7 +99,7 @@
99;; 99;;
100;; To turn RefTeX Mode on and off in a particular buffer, use `M-x 100;; To turn RefTeX Mode on and off in a particular buffer, use `M-x
101;; reftex-mode'. To turn on RefTeX Mode for all LaTeX files, add the 101;; reftex-mode'. To turn on RefTeX Mode for all LaTeX files, add the
102;; following lines to your `.emacs' file: 102;; following lines to your init file:
103;; 103;;
104;; (add-hook 'LaTeX-mode-hook 'turn-on-reftex) ; with AUCTeX LaTeX mode 104;; (add-hook 'LaTeX-mode-hook 'turn-on-reftex) ; with AUCTeX LaTeX mode
105;; (add-hook 'latex-mode-hook 'turn-on-reftex) ; with Emacs latex mode 105;; (add-hook 'latex-mode-hook 'turn-on-reftex) ; with Emacs latex mode
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el
index 767f8f360bb..e2647a98770 100644
--- a/lisp/textmodes/rst.el
+++ b/lisp/textmodes/rst.el
@@ -81,7 +81,7 @@
81 81
82;;; INSTALLATION 82;;; INSTALLATION
83 83
84;; Add the following lines to your `.emacs' file: 84;; Add the following lines to your init file:
85;; 85;;
86;; (require 'rst) 86;; (require 'rst)
87;; 87;;
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 5bcd87ede68..67d7f8c01f9 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -451,7 +451,7 @@ the next N words. In Transient Mark mode, when the mark is active,
451N defaults to -1, which means to wrap it around the current region. 451N defaults to -1, which means to wrap it around the current region.
452 452
453If you like upcased tags, put (setq sgml-transformation-function 'upcase) 453If you like upcased tags, put (setq sgml-transformation-function 'upcase)
454in your `.emacs' file. 454in your init file.
455 455
456Use \\[sgml-validate] to validate your document with an SGML parser. 456Use \\[sgml-validate] to validate your document with an SGML parser.
457 457
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index 2664a89855f..459e884d45d 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -126,7 +126,7 @@
126;; again. 126;; again.
127;; 127;;
128;; To use the package regularly place this file in the site library 128;; To use the package regularly place this file in the site library
129;; directory and add the next expression in your .emacs file. Make 129;; directory and add the next expression in your init file. Make
130;; sure that directory is included in the `load-path'. 130;; sure that directory is included in the `load-path'.
131;; 131;;
132;; (require 'table) 132;; (require 'table)
@@ -342,10 +342,10 @@
342;; (function (lambda () 342;; (function (lambda ()
343;; (local-set-key [<key sequence>] '<function>)))) 343;; (local-set-key [<key sequence>] '<function>))))
344;; 344;;
345;; Above code is well known ~/.emacs idiom for customizing a mode 345;; Adding the above to your init file is a common way to customize a
346;; specific keymap however it does not work for this package. This is 346;; mode specific keymap. However it does not work for this package.
347;; because there is no table mode in effect. This package does not 347;; This is because there is no table mode in effect. This package
348;; use a local map therefore you must modify `table-cell-map' 348;; does not use a local map therefore you must modify `table-cell-map'
349;; explicitly. The correct way of achieving above task is: 349;; explicitly. The correct way of achieving above task is:
350;; 350;;
351;; (add-hook 'table-cell-map-hook 351;; (add-hook 'table-cell-map-hook
diff --git a/lisp/textmodes/two-column.el b/lisp/textmodes/two-column.el
index 8a4fe4f87fd..b21e72639fd 100644
--- a/lisp/textmodes/two-column.el
+++ b/lisp/textmodes/two-column.el
@@ -276,8 +276,9 @@ You have the following commands at your disposal:
276\\[2C-merge] Merge both buffers 276\\[2C-merge] Merge both buffers
277\\[2C-dissociate] Dissociate the two buffers 277\\[2C-dissociate] Dissociate the two buffers
278 278
279These keybindings can be customized in your ~/.emacs by `2C-mode-map', 279These keybindings can be customized in your init file by
280`2C-minor-mode-map' and by binding `2C-command' to some prefix. 280`2C-mode-map', `2C-minor-mode-map' and by binding `2C-command' to
281some prefix.
281 282
282The appearance of the screen can be customized by the variables 283The appearance of the screen can be customized by the variables
283`2C-window-width', `2C-beyond-fill-column', `2C-mode-line-format' and 284`2C-window-width', `2C-beyond-fill-column', `2C-mode-line-format' and
diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el
index 13963121e2b..c2ac1035dfe 100644
--- a/lisp/time-stamp.el
+++ b/lisp/time-stamp.el
@@ -29,7 +29,7 @@
29;; static char *ts = "sdmain.c Time-stamp: <2001-08-13 10:20:51 gildea>"; 29;; static char *ts = "sdmain.c Time-stamp: <2001-08-13 10:20:51 gildea>";
30;; See the top of `time-stamp.el' for another example. 30;; See the top of `time-stamp.el' for another example.
31 31
32;; To use time-stamping, add this line to your .emacs file: 32;; To use time-stamping, add this line to your init file:
33;; (add-hook 'before-save-hook 'time-stamp) 33;; (add-hook 'before-save-hook 'time-stamp)
34;; Now any time-stamp templates in your files will be updated automatically. 34;; Now any time-stamp templates in your files will be updated automatically.
35 35
@@ -254,7 +254,7 @@ time-stamped file itself.")
254(defun time-stamp () 254(defun time-stamp ()
255 "Update the time stamp string(s) in the buffer. 255 "Update the time stamp string(s) in the buffer.
256A template in a file can be automatically updated with a new time stamp 256A template in a file can be automatically updated with a new time stamp
257every time you save the file. Add this line to your .emacs file: 257every time you save the file. Add this line to your init file:
258 (add-hook 'before-save-hook 'time-stamp) 258 (add-hook 'before-save-hook 'time-stamp)
259or customize `before-save-hook' through Custom. 259or customize `before-save-hook' through Custom.
260Normally the template must appear in the first 8 lines of a file and 260Normally the template must appear in the first 8 lines of a file and
diff --git a/lisp/time.el b/lisp/time.el
index 8d43b565416..fe3cdbb57be 100644
--- a/lisp/time.el
+++ b/lisp/time.el
@@ -575,7 +575,8 @@ To turn off the world time display, go to that window and type `q'."
575 (let ((list timer-list)) 575 (let ((list timer-list))
576 (while list 576 (while list
577 (let ((elt (pop list))) 577 (let ((elt (pop list)))
578 (when (equal (symbol-name (aref elt 5)) "display-time-world-timer") 578 (when (equal (symbol-name (timer--function elt))
579 "display-time-world-timer")
579 (cancel-timer elt))))))) 580 (cancel-timer elt)))))))
580 581
581;;;###autoload 582;;;###autoload
diff --git a/lisp/url/url-methods.el b/lisp/url/url-methods.el
index bd7d8e33922..26fe72014f7 100644
--- a/lisp/url/url-methods.el
+++ b/lisp/url/url-methods.el
@@ -79,7 +79,7 @@
79 79
80 ;; Store any proxying information - this will not overwrite an old 80 ;; Store any proxying information - this will not overwrite an old
81 ;; entry, so that people can still set this information in their 81 ;; entry, so that people can still set this information in their
82 ;; .emacs file 82 ;; init file
83 (cond 83 (cond
84 (cur-proxy nil) ; Keep their old settings 84 (cur-proxy nil) ; Keep their old settings
85 ((null env-proxy) nil) ; No proxy setup 85 ((null env-proxy) nil) ; No proxy setup
diff --git a/lisp/userlock.el b/lisp/userlock.el
index 705d9588249..4c003e423aa 100644
--- a/lisp/userlock.el
+++ b/lisp/userlock.el
@@ -108,37 +108,27 @@ You can rewrite this to use any criterion you like to choose which one to do.
108The buffer in question is current when this function is called." 108The buffer in question is current when this function is called."
109 (discard-input) 109 (discard-input)
110 (save-window-excursion 110 (save-window-excursion
111 (let (answer) 111 (let ((prompt
112 (format "%s changed on disk; \
113really edit the buffer? (y, n, r or C-h) "
114 (file-name-nondirectory fn)))
115 (choices '(?y ?n ?r ?? ?\C-h))
116 answer)
112 (while (null answer) 117 (while (null answer)
113 (message "%s changed on disk; really edit the buffer? (y, n, r or C-h) " 118 (setq answer (read-char-choice prompt choices))
114 (file-name-nondirectory fn)) 119 (cond ((memq answer '(?? ?\C-h))
115 (let ((tem (downcase (let ((cursor-in-echo-area t)) 120 (ask-user-about-supersession-help)
116 (read-char-exclusive))))) 121 (setq answer nil))
117 (setq answer 122 ((eq answer ?r)
118 (if (= tem help-char) 123 ;; Ask for confirmation if buffer modified
119 'help 124 (revert-buffer nil (not (buffer-modified-p)))
120 (cdr (assoc tem '((?n . yield) 125 (signal 'file-supersession
121 (?\C-g . yield) 126 (list "File reverted" fn)))
122 (?y . proceed) 127 ((eq answer ?n)
123 (?r . revert) 128 (signal 'file-supersession
124 (?? . help)))))) 129 (list "File changed on disk" fn)))))
125 (cond ((null answer)
126 (beep)
127 (message "Please type y, n or r; or ? for help")
128 (sit-for 3))
129 ((eq answer 'help)
130 (ask-user-about-supersession-help)
131 (setq answer nil))
132 ((eq answer 'revert)
133 (revert-buffer nil (not (buffer-modified-p)))
134 ; ask confirmation if buffer modified
135 (signal 'file-supersession
136 (list "File reverted" fn)))
137 ((eq answer 'yield)
138 (signal 'file-supersession
139 (list "File changed on disk" fn))))))
140 (message 130 (message
141 "File on disk now will become a backup file if you save these changes.") 131 "File on disk now will become a backup file if you save these changes.")
142 (setq buffer-backed-up nil)))) 132 (setq buffer-backed-up nil))))
143 133
144(defun ask-user-about-supersession-help () 134(defun ask-user-about-supersession-help ()
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index c6a9371ea9a..11ec785b647 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -178,6 +178,8 @@ when editing big diffs)."
178 ["Unified -> Context" diff-unified->context 178 ["Unified -> Context" diff-unified->context
179 :help "Convert unified diffs to context diffs"] 179 :help "Convert unified diffs to context diffs"]
180 ;;["Fixup Headers" diff-fixup-modifs (not buffer-read-only)] 180 ;;["Fixup Headers" diff-fixup-modifs (not buffer-read-only)]
181 ["Remove trailing whitespace" diff-remove-trailing-whitespace
182 :help "Remove trailing whitespace problems introduced by the diff"]
181 ["Show trailing whitespace" whitespace-mode 183 ["Show trailing whitespace" whitespace-mode
182 :style toggle :selected (bound-and-true-p whitespace-mode) 184 :style toggle :selected (bound-and-true-p whitespace-mode)
183 :help "Show trailing whitespace in modified lines"] 185 :help "Show trailing whitespace in modified lines"]
diff --git a/lisp/vc/pcvs-defs.el b/lisp/vc/pcvs-defs.el
index 0f71b7b82e7..fc65d62c67d 100644
--- a/lisp/vc/pcvs-defs.el
+++ b/lisp/vc/pcvs-defs.el
@@ -57,11 +57,7 @@ versions, such as the one in SunOS-4.")
57;;;; END OF THINGS TO CHECK WHEN INSTALLING 57;;;; END OF THINGS TO CHECK WHEN INSTALLING
58;;;; -------------------------------------------------------- 58;;;; --------------------------------------------------------
59 59
60;;;;
61;;;; User configuration variables: 60;;;; User configuration variables:
62;;;;
63;;;; NOTE: these should be set in your ~/.emacs (or site-lisp/default.el) file.
64;;;;
65 61
66(defgroup pcl-cvs nil 62(defgroup pcl-cvs nil
67 "Special support for the CVS versioning system." 63 "Special support for the CVS versioning system."
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index c0dafda57b6..1eb33776f6a 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -534,7 +534,9 @@ in the branch repository (or whose status not be determined)."
534 ;; FIXME: maybe it's overkill to check if both these 534 ;; FIXME: maybe it's overkill to check if both these
535 ;; files exist. 535 ;; files exist.
536 (and (file-exists-p branch-format-file) 536 (and (file-exists-p branch-format-file)
537 (file-exists-p lastrev-file))))) 537 (file-exists-p lastrev-file)
538 (equal (emacs-bzr-version-dirstate l-c-parent-dir)
539 (emacs-bzr-version-dirstate rootdir))))))
538 t))) 540 t)))
539 (with-temp-buffer 541 (with-temp-buffer
540 (insert-file-contents branch-format-file) 542 (insert-file-contents branch-format-file)
@@ -553,13 +555,17 @@ in the branch repository (or whose status not be determined)."
553 (insert-file-contents lastrev-file) 555 (insert-file-contents lastrev-file)
554 (when (re-search-forward "[0-9]+" nil t) 556 (when (re-search-forward "[0-9]+" nil t)
555 (buffer-substring (match-beginning 0) (match-end 0)))))) 557 (buffer-substring (match-beginning 0) (match-end 0))))))
556 ;; fallback to calling "bzr revno" 558 ;; Fallback to calling "bzr revno --tree".
559 ;; The "--tree" matters for lightweight checkouts not on the same
560 ;; revision as the parent.
557 (let* ((result (vc-bzr-command-discarding-stderr 561 (let* ((result (vc-bzr-command-discarding-stderr
558 vc-bzr-program "revno" (file-relative-name file))) 562 vc-bzr-program "revno" "--tree"
563 (file-relative-name file)))
559 (exitcode (car result)) 564 (exitcode (car result))
560 (output (cdr result))) 565 (output (cdr result)))
561 (cond 566 (cond
562 ((eq exitcode 0) (substring output 0 -1)) 567 ((and (eq exitcode 0) (not (zerop (length output))))
568 (substring output 0 -1))
563 (t nil)))))) 569 (t nil))))))
564 570
565(defun vc-bzr-create-repo () 571(defun vc-bzr-create-repo ()
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index b48ea1afd95..ea9ce949ccb 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -31,7 +31,7 @@
31 31
32;; To install: put this file on the load-path and add Git to the list 32;; To install: put this file on the load-path and add Git to the list
33;; of supported backends in `vc-handled-backends'; the following line, 33;; of supported backends in `vc-handled-backends'; the following line,
34;; placed in your ~/.emacs, will accomplish this: 34;; placed in your init file, will accomplish this:
35;; 35;;
36;; (add-to-list 'vc-handled-backends 'Git) 36;; (add-to-list 'vc-handled-backends 'Git)
37 37
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 1ef4faaa008..47800bd4aac 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -653,7 +653,6 @@
653 653
654(require 'vc-hooks) 654(require 'vc-hooks)
655(require 'vc-dispatcher) 655(require 'vc-dispatcher)
656(require 'ediff)
657 656
658(declare-function diff-setup-whitespace "diff-mode" ()) 657(declare-function diff-setup-whitespace "diff-mode" ())
659 658
@@ -1698,7 +1697,9 @@ saving the buffer."
1698 (vc-diff-internal t (vc-deduce-fileset t) nil nil 1697 (vc-diff-internal t (vc-deduce-fileset t) nil nil
1699 (called-interactively-p 'interactive)))) 1698 (called-interactively-p 'interactive))))
1700 1699
1701(declare-function ediff-vc-internal (rev1 rev2 &optional startup-hooks)) 1700(declare-function ediff-load-version-control "ediff" (&optional silent))
1701(declare-function ediff-vc-internal "ediff-vers"
1702 (rev1 rev2 &optional startup-hooks))
1702 1703
1703;;;###autoload 1704;;;###autoload
1704(defun vc-version-ediff (files rev1 rev2) 1705(defun vc-version-ediff (files rev1 rev2)
@@ -1719,7 +1720,8 @@ repository history using ediff."
1719 ;; FIXME We only support running ediff on one file for now. 1720 ;; FIXME We only support running ediff on one file for now.
1720 ;; We could spin off an ediff session per file in the file set. 1721 ;; We could spin off an ediff session per file in the file set.
1721 ((= (length files) 1) 1722 ((= (length files) 1)
1722 (ediff-load-version-control) 1723 (require 'ediff)
1724 (ediff-load-version-control) ; loads ediff-vers
1723 (find-file (car files)) ;FIXME: find-file from Elisp is bad. 1725 (find-file (car files)) ;FIXME: find-file from Elisp is bad.
1724 (ediff-vc-internal rev1 rev2 nil)) 1726 (ediff-vc-internal rev1 rev2 nil))
1725 (t 1727 (t
diff --git a/lisp/version.el b/lisp/version.el
index e63c51d0d26..1fb3828e15d 100644
--- a/lisp/version.el
+++ b/lisp/version.el
@@ -87,40 +87,91 @@ to the system configuration; look at `system-configuration' instead."
87;; Set during dumping, this is a defvar so that it can be setq'd. 87;; Set during dumping, this is a defvar so that it can be setq'd.
88(defvar emacs-bzr-version nil 88(defvar emacs-bzr-version nil
89 "String giving the bzr revision from which this Emacs was built. 89 "String giving the bzr revision from which this Emacs was built.
90Value is the bzr revision number and a revision ID separated by a blank. 90The format is: [revno] revision_id, where revno may be absent.
91Value is nil if Emacs was not built from a bzr checkout, or if we could 91Value is nil if Emacs was not built from a bzr checkout, or if we could
92not determine the revision.") 92not determine the revision.")
93 93
94(defun emacs-bzr-get-version (&optional dir) 94(defun emacs-bzr-version-dirstate (dir)
95 "Try to return as a string the bzr revision number of the Emacs sources. 95 "Try to return as a string the bzr revision ID of directory DIR.
96Value is the bzr revision number and a revision ID separated by a blank. 96This uses the dirstate file's parent revision entry.
97Returns nil if unable to find this information."
98 (let ((file (expand-file-name ".bzr/checkout/dirstate" dir)))
99 (when (file-readable-p file)
100 (with-temp-buffer
101 (insert-file-contents file)
102 (and (looking-at "#bazaar dirstate flat format 3")
103 (forward-line 3)
104 (looking-at "[0-9]+\0\\([^\0\n]+\\)\0")
105 (match-string 1))))))
106
107(defun emacs-bzr-version-bzr (dir)
108 "Ask bzr itself for the version information for directory DIR."
109 ;; Comments on `bzr version-info':
110 ;; i) Unknown files also cause clean != 1.
111 ;; ii) It can be slow, contacting the upstream repo to get the
112 ;; branch nick if one is not set locally, even with a custom
113 ;; template that is not asking for the nick (as used here). You'd
114 ;; think the latter part would be trivial to fix:
115 ;; https://bugs.launchpad.net/bzr/+bug/882541/comments/3
116 ;; https://bugs.launchpad.net/bzr/+bug/629150
117 ;; You can set the nick locally with `bzr nick ...', which speeds
118 ;; things up enormously. `bzr revno' does not have this issue, but
119 ;; has no way to print the revision_id AFAICS.
120 (message "Waiting for bzr...")
121 (with-temp-buffer
122 (if (zerop
123 (call-process "bzr" nil '(t nil) nil "version-info"
124 "--custom"
125 "--template={revno} {revision_id} (clean = {clean})"
126 "dir"))
127 (buffer-string))))
128
129(defun emacs-bzr-get-version (&optional dir external)
130 "Try to return as a string the bzr revision of the Emacs sources.
131The format is: [revno] revision_id, where revno may be absent.
97Value is nil if the sources do not seem to be under bzr, or if we could 132Value is nil if the sources do not seem to be under bzr, or if we could
98not determine the revision. Note that this reports on the current state 133not determine the revision. Note that this reports on the current state
99of the sources, which may not correspond to the running Emacs. 134of the sources, which may not correspond to the running Emacs.
100 135
101Optional argument DIR is a directory to use instead of `source-directory'." 136Optional argument DIR is a directory to use instead of `source-directory'.
137Optional argument EXTERNAL non-nil means to maybe ask `bzr' itself,
138if the sources appear to be under bzr. If `force', always ask bzr.
139Otherwise only ask bzr if we cannot find any information ourselves."
102 (or dir (setq dir source-directory)) 140 (or dir (setq dir source-directory))
103 (when (file-directory-p (setq dir (expand-file-name ".bzr/branch" dir))) 141 (when (file-directory-p (expand-file-name ".bzr/branch" dir))
104 (let (file loc) 142 (if (eq external 'force)
105 (cond ((file-readable-p 143 (emacs-bzr-version-bzr dir)
106 (setq file (expand-file-name "last-revision" dir))) 144 (let (file loc rev)
107 (with-temp-buffer 145 (cond ((file-readable-p
108 (insert-file-contents file) 146 (setq file (expand-file-name ".bzr/branch/last-revision" dir)))
109 (goto-char (point-max)) 147 (with-temp-buffer
110 (if (looking-back "\n") 148 (insert-file-contents file)
111 (delete-char -1)) 149 (goto-char (point-max))
112 (buffer-string))) 150 (if (looking-back "\n")
113 ;; OK, no last-revision. Is it a lightweight checkout? 151 (delete-char -1))
114 ((file-readable-p 152 (buffer-string)))
115 (setq file (expand-file-name "location" dir))) 153 ;; OK, no last-revision. Is it a lightweight checkout?
116 ;; If the parent branch is local, try looking there for the revid. 154 ((file-readable-p
117 (if (setq loc (with-temp-buffer 155 (setq file (expand-file-name ".bzr/branch/location" dir)))
118 (insert-file-contents file) 156 (setq rev (emacs-bzr-version-dirstate dir))
119 (if (looking-at "file://\\(.*\\)") 157 ;; If the parent branch is local, try looking there for the rev.
120 (match-string 1)))) 158 ;; Note: there is no guarantee that the parent branch's rev
121 (emacs-bzr-get-version loc))) 159 ;; corresponds to this branch. This branch could have
122 ;; Could fall back to eg `bzr testament' at this point. 160 ;; been made with a specific -r revno argument, or the
123 )))) 161 ;; parent could have been updated since this branch was created.
162 ;; To try and detect this, we check the dirstate revids
163 ;; to see if they match.
164 (if (and (setq loc (with-temp-buffer
165 (insert-file-contents file)
166 (if (looking-at "file://\\(.*\\)")
167 (match-string 1))))
168 (equal rev (emacs-bzr-version-dirstate loc)))
169 (emacs-bzr-get-version loc)
170 ;; If parent does not match, the best we can do without
171 ;; calling external commands is to use the dirstate rev.
172 rev))
173 (external
174 (emacs-bzr-version-bzr dir)))))))
124 175
125;; We put version info into the executable in the form that `ident' uses. 176;; We put version info into the executable in the form that `ident' uses.
126(purecopy (concat "\n$Id: " (subst-char-in-string ?\n ?\s (emacs-version)) 177(purecopy (concat "\n$Id: " (subst-char-in-string ?\n ?\s (emacs-version))
diff --git a/lisp/windmove.el b/lisp/windmove.el
index 3a1afec38ee..1181e409dff 100644
--- a/lisp/windmove.el
+++ b/lisp/windmove.el
@@ -94,7 +94,7 @@
94 94
95;; Installation: 95;; Installation:
96;; 96;;
97;; Put the following line in your `.emacs' file: 97;; Put the following line in your init file:
98;; 98;;
99;; (windmove-default-keybindings) ; shifted arrow keys 99;; (windmove-default-keybindings) ; shifted arrow keys
100;; 100;;
diff --git a/lisp/window.el b/lisp/window.el
index 2fce874e987..fccb68bd94a 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -73,6 +73,108 @@ are not altered by this macro (unless they are altered in BODY)."
73 (when (window-live-p save-selected-window-window) 73 (when (window-live-p save-selected-window-window)
74 (select-window save-selected-window-window 'norecord)))))) 74 (select-window save-selected-window-window 'norecord))))))
75 75
76(defvar temp-buffer-window-setup-hook nil
77 "Normal hook run by `with-temp-buffer-window' before buffer display.
78This hook is run by `with-temp-buffer-window' with the buffer to be
79displayed current.")
80
81(defvar temp-buffer-window-show-hook nil
82 "Normal hook run by `with-temp-buffer-window' after buffer display.
83This hook is run by `with-temp-buffer-window' with the buffer
84displayed and current and its window selected.")
85
86(defun temp-buffer-window-setup (buffer-or-name)
87 "Set up temporary buffer specified by BUFFER-OR-NAME
88Return the buffer."
89 (let ((old-dir default-directory)
90 (buffer (get-buffer-create buffer-or-name)))
91 (with-current-buffer buffer
92 (kill-all-local-variables)
93 (setq default-directory old-dir)
94 (delete-all-overlays)
95 (setq buffer-read-only nil)
96 (setq buffer-file-name nil)
97 (setq buffer-undo-list t)
98 (let ((inhibit-read-only t)
99 (inhibit-modification-hooks t))
100 (erase-buffer)
101 (run-hooks 'temp-buffer-window-setup-hook))
102 ;; Return the buffer.
103 buffer)))
104
105(defun temp-buffer-window-show (&optional buffer action)
106 "Show temporary buffer BUFFER in a window.
107Return the window showing BUFFER. Pass ACTION as action argument
108to `display-buffer'."
109 (let (window frame)
110 (with-current-buffer buffer
111 (set-buffer-modified-p nil)
112 (setq buffer-read-only t)
113 (goto-char (point-min))
114 (when (setq window (display-buffer buffer action))
115 (setq frame (window-frame window))
116 (unless (eq frame (selected-frame))
117 (raise-frame frame))
118 (setq minibuffer-scroll-window window)
119 (set-window-hscroll window 0)
120 (with-selected-window window
121 (run-hooks 'temp-buffer-window-show-hook)
122 (when temp-buffer-resize-mode
123 (resize-temp-buffer-window window)))
124 ;; Return the window.
125 window))))
126
127(defmacro with-temp-buffer-window (buffer-or-name action quit-function &rest body)
128 "Evaluate BODY and display buffer specified by BUFFER-OR-NAME.
129BUFFER-OR-NAME must specify either a live buffer or the name of a
130buffer. If no buffer with such a name exists, create one.
131
132Make sure the specified buffer is empty before evaluating BODY.
133Do not make that buffer current for BODY. Instead, bind
134`standard-output' to that buffer, so that output generated with
135`prin1' and similar functions in BODY goes into that buffer.
136
137After evaluating BODY, mark the specified buffer unmodified and
138read-only, and display it in a window via `display-buffer'. Pass
139ACTION as action argument to `display-buffer'. Automatically
140shrink the window used if `temp-buffer-resize-mode' is enabled.
141
142Return the value returned by BODY unless QUIT-FUNCTION specifies
143a function. In that case, run the function with two arguments -
144the window showing the specified buffer and the value returned by
145BODY - and return the value returned by that function.
146
147If the buffer is displayed on a new frame, the window manager may
148decide to select that frame. In that case, it's usually a good
149strategy if the function specified by QUIT-FUNCTION selects the
150window showing the buffer before reading a value from the
151minibuffer, for example, when asking a `yes-or-no-p' question.
152
153This construct is similar to `with-output-to-temp-buffer' but
154does neither put the buffer in help mode nor does it call
155`temp-buffer-show-function'. It also runs different hooks,
156namely `temp-buffer-window-setup-hook' (with the specified buffer
157current) and `temp-buffer-window-show-hook' (with the specified
158buffer current and the window showing it selected).
159
160Since this macro calls `display-buffer', the window displaying
161the buffer is usually not selected and the specified buffer
162usually not made current. QUIT-FUNCTION can override that."
163 (declare (debug t))
164 (let ((buffer (make-symbol "buffer"))
165 (window (make-symbol "window"))
166 (value (make-symbol "value")))
167 `(let* ((,buffer (temp-buffer-window-setup ,buffer-or-name))
168 (standard-output ,buffer)
169 ,window ,value)
170 (with-current-buffer ,buffer
171 (setq ,value (progn ,@body))
172 (setq ,window (temp-buffer-window-show ,buffer ,action)))
173
174 (if (functionp ,quit-function)
175 (funcall ,quit-function ,window ,value)
176 ,value))))
177
76;; The following two functions are like `window-next-sibling' and 178;; The following two functions are like `window-next-sibling' and
77;; `window-prev-sibling' but the WINDOW argument is _not_ optional (so 179;; `window-prev-sibling' but the WINDOW argument is _not_ optional (so
78;; they don't substitute the selected window for nil), and they return 180;; they don't substitute the selected window for nil), and they return
@@ -4449,6 +4551,9 @@ of the window used."
4449 (function :tag "function")) 4551 (function :tag "function"))
4450 :group 'windows) 4552 :group 'windows)
4451 4553
4554(make-obsolete-variable 'display-buffer-function
4555 'display-buffer-alist "24.3")
4556
4452;; Eventually, we want to turn this into a defvar; instead of 4557;; Eventually, we want to turn this into a defvar; instead of
4453;; customizing this, the user should use a `pop-up-frame-parameters' 4558;; customizing this, the user should use a `pop-up-frame-parameters'
4454;; alist entry in `display-buffer-base-action'. 4559;; alist entry in `display-buffer-base-action'.
@@ -4666,8 +4771,8 @@ the selected window. If they contain (same-frame . t), display
4666BUFFER in a window of the selected frame. 4771BUFFER in a window of the selected frame.
4667 4772
4668If ARGS is a list whose car is a symbol, use (car ARGS) as a 4773If ARGS is a list whose car is a symbol, use (car ARGS) as a
4669function to do the work. Pass it BUFFER as first argument, 4774function to do the work. Pass it BUFFER as first argument, and
4670and (cdr ARGS) as second." 4775pass the elements of (cdr ARGS) as the remaining arguments."
4671 (if (and args (symbolp (car args))) 4776 (if (and args (symbolp (car args)))
4672 (apply (car args) buffer (cdr args)) 4777 (apply (car args) buffer (cdr args))
4673 (let ((window (get-buffer-window buffer 0))) 4778 (let ((window (get-buffer-window buffer 0)))
@@ -4696,6 +4801,9 @@ and (cdr ARGS) as second."
4696 (make-frame (append args special-display-frame-alist)))) 4801 (make-frame (append args special-display-frame-alist))))
4697 (window (frame-selected-window frame))) 4802 (window (frame-selected-window frame)))
4698 (display-buffer-record-window 'frame window buffer) 4803 (display-buffer-record-window 'frame window buffer)
4804 (unless (eq buffer (window-buffer window))
4805 (set-window-buffer window buffer)
4806 (set-window-prev-buffers window nil))
4699 (set-window-dedicated-p window t) 4807 (set-window-dedicated-p window t)
4700 window))))) 4808 window)))))
4701 4809
@@ -5416,6 +5524,62 @@ the selected one."
5416 (window--display-buffer 5524 (window--display-buffer
5417 buffer window 'reuse display-buffer-mark-dedicated))))) 5525 buffer window 'reuse display-buffer-mark-dedicated)))))
5418 5526
5527(defun display-buffer-in-previous-window (buffer alist)
5528 "Display BUFFER in a window previously showing it.
5529If ALIST has a non-nil `inhibit-same-window' entry, the selected
5530window is not eligible for reuse.
5531
5532If ALIST contains a `reusable-frames' entry, its value determines
5533which frames to search for a reusable window:
5534 nil -- the selected frame (actually the last non-minibuffer frame)
5535 A frame -- just that frame
5536 `visible' -- all visible frames
5537 0 -- all frames on the current terminal
5538 t -- all frames.
5539
5540If ALIST contains no `reusable-frames' entry, search just the
5541selected frame if `display-buffer-reuse-frames' and
5542`pop-up-frames' are both nil; search all frames on the current
5543terminal if either of those variables is non-nil.
5544
5545If ALIST has a `previous-window' entry, the window specified by
5546that entry will override any other window found by the methods
5547above, even if that window never showed BUFFER before."
5548 (let* ((alist-entry (assq 'reusable-frames alist))
5549 (inhibit-same-window
5550 (cdr (assq 'inhibit-same-window alist)))
5551 (frames (cond
5552 (alist-entry (cdr alist-entry))
5553 ((if (eq pop-up-frames 'graphic-only)
5554 (display-graphic-p)
5555 pop-up-frames)
5556 0)
5557 (display-buffer-reuse-frames 0)
5558 (t (last-nonminibuffer-frame))))
5559 entry best-window second-best-window window)
5560 ;; Scan windows whether they have shown the buffer recently.
5561 (catch 'best
5562 (dolist (window (window-list-1 (frame-first-window) 'nomini frames))
5563 (when (and (assq buffer (window-prev-buffers window))
5564 (not (window-dedicated-p window)))
5565 (if (eq window (selected-window))
5566 (unless inhibit-same-window
5567 (setq second-best-window window))
5568 (setq best-window window)
5569 (throw 'best t)))))
5570 ;; When ALIST has a `previous-window' entry, that entry may override
5571 ;; anything we found so far.
5572 (when (and (setq window (cdr (assq 'previous-window alist)))
5573 (window-live-p window)
5574 (not (window-dedicated-p window)))
5575 (if (eq window (selected-window))
5576 (unless inhibit-same-window
5577 (setq second-best-window window))
5578 (setq best-window window)))
5579 ;; Return best or second best window found.
5580 (when (setq window (or best-window second-best-window))
5581 (window--display-buffer buffer window 'reuse))))
5582
5419(defun display-buffer-use-some-window (buffer alist) 5583(defun display-buffer-use-some-window (buffer alist)
5420 "Display BUFFER in an existing window. 5584 "Display BUFFER in an existing window.
5421Search for a usable window, set that window to the buffer, and 5585Search for a usable window, set that window to the buffer, and
@@ -5537,26 +5701,28 @@ buffer with the name BUFFER-OR-NAME and return that buffer."
5537 5701
5538(defun switch-to-buffer (buffer-or-name &optional norecord force-same-window) 5702(defun switch-to-buffer (buffer-or-name &optional norecord force-same-window)
5539 "Switch to buffer BUFFER-OR-NAME in the selected window. 5703 "Switch to buffer BUFFER-OR-NAME in the selected window.
5540If called interactively, prompt for the buffer name using the 5704If the selected window cannot display the specified
5705buffer (e.g. if it is a minibuffer window or strongly dedicated
5706to another buffer), call `pop-to-buffer' to select the buffer in
5707another window.
5708
5709If called interactively, read the buffer name using the
5541minibuffer. The variable `confirm-nonexistent-file-or-buffer' 5710minibuffer. The variable `confirm-nonexistent-file-or-buffer'
5542determines whether to request confirmation before creating a new 5711determines whether to request confirmation before creating a new
5543buffer. 5712buffer.
5544 5713
5545BUFFER-OR-NAME may be a buffer, a string (a buffer name), or 5714BUFFER-OR-NAME may be a buffer, a string (a buffer name), or nil.
5546nil. If BUFFER-OR-NAME is a string that does not identify an 5715If BUFFER-OR-NAME is a string that does not identify an existing
5547existing buffer, create a buffer with that name. If 5716buffer, create a buffer with that name. If BUFFER-OR-NAME is
5548BUFFER-OR-NAME is nil, switch to the buffer returned by 5717nil, switch to the buffer returned by `other-buffer'.
5549`other-buffer'.
5550 5718
5551Optional argument NORECORD non-nil means do not put the buffer 5719If optional argument NORECORD is non-nil, do not put the buffer
5552specified by BUFFER-OR-NAME at the front of the buffer list and 5720at the front of the buffer list, and do not make the window
5553do not make the window displaying it the most recently selected 5721displaying it the most recently selected one.
5554one.
5555 5722
5556If FORCE-SAME-WINDOW is non-nil, BUFFER-OR-NAME must be displayed 5723If optional argument FORCE-SAME-WINDOW is non-nil, the buffer
5557in the selected window; signal an error if that is 5724must be displayed in the selected window; if that is impossible,
5558impossible (e.g. if the selected window is minibuffer-only). If 5725signal an error rather than calling `pop-to-buffer'.
5559nil, BUFFER-OR-NAME may be displayed in another window.
5560 5726
5561Return the buffer switched to." 5727Return the buffer switched to."
5562 (interactive 5728 (interactive
@@ -5710,7 +5876,7 @@ WINDOW must be a live window and defaults to the selected one."
5710 window)))) 5876 window))))
5711 5877
5712;;; Resizing buffers to fit their contents exactly. 5878;;; Resizing buffers to fit their contents exactly.
5713(defun fit-window-to-buffer (&optional window max-height min-height override) 5879(defun fit-window-to-buffer (&optional window max-height min-height)
5714 "Adjust height of WINDOW to display its buffer's contents exactly. 5880 "Adjust height of WINDOW to display its buffer's contents exactly.
5715WINDOW must be a live window and defaults to the selected one. 5881WINDOW must be a live window and defaults to the selected one.
5716 5882
@@ -5721,10 +5887,6 @@ defaults to `window-min-height'. Both MAX-HEIGHT and MIN-HEIGHT
5721are specified in lines and include the mode line and header line, 5887are specified in lines and include the mode line and header line,
5722if any. 5888if any.
5723 5889
5724Optional argument OVERRIDE non-nil means override restrictions
5725imposed by `window-min-height' and `window-min-width' on the size
5726of WINDOW.
5727
5728Return the number of lines by which WINDOW was enlarged or 5890Return the number of lines by which WINDOW was enlarged or
5729shrunk. If an error occurs during resizing, return nil but don't 5891shrunk. If an error occurs during resizing, return nil but don't
5730signal an error. 5892signal an error.
@@ -5733,28 +5895,27 @@ Note that even if this function makes WINDOW large enough to show
5733_all_ lines of its buffer you might not see the first lines when 5895_all_ lines of its buffer you might not see the first lines when
5734WINDOW was scrolled." 5896WINDOW was scrolled."
5735 (interactive) 5897 (interactive)
5736 ;; Do all the work in WINDOW and its buffer and restore the selected
5737 ;; window and the current buffer when we're done.
5738 (setq window (window-normalize-window window t)) 5898 (setq window (window-normalize-window window t))
5739 ;; Can't resize a full height or fixed-size window. 5899 ;; Can't resize a full height or fixed-size window.
5740 (unless (or (window-size-fixed-p window) 5900 (unless (or (window-size-fixed-p window)
5741 (window-full-height-p window)) 5901 (window-full-height-p window))
5742 ;; `with-selected-window' should orderly restore the current buffer.
5743 (with-selected-window window 5902 (with-selected-window window
5744 ;; We are in WINDOW's buffer now. 5903 (let* ((height (window-total-size))
5745 (let* (;; Adjust MIN-HEIGHT.
5746 (min-height 5904 (min-height
5747 (if override 5905 ;; Adjust MIN-HEIGHT.
5748 (window-min-size window nil window) 5906 (if (numberp min-height)
5749 (max (or min-height window-min-height) 5907 ;; Can't get smaller than `window-safe-min-height'.
5750 window-safe-min-height))) 5908 (max min-height window-safe-min-height)
5751 (max-window-height 5909 ;; Preserve header and mode line if present.
5752 (window-total-size (frame-root-window window))) 5910 (window-min-size nil nil t)))
5753 ;; Adjust MAX-HEIGHT.
5754 (max-height 5911 (max-height
5755 (if (or override (not max-height)) 5912 ;; Adjust MAX-HEIGHT.
5756 max-window-height 5913 (if (numberp max-height)
5757 (min max-height max-window-height))) 5914 ;; Can't get larger than height of frame.
5915 (min max-height
5916 (window-total-size (frame-root-window window)))
5917 ;, Don't delete other windows.
5918 (+ height (window-max-delta nil nil window))))
5758 ;; Make `desired-height' the height necessary to show 5919 ;; Make `desired-height' the height necessary to show
5759 ;; all of WINDOW's buffer, constrained by MIN-HEIGHT 5920 ;; all of WINDOW's buffer, constrained by MIN-HEIGHT
5760 ;; and MAX-HEIGHT. 5921 ;; and MAX-HEIGHT.
@@ -5779,7 +5940,6 @@ WINDOW was scrolled."
5779 (window-max-delta window nil window)) 5940 (window-max-delta window nil window))
5780 (max desired-delta 5941 (max desired-delta
5781 (- (window-min-delta window nil window)))))) 5942 (- (window-min-delta window nil window))))))
5782 ;; This `condition-case' shouldn't be necessary, but who knows?
5783 (condition-case nil 5943 (condition-case nil
5784 (if (zerop delta) 5944 (if (zerop delta)
5785 ;; Return zero if DELTA became zero in the process. 5945 ;; Return zero if DELTA became zero in the process.
@@ -5819,6 +5979,88 @@ WINDOW was scrolled."
5819 (error (setq delta nil))) 5979 (error (setq delta nil)))
5820 delta)))) 5980 delta))))
5821 5981
5982(defcustom fit-frame-to-buffer-bottom-margin 4
5983 "Bottom margin for `fit-frame-to-buffer'.
5984This is the number of lines `fit-frame-to-buffer' leaves free at the
5985bottom of the display in order to not obscure the system task bar."
5986 :type 'integer
5987 :version "24.2"
5988 :group 'windows)
5989
5990(defun fit-frame-to-buffer (&optional frame max-height min-height)
5991 "Adjust height of FRAME to display its buffer's contents exactly.
5992FRAME can be any live frame and defaults to the selected one.
5993
5994Optional argument MAX-HEIGHT specifies the maximum height of
5995FRAME and defaults to the height of the display below the current
5996top line of FRAME minus FIT-FRAME-TO-BUFFER-BOTTOM-MARGIN.
5997Optional argument MIN-HEIGHT specifies the minimum height of
5998FRAME."
5999 (interactive)
6000 (setq frame (window-normalize-frame frame))
6001 (let* ((root (frame-root-window frame))
6002 (frame-min-height
6003 (+ (- (frame-height frame) (window-total-size root))
6004 window-min-height))
6005 (frame-top (frame-parameter frame 'top))
6006 (top (if (consp frame-top)
6007 (funcall (car frame-top) (cadr frame-top))
6008 frame-top))
6009 (frame-max-height
6010 (- (/ (- (x-display-pixel-height frame) top)
6011 (frame-char-height frame))
6012 fit-frame-to-buffer-bottom-margin))
6013 (compensate 0)
6014 delta)
6015 (when (and (window-live-p root) (not (window-size-fixed-p root)))
6016 (with-selected-window root
6017 (cond
6018 ((not max-height)
6019 (setq max-height frame-max-height))
6020 ((numberp max-height)
6021 (setq max-height (min max-height frame-max-height)))
6022 (t
6023 (error "%s is an invalid maximum height" max-height)))
6024 (cond
6025 ((not min-height)
6026 (setq min-height frame-min-height))
6027 ((numberp min-height)
6028 (setq min-height (min min-height frame-min-height)))
6029 (t
6030 (error "%s is an invalid minimum height" min-height)))
6031 ;; When tool-bar-mode is enabled and we have just created a new
6032 ;; frame, reserve lines for toolbar resizing. This is needed
6033 ;; because for reasons unknown to me Emacs (1) reserves one line
6034 ;; for the toolbar when making the initial frame and toolbars
6035 ;; are enabled, and (2) later adds the remaining lines needed.
6036 ;; Our code runs IN BETWEEN (1) and (2). YMMV when you're on a
6037 ;; system that behaves differently.
6038 (let ((quit-restore (window-parameter root 'quit-restore))
6039 (lines (tool-bar-lines-needed frame)))
6040 (when (and quit-restore (eq (car quit-restore) 'frame)
6041 (not (zerop lines)))
6042 (setq compensate (1- lines))))
6043 (message "%s" compensate)
6044 (setq delta
6045 ;; Always count a final newline - we don't do any
6046 ;; post-processing, so let's play safe.
6047 (+ (count-screen-lines nil nil t)
6048 (- (window-body-size))
6049 compensate)))
6050 ;; Move away from final newline.
6051 (when (and (eobp) (bolp) (not (bobp)))
6052 (set-window-point root (line-beginning-position 0)))
6053 (set-window-start root (point-min))
6054 (set-window-vscroll root 0)
6055 (condition-case nil
6056 (set-frame-height
6057 frame
6058 (min (max (+ (frame-height frame) delta)
6059 min-height)
6060 max-height))
6061 (error (setq delta nil))))
6062 delta))
6063
5822(defun window-safely-shrinkable-p (&optional window) 6064(defun window-safely-shrinkable-p (&optional window)
5823 "Return t if WINDOW can be shrunk without shrinking other windows. 6065 "Return t if WINDOW can be shrunk without shrinking other windows.
5824WINDOW defaults to the selected window." 6066WINDOW defaults to the selected window."
@@ -6062,7 +6304,7 @@ This is different from `scroll-down-command' that scrolls a full screen."
6062(put 'scroll-down-line 'scroll-command t) 6304(put 'scroll-down-line 'scroll-command t)
6063 6305
6064 6306
6065(defun scroll-other-window-down (lines) 6307(defun scroll-other-window-down (&optional lines)
6066 "Scroll the \"other window\" down. 6308 "Scroll the \"other window\" down.
6067For more details, see the documentation for `scroll-other-window'." 6309For more details, see the documentation for `scroll-other-window'."
6068 (interactive "P") 6310 (interactive "P")