aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorKaroly Lorentey2006-07-29 09:59:12 +0000
committerKaroly Lorentey2006-07-29 09:59:12 +0000
commit251bc578cc636223d618d06cf2a2bb7d07db9cce (patch)
tree58e1c6b0a35bb4a77e6cb77876e4bc6a9d3f2ab2 /lisp
parent99715bbc447eb633e45ffa23b87284771ce3ac74 (diff)
parent0ed0527cb02180a50f6744086ce3a487740c73e4 (diff)
downloademacs-251bc578cc636223d618d06cf2a2bb7d07db9cce.tar.gz
emacs-251bc578cc636223d618d06cf2a2bb7d07db9cce.zip
Merged from emacs@sv.gnu.org
Patches applied: * emacs@sv.gnu.org/emacs--devo--0--patch-351 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-352 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-353 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-354 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-355 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-356 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-357 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-358 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-359 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-360 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-361 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-362 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-363 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-364 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-365 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-366 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-367 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-368 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-369 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-370 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-115 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-116 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-117 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-118 Merge from emacs--devo--0 * emacs@sv.gnu.org/gnus--rel--5.10--patch-119 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-120 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-573
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog425
-rw-r--r--lisp/Makefile.in17
-rw-r--r--lisp/allout.el756
-rw-r--r--lisp/arc-mode.el12
-rw-r--r--lisp/bindings.el6
-rw-r--r--lisp/calc/calc-aent.el38
-rw-r--r--lisp/calc/calc-map.el6
-rw-r--r--lisp/calc/calc-rewr.el1
-rw-r--r--lisp/calc/calc-sel.el12
-rw-r--r--lisp/calc/calc.el1
-rw-r--r--lisp/calc/calcalg3.el6
-rw-r--r--lisp/cus-edit.el59
-rw-r--r--lisp/custom.el31
-rw-r--r--lisp/dired-aux.el29
-rw-r--r--lisp/dired.el1
-rw-r--r--lisp/dos-w32.el20
-rw-r--r--lisp/emacs-lisp/authors.el1
-rw-r--r--lisp/emacs-lisp/autoload.el5
-rw-r--r--lisp/emacs-lisp/find-func.el7
-rw-r--r--lisp/emulation/cua-base.el19
-rw-r--r--lisp/emulation/cua-rect.el1
-rw-r--r--lisp/files.el70
-rw-r--r--lisp/find-file.el52
-rw-r--r--lisp/frame.el4
-rw-r--r--lisp/gnus/ChangeLog89
-rw-r--r--lisp/gnus/gnus-srvr.el20
-rw-r--r--lisp/gnus/gnus-sum.el2
-rw-r--r--lisp/gnus/mm-url.el8
-rw-r--r--lisp/gnus/mm-util.el14
-rw-r--r--lisp/gnus/nnmail.el4
-rw-r--r--lisp/gnus/nnweb.el10
-rw-r--r--lisp/help-mode.el15
-rw-r--r--lisp/ibuffer.el2
-rw-r--r--lisp/image-mode.el3
-rw-r--r--lisp/international/mule-cmds.el52
-rw-r--r--lisp/mouse.el6
-rw-r--r--lisp/pgg-def.el2
-rw-r--r--lisp/progmodes/ada-mode.el82
-rw-r--r--lisp/progmodes/cc-langs.el71
-rw-r--r--lisp/progmodes/cc-mode.el9
-rw-r--r--lisp/progmodes/compile.el76
-rw-r--r--lisp/progmodes/delphi.el3
-rw-r--r--lisp/progmodes/gdb-ui.el24
-rw-r--r--lisp/progmodes/grep.el2
-rw-r--r--lisp/progmodes/idlw-shell.el2
-rw-r--r--lisp/progmodes/ld-script.el55
-rw-r--r--lisp/progmodes/sh-script.el90
-rw-r--r--lisp/progmodes/which-func.el4
-rw-r--r--lisp/replace.el4
-rw-r--r--lisp/startup.el19
-rw-r--r--lisp/subr.el48
-rw-r--r--lisp/tabify.el29
-rw-r--r--lisp/term/xterm.el20
-rw-r--r--lisp/textmodes/ispell.el10
-rw-r--r--lisp/textmodes/po.el2
-rw-r--r--lisp/textmodes/table.el6
-rw-r--r--lisp/tumme.el364
-rw-r--r--lisp/xml.el29
58 files changed, 1852 insertions, 903 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 54e81f850e7..30aee0030ba 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,393 @@
12006-07-28 Nick Roberts <nickrob@snap.net.nz>
2
3 * Makefile.in (recompile): Update comment to reflect change
4 on 2004-04-21.
5
62006-07-27 Richard Stallman <rms@gnu.org>
7
8 * cus-edit.el (customize-package-emacs-version-alist): Doc fix.
9 (customize-package-emacs-version): Change msg when pkg has no entry.
10 (custom-no-edit): On a button, do like widget-button-press.
11
122006-07-27 Dan Nicolaescu <dann@ics.uci.edu>
13
14 * term/xterm.el (terminal-init-xterm): Fix bindings for C-tab,
15 S-tab and C-S-tab.
16
172006-07-28 Nick Roberts <nickrob@snap.net.nz>
18
19 * progmodes/which-func.el (which-function): Fix documentation/
20 comment typo.
21
222006-07-26 Richard Stallman <rms@gnu.org>
23
24 * textmodes/ispell.el (ispell-word): If we replace the word,
25 move point to the end. Insert before deleting.
26
272006-07-26 Chong Yidong <cyd@stupidchicken.com>
28
29 * subr.el (sit-for): Use new SECONDS arg of read-event instead of
30 a timer.
31
322006-07-26 Mathias Dahl <mathias.dahl@gmail.com>
33
34 * tumme.el (tumme-backward-image): Add prefix argument. Add error
35 when at first image.
36 (tumme-forward-image): Add prefix argument. Add error when at last
37 image.
38
392006-07-25 Stefan Monnier <monnier@iro.umontreal.ca>
40
41 * tabify.el (tabify-regexp): Use more specific regexps.
42 (tabify): Avoid modifying the buffer unnecessarily.
43
442006-07-25 Mathias Dahl <mathias.dahl@gmail.com>
45
46 * tumme.el (tumme-track-original-file): Add `buffer-live-p' check.
47 (tumme-format-properties-string): Handle empty `buf'.
48 (tumme-get-comment): Change variable names inside `let'. Add
49 missing `let' variable that cause font-lock problems.
50 (tumme-write-comments): Change variable names inside `let'. Add
51 missing `let' variable that cause font-lock problems.
52 (tumme-forward-image): Rename from `tumme-forward-char'.
53 (tumme-backward-image): Rename from `tumme-backward-char'.
54
552006-07-25 Masatake YAMATO <jet@gyve.org>
56
57 * progmodes/ld-script.el (ld-script-keywords)
58 (ld-script-font-lock-keywords, ld-script-builtins): Update keywords
59 and add comments.
60
612006-07-25 Nick Roberts <nickrob@snap.net.nz>
62
63 * progmodes/gdb-ui.el (gdb-set-gud-minor-mode-existing-buffers)
64 (gdb-resync, gdb-prompt, gdb-starting, gdb-exited, gdb-stopped)
65 (gdb-set-gud-minor-mode-existing-buffers-1): Use different faces
66 for status indicator.
67
682006-07-24 Richard Stallman <rms@gnu.org>
69
70 * xml.el (xml-parse-file): Clean up, and use with-temp-buffer.
71
72 * subr.el (dolist, dotimes): Use interned symbols for locals.
73 (--dotimes-limit--, --dolist-tail--): New defvars.
74 (looking-back): Doc fix.
75
76 * replace.el (replace-match-string-symbols): Handle dotted lists.
77
782006-07-24 mathias <mathias@mattis>
79
80 * tumme.el (tumme-write-tags): Add.
81 (tumme-write-comments): Add.
82 (tumme-tag-files): Change to use `tumme-write-tags'.
83 (tumme-tag-thumbnail): Change to use `tumme-write-tags'.
84 (tumme-dired-comment-files): Change to use `tumme-write-comments'.
85 (tumme-save-information-from-widgets): Change to use
86 `tumme-write-comments' and `tumme-write-tags'.
87 (tumme-comment-thumbnail): Change to use `tumme-write-comments'.
88 (tumme-write-tag): Remove.
89 (tumme-write-comment): Remove.
90 (tumme-display-previous-thumbnail-original): Remove empty line.
91 (tumme-widget-list): Add punctuation.
92
932006-07-24 mathias <mathias.dahl@gmail.com>
94
95 * tumme.el (tumme-line-up): Add an extra check for end of buffer.
96
972006-07-24 Daiki Ueno <ueno@unixuser.org>
98
99 * pgg-def.el (pgg-truncate-key-identifier): Truncate the key ID to 8
100 letters from the end. Thanks to "David Smith" <davidsmith@acm.org> and
101 andreas@altroot.de (Andreas V,Av(Bgele)
102
1032006-07-23 Thien-Thi Nguyen <ttn@gnu.org>
104
105 * mouse.el (mouse-on-link-p): Doc fix.
106
1072006-07-23 Nick Roberts <nickrob@snap.net.nz>
108
109 * emacs-lisp/find-func.el (find-function-search-for-symbol):
110 Handle "C-h f `".
111
1122006-07-22 Dan Nicolaescu <dann@ics.uci.edu>
113
114 * ibuffer.el (ibuffer-formats): Use left alignment for the mode
115 column.
116
1172006-07-22 Matt Hodges <MPHodges@member.fsf.org>
118
119 * textmodes/table.el: Add move-beginning-of-line and
120 move-end-of-line to Point Motion Only Group.
121
1222006-07-22 Eric Hanchrow <offby1@blarg.net>
123
124 * progmodes/delphi.el (delphi-fill-comment): Use save-restriction.
125
1262006-07-22 Micha,Ak(Bl Cadilhac <michael.cadilhac@lrde.org>
127
128 * startup.el (user-mail-address): Initialize from the `EMAIL'
129 environment variable first. Document this.
130 (command-line): Ditto.
131
1322006-07-22 Nick Roberts <nickrob@snap.net.nz>
133
134 * help-mode.el (help-function-def, help-variable-def)
135 (help-face-def): Print a message in the minibuffer.
136
1372006-07-21 Dan Nicolaescu <dann@ics.uci.edu>
138
139 * term/xterm.el (terminal-init-xterm): Fix key bindings
140 syntax. Bind S-return, C-M-., C-TAB, S-TAB and C-S-TAB.
141
1422006-07-21 Eli Zaretskii <eliz@gnu.org>
143
144 * dos-w32.el (find-buffer-file-type-coding-system): Support calls
145 where `(nth 1 command)' is a cons cell. Doc fix.
146
147 * textmodes/po.el (po-find-charset): Doc fix.
148
1492006-07-21 Ken Manheimer <ken.manheimer@gmail.com>
150
151 * allout.el (allout-unprotected, allout-e-o-prefix-p)
152 (allout-beginning-of-current-line, allout-end-of-current-line)
153 (allout-next-visible-heading, allout-open-topic)
154 (allout-kill-topic, allout-yank-processing, allout-resolve-xref)
155 (allout-flag-current-subtree, allout-show-to-offshoot)
156 (allout-hide-current-entry, allout-show-current-branches)
157 (allout-hide-region-body, allout-old-expose-topic)
158 (allout-listify-exposed, allout-latex-verbatim-quote-curr-line)
159 (allout-mark-topic, allout-adjust-file-variable): Enclose scopes
160 containing `beginning-of-line' and `end-of-line' with
161 `inhibit-field-text-motion' t.
162
1632006-07-21 Eli Zaretskii <eliz@gnu.org>
164
165 * frame.el (focus-follows-mouse): Document that it doesn't have
166 any effect on MS-Windows.
167
1682006-07-20 Stefan Monnier <monnier@iro.umontreal.ca>
169
170 * progmodes/sh-script.el (sh-quoted-subshell): Further fix last change.
171
1722006-07-20 Jay Belanger <belanger@truman.edu>
173
174 * calc.el (calc-previous-alg-entry): Remove variable.
175
176 * calc-aent.el (calc-alg-entry-history, calc-quick-calc-history):
177 New variables.
178 (calc-alg-entry): Use `calc-alg-entry-history'.
179 (calc-do-quick-calc): Use `calc-quick-calc-history'.
180 Remove reference to `calc-previous-alg-entry'.
181 (calcAlg-edit, calcAlg-enter): Remove reference to
182 `calc-previous-alg-entry'.
183 (calcAlg-previous): Use `previous-history-element' instead of
184 `calc-previous-alg-entry'.
185 (calc-do-alg-entry): Use history when calling `read-from-minibuffer'.
186 Change keybinding for `calcAlg-plus-minus', add keybindings for
187 `previous-history-element' and `next-history-element'.
188
189 * calc-rewr.el (calc-match): Remove reference to
190 `calc-previous-alg-entry'.
191
192 * calc-sel.el (calc-selection-history): New variable.
193 (calc-enter-selection, calc-sel-mult-both-sides)
194 (calc-sel-add-both-sides): Use `calc-selection-history'.
195
196 * calc-map.el (calc-get-operator-history): New variable.
197 (calc-get-operator): Use `calc-get-operator-history'.
198
199 * calcalg3.el (calc-curve-fit-history): New variable.
200 (calc-curve-fit): Use `calc-curve-fit-history'.
201
2022006-07-20 Kenichi Handa <handa@m17n.org>
203
204 * international/mule-cmds.el (select-safe-coding-system): Fix the
205 way of deciding eol-type of the coding system.
206
2072006-07-20 Alan Mackenzie <acm@muc.de>
208
209 * progmodes/cc-langs.el (c-emacs-variable-inits): New variable.
210 (c-lang-setvar): New macro.
211 (c-make-init-lang-vars-fun): Use the initialization forms in
212 c-emacs-variable-inits in addition to those in c-lang-variable-inits.
213 (comment-start, comment-end, comment-start-skip): Change these from
214 c-lang-defvar's to c-lang-setvar's.
215
216 * progmodes/cc-mode.el (c-make-emacs-variables-local): New macro,
217 which calls make-local-variable on the elements of
218 c-emacs-variable-inits.
219 (c-init-language-vars-for): Call this new macro.
220
2212006-07-19 Stefan Monnier <monnier@iro.umontreal.ca>
222
223 * progmodes/compile.el (compilation-error-regexp-alist-alist) <gnu>:
224 Try to rule out false positives due to time stamps.
225 (compilation-mode-font-lock-keywords): Remove rules made redundant
226 because of the above change. Add `segmentation fault' to the known and
227 highlighted compilation termination messages.
228
2292006-07-19 Kim F. Storm <storm@cua.dk>
230
231 * progmodes/grep.el (grep-find-ignored-directories):
232 Add .svn and _darcs to list.
233
2342006-07-19 Mathias Dahl <mathias.dahl@gmail.com>
235
236 * dired.el (dired-mode-map): Add key binding `C-te' for
237 `tumme-dired-edit-comment-and-tags'.
238
239 * tumme.el (tumme-display-thumbnail-original-image): Make sure
240 image display buffer is displayed before call to
241 `tumme-display-image.
242 (tumme-dired-display-image): Make sure image display buffer is
243 displayed before call to `tumme-display-image.
244 (tumme-mouse-display-image): Make sure image display buffer is
245 displayed before call to `tumme-display-image.
246 (tumme-widget-list): Add.
247 (tumme-dired-edit-comment-and-tags): Add.
248 (tumme-save-information-from-widgets): Add.
249
2502006-07-19 Stefan Monnier <monnier@iro.umontreal.ca>
251
252 * progmodes/sh-script.el (sh-quoted-subshell): Fix last change.
253
2542006-07-18 Stefan Monnier <monnier@iro.umontreal.ca>
255
256 * progmodes/sh-script.el (sh-font-lock-keywords-1):
257 Revert inadvertently installed patch hunk.
258
259 * progmodes/compile.el (compilation-find-file): Handle the
260 cases where the user selects a non-existent file.
261
2622006-07-18 Stefan Monnier <monnier@iro.umontreal.ca>
263
264 * bindings.el (minibuffer-local-map): Rebind TAB so it inserts a \t.
265
2662006-07-17 Chong Yidong <cyd@stupidchicken.com>
267
268 * subr.el (sit-for): Just sleep-for if noninteractive.
269
2702006-07-17 Stefan Monnier <monnier@iro.umontreal.ca>
271
272 * emacs-lisp/autoload.el (make-autoload): Use new arg.
273
274 * custom.el (custom-autoload): Add `noset' argument.
275 (custom-push-theme): Don't autoload the variable, let callers do it.
276 (custom-theme-set-variables): Autoload the variable if necessary.
277
278 * cus-edit.el (custom-variable-state-set): If the variable was
279 originally set outside custom, but to the same value as the default,
280 consider it to be standard.
281
282 * Makefile.in (mh-loaddefs.el): Finish setting up the default empty
283 file *before* telling Emacs to add the autoloads, in case it fails.
284
285 * progmodes/sh-script.el (sh-quoted-subshell): Don't match escaped `.
286 Use `cond', push', and `dolist'.
287
2882006-07-17 Richard Stallman <rms@gnu.org>
289
290 * image-mode.el (tar-superior-buffer, archive-superior-buffer):
291 Add defvars to silence warnings.
292
2932006-07-17 Chong Yidong <cyd@stupidchicken.com>
294
295 * progmodes/compile.el (compilation-mode-font-lock-keywords):
296 Don't highlight "Compiling file" messages as error.
297
298 * dired-aux.el (dired-compress-file): Confirm again if gzipped
299 file already exists.
300
3012006-07-16 Thien-Thi Nguyen <ttn@gnu.org>
302
303 * find-file.el (ff-special-constructs): Doc fix. Also, for C/C++
304 entry, don't assign to free var; simply return the extracted filename.
305 (ff-treat-as-special): Incorporate common preamble from callers.
306 (ff-other-file-name, ff-find-the-other-file):
307 Update call to ff-treat-as-special.
308
309 * progmodes/ada-mode.el (ada-mode): Rewrite ff-special-constructs init.
310
3112006-07-16 Mathias Dahl <mathias.dahl@gmail.com>
312
313 * tumme.el (tumme-get-comment): Fix bug.
314
3152006-07-16 Stefan Monnier <monnier@iro.umontreal.ca>
316
317 * files.el: Remove spurious * in docstrings.
318
3192006-07-14 Ken Manheimer <ken.manheimer@gmail.com>
320
321 * allout.el (allout-run-unit-tests-on-load): Rectify docstring
322 grammar.
323 (allout-beginning-of-current-line): Beware beginning of buffer.
324 Also, a comment is simplified.
325 (allout-hotspot-key-handler): Only set allout-post-goto-bullet
326 when appropriate. (This fix enables use for other than
327 bullet-hotspot operation.)
328 (allout-hide-current-subtree): While escalating to sibling-close,
329 make sure to situate on a topic.
330
3312006-07-14 Kim F. Storm <storm@cua.dk>
332
333 * emulation/cua-base.el (cua-delete-selection)
334 (cua-toggle-set-mark): New defcustoms.
335 (cua-rectangle-modifier-key): Add `alt' modifier.
336 (cua-replace-region): Don't delete if cua-delete-selection is nil.
337 (cua-set-mark): Don't clear mark if cua-toggle-set-mark is nil.
338 Suggested by Klaus Zeitler <kzeitler@lucent.com>.
339
340 * emulation/cua-rect.el (cua-help-for-rectangle): Add `alt' modifier.
341
3422006-07-14 Ken Manheimer <ken.manheimer@gmail.com>
343
344 * allout.el: Require 'cl during byte-compilation/interactive load,
345 for the `assert' macro.
346 (allout-mode-deactivate-hook): New hook, run when allout mode
347 deactivates.
348 (allout-developer): New allout customization subgroup.
349 (allout-run-unit-tests-on-load): New allout-developer
350 customization variable, when true allout unit tests are run towards
351 end of file load/eval.
352 (allout-inhibit-auto-fill): Disable auto-fill activity even during
353 auto-fill-mode.
354 (allout-resumptions): Remove, to be replaced by...
355 (allout-add-resumptions): Register variable settings to be
356 reinstated by `allout-do-resumptions'. The settings are made
357 buffer-local, but the locality/globality of the suspended setting
358 is restored on resumption.
359 (allout-do-resumptions): Reinstate all settings suspended using
360 `allout-add-resumptions'.
361 (allout-test-resumptions): Unit tests (and intermediate variables)
362 for resumptions.
363 (allout-tests-globally-unbound, allout-tests-globally-true)
364 (allout-tests-locally-true): Intermediate variables for
365 resumptions unit tests.
366 (allout-overlay-preparations): Replaces `allout-set-overlay-category'.
367 (allout-exposure-category): Replaces 'allout-overlay-category variable.
368 (allout-mode): Use `allout-add-resumptions' and `allout-do-resumptions'
369 instead of retired `allout-resumptions'. For hook functions, use
370 `local' parameter so hook settings are created and removed as
371 buffer-local settings. Revise (resumptions) setting
372 auto-fill-function so it is set only if already active. (The
373 related fill-function settings are all made in either case, so
374 that activating auto-fill-mode activity will have the custom
375 allout-mode behaviors (hanging indent on topics, if configured for it).
376 Remove all allout-exposure-category overlays on mode deactivation.
377 (allout-hotspot-key-handler): New function extracted from
378 `allout-pre-command-business', so the functionality can be used
379 for other purposes, eg as a binding in an overlay.
380 (allout-pre-command-business): Use new `allout-hotspot-key-handler'.
381 (allout-auto-fill): Respect new `allout-inhibit-auto-fill'
382 customization variable.
383 (allout-run-unit-tests): Run the (currently quite small)
384 repertoire of unit tests. Called just before the provide iff user
385 has customized `allout-run-unit-tests-on-load' non-nil.
386
3872006-07-14 K,Aa(Broly L,Bu(Brentey <lorentey@elte.hu>
388
389 * emacs-lisp/authors.el (authors-aliases): Update.
390
12006-07-14 Nick Roberts <nickrob@snap.net.nz> 3912006-07-14 Nick Roberts <nickrob@snap.net.nz>
2 392
3 * progmodes/gdb-ui.el (gdb-display-buffer): Check for 393 * progmodes/gdb-ui.el (gdb-display-buffer): Check for
@@ -6,7 +396,7 @@
6 (gdb-display-breakpoints-buffer, gdb-display-stack-buffer) 396 (gdb-display-breakpoints-buffer, gdb-display-stack-buffer)
7 (gdb-display-threads-buffer, gdb-display-memory-buffer) 397 (gdb-display-threads-buffer, gdb-display-memory-buffer)
8 (gdb-display-locals-buffer): Use it. 398 (gdb-display-locals-buffer): Use it.
9 399
10 * progmodes/gud.el (gud-display-line): Use gdb-display-buffer. 400 * progmodes/gud.el (gud-display-line): Use gdb-display-buffer.
11 Set gdb-source-window. 401 Set gdb-source-window.
12 402
@@ -51,10 +441,9 @@
51 441
522006-07-12 Nick Roberts <nickrob@snap.net.nz> 4422006-07-12 Nick Roberts <nickrob@snap.net.nz>
53 443
54 * tumme.el (tumme-create-thumb) 444 * tumme.el (tumme-create-thumb, tumme-thumbnail-display-external)
55 (tumme-thumbnail-display-external, tumme-display-image) 445 (tumme-display-image, tumme-rotate-thumbnail, tumme-rotate-original)
56 (tumme-rotate-thumbnail, tumme-rotate-original) 446 (tumme-set-exif-data, tumme-get-exif-data): Use shell-command-switch.
57 (tumme-set-exif-data, tumme-get-exif-data): Use shell-command-switch.
58 447
59 * thumbs.el (thumbs-call-convert): Use shell-command-switch. 448 * thumbs.el (thumbs-call-convert): Use shell-command-switch.
60 449
@@ -90,20 +479,16 @@
90 479
912006-07-11 Nick Roberts <nickrob@snap.net.nz> 4802006-07-11 Nick Roberts <nickrob@snap.net.nz>
92 481
93 * tumme.el (tumme-create-thumb) 482 * tumme.el (tumme-create-thumb, tumme-thumbnail-display-external)
94 (tumme-thumbnail-display-external, tumme-display-image) 483 (tumme-display-image, tumme-rotate-thumbnail, tumme-rotate-original)
95 (tumme-rotate-thumbnail, tumme-rotate-original)
96 (tumme-set-exif-data, tumme-get-exif-data): Use call-process 484 (tumme-set-exif-data, tumme-get-exif-data): Use call-process
97 instead of shell-command. 485 instead of shell-command.
98 (tumme-create-thumbnail-buffer) 486 (tumme-create-thumbnail-buffer, tumme-create-display-image-buffer)
99 (tumme-create-display-image-buffer, tumme-display-thumbs) 487 (tumme-display-thumbs, tumme-modify-mark-on-thumb-original-file)
100 (tumme-modify-mark-on-thumb-original-file, tumme-display-image) 488 (tumme-display-image, tumme-get-exif-data): Use with-current-buffer.
101 (tumme-get-exif-data): Use with-current-buffer. 489 (tumme-display-properties-format, tumme-dired-insert-marked-thumbs)
102 (tumme-display-properties-format) 490 (tumme-thumbnail-set-image-description, tumme-gallery-generate)
103 (tumme-dired-insert-marked-thumbs, tumme-rotate-original) 491 (tumme-rotate-original, tumme-get-exif-file-name): Fit to 80 columns.
104 (tumme-get-exif-file-name)
105 (tumme-thumbnail-set-image-description, tumme-gallery-generate):
106 Fit to 80 columns.
107 492
1082006-07-11 Kim F. Storm <storm@cua.dk> 4932006-07-11 Kim F. Storm <storm@cua.dk>
109 494
@@ -414,8 +799,8 @@
4142006-06-25 Michael Albinus <michael.albinus@gmx.de> 7992006-06-25 Michael Albinus <michael.albinus@gmx.de>
415 800
416 * net/rcompile.el (remote-compile): Replace ange-ftp based 801 * net/rcompile.el (remote-compile): Replace ange-ftp based
417 implementation by Tramp functions. Based on a patch published by 802 implementation by Tramp functions.
418 Marc Abramowitz <msabramo@gmail.com>. 803 Suggested by Marc Abramowitz <msabramo@gmail.com>.
419 804
420 * net/tramp.el (tramp-unload-tramp): Provide a doc string. 805 * net/tramp.el (tramp-unload-tramp): Provide a doc string.
421 806
@@ -2090,8 +2475,6 @@
2090 to `ispell-local-dictionary'. 2475 to `ispell-local-dictionary'.
2091 (ispell-internal-change-dictionary): Check for a change in 2476 (ispell-internal-change-dictionary): Check for a change in
2092 personal dictionary use too. 2477 personal dictionary use too.
2093 Cosmetic changes from Agustin Martin
2094 <agustin.martin@hispalinux.es>.
2095 2478
20962006-05-05 Eli Zaretskii <eliz@gnu.org> 24792006-05-05 Eli Zaretskii <eliz@gnu.org>
2097 2480
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index e90c6161f75..f6caedcccda 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -204,9 +204,8 @@ backup-compiled-files:
204 204
205compile-after-backup: backup-compiled-files compile-always 205compile-after-backup: backup-compiled-files compile-always
206 206
207# Recompile all Lisp files which are newer than their .elc files. 207# Recompile all Lisp files which are newer than their .elc files and compile
208# Note that this doesn't create .elc files. It only recompiles if an 208# new ones.
209# .elc is present.
210 209
211recompile: doit mh-autoloads $(lisp)/progmodes/cc-mode.elc 210recompile: doit mh-autoloads $(lisp)/progmodes/cc-mode.elc
212 $(EMACS) $(EMACSOPT) --eval "(batch-byte-recompile-directory 0)" $(lisp) 211 $(EMACS) $(EMACSOPT) --eval "(batch-byte-recompile-directory 0)" $(lisp)
@@ -247,12 +246,6 @@ $(lisp)/mh-e/mh-loaddefs.el: $(MH_E_SRC)
247 echo ";;; Commentary:" >> $@ 246 echo ";;; Commentary:" >> $@
248 echo ";;; Change Log:" >> $@ 247 echo ";;; Change Log:" >> $@
249 echo ";;; Code:" >> $@ 248 echo ";;; Code:" >> $@
250 $(EMACS) $(EMACSOPT) \
251 -l autoload \
252 --eval "(setq generate-autoload-cookie \";;;###mh-autoload\")" \
253 --eval "(setq generated-autoload-file \"$(lisp)/mh-e/mh-loaddefs.el\")" \
254 --eval "(setq make-backup-files nil)" \
255 -f batch-update-autoloads $(lisp)/mh-e
256 echo " " >> $@ 249 echo " " >> $@
257 echo "(provide 'mh-loaddefs)" >> $@ 250 echo "(provide 'mh-loaddefs)" >> $@
258 echo ";; Local Variables:" >> $@ 251 echo ";; Local Variables:" >> $@
@@ -261,6 +254,12 @@ $(lisp)/mh-e/mh-loaddefs.el: $(MH_E_SRC)
261 echo ";; no-update-autoloads: t" >> $@ 254 echo ";; no-update-autoloads: t" >> $@
262 echo ";; End:" >> $@ 255 echo ";; End:" >> $@
263 echo ";;; mh-loaddefs.el ends here" >> $@ 256 echo ";;; mh-loaddefs.el ends here" >> $@
257 $(EMACS) $(EMACSOPT) \
258 -l autoload \
259 --eval "(setq generate-autoload-cookie \";;;###mh-autoload\")" \
260 --eval "(setq generated-autoload-file \"$(lisp)/mh-e/mh-loaddefs.el\")" \
261 --eval "(setq make-backup-files nil)" \
262 -f batch-update-autoloads $(lisp)/mh-e
264 263
265# Prepare a bootstrap in the lisp subdirectory. 264# Prepare a bootstrap in the lisp subdirectory.
266# 265#
diff --git a/lisp/allout.el b/lisp/allout.el
index 2fbef5b2cd8..f1f262c70b7 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -8,6 +8,7 @@
8;; Created: Dec 1991 - first release to usenet 8;; Created: Dec 1991 - first release to usenet
9;; Version: 2.2.1 9;; Version: 2.2.1
10;; Keywords: outlines wp languages 10;; Keywords: outlines wp languages
11;; Website: http://myriadicity.net/Sundry/EmacsAllout
11 12
12;; This file is part of GNU Emacs. 13;; This file is part of GNU Emacs.
13 14
@@ -58,7 +59,9 @@
58;; and more. 59;; and more.
59;; 60;;
60;; See the `allout-mode' function's docstring for an introduction to the 61;; See the `allout-mode' function's docstring for an introduction to the
61;; mode. The development version and helpful notes are available at 62;; mode.
63;;
64;; The latest development version and helpful notes are available at
62;; http://myriadicity.net/Sundry/EmacsAllout . 65;; http://myriadicity.net/Sundry/EmacsAllout .
63;; 66;;
64;; The outline menubar additions provide quick reference to many of 67;; The outline menubar additions provide quick reference to many of
@@ -80,10 +83,19 @@
80 83
81;;;_* Dependency autoloads 84;;;_* Dependency autoloads
82(require 'overlay) 85(require 'overlay)
83(eval-when-compile (progn (require 'pgg) 86(eval-when-compile
84 (require 'pgg-gpg) 87 ;; Most of the requires here are for stuff covered by autoloads.
85 (require 'overlay) 88 ;; Since just byte-compiling doesn't trigger autoloads, so that
86 )) 89 ;; "function not found" warnings would occur without these requires.
90 (progn
91 (require 'pgg)
92 (require 'pgg-gpg)
93 (require 'overlay)
94 ;; `cl' is required for `assert'. `assert' is not covered by a standard
95 ;; autoload, but it is a macro, so that eval-when-compile is sufficient
96 ;; to byte-compile it in, or to do the require when the buffer evalled.
97 (require 'cl)
98 ))
87 99
88;;;_* USER CUSTOMIZATION VARIABLES: 100;;;_* USER CUSTOMIZATION VARIABLES:
89 101
@@ -556,6 +568,25 @@ disable auto-saves for that file."
556 :group 'allout-encryption) 568 :group 'allout-encryption)
557(make-variable-buffer-local 'allout-encrypt-unencrypted-on-saves) 569(make-variable-buffer-local 'allout-encrypt-unencrypted-on-saves)
558 570
571;;;_ + Developer
572;;;_ = allout-developer group
573(defgroup allout-developer nil
574 "Settings for topic encryption features of allout outliner."
575 :group 'allout)
576;;;_ = allout-run-unit-tests-on-load
577(defcustom allout-run-unit-tests-on-load nil
578 "*When non-nil, unit tests will be run at end of loading the allout module.
579
580Generally, allout code developers are the only ones who'll want to set this.
581
582\(If set, this makes it an even better practice to exercise changes by
583doing byte-compilation with a repeat count, so the file is loaded after
584compilation.)
585
586See `allout-run-unit-tests' to see what's run."
587 :type 'boolean
588 :group 'allout-developer)
589
559;;;_ + Miscellaneous customization 590;;;_ + Miscellaneous customization
560 591
561;;;_ = allout-command-prefix 592;;;_ = allout-command-prefix
@@ -615,6 +646,23 @@ unless optional third, non-nil element is present.")
615 ("=t" allout-latexify-exposed) 646 ("=t" allout-latexify-exposed)
616 ("=p" allout-flatten-exposed-to-buffer))) 647 ("=p" allout-flatten-exposed-to-buffer)))
617 648
649;;;_ = allout-inhibit-auto-fill
650(defcustom allout-inhibit-auto-fill nil
651 "*If non-nil, auto-fill will be inhibited in the allout buffers.
652
653You can customize this setting to set it for all allout buffers, or set it
654in individual buffers if you want to inhibit auto-fill only in particular
655buffers. \(You could use a function on `allout-mode-hook' to inhibit
656auto-fill according, eg, to the major mode.\)
657
658If you don't set this and auto-fill-mode is enabled, allout will use the
659value that `normal-auto-fill-function', if any, when allout mode starts, or
660else allout's special hanging-indent maintaining auto-fill function,
661`allout-auto-fill'."
662 :type 'boolean
663 :group 'allout)
664(make-variable-buffer-local 'allout-inhibit-auto-fill)
665
618;;;_ = allout-use-hanging-indents 666;;;_ = allout-use-hanging-indents
619(defcustom allout-use-hanging-indents t 667(defcustom allout-use-hanging-indents t
620 "*If non-nil, topic body text auto-indent defaults to indent of the header. 668 "*If non-nil, topic body text auto-indent defaults to indent of the header.
@@ -993,81 +1041,84 @@ activation. Being deprecated.")
993 "----" 1041 "----"
994 ["Set Header Lead" allout-reset-header-lead t] 1042 ["Set Header Lead" allout-reset-header-lead t]
995 ["Set New Exposure" allout-expose-topic t]))) 1043 ["Set New Exposure" allout-expose-topic t])))
996;;;_ : Mode-Specific Variable Maintenance Utilities 1044;;;_ : Allout Modal-Variables Utilities
997;;;_ = allout-mode-prior-settings 1045;;;_ = allout-mode-prior-settings
998(defvar allout-mode-prior-settings nil 1046(defvar allout-mode-prior-settings nil
999 "Internal `allout-mode' use; settings to be resumed on mode deactivation.") 1047 "Internal `allout-mode' use; settings to be resumed on mode deactivation.
1000(make-variable-buffer-local 'allout-mode-prior-settings)
1001;;;_ > allout-resumptions (name &optional value)
1002(defun allout-resumptions (name &optional value)
1003
1004 "Registers or resumes settings over `allout-mode' activation/deactivation.
1005
1006First arg is NAME of variable affected. Optional second arg is list
1007containing allout-mode-specific VALUE to be imposed on named
1008variable, and to be registered. \(It's a list so you can specify
1009registrations of null values.) If no value is specified, the
1010registered value is returned (encapsulated in the list, so the caller
1011can distinguish nil vs no value), and the registration is popped
1012from the list."
1013
1014 (let ((on-list (assq name allout-mode-prior-settings))
1015 prior-capsule ; By `capsule' i mean a list
1016 ; containing a value, so we can
1017 ; distinguish nil from no value.
1018 )
1019
1020 (if value
1021
1022 ;; Registering:
1023 (progn
1024 (if on-list
1025 nil ; Already preserved prior value - don't mess with it.
1026 ;; Register the old value, or nil if previously unbound:
1027 (setq allout-mode-prior-settings
1028 (cons (list name
1029 (if (boundp name) (list (symbol-value name))))
1030 allout-mode-prior-settings)))
1031 ; And impose the new value, locally:
1032 (progn (make-local-variable name)
1033 (set name (car value))))
1034
1035 ;; Relinquishing:
1036 (if (not on-list)
1037
1038 ;; Oops, not registered - leave it be:
1039 nil
1040 1048
1041 ;; Some registration: 1049See `allout-add-resumptions' and `allout-do-resumptions'.")
1042 ; reestablish it: 1050(make-variable-buffer-local 'allout-mode-prior-settings)
1043 (setq prior-capsule (car (cdr on-list))) 1051;;;_ > allout-add-resumptions (&rest pairs)
1044 (if prior-capsule 1052(defun allout-add-resumptions (&rest pairs)
1045 (set name (car prior-capsule)) ; Some prior value - reestablish it. 1053 "Set name/value pairs.
1046 (makunbound name)) ; Previously unbound - demolish var. 1054
1047 ; Remove registration: 1055Old settings are preserved for later resumption using `allout-do-resumptions'.
1048 (let (rebuild) 1056
1049 (while allout-mode-prior-settings 1057The pairs are lists whose car is the name of the variable and car of the
1050 (if (not (eq (car allout-mode-prior-settings) 1058cdr is the new value: '(some-var some-value)'.
1051 on-list)) 1059
1052 (setq rebuild 1060The new value is set as a buffer local.
1053 (cons (car allout-mode-prior-settings) 1061
1054 rebuild))) 1062If the variable was not previously buffer-local, then that is noted and the
1055 (setq allout-mode-prior-settings 1063`allout-do-resumptions' will just `kill-local-variable' of that binding.
1056 (cdr allout-mode-prior-settings))) 1064
1057 (setq allout-mode-prior-settings rebuild))))) 1065If it previously was buffer-local, the old value is noted and resurrected
1058 ) 1066by `allout-do-resumptions'. \(If the local value was previously void, then
1067it is left as nil on resumption.\)
1068
1069The settings are stored on `allout-mode-prior-settings'."
1070 (while pairs
1071 (let* ((pair (pop pairs))
1072 (name (car pair))
1073 (value (cadr pair)))
1074 (if (not (symbolp name))
1075 (error "Pair's name, %S, must be a symbol, not %s"
1076 name (type-of name)))
1077 (when (not (assoc name allout-mode-prior-settings))
1078 ;; Not already added as a resumption, create the prior setting entry.
1079 (if (local-variable-p name)
1080 ;; is already local variable - preserve the prior value:
1081 (push (list name (condition-case err
1082 (symbol-value name)
1083 (void-variable nil)))
1084 allout-mode-prior-settings)
1085 ;; wasn't local variable, indicate so for resumption by killing
1086 ;; local value, and make it local:
1087 (push (list name) allout-mode-prior-settings)
1088 (make-local-variable name)))
1089 (set name value))))
1090;;;_ > allout-do-resumptions ()
1091(defun allout-do-resumptions ()
1092 "Resume all name/value settings registered by `allout-add-resumptions'.
1093
1094This is used when concluding allout-mode, to resume selected variables to
1095their settings before allout-mode was started."
1096
1097 (while allout-mode-prior-settings
1098 (let* ((pair (pop allout-mode-prior-settings))
1099 (name (car pair))
1100 (value-cell (cdr pair)))
1101 (if (not value-cell)
1102 ;; Prior value was global:
1103 (kill-local-variable name)
1104 ;; Prior value was explicit:
1105 (set name (car value-cell))))))
1059;;;_ : Mode-specific incidentals 1106;;;_ : Mode-specific incidentals
1060;;;_ > allout-unprotected (expr) 1107;;;_ > allout-unprotected (expr)
1061(defmacro allout-unprotected (expr) 1108(defmacro allout-unprotected (expr)
1062 "Enable internal outline operations to alter invisible text." 1109 "Enable internal outline operations to alter invisible text."
1063 `(let ((inhibit-read-only t)) 1110 `(let ((inhibit-read-only t)
1111 (inhibit-field-text-motion t))
1064 ,expr)) 1112 ,expr))
1065;;;_ = allout-mode-hook 1113;;;_ = allout-mode-hook
1066(defvar allout-mode-hook nil 1114(defvar allout-mode-hook nil
1067 "*Hook that's run when allout mode starts.") 1115 "*Hook that's run when allout mode starts.")
1068;;;_ = allout-overlay-category 1116;;;_ = allout-mode-deactivate-hook
1069(defvar allout-overlay-category nil 1117(defvar allout-mode-deactivate-hook nil
1070 "Symbol for use in allout invisible-text overlays as the category.") 1118 "*Hook that's run when allout mode ends.")
1119;;;_ = allout-exposure-category
1120(defvar allout-exposure-category nil
1121 "Symbol for use as allout invisible-text overlay category.")
1071;;;_ x allout-view-change-hook 1122;;;_ x allout-view-change-hook
1072(defvar allout-view-change-hook nil 1123(defvar allout-view-change-hook nil
1073 "*\(Deprecated\) Hook that's run after allout outline exposure changes. 1124 "*\(Deprecated\) Hook that's run after allout outline exposure changes.
@@ -1293,30 +1344,26 @@ the following two lines in your Emacs init file:
1293 (setq cur (car menus) 1344 (setq cur (car menus)
1294 menus (cdr menus)) 1345 menus (cdr menus))
1295 (easy-menu-add cur)))) 1346 (easy-menu-add cur))))
1296;;;_ > allout-set-overlay-category 1347;;;_ > allout-overlay-preparations
1297(defun allout-set-overlay-category () 1348(defun allout-overlay-preparations ()
1298 "Set the properties of the allout invisible-text overlay." 1349 "Set the properties of the allout invisible-text overlay and others."
1299 (setplist 'allout-overlay-category nil) 1350 (setplist 'allout-exposure-category nil)
1300 (put 'allout-overlay-category 'invisible 'allout) 1351 (put 'allout-exposure-category 'invisible 'allout)
1301 (put 'allout-overlay-category 'evaporate t) 1352 (put 'allout-exposure-category 'evaporate t)
1302 ;; XXX We use isearch-open-invisible *and* isearch-mode-end-hook. The 1353 ;; XXX We use isearch-open-invisible *and* isearch-mode-end-hook. The
1303 ;; latter would be sufficient, but it seems that a separate behavior - 1354 ;; latter would be sufficient, but it seems that a separate behavior -
1304 ;; the _transient_ opening of invisible text during isearch - is keyed to 1355 ;; the _transient_ opening of invisible text during isearch - is keyed to
1305 ;; presence of the isearch-open-invisible property - even though this 1356 ;; presence of the isearch-open-invisible property - even though this
1306 ;; property controls the isearch _arrival_ behavior. This is the case at 1357 ;; property controls the isearch _arrival_ behavior. This is the case at
1307 ;; least in emacs 21, 22.0, and xemacs 21.4. 1358 ;; least in emacs 21, 22.0, and xemacs 21.4.
1308 (put 'allout-overlay-category 'isearch-open-invisible 1359 (put 'allout-exposure-category 'isearch-open-invisible
1309 'allout-isearch-end-handler) 1360 'allout-isearch-end-handler)
1310 (if (featurep 'xemacs) 1361 (if (featurep 'xemacs)
1311 (put 'allout-overlay-category 'start-open t) 1362 (put 'allout-exposure-category 'start-open t)
1312 (put 'allout-overlay-category 'insert-in-front-hooks 1363 (put 'allout-exposure-category 'insert-in-front-hooks
1313 '(allout-overlay-insert-in-front-handler))) 1364 '(allout-overlay-insert-in-front-handler)))
1314 (if (featurep 'xemacs) 1365 (put 'allout-exposure-category 'modification-hooks
1315 (progn (make-variable-buffer-local 'before-change-functions) 1366 '(allout-overlay-interior-modification-handler)))
1316 (add-hook 'before-change-functions
1317 'allout-before-change-handler))
1318 (put 'allout-overlay-category 'modification-hooks
1319 '(allout-overlay-interior-modification-handler))))
1320;;;_ > allout-mode (&optional toggle) 1367;;;_ > allout-mode (&optional toggle)
1321;;;_ : Defun: 1368;;;_ : Defun:
1322;;;###autoload 1369;;;###autoload
@@ -1575,118 +1622,92 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1575 ; active state or *de*activation 1622 ; active state or *de*activation
1576 ; specifically requested: 1623 ; specifically requested:
1577 (setq allout-explicitly-deactivated t) 1624 (setq allout-explicitly-deactivated t)
1578 (if (string-match "^18\." emacs-version)
1579 ; Revoke those keys that remain
1580 ; as we set them:
1581 (let ((curr-loc (current-local-map)))
1582 (mapcar (function
1583 (lambda (cell)
1584 (if (eq (lookup-key curr-loc (car cell))
1585 (car (cdr cell)))
1586 (define-key curr-loc (car cell)
1587 (assq (car cell) allout-prior-bindings)))))
1588 allout-added-bindings)
1589 (allout-resumptions 'allout-added-bindings)
1590 (allout-resumptions 'allout-prior-bindings)))
1591 1625
1592 (if allout-old-style-prefixes 1626 (allout-do-resumptions)
1593 (progn 1627
1594 (allout-resumptions 'allout-primary-bullet)
1595 (allout-resumptions 'allout-old-style-prefixes)))
1596 ;;(allout-resumptions 'selective-display)
1597 (remove-from-invisibility-spec '(allout . t)) 1628 (remove-from-invisibility-spec '(allout . t))
1598 (set write-file-hook-var-name 1629 (remove-hook 'pre-command-hook 'allout-pre-command-business t)
1599 (delq 'allout-write-file-hook-handler 1630 (remove-hook 'post-command-hook 'allout-post-command-business t)
1600 (symbol-value write-file-hook-var-name))) 1631 (when (featurep 'xemacs)
1601 (setq auto-save-hook 1632 (remove-hook 'before-change-functions 'allout-before-change-handler t))
1602 (delq 'allout-auto-save-hook-handler 1633 (remove-hook 'isearch-mode-end-hook 'allout-isearch-end-handler t)
1603 auto-save-hook)) 1634 (remove-hook write-file-hook-var-name 'allout-write-file-hook-handler t)
1604 (allout-resumptions 'paragraph-start) 1635 (remove-hook 'auto-save-hook 'allout-auto-save-hook-handler t)
1605 (allout-resumptions 'paragraph-separate) 1636
1606 (allout-resumptions 'auto-fill-function) 1637 (remove-overlays (point-min) (point-max)
1607 (allout-resumptions 'normal-auto-fill-function) 1638 'category 'allout-exposure-category)
1608 (allout-resumptions 'allout-former-auto-filler) 1639
1640 (run-hooks 'allout-mode-deactivate-hook)
1609 (setq allout-mode nil)) 1641 (setq allout-mode nil))
1610 1642
1611 ;; Activation: 1643 ;; Activation:
1612 ((not active) 1644 ((not active)
1613 (setq allout-explicitly-deactivated nil) 1645 (setq allout-explicitly-deactivated nil)
1614 (if allout-old-style-prefixes 1646 (if allout-old-style-prefixes
1615 (progn ; Inhibit all the fancy formatting: 1647 ;; Inhibit all the fancy formatting:
1616 (allout-resumptions 'allout-primary-bullet '("*")) 1648 (allout-add-resumptions '((allout-primary-bullet "*")
1617 (allout-resumptions 'allout-old-style-prefixes '(())))) 1649 (allout-old-style-prefixes ()))))
1618 1650
1619 (allout-set-overlay-category) ; Doesn't hurt to redo this. 1651 (allout-overlay-preparations) ; Doesn't hurt to redo this.
1620 1652
1621 (allout-infer-header-lead) 1653 (allout-infer-header-lead)
1622 (allout-infer-body-reindent) 1654 (allout-infer-body-reindent)
1623 1655
1624 (set-allout-regexp) 1656 (set-allout-regexp)
1625 1657
1626 ; Produce map from current version 1658 ;; Produce map from current version of allout-keybindings-list:
1627 ; of allout-keybindings-list: 1659 (setq allout-mode-map
1628 (if (boundp 'minor-mode-map-alist) 1660 (produce-allout-mode-map allout-keybindings-list))
1629 1661 (substitute-key-definition 'beginning-of-line
1630 (progn ; V19, and maybe lucid and 1662 'move-beginning-of-line
1631 ; epoch, minor-mode key bindings: 1663 allout-mode-map global-map)
1632 (setq allout-mode-map 1664 (substitute-key-definition 'end-of-line
1633 (produce-allout-mode-map allout-keybindings-list)) 1665 'move-end-of-line
1634 (substitute-key-definition 'beginning-of-line 1666 allout-mode-map global-map)
1635 'move-beginning-of-line 1667 (produce-allout-mode-menubar-entries)
1636 allout-mode-map global-map) 1668 (fset 'allout-mode-map allout-mode-map)
1637 (substitute-key-definition 'end-of-line 1669
1638 'move-end-of-line 1670 ;; Include on minor-mode-map-alist, if not already there:
1639 allout-mode-map global-map) 1671 (if (not (member '(allout-mode . allout-mode-map)
1640 (produce-allout-mode-menubar-entries) 1672 minor-mode-map-alist))
1641 (fset 'allout-mode-map allout-mode-map) 1673 (setq minor-mode-map-alist
1642 ; Include on minor-mode-map-alist, 1674 (cons '(allout-mode . allout-mode-map)
1643 ; if not already there: 1675 minor-mode-map-alist)))
1644 (if (not (member '(allout-mode . allout-mode-map)
1645 minor-mode-map-alist))
1646 (setq minor-mode-map-alist
1647 (cons '(allout-mode . allout-mode-map)
1648 minor-mode-map-alist))))
1649
1650 ; V18 minor-mode key bindings:
1651 ; Stash record of added bindings
1652 ; for later revocation:
1653 (allout-resumptions 'allout-added-bindings
1654 (list allout-keybindings-list))
1655 (allout-resumptions 'allout-prior-bindings
1656 (list (current-local-map)))
1657 ; and add them:
1658 (use-local-map (produce-allout-mode-map allout-keybindings-list
1659 (current-local-map)))
1660 )
1661 1676
1662 (add-to-invisibility-spec '(allout . t)) 1677 (add-to-invisibility-spec '(allout . t))
1663 (make-local-variable 'line-move-ignore-invisible) 1678 (allout-add-resumptions '(line-move-ignore-invisible t))
1664 (setq line-move-ignore-invisible t) 1679 (add-hook 'pre-command-hook 'allout-pre-command-business nil t)
1665 (add-hook 'pre-command-hook 'allout-pre-command-business) 1680 (add-hook 'post-command-hook 'allout-post-command-business nil t)
1666 (add-hook 'post-command-hook 'allout-post-command-business) 1681 (when (featurep 'xemacs)
1667 (add-hook 'isearch-mode-end-hook 'allout-isearch-end-handler) 1682 (add-hook 'before-change-functions 'allout-before-change-handler
1668 (add-hook write-file-hook-var-name 'allout-write-file-hook-handler) 1683 nil t))
1669 (add-hook 'auto-save-hook 'allout-auto-save-hook-handler) 1684 (add-hook 'isearch-mode-end-hook 'allout-isearch-end-handler nil t)
1670 ; Custom auto-fill func, to support 1685 (add-hook write-file-hook-var-name 'allout-write-file-hook-handler
1671 ; respect for topic headline, 1686 nil t)
1672 ; hanging-indents, etc: 1687 (add-hook 'auto-save-hook 'allout-auto-save-hook-handler
1673 ;; Register prevailing fill func for use by allout-auto-fill: 1688 nil t)
1674 (allout-resumptions 'allout-former-auto-filler (list auto-fill-function)) 1689
1675 ;; Register allout-auto-fill to be used if filling is active: 1690 ;; Stash auto-fill settings and adjust so custom allout auto-fill
1676 (allout-resumptions 'auto-fill-function '(allout-auto-fill)) 1691 ;; func will be used if auto-fill is active or activated. (The
1677 (allout-resumptions 'allout-outside-normal-auto-fill-function 1692 ;; custom func respects topic headline, maintains hanging-indents,
1678 (list normal-auto-fill-function)) 1693 ;; etc.)
1679 (allout-resumptions 'normal-auto-fill-function '(allout-auto-fill)) 1694 (if (and auto-fill-function (not allout-inhibit-auto-fill))
1680 ;; Paragraphs are broken by topic headlines. 1695 ;; allout-auto-fill will use the stashed values and so forth.
1681 (make-local-variable 'paragraph-start) 1696 (allout-add-resumptions '(auto-fill-function allout-auto-fill)))
1682 (allout-resumptions 'paragraph-start 1697 (allout-add-resumptions (list 'allout-former-auto-filler
1683 (list (concat paragraph-start "\\|^\\(" 1698 auto-fill-function)
1684 allout-regexp "\\)"))) 1699 ;; Register allout-auto-fill to be used if
1685 (make-local-variable 'paragraph-separate) 1700 ;; filling is active:
1686 (allout-resumptions 'paragraph-separate 1701 (list 'allout-outside-normal-auto-fill-function
1687 (list (concat paragraph-separate "\\|^\\(" 1702 normal-auto-fill-function)
1688 allout-regexp "\\)"))) 1703 '(normal-auto-fill-function allout-auto-fill)
1689 1704 ;; Paragraphs are broken by topic headlines.
1705 (list 'paragraph-start
1706 (concat paragraph-start "\\|^\\("
1707 allout-regexp "\\)"))
1708 (list 'paragraph-separate
1709 (concat paragraph-separate "\\|^\\("
1710 allout-regexp "\\)")))
1690 (or (assq 'allout-mode minor-mode-alist) 1711 (or (assq 'allout-mode minor-mode-alist)
1691 (setq minor-mode-alist 1712 (setq minor-mode-alist
1692 (cons '(allout-mode " Allout") minor-mode-alist))) 1713 (cons '(allout-mode " Allout") minor-mode-alist)))
@@ -1702,8 +1723,9 @@ OPEN: A topic that is not closed, though its offspring or body may be."
1702 ;; Reactivation: 1723 ;; Reactivation:
1703 ((setq do-layout t) 1724 ((setq do-layout t)
1704 (allout-infer-body-reindent)) 1725 (allout-infer-body-reindent))
1705 ) ; cond 1726 ) ;; end of activation-mode cases.
1706 1727
1728 ;; Do auto layout if warranted:
1707 (let ((use-layout (if (listp allout-layout) 1729 (let ((use-layout (if (listp allout-layout)
1708 allout-layout 1730 allout-layout
1709 allout-default-layout))) 1731 allout-default-layout)))
@@ -1802,9 +1824,14 @@ See allout-overlay-interior-modification-handler for details.
1802 1824
1803This before-change handler is used only where modification-hooks 1825This before-change handler is used only where modification-hooks
1804overlay property is not supported." 1826overlay property is not supported."
1805 (if (not (allout-mode-p)) 1827 ;; allout-overlay-interior-modification-handler on an overlay handles
1806 nil 1828 ;; this in other emacs, via `allout-exposure-category's 'modification-hooks.
1807 (allout-overlay-interior-modification-handler nil nil beg end nil))) 1829 (when (and (featurep 'xemacs) (allout-mode-p))
1830 ;; process all of the pending overlays:
1831 (dolist (overlay (overlays-in beg end))
1832 (if (eq (overlay-get ol 'invisible) 'allout)
1833 (allout-overlay-interior-modification-handler
1834 overlay nil beg end nil)))))
1808;;;_ > allout-isearch-end-handler (&optional overlay) 1835;;;_ > allout-isearch-end-handler (&optional overlay)
1809(defun allout-isearch-end-handler (&optional overlay) 1836(defun allout-isearch-end-handler (&optional overlay)
1810 "Reconcile allout outline exposure on arriving in hidden text after isearch. 1837 "Reconcile allout outline exposure on arriving in hidden text after isearch.
@@ -1894,7 +1921,8 @@ Actually, returns prefix beginning point."
1894;;;_ > allout-e-o-prefix-p () 1921;;;_ > allout-e-o-prefix-p ()
1895(defun allout-e-o-prefix-p () 1922(defun allout-e-o-prefix-p ()
1896 "True if point is located where current topic prefix ends, heading begins." 1923 "True if point is located where current topic prefix ends, heading begins."
1897 (and (save-excursion (beginning-of-line) 1924 (and (save-excursion (let ((inhibit-field-text-motion t))
1925 (beginning-of-line))
1898 (looking-at allout-regexp)) 1926 (looking-at allout-regexp))
1899 (= (point)(save-excursion (allout-end-of-prefix)(point))))) 1927 (= (point)(save-excursion (allout-end-of-prefix)(point)))))
1900;;;_ : Location attributes 1928;;;_ : Location attributes
@@ -1996,34 +2024,34 @@ Outermost is first."
1996(defun allout-beginning-of-current-line () 2024(defun allout-beginning-of-current-line ()
1997 "Like beginning of line, but to visible text." 2025 "Like beginning of line, but to visible text."
1998 2026
1999 ;; XXX We would use `(move-beginning-of-line 1)', but it gets 2027 ;; This combination of move-beginning-of-line and beginning-of-line is
2000 ;; stuck on some hidden newlines, eg at column 80, as of GNU Emacs 22.0.50. 2028 ;; deliberate, but the (beginning-of-line) may now be superfluous.
2001 ;; Conversely, `beginning-of-line' can make no progress in other 2029 (let ((inhibit-field-text-motion t))
2002 ;; situations. Both are necessary, in the order used below. 2030 (move-beginning-of-line 1)
2003 (move-beginning-of-line 1)
2004 (beginning-of-line)
2005 (while (or (not (bolp)) (allout-hidden-p))
2006 (beginning-of-line) 2031 (beginning-of-line)
2007 (if (or (allout-hidden-p) (not (bolp))) 2032 (while (and (not (bobp)) (or (not (bolp)) (allout-hidden-p)))
2008 (forward-char -1)))) 2033 (beginning-of-line)
2034 (if (or (allout-hidden-p) (not (bolp)))
2035 (forward-char -1)))))
2009;;;_ > allout-end-of-current-line () 2036;;;_ > allout-end-of-current-line ()
2010(defun allout-end-of-current-line () 2037(defun allout-end-of-current-line ()
2011 "Move to the end of line, past concealed text if any." 2038 "Move to the end of line, past concealed text if any."
2012 ;; XXX This is for symmetry with `allout-beginning-of-current-line' - 2039 ;; XXX This is for symmetry with `allout-beginning-of-current-line' -
2013 ;; `move-end-of-line' doesn't suffer the same problem as 2040 ;; `move-end-of-line' doesn't suffer the same problem as
2014 ;; `move-beginning-of-line'. 2041 ;; `move-beginning-of-line'.
2015 (end-of-line) 2042 (let ((inhibit-field-text-motion t))
2016 (while (allout-hidden-p)
2017 (end-of-line) 2043 (end-of-line)
2018 (if (allout-hidden-p) (forward-char 1)))) 2044 (while (allout-hidden-p)
2045 (end-of-line)
2046 (if (allout-hidden-p) (forward-char 1)))))
2019;;;_ > allout-next-heading () 2047;;;_ > allout-next-heading ()
2020(defsubst allout-next-heading () 2048(defsubst allout-next-heading ()
2021 "Move to the heading for the topic \(possibly invisible) before this one. 2049 "Move to the heading for the topic \(possibly invisible) after this one.
2022 2050
2023Returns the location of the heading, or nil if none found." 2051Returns the location of the heading, or nil if none found."
2024 2052
2025 (if (and (bobp) (not (eobp))) 2053 (if (and (bobp) (not (eobp)) (looking-at allout-regexp))
2026 (forward-char 1)) 2054 (forward-char 1))
2027 2055
2028 (if (re-search-forward allout-line-boundary-regexp nil 0) 2056 (if (re-search-forward allout-line-boundary-regexp nil 0)
2029 (allout-prefix-data ; Got valid location state - set vars: 2057 (allout-prefix-data ; Got valid location state - set vars:
@@ -2553,7 +2581,8 @@ Presumes point is at the start of a topic prefix."
2553Move to buffer limit in indicated direction if headings are exhausted." 2581Move to buffer limit in indicated direction if headings are exhausted."
2554 2582
2555 (interactive "p") 2583 (interactive "p")
2556 (let* ((backward (if (< arg 0) (setq arg (* -1 arg)))) 2584 (let* ((inhibit-field-text-motion t)
2585 (backward (if (< arg 0) (setq arg (* -1 arg))))
2557 (step (if backward -1 1)) 2586 (step (if backward -1 1))
2558 prev got) 2587 prev got)
2559 2588
@@ -2688,36 +2717,51 @@ return to regular interpretation of self-insert characters."
2688 2717
2689 (if (not (allout-mode-p)) 2718 (if (not (allout-mode-p))
2690 nil 2719 nil
2691 ;; Hot-spot navigation provisions:
2692 (if (and (eq this-command 'self-insert-command) 2720 (if (and (eq this-command 'self-insert-command)
2693 (eq (point)(allout-current-bullet-pos))) 2721 (eq (point)(allout-current-bullet-pos)))
2694 (let* ((this-key-num (cond 2722 (allout-hotspot-key-handler))))
2695 ((numberp last-command-char) 2723;;;_ > allout-hotspot-key-handler ()
2696 last-command-char) 2724(defun allout-hotspot-key-handler ()
2697 ;; Only xemacs has characterp. 2725 "Catchall handling of key bindings in hot-spots.
2698 ((and (fboundp 'characterp) 2726
2699 (apply 'characterp 2727Translates unmodified keystrokes to corresponding allout commands, when
2700 (list last-command-char))) 2728they would qualify if prefixed with the allout-command-prefix, and sets
2701 (apply 'char-to-int (list last-command-char))) 2729this-command accordingly.
2702 (t 0))) 2730
2703 mapped-binding) 2731Returns the qualifying command, if any, else nil."
2704 (if (zerop this-key-num) 2732 (interactive)
2705 nil 2733 (let* ((key-num (cond ((numberp last-command-char) last-command-char)
2706 ; Map upper-register literals 2734 ;; for XEmacs character type:
2707 ; to lower register: 2735 ((and (fboundp 'characterp)
2708 (if (<= 96 this-key-num) 2736 (apply 'characterp (list last-command-char)))
2709 (setq this-key-num (- this-key-num 32))) 2737 (apply 'char-to-int (list last-command-char)))
2710 ; Check if we have a literal: 2738 (t 0)))
2711 (if (and (<= 64 this-key-num) 2739 mapped-binding
2712 (>= 96 this-key-num)) 2740 (on-bullet (eq (point) (allout-current-bullet-pos))))
2713 (setq mapped-binding 2741
2714 (lookup-key 'allout-mode-map 2742 (if (zerop key-num)
2715 (concat allout-command-prefix 2743 nil
2716 (char-to-string (- this-key-num 2744
2717 64)))))) 2745 (if (and (<= 33 key-num)
2718 (if mapped-binding 2746 (setq mapped-binding
2719 (setq allout-post-goto-bullet t 2747 (key-binding (concat allout-command-prefix
2720 this-command mapped-binding))))))) 2748 (char-to-string
2749 (if (and (<= 97 key-num) ; "a"
2750 (>= 122 key-num)) ; "z"
2751 (- key-num 96) key-num)))
2752 t)))
2753 ;; Qualified with the allout prefix - do hot-spot operation.
2754 (setq allout-post-goto-bullet t)
2755 ;; accept-defaults nil, or else we'll get allout-item-icon-key-handler.
2756 (setq mapped-binding (key-binding (char-to-string key-num))))
2757
2758 (while (keymapp mapped-binding)
2759 (setq mapped-binding
2760 (lookup-key mapped-binding (read-key-sequence-vector nil t))))
2761
2762 (if mapped-binding
2763 (setq this-command mapped-binding)))))
2764
2721;;;_ > allout-find-file-hook () 2765;;;_ > allout-find-file-hook ()
2722(defun allout-find-file-hook () 2766(defun allout-find-file-hook ()
2723 "Activate `allout-mode' on non-nil `allout-auto-activation', `allout-layout'. 2767 "Activate `allout-mode' on non-nil `allout-auto-activation', `allout-layout'.
@@ -2969,7 +3013,8 @@ Nuances:
2969 from there." 3013 from there."
2970 3014
2971 (allout-beginning-of-current-line) 3015 (allout-beginning-of-current-line)
2972 (let* ((depth (+ (allout-current-depth) relative-depth)) 3016 (let* ((inhibit-field-text-motion t)
3017 (depth (+ (allout-current-depth) relative-depth))
2973 (opening-on-blank (if (looking-at "^\$") 3018 (opening-on-blank (if (looking-at "^\$")
2974 (not (setq before nil)))) 3019 (not (setq before nil))))
2975 ;; bunch o vars set while computing ref-topic 3020 ;; bunch o vars set while computing ref-topic
@@ -3146,21 +3191,23 @@ topic prior to the current one."
3146 3191
3147Maintains outline hanging topic indentation if 3192Maintains outline hanging topic indentation if
3148`allout-use-hanging-indents' is set." 3193`allout-use-hanging-indents' is set."
3149 (let ((fill-prefix (if allout-use-hanging-indents 3194
3150 ;; Check for topic header indentation: 3195 (when (not allout-inhibit-auto-fill)
3151 (save-excursion 3196 (let ((fill-prefix (if allout-use-hanging-indents
3152 (beginning-of-line) 3197 ;; Check for topic header indentation:
3153 (if (looking-at allout-regexp) 3198 (save-excursion
3154 ;; ... construct indentation to account for 3199 (beginning-of-line)
3155 ;; length of topic prefix: 3200 (if (looking-at allout-regexp)
3156 (make-string (progn (allout-end-of-prefix) 3201 ;; ... construct indentation to account for
3157 (current-column)) 3202 ;; length of topic prefix:
3158 ?\ ))))) 3203 (make-string (progn (allout-end-of-prefix)
3159 (use-auto-fill-function (or allout-outside-normal-auto-fill-function 3204 (current-column))
3160 auto-fill-function 3205 ?\ )))))
3161 'do-auto-fill))) 3206 (use-auto-fill-function (or allout-outside-normal-auto-fill-function
3162 (if (or allout-former-auto-filler allout-use-hanging-indents) 3207 auto-fill-function
3163 (funcall use-auto-fill-function)))) 3208 'do-auto-fill)))
3209 (if (or allout-former-auto-filler allout-use-hanging-indents)
3210 (funcall use-auto-fill-function)))))
3164;;;_ > allout-reindent-body (old-depth new-depth &optional number) 3211;;;_ > allout-reindent-body (old-depth new-depth &optional number)
3165(defun allout-reindent-body (old-depth new-depth &optional number) 3212(defun allout-reindent-body (old-depth new-depth &optional number)
3166 "Reindent body lines which were indented at OLD-DEPTH to NEW-DEPTH. 3213 "Reindent body lines which were indented at OLD-DEPTH to NEW-DEPTH.
@@ -3585,7 +3632,8 @@ when yank with allout-yank into an outline as a heading."
3585 ;; a lag *after* a kill has been performed. 3632 ;; a lag *after* a kill has been performed.
3586 3633
3587 (interactive) 3634 (interactive)
3588 (let* ((collapsed (allout-current-topic-collapsed-p)) 3635 (let* ((inhibit-field-text-motion t)
3636 (collapsed (allout-current-topic-collapsed-p))
3589 (beg (prog1 (allout-back-to-current-heading) (beginning-of-line))) 3637 (beg (prog1 (allout-back-to-current-heading) (beginning-of-line)))
3590 (depth (allout-recent-depth))) 3638 (depth (allout-recent-depth)))
3591 (allout-end-of-current-subtree) 3639 (allout-end-of-current-subtree)
@@ -3601,8 +3649,10 @@ when yank with allout-yank into an outline as a heading."
3601 (forward-char 1))) 3649 (forward-char 1)))
3602 3650
3603 (if collapsed 3651 (if collapsed
3604 (put-text-property beg (1+ beg) 'allout-was-collapsed t) 3652 (allout-unprotected
3605 (remove-text-properties beg (1+ beg) '(allout-was-collapsed t))) 3653 (put-text-property beg (1+ beg) 'allout-was-collapsed t))
3654 (allout-unprotected
3655 (remove-text-properties beg (1+ beg) '(allout-was-collapsed t))))
3606 (allout-unprotected (kill-region beg (point))) 3656 (allout-unprotected (kill-region beg (point)))
3607 (sit-for 0) 3657 (sit-for 0)
3608 (save-excursion 3658 (save-excursion
@@ -3633,7 +3683,8 @@ however, are left exactly like normal, non-allout-specific yanks."
3633 ; region around subject: 3683 ; region around subject:
3634 (if (< (allout-mark-marker t) (point)) 3684 (if (< (allout-mark-marker t) (point))
3635 (exchange-point-and-mark)) 3685 (exchange-point-and-mark))
3636 (let* ((subj-beg (point)) 3686 (let* ((inhibit-field-text-motion t)
3687 (subj-beg (point))
3637 (into-bol (bolp)) 3688 (into-bol (bolp))
3638 (subj-end (allout-mark-marker t)) 3689 (subj-end (allout-mark-marker t))
3639 (was-collapsed (get-text-property subj-beg 'allout-was-collapsed)) 3690 (was-collapsed (get-text-property subj-beg 'allout-was-collapsed))
@@ -3802,7 +3853,8 @@ by pops to non-distinctive yanks. Bug..."
3802 (if (not (string= (allout-current-bullet) allout-file-xref-bullet)) 3853 (if (not (string= (allout-current-bullet) allout-file-xref-bullet))
3803 (error "Current heading lacks cross-reference bullet `%s'" 3854 (error "Current heading lacks cross-reference bullet `%s'"
3804 allout-file-xref-bullet) 3855 allout-file-xref-bullet)
3805 (let (file-name) 3856 (let ((inhibit-field-text-motion t)
3857 file-name)
3806 (save-excursion 3858 (save-excursion
3807 (let* ((text-start allout-recent-prefix-end) 3859 (let* ((text-start allout-recent-prefix-end)
3808 (heading-end (progn (end-of-line) (point)))) 3860 (heading-end (progn (end-of-line) (point))))
@@ -3834,12 +3886,12 @@ by pops to non-distinctive yanks. Bug..."
3834 3886
3835Text is shown if flag is nil and hidden otherwise." 3887Text is shown if flag is nil and hidden otherwise."
3836 ;; We use outline invisibility spec. 3888 ;; We use outline invisibility spec.
3837 (remove-overlays from to 'category 'allout-overlay-category) 3889 (remove-overlays from to 'category 'allout-exposure-category)
3838 (when flag 3890 (when flag
3839 (let ((o (make-overlay from to))) 3891 (let ((o (make-overlay from to)))
3840 (overlay-put o 'category 'allout-overlay-category) 3892 (overlay-put o 'category 'allout-exposure-category)
3841 (when (featurep 'xemacs) 3893 (when (featurep 'xemacs)
3842 (let ((props (symbol-plist 'allout-overlay-category))) 3894 (let ((props (symbol-plist 'allout-exposure-category)))
3843 (while props 3895 (while props
3844 (overlay-put o (pop props) (pop props))))))) 3896 (overlay-put o (pop props) (pop props)))))))
3845 (run-hooks 'allout-view-change-hook) 3897 (run-hooks 'allout-view-change-hook)
@@ -3850,7 +3902,8 @@ Text is shown if flag is nil and hidden otherwise."
3850 3902
3851 (save-excursion 3903 (save-excursion
3852 (allout-back-to-current-heading) 3904 (allout-back-to-current-heading)
3853 (end-of-line) 3905 (let ((inhibit-field-text-motion t))
3906 (end-of-line))
3854 (allout-flag-region (point) 3907 (allout-flag-region (point)
3855 ;; Exposing must not leave trailing blanks hidden, 3908 ;; Exposing must not leave trailing blanks hidden,
3856 ;; but can leave them exposed when hiding, so we 3909 ;; but can leave them exposed when hiding, so we
@@ -3860,9 +3913,9 @@ Text is shown if flag is nil and hidden otherwise."
3860 flag))) 3913 flag)))
3861 3914
3862;;;_ - Topic-specific 3915;;;_ - Topic-specific
3863;;;_ > allout-show-entry (&optional inclusive) 3916;;;_ > allout-show-entry ()
3864(defun allout-show-entry (&optional inclusive) 3917(defun allout-show-entry ()
3865 "Like `allout-show-current-entry', reveals entries nested in hidden topics. 3918 "Like `allout-show-current-entry', but reveals entries in hidden topics.
3866 3919
3867This is a way to give restricted peek at a concealed locality without the 3920This is a way to give restricted peek at a concealed locality without the
3868expense of exposing its context, but can leave the outline with aberrant 3921expense of exposing its context, but can leave the outline with aberrant
@@ -3939,7 +3992,8 @@ point of non-opened subtree?)"
3939Useful for coherently exposing to a random point in a hidden region." 3992Useful for coherently exposing to a random point in a hidden region."
3940 (interactive) 3993 (interactive)
3941 (save-excursion 3994 (save-excursion
3942 (let ((orig-pt (point)) 3995 (let ((inhibit-field-text-motion t)
3996 (orig-pt (point))
3943 (orig-pref (allout-goto-prefix)) 3997 (orig-pref (allout-goto-prefix))
3944 (last-at (point)) 3998 (last-at (point))
3945 bag-it) 3999 bag-it)
@@ -3971,13 +4025,13 @@ Useful for coherently exposing to a random point in a hidden region."
3971 (interactive) 4025 (interactive)
3972 (allout-back-to-current-heading) 4026 (allout-back-to-current-heading)
3973 (save-excursion 4027 (save-excursion
3974 (end-of-line) 4028 (let ((inhibit-field-text-motion t))
4029 (end-of-line))
3975 (allout-flag-region (point) 4030 (allout-flag-region (point)
3976 (progn (allout-end-of-entry) (point)) 4031 (progn (allout-end-of-entry) (point))
3977 t))) 4032 t)))
3978;;;_ > allout-show-current-entry (&optional arg) 4033;;;_ > allout-show-current-entry (&optional arg)
3979(defun allout-show-current-entry (&optional arg) 4034(defun allout-show-current-entry (&optional arg)
3980
3981 "Show body following current heading, or hide entry with universal argument." 4035 "Show body following current heading, or hide entry with universal argument."
3982 4036
3983 (interactive "P") 4037 (interactive "P")
@@ -4042,6 +4096,7 @@ siblings, even if the target topic is already closed."
4042 ((allout-up-current-level 1 t) (allout-hide-current-subtree)) 4096 ((allout-up-current-level 1 t) (allout-hide-current-subtree))
4043 (t (goto-char 0) 4097 (t (goto-char 0)
4044 (message sibs-msg) 4098 (message sibs-msg)
4099 (allout-goto-prefix)
4045 (allout-expose-topic '(0 :)) 4100 (allout-expose-topic '(0 :))
4046 (message (concat sibs-msg " Done.")))) 4101 (message (concat sibs-msg " Done."))))
4047 (goto-char from))) 4102 (goto-char from)))
@@ -4049,7 +4104,8 @@ siblings, even if the target topic is already closed."
4049(defun allout-show-current-branches () 4104(defun allout-show-current-branches ()
4050 "Show all subheadings of this heading, but not their bodies." 4105 "Show all subheadings of this heading, but not their bodies."
4051 (interactive) 4106 (interactive)
4052 (beginning-of-line) 4107 (let ((inhibit-field-text-motion t))
4108 (beginning-of-line))
4053 (allout-show-children t)) 4109 (allout-show-children t))
4054;;;_ > allout-hide-current-leaves () 4110;;;_ > allout-hide-current-leaves ()
4055(defun allout-hide-current-leaves () 4111(defun allout-hide-current-leaves ()
@@ -4079,13 +4135,14 @@ siblings, even if the target topic is already closed."
4079 (save-restriction 4135 (save-restriction
4080 (narrow-to-region start end) 4136 (narrow-to-region start end)
4081 (goto-char (point-min)) 4137 (goto-char (point-min))
4082 (while (not (eobp)) 4138 (let ((inhibit-field-text-motion t))
4083 (end-of-line) 4139 (while (not (eobp))
4084 (allout-flag-region (point) (allout-end-of-entry) t) 4140 (end-of-line)
4085 (if (not (eobp)) 4141 (allout-flag-region (point) (allout-end-of-entry) t)
4086 (forward-char 4142 (if (not (eobp))
4087 (if (looking-at "\n\n") 4143 (forward-char
4088 2 1))))))) 4144 (if (looking-at "\n\n")
4145 2 1))))))))
4089 4146
4090;;;_ > allout-expose-topic (spec) 4147;;;_ > allout-expose-topic (spec)
4091(defun allout-expose-topic (spec) 4148(defun allout-expose-topic (spec)
@@ -4238,7 +4295,8 @@ for the corresponding offspring of the topic.
4238Optional FOLLOWERS arguments dictate exposure for succeeding siblings." 4295Optional FOLLOWERS arguments dictate exposure for succeeding siblings."
4239 4296
4240 (interactive "xExposure spec: ") 4297 (interactive "xExposure spec: ")
4241 (let ((depth (allout-current-depth)) 4298 (let ((inhibit-field-text-motion t)
4299 (depth (allout-current-depth))
4242 max-pos) 4300 max-pos)
4243 (cond ((null spec) nil) 4301 (cond ((null spec) nil)
4244 ((symbolp spec) 4302 ((symbolp spec)
@@ -4417,8 +4475,9 @@ header and body. The elements of that list are:
4417 (interactive "r") 4475 (interactive "r")
4418 (save-excursion 4476 (save-excursion
4419 (let* 4477 (let*
4420 ;; state vars: 4478 ((inhibit-field-text-motion t)
4421 (strings prefix result depth new-depth out gone-out bullet beg 4479 ;; state vars:
4480 strings prefix result depth new-depth out gone-out bullet beg
4422 next done) 4481 next done)
4423 4482
4424 (goto-char start) 4483 (goto-char start)
@@ -4697,18 +4756,19 @@ string across LaTeX processing."
4697Adjust line contents so it is unaltered \(from the original line) 4756Adjust line contents so it is unaltered \(from the original line)
4698across LaTeX processing, within the context of a `verbatim' 4757across LaTeX processing, within the context of a `verbatim'
4699environment. Leaves point at the end of the line." 4758environment. Leaves point at the end of the line."
4700 (beginning-of-line) 4759 (let ((inhibit-field-text-motion t))
4701 (let ((beg (point)) 4760 (beginning-of-line)
4702 (end (progn (end-of-line)(point)))) 4761 (let ((beg (point))
4703 (goto-char beg) 4762 (end (progn (end-of-line)(point))))
4704 (while (re-search-forward "\\\\" 4763 (goto-char beg)
4705 ;;"\\\\\\|\\{\\|\\}\\|\\_\\|\\$\\|\\\"\\|\\&\\|\\^\\|\\-\\|\\*\\|#" 4764 (while (re-search-forward "\\\\"
4706 end ; bounded by end-of-line 4765 ;;"\\\\\\|\\{\\|\\}\\|\\_\\|\\$\\|\\\"\\|\\&\\|\\^\\|\\-\\|\\*\\|#"
4707 1) ; no matches, move to end & return nil 4766 end ; bounded by end-of-line
4708 (goto-char (match-beginning 0)) 4767 1) ; no matches, move to end & return nil
4709 (insert "\\") 4768 (goto-char (match-beginning 0))
4710 (setq end (1+ end)) 4769 (insert "\\")
4711 (goto-char (1+ (match-end 0)))))) 4770 (setq end (1+ end))
4771 (goto-char (1+ (match-end 0)))))))
4712;;;_ > allout-insert-latex-header (buffer) 4772;;;_ > allout-insert-latex-header (buffer)
4713(defun allout-insert-latex-header (buffer) 4773(defun allout-insert-latex-header (buffer)
4714 "Insert initial LaTeX commands at point in BUFFER." 4774 "Insert initial LaTeX commands at point in BUFFER."
@@ -5556,7 +5616,8 @@ save. See `allout-encrypt-unencrypted-on-saves' for more info."
5556(defun allout-mark-topic () 5616(defun allout-mark-topic ()
5557 "Put the region around topic currently containing point." 5617 "Put the region around topic currently containing point."
5558 (interactive) 5618 (interactive)
5559 (beginning-of-line) 5619 (let ((inhibit-field-text-motion t))
5620 (beginning-of-line))
5560 (allout-goto-prefix) 5621 (allout-goto-prefix)
5561 (push-mark (point)) 5622 (push-mark (point))
5562 (allout-end-of-current-subtree) 5623 (allout-end-of-current-subtree)
@@ -5631,7 +5692,8 @@ enable-local-variables must be true for any of this to happen."
5631 allout-enable-file-variable-adjustment)) 5692 allout-enable-file-variable-adjustment))
5632 nil 5693 nil
5633 (save-excursion 5694 (save-excursion
5634 (let ((section-data (allout-file-vars-section-data)) 5695 (let ((inhibit-field-text-motion t)
5696 (section-data (allout-file-vars-section-data))
5635 beg prefix suffix) 5697 beg prefix suffix)
5636 (if section-data 5698 (if section-data
5637 (setq beg (car section-data) 5699 (setq beg (car section-data)
@@ -5919,7 +5981,131 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
5919 (isearch-repeat 'forward) 5981 (isearch-repeat 'forward)
5920 (isearch-mode t))) 5982 (isearch-mode t)))
5921 5983
5922;;;_ #11 Provide 5984;;;_ #11 Unit tests - this should be last item before "Provide"
5985;;;_ > allout-run-unit-tests ()
5986(defun allout-run-unit-tests ()
5987 "Run the various allout unit tests."
5988 (message "Running allout tests...")
5989 (allout-test-resumptions)
5990 (message "Running allout tests... Done.")
5991 (sit-for .5))
5992;;;_ : test resumptions:
5993;;;_ > allout-tests-obliterate-variable (name)
5994(defun allout-tests-obliterate-variable (name)
5995 "Completely unbind variable with NAME."
5996 (if (local-variable-p name) (kill-local-variable name))
5997 (while (boundp name) (makunbound name)))
5998;;;_ > allout-test-resumptions ()
5999(defvar allout-tests-globally-unbound nil
6000 "Fodder for allout resumptions tests - defvar just for byte compiler.")
6001(defvar allout-tests-globally-true nil
6002 "Fodder for allout resumptions tests - defvar just just for byte compiler.")
6003(defvar allout-tests-locally-true nil
6004 "Fodder for allout resumptions tests - defvar just for byte compiler.")
6005(defun allout-test-resumptions ()
6006 "Exercise allout resumptions."
6007 ;; for each resumption case, we also test that the right local/global
6008 ;; scopes are affected during resumption effects:
6009
6010 ;; ensure that previously unbound variables return to the unbound state.
6011 (with-temp-buffer
6012 (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
6013 (allout-add-resumptions '(allout-tests-globally-unbound t))
6014 (assert (not (default-boundp 'allout-tests-globally-unbound)))
6015 (assert (local-variable-p 'allout-tests-globally-unbound))
6016 (assert (boundp 'allout-tests-globally-unbound))
6017 (assert (equal allout-tests-globally-unbound t))
6018 (allout-do-resumptions)
6019 (assert (not (local-variable-p 'allout-tests-globally-unbound)))
6020 (assert (not (boundp 'allout-tests-globally-unbound))))
6021
6022 ;; ensure that variable with prior global value is resumed
6023 (with-temp-buffer
6024 (allout-tests-obliterate-variable 'allout-tests-globally-true)
6025 (setq allout-tests-globally-true t)
6026 (allout-add-resumptions '(allout-tests-globally-true nil))
6027 (assert (equal (default-value 'allout-tests-globally-true) t))
6028 (assert (local-variable-p 'allout-tests-globally-true))
6029 (assert (equal allout-tests-globally-true nil))
6030 (allout-do-resumptions)
6031 (assert (not (local-variable-p 'allout-tests-globally-true)))
6032 (assert (boundp 'allout-tests-globally-true))
6033 (assert (equal allout-tests-globally-true t)))
6034
6035 ;; ensure that prior local value is resumed
6036 (with-temp-buffer
6037 (allout-tests-obliterate-variable 'allout-tests-locally-true)
6038 (set (make-local-variable 'allout-tests-locally-true) t)
6039 (assert (not (default-boundp 'allout-tests-locally-true))
6040 nil (concat "Test setup mistake - variable supposed to"
6041 " not have global binding, but it does."))
6042 (assert (local-variable-p 'allout-tests-locally-true)
6043 nil (concat "Test setup mistake - variable supposed to have"
6044 " local binding, but it lacks one."))
6045 (allout-add-resumptions '(allout-tests-locally-true nil))
6046 (assert (not (default-boundp 'allout-tests-locally-true)))
6047 (assert (local-variable-p 'allout-tests-locally-true))
6048 (assert (equal allout-tests-locally-true nil))
6049 (allout-do-resumptions)
6050 (assert (boundp 'allout-tests-locally-true))
6051 (assert (local-variable-p 'allout-tests-locally-true))
6052 (assert (equal allout-tests-locally-true t))
6053 (assert (not (default-boundp 'allout-tests-locally-true))))
6054
6055 ;; ensure that last of multiple resumptions holds, for various scopes.
6056 (with-temp-buffer
6057 (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
6058 (allout-tests-obliterate-variable 'allout-tests-globally-true)
6059 (setq allout-tests-globally-true t)
6060 (allout-tests-obliterate-variable 'allout-tests-locally-true)
6061 (set (make-local-variable 'allout-tests-locally-true) t)
6062 (allout-add-resumptions '(allout-tests-globally-unbound t)
6063 '(allout-tests-globally-true nil)
6064 '(allout-tests-locally-true nil))
6065 (allout-add-resumptions '(allout-tests-globally-unbound 2)
6066 '(allout-tests-globally-true 3)
6067 '(allout-tests-locally-true 4))
6068 ;; reestablish many of the basic conditions are maintained after re-add:
6069 (assert (not (default-boundp 'allout-tests-globally-unbound)))
6070 (assert (local-variable-p 'allout-tests-globally-unbound))
6071 (assert (equal allout-tests-globally-unbound 2))
6072 (assert (default-boundp 'allout-tests-globally-true))
6073 (assert (local-variable-p 'allout-tests-globally-true))
6074 (assert (equal allout-tests-globally-true 3))
6075 (assert (not (default-boundp 'allout-tests-locally-true)))
6076 (assert (local-variable-p 'allout-tests-locally-true))
6077 (assert (equal allout-tests-locally-true 4))
6078 (allout-do-resumptions)
6079 (assert (not (local-variable-p 'allout-tests-globally-unbound)))
6080 (assert (not (boundp 'allout-tests-globally-unbound)))
6081 (assert (not (local-variable-p 'allout-tests-globally-true)))
6082 (assert (boundp 'allout-tests-globally-true))
6083 (assert (equal allout-tests-globally-true t))
6084 (assert (boundp 'allout-tests-locally-true))
6085 (assert (local-variable-p 'allout-tests-locally-true))
6086 (assert (equal allout-tests-locally-true t))
6087 (assert (not (default-boundp 'allout-tests-locally-true))))
6088
6089 ;; ensure that deliberately unbinding registered variables doesn't foul things
6090 (with-temp-buffer
6091 (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
6092 (allout-tests-obliterate-variable 'allout-tests-globally-true)
6093 (setq allout-tests-globally-true t)
6094 (allout-tests-obliterate-variable 'allout-tests-locally-true)
6095 (set (make-local-variable 'allout-tests-locally-true) t)
6096 (allout-add-resumptions '(allout-tests-globally-unbound t)
6097 '(allout-tests-globally-true nil)
6098 '(allout-tests-locally-true nil))
6099 (allout-tests-obliterate-variable 'allout-tests-globally-unbound)
6100 (allout-tests-obliterate-variable 'allout-tests-globally-true)
6101 (allout-tests-obliterate-variable 'allout-tests-locally-true)
6102 (allout-do-resumptions))
6103 )
6104;;;_ % Run unit tests if `allout-run-unit-tests-after-load' is true:
6105(when allout-run-unit-tests-on-load
6106 (allout-run-unit-tests))
6107
6108;;;_ #12 Provide
5923(provide 'allout) 6109(provide 'allout)
5924 6110
5925;;;_* Local emacs vars. 6111;;;_* Local emacs vars.
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index 500ad5ff5fa..4afdfac2bf5 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -870,10 +870,14 @@ using `make-temp-file', and the generated name is returned."
870 (save-excursion 870 (save-excursion
871 (funcall set-auto-coding-function 871 (funcall set-auto-coding-function
872 filename (- (point-max) (point-min))))) 872 filename (- (point-max) (point-min)))))
873 ;; dos-w32.el defines find-operation-coding-system for 873 ;; dos-w32.el defines the function
874 ;; DOS/Windows systems which preserves the coding-system 874 ;; find-buffer-file-type-coding-system for DOS/Windows
875 ;; of existing files. We want it to act here as if the 875 ;; systems which preserves the coding-system of existing files.
876 ;; extracted file existed. 876 ;; (That function is called via file-coding-system-alist.)
877 ;; Here, we want it to act as if the extracted file existed.
878 ;; The following let-binding of file-name-handler-alist forces
879 ;; find-file-not-found-set-buffer-file-coding-system to ignore
880 ;; the file's name (see dos-w32.el).
877 (let ((file-name-handler-alist 881 (let ((file-name-handler-alist
878 '(("" . archive-file-name-handler)))) 882 '(("" . archive-file-name-handler))))
879 (car (find-operation-coding-system 883 (car (find-operation-coding-system
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 639ee2dabb8..fc66d36b41f 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -683,7 +683,11 @@ language you are using."
683 (define-key map [prior] 'previous-history-element) 683 (define-key map [prior] 'previous-history-element)
684 (define-key map [up] 'previous-history-element) 684 (define-key map [up] 'previous-history-element)
685 (define-key map "\es" 'next-matching-history-element) 685 (define-key map "\es" 'next-matching-history-element)
686 (define-key map "\er" 'previous-matching-history-element)) 686 (define-key map "\er" 'previous-matching-history-element)
687 ;; Override the global binding (which calls indent-relative via
688 ;; indent-for-tab-command). The alignment that indent-relative tries to
689 ;; do doesn't make much sense here since the prompt messes it up.
690 (define-key map "\t" 'self-insert-command))
687 691
688(define-key global-map "\C-u" 'universal-argument) 692(define-key global-map "\C-u" 'universal-argument)
689(let ((i ?0)) 693(let ((i ?0))
diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el
index fadfabce663..fe5bf4cf9e0 100644
--- a/lisp/calc/calc-aent.el
+++ b/lisp/calc/calc-aent.el
@@ -32,7 +32,11 @@
32(require 'calc) 32(require 'calc)
33(require 'calc-macs) 33(require 'calc-macs)
34 34
35(defvar calc-quick-calc-history nil
36 "The history list for quick-calc.")
37
35(defun calc-do-quick-calc () 38(defun calc-do-quick-calc ()
39 (require 'calc-ext)
36 (calc-check-defines) 40 (calc-check-defines)
37 (if (eq major-mode 'calc-mode) 41 (if (eq major-mode 'calc-mode)
38 (calc-algebraic-entry t) 42 (calc-algebraic-entry t)
@@ -45,23 +49,12 @@
45 (enable-recursive-minibuffers t) 49 (enable-recursive-minibuffers t)
46 (calc-language (if (memq calc-language '(nil big)) 50 (calc-language (if (memq calc-language '(nil big))
47 'flat calc-language)) 51 'flat calc-language))
48 (entry (calc-do-alg-entry "" "Quick calc: " t)) 52 (entry (calc-do-alg-entry "" "Quick calc: " t 'calc-quick-calc-history))
49 (alg-exp (mapcar (function 53 (alg-exp (mapcar 'math-evaluate-expr entry)))
50 (lambda (x)
51 (if (and (not (featurep 'calc-ext))
52 calc-previous-alg-entry
53 (string-match
54 "\\`[-0-9._+*/^() ]+\\'"
55 calc-previous-alg-entry))
56 (calc-normalize x)
57 (require 'calc-ext)
58 (math-evaluate-expr x))))
59 entry)))
60 (when (and (= (length alg-exp) 1) 54 (when (and (= (length alg-exp) 1)
61 (eq (car-safe (car alg-exp)) 'calcFunc-assign) 55 (eq (car-safe (car alg-exp)) 'calcFunc-assign)
62 (= (length (car alg-exp)) 3) 56 (= (length (car alg-exp)) 3)
63 (eq (car-safe (nth 1 (car alg-exp))) 'var)) 57 (eq (car-safe (nth 1 (car alg-exp))) 'var))
64 (require 'calc-ext)
65 (set (nth 2 (nth 1 (car alg-exp))) (nth 2 (car alg-exp))) 58 (set (nth 2 (nth 1 (car alg-exp))) (nth 2 (car alg-exp)))
66 (calc-refresh-evaltos (nth 2 (nth 1 (car alg-exp)))) 59 (calc-refresh-evaltos (nth 2 (nth 1 (car alg-exp))))
67 (setq alg-exp (list (nth 2 (car alg-exp))))) 60 (setq alg-exp (list (nth 2 (car alg-exp)))))
@@ -264,13 +257,16 @@ T means abort and give an error message.")
264 (math-expr-opers (if prefix math-standard-opers math-expr-opers))) 257 (math-expr-opers (if prefix math-standard-opers math-expr-opers)))
265 (calc-alg-entry (and auto (char-to-string last-command-char)))))) 258 (calc-alg-entry (and auto (char-to-string last-command-char))))))
266 259
260(defvar calc-alg-entry-history nil
261 "History for algebraic entry.")
262
267(defun calc-alg-entry (&optional initial prompt) 263(defun calc-alg-entry (&optional initial prompt)
268 (let* ((sel-mode nil) 264 (let* ((sel-mode nil)
269 (calc-dollar-values (mapcar 'calc-get-stack-element 265 (calc-dollar-values (mapcar 'calc-get-stack-element
270 (nthcdr calc-stack-top calc-stack))) 266 (nthcdr calc-stack-top calc-stack)))
271 (calc-dollar-used 0) 267 (calc-dollar-used 0)
272 (calc-plain-entry t) 268 (calc-plain-entry t)
273 (alg-exp (calc-do-alg-entry initial prompt t))) 269 (alg-exp (calc-do-alg-entry initial prompt t 'calc-alg-entry-history)))
274 (if (stringp alg-exp) 270 (if (stringp alg-exp)
275 (progn 271 (progn
276 (require 'calc-ext) 272 (require 'calc-ext)
@@ -301,7 +297,7 @@ T means abort and give an error message.")
301 297
302(defvar calc-alg-exp) 298(defvar calc-alg-exp)
303 299
304(defun calc-do-alg-entry (&optional initial prompt no-normalize) 300(defun calc-do-alg-entry (&optional initial prompt no-normalize history)
305 (let* ((calc-buffer (current-buffer)) 301 (let* ((calc-buffer (current-buffer))
306 (blink-paren-function 'calcAlg-blink-matching-open) 302 (blink-paren-function 'calcAlg-blink-matching-open)
307 (calc-alg-exp 'error)) 303 (calc-alg-exp 'error))
@@ -319,15 +315,17 @@ T means abort and give an error message.")
319 (define-key calc-alg-ent-map "\e" nil) 315 (define-key calc-alg-ent-map "\e" nil)
320 (if (eq calc-algebraic-mode 'total) 316 (if (eq calc-algebraic-mode 'total)
321 (define-key calc-alg-ent-map "\e" calc-alg-ent-esc-map) 317 (define-key calc-alg-ent-map "\e" calc-alg-ent-esc-map)
322 (define-key calc-alg-ent-map "\ep" 'calcAlg-plus-minus) 318 (define-key calc-alg-ent-map "\e+" 'calcAlg-plus-minus)
323 (define-key calc-alg-ent-map "\em" 'calcAlg-mod) 319 (define-key calc-alg-ent-map "\em" 'calcAlg-mod)
324 (define-key calc-alg-ent-map "\e=" 'calcAlg-equals) 320 (define-key calc-alg-ent-map "\e=" 'calcAlg-equals)
325 (define-key calc-alg-ent-map "\e\r" 'calcAlg-equals) 321 (define-key calc-alg-ent-map "\e\r" 'calcAlg-equals)
322 (define-key calc-alg-ent-map "\ep" 'previous-history-element)
323 (define-key calc-alg-ent-map "\en" 'next-history-element)
326 (define-key calc-alg-ent-map "\e%" 'self-insert-command)) 324 (define-key calc-alg-ent-map "\e%" 'self-insert-command))
327 (setq calc-aborted-prefix nil) 325 (setq calc-aborted-prefix nil)
328 (let ((buf (read-from-minibuffer (or prompt "Algebraic: ") 326 (let ((buf (read-from-minibuffer (or prompt "Algebraic: ")
329 (or initial "") 327 (or initial "")
330 calc-alg-ent-map nil))) 328 calc-alg-ent-map nil history)))
331 (when (eq calc-alg-exp 'error) 329 (when (eq calc-alg-exp 'error)
332 (when (eq (car-safe (setq calc-alg-exp (math-read-exprs buf))) 'error) 330 (when (eq (car-safe (setq calc-alg-exp (math-read-exprs buf))) 'error)
333 (setq calc-alg-exp nil))) 331 (setq calc-alg-exp nil)))
@@ -355,9 +353,7 @@ T means abort and give an error message.")
355(defun calcAlg-previous () 353(defun calcAlg-previous ()
356 (interactive) 354 (interactive)
357 (if (calc-minibuffer-contains "\\'") 355 (if (calc-minibuffer-contains "\\'")
358 (if calc-previous-alg-entry 356 (previous-history-element 1)
359 (insert calc-previous-alg-entry)
360 (beep))
361 (insert "'"))) 357 (insert "'")))
362 358
363(defun calcAlg-equals () 359(defun calcAlg-equals ()
@@ -384,7 +380,6 @@ T means abort and give an error message.")
384 "\\`\\([^\"]*\"[^\"]*\"\\)*[^\"]*\"[^\"]*\\'")) 380 "\\`\\([^\"]*\"[^\"]*\"\\)*[^\"]*\"[^\"]*\\'"))
385 (insert "`") 381 (insert "`")
386 (setq calc-alg-exp (minibuffer-contents)) 382 (setq calc-alg-exp (minibuffer-contents))
387 (and (> (length calc-alg-exp) 0) (setq calc-previous-alg-entry calc-alg-exp))
388 (exit-minibuffer))) 383 (exit-minibuffer)))
389 384
390(defvar calc-buffer) 385(defvar calc-buffer)
@@ -407,7 +402,6 @@ T means abort and give an error message.")
407 (setq calc-alg-exp (if (calc-minibuffer-contains "\\` *\\[ *\\'") 402 (setq calc-alg-exp (if (calc-minibuffer-contains "\\` *\\[ *\\'")
408 '((incomplete vec)) 403 '((incomplete vec))
409 exp)) 404 exp))
410 (and (> (length str) 0) (setq calc-previous-alg-entry str))
411 (exit-minibuffer)))) 405 (exit-minibuffer))))
412 406
413(defun calcAlg-blink-matching-open () 407(defun calcAlg-blink-matching-open ()
diff --git a/lisp/calc/calc-map.el b/lisp/calc/calc-map.el
index 63e45538c32..c9c71b3ebf1 100644
--- a/lisp/calc/calc-map.el
+++ b/lisp/calc/calc-map.el
@@ -498,6 +498,9 @@
498 498
499 499
500;;; Return a list of the form (nargs func name) 500;;; Return a list of the form (nargs func name)
501(defvar calc-get-operator-history nil
502 "History for calc-get-operator.")
503
501(defun calc-get-operator (msg &optional nargs) 504(defun calc-get-operator (msg &optional nargs)
502 (setq calc-aborted-prefix nil) 505 (setq calc-aborted-prefix nil)
503 (let ((inv nil) (hyp nil) (prefix nil) (forcenargs nil) 506 (let ((inv nil) (hyp nil) (prefix nil) (forcenargs nil)
@@ -583,7 +586,8 @@
583 (let* ((calc-dollar-values calc-arg-values) 586 (let* ((calc-dollar-values calc-arg-values)
584 (calc-dollar-used 0) 587 (calc-dollar-used 0)
585 (calc-hashes-used 0) 588 (calc-hashes-used 0)
586 (func (calc-do-alg-entry "" "Function: "))) 589 (func (calc-do-alg-entry "" "Function: " nil
590 'calc-get-operator-history)))
587 (setq record-entry t) 591 (setq record-entry t)
588 (or (= (length func) 1) 592 (or (= (length func) 1)
589 (error "Bad format")) 593 (error "Bad format"))
diff --git a/lisp/calc/calc-rewr.el b/lisp/calc/calc-rewr.el
index 71dce50d976..d7530dc4cb6 100644
--- a/lisp/calc/calc-rewr.el
+++ b/lisp/calc/calc-rewr.el
@@ -154,7 +154,6 @@
154 (setq expr (calc-top-n 2) 154 (setq expr (calc-top-n 2)
155 pat (calc-top-n 1) 155 pat (calc-top-n 1)
156 n 2) 156 n 2)
157 (if interactive (setq calc-previous-alg-entry pat))
158 (setq pat (if (stringp pat) (math-read-expr pat) pat)) 157 (setq pat (if (stringp pat) (math-read-expr pat) pat))
159 (if (eq (car-safe pat) 'error) 158 (if (eq (car-safe pat) 'error)
160 (error "Bad format in expression: %s" (nth 1 pat))) 159 (error "Bad format in expression: %s" (nth 1 pat)))
diff --git a/lisp/calc/calc-sel.el b/lisp/calc/calc-sel.el
index bf18fa968c5..7f6dbb7f999 100644
--- a/lisp/calc/calc-sel.el
+++ b/lisp/calc/calc-sel.el
@@ -633,6 +633,9 @@
633 (setcar (nthcdr 2 entry) (and (not (eq sel (car entry))) sel)) 633 (setcar (nthcdr 2 entry) (and (not (eq sel (car entry))) sel))
634 (calc-delete-selection num)))) 634 (calc-delete-selection num))))
635 635
636(defvar calc-selection-history nil
637 "History for calc selections.")
638
636(defun calc-enter-selection () 639(defun calc-enter-selection ()
637 (interactive) 640 (interactive)
638 (calc-wrapper 641 (calc-wrapper
@@ -645,7 +648,8 @@
645 alg) 648 alg)
646 (let ((calc-dollar-values (list sel)) 649 (let ((calc-dollar-values (list sel))
647 (calc-dollar-used 0)) 650 (calc-dollar-used 0))
648 (setq alg (calc-do-alg-entry "" "Replace selection with: ")) 651 (setq alg (calc-do-alg-entry "" "Replace selection with: " nil
652 'calc-selection-history))
649 (and alg 653 (and alg
650 (progn 654 (progn
651 (setq alg (calc-encase-atoms (car alg))) 655 (setq alg (calc-encase-atoms (car alg)))
@@ -765,7 +769,8 @@
765 (car (calc-do-alg-entry "" 769 (car (calc-do-alg-entry ""
766 (if divide 770 (if divide
767 "Divide both sides by: " 771 "Divide both sides by: "
768 "Multiply both sides by: "))))) 772 "Multiply both sides by: ")
773 nil 'calc-selection-history))))
769 (and alg 774 (and alg
770 (progn 775 (progn
771 (if (and (or (eq func '/) 776 (if (and (or (eq func '/)
@@ -830,7 +835,8 @@
830 (car (calc-do-alg-entry "" 835 (car (calc-do-alg-entry ""
831 (if subtract 836 (if subtract
832 "Subtract from both sides: " 837 "Subtract from both sides: "
833 "Add to both sides: "))))) 838 "Add to both sides: ")
839 nil 'calc-selection-history))))
834 (and alg 840 (and alg
835 (progn 841 (progn
836 (if (and (assq func calc-tweak-eqn-table) 842 (if (and (assq func calc-tweak-eqn-table)
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index c251d28acfb..bbb80bebc1d 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -886,7 +886,6 @@ If nil, selections displayed but ignored.")
886 "Formatting function used for non-decimal numbers.") 886 "Formatting function used for non-decimal numbers.")
887 887
888(defvar calc-last-kill nil) ; Last number killed in calc-mode. 888(defvar calc-last-kill nil) ; Last number killed in calc-mode.
889(defvar calc-previous-alg-entry nil) ; Previous algebraic entry.
890(defvar calc-dollar-values nil) ; Values to be used for '$'. 889(defvar calc-dollar-values nil) ; Values to be used for '$'.
891(defvar calc-dollar-used nil) ; Highest order of '$' that occurred. 890(defvar calc-dollar-used nil) ; Highest order of '$' that occurred.
892(defvar calc-hashes-used nil) ; Highest order of '#' that occurred. 891(defvar calc-hashes-used nil) ; Highest order of '#' that occurred.
diff --git a/lisp/calc/calcalg3.el b/lisp/calc/calcalg3.el
index b1c5b80b17b..4c0134263d9 100644
--- a/lisp/calc/calcalg3.el
+++ b/lisp/calc/calcalg3.el
@@ -103,6 +103,9 @@
103(defvar calc-curve-model) 103(defvar calc-curve-model)
104(defvar calc-curve-coefnames) 104(defvar calc-curve-coefnames)
105 105
106(defvar calc-curve-fit-history nil
107 "History for calc-curve-fit.")
108
106(defun calc-curve-fit (arg &optional calc-curve-model 109(defun calc-curve-fit (arg &optional calc-curve-model
107 calc-curve-coefnames calc-curve-varnames) 110 calc-curve-coefnames calc-curve-varnames)
108 (interactive "P") 111 (interactive "P")
@@ -259,7 +262,8 @@
259 (let* ((calc-dollar-values calc-arg-values) 262 (let* ((calc-dollar-values calc-arg-values)
260 (calc-dollar-used 0) 263 (calc-dollar-used 0)
261 (calc-hashes-used 0)) 264 (calc-hashes-used 0))
262 (setq calc-curve-model (calc-do-alg-entry "" "Model formula: ")) 265 (setq calc-curve-model (calc-do-alg-entry "" "Model formula: "
266 nil 'calc-curve-fit-history))
263 (if (/= (length calc-curve-model) 1) 267 (if (/= (length calc-curve-model) 1)
264 (error "Bad format")) 268 (error "Bad format"))
265 (setq calc-curve-model (car calc-curve-model) 269 (setq calc-curve-model (car calc-curve-model)
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 15efbc5ab91..15f43080aff 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -1087,18 +1087,24 @@ Show the buffer in another window, but don't select it."
1087;; Packages will update this variable, so make it available. 1087;; Packages will update this variable, so make it available.
1088;;;###autoload 1088;;;###autoload
1089(defvar customize-package-emacs-version-alist nil 1089(defvar customize-package-emacs-version-alist nil
1090 "Alist mapping versions of Emacs to versions of a package. 1090 "Alist mapping versions of a package to Emacs versions.
1091These package versions are listed in the :package-version 1091We use this for packages that have their own names, but are released
1092keyword used in `defcustom', `defgroup', and `defface'. Its 1092as part of Emacs itself.
1093elements look like this: 1093
1094Each elements looks like this:
1094 1095
1095 (PACKAGE (PVERSION . EVERSION)...) 1096 (PACKAGE (PVERSION . EVERSION)...)
1096 1097
1097For each PACKAGE, which is a symbol, there are one or more 1098Here PACKAGE is the name of a package, as a symbol. After
1098elements that contain a package version PVERSION with an 1099PACKAGE come one or more elements, each associating a
1099associated Emacs version EVERSION. These versions are strings. 1100package version PVERSION with the first Emacs version
1100For example, the MH-E package updates this alist with the 1101EVERSION in which it (or a subsequent version of PACKAGE)
1101following: 1102was first released. Both PVERSION and EVERSION are strings.
1103PVERSION should be a string that this package used in
1104the :package-version keyword for `defcustom', `defgroup',
1105and `defface'.
1106
1107For example, the MH-E package updates this alist as follows:
1102 1108
1103 (add-to-list 'customize-package-emacs-version-alist 1109 (add-to-list 'customize-package-emacs-version-alist
1104 '(MH-E (\"6.0\" . \"22.1\") (\"6.1\" . \"22.1\") 1110 '(MH-E (\"6.0\" . \"22.1\") (\"6.1\" . \"22.1\")
@@ -1173,11 +1179,10 @@ that were added or redefined since that version."
1173 since-version)))) 1179 since-version))))
1174 1180
1175(defun customize-package-emacs-version (symbol package-version) 1181(defun customize-package-emacs-version (symbol package-version)
1176 "Return Emacs version of SYMBOL. 1182 "Return the Emacs version in which SYMBOL's meaning last changed.
1177PACKAGE-VERSION has the form (PACKAGE . VERSION). The VERSION of 1183PACKAGE-VERSION has the form (PACKAGE . VERSION). We use
1178PACKAGE is looked up in the associated list
1179`customize-package-emacs-version-alist' to find the version of 1184`customize-package-emacs-version-alist' to find the version of
1180Emacs that is associated with it." 1185Emacs that is associated with version VERSION of PACKAGE."
1181 (let (package-versions emacs-version) 1186 (let (package-versions emacs-version)
1182 ;; Use message instead of error since we want user to be able to 1187 ;; Use message instead of error since we want user to be able to
1183 ;; see the rest of the symbols even if a package author has 1188 ;; see the rest of the symbols even if a package author has
@@ -1193,9 +1198,9 @@ Emacs that is associated with it."
1193 (cdr package-version) 1198 (cdr package-version)
1194 "customize-package-emacs-version-alist"))) 1199 "customize-package-emacs-version-alist")))
1195 (t 1200 (t
1196 (message "Package %s neglected to update %s" 1201 (message "Package %s version %s lists no corresponding Emacs version"
1197 (car package-version) 1202 (car package-version)
1198 "customize-package-emacs-version-alist"))) 1203 (cdr package-version))))
1199 emacs-version)) 1204 emacs-version))
1200 1205
1201(defun customize-version-lessp (version1 version2) 1206(defun customize-version-lessp (version1 version2)
@@ -2668,7 +2673,18 @@ Otherwise, look up symbol in `custom-guess-type-alist'."
2668 (error nil)) 2673 (error nil))
2669 (cond 2674 (cond
2670 ((eq (caar tmp) 'user) 'saved) 2675 ((eq (caar tmp) 'user) 'saved)
2671 ((eq (caar tmp) 'changed) 'changed) 2676 ((eq (caar tmp) 'changed)
2677 (if (condition-case nil
2678 (and (null comment)
2679 (equal value
2680 (eval
2681 (car (get symbol 'standard-value)))))
2682 (error nil))
2683 ;; The value was originally set outside
2684 ;; custom, but it was set to the standard
2685 ;; value (probably an autoloaded defcustom).
2686 'standard
2687 'changed))
2672 (t 'themed)) 2688 (t 'themed))
2673 'changed)) 2689 'changed))
2674 ((setq tmp (get symbol 'standard-value)) 2690 ((setq tmp (get symbol 'standard-value))
@@ -4433,10 +4449,13 @@ The format is suitable for use with `easy-menu-define'."
4433 map) 4449 map)
4434 "Keymap for `custom-mode'.") 4450 "Keymap for `custom-mode'.")
4435 4451
4436(defun custom-no-edit () 4452(defun custom-no-edit (pos &optional event)
4437 "Refuse to allow editing of Custom buffer." 4453 "Invoke button at POS, or refuse to allow editing of Custom buffer."
4438 (interactive) 4454 (interactive "@d")
4439 (error "You can't edit this part of the Custom buffer")) 4455 (let ((button (get-char-property pos 'button)))
4456 (if button
4457 (widget-apply-action button event)
4458 (error "You can't edit this part of the Custom buffer"))))
4440 4459
4441(easy-menu-define Custom-mode-menu 4460(easy-menu-define Custom-mode-menu
4442 custom-mode-map 4461 custom-mode-map
diff --git a/lisp/custom.el b/lisp/custom.el
index c0169812d36..2e5c0a59d9b 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -558,9 +558,10 @@ LOAD should be either a library file name, or a feature name."
558 (unless (member load loads) 558 (unless (member load loads)
559 (put symbol 'custom-loads (cons (purecopy load) loads))))) 559 (put symbol 'custom-loads (cons (purecopy load) loads)))))
560 560
561(defun custom-autoload (symbol load) 561(defun custom-autoload (symbol load &optional noset)
562 "Mark SYMBOL as autoloaded custom variable and add dependency LOAD." 562 "Mark SYMBOL as autoloaded custom variable and add dependency LOAD.
563 (put symbol 'custom-autoload t) 563If NOSET is non-nil, don't bother autoloading LOAD when setting the variable."
564 (put symbol 'custom-autoload (if noset 'noset t))
564 (custom-add-load symbol load)) 565 (custom-add-load symbol load))
565 566
566;; This test is also in the C code of `user-variable-p'. 567;; This test is also in the C code of `user-variable-p'.
@@ -699,10 +700,10 @@ Return non-nil iff the `customized-value' property actually changed."
699 (customized (get symbol 'customized-value)) 700 (customized (get symbol 'customized-value))
700 (old (or (get symbol 'saved-value) (get symbol 'standard-value)))) 701 (old (or (get symbol 'saved-value) (get symbol 'standard-value))))
701 ;; Mark default value as set iff different from old value. 702 ;; Mark default value as set iff different from old value.
702 (if (or (null old) 703 (if (not (and old
703 (not (equal value (condition-case nil 704 (equal value (condition-case nil
704 (eval (car old)) 705 (eval (car old))
705 (error nil))))) 706 (error nil)))))
706 (progn (put symbol 'customized-value (list (custom-quote value))) 707 (progn (put symbol 'customized-value (list (custom-quote value)))
707 (custom-push-theme 'theme-value symbol 'user 'set 708 (custom-push-theme 'theme-value symbol 'user 'set
708 (custom-quote value))) 709 (custom-quote value)))
@@ -827,13 +828,9 @@ See `custom-known-themes' for a list of known themes."
827 (if (and (eq prop 'theme-value) 828 (if (and (eq prop 'theme-value)
828 (boundp symbol)) 829 (boundp symbol))
829 (let ((sv (get symbol 'standard-value))) 830 (let ((sv (get symbol 'standard-value)))
830 (when (and (null sv) (custom-variable-p symbol)) 831 (unless (and sv
831 (custom-load-symbol symbol) 832 (equal (eval (car sv)) (symbol-value symbol)))
832 (setq sv (get symbol 'standard-value))) 833 (setq old (list (list 'changed (symbol-value symbol))))))
833 (if (or (null sv)
834 (not (equal (eval (car (get symbol 'standard-value)))
835 (symbol-value symbol))))
836 (setq old (list (list 'changed (symbol-value symbol))))))
837 (if (and (facep symbol) 834 (if (and (facep symbol)
838 (not (face-spec-match-p symbol (get symbol 'face-defface-spec)))) 835 (not (face-spec-match-p symbol (get symbol 'face-defface-spec))))
839 (setq old (list (list 'changed (list 836 (setq old (list (list 'changed (list
@@ -907,6 +904,10 @@ in SYMBOL's list property `theme-value' \(using `custom-push-theme')."
907 (when requests 904 (when requests
908 (put symbol 'custom-requests requests) 905 (put symbol 'custom-requests requests)
909 (mapc 'require requests)) 906 (mapc 'require requests))
907 (unless (or (get symbol 'standard-value)
908 (memq (get symbol 'custom-autoload) '(nil noset)))
909 ;; This symbol needs to be autoloaded, even just for a `set'.
910 (custom-load-symbol symbol))
910 (setq set (or (get symbol 'custom-set) 'custom-set-default)) 911 (setq set (or (get symbol 'custom-set) 'custom-set-default))
911 (put symbol 'saved-value (list value)) 912 (put symbol 'saved-value (list value))
912 (put symbol 'saved-variable-comment comment) 913 (put symbol 'saved-variable-comment comment)
@@ -926,6 +927,8 @@ in SYMBOL's list property `theme-value' \(using `custom-push-theme')."
926 (setq args (cdr args)) 927 (setq args (cdr args))
927 (and (or now (default-boundp symbol)) 928 (and (or now (default-boundp symbol))
928 (put symbol 'variable-comment comment))) 929 (put symbol 'variable-comment comment)))
930 ;; I believe this is dead-code, because the `sort' code above would
931 ;; have burped before we could get here. --Stef
929 ;; Old format, a plist of SYMBOL VALUE pairs. 932 ;; Old format, a plist of SYMBOL VALUE pairs.
930 (message "Warning: old format `custom-set-variables'") 933 (message "Warning: old format `custom-set-variables'")
931 (ding) 934 (ding)
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index b4cb8933194..0942c6d1dff 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -745,19 +745,22 @@ Otherwise, the rule is a compression rule, and compression is done with gzip.")
745 ;;; We don't recognize the file as compressed, so compress it. 745 ;;; We don't recognize the file as compressed, so compress it.
746 ;;; Try gzip; if we don't have that, use compress. 746 ;;; Try gzip; if we don't have that, use compress.
747 (condition-case nil 747 (condition-case nil
748 (if (not (dired-check-process (concat "Compressing " file) 748 (let ((out-name (concat file ".gz")))
749 "gzip" "-f" file)) 749 (and (or (not (file-exists-p out-name))
750 (let ((out-name 750 (y-or-n-p
751 (if (file-exists-p (concat file ".gz")) 751 (format "File %s already exists. Really compress? "
752 (concat file ".gz") 752 out-name)))
753 (concat file ".z")))) 753 (not (dired-check-process (concat "Compressing " file)
754 ;; Rename the compressed file to NEWNAME 754 "gzip" "-f" file))
755 ;; if it hasn't got that name already. 755 (or (file-exists-p out-name)
756 (if (and newname (not (equal newname out-name))) 756 (setq out-name (concat file ".z")))
757 (progn 757 ;; Rename the compressed file to NEWNAME
758 (rename-file out-name newname t) 758 ;; if it hasn't got that name already.
759 newname) 759 (if (and newname (not (equal newname out-name)))
760 out-name))) 760 (progn
761 (rename-file out-name newname t)
762 newname)
763 out-name)))
761 (file-error 764 (file-error
762 (if (not (dired-check-process (concat "Compressing " file) 765 (if (not (dired-check-process (concat "Compressing " file)
763 "compress" "-f" file)) 766 "compress" "-f" file))
diff --git a/lisp/dired.el b/lisp/dired.el
index 64b73184397..59fb21a004f 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1260,6 +1260,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
1260 (define-key map "\C-tc" 'tumme-dired-comment-files) 1260 (define-key map "\C-tc" 'tumme-dired-comment-files)
1261 (define-key map "\C-tf" 'tumme-mark-tagged-files) 1261 (define-key map "\C-tf" 'tumme-mark-tagged-files)
1262 (define-key map "\C-t\C-t" 'tumme-dired-insert-marked-thumbs) 1262 (define-key map "\C-t\C-t" 'tumme-dired-insert-marked-thumbs)
1263 (define-key map "\C-te" 'tumme-dired-edit-comment-and-tags)
1263 1264
1264 ;; Make menu bar items. 1265 ;; Make menu bar items.
1265 1266
diff --git a/lisp/dos-w32.el b/lisp/dos-w32.el
index 2d730c8af0f..5fb6d5a0f6b 100644
--- a/lisp/dos-w32.el
+++ b/lisp/dos-w32.el
@@ -88,10 +88,13 @@ against the file name, and TYPE is nil for text, t for binary.")
88(setq-default buffer-file-coding-system 'undecided-dos) 88(setq-default buffer-file-coding-system 'undecided-dos)
89 89
90(defun find-buffer-file-type-coding-system (command) 90(defun find-buffer-file-type-coding-system (command)
91 "Choose a coding system for a file operation. 91 "Choose a coding system for a file operation in COMMAND.
92If COMMAND is `insert-file-contents', the coding system is chosen based 92COMMAND is a list that specifies the operation, and I/O primitive as its
93upon the filename, the contents of `untranslated-filesystem-list' and 93CAR, and the arguments that might be given to that operation as its CDR.
94`file-name-buffer-file-type-alist', and whether the file exists: 94If operation is `insert-file-contents', the coding system is chosen based
95upon the filename (the CAR of the arguments beyond the operation), the contents
96of `untranslated-filesystem-list' and `file-name-buffer-file-type-alist',
97and whether the file exists:
95 98
96 If it matches in `untranslated-filesystem-list': 99 If it matches in `untranslated-filesystem-list':
97 If the file exists: `undecided' 100 If the file exists: `undecided'
@@ -103,7 +106,7 @@ upon the filename, the contents of `untranslated-filesystem-list' and
103 If the file exists: `undecided' 106 If the file exists: `undecided'
104 If the file does not exist: default-buffer-file-coding-system 107 If the file does not exist: default-buffer-file-coding-system
105 108
106If COMMAND is `write-region', the coding system is chosen based upon 109If operation is `write-region', the coding system is chosen based upon
107the value of `buffer-file-coding-system' and `buffer-file-type'. If 110the value of `buffer-file-coding-system' and `buffer-file-type'. If
108`buffer-file-coding-system' is non-nil, its value is used. If it is 111`buffer-file-coding-system' is non-nil, its value is used. If it is
109nil and `buffer-file-type' is t, the coding system is `no-conversion'. 112nil and `buffer-file-type' is t, the coding system is `no-conversion'.
@@ -126,6 +129,13 @@ set to the appropriate coding system, and the value of
126 (undecided nil) (undecided-unix nil)) 129 (undecided nil) (undecided-unix nil))
127 (cond ((eq op 'insert-file-contents) 130 (cond ((eq op 'insert-file-contents)
128 (setq target (nth 1 command)) 131 (setq target (nth 1 command))
132 ;; If TARGET is a cons cell, it has the form (FILENAME . BUFFER),
133 ;; where BUFFER is a buffer into which the file was already read,
134 ;; but its contents were not yet decoded. (This form of the
135 ;; arguments is used, e.g., in arc-mode.el.) This function
136 ;; doesn't care about the contents, it only looks at the file's
137 ;; name, which is the CAR of the cons cell.
138 (if (consp target) (setq target (car target)))
129 ;; First check for a file name that indicates 139 ;; First check for a file name that indicates
130 ;; it is truly binary. 140 ;; it is truly binary.
131 (setq binary (find-buffer-file-type target)) 141 (setq binary (find-buffer-file-type target))
diff --git a/lisp/emacs-lisp/authors.el b/lisp/emacs-lisp/authors.el
index 912f6b2d77f..d1710dba7a4 100644
--- a/lisp/emacs-lisp/authors.el
+++ b/lisp/emacs-lisp/authors.el
@@ -92,6 +92,7 @@ files.")
92 "Kai.Grossjohann@Cs.Uni-Dortmund.De" 92 "Kai.Grossjohann@Cs.Uni-Dortmund.De"
93 "Kai.Grossjohann@Gmx.Net") 93 "Kai.Grossjohann@Gmx.Net")
94 ("Karl Berry" "K. Berry") 94 ("Karl Berry" "K. Berry")
95 ("K,Aa(Broly L$,1 q(Brentey" "K,Aa(Broly L,Bu(Brentey" "L$,1 q(Brentey K,Aa(Broly")
95 ("Kazushi Marukawa" "Kazushi") 96 ("Kazushi Marukawa" "Kazushi")
96 ("Ken Manheimer" "Kenneth Manheimer") 97 ("Ken Manheimer" "Kenneth Manheimer")
97 ("Kenichi Handa" "Ken'ichi Handa" "Kenichi HANDA") 98 ("Kenichi Handa" "Ken'ichi Handa" "Kenichi HANDA")
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index 4000b4da282..da85cbd817a 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -124,7 +124,10 @@ or macro definition or a defcustom)."
124 ) 124 )
125 `(progn 125 `(progn
126 (defvar ,varname ,init ,doc) 126 (defvar ,varname ,init ,doc)
127 (custom-autoload ',varname ,file)))) 127 (custom-autoload ',varname ,file
128 ,(condition-case nil
129 (null (cadr (memq :set form)))
130 (error nil))))))
128 131
129 ((eq car 'defgroup) 132 ((eq car 'defgroup)
130 ;; In Emacs this is normally handled separately by cus-dep.el, but for 133 ;; In Emacs this is normally handled separately by cus-dep.el, but for
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index 41c940f1cec..50b7d8dc9ef 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -226,7 +226,12 @@ The search is done in the source for library LIBRARY."
226 (regexp-symbol (cdr (assq type find-function-regexp-alist)))) 226 (regexp-symbol (cdr (assq type find-function-regexp-alist))))
227 (with-current-buffer (find-file-noselect filename) 227 (with-current-buffer (find-file-noselect filename)
228 (let ((regexp (format (symbol-value regexp-symbol) 228 (let ((regexp (format (symbol-value regexp-symbol)
229 (regexp-quote (symbol-name symbol)))) 229 ;; Entry for ` (backquote) macro in loaddefs.el,
230 ;; (defalias (quote \`)..., has a \ but
231 ;; (symbol-name symbol) doesn't. Add an
232 ;; optional \ to catch this.
233 (concat "\\\\?"
234 (regexp-quote (symbol-name symbol)))))
230 (case-fold-search)) 235 (case-fold-search))
231 (with-syntax-table emacs-lisp-mode-syntax-table 236 (with-syntax-table emacs-lisp-mode-syntax-table
232 (goto-char (point-min)) 237 (goto-char (point-min))
diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el
index 245c274abd3..b16ae17eda0 100644
--- a/lisp/emulation/cua-base.el
+++ b/lisp/emulation/cua-base.el
@@ -305,11 +305,23 @@ If the value is nil, use a shifted prefix key to inhibit the override."
305 (const :tag "No delay" nil)) 305 (const :tag "No delay" nil))
306 :group 'cua) 306 :group 'cua)
307 307
308(defcustom cua-delete-selection t
309 "*If non-nil, typed text replaces text in the active selection."
310 :type '(choice (const :tag "Disabled" nil)
311 (other :tag "Enabled" t))
312 :group 'cua)
313
308(defcustom cua-keep-region-after-copy nil 314(defcustom cua-keep-region-after-copy nil
309 "If non-nil, don't deselect the region after copying." 315 "If non-nil, don't deselect the region after copying."
310 :type 'boolean 316 :type 'boolean
311 :group 'cua) 317 :group 'cua)
312 318
319(defcustom cua-toggle-set-mark t
320 "*In non-nil, the `cua-set-mark' command toggles the mark."
321 :type '(choice (const :tag "Disabled" nil)
322 (other :tag "Enabled" t))
323 :group 'cua)
324
313(defcustom cua-enable-register-prefix 'not-ctrl-u 325(defcustom cua-enable-register-prefix 'not-ctrl-u
314 "*If non-nil, registers are supported via numeric prefix arg. 326 "*If non-nil, registers are supported via numeric prefix arg.
315If the value is t, any numeric prefix arg in the range 0 to 9 will be 327If the value is t, any numeric prefix arg in the range 0 to 9 will be
@@ -391,7 +403,8 @@ and after the region marked by the rectangle to search."
391On non-window systems, always use the meta modifier. 403On non-window systems, always use the meta modifier.
392Must be set prior to enabling CUA." 404Must be set prior to enabling CUA."
393 :type '(choice (const :tag "Meta key" meta) 405 :type '(choice (const :tag "Meta key" meta)
394 (const :tag "Hyper key" hyper ) 406 (const :tag "Alt key" alt)
407 (const :tag "Hyper key" hyper)
395 (const :tag "Super key" super)) 408 (const :tag "Super key" super))
396 :group 'cua) 409 :group 'cua)
397 410
@@ -783,7 +796,7 @@ Save a copy in register 0 if `cua-delete-copy-to-register-0' is non-nil."
783(defun cua-replace-region () 796(defun cua-replace-region ()
784 "Replace the active region with the character you type." 797 "Replace the active region with the character you type."
785 (interactive) 798 (interactive)
786 (let ((not-empty (cua-delete-region))) 799 (let ((not-empty (and cua-delete-selection (cua-delete-region))))
787 (unless (eq this-original-command this-command) 800 (unless (eq this-original-command this-command)
788 (let ((overwrite-mode 801 (let ((overwrite-mode
789 (and overwrite-mode 802 (and overwrite-mode
@@ -1001,7 +1014,7 @@ With a double \\[universal-argument] prefix argument, unconditionally set mark."
1001 (arg 1014 (arg
1002 (setq this-command 'pop-to-mark-command) 1015 (setq this-command 'pop-to-mark-command)
1003 (pop-to-mark-command)) 1016 (pop-to-mark-command))
1004 (mark-active 1017 ((and cua-toggle-set-mark mark-active)
1005 (cua--deactivate) 1018 (cua--deactivate)
1006 (message "Mark Cleared")) 1019 (message "Mark Cleared"))
1007 (t 1020 (t
diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el
index 43a66fd0e3e..7db3cca8fae 100644
--- a/lisp/emulation/cua-rect.el
+++ b/lisp/emulation/cua-rect.el
@@ -1361,6 +1361,7 @@ With prefix arg, indent to that column."
1361 (interactive) 1361 (interactive)
1362 (let ((M (cond ((eq cua--rectangle-modifier-key 'hyper) " H-") 1362 (let ((M (cond ((eq cua--rectangle-modifier-key 'hyper) " H-")
1363 ((eq cua--rectangle-modifier-key 'super) " s-") 1363 ((eq cua--rectangle-modifier-key 'super) " s-")
1364 ((eq cua--rectangle-modifier-key 'alt) " A-")
1364 (t " M-")))) 1365 (t " M-"))))
1365 (message 1366 (message
1366 (concat (if help "C-?:help" "") 1367 (concat (if help "C-?:help" "")
diff --git a/lisp/files.el b/lisp/files.el
index 315c11de529..2b1446683be 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -44,7 +44,7 @@
44 44
45 45
46(defcustom delete-auto-save-files t 46(defcustom delete-auto-save-files t
47 "*Non-nil means delete auto-save file when a buffer is saved or killed. 47 "Non-nil means delete auto-save file when a buffer is saved or killed.
48 48
49Note that the auto-save file will not be deleted if the buffer is killed 49Note that the auto-save file will not be deleted if the buffer is killed
50when it has unsaved changes." 50when it has unsaved changes."
@@ -53,7 +53,7 @@ when it has unsaved changes."
53 53
54(defcustom directory-abbrev-alist 54(defcustom directory-abbrev-alist
55 nil 55 nil
56 "*Alist of abbreviations for file directories. 56 "Alist of abbreviations for file directories.
57A list of elements of the form (FROM . TO), each meaning to replace 57A list of elements of the form (FROM . TO), each meaning to replace
58FROM with TO when it appears in a directory name. This replacement is 58FROM with TO when it appears in a directory name. This replacement is
59done when setting up the default directory of a newly visited file. 59done when setting up the default directory of a newly visited file.
@@ -74,7 +74,7 @@ the name it is linked to."
74 74
75;; Turn off backup files on VMS since it has version numbers. 75;; Turn off backup files on VMS since it has version numbers.
76(defcustom make-backup-files (not (eq system-type 'vax-vms)) 76(defcustom make-backup-files (not (eq system-type 'vax-vms))
77 "*Non-nil means make a backup of a file the first time it is saved. 77 "Non-nil means make a backup of a file the first time it is saved.
78This can be done by renaming the file or by copying. 78This can be done by renaming the file or by copying.
79 79
80Renaming means that Emacs renames the existing file so that it is a 80Renaming means that Emacs renames the existing file so that it is a
@@ -103,20 +103,20 @@ But it is local only if you make it local.")
103(put 'backup-inhibited 'permanent-local t) 103(put 'backup-inhibited 'permanent-local t)
104 104
105(defcustom backup-by-copying nil 105(defcustom backup-by-copying nil
106 "*Non-nil means always use copying to create backup files. 106 "Non-nil means always use copying to create backup files.
107See documentation of variable `make-backup-files'." 107See documentation of variable `make-backup-files'."
108 :type 'boolean 108 :type 'boolean
109 :group 'backup) 109 :group 'backup)
110 110
111(defcustom backup-by-copying-when-linked nil 111(defcustom backup-by-copying-when-linked nil
112 "*Non-nil means use copying to create backups for files with multiple names. 112 "Non-nil means use copying to create backups for files with multiple names.
113This causes the alternate names to refer to the latest version as edited. 113This causes the alternate names to refer to the latest version as edited.
114This variable is relevant only if `backup-by-copying' is nil." 114This variable is relevant only if `backup-by-copying' is nil."
115 :type 'boolean 115 :type 'boolean
116 :group 'backup) 116 :group 'backup)
117 117
118(defcustom backup-by-copying-when-mismatch nil 118(defcustom backup-by-copying-when-mismatch nil
119 "*Non-nil means create backups by copying if this preserves owner or group. 119 "Non-nil means create backups by copying if this preserves owner or group.
120Renaming may still be used (subject to control of other variables) 120Renaming may still be used (subject to control of other variables)
121when it would not result in changing the owner or group of the file; 121when it would not result in changing the owner or group of the file;
122that is, for files which are owned by you and whose group matches 122that is, for files which are owned by you and whose group matches
@@ -126,7 +126,7 @@ This variable is relevant only if `backup-by-copying' is nil."
126 :group 'backup) 126 :group 'backup)
127 127
128(defcustom backup-by-copying-when-privileged-mismatch 200 128(defcustom backup-by-copying-when-privileged-mismatch 200
129 "*Non-nil means create backups by copying to preserve a privileged owner. 129 "Non-nil means create backups by copying to preserve a privileged owner.
130Renaming may still be used (subject to control of other variables) 130Renaming may still be used (subject to control of other variables)
131when it would not result in changing the owner of the file or if the owner 131when it would not result in changing the owner of the file or if the owner
132has a user id greater than the value of this variable. This is useful 132has a user id greater than the value of this variable. This is useful
@@ -142,7 +142,7 @@ This variable is relevant only if `backup-by-copying' and
142Called with an absolute file name as argument, it returns t to enable backup.") 142Called with an absolute file name as argument, it returns t to enable backup.")
143 143
144(defcustom buffer-offer-save nil 144(defcustom buffer-offer-save nil
145 "*Non-nil in a buffer means always offer to save buffer on exit. 145 "Non-nil in a buffer means always offer to save buffer on exit.
146Do so even if the buffer is not visiting a file. 146Do so even if the buffer is not visiting a file.
147Automatically local in all buffers." 147Automatically local in all buffers."
148 :type 'boolean 148 :type 'boolean
@@ -150,7 +150,7 @@ Automatically local in all buffers."
150(make-variable-buffer-local 'buffer-offer-save) 150(make-variable-buffer-local 'buffer-offer-save)
151 151
152(defcustom find-file-existing-other-name t 152(defcustom find-file-existing-other-name t
153 "*Non-nil means find a file under alternative names, in existing buffers. 153 "Non-nil means find a file under alternative names, in existing buffers.
154This means if any existing buffer is visiting the file you want 154This means if any existing buffer is visiting the file you want
155under another name, you get the existing buffer instead of a new buffer." 155under another name, you get the existing buffer instead of a new buffer."
156 :type 'boolean 156 :type 'boolean
@@ -165,7 +165,7 @@ both at the file level and at the levels of the containing directories."
165(put 'find-file-visit-truename 'safe-local-variable 'boolean) 165(put 'find-file-visit-truename 'safe-local-variable 'boolean)
166 166
167(defcustom revert-without-query nil 167(defcustom revert-without-query nil
168 "*Specify which files should be reverted without query. 168 "Specify which files should be reverted without query.
169The value is a list of regular expressions. 169The value is a list of regular expressions.
170If the file name matches one of these regular expressions, 170If the file name matches one of these regular expressions,
171then `revert-buffer' reverts the file without querying 171then `revert-buffer' reverts the file without querying
@@ -226,7 +226,7 @@ have fast storage with limited space, such as a RAM disk."
226 "Regexp recognizing file names which aren't allowed by the filesystem.") 226 "Regexp recognizing file names which aren't allowed by the filesystem.")
227 227
228(defcustom file-precious-flag nil 228(defcustom file-precious-flag nil
229 "*Non-nil means protect against I/O errors while saving files. 229 "Non-nil means protect against I/O errors while saving files.
230Some modes set this non-nil in particular buffers. 230Some modes set this non-nil in particular buffers.
231 231
232This feature works by writing the new contents into a temporary file 232This feature works by writing the new contents into a temporary file
@@ -241,7 +241,7 @@ breaks any hard links between it and other files."
241 :group 'backup) 241 :group 'backup)
242 242
243(defcustom version-control nil 243(defcustom version-control nil
244 "*Control use of version numbers for backup files. 244 "Control use of version numbers for backup files.
245t means make numeric backup versions unconditionally. 245t means make numeric backup versions unconditionally.
246nil means make them for files that have some already. 246nil means make them for files that have some already.
247`never' means do not make them." 247`never' means do not make them."
@@ -254,13 +254,13 @@ nil means make them for files that have some already.
254 '(lambda (x) (or (booleanp x) (equal x 'never)))) 254 '(lambda (x) (or (booleanp x) (equal x 'never))))
255 255
256(defcustom dired-kept-versions 2 256(defcustom dired-kept-versions 2
257 "*When cleaning directory, number of versions to keep." 257 "When cleaning directory, number of versions to keep."
258 :type 'integer 258 :type 'integer
259 :group 'backup 259 :group 'backup
260 :group 'dired) 260 :group 'dired)
261 261
262(defcustom delete-old-versions nil 262(defcustom delete-old-versions nil
263 "*If t, delete excess backup versions silently. 263 "If t, delete excess backup versions silently.
264If nil, ask confirmation. Any other value prevents any trimming." 264If nil, ask confirmation. Any other value prevents any trimming."
265 :type '(choice (const :tag "Delete" t) 265 :type '(choice (const :tag "Delete" t)
266 (const :tag "Ask" nil) 266 (const :tag "Ask" nil)
@@ -268,20 +268,20 @@ If nil, ask confirmation. Any other value prevents any trimming."
268 :group 'backup) 268 :group 'backup)
269 269
270(defcustom kept-old-versions 2 270(defcustom kept-old-versions 2
271 "*Number of oldest versions to keep when a new numbered backup is made." 271 "Number of oldest versions to keep when a new numbered backup is made."
272 :type 'integer 272 :type 'integer
273 :group 'backup) 273 :group 'backup)
274(put 'kept-old-versions 'safe-local-variable 'integerp) 274(put 'kept-old-versions 'safe-local-variable 'integerp)
275 275
276(defcustom kept-new-versions 2 276(defcustom kept-new-versions 2
277 "*Number of newest versions to keep when a new numbered backup is made. 277 "Number of newest versions to keep when a new numbered backup is made.
278Includes the new backup. Must be > 0" 278Includes the new backup. Must be > 0"
279 :type 'integer 279 :type 'integer
280 :group 'backup) 280 :group 'backup)
281(put 'kept-new-versions 'safe-local-variable 'integerp) 281(put 'kept-new-versions 'safe-local-variable 'integerp)
282 282
283(defcustom require-final-newline nil 283(defcustom require-final-newline nil
284 "*Whether to add a newline automatically at the end of the file. 284 "Whether to add a newline automatically at the end of the file.
285 285
286A value of t means do this only when the file is about to be saved. 286A value of t means do this only when the file is about to be saved.
287A value of `visit' means do this right after the file is visited. 287A value of `visit' means do this right after the file is visited.
@@ -299,7 +299,7 @@ from `mode-require-final-newline'."
299 :group 'editing-basics) 299 :group 'editing-basics)
300 300
301(defcustom mode-require-final-newline t 301(defcustom mode-require-final-newline t
302 "*Whether to add a newline at end of file, in certain major modes. 302 "Whether to add a newline at end of file, in certain major modes.
303Those modes set `require-final-newline' to this value when you enable them. 303Those modes set `require-final-newline' to this value when you enable them.
304They do so because they are often used for files that are supposed 304They do so because they are often used for files that are supposed
305to end in newlines, and the question is how to arrange that. 305to end in newlines, and the question is how to arrange that.
@@ -322,12 +322,12 @@ a final newline, whenever you save a file that really needs one."
322 :version "22.1") 322 :version "22.1")
323 323
324(defcustom auto-save-default t 324(defcustom auto-save-default t
325 "*Non-nil says by default do auto-saving of every file-visiting buffer." 325 "Non-nil says by default do auto-saving of every file-visiting buffer."
326 :type 'boolean 326 :type 'boolean
327 :group 'auto-save) 327 :group 'auto-save)
328 328
329(defcustom auto-save-visited-file-name nil 329(defcustom auto-save-visited-file-name nil
330 "*Non-nil says auto-save a buffer in the file it is visiting, when practical. 330 "Non-nil says auto-save a buffer in the file it is visiting, when practical.
331Normally auto-save files are written under other names." 331Normally auto-save files are written under other names."
332 :type 'boolean 332 :type 'boolean
333 :group 'auto-save) 333 :group 'auto-save)
@@ -337,7 +337,7 @@ Normally auto-save files are written under other names."
337 ;; Don't put "\\2" inside expand-file-name, since it will be 337 ;; Don't put "\\2" inside expand-file-name, since it will be
338 ;; transformed to "/2" on DOS/Windows. 338 ;; transformed to "/2" on DOS/Windows.
339 ,(concat temporary-file-directory "\\2") t)) 339 ,(concat temporary-file-directory "\\2") t))
340 "*Transforms to apply to buffer file name before making auto-save file name. 340 "Transforms to apply to buffer file name before making auto-save file name.
341Each transform is a list (REGEXP REPLACEMENT UNIQUIFY): 341Each transform is a list (REGEXP REPLACEMENT UNIQUIFY):
342REGEXP is a regular expression to match against the file name. 342REGEXP is a regular expression to match against the file name.
343If it matches, `replace-match' is used to replace the 343If it matches, `replace-match' is used to replace the
@@ -364,19 +364,19 @@ ignored."
364 :version "21.1") 364 :version "21.1")
365 365
366(defcustom save-abbrevs t 366(defcustom save-abbrevs t
367 "*Non-nil means save word abbrevs too when files are saved. 367 "Non-nil means save word abbrevs too when files are saved.
368If `silently', don't ask the user before saving." 368If `silently', don't ask the user before saving."
369 :type '(choice (const t) (const nil) (const silently)) 369 :type '(choice (const t) (const nil) (const silently))
370 :group 'abbrev) 370 :group 'abbrev)
371 371
372(defcustom find-file-run-dired t 372(defcustom find-file-run-dired t
373 "*Non-nil means allow `find-file' to visit directories. 373 "Non-nil means allow `find-file' to visit directories.
374To visit the directory, `find-file' runs `find-directory-functions'." 374To visit the directory, `find-file' runs `find-directory-functions'."
375 :type 'boolean 375 :type 'boolean
376 :group 'find-file) 376 :group 'find-file)
377 377
378(defcustom find-directory-functions '(cvs-dired-noselect dired-noselect) 378(defcustom find-directory-functions '(cvs-dired-noselect dired-noselect)
379 "*List of functions to try in sequence to visit a directory. 379 "List of functions to try in sequence to visit a directory.
380Each function is called with the directory name as the sole argument 380Each function is called with the directory name as the sole argument
381and should return either a buffer or nil." 381and should return either a buffer or nil."
382 :type '(hook :options (cvs-dired-noselect dired-noselect)) 382 :type '(hook :options (cvs-dired-noselect dired-noselect))
@@ -448,7 +448,7 @@ use `before-save-hook'.")
448 'write-contents-functions "22.1") 448 'write-contents-functions "22.1")
449 449
450(defcustom enable-local-variables t 450(defcustom enable-local-variables t
451 "*Control use of local variables in files you visit. 451 "Control use of local variables in files you visit.
452The value can be t, nil, :safe, or something else. 452The value can be t, nil, :safe, or something else.
453 453
454A value of t means file local variables specifications are obeyed 454A value of t means file local variables specifications are obeyed
@@ -506,7 +506,7 @@ nil means ignore them; anything else means query."
506 (defalias 'file-locked-p 'ignore)) 506 (defalias 'file-locked-p 'ignore))
507 507
508(defcustom view-read-only nil 508(defcustom view-read-only nil
509 "*Non-nil means buffers visiting files read-only do so in view mode. 509 "Non-nil means buffers visiting files read-only do so in view mode.
510In fact, this means that all read-only buffers normally have 510In fact, this means that all read-only buffers normally have
511View mode enabled, including buffers that are read-only because 511View mode enabled, including buffers that are read-only because
512you visit a file you cannot alter, and buffers you make read-only 512you visit a file you cannot alter, and buffers you make read-only
@@ -1324,7 +1324,7 @@ removes automounter prefixes (see the variable `automount-dir-prefix')."
1324 filename))) 1324 filename)))
1325 1325
1326(defcustom find-file-not-true-dirname-list nil 1326(defcustom find-file-not-true-dirname-list nil
1327 "*List of logical names for which visiting shouldn't save the true dirname. 1327 "List of logical names for which visiting shouldn't save the true dirname.
1328On VMS, when you visit a file using a logical name that searches a path, 1328On VMS, when you visit a file using a logical name that searches a path,
1329you may or may not want the visited file name to record the specific 1329you may or may not want the visited file name to record the specific
1330directory where the file was found. If you *do not* want that, add the logical 1330directory where the file was found. If you *do not* want that, add the logical
@@ -1373,7 +1373,7 @@ If there is no such live buffer, return nil."
1373 found)))) 1373 found))))
1374 1374
1375(defcustom find-file-wildcards t 1375(defcustom find-file-wildcards t
1376 "*Non-nil means file-visiting commands should handle wildcards. 1376 "Non-nil means file-visiting commands should handle wildcards.
1377For example, if you specify `*.c', that would visit all the files 1377For example, if you specify `*.c', that would visit all the files
1378whose names match the pattern." 1378whose names match the pattern."
1379 :group 'files 1379 :group 'files
@@ -1381,7 +1381,7 @@ whose names match the pattern."
1381 :type 'boolean) 1381 :type 'boolean)
1382 1382
1383(defcustom find-file-suppress-same-file-warnings nil 1383(defcustom find-file-suppress-same-file-warnings nil
1384 "*Non-nil means suppress warning messages for symlinked files. 1384 "Non-nil means suppress warning messages for symlinked files.
1385When nil, Emacs prints a warning when visiting a file that is already 1385When nil, Emacs prints a warning when visiting a file that is already
1386visited, but with a different name. Setting this option to t 1386visited, but with a different name. Setting this option to t
1387suppresses this warning." 1387suppresses this warning."
@@ -2303,7 +2303,7 @@ symbol and VAL is a value that is considered safe."
2303 :type 'alist) 2303 :type 'alist)
2304 2304
2305(defcustom safe-local-eval-forms nil 2305(defcustom safe-local-eval-forms nil
2306 "*Expressions that are considered safe in an `eval:' local variable. 2306 "Expressions that are considered safe in an `eval:' local variable.
2307Add expressions to this list if you want Emacs to evaluate them, when 2307Add expressions to this list if you want Emacs to evaluate them, when
2308they appear in an `eval' local variable specification, without first 2308they appear in an `eval' local variable specification, without first
2309asking you for confirmation." 2309asking you for confirmation."
@@ -2765,7 +2765,7 @@ It is dangerous if either of these conditions are met:
2765 2765
2766 2766
2767(defcustom change-major-mode-with-file-name t 2767(defcustom change-major-mode-with-file-name t
2768 "*Non-nil means \\[write-file] should set the major mode from the file name. 2768 "Non-nil means \\[write-file] should set the major mode from the file name.
2769However, the mode will not be changed if 2769However, the mode will not be changed if
2770\(1) a local variables list or the `-*-' line specifies a major mode, or 2770\(1) a local variables list or the `-*-' line specifies a major mode, or
2771\(2) the current major mode is a \"special\" mode, 2771\(2) the current major mode is a \"special\" mode,
@@ -4500,7 +4500,7 @@ by `sh' are supported."
4500 4500
4501(defcustom list-directory-brief-switches 4501(defcustom list-directory-brief-switches
4502 (if (eq system-type 'vax-vms) "" "-CF") 4502 (if (eq system-type 'vax-vms) "" "-CF")
4503 "*Switches for `list-directory' to pass to `ls' for brief listing." 4503 "Switches for `list-directory' to pass to `ls' for brief listing."
4504 :type 'string 4504 :type 'string
4505 :group 'dired) 4505 :group 'dired)
4506 4506
@@ -4508,7 +4508,7 @@ by `sh' are supported."
4508 (if (eq system-type 'vax-vms) 4508 (if (eq system-type 'vax-vms)
4509 "/PROTECTION/SIZE/DATE/OWNER/WIDTH=(OWNER:10)" 4509 "/PROTECTION/SIZE/DATE/OWNER/WIDTH=(OWNER:10)"
4510 "-l") 4510 "-l")
4511 "*Switches for `list-directory' to pass to `ls' for verbose listing." 4511 "Switches for `list-directory' to pass to `ls' for verbose listing."
4512 :type 'string 4512 :type 'string
4513 :group 'dired) 4513 :group 'dired)
4514 4514
@@ -4639,7 +4639,7 @@ PATTERN that already quotes some of the special characters."
4639 "Absolute or relative name of the `ls' program used by `insert-directory'.") 4639 "Absolute or relative name of the `ls' program used by `insert-directory'.")
4640 4640
4641(defcustom directory-free-space-program "df" 4641(defcustom directory-free-space-program "df"
4642 "*Program to get the amount of free space on a file system. 4642 "Program to get the amount of free space on a file system.
4643We assume the output has the format of `df'. 4643We assume the output has the format of `df'.
4644The value of this variable must be just a command name or file name; 4644The value of this variable must be just a command name or file name;
4645if you want to specify options, use `directory-free-space-args'. 4645if you want to specify options, use `directory-free-space-args'.
@@ -4653,7 +4653,7 @@ preference to the program given by this variable."
4653 4653
4654(defcustom directory-free-space-args 4654(defcustom directory-free-space-args
4655 (if (eq system-type 'darwin) "-k" "-Pk") 4655 (if (eq system-type 'darwin) "-k" "-Pk")
4656 "*Options to use when running `directory-free-space-program'." 4656 "Options to use when running `directory-free-space-program'."
4657 :type 'string 4657 :type 'string
4658 :group 'dired) 4658 :group 'dired)
4659 4659
diff --git a/lisp/find-file.el b/lisp/find-file.el
index e15d6e62b0b..5618ba58dbe 100644
--- a/lisp/find-file.el
+++ b/lisp/find-file.el
@@ -189,12 +189,16 @@ To override this, give an argument to `ff-find-other-file'."
189 ;; C/C++ include, for NeXTSTEP too 189 ;; C/C++ include, for NeXTSTEP too
190 ("^\#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]" . 190 ("^\#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]" .
191 (lambda () 191 (lambda ()
192 (setq fname (buffer-substring (match-beginning 2) (match-end 2))))) 192 (buffer-substring (match-beginning 2) (match-end 2))))
193 ) 193 )
194 "*A list of regular expressions for `ff-find-file'. 194 ;; We include `ff-treat-as-special' documentation here so that autoload
195Specifies how to recognize special constructs such as include files 195 ;; can make it available to be read prior to loading this file.
196etc. and an associated method for extracting the filename from that 196 "*List of special constructs for `ff-treat-as-special' to recognize.
197construct.") 197Each element, tried in order, has the form (REGEXP . EXTRACT).
198If REGEXP matches the current line (from the beginning of the line),
199`ff-treat-as-special' calls function EXTRACT with no args.
200If EXTRACT returns nil, keep trying. Otherwise, return the
201filename that EXTRACT returned.")
198 202
199(defvaralias 'ff-related-file-alist 'ff-other-file-alist) 203(defvaralias 'ff-related-file-alist 'ff-other-file-alist)
200(defcustom ff-other-file-alist 'cc-other-file-alist 204(defcustom ff-other-file-alist 'cc-other-file-alist
@@ -405,9 +409,7 @@ If optional IN-OTHER-WINDOW is non-nil, find the file in another window."
405 (ff-list-replace-env-vars (symbol-value ff-search-directories)) 409 (ff-list-replace-env-vars (symbol-value ff-search-directories))
406 (ff-list-replace-env-vars ff-search-directories))) 410 (ff-list-replace-env-vars ff-search-directories)))
407 411
408 (save-excursion 412 (setq fname (ff-treat-as-special))
409 (beginning-of-line 1)
410 (setq fname (ff-treat-as-special)))
411 413
412 (cond 414 (cond
413 ((and (not ff-ignore-include) fname) 415 ((and (not ff-ignore-include) fname)
@@ -540,9 +542,7 @@ the `ff-ignore-include' variable."
540 (ff-list-replace-env-vars (symbol-value ff-search-directories)) 542 (ff-list-replace-env-vars (symbol-value ff-search-directories))
541 (ff-list-replace-env-vars ff-search-directories))) 543 (ff-list-replace-env-vars ff-search-directories)))
542 544
543 (save-excursion 545 (setq fname (ff-treat-as-special))
544 (beginning-of-line 1)
545 (setq fname (ff-treat-as-special)))
546 546
547 (cond 547 (cond
548 ((and (not ff-ignore-include) fname) 548 ((and (not ff-ignore-include) fname)
@@ -771,20 +771,22 @@ The value used comes from `ff-case-fold-search'."
771 771
772(defun ff-treat-as-special () 772(defun ff-treat-as-special ()
773 "Return the file to look for if the construct was special, else nil. 773 "Return the file to look for if the construct was special, else nil.
774The construct is defined in the variable `ff-special-constructs'." 774See variable `ff-special-constructs'."
775 (let* (fname 775 (save-excursion
776 (list ff-special-constructs) 776 (beginning-of-line 1)
777 (elem (car list)) 777 (let* (fname
778 (regexp (car elem)) 778 (list ff-special-constructs)
779 (match (cdr elem))) 779 (elem (car list))
780 (while (and list (not fname)) 780 (regexp (car elem))
781 (if (and (looking-at regexp) match) 781 (match (cdr elem)))
782 (setq fname (funcall match))) 782 (while (and list (not fname))
783 (setq list (cdr list)) 783 (if (and (looking-at regexp) match)
784 (setq elem (car list)) 784 (setq fname (funcall match)))
785 (setq regexp (car elem)) 785 (setq list (cdr list))
786 (setq match (cdr elem))) 786 (setq elem (car list))
787 fname)) 787 (setq regexp (car elem))
788 (setq match (cdr elem)))
789 fname)))
788 790
789(defun ff-basename (string) 791(defun ff-basename (string)
790 "Return the basename of pathname STRING." 792 "Return the basename of pathname STRING."
diff --git a/lisp/frame.el b/lisp/frame.el
index f5d3f4b0c37..ff07999f804 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -776,7 +776,9 @@ the user during startup."
776 "*Non-nil if window system changes focus when you move the mouse. 776 "*Non-nil if window system changes focus when you move the mouse.
777You should set this variable to tell Emacs how your window manager 777You should set this variable to tell Emacs how your window manager
778handles focus, since there is no way in general for Emacs to find out 778handles focus, since there is no way in general for Emacs to find out
779automatically." 779automatically.
780
781This variable does not have any effect on MS-Windows."
780 :type 'boolean 782 :type 'boolean
781 :group 'frames 783 :group 'frames
782 :version "20.3") 784 :version "20.3")
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 825a8bce003..beccd918c3e 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,38 @@
12006-07-19 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
2
3 * mm-url.el (mm-url-insert-file-contents): Inhibit Connection: close
4 workaround for the url package included with Emacs.
5
6 * nnweb.el (nnweb-google-create-mapping): Update regexp.
7
82006-07-18 Karl Fogel <kfogel@red-bean.com>
9
10 * nnmail.el (nnmail-article-group): If splitting raises an error, give
11 some information about the error when saying that the `bogus' mail
12 group will be used.
13
142006-07-18 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
15
16 [ Backported bug fixes from No Gnus. ]
17
18 * nnweb.el (nnweb-google-parse-1): Update regexp for author and date.
19 (nnweb-google-search): Respect nnweb-max-hits as upper bound.
20 (nnweb-request-article): Do proper xwfu encoding when fetching articles
21 by message-id.
22
23 * gnus-srvr.el (gnus-browse-unsubscribe-group): Don't subscribe
24 unsubscribed groups as if they were killed ones. It causes duplicate
25 entries in gnus-newsrc-alist.
26
272006-07-17 Reiner Steib <Reiner.Steib@gmx.de>
28
29 * gnus-sum.el (gnus-summary-delete-article): Don't use TAB in doc
30 string.
31
322006-07-16 NAKAJI Hiroyuki <nakaji@heimat.jp> (tiny change)
33
34 * mm-util.el (mm-charset-synonym-alist): Map windows-31j to cp932.
35
12006-07-14 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de> 362006-07-14 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
2 37
3 * gnus-start.el (gnus-subscribe-options-newsgroup-method): Doc fix. 38 * gnus-start.el (gnus-subscribe-options-newsgroup-method): Doc fix.
@@ -131,8 +166,7 @@
131 (mm-display-part): Simplify. 166 (mm-display-part): Simplify.
132 (mm-inlinable-p): Add optional arg `type'. 167 (mm-inlinable-p): Add optional arg `type'.
133 168
134 * gnus-art.el (gnus-mime-view-part-as-type): Add optional PRED 169 * gnus-art.el (gnus-mime-view-part-as-type): Add optional PRED arg.
135 argument.
136 (gnus-mime-view-part-externally, gnus-mime-view-part-internally): 170 (gnus-mime-view-part-externally, gnus-mime-view-part-internally):
137 Try harder to show the attachment internally or externally using 171 Try harder to show the attachment internally or externally using
138 gnus-mime-view-part-as-type. 172 gnus-mime-view-part-as-type.
@@ -142,8 +176,7 @@
142 * gnus-art.el (gnus-mime-view-part-as-type-internal): Try to fetch 176 * gnus-art.el (gnus-mime-view-part-as-type-internal): Try to fetch
143 `filename' from Content-Disposition if Content-Type doesn't 177 `filename' from Content-Disposition if Content-Type doesn't
144 provide `name'. 178 provide `name'.
145 (gnus-mime-view-part-as-type): Set default instead of 179 (gnus-mime-view-part-as-type): Set default instead of initial-input.
146 initial-input.
147 180
1482006-04-28 Katsumi Yamaoka <yamaoka@jpl.org> 1812006-04-28 Katsumi Yamaoka <yamaoka@jpl.org>
149 182
@@ -166,8 +199,8 @@
166 199
167 * mml-sec.el (mml-secure-method): New internal variable. 200 * mml-sec.el (mml-secure-method): New internal variable.
168 (mml-secure-sign, mml-secure-encrypt, mml-secure-message-sign) 201 (mml-secure-sign, mml-secure-encrypt, mml-secure-message-sign)
169 (mml-secure-message-sign-encrypt, mml-secure-message-encrypt): New 202 (mml-secure-message-sign-encrypt, mml-secure-message-encrypt):
170 functions using mml-secure-method. Sync from the trunk. 203 New functions using mml-secure-method. Sync from the trunk.
171 204
172 * mml.el (mml-mode-map): Add key bindings for those functions. 205 * mml.el (mml-mode-map): Add key bindings for those functions.
173 (mml-menu): Simplify security menu entries. Suggested by Jesper 206 (mml-menu): Simplify security menu entries. Suggested by Jesper
@@ -211,8 +244,8 @@
211 244
2122006-04-20 Reiner Steib <Reiner.Steib@gmx.de> 2452006-04-20 Reiner Steib <Reiner.Steib@gmx.de>
213 246
214 * gnus-util.el (gnus-replace-in-string): Prefer 247 * gnus-util.el (gnus-replace-in-string):
215 replace-regexp-in-string over of replace-in-string. 248 Prefer replace-regexp-in-string over of replace-in-string.
216 249
2172006-04-20 Katsumi Yamaoka <yamaoka@jpl.org> 2502006-04-20 Katsumi Yamaoka <yamaoka@jpl.org>
218 251
@@ -220,8 +253,8 @@
220 253
221 * gnus-sum.el: Ditto. 254 * gnus-sum.el: Ditto.
222 255
223 * gnus-util.el (gnus-select-frame-set-input-focus): Use 256 * gnus-util.el (gnus-select-frame-set-input-focus):
224 select-frame-set-input-focus if it is available in XEmacs; use 257 Use select-frame-set-input-focus if it is available in XEmacs; use
225 definition defined in Emacs 22 for old Emacsen. 258 definition defined in Emacs 22 for old Emacsen.
226 259
2272006-04-17 Reiner Steib <Reiner.Steib@gmx.de> 2602006-04-17 Reiner Steib <Reiner.Steib@gmx.de>
@@ -233,13 +266,13 @@
233 (mm-charset-to-coding-system): Use it. 266 (mm-charset-to-coding-system): Use it.
234 (mm-codepage-setup): New helper function. 267 (mm-codepage-setup): New helper function.
235 (mm-charset-eval-alist): New variable. 268 (mm-charset-eval-alist): New variable.
236 (mm-charset-to-coding-system): Use mm-charset-eval-alist. Warn 269 (mm-charset-to-coding-system): Use mm-charset-eval-alist.
237 about unknown charsets. Add allow-override. Use 270 Warn about unknown charsets. Add allow-override.
238 `mm-charset-override-alist' only when decoding. 271 Use `mm-charset-override-alist' only when decoding.
239 (mm-detect-mime-charset-region): Use :mime-charset. 272 (mm-detect-mime-charset-region): Use :mime-charset.
240 273
241 * mm-bodies.el (mm-decode-body, mm-decode-string): Call 274 * mm-bodies.el (mm-decode-body, mm-decode-string):
242 `mm-charset-to-coding-system' with allow-override argument. 275 Call `mm-charset-to-coding-system' with allow-override argument.
243 276
244 * message.el (message-tool-bar-zap-list, message-tool-bar) 277 * message.el (message-tool-bar-zap-list, message-tool-bar)
245 (message-tool-bar-gnome, message-tool-bar-retro): New variables. 278 (message-tool-bar-gnome, message-tool-bar-retro): New variables.
@@ -255,8 +288,8 @@
255 `gmm-tool-bar-from-list'. 288 `gmm-tool-bar-from-list'.
256 289
257 * gnus-group.el (gnus-group-tool-bar, gnus-group-tool-bar-gnome) 290 * gnus-group.el (gnus-group-tool-bar, gnus-group-tool-bar-gnome)
258 (gnus-group-tool-bar-retro, gnus-group-tool-bar-zap-list): New 291 (gnus-group-tool-bar-retro, gnus-group-tool-bar-zap-list):
259 variables. 292 New variables.
260 (gnus-group-make-tool-bar): Complete rewrite using 293 (gnus-group-make-tool-bar): Complete rewrite using
261 `gmm-tool-bar-from-list'. 294 `gmm-tool-bar-from-list'.
262 (gnus-group-tool-bar-update): New function. 295 (gnus-group-tool-bar-update): New function.
@@ -270,8 +303,8 @@
270 303
2712006-04-12 Reiner Steib <Reiner.Steib@gmx.de> 3042006-04-12 Reiner Steib <Reiner.Steib@gmx.de>
272 305
273 * gnus-art.el (gnus-article-mode): Set 306 * gnus-art.el (gnus-article-mode):
274 cursor-in-non-selected-windows to nil. 307 Set cursor-in-non-selected-windows to nil.
275 308
2762006-04-12 Katsumi Yamaoka <yamaoka@jpl.org> 3092006-04-12 Katsumi Yamaoka <yamaoka@jpl.org>
277 310
@@ -302,8 +335,7 @@
302 335
3032006-04-11 Lars Magne Ingebrigtsen <larsi@gnus.org> 3362006-04-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
304 337
305 * nnslashdot.el (nnslashdot-retrieve-headers-1): Fix up to new 338 * nnslashdot.el (nnslashdot-retrieve-headers-1): Fix up to new layout.
306 layout.
307 339
308 * rfc2047.el (rfc2047-decode-encoded-words): Don't message about 340 * rfc2047.el (rfc2047-decode-encoded-words): Don't message about
309 unknown charset. 341 unknown charset.
@@ -365,13 +397,12 @@
365 397
366 * gnus-agent.el (gnus-agent-queue-mail): Fix custom tag for `t'. 398 * gnus-agent.el (gnus-agent-queue-mail): Fix custom tag for `t'.
367 399
368 * spam.el (spam-mark-new-messages-in-spam-group-as-spam): Add 400 * spam.el (spam-mark-new-messages-in-spam-group-as-spam):
369 comment on version. 401 Add comment on version.
370 402
3712006-03-20 Teodor Zlatanov <tzz@lifelogs.com> 4032006-03-20 Teodor Zlatanov <tzz@lifelogs.com>
372 404
373 * spam.el (spam-mark-new-messages-in-spam-group-as-spam): New 405 * spam.el (spam-mark-new-messages-in-spam-group-as-spam): New variable.
374 variable.
375 (spam-mark-junk-as-spam-routine): Use it. Allow to disable 406 (spam-mark-junk-as-spam-routine): Use it. Allow to disable
376 assigning the spam-mark to new messages. 407 assigning the spam-mark to new messages.
377 408
@@ -402,14 +433,14 @@
402 433
403 * gnus-art.el (gnus-article-only-boring-p): 434 * gnus-art.el (gnus-article-only-boring-p):
404 Bind inhibit-point-motion-hooks to avoid infinite loop when entering 435 Bind inhibit-point-motion-hooks to avoid infinite loop when entering
405 intangible text. Reported by Ralf Wachinger 436 intangible text.
406 <rwnewsmampfer@geekmail.de>. 437 Reported by Ralf Wachinger <rwnewsmampfer@geekmail.de>.
407 438
4082006-03-14 Simon Josefsson <jas@extundo.com> 4392006-03-14 Simon Josefsson <jas@extundo.com>
409 440
410 * message.el (message-unique-id): Don't use message-number-base36 441 * message.el (message-unique-id): Don't use message-number-base36
411 if (user-uid) is a float. Reported by Bjorn Solberg 442 if (user-uid) is a float.
412 <bjorn_ding1@hekneby.org>. 443 Reported by Bjorn Solberg <bjorn_ding1@hekneby.org>.
413 444
4142006-03-13 Katsumi Yamaoka <yamaoka@jpl.org> 4452006-03-13 Katsumi Yamaoka <yamaoka@jpl.org>
415 446
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index 5d4f9c2a3f6..aabf8efbf6b 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -943,19 +943,23 @@ If NUMBER, fetch this number of articles."
943 (progn 943 (progn
944 ;; Make sure the group has been properly removed before we 944 ;; Make sure the group has been properly removed before we
945 ;; subscribe to it. 945 ;; subscribe to it.
946 (gnus-kill-ephemeral-group group) 946 (if (gnus-ephemeral-group-p group)
947 (gnus-kill-ephemeral-group group))
948 ;; We need to discern between killed/zombie groups and
949 ;; just unsubscribed ones.
947 (gnus-group-change-level 950 (gnus-group-change-level
948 (list t group gnus-level-default-subscribed 951 (or (gnus-group-entry group)
949 nil nil (if (gnus-server-equal 952 (list t group gnus-level-default-subscribed
950 gnus-browse-current-method "native") 953 nil nil (if (gnus-server-equal
951 nil 954 gnus-browse-current-method "native")
952 (gnus-method-simplify 955 nil
953 gnus-browse-current-method))) 956 (gnus-method-simplify
957 gnus-browse-current-method))))
954 gnus-level-default-subscribed (gnus-group-level group) 958 gnus-level-default-subscribed (gnus-group-level group)
955 (and (car (nth 1 gnus-newsrc-alist)) 959 (and (car (nth 1 gnus-newsrc-alist))
956 (gnus-gethash (car (nth 1 gnus-newsrc-alist)) 960 (gnus-gethash (car (nth 1 gnus-newsrc-alist))
957 gnus-newsrc-hashtb)) 961 gnus-newsrc-hashtb))
958 t) 962 (null (gnus-group-entry group)))
959 (delete-char 1) 963 (delete-char 1)
960 (insert ? )) 964 (insert ? ))
961 (gnus-group-change-level 965 (gnus-group-change-level
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 66ab41950d1..b94d093329a 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -9510,7 +9510,7 @@ deleted forever, right now."
9510;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. 9510;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
9511(defun gnus-summary-delete-article (&optional n) 9511(defun gnus-summary-delete-article (&optional n)
9512 "Delete the N next (mail) articles. 9512 "Delete the N next (mail) articles.
9513This command actually deletes articles. This is not a marking 9513This command actually deletes articles. This is not a marking
9514command. The article will disappear forever from your life, never to 9514command. The article will disappear forever from your life, never to
9515return. 9515return.
9516 9516
diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el
index ba21247f356..5e228f0af72 100644
--- a/lisp/gnus/mm-url.el
+++ b/lisp/gnus/mm-url.el
@@ -301,7 +301,13 @@ If `mm-url-use-external' is non-nil, use `mm-url-program'."
301 (list url (buffer-size))) 301 (list url (buffer-size)))
302 (mm-url-load-url) 302 (mm-url-load-url)
303 (let ((name buffer-file-name) 303 (let ((name buffer-file-name)
304 (url-request-extra-headers (list (cons "Connection" "Close"))) 304 (url-request-extra-headers
305 ;; ISTM setting a Connection header was a workaround for
306 ;; older versions of url included with w3, but it does more
307 ;; harm than good with the one shipped with Emacs. --ansel
308 (if (not (and (boundp 'url-version)
309 (equal url-version "Emacs")))
310 (list (cons "Connection" "Close"))))
305 (url-package-name (or mm-url-package-name 311 (url-package-name (or mm-url-package-name
306 url-package-name)) 312 url-package-name))
307 (url-package-version (or mm-url-package-version 313 (url-package-version (or mm-url-package-version
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index 634d1f66675..26a1bf23e84 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -204,19 +204,19 @@ the alias. Else windows-NUMBER is used."
204 `( 204 `(
205 ;; Not in XEmacs, but it's not a proper MIME charset anyhow. 205 ;; Not in XEmacs, but it's not a proper MIME charset anyhow.
206 ,@(unless (mm-coding-system-p 'x-ctext) 206 ,@(unless (mm-coding-system-p 'x-ctext)
207 '((x-ctext . ctext))) 207 '((x-ctext . ctext)))
208 ;; ISO-8859-15 is very similar to ISO-8859-1. But it's _different_! 208 ;; ISO-8859-15 is very similar to ISO-8859-1. But it's _different_!
209 ,@(unless (mm-coding-system-p 'iso-8859-15) 209 ,@(unless (mm-coding-system-p 'iso-8859-15)
210 '((iso-8859-15 . iso-8859-1))) 210 '((iso-8859-15 . iso-8859-1)))
211 ;; BIG-5HKSCS is similar to, but different than, BIG-5. 211 ;; BIG-5HKSCS is similar to, but different than, BIG-5.
212 ,@(unless (mm-coding-system-p 'big5-hkscs) 212 ,@(unless (mm-coding-system-p 'big5-hkscs)
213 '((big5-hkscs . big5))) 213 '((big5-hkscs . big5)))
214 ;; Windows-1252 is actually a superset of Latin-1. See also 214 ;; Windows-1252 is actually a superset of Latin-1. See also
215 ;; `gnus-article-dumbquotes-map'. 215 ;; `gnus-article-dumbquotes-map'.
216 ,@(unless (mm-coding-system-p 'windows-1252) 216 ,@(unless (mm-coding-system-p 'windows-1252)
217 (if (mm-coding-system-p 'cp1252) 217 (if (mm-coding-system-p 'cp1252)
218 '((windows-1252 . cp1252)) 218 '((windows-1252 . cp1252))
219 '((windows-1252 . iso-8859-1)))) 219 '((windows-1252 . iso-8859-1))))
220 ;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft 220 ;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft
221 ;; Outlook users in Czech republic. Use this to allow reading of their 221 ;; Outlook users in Czech republic. Use this to allow reading of their
222 ;; e-mails. cp1250 should be defined by M-x codepage-setup. 222 ;; e-mails. cp1250 should be defined by M-x codepage-setup.
@@ -232,6 +232,10 @@ the alias. Else windows-NUMBER is used."
232 (if (mm-coding-system-p 'cp949) 232 (if (mm-coding-system-p 'cp949)
233 '((ks_c_5601-1987 . cp949)) 233 '((ks_c_5601-1987 . cp949))
234 '((ks_c_5601-1987 . euc-kr)))) 234 '((ks_c_5601-1987 . euc-kr))))
235 ;; Windows-31J is Windows Codepage 932.
236 ,@(if (and (not (mm-coding-system-p 'windows-31j))
237 (mm-coding-system-p 'cp932))
238 '((windows-31j . cp932)))
235 ) 239 )
236 "A mapping from unknown or invalid charset names to the real charset names.") 240 "A mapping from unknown or invalid charset names to the real charset names.")
237 241
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index f4275fa8ed5..98af7ba41f2 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -1131,7 +1131,7 @@ FUNC will be called with the group name to determine the article number."
1131 (if (and (symbolp nnmail-split-methods) 1131 (if (and (symbolp nnmail-split-methods)
1132 (fboundp nnmail-split-methods)) 1132 (fboundp nnmail-split-methods))
1133 (let ((split 1133 (let ((split
1134 (condition-case nil 1134 (condition-case error-info
1135 ;; `nnmail-split-methods' is a function, so we 1135 ;; `nnmail-split-methods' is a function, so we
1136 ;; just call this function here and use the 1136 ;; just call this function here and use the
1137 ;; result. 1137 ;; result.
@@ -1139,7 +1139,7 @@ FUNC will be called with the group name to determine the article number."
1139 '("bogus")) 1139 '("bogus"))
1140 (error 1140 (error
1141 (nnheader-message 1141 (nnheader-message
1142 5 "Error in `nnmail-split-methods'; using `bogus' mail group") 1142 5 "Error in `nnmail-split-methods'; using `bogus' mail group: %S" error-info)
1143 (sit-for 1) 1143 (sit-for 1)
1144 '("bogus"))))) 1144 '("bogus")))))
1145 (setq split (mm-delete-duplicates split)) 1145 (setq split (mm-delete-duplicates split))
diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el
index a67d5a469f6..7c0c8e0e444 100644
--- a/lisp/gnus/nnweb.el
+++ b/lisp/gnus/nnweb.el
@@ -171,7 +171,8 @@ Valid types include `google', `dejanews', and `gmane'.")
171 (when (string-match "^<\\(.*\\)>$" article) 171 (when (string-match "^<\\(.*\\)>$" article)
172 (setq art (match-string 1 article))) 172 (setq art (match-string 1 article)))
173 (when (and fetch art) 173 (when (and fetch art)
174 (setq url (format fetch art)) 174 (setq url (format fetch
175 (mm-url-form-encode-xwfu art)))
175 (mm-with-unibyte-current-buffer 176 (mm-with-unibyte-current-buffer
176 (mm-url-insert url)) 177 (mm-url-insert url))
177 (if (nnweb-definition 'reference t) 178 (if (nnweb-definition 'reference t)
@@ -365,7 +366,7 @@ Valid types include `google', `dejanews', and `gmane'.")
365 (mm-url-decode-entities) 366 (mm-url-decode-entities)
366 (search-backward " - ") 367 (search-backward " - ")
367 (when (looking-at 368 (when (looking-at
368 " - \\([a-zA-Z]+\\) \\([0-9]+\\)\\(?: \\([0-9]\\{4\\}\\)\\)?, [^\n]+by \\([^<\n]+\\)\n") 369 " - \\([a-zA-Z]+\\) \\([0-9]+\\)\\(?: \\([0-9]\\{4\\}\\)\\)?[^\n]+by ?\n?\\([^<\n]+\\)\n")
369 (setq From (match-string 4) 370 (setq From (match-string 4)
370 Date (format "%s %s 00:00:00 %s" 371 Date (format "%s %s 00:00:00 %s"
371 (match-string 1) 372 (match-string 1)
@@ -415,7 +416,7 @@ Valid types include `google', `dejanews', and `gmane'.")
415 (goto-char (point-min)) 416 (goto-char (point-min))
416 (incf i 100) 417 (incf i 100)
417 (if (or (not (re-search-forward 418 (if (or (not (re-search-forward
418 "<a href=\"\n\\([^>\" \n\t]+\\)[^<]*<img src=[^>]+next" 419 "<a [^>]+href=\"\n?\\([^>\" \n\t]+\\)[^<]*<img[^>]+src=[^>]+next"
419 nil t)) 420 nil t))
420 (>= i nnweb-max-hits)) 421 (>= i nnweb-max-hits))
421 (setq more nil) 422 (setq more nil)
@@ -437,7 +438,8 @@ Valid types include `google', `dejanews', and `gmane'.")
437 "?" 438 "?"
438 (mm-url-encode-www-form-urlencoded 439 (mm-url-encode-www-form-urlencoded
439 `(("q" . ,search) 440 `(("q" . ,search)
440 ("num" . "100") 441 ("num" . ,(number-to-string
442 (min 100 nnweb-max-hits)))
441 ("hq" . "") 443 ("hq" . "")
442 ("hl" . "en") 444 ("hl" . "en")
443 ("lr" . "") 445 ("lr" . "")
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index 7cdf78fbe13..ce79e618cd5 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -157,8 +157,9 @@ The format is (FUNCTION ARGS...).")
157 (let ((location 157 (let ((location
158 (find-function-search-for-symbol fun nil file))) 158 (find-function-search-for-symbol fun nil file)))
159 (pop-to-buffer (car location)) 159 (pop-to-buffer (car location))
160 (when (cdr location) 160 (if (cdr location)
161 (goto-char (cdr location))))) 161 (goto-char (cdr location))
162 (message "Unable to find location in file"))))
162 'help-echo (purecopy "mouse-2, RET: find function's definition")) 163 'help-echo (purecopy "mouse-2, RET: find function's definition"))
163 164
164(define-button-type 'help-variable-def 165(define-button-type 'help-variable-def
@@ -168,8 +169,9 @@ The format is (FUNCTION ARGS...).")
168 (setq file (help-C-file-name var 'var))) 169 (setq file (help-C-file-name var 'var)))
169 (let ((location (find-variable-noselect var file))) 170 (let ((location (find-variable-noselect var file)))
170 (pop-to-buffer (car location)) 171 (pop-to-buffer (car location))
171 (when (cdr location) 172 (if (cdr location)
172 (goto-char (cdr location))))) 173 (goto-char (cdr location))
174 (message "Unable to find location in file"))))
173 'help-echo (purecopy "mouse-2, RET: find variable's definition")) 175 'help-echo (purecopy "mouse-2, RET: find variable's definition"))
174 176
175(define-button-type 'help-face-def 177(define-button-type 'help-face-def
@@ -181,8 +183,9 @@ The format is (FUNCTION ARGS...).")
181 (let ((location 183 (let ((location
182 (find-function-search-for-symbol fun 'defface file))) 184 (find-function-search-for-symbol fun 'defface file)))
183 (pop-to-buffer (car location)) 185 (pop-to-buffer (car location))
184 (when (cdr location) 186 (if (cdr location)
185 (goto-char (cdr location))))) 187 (goto-char (cdr location))
188 (message "Unable to find location in file"))))
186 'help-echo (purecopy "mouse-2, RET: find face's definition")) 189 'help-echo (purecopy "mouse-2, RET: find face's definition"))
187 190
188 191
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index b5f9c4f1bcf..29767cee7f6 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -66,7 +66,7 @@ the ability to filter the displayed buffers by various criteria."
66 66
67(defcustom ibuffer-formats '((mark modified read-only " " (name 18 18 :left :elide) 67(defcustom ibuffer-formats '((mark modified read-only " " (name 18 18 :left :elide)
68 " " (size 9 -1 :right) 68 " " (size 9 -1 :right)
69 " " (mode 16 16 :right :elide) " " filename-and-process) 69 " " (mode 16 16 :left :elide) " " filename-and-process)
70 (mark " " (name 16 -1) " " filename)) 70 (mark " " (name 16 -1) " " filename))
71 "A list of ways to display buffer lines. 71 "A list of ways to display buffer lines.
72 72
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index 66d7fb6c16a..523ef3f73a8 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -118,6 +118,9 @@ information on these modes."
118 (if (get-text-property (point-min) 'display) 118 (if (get-text-property (point-min) 'display)
119 (image-toggle-display))) 119 (image-toggle-display)))
120 120
121(defvar archive-superior-buffer)
122(defvar tar-superior-buffer)
123
121(defun image-toggle-display () 124(defun image-toggle-display ()
122 "Start or stop displaying an image file as the actual image. 125 "Start or stop displaying an image file as the actual image.
123This command toggles between showing the text of the image file 126This command toggles between showing the text of the image file
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 1cd077413c3..aecf2128456 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -831,7 +831,7 @@ re-visited and edited.)
831Optional 3rd arg DEFAULT-CODING-SYSTEM specifies a coding system or a 831Optional 3rd arg DEFAULT-CODING-SYSTEM specifies a coding system or a
832list of coding systems to be prepended to the default coding system 832list of coding systems to be prepended to the default coding system
833list. However, if DEFAULT-CODING-SYSTEM is a list and the first 833list. However, if DEFAULT-CODING-SYSTEM is a list and the first
834element is t, the cdr part is used as the defualt coding system list, 834element is t, the cdr part is used as the default coding system list,
835i.e. `buffer-file-coding-system', `default-buffer-file-coding-system', 835i.e. `buffer-file-coding-system', `default-buffer-file-coding-system',
836and the most preferred coding system are not used. 836and the most preferred coding system are not used.
837 837
@@ -898,9 +898,6 @@ It is highly recommended to fix it before writing to a file."
898 (rassq base default-coding-system) 898 (rassq base default-coding-system)
899 (push (cons auto-cs base) default-coding-system)))) 899 (push (cons auto-cs base) default-coding-system))))
900 900
901 ;; From now on, the list of defaults is reversed.
902 (setq default-coding-system (nreverse default-coding-system))
903
904 (unless no-other-defaults 901 (unless no-other-defaults
905 ;; If buffer-file-coding-system is not nil nor undecided, append it 902 ;; If buffer-file-coding-system is not nil nor undecided, append it
906 ;; to the defaults. 903 ;; to the defaults.
@@ -908,8 +905,9 @@ It is highly recommended to fix it before writing to a file."
908 (let ((base (coding-system-base buffer-file-coding-system))) 905 (let ((base (coding-system-base buffer-file-coding-system)))
909 (or (eq base 'undecided) 906 (or (eq base 'undecided)
910 (rassq base default-coding-system) 907 (rassq base default-coding-system)
911 (push (cons buffer-file-coding-system base) 908 (setq default-coding-system
912 default-coding-system)))) 909 (append default-coding-system
910 (list (cons buffer-file-coding-system base)))))))
913 911
914 ;; If default-buffer-file-coding-system is not nil nor undecided, 912 ;; If default-buffer-file-coding-system is not nil nor undecided,
915 ;; append it to the defaults. 913 ;; append it to the defaults.
@@ -917,8 +915,10 @@ It is highly recommended to fix it before writing to a file."
917 (let ((base (coding-system-base default-buffer-file-coding-system))) 915 (let ((base (coding-system-base default-buffer-file-coding-system)))
918 (or (eq base 'undecided) 916 (or (eq base 'undecided)
919 (rassq base default-coding-system) 917 (rassq base default-coding-system)
920 (push (cons default-buffer-file-coding-system base) 918 (setq default-coding-system
921 default-coding-system)))) 919 (append default-coding-system
920 (list (cons default-buffer-file-coding-system
921 base)))))))
922 922
923 ;; If the most preferred coding system has the property mime-charset, 923 ;; If the most preferred coding system has the property mime-charset,
924 ;; append it to the defaults. 924 ;; append it to the defaults.
@@ -930,18 +930,40 @@ It is highly recommended to fix it before writing to a file."
930 (setq base (coding-system-base preferred)) 930 (setq base (coding-system-base preferred))
931 (coding-system-get preferred 'mime-charset) 931 (coding-system-get preferred 'mime-charset)
932 (not (rassq base default-coding-system)) 932 (not (rassq base default-coding-system))
933 (push (cons preferred base) 933 (setq default-coding-system
934 default-coding-system)))) 934 (append default-coding-system
935 (list (cons preferred base)))))))
935 936
936 (if select-safe-coding-system-accept-default-p 937 (if select-safe-coding-system-accept-default-p
937 (setq accept-default-p select-safe-coding-system-accept-default-p)) 938 (setq accept-default-p select-safe-coding-system-accept-default-p))
938 939
940 ;; Decide the eol-type from the top of the default codings,
941 ;; buffer-file-coding-system, or
942 ;; default-buffer-file-coding-system.
943 (if default-coding-system
944 (let ((default-eol-type (coding-system-eol-type
945 (caar default-coding-system))))
946 (if (and (vectorp default-eol-type) buffer-file-coding-system)
947 (setq default-eol-type (coding-system-eol-type
948 buffer-file-coding-system)))
949 (if (and (vectorp default-eol-type) default-buffer-file-coding-system)
950 (setq default-eol-type (coding-system-eol-type
951 default-buffer-file-coding-system)))
952 (if (and default-eol-type (not (vectorp default-eol-type)))
953 (dolist (elt default-coding-system)
954 (setcar elt (coding-system-change-eol-conversion
955 (car elt) default-eol-type))))))
956
939 (let ((codings (find-coding-systems-region from to)) 957 (let ((codings (find-coding-systems-region from to))
940 (coding-system nil) 958 (coding-system nil)
941 safe rejected unsafe) 959 safe rejected unsafe)
942 (if (eq (car codings) 'undecided) 960 (if (eq (car codings) 'undecided)
943 ;; Any coding system is ok. 961 ;; Any coding system is ok.
944 (setq coding-system t) 962 (setq coding-system (caar default-coding-system))
963 ;; Reverse the list so that elements are accumulated in safe,
964 ;; rejected, and unsafe in the correct order.
965 (setq default-coding-system (nreverse default-coding-system))
966
945 ;; Classify the defaults into safe, rejected, and unsafe. 967 ;; Classify the defaults into safe, rejected, and unsafe.
946 (dolist (elt default-coding-system) 968 (dolist (elt default-coding-system)
947 (if (memq (cdr elt) codings) 969 (if (memq (cdr elt) codings)
@@ -958,14 +980,6 @@ It is highly recommended to fix it before writing to a file."
958 (setq coding-system (select-safe-coding-system-interactively 980 (setq coding-system (select-safe-coding-system-interactively
959 from to codings unsafe rejected (car codings)))) 981 from to codings unsafe rejected (car codings))))
960 982
961 (if (vectorp (coding-system-eol-type coding-system))
962 (let ((eol (coding-system-eol-type buffer-file-coding-system)))
963 (if (numberp eol)
964 (setq coding-system
965 (coding-system-change-eol-conversion coding-system eol)))))
966
967 (if (eq coding-system t)
968 (setq coding-system buffer-file-coding-system))
969 ;; Check we're not inconsistent with what `coding:' spec &c would 983 ;; Check we're not inconsistent with what `coding:' spec &c would
970 ;; give when file is re-read. 984 ;; give when file is re-read.
971 ;; But don't do this if we explicitly ignored the cookie 985 ;; But don't do this if we explicitly ignored the cookie
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 145eb76446f..043c78578db 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -777,8 +777,8 @@ If the click is in the echo area, display the `*Messages*' buffer."
777 777
778(defun mouse-on-link-p (pos) 778(defun mouse-on-link-p (pos)
779 "Return non-nil if POS is on a link in the current buffer. 779 "Return non-nil if POS is on a link in the current buffer.
780POS must be a buffer position in the current buffer or an mouse 780POS must be a buffer position in the current buffer or a mouse
781event location in the selected window, see `event-start'. 781event location in the selected window (see `event-start').
782However, if `mouse-1-click-in-non-selected-windows' is non-nil, 782However, if `mouse-1-click-in-non-selected-windows' is non-nil,
783POS may be a mouse event location in any window. 783POS may be a mouse event location in any window.
784 784
@@ -798,7 +798,7 @@ is a non-nil `mouse-face' property at POS. Return t in this case.
798 798
799- If the value is a function, FUNC, POS is inside a link if 799- If the value is a function, FUNC, POS is inside a link if
800the call \(FUNC POS) returns non-nil. Return the return value 800the call \(FUNC POS) returns non-nil. Return the return value
801from that call. Arg is \(posn-point POS) if POS is a mouse event, 801from that call. Arg is \(posn-point POS) if POS is a mouse event.
802 802
803- Otherwise, return the value itself. 803- Otherwise, return the value itself.
804 804
diff --git a/lisp/pgg-def.el b/lisp/pgg-def.el
index 058dca4fa8f..6481a433423 100644
--- a/lisp/pgg-def.el
+++ b/lisp/pgg-def.el
@@ -87,7 +87,7 @@ Whether the passphrase is cached at all is controlled by
87 "If t, inform the recipient that the input is text.") 87 "If t, inform the recipient that the input is text.")
88 88
89(defmacro pgg-truncate-key-identifier (key) 89(defmacro pgg-truncate-key-identifier (key)
90 `(if (> (length ,key) 8) (substring ,key 8) ,key)) 90 `(if (> (length ,key) 8) (substring ,key -8) ,key))
91 91
92(provide 'pgg-def) 92(provide 'pgg-def)
93 93
diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el
index 9dc74264da8..bc00d859c2d 100644
--- a/lisp/progmodes/ada-mode.el
+++ b/lisp/progmodes/ada-mode.el
@@ -1208,60 +1208,36 @@ If you use ada-xref.el:
1208 ff-file-created-hook 'ada-make-body) 1208 ff-file-created-hook 'ada-make-body)
1209 (add-hook 'ff-pre-load-hook 'ada-which-function-are-we-in) 1209 (add-hook 'ff-pre-load-hook 'ada-which-function-are-we-in)
1210 1210
1211 ;; Some special constructs for find-file.el 1211 ;; Some special constructs for find-file.el.
1212 ;; We do not need to add the construction for 'with', which is in the
1213 ;; standard find-file.el
1214 (make-local-variable 'ff-special-constructs) 1212 (make-local-variable 'ff-special-constructs)
1215 1213 (mapc (lambda (pair)
1216 ;; Go to the parent package : 1214 (add-to-list 'ff-special-constructs pair))
1217 (add-to-list 'ff-special-constructs 1215 `(
1218 (cons (eval-when-compile 1216 ;; Go to the parent package.
1219 (concat "^\\(private[ \t]\\)?[ \t]*package[ \t]+" 1217 (,(eval-when-compile
1220 "\\(body[ \t]+\\)?" 1218 (concat "^\\(private[ \t]\\)?[ \t]*package[ \t]+"
1221 "\\(\\(\\sw\\|[_.]\\)+\\)\\.\\(\\sw\\|_\\)+[ \t\n]+is")) 1219 "\\(body[ \t]+\\)?"
1222 (lambda () 1220 "\\(\\(\\sw\\|[_.]\\)+\\)\\.\\(\\sw\\|_\\)+[ \t\n]+is"))
1223 (if (fboundp 'ff-get-file) 1221 . ,(lambda ()
1224 (if (boundp 'fname) 1222 (ff-get-file
1225 (set 'fname (ff-get-file 1223 ada-search-directories-internal
1226 ada-search-directories-internal 1224 (ada-make-filename-from-adaname (match-string 3))
1227 (ada-make-filename-from-adaname 1225 ada-spec-suffixes)))
1228 (match-string 3)) 1226 ;; A "separate" clause.
1229 ada-spec-suffixes))))))) 1227 ("^separate[ \t\n]*(\\(\\(\\sw\\|[_.]\\)+\\))"
1230 ;; Another special construct for find-file.el : when in a separate clause, 1228 . ,(lambda ()
1231 ;; go to the correct package. 1229 (ff-get-file
1232 (add-to-list 'ff-special-constructs 1230 ada-search-directories-internal
1233 (cons "^separate[ \t\n]*(\\(\\(\\sw\\|[_.]\\)+\\))" 1231 (ada-make-filename-from-adaname (match-string 1))
1234 (lambda () 1232 ada-spec-suffixes)))
1235 (if (fboundp 'ff-get-file) 1233 ;; A "with" clause.
1236 (if (boundp 'fname) 1234 ("^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)"
1237 (setq fname (ff-get-file 1235 . ,(lambda ()
1238 ada-search-directories-internal 1236 (ff-get-file
1239 (ada-make-filename-from-adaname 1237 ada-search-directories-internal
1240 (match-string 1)) 1238 (ada-make-filename-from-adaname (match-string 1))
1241 ada-spec-suffixes))))))) 1239 ada-spec-suffixes)))
1242 1240 ))
1243 ;; Another special construct, that redefines the one in find-file.el. The
1244 ;; old one can handle only one possible type of extension for Ada files
1245 ;; remove from the list the standard "with..." that is put by find-file.el,
1246 ;; since it uses the old ada-spec-suffix variable
1247 ;; This one needs to replace the standard one defined in find-file.el (with
1248 ;; Emacs <= 20.4), since that one uses the old variable ada-spec-suffix
1249 (let ((old-construct
1250 (assoc "^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)" ff-special-constructs))
1251 (new-cdr
1252 (lambda ()
1253 (if (fboundp 'ff-get-file)
1254 (if (boundp 'fname)
1255 (set 'fname (ff-get-file
1256 ada-search-directories-internal
1257 (ada-make-filename-from-adaname
1258 (match-string 1))
1259 ada-spec-suffixes)))))))
1260 (if old-construct
1261 (setcdr old-construct new-cdr)
1262 (add-to-list 'ff-special-constructs
1263 (cons "^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)"
1264 new-cdr))))
1265 1241
1266 ;; Support for outline-minor-mode 1242 ;; Support for outline-minor-mode
1267 (set (make-local-variable 'outline-regexp) 1243 (set (make-local-variable 'outline-regexp)
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index e7a0d03cc55..d29e75e92f0 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -134,12 +134,18 @@
134 134
135(eval-and-compile 135(eval-and-compile
136 ;; These are used to collect the init forms from the subsequent 136 ;; These are used to collect the init forms from the subsequent
137 ;; `c-lang-defvar'. They are used to build the lambda in 137 ;; `c-lang-defvar' and `c-lang-setvar'. They are used to build the
138 ;; `c-make-init-lang-vars-fun' below. 138 ;; lambda in `c-make-init-lang-vars-fun' below, and to build `defvar's
139 ;; and `make-variable-buffer-local's in cc-engine and
140 ;; `make-local-variable's in `c-init-language-vars-for'.
139 (defvar c-lang-variable-inits nil) 141 (defvar c-lang-variable-inits nil)
140 (defvar c-lang-variable-inits-tail nil) 142 (defvar c-lang-variable-inits-tail nil)
141 (setq c-lang-variable-inits (list nil) 143 (setq c-lang-variable-inits (list nil)
142 c-lang-variable-inits-tail c-lang-variable-inits)) 144 c-lang-variable-inits-tail c-lang-variable-inits)
145 (defvar c-emacs-variable-inits nil)
146 (defvar c-emacs-variable-inits-tail nil)
147 (setq c-emacs-variable-inits (list nil)
148 c-emacs-variable-inits-tail c-emacs-variable-inits))
143 149
144(defmacro c-lang-defvar (var val &optional doc) 150(defmacro c-lang-defvar (var val &optional doc)
145 "Declares the buffer local variable VAR to get the value VAL. VAL is 151 "Declares the buffer local variable VAR to get the value VAL. VAL is
@@ -172,6 +178,25 @@ the evaluated constant value at compile time."
172 ;; Return the symbol, like the other def* forms. 178 ;; Return the symbol, like the other def* forms.
173 `',var) 179 `',var)
174 180
181(defmacro c-lang-setvar (var val)
182 "Causes the variable VAR to be made buffer local and to get set to the
183value VAL. VAL is evaluated and assigned at mode initialization. More
184precisely, VAL is evaluated and bound to VAR when the result from the
185macro `c-init-language-vars' is evaluated. VAR is typically a standard
186Emacs variable like `comment-start'.
187
188`c-lang-const' is typically used in VAL to get the right value for the
189language being initialized, and such calls will be macro expanded to
190the evaluated constant value at compile time."
191 (let ((elem (assq var (cdr c-emacs-variable-inits))))
192 (if elem
193 (setcdr elem (list val)) ; Maybe remove "list", sometime. 2006-07-19
194 (setcdr c-emacs-variable-inits-tail (list (list var val)))
195 (setq c-emacs-variable-inits-tail (cdr c-emacs-variable-inits-tail))))
196
197 ;; Return the symbol, like the other def* forms.
198 `',var)
199
175(put 'c-lang-defvar 'lisp-indent-function 'defun) 200(put 'c-lang-defvar 'lisp-indent-function 'defun)
176; (eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el. 201; (eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el.
177; ' 202; '
@@ -1103,8 +1128,7 @@ properly."
1103 ;; In C we still default to the block comment style since line 1128 ;; In C we still default to the block comment style since line
1104 ;; comments aren't entirely portable. 1129 ;; comments aren't entirely portable.
1105 c "/* ") 1130 c "/* ")
1106(c-lang-defvar comment-start (c-lang-const comment-start) 1131(c-lang-setvar comment-start (c-lang-const comment-start))
1107 'dont-doc)
1108 1132
1109(c-lang-defconst comment-end 1133(c-lang-defconst comment-end
1110 "String that ends comments inserted with M-; etc. 1134 "String that ends comments inserted with M-; etc.
@@ -1117,8 +1141,7 @@ properly."
1117 (c-lang-const comment-start)) 1141 (c-lang-const comment-start))
1118 (concat " " (c-lang-const c-block-comment-ender)) 1142 (concat " " (c-lang-const c-block-comment-ender))
1119 "")) 1143 ""))
1120(c-lang-defvar comment-end (c-lang-const comment-end) 1144(c-lang-setvar comment-end (c-lang-const comment-end))
1121 'dont-doc)
1122 1145
1123(c-lang-defconst comment-start-skip 1146(c-lang-defconst comment-start-skip
1124 "Regexp to match the start of a comment plus everything up to its body. 1147 "Regexp to match the start of a comment plus everything up to its body.
@@ -1134,8 +1157,7 @@ properly."
1134 (c-lang-const c-block-comment-starter))) 1157 (c-lang-const c-block-comment-starter)))
1135 "\\|") 1158 "\\|")
1136 "\\)\\s *")) 1159 "\\)\\s *"))
1137(c-lang-defvar comment-start-skip (c-lang-const comment-start-skip) 1160(c-lang-setvar comment-start-skip (c-lang-const comment-start-skip))
1138 'dont-doc)
1139 1161
1140(c-lang-defconst c-syntactic-ws-start 1162(c-lang-defconst c-syntactic-ws-start
1141 ;; Regexp matching any sequence that can start syntactic whitespace. 1163 ;; Regexp matching any sequence that can start syntactic whitespace.
@@ -2806,9 +2828,10 @@ way."
2806;;; Wrap up the `c-lang-defvar' system. 2828;;; Wrap up the `c-lang-defvar' system.
2807 2829
2808;; Compile in the list of language variables that has been collected 2830;; Compile in the list of language variables that has been collected
2809;; with the `c-lang-defvar' macro. Note that the first element is 2831;; with the `c-lang-defvar' and `c-lang-setvar' macros. Note that the
2810;; nil. 2832;; first element of each is nil.
2811(defconst c-lang-variable-inits (cc-eval-when-compile c-lang-variable-inits)) 2833(defconst c-lang-variable-inits (cc-eval-when-compile c-lang-variable-inits))
2834(defconst c-emacs-variable-inits (cc-eval-when-compile c-emacs-variable-inits))
2812 2835
2813(defun c-make-init-lang-vars-fun (mode) 2836(defun c-make-init-lang-vars-fun (mode)
2814 "Create a function that initializes all the language dependent variables 2837 "Create a function that initializes all the language dependent variables
@@ -2841,12 +2864,16 @@ accomplish that conveniently."
2841 ;; `c-lang-const' will expand to the evaluated 2864 ;; `c-lang-const' will expand to the evaluated
2842 ;; constant immediately in `cl-macroexpand-all' 2865 ;; constant immediately in `cl-macroexpand-all'
2843 ;; below. 2866 ;; below.
2844 (mapcan 2867 (mapcan
2845 (lambda (init) 2868 (lambda (init)
2846 `(current-var ',(car init) 2869 `(current-var ',(car init)
2847 ,(car init) ,(cl-macroexpand-all 2870 ,(car init) ,(cl-macroexpand-all
2848 (elt init 1)))) 2871 (elt init 1))))
2849 (cdr c-lang-variable-inits)))) 2872 ;; Note: The following `append' copies the
2873 ;; first argument. That list is small, so
2874 ;; this doesn't matter too much.
2875 (append (cdr c-emacs-variable-inits)
2876 (cdr c-lang-variable-inits)))))
2850 2877
2851 ;; This diagnostic message isn't useful for end 2878 ;; This diagnostic message isn't useful for end
2852 ;; users, so it's disabled. 2879 ;; users, so it's disabled.
@@ -2859,7 +2886,8 @@ accomplish that conveniently."
2859 2886
2860 (require 'cc-langs) 2887 (require 'cc-langs)
2861 (setq source-eval t) 2888 (setq source-eval t)
2862 (let ((init (cdr c-lang-variable-inits))) 2889 (let ((init (append (cdr c-emacs-variable-inits)
2890 (cdr c-lang-variable-inits))))
2863 (while init 2891 (while init
2864 (setq current-var (caar init)) 2892 (setq current-var (caar init))
2865 (set (caar init) (eval (cadar init))) 2893 (set (caar init) (eval (cadar init)))
@@ -2867,7 +2895,7 @@ accomplish that conveniently."
2867 2895
2868 (error 2896 (error
2869 (if current-var 2897 (if current-var
2870 (message "Eval error in the `c-lang-defvar' for `%s'%s: %S" 2898 (message "Eval error in the `c-lang-defvar' or `c-lang-setvar' for `%s'%s: %S"
2871 current-var 2899 current-var
2872 (if source-eval 2900 (if source-eval
2873 (format "\ 2901 (format "\
@@ -2883,7 +2911,8 @@ accomplish that conveniently."
2883 `(lambda () 2911 `(lambda ()
2884 (require 'cc-langs) 2912 (require 'cc-langs)
2885 (let ((c-buffer-is-cc-mode ',mode) 2913 (let ((c-buffer-is-cc-mode ',mode)
2886 (init (cdr c-lang-variable-inits)) 2914 (init (append (cdr c-emacs-variable-inits)
2915 (cdr c-lang-variable-inits)))
2887 current-var) 2916 current-var)
2888 (condition-case err 2917 (condition-case err
2889 2918
@@ -2895,7 +2924,7 @@ accomplish that conveniently."
2895 (error 2924 (error
2896 (if current-var 2925 (if current-var
2897 (message 2926 (message
2898 "Eval error in the `c-lang-defvar' for `%s' (source eval): %S" 2927 "Eval error in the `c-lang-defvar' or `c-lang-setver' for `%s' (source eval): %S"
2899 current-var err) 2928 current-var err)
2900 (signal (car err) (cdr err))))))) 2929 (signal (car err) (cdr err)))))))
2901 )) 2930 ))
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 7343ec735ea..eb5ae4b63b6 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -153,12 +153,21 @@
153(defun c-leave-cc-mode-mode () 153(defun c-leave-cc-mode-mode ()
154 (setq c-buffer-is-cc-mode nil)) 154 (setq c-buffer-is-cc-mode nil))
155 155
156;; Make the `c-lang-setvar' variables buffer local in the current buffer.
157;; These are typically standard emacs variables such as `comment-start'.
158(defmacro c-make-emacs-variables-local ()
159 `(progn
160 ,@(mapcan (lambda (init)
161 `((make-local-variable ',(car init))))
162 (cdr c-emacs-variable-inits))))
163
156(defun c-init-language-vars-for (mode) 164(defun c-init-language-vars-for (mode)
157 "Initialize the language variables for one of the language modes 165 "Initialize the language variables for one of the language modes
158directly supported by CC Mode. This can be used instead of the 166directly supported by CC Mode. This can be used instead of the
159`c-init-language-vars' macro if the language you want to use is one of 167`c-init-language-vars' macro if the language you want to use is one of
160those, rather than a derived language defined through the language 168those, rather than a derived language defined through the language
161variable system (see \"cc-langs.el\")." 169variable system (see \"cc-langs.el\")."
170 (c-make-emacs-variables-local)
162 (cond ((eq mode 'c-mode) (c-init-language-vars c-mode)) 171 (cond ((eq mode 'c-mode) (c-init-language-vars c-mode))
163 ((eq mode 'c++-mode) (c-init-language-vars c++-mode)) 172 ((eq mode 'c++-mode) (c-init-language-vars c++-mode))
164 ((eq mode 'objc-mode) (c-init-language-vars objc-mode)) 173 ((eq mode 'objc-mode) (c-init-language-vars objc-mode))
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 3c63d5f01b1..e8c09113d39 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -226,14 +226,19 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
226 ;; I have no idea what this first line is supposed to match, but it 226 ;; I have no idea what this first line is supposed to match, but it
227 ;; makes things ambiguous with output such as "foo:344:50:blabla" since 227 ;; makes things ambiguous with output such as "foo:344:50:blabla" since
228 ;; the "foo" part can match this first line (in which case the file 228 ;; the "foo" part can match this first line (in which case the file
229 ;; name as "344"). To avoid this, we disallow filenames exclusively 229 ;; name as "344"). To avoid this, the second line disallows filenames
230 ;; composed of digits. --Stef 230 ;; exclusively composed of digits. --Stef
231 ;; Similarly, we get lots of false positives with messages including
232 ;; times of the form "HH:MM:SS" where MM is taken as a line number, so
233 ;; the last line tries to rule out message where the info after the
234 ;; line number starts with "SS". --Stef
231 "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\)?\ 235 "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\)?\
232\\([0-9]*[^0-9\n].*?\\): ?\ 236\\([0-9]*[^0-9\n].*?\\): ?\
233\\([0-9]+\\)\\(?:\\([.:]\\)\\([0-9]+\\)\\)?\ 237\\([0-9]+\\)\\(?:\\([.:]\\)\\([0-9]+\\)\\)?\
234\\(?:-\\([0-9]+\\)?\\(?:\\3\\([0-9]+\\)\\)?\\)?:\ 238\\(?:-\\([0-9]+\\)?\\(?:\\3\\([0-9]+\\)\\)?\\)?:\
235\\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\ 239\\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\
236 *\\([Ii]nfo\\(?:\\>\\|rmationa?l?\\)\\|I:\\|instantiated from\\)\\)?" 240 *\\([Ii]nfo\\(?:\\>\\|rmationa?l?\\)\\|I:\\|instantiated from\\)\\|\
241\[0-9]?\\(?:[^0-9\n]\\|$\\)\\|[0-9][0-9][0-9]\\)"
237 1 (2 . 5) (4 . 6) (7 . 8)) 242 1 (2 . 5) (4 . 6) (7 . 8))
238 243
239 (lcc 244 (lcc
@@ -405,10 +410,7 @@ you may also want to change `compilation-page-delimiter'.")
405 "Value of `page-delimiter' in Compilation mode.") 410 "Value of `page-delimiter' in Compilation mode.")
406 411
407(defvar compilation-mode-font-lock-keywords 412(defvar compilation-mode-font-lock-keywords
408 '(;; Don't highlight this as a compilation message. 413 '(;; configure output lines.
409 ("^Compilation started at.*"
410 (0 '(face nil message nil help-echo nil mouse-face nil) t))
411 ;; configure output lines.
412 ("^[Cc]hecking \\(?:[Ff]or \\|[Ii]f \\|[Ww]hether \\(?:to \\)?\\)?\\(.+\\)\\.\\.\\. *\\(?:(cached) *\\)?\\(\\(yes\\(?: .+\\)?\\)\\|no\\|\\(.*\\)\\)$" 414 ("^[Cc]hecking \\(?:[Ff]or \\|[Ii]f \\|[Ww]hether \\(?:to \\)?\\)?\\(.+\\)\\.\\.\\. *\\(?:(cached) *\\)?\\(\\(yes\\(?: .+\\)?\\)\\|no\\|\\(.*\\)\\)$"
413 (1 font-lock-variable-name-face) 415 (1 font-lock-variable-name-face)
414 (2 (compilation-face '(4 . 3)))) 416 (2 (compilation-face '(4 . 3))))
@@ -419,7 +421,7 @@ you may also want to change `compilation-page-delimiter'.")
419 ("^Compilation \\(finished\\).*" 421 ("^Compilation \\(finished\\).*"
420 (0 '(face nil message nil help-echo nil mouse-face nil) t) 422 (0 '(face nil message nil help-echo nil mouse-face nil) t)
421 (1 compilation-info-face)) 423 (1 compilation-info-face))
422 ("^Compilation \\(exited abnormally\\|interrupt\\|killed\\|terminated\\)\\(?:.*with code \\([0-9]+\\)\\)?.*" 424 ("^Compilation \\(exited abnormally\\|interrupt\\|killed\\|terminated\\|segmentation fault\\)\\(?:.*with code \\([0-9]+\\)\\)?.*"
423 (0 '(face nil message nil help-echo nil mouse-face nil) t) 425 (0 '(face nil message nil help-echo nil mouse-face nil) t)
424 (1 compilation-error-face) 426 (1 compilation-error-face)
425 (2 compilation-error-face nil t))) 427 (2 compilation-error-face nil t)))
@@ -1823,28 +1825,44 @@ Pop up the buffer containing MARKER and scroll to MARKER if we ask the user."
1823 (find-file-noselect name)) 1825 (find-file-noselect name))
1824 fmts (cdr fmts))) 1826 fmts (cdr fmts)))
1825 (setq dirs (cdr dirs))) 1827 (setq dirs (cdr dirs)))
1826 (or buffer 1828 (while (null buffer) ;Repeat until the user selects an existing file.
1827 ;; The file doesn't exist. Ask the user where to find it. 1829 ;; The file doesn't exist. Ask the user where to find it.
1828 (save-excursion ;This save-excursion is probably not right. 1830 (save-excursion ;This save-excursion is probably not right.
1829 (let ((pop-up-windows t)) 1831 (let ((pop-up-windows t))
1830 (compilation-set-window (display-buffer (marker-buffer marker)) 1832 (compilation-set-window (display-buffer (marker-buffer marker))
1831 marker) 1833 marker)
1832 (let ((name (expand-file-name 1834 (let* ((name (read-file-name
1833 (read-file-name 1835 (format "Find this %s in (default %s): "
1834 (format "Find this %s in (default %s): " 1836 compilation-error filename)
1835 compilation-error filename) 1837 spec-dir filename t nil
1836 spec-dir filename t)))) 1838 ;; Try to make sure the user can only select
1837 (if (file-directory-p name) 1839 ;; a valid answer. This predicate may be ignored,
1838 (setq name (expand-file-name filename name))) 1840 ;; tho, so we still have to double-check afterwards.
1839 (setq buffer (and (file-exists-p name) 1841 ;; TODO: We should probably fix read-file-name so
1840 (find-file-noselect name))))))) 1842 ;; that it never ignores this predicate, even when
1843 ;; using popup dialog boxes.
1844 (lambda (name)
1845 (if (file-directory-p name)
1846 (setq name (expand-file-name filename name)))
1847 (file-exists-p name))))
1848 (origname name))
1849 (cond
1850 ((not (file-exists-p name))
1851 (message "Cannot find file `%s'" name)
1852 (ding) (sit-for 2))
1853 ((and (file-directory-p name)
1854 (not (file-exists-p
1855 (setq name (expand-file-name filename name)))))
1856 (message "No `%s' in directory %s" filename origname)
1857 (ding) (sit-for 2))
1858 (t
1859 (setq buffer (find-file-noselect name))))))))
1841 ;; Make intangible overlays tangible. 1860 ;; Make intangible overlays tangible.
1842 ;; This is very weird: it's not even clear which is the current buffer, 1861 ;; This is weird: it's not even clear which is the current buffer,
1843 ;; so the code below can't be expected to DTRT here. --Stef 1862 ;; so the code below can't be expected to DTRT here. -- Stef
1844 (mapcar (function (lambda (ov) 1863 (dolist (ov (overlays-in (point-min) (point-max)))
1845 (when (overlay-get ov 'intangible) 1864 (when (overlay-get ov 'intangible)
1846 (overlay-put ov 'intangible nil)))) 1865 (overlay-put ov 'intangible nil)))
1847 (overlays-in (point-min) (point-max)))
1848 buffer)) 1866 buffer))
1849 1867
1850(defun compilation-get-file-structure (file &optional fmt) 1868(defun compilation-get-file-structure (file &optional fmt)
diff --git a/lisp/progmodes/delphi.el b/lisp/progmodes/delphi.el
index 03ab24adf47..44a192ab772 100644
--- a/lisp/progmodes/delphi.el
+++ b/lisp/progmodes/delphi.el
@@ -1767,6 +1767,7 @@ it is a routine."
1767An error is raised if not in a comment." 1767An error is raised if not in a comment."
1768 (interactive) 1768 (interactive)
1769 (save-excursion 1769 (save-excursion
1770 (save-restriction
1770 (let* ((comment (delphi-current-token)) 1771 (let* ((comment (delphi-current-token))
1771 (comment-kind (delphi-token-kind comment))) 1772 (comment-kind (delphi-token-kind comment)))
1772 (if (not (delphi-is comment-kind delphi-comments)) 1773 (if (not (delphi-is comment-kind delphi-comments))
@@ -1845,7 +1846,7 @@ An error is raised if not in a comment."
1845 ;; React to the entire fill change as a whole. 1846 ;; React to the entire fill change as a whole.
1846 (delphi-progress-start) 1847 (delphi-progress-start)
1847 (delphi-parse-region comment-start comment-end) 1848 (delphi-parse-region comment-start comment-end)
1848 (delphi-progress-done)))))) 1849 (delphi-progress-done)))))))
1849 1850
1850(defun delphi-new-comment-line () 1851(defun delphi-new-comment-line ()
1851 "If in a // comment, does a newline, indented such that one is still in the 1852 "If in a // comment, does a newline, indented such that one is still in the
diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el
index 810a7b3e973..dca6fa16df0 100644
--- a/lisp/progmodes/gdb-ui.el
+++ b/lisp/progmodes/gdb-ui.el
@@ -434,7 +434,8 @@ With arg, use separate IO iff arg is positive."
434 (make-local-variable 'gdb-define-alist) 434 (make-local-variable 'gdb-define-alist)
435 (gdb-create-define-alist) 435 (gdb-create-define-alist)
436 (add-hook 'after-save-hook 'gdb-create-define-alist nil t)))))) 436 (add-hook 'after-save-hook 'gdb-create-define-alist nil t))))))
437 (gdb-force-mode-line-update "ready")) 437 (gdb-force-mode-line-update
438 (propertize "ready" 'face font-lock-variable-name-face)))
438 439
439(defun gdb-find-watch-expression () 440(defun gdb-find-watch-expression ()
440 (let* ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list)) 441 (let* ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list))
@@ -1209,7 +1210,8 @@ This filter may simply queue input for a later time."
1209(defun gdb-resync() 1210(defun gdb-resync()
1210 (setq gdb-flush-pending-output t) 1211 (setq gdb-flush-pending-output t)
1211 (setq gud-running nil) 1212 (setq gud-running nil)
1212 (gdb-force-mode-line-update "stopped") 1213 (gdb-force-mode-line-update
1214 (propertize "stopped"'face font-lock-warning-face))
1213 (setq gdb-output-sink 'user) 1215 (setq gdb-output-sink 'user)
1214 (setq gdb-input-queue nil) 1216 (setq gdb-input-queue nil)
1215 (setq gdb-pending-triggers nil) 1217 (setq gdb-pending-triggers nil)
@@ -1249,7 +1251,8 @@ happens to be in effect."
1249 "An annotation handler for `prompt'. 1251 "An annotation handler for `prompt'.
1250This sends the next command (if any) to gdb." 1252This sends the next command (if any) to gdb."
1251 (when gdb-first-prompt 1253 (when gdb-first-prompt
1252 (gdb-force-mode-line-update "initializing...") 1254 (gdb-force-mode-line-update
1255 (propertize "initializing..." 'face font-lock-variable-name-face))
1253 (gdb-init-1) 1256 (gdb-init-1)
1254 (setq gdb-first-prompt nil)) 1257 (setq gdb-first-prompt nil))
1255 (let ((sink gdb-output-sink)) 1258 (let ((sink gdb-output-sink))
@@ -1287,7 +1290,8 @@ not GDB."
1287 (progn 1290 (progn
1288 (setq gud-running t) 1291 (setq gud-running t)
1289 (setq gdb-inferior-status "running") 1292 (setq gdb-inferior-status "running")
1290 (gdb-force-mode-line-update gdb-inferior-status) 1293 (gdb-force-mode-line-update
1294 (propertize gdb-inferior-status 'face font-lock-type-face))
1291 (gdb-remove-text-properties) 1295 (gdb-remove-text-properties)
1292 (setq gud-old-arrow gud-overlay-arrow-position) 1296 (setq gud-old-arrow gud-overlay-arrow-position)
1293 (setq gud-overlay-arrow-position nil) 1297 (setq gud-overlay-arrow-position nil)
@@ -1300,7 +1304,8 @@ not GDB."
1300 1304
1301(defun gdb-signal (ignored) 1305(defun gdb-signal (ignored)
1302 (setq gdb-inferior-status "signal") 1306 (setq gdb-inferior-status "signal")
1303 (gdb-force-mode-line-update gdb-inferior-status) 1307 (gdb-force-mode-line-update
1308 (propertize gdb-inferior-status 'face font-lock-warning-face))
1304 (gdb-stopping ignored)) 1309 (gdb-stopping ignored))
1305 1310
1306(defun gdb-stopping (ignored) 1311(defun gdb-stopping (ignored)
@@ -1327,7 +1332,8 @@ directives."
1327 (setq gdb-overlay-arrow-position nil) 1332 (setq gdb-overlay-arrow-position nil)
1328 (setq gud-old-arrow nil) 1333 (setq gud-old-arrow nil)
1329 (setq gdb-inferior-status "exited") 1334 (setq gdb-inferior-status "exited")
1330 (gdb-force-mode-line-update gdb-inferior-status) 1335 (gdb-force-mode-line-update
1336 (propertize gdb-inferior-status 'face font-lock-warning-face))
1331 (gdb-stopping ignored)) 1337 (gdb-stopping ignored))
1332 1338
1333(defun gdb-signalled (ignored) 1339(defun gdb-signalled (ignored)
@@ -1375,7 +1381,8 @@ sink to `user' in `gdb-stopping', that is fine."
1375 'delete))))) 1381 'delete)))))
1376 (unless (member gdb-inferior-status '("exited" "signal")) 1382 (unless (member gdb-inferior-status '("exited" "signal"))
1377 (setq gdb-inferior-status "stopped") 1383 (setq gdb-inferior-status "stopped")
1378 (gdb-force-mode-line-update gdb-inferior-status)) 1384 (gdb-force-mode-line-update
1385 (propertize gdb-inferior-status 'face font-lock-warning-face)))
1379 (let ((sink gdb-output-sink)) 1386 (let ((sink gdb-output-sink))
1380 (cond 1387 (cond
1381 ((eq sink 'inferior) 1388 ((eq sink 'inferior)
@@ -3268,7 +3275,8 @@ is set in them."
3268 (make-local-variable 'gdb-define-alist) 3275 (make-local-variable 'gdb-define-alist)
3269 (gdb-create-define-alist) 3276 (gdb-create-define-alist)
3270 (add-hook 'after-save-hook 'gdb-create-define-alist nil t))))) 3277 (add-hook 'after-save-hook 'gdb-create-define-alist nil t)))))
3271 (gdb-force-mode-line-update "ready")) 3278 (gdb-force-mode-line-update
3279 (propertize "ready" 'face font-lock-variable-name-face)))
3272 3280
3273; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards. 3281; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards.
3274(defun gdb-var-list-children-1 (varnum) 3282(defun gdb-var-list-children-1 (varnum)
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 37d4952058b..e7d85910a63 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -155,7 +155,7 @@ The following place holders should be present in the string:
155 :type 'alist 155 :type 'alist
156 :group 'grep) 156 :group 'grep)
157 157
158(defcustom grep-find-ignored-directories '("CVS" ".hg" "{arch}") 158(defcustom grep-find-ignored-directories '("CVS" ".svn" "{arch}" ".hg" "_darcs")
159 "*List of names of sub-directories which `rgrep' shall not recurse into." 159 "*List of names of sub-directories which `rgrep' shall not recurse into."
160 :type '(repeat string) 160 :type '(repeat string)
161 :group 'grep) 161 :group 'grep)
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el
index bdc8161c80f..f4c117fd935 100644
--- a/lisp/progmodes/idlw-shell.el
+++ b/lisp/progmodes/idlw-shell.el
@@ -4384,7 +4384,7 @@ idlwave-shell-electric-debug-mode-map)
4384 ["Edit Default Cmd" idlwave-shell-edit-default-command-line t]) 4384 ["Edit Default Cmd" idlwave-shell-edit-default-command-line t])
4385 ("Breakpoints" 4385 ("Breakpoints"
4386 ["Set Breakpoint" idlwave-shell-break-here 4386 ["Set Breakpoint" idlwave-shell-break-here
4387 :keys "C-c C-d C-c" :active (eq major-mode 'idlwave-mode)] 4387 :keys "C-c C-d C-b" :active (eq major-mode 'idlwave-mode)]
4388 ("Set Special Breakpoint" 4388 ("Set Special Breakpoint"
4389 ["Set After Count Breakpoint" 4389 ["Set After Count Breakpoint"
4390 (progn 4390 (progn
diff --git a/lisp/progmodes/ld-script.el b/lisp/progmodes/ld-script.el
index ec12468e5d9..4f0159c5992 100644
--- a/lisp/progmodes/ld-script.el
+++ b/lisp/progmodes/ld-script.el
@@ -74,25 +74,55 @@
74 "Syntax table used while in `ld-script-mode'.") 74 "Syntax table used while in `ld-script-mode'.")
75 75
76;; Font lock keywords 76;; Font lock keywords
77;; (The section number comes from ld's info.)
77(defvar ld-script-keywords 78(defvar ld-script-keywords
78 '("ENTRY" "INCLUDE" "INPUT" "GROUP" 79 '(
79 "OUTPUT" "SEARCH_DIR" "STARTUP" 80 ;; 3.4.1 Setting the Entry Point
81 "ENTRY"
82 ;; 3.4.2 Commands Dealing with Files
83 "INCLUDE" "INPUT" "GROUP" "AS_NEEDED" "OUTPUT" "SEARCH_DIR" "STARTUP"
84 ;; 3.4.3 Commands Dealing with Object File Formats
80 "OUTPUT_FORMAT" "TARGET" 85 "OUTPUT_FORMAT" "TARGET"
81 "ASSERT" "EXTERN" "FORCE_COMMON_ALLOCATION" "NOCROSSREFS" "OUTPUT_ARCH" 86 ;; 3.4.3 Other Linker Script Commands
87 "ASSERT" "EXTERN" "FORCE_COMMON_ALLOCATION"
88 "INHIBIT_COMMON_ALLOCATION" "NOCROSSREFS" "OUTPUT_ARCH"
89 ;; 3.5.2 PROVIDE
82 "PROVIDE" 90 "PROVIDE"
83 "SECTIONS" "SORT" "COMMON" "KEEP" 91 ;; 3.5.3 PROVIDE_HIDDEN
84 "BYTE" "SHORT" "LONG" "QUAD" "SQAD" 92 "PROVIDE_HIDEN"
85 "FILL" 93 ;; 3.6 SECTIONS Command
86 "CREATE_OBJECT_SYMBOLS" 94 "SECTIONS"
87 "CONSTRUCTORS" 95 ;; 3.6.4.2 Input Section Wildcard Patterns
96 "SORT" "SORT_BY_NAME" "SORT_BY_ALIGNMENT"
97 ;; 3.6.4.3 Input Section for Common Symbols
98 "COMMON"
99 ;; 3.6.4.4 Input Section and Garbage Collection
100 "KEEP"
101 ;; 3.6.5 Output Section Data
102 "BYTE" "SHORT" "LONG" "QUAD" "SQUAD" "FILL"
103 ;; 3.6.6 Output Section Keywords
104 "CREATE_OBJECT_SYMBOLS" "CONSTRUCTORS"
105 "__CTOR_LIST__" "__CTOR_END__" "__DTOR_LIST__" "__DTOR_END__"
106 ;; 3.6.7 Output Section Discarding
107 ;; See `ld-script-font-lock-keywords'
108 ;; 3.6.8.1 Output Section Type
88 "NOLOAD" "DSECT" "COPY" "INFO" "OVERLAY" 109 "NOLOAD" "DSECT" "COPY" "INFO" "OVERLAY"
110 ;; 3.6.8.2 Output Section LMA
89 "AT" 111 "AT"
112 ;; 3.6.8.4 Forced Input Alignment
113 "SUBALIGN"
114 ;; 3.6.8.6 Output Section Phdr
115 ":PHDR"
116 ;; 3.7 MEMORY Command
90 "MEMORY" 117 "MEMORY"
118 ;; 3.8 PHDRS Command
91 "PHDRS" "FILEHDR" "FLAGS" 119 "PHDRS" "FILEHDR" "FLAGS"
92 "PT_NULL" "PT_LOAD" "PT_DYNAMIC" "PT_INTERP" "PT_NONE" "PT_SHLIB" "PT_PHDR" 120 "PT_NULL" "PT_LOAD" "PT_DYNAMIC" "PT_INTERP" "PT_NONE" "PT_SHLIB" "PT_PHDR"
121 ;; 3.9 VERSION Command
93 "VERSION") 122 "VERSION")
94 "Keywords used of GNU ld script.") 123 "Keywords used of GNU ld script.")
95 124
125;; 3.10.8 Builtin Functions
96(defvar ld-script-builtins 126(defvar ld-script-builtins
97 '("ABSOLUTE" 127 '("ABSOLUTE"
98 "ADDR" 128 "ADDR"
@@ -102,12 +132,12 @@
102 "DATA_SEGMENT_END" 132 "DATA_SEGMENT_END"
103 "DATA_SEGMENT_RELRO_END" 133 "DATA_SEGMENT_RELRO_END"
104 "DEFINED" 134 "DEFINED"
105 "LENGTH" 135 "LENGTH" "len" "l"
106 "LOADADDR" 136 "LOADADDR"
107 "MAX" 137 "MAX"
108 "MIN" 138 "MIN"
109 "NEXT" 139 "NEXT"
110 "ORIGIN" 140 "ORIGIN" "org" "o"
111 "SEGMENT_START" 141 "SEGMENT_START"
112 "SIZEOF" 142 "SIZEOF"
113 "SIZEOF_HEADERS" 143 "SIZEOF_HEADERS"
@@ -120,7 +150,10 @@
120 1 font-lock-keyword-face) 150 1 font-lock-keyword-face)
121 (,(regexp-opt ld-script-builtins 'words) 151 (,(regexp-opt ld-script-builtins 'words)
122 1 font-lock-builtin-face) 152 1 font-lock-builtin-face)
123 ("/DISCARD/" . font-lock-warning-face) 153 ;; 3.6.7 Output Section Discarding
154 ;; 3.6.4.1 Input Section Basics
155 ;; 3.6.8.6 Output Section Phdr
156 ("/DISCARD/\\|EXCLUDE_FILE\\|:NONE" . font-lock-warning-face)
124 ("\\W\\(\\.\\)\\W" 1 ld-script-location-counter-face) 157 ("\\W\\(\\.\\)\\W" 1 ld-script-location-counter-face)
125 ) 158 )
126 cpp-font-lock-keywords) 159 cpp-font-lock-keywords)
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index ef80d28c578..6098c8be067 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -980,47 +980,55 @@ Point is at the beginning of the next line."
980 (re-search-forward sh-here-doc-re limit t)) 980 (re-search-forward sh-here-doc-re limit t))
981 981
982(defun sh-quoted-subshell (limit) 982(defun sh-quoted-subshell (limit)
983 "Search for a subshell embedded in a string. Find all the unescaped 983 "Search for a subshell embedded in a string.
984\" characters within said subshell, remembering that subshells can nest." 984Find all the unescaped \" characters within said subshell, remembering that
985 (if (re-search-forward "\"\\(?:.\\|\n\\)*?\\(\\$(\\|`\\)" limit t) 985subshells can nest."
986 ;; bingo we have a $( or a ` inside a "" 986 ;; FIXME: This can (and often does) match multiple lines, yet it makes no
987 (let ((char (char-after (point))) 987 ;; effort to handle multiline cases correctly, so it ends up being
988 (continue t) 988 ;; rather flakey.
989 (pos (point)) 989 (when (re-search-forward "\"\\(?:\\(?:.\\|\n\\)*?[^\\]\\(?:\\\\\\\\\\)*\\)??\\(\\$(\\|`\\)" limit t)
990 (data nil) ;; value to put into match-data (and return) 990 ;; bingo we have a $( or a ` inside a ""
991 (last nil) ;; last char seen 991 (let ((char (char-after (point)))
992 (bq (equal (match-string 1) "`")) ;; ` state flip-flop 992 (continue t)
993 (seen nil) ;; list of important positions 993 (pos (point))
994 (nest 1)) ;; subshell nesting level 994 (data nil) ;; value to put into match-data (and return)
995 (while (and continue char (<= pos limit)) 995 (last nil) ;; last char seen
996 ;; unescaped " inside a $( ... ) construct. 996 (bq (equal (match-string 1) "`")) ;; ` state flip-flop
997 ;; state machine time... 997 (seen nil) ;; list of important positions
998 ;; \ => ignore next char; 998 (nest 1)) ;; subshell nesting level
999 ;; ` => increase or decrease nesting level based on bq flag 999 (while (and continue char (<= pos limit))
1000 ;; ) [where nesting > 0] => decrease nesting 1000 ;; unescaped " inside a $( ... ) construct.
1001 ;; ( [where nesting > 0] => increase nesting 1001 ;; state machine time...
1002 ;; ( [preceeded by $ ] => increase nesting 1002 ;; \ => ignore next char;
1003 ;; " [nesting <= 0 ] => terminate, we're done. 1003 ;; ` => increase or decrease nesting level based on bq flag
1004 ;; " [nesting > 0 ] => remember this, it's not a proper " 1004 ;; ) [where nesting > 0] => decrease nesting
1005 (if (eq ?\\ last) nil 1005 ;; ( [where nesting > 0] => increase nesting
1006 (if (eq ?\` char) (setq nest (+ nest (if bq -1 1)) bq (not bq)) 1006 ;; ( [preceeded by $ ] => increase nesting
1007 (if (and (> nest 0) (eq ?\) char)) (setq nest (1- nest)) 1007 ;; " [nesting <= 0 ] => terminate, we're done.
1008 (if (and (eq ?$ last) (eq ?\( char)) (setq nest (1+ nest)) 1008 ;; " [nesting > 0 ] => remember this, it's not a proper "
1009 (if (and (> nest 0) (eq ?\( char)) (setq nest (1+ nest)) 1009 ;; FIXME: don't count parens that appear within quotes.
1010 (if (eq char ?\") 1010 (cond
1011 (if (>= 0 nest) (setq continue nil) 1011 ((eq ?\\ last) nil)
1012 (setq seen (cons pos seen)) ) )))))) 1012 ((eq ?\` char) (setq nest (+ nest (if bq -1 1)) bq (not bq)))
1013 ;;(message "POS: %d [%d]" pos nest) 1013 ((and (> nest 0) (eq ?\) char)) (setq nest (1- nest)))
1014 (setq last char 1014 ((and (eq ?$ last) (eq ?\( char)) (setq nest (1+ nest)))
1015 pos (1+ pos) 1015 ((and (> nest 0) (eq ?\( char)) (setq nest (1+ nest)))
1016 char (char-after pos)) ) 1016 ((eq char ?\")
1017 (when seen 1017 (if (>= 0 nest) (setq continue nil) (push pos seen))))
1018 ;;(message "SEEN: %S" seen) 1018 ;;(message "POS: %d [%d]" pos nest)
1019 (setq data (list (current-buffer))) 1019 (setq last char
1020 (mapc (lambda (P) 1020 pos (1+ pos)
1021 (setq data (cons P (cons (1+ P) data)) ) ) seen) 1021 char (char-after pos)) )
1022 (store-match-data data)) 1022 ;; FIXME: why construct a costly match data to pass to
1023 data) )) 1023 ;; sh-apply-quoted-subshell rather than apply the highlight
1024 ;; directly here? -- Stef
1025 (when seen
1026 ;;(message "SEEN: %S" seen)
1027 (setq data (list (current-buffer)))
1028 (dolist(P seen)
1029 (setq data (cons P (cons (1+ P) data))))
1030 (store-match-data data))
1031 data) ))
1024 1032
1025(defun sh-is-quoted-p (pos) 1033(defun sh-is-quoted-p (pos)
1026 (and (eq (char-before pos) ?\\) 1034 (and (eq (char-before pos) ?\\)
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el
index 8ca7eb188ec..b622e536d26 100644
--- a/lisp/progmodes/which-func.el
+++ b/lisp/progmodes/which-func.el
@@ -262,11 +262,11 @@ It calls them sequentially, and if any returns non-nil,
262 262
263(defun which-function () 263(defun which-function ()
264 "Return current function name based on point. 264 "Return current function name based on point.
265Uses `which-function-functions', `imenu--index-alist' 265Uses `which-func-functions', `imenu--index-alist'
266or `add-log-current-defun-function'. 266or `add-log-current-defun-function'.
267If no function name is found, return nil." 267If no function name is found, return nil."
268 (let ((name 268 (let ((name
269 ;; Try the `which-function-functions' functions first. 269 ;; Try the `which-func-functions' functions first.
270 (run-hook-with-args-until-success 'which-func-functions))) 270 (run-hook-with-args-until-success 'which-func-functions)))
271 271
272 ;; If Imenu is loaded, try to make an index alist with it. 272 ;; If Imenu is loaded, try to make an index alist with it.
diff --git a/lisp/replace.el b/lisp/replace.el
index 2f8fe86860c..4275aef8d87 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1283,8 +1283,8 @@ N (match-string N) (where N is a string of digits)
1283# replace-count 1283# replace-count
1284 1284
1285Note that these symbols must be preceeded by a backslash in order to 1285Note that these symbols must be preceeded by a backslash in order to
1286type them." 1286type them using Lisp syntax."
1287 (while n 1287 (while (consp n)
1288 (cond 1288 (cond
1289 ((consp (car n)) 1289 ((consp (car n))
1290 (replace-match-string-symbols (car n))) ;Process sub-list 1290 (replace-match-string-symbols (car n))) ;Process sub-list
diff --git a/lisp/startup.el b/lisp/startup.el
index 0ec53f98ae7..5a6b4089770 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -254,14 +254,16 @@ this variable usefully is to set it while building and dumping Emacs."
254 :group 'mail) 254 :group 'mail)
255 255
256(defcustom user-mail-address (if command-line-processed 256(defcustom user-mail-address (if command-line-processed
257 (concat (user-login-name) "@" 257 (or (getenv "EMAIL")
258 (or mail-host-address 258 (concat (user-login-name) "@"
259 (system-name))) 259 (or mail-host-address
260 (system-name))))
260 ;; Empty string means "not set yet". 261 ;; Empty string means "not set yet".
261 "") 262 "")
262 "*Full mailing address of this user. 263 "*Full mailing address of this user.
263This is initialized based on `mail-host-address', 264This is initialized with environment variable `EMAIL' or, as a
264after your init file is read, in case it sets `mail-host-address'." 265fallback, using `mail-host-address'. This is done after your
266init file is read, in case it sets `mail-host-address'."
265 :type 'string 267 :type 'string
266 :group 'mail) 268 :group 'mail)
267 269
@@ -984,9 +986,10 @@ opening the first frame (e.g. open a connection to an X server).")
984 986
985 ;; Do this here in case the init file sets mail-host-address. 987 ;; Do this here in case the init file sets mail-host-address.
986 (if (equal user-mail-address "") 988 (if (equal user-mail-address "")
987 (setq user-mail-address (concat (user-login-name) "@" 989 (setq user-mail-address (or (getenv "EMAIL")
988 (or mail-host-address 990 (concat (user-login-name) "@"
989 (system-name))))) 991 (or mail-host-address
992 (system-name))))))
990 993
991 ;; Originally face attributes were specified via 994 ;; Originally face attributes were specified via
992 ;; `font-lock-face-attributes'. Users then changed the default 995 ;; `font-lock-face-attributes'. Users then changed the default
diff --git a/lisp/subr.el b/lisp/subr.el
index 9b5d5f47ef2..6d35171bf04 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -108,6 +108,9 @@ change the list."
108 (declare (indent 1) (debug t)) 108 (declare (indent 1) (debug t))
109 (cons 'if (cons cond (cons nil body)))) 109 (cons 'if (cons cond (cons nil body))))
110 110
111(defvar --dolist-tail-- nil
112 "Temporary variable used in `dolist' expansion.")
113
111(defmacro dolist (spec &rest body) 114(defmacro dolist (spec &rest body)
112 "Loop over a list. 115 "Loop over a list.
113Evaluate BODY with VAR bound to each car from LIST, in turn. 116Evaluate BODY with VAR bound to each car from LIST, in turn.
@@ -115,16 +118,22 @@ Then evaluate RESULT to get return value, default nil.
115 118
116\(fn (VAR LIST [RESULT]) BODY...)" 119\(fn (VAR LIST [RESULT]) BODY...)"
117 (declare (indent 1) (debug ((symbolp form &optional form) body))) 120 (declare (indent 1) (debug ((symbolp form &optional form) body)))
118 (let ((temp (make-symbol "--dolist-temp--"))) 121 ;; It would be cleaner to create an uninterned symbol,
122 ;; but that uses a lot more space when many functions in many files
123 ;; use dolist.
124 (let ((temp '--dolist-tail--))
119 `(let ((,temp ,(nth 1 spec)) 125 `(let ((,temp ,(nth 1 spec))
120 ,(car spec)) 126 ,(car spec))
121 (while ,temp 127 (while ,temp
122 (setq ,(car spec) (car ,temp)) 128 (setq ,(car spec) (car ,temp))
123 (setq ,temp (cdr ,temp)) 129 ,@body
124 ,@body) 130 (setq ,temp (cdr ,temp)))
125 ,@(if (cdr (cdr spec)) 131 ,@(if (cdr (cdr spec))
126 `((setq ,(car spec) nil) ,@(cdr (cdr spec))))))) 132 `((setq ,(car spec) nil) ,@(cdr (cdr spec)))))))
127 133
134(defvar --dotimes-limit-- nil
135 "Temporary variable used in `dotimes' expansion.")
136
128(defmacro dotimes (spec &rest body) 137(defmacro dotimes (spec &rest body)
129 "Loop a certain number of times. 138 "Loop a certain number of times.
130Evaluate BODY with VAR bound to successive integers running from 0, 139Evaluate BODY with VAR bound to successive integers running from 0,
@@ -133,7 +142,10 @@ the return value (nil if RESULT is omitted).
133 142
134\(fn (VAR COUNT [RESULT]) BODY...)" 143\(fn (VAR COUNT [RESULT]) BODY...)"
135 (declare (indent 1) (debug dolist)) 144 (declare (indent 1) (debug dolist))
136 (let ((temp (make-symbol "--dotimes-temp--")) 145 ;; It would be cleaner to create an uninterned symbol,
146 ;; but that uses a lot more space when many functions in many files
147 ;; use dotimes.
148 (let ((temp '--dotimes-limit--)
137 (start 0) 149 (start 0)
138 (end (nth 1 spec))) 150 (end (nth 1 spec)))
139 `(let ((,temp ,end) 151 `(let ((,temp ,end)
@@ -1721,22 +1733,13 @@ floating point support.
1721 (when (or obsolete (numberp nodisp)) 1733 (when (or obsolete (numberp nodisp))
1722 (setq seconds (+ seconds (* 1e-3 nodisp))) 1734 (setq seconds (+ seconds (* 1e-3 nodisp)))
1723 (setq nodisp obsolete)) 1735 (setq nodisp obsolete))
1724 (unless nodisp 1736 (if noninteractive
1725 (redisplay)) 1737 (progn (sleep-for seconds) t)
1726 (or (<= seconds 0) 1738 (unless nodisp (redisplay))
1727 (let ((timer (timer-create)) 1739 (or (<= seconds 0)
1728 (echo-keystrokes 0)) 1740 (let ((read (read-event nil nil seconds)))
1729 (if (catch 'sit-for-timeout 1741 (or (null read)
1730 (timer-set-time timer (timer-relative-time 1742 (progn (push read unread-command-events) nil))))))
1731 (current-time) seconds))
1732 (timer-set-function timer 'with-timeout-handler
1733 '(sit-for-timeout))
1734 (timer-activate timer)
1735 (push (read-event) unread-command-events)
1736 nil)
1737 t
1738 (cancel-timer timer)
1739 nil))))
1740 1743
1741;;; Atomic change groups. 1744;;; Atomic change groups.
1742 1745
@@ -2547,8 +2550,9 @@ STRING should be given if the last search was by `string-match' on STRING."
2547(defun looking-back (regexp &optional limit greedy) 2550(defun looking-back (regexp &optional limit greedy)
2548 "Return non-nil if text before point matches regular expression REGEXP. 2551 "Return non-nil if text before point matches regular expression REGEXP.
2549Like `looking-at' except matches before point, and is slower. 2552Like `looking-at' except matches before point, and is slower.
2550LIMIT if non-nil speeds up the search by specifying how far back the 2553LIMIT if non-nil speeds up the search by specifying a minimum
2551match can start. 2554starting position, to avoid checking matches that would start
2555before LIMIT.
2552 2556
2553If GREEDY is non-nil, extend the match backwards as far as possible, 2557If GREEDY is non-nil, extend the match backwards as far as possible,
2554stopping when a single additional previous character cannot be part 2558stopping when a single additional previous character cannot be part
diff --git a/lisp/tabify.el b/lisp/tabify.el
index 6e12270bf47..de37f281eda 100644
--- a/lisp/tabify.el
+++ b/lisp/tabify.el
@@ -50,10 +50,10 @@ The variable `tab-width' controls the spacing of tab stops."
50 (delete-region tab-beg (point)) 50 (delete-region tab-beg (point))
51 (indent-to column)))))) 51 (indent-to column))))))
52 52
53(defvar tabify-regexp "[ \t][ \t]+" 53(defvar tabify-regexp " [ \t]+"
54 "Regexp matching whitespace that tabify should consider. 54 "Regexp matching whitespace that tabify should consider.
55Usually this will be \"[ \\t][ \\t]+\" to match two or more spaces or tabs. 55Usually this will be \" [ \\t]+\" to match two or more spaces or tabs.
56\"^[ \\t]+\" is also useful, for tabifying only initial whitespace.") 56\"^\\t* [ \\t]+\" is also useful, for tabifying only initial whitespace.")
57 57
58;;;###autoload 58;;;###autoload
59(defun tabify (start end) 59(defun tabify (start end)
@@ -72,13 +72,24 @@ The variable `tab-width' controls the spacing of tab stops."
72 (beginning-of-line) 72 (beginning-of-line)
73 (narrow-to-region (point) end) 73 (narrow-to-region (point) end)
74 (goto-char start) 74 (goto-char start)
75 (while (re-search-forward tabify-regexp nil t) 75 (let ((indent-tabs-mode t))
76 (let ((column (current-column)) 76 (while (re-search-forward tabify-regexp nil t)
77 (indent-tabs-mode t)) 77 ;; The region between (match-beginning 0) and (match-end 0) is just
78 (delete-region (match-beginning 0) (point)) 78 ;; spacing which we want to adjust to use TABs where possible.
79 (indent-to column)))))) 79 (let ((end-col (current-column))
80 (beg-col (save-excursion (goto-char (match-beginning 0))
81 (skip-chars-forward "\t")
82 (current-column))))
83 (if (= (/ end-col tab-width) (/ beg-col tab-width))
84 ;; The spacing (after some leading TABs which we wouldn't
85 ;; want to touch anyway) does not straddle a TAB boundary,
86 ;; so it neither contains a TAB, nor will we be able to use
87 ;; a TAB here anyway: there's nothing to do.
88 nil
89 (delete-region (match-beginning 0) (point))
90 (indent-to end-col))))))))
80 91
81(provide 'tabify) 92(provide 'tabify)
82 93
83;;; arch-tag: c83893b1-e0cc-4e57-8a09-73fd03466416 94;; arch-tag: c83893b1-e0cc-4e57-8a09-73fd03466416
84;;; tabify.el ends here 95;;; tabify.el ends here
diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el
index becf418e4e0..79324306ad1 100644
--- a/lisp/term/xterm.el
+++ b/lisp/term/xterm.el
@@ -160,13 +160,21 @@
160(define-key xterm-function-map "\e[29~" [print]) 160(define-key xterm-function-map "\e[29~" [print])
161 161
162;; These keys are available in xterm starting from version 214 162;; These keys are available in xterm starting from version 214
163;; if the modifyOtherKeys resource is set. 163;; if the modifyOtherKeys resource is set to 1.
164(define-key xterm-function-map "\e[27;5;9~" [(control ?\t)]) 164(define-key xterm-function-map "\e[27;5;9~" [C-tab])
165(define-key xterm-function-map "\e[27;5;13~" [C-return]) 165(define-key xterm-function-map "\e[27;5;13~" [C-return])
166(define-key xterm-function-map "\e[27;5;44~" [(control ?\,)]) 166(define-key xterm-function-map "\e[27;5;44~" [?\C-,])
167(define-key xterm-function-map "\e[27;5;46~" [(control ?\.)]) 167(define-key xterm-function-map "\e[27;5;46~" [?\C-.])
168(define-key xterm-function-map "\e[27;5;47~" [(control ?\/)]) 168(define-key xterm-function-map "\e[27;5;47~" [?\C-/])
169(define-key xterm-function-map "\e[27;5;92~" [(control ?\\)]) 169(define-key xterm-function-map "\e[27;5;92~" [?\C-\\)])
170
171(define-key xterm-function-map "\e[27;2;9~" [S-tab])
172(define-key xterm-function-map "\e[27;2;13~" [S-return])
173
174(define-key xterm-function-map "\e[27;6;9~" [(C-S-tab)])
175
176(define-key xterm-function-map "\e[27;13;46~" [?\C-\M-.])
177
170 178
171;; Other versions of xterm might emit these. 179;; Other versions of xterm might emit these.
172(define-key xterm-function-map "\e[A" [up]) 180(define-key xterm-function-map "\e[A" [up])
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index a4d873a543d..a0eb147d9c8 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -1650,9 +1650,15 @@ quit spell session exited."
1650 cursor-location)) 1650 cursor-location))
1651 (if (not (equal new-word (car poss))) 1651 (if (not (equal new-word (car poss)))
1652 (progn 1652 (progn
1653 (delete-region start end) 1653 (goto-char start)
1654 (setq start (point)) 1654 ;; Insert first and then delete,
1655 ;; to avoid collapsing markers before and after
1656 ;; into a single place.
1655 (ispell-insert-word new-word) 1657 (ispell-insert-word new-word)
1658 (delete-region (point) (+ (point) (- end start)))
1659 ;; It is meaningless to preserve the cursor position
1660 ;; inside a word that has changed.
1661 (setq cursor-location (point))
1656 (setq end (point)))) 1662 (setq end (point))))
1657 (if (not (atom replace)) ;recheck spelling of replacement 1663 (if (not (atom replace)) ;recheck spelling of replacement
1658 (progn 1664 (progn
diff --git a/lisp/textmodes/po.el b/lisp/textmodes/po.el
index eac1cb94105..701095caa8e 100644
--- a/lisp/textmodes/po.el
+++ b/lisp/textmodes/po.el
@@ -42,7 +42,7 @@ Contains canonical charset names that don't correspond to coding systems.")
42 42
43(defun po-find-charset (filename) 43(defun po-find-charset (filename)
44 "Return PO charset value for FILENAME. 44 "Return PO charset value for FILENAME.
45If FILENAME is a cons, the cdr part is a buffer that already contains 45If FILENAME is a cons cell, its CDR is a buffer that already contains
46the PO file (but not yet decoded)." 46the PO file (but not yet decoded)."
47 (let ((charset-regexp 47 (let ((charset-regexp
48 "^\"Content-Type:[ \t]*text/plain;[ \t]*charset=\\(.*\\)\\\\n\"") 48 "^\"Content-Type:[ \t]*text/plain;[ \t]*charset=\\(.*\\)\\\\n\"")
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index dab08902769..002ab9dac11 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -6,7 +6,7 @@
6;; Keywords: wp, convenience 6;; Keywords: wp, convenience
7;; Author: Takaaki Ota <Takaaki.Ota@am.sony.com> 7;; Author: Takaaki Ota <Takaaki.Ota@am.sony.com>
8;; Created: Sat Jul 08 2000 13:28:45 (PST) 8;; Created: Sat Jul 08 2000 13:28:45 (PST)
9;; Revised: Tue May 30 2006 10:01:43 (PDT) 9;; Revised: Thu Jul 20 2006 17:30:09 (PDT)
10 10
11;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
12 12
@@ -1394,7 +1394,9 @@ the last cache point coordinate."
1394 (setq table-command-remap-alist 1394 (setq table-command-remap-alist
1395 (cons (cons command func-symbol) 1395 (cons (cons command func-symbol)
1396 table-command-remap-alist)))) 1396 table-command-remap-alist))))
1397 '(beginning-of-line 1397 '(move-beginning-of-line
1398 beginning-of-line
1399 move-end-of-line
1398 end-of-line 1400 end-of-line
1399 beginning-of-buffer 1401 beginning-of-buffer
1400 end-of-buffer 1402 end-of-buffer
diff --git a/lisp/tumme.el b/lisp/tumme.el
index 26d48e77b2f..3bd1d41886e 100644
--- a/lisp/tumme.el
+++ b/lisp/tumme.el
@@ -84,7 +84,7 @@
84;; USAGE 84;; USAGE
85;; ===== 85;; =====
86;; 86;;
87;; This information has been moved to the manual. Type `C-h r' to open 87;; This information has been moved to the manual. Type `C-h r' to open
88;; the Emacs manual and go to the node Thumbnails by typing `g 88;; the Emacs manual and go to the node Thumbnails by typing `g
89;; Thumbnails RET'. 89;; Thumbnails RET'.
90;; 90;;
@@ -161,6 +161,10 @@
161 161
162(require 'dired) 162(require 'dired)
163(require 'format-spec) 163(require 'format-spec)
164(require 'widget)
165
166(eval-when-compile
167 (require 'wid-edit))
164 168
165(defgroup tumme nil 169(defgroup tumme nil
166 "Use dired to browse your images as thumbnails, and more." 170 "Use dired to browse your images as thumbnails, and more."
@@ -644,7 +648,7 @@ according to the Thumbnail Managing Standard."
644 ;; Can't use (overlays-at (point)), BUG? 648 ;; Can't use (overlays-at (point)), BUG?
645 (overlays-in (point) (1+ (point))))) 649 (overlays-in (point) (1+ (point)))))
646 (put-image thumb-file image-pos) 650 (put-image thumb-file image-pos)
647 (setq 651 (setq
648 overlay 652 overlay
649 (car (delq nil (mapcar (lambda (o) (and (overlay-get o 'put-image) o)) 653 (car (delq nil (mapcar (lambda (o) (and (overlay-get o 'put-image) o))
650 (overlays-in (point) (1+ (point))))))) 654 (overlays-in (point) (1+ (point)))))))
@@ -864,32 +868,27 @@ displayed."
864;;;###autoload 868;;;###autoload
865(defalias 'tumme 'tumme-show-all-from-dir) 869(defalias 'tumme 'tumme-show-all-from-dir)
866 870
867(defun tumme-write-tag (files tag) 871(defun tumme-write-tags (file-tags)
868 "For all FILES, writes TAG to the image database." 872 "Write file tags to database.
869 (save-excursion 873Write each file and tag in FILE-TAGS to the database. FILE-TAGS
870 (let (end buf) 874is an alist in the following form:
871 (setq buf (find-file tumme-db-file)) 875 ((FILE . TAG) ... )"
872 (if (not (listp files)) 876 (let (end file tag)
873 (if (stringp files) 877 (with-temp-file tumme-db-file
874 (setq files (list files)) 878 (insert-file-contents tumme-db-file)
875 (error "Files must be a string or a list of strings!"))) 879 (dolist (elt file-tags)
876 (mapcar 880 (setq file (car elt)
877 (lambda (file) 881 tag (cdr elt))
878 (goto-char (point-min)) 882 (goto-char (point-min))
879 (if (search-forward-regexp 883 (if (search-forward-regexp (format "^%s.*$" file) nil t)
880 (format "^%s" file) nil t) 884 (progn
881 (progn 885 (setq end (point))
882 (end-of-line) 886 (beginning-of-line)
883 (setq end (point)) 887 (when (not (search-forward (format ";%s" tag) end t))
884 (beginning-of-line) 888 (end-of-line)
885 (when (not (search-forward (format ";%s" tag) end t)) 889 (insert (format ";%s" tag))))
886 (end-of-line) 890 (goto-char (point-max))
887 (insert (format ";%s" tag)))) 891 (insert (format "\n%s;%s" file tag)))))))
888 (goto-char (point-max))
889 (insert (format "\n%s;%s" file tag))))
890 files)
891 (save-buffer)
892 (kill-buffer buf))))
893 892
894(defun tumme-remove-tag (files tag) 893(defun tumme-remove-tag (files tag)
895 "For all FILES, remove TAG from the image database." 894 "For all FILES, remove TAG from the image database."
@@ -951,15 +950,19 @@ displayed."
951 (let ((tag (read-string "Tags to add (separate tags with a semicolon): ")) 950 (let ((tag (read-string "Tags to add (separate tags with a semicolon): "))
952 curr-file files) 951 curr-file files)
953 (if arg 952 (if arg
954 (setq files (dired-get-filename)) 953 (setq files (list (dired-get-filename)))
955 (setq files (dired-get-marked-files))) 954 (setq files (dired-get-marked-files)))
956 (tumme-write-tag files tag))) 955 (tumme-write-tags
956 (mapcar
957 (lambda (x)
958 (cons x tag))
959 files))))
957 960
958(defun tumme-tag-thumbnail () 961(defun tumme-tag-thumbnail ()
959 "Tag current thumbnail." 962 "Tag current thumbnail."
960 (interactive) 963 (interactive)
961 (let ((tag (read-string "Tags to add (separate tags with a semicolon): "))) 964 (let ((tag (read-string "Tags to add (separate tags with a semicolon): ")))
962 (tumme-write-tag (tumme-original-file-name) tag)) 965 (tumme-write-tags (list (cons (tumme-original-file-name) tag))))
963 (tumme-update-property 966 (tumme-update-property
964 'tags (tumme-list-tags (tumme-original-file-name)))) 967 'tags (tumme-list-tags (tumme-original-file-name))))
965 968
@@ -1006,7 +1009,7 @@ use only useful if `tumme-track-movement' is nil."
1006 (let ((old-buf (current-buffer)) 1009 (let ((old-buf (current-buffer))
1007 (dired-buf (tumme-associated-dired-buffer)) 1010 (dired-buf (tumme-associated-dired-buffer))
1008 (file-name (tumme-original-file-name))) 1011 (file-name (tumme-original-file-name)))
1009 (when (and dired-buf file-name) 1012 (when (and (buffer-live-p dired-buf) file-name)
1010 (setq file-name (file-name-nondirectory file-name)) 1013 (setq file-name (file-name-nondirectory file-name))
1011 (set-buffer dired-buf) 1014 (set-buffer dired-buf)
1012 (goto-char (point-min)) 1015 (goto-char (point-min))
@@ -1069,32 +1072,46 @@ move ARG lines."
1069 (if tumme-track-movement 1072 (if tumme-track-movement
1070 (tumme-track-thumbnail))) 1073 (tumme-track-thumbnail)))
1071 1074
1072(defun tumme-forward-char () 1075(defun tumme-forward-image (&optional arg)
1073 "Move to next image and display properties." 1076 "Move to next image and display properties.
1074 (interactive) 1077Optional prefix ARG says how many images to move; default is one
1075 ;; Before we move, make sure that there is an image two positions 1078image."
1076 ;; forward. 1079 (interactive "p")
1077 (when (save-excursion 1080 (let (pos (steps (or arg 1)))
1078 (forward-char 2) 1081 (dotimes (i steps)
1079 (tumme-image-at-point-p)) 1082 (if (and (not (eobp))
1080 (forward-char) 1083 (save-excursion
1081 (while (and (not (eobp)) 1084 (forward-char)
1082 (not (tumme-image-at-point-p))) 1085 (while (and (not (eobp))
1083 (forward-char)) 1086 (not (tumme-image-at-point-p)))
1084 (if tumme-track-movement 1087 (forward-char))
1085 (tumme-track-original-file))) 1088 (setq pos (point))
1089 (tumme-image-at-point-p)))
1090 (goto-char pos)
1091 (error "At last image"))))
1092 (when tumme-track-movement
1093 (tumme-track-original-file))
1086 (tumme-display-thumb-properties)) 1094 (tumme-display-thumb-properties))
1087 1095
1088(defun tumme-backward-char () 1096(defun tumme-backward-image (&optional arg)
1089 "Move to previous image and display properties." 1097 "Move to previous image and display properties.
1090 (interactive) 1098Optional prefix ARG says how many images to move; default is one
1091 (when (not (bobp)) 1099image."
1092 (backward-char) 1100 (interactive "p")
1093 (while (and (not (bobp)) 1101 (let (pos (steps (or arg 1)))
1094 (not (tumme-image-at-point-p))) 1102 (dotimes (i steps)
1095 (backward-char)) 1103 (if (and (not (bobp))
1096 (if tumme-track-movement 1104 (save-excursion
1097 (tumme-track-original-file))) 1105 (backward-char)
1106 (while (and (not (bobp))
1107 (not (tumme-image-at-point-p)))
1108 (backward-char))
1109 (setq pos (point))
1110 (tumme-image-at-point-p)))
1111 (goto-char pos)
1112 (error "At first image"))))
1113 (when tumme-track-movement
1114 (tumme-track-original-file))
1098 (tumme-display-thumb-properties)) 1115 (tumme-display-thumb-properties))
1099 1116
1100(defun tumme-next-line () 1117(defun tumme-next-line ()
@@ -1103,7 +1120,7 @@ move ARG lines."
1103 (next-line 1) 1120 (next-line 1)
1104 ;; If we end up in an empty spot, back up to the next thumbnail. 1121 ;; If we end up in an empty spot, back up to the next thumbnail.
1105 (if (not (tumme-image-at-point-p)) 1122 (if (not (tumme-image-at-point-p))
1106 (tumme-backward-char)) 1123 (tumme-backward-image))
1107 (if tumme-track-movement 1124 (if tumme-track-movement
1108 (tumme-track-original-file)) 1125 (tumme-track-original-file))
1109 (tumme-display-thumb-properties)) 1126 (tumme-display-thumb-properties))
@@ -1118,7 +1135,7 @@ move ARG lines."
1118 ;; thumbnail and did not refresh, so it is not very common. But we 1135 ;; thumbnail and did not refresh, so it is not very common. But we
1119 ;; can handle it in a good manner, so why not? 1136 ;; can handle it in a good manner, so why not?
1120 (if (not (tumme-image-at-point-p)) 1137 (if (not (tumme-image-at-point-p))
1121 (tumme-backward-char)) 1138 (tumme-backward-image))
1122 (if tumme-track-movement 1139 (if tumme-track-movement
1123 (tumme-track-original-file)) 1140 (tumme-track-original-file))
1124 (tumme-display-thumb-properties)) 1141 (tumme-display-thumb-properties))
@@ -1131,7 +1148,7 @@ comment."
1131 (format-spec 1148 (format-spec
1132 tumme-display-properties-format 1149 tumme-display-properties-format
1133 (list 1150 (list
1134 (cons ?b buf) 1151 (cons ?b (or buf ""))
1135 (cons ?f file) 1152 (cons ?f file)
1136 (cons ?t (or (princ props) "")) 1153 (cons ?t (or (princ props) ""))
1137 (cons ?c (or comment ""))))) 1154 (cons ?c (or comment "")))))
@@ -1187,19 +1204,19 @@ dired."
1187 "Mark original image file in associated dired buffer." 1204 "Mark original image file in associated dired buffer."
1188 (interactive) 1205 (interactive)
1189 (tumme-modify-mark-on-thumb-original-file 'mark) 1206 (tumme-modify-mark-on-thumb-original-file 'mark)
1190 (tumme-forward-char)) 1207 (tumme-forward-image))
1191 1208
1192(defun tumme-unmark-thumb-original-file () 1209(defun tumme-unmark-thumb-original-file ()
1193 "Unmark original image file in associated dired buffer." 1210 "Unmark original image file in associated dired buffer."
1194 (interactive) 1211 (interactive)
1195 (tumme-modify-mark-on-thumb-original-file 'unmark) 1212 (tumme-modify-mark-on-thumb-original-file 'unmark)
1196 (tumme-forward-char)) 1213 (tumme-forward-image))
1197 1214
1198(defun tumme-flag-thumb-original-file () 1215(defun tumme-flag-thumb-original-file ()
1199 "Flag original image file for deletion in associated dired buffer." 1216 "Flag original image file for deletion in associated dired buffer."
1200 (interactive) 1217 (interactive)
1201 (tumme-modify-mark-on-thumb-original-file 'flag) 1218 (tumme-modify-mark-on-thumb-original-file 'flag)
1202 (tumme-forward-char)) 1219 (tumme-forward-image))
1203 1220
1204(defun tumme-toggle-mark-thumb-original-file () 1221(defun tumme-toggle-mark-thumb-original-file ()
1205 "Toggle mark on original image file in associated dired buffer." 1222 "Toggle mark on original image file in associated dired buffer."
@@ -1247,12 +1264,12 @@ You probably want to use this together with
1247 "Define keymap for `tumme-thumbnail-mode'." 1264 "Define keymap for `tumme-thumbnail-mode'."
1248 1265
1249 ;; Keys 1266 ;; Keys
1250 (define-key tumme-thumbnail-mode-map [right] 'tumme-forward-char) 1267 (define-key tumme-thumbnail-mode-map [right] 'tumme-forward-image)
1251 (define-key tumme-thumbnail-mode-map [left] 'tumme-backward-char) 1268 (define-key tumme-thumbnail-mode-map [left] 'tumme-backward-image)
1252 (define-key tumme-thumbnail-mode-map [up] 'tumme-previous-line) 1269 (define-key tumme-thumbnail-mode-map [up] 'tumme-previous-line)
1253 (define-key tumme-thumbnail-mode-map [down] 'tumme-next-line) 1270 (define-key tumme-thumbnail-mode-map [down] 'tumme-next-line)
1254 (define-key tumme-thumbnail-mode-map "\C-f" 'tumme-forward-char) 1271 (define-key tumme-thumbnail-mode-map "\C-f" 'tumme-forward-image)
1255 (define-key tumme-thumbnail-mode-map "\C-b" 'tumme-backward-char) 1272 (define-key tumme-thumbnail-mode-map "\C-b" 'tumme-backward-image)
1256 (define-key tumme-thumbnail-mode-map "\C-p" 'tumme-previous-line) 1273 (define-key tumme-thumbnail-mode-map "\C-p" 'tumme-previous-line)
1257 (define-key tumme-thumbnail-mode-map "\C-n" 'tumme-next-line) 1274 (define-key tumme-thumbnail-mode-map "\C-n" 'tumme-next-line)
1258 1275
@@ -1655,7 +1672,8 @@ See also `tumme-line-up-dynamic'."
1655 (insert "\n") 1672 (insert "\n")
1656 (insert " ") 1673 (insert " ")
1657 (setq count (1+ count)) 1674 (setq count (1+ count))
1658 (when (= count (- tumme-thumbs-per-row 1)) 1675 (when (and (= count (- tumme-thumbs-per-row 1))
1676 (not (eobp)))
1659 (forward-char) 1677 (forward-char)
1660 (insert "\n") 1678 (insert "\n")
1661 (setq count 0))))) 1679 (setq count 0)))))
@@ -1798,8 +1816,10 @@ With prefix argument ARG, display image in its original size."
1798 (message "No thumbnail at point") 1816 (message "No thumbnail at point")
1799 (if (not file) 1817 (if (not file)
1800 (message "No original file name found") 1818 (message "No original file name found")
1801 (tumme-display-image file arg) 1819 (tumme-create-display-image-buffer)
1802 (display-buffer tumme-display-image-buffer)))))) 1820 (display-buffer tumme-display-image-buffer)
1821 (tumme-display-image file arg))))))
1822
1803 1823
1804;;;###autoload 1824;;;###autoload
1805(defun tumme-dired-display-image (&optional arg) 1825(defun tumme-dired-display-image (&optional arg)
@@ -1807,8 +1827,9 @@ With prefix argument ARG, display image in its original size."
1807See documentation for `tumme-display-image' for more information. 1827See documentation for `tumme-display-image' for more information.
1808With prefix argument ARG, display image in its original size." 1828With prefix argument ARG, display image in its original size."
1809 (interactive "P") 1829 (interactive "P")
1810 (tumme-display-image (dired-get-filename) arg) 1830 (tumme-create-display-image-buffer)
1811 (display-buffer tumme-display-image-buffer)) 1831 (display-buffer tumme-display-image-buffer)
1832 (tumme-display-image (dired-get-filename) arg))
1812 1833
1813(defun tumme-image-at-point-p () 1834(defun tumme-image-at-point-p ()
1814 "Return true if there is a tumme thumbnail at point." 1835 "Return true if there is a tumme thumbnail at point."
@@ -2000,49 +2021,49 @@ function. The result is a couple of new files in
2000(defun tumme-display-next-thumbnail-original () 2021(defun tumme-display-next-thumbnail-original ()
2001 "In thubnail buffer, move to next thumbnail and display the image." 2022 "In thubnail buffer, move to next thumbnail and display the image."
2002 (interactive) 2023 (interactive)
2003 (tumme-forward-char) 2024 (tumme-forward-image)
2004 (tumme-display-thumbnail-original-image)) 2025 (tumme-display-thumbnail-original-image))
2005 2026
2006(defun tumme-display-previous-thumbnail-original () 2027(defun tumme-display-previous-thumbnail-original ()
2007 "Move to previous thumbnail and display image." 2028 "Move to previous thumbnail and display image."
2008
2009 (interactive) 2029 (interactive)
2010 (tumme-backward-char) 2030 (tumme-backward-image)
2011 (tumme-display-thumbnail-original-image)) 2031 (tumme-display-thumbnail-original-image))
2012 2032
2013(defun tumme-write-comment (file comment) 2033(defun tumme-write-comments (file-comments)
2014 "For FILE, write comment COMMENT in database." 2034 "Write file comments to database.
2015 (save-excursion 2035Write file comments to one or more files. FILE-COMMENTS is an alist on
2016 (let (end buf comment-beg) 2036the following form:
2017 (setq buf (find-file tumme-db-file)) 2037 ((FILE . COMMENT) ... )"
2018 (goto-char (point-min)) 2038 (let (end comment-beg-pos comment-end-pos file comment)
2019 (if (search-forward-regexp 2039 (with-temp-file tumme-db-file
2020 (format "^%s" file) nil t) 2040 (insert-file-contents tumme-db-file)
2021 (progn 2041 (dolist (elt file-comments)
2022 (end-of-line) 2042 (setq file (car elt)
2023 (setq end (point)) 2043 comment (cdr elt))
2024 (beginning-of-line) 2044 (goto-char (point-min))
2025 ;; Delete old comment, if any 2045 (if (search-forward-regexp (format "^%s.*$" file) nil t)
2026 (cond ((search-forward ";comment:" end t) 2046 (progn
2027 (setq comment-beg (match-beginning 0)) 2047 (setq end (point))
2028 ;; Any tags after the comment? 2048 (beginning-of-line)
2029 (if (search-forward ";" end t) 2049 ;; Delete old comment, if any
2030 (setq comment-end (- (point) 1)) 2050 (when (search-forward ";comment:" end t)
2031 (setq comment-end end)) 2051 (setq comment-beg-pos (match-beginning 0))
2032 ;; Delete comment tag and comment 2052 ;; Any tags after the comment?
2033 (delete-region comment-beg comment-end))) 2053 (if (search-forward ";" end t)
2034 ;; Insert new comment 2054 (setq comment-end-pos (- (point) 1))
2035 (beginning-of-line) 2055 (setq comment-end-pos end))
2036 (if (not (search-forward ";" end t)) 2056 ;; Delete comment tag and comment
2037 (progn 2057 (delete-region comment-beg-pos comment-end-pos))
2038 (end-of-line) 2058 ;; Insert new comment
2039 (insert ";"))) 2059 (beginning-of-line)
2040 (insert (format "comment:%s;" comment))) 2060 (unless (search-forward ";" end t)
2041 ;; File does not exist in databse - add it. 2061 (end-of-line)
2042 (goto-char (point-max)) 2062 (insert ";"))
2043 (insert (format "\n%s;comment:%s" file comment))) 2063 (insert (format "comment:%s;" comment)))
2044 (save-buffer) 2064 ;; File does not exist in database - add it.
2045 (kill-buffer buf)))) 2065 (goto-char (point-max))
2066 (insert (format "\n%s;comment:%s" file comment)))))))
2046 2067
2047(defun tumme-update-property (prop value) 2068(defun tumme-update-property (prop value)
2048 "Update text property PROP with value VALUE at point." 2069 "Update text property PROP with value VALUE at point."
@@ -2056,19 +2077,19 @@ function. The result is a couple of new files in
2056(defun tumme-dired-comment-files () 2077(defun tumme-dired-comment-files ()
2057 "Add comment to current or marked files in dired." 2078 "Add comment to current or marked files in dired."
2058 (interactive) 2079 (interactive)
2059 (let ((files (dired-get-marked-files)) 2080 (let ((comment (tumme-read-comment)))
2060 (comment (tumme-read-comment))) 2081 (tumme-write-comments
2061 (mapcar 2082 (mapcar
2062 (lambda (curr-file) 2083 (lambda (curr-file)
2063 (tumme-write-comment curr-file comment)) 2084 (cons curr-file comment))
2064 files))) 2085 (dired-get-marked-files)))))
2065 2086
2066(defun tumme-comment-thumbnail () 2087(defun tumme-comment-thumbnail ()
2067 "Add comment to current thumbnail in thumbnail buffer." 2088 "Add comment to current thumbnail in thumbnail buffer."
2068 (interactive) 2089 (interactive)
2069 (let* ((file (tumme-original-file-name)) 2090 (let* ((file (tumme-original-file-name))
2070 (comment (tumme-read-comment file))) 2091 (comment (tumme-read-comment file)))
2071 (tumme-write-comment file comment) 2092 (tumme-write-comments (list (cons file comment)))
2072 (tumme-update-property 'comment comment)) 2093 (tumme-update-property 'comment comment))
2073 (tumme-display-thumb-properties)) 2094 (tumme-display-thumb-properties))
2074 2095
@@ -2085,21 +2106,21 @@ as initial value."
2085(defun tumme-get-comment (file) 2106(defun tumme-get-comment (file)
2086 "Get comment for file FILE." 2107 "Get comment for file FILE."
2087 (save-excursion 2108 (save-excursion
2088 (let (end buf comment-beg comment (base-name (file-name-nondirectory file))) 2109 (let (end buf comment-beg-pos comment-end-pos comment)
2089 (setq buf (find-file tumme-db-file)) 2110 (setq buf (find-file tumme-db-file))
2090 (goto-char (point-min)) 2111 (goto-char (point-min))
2091 (when (search-forward-regexp 2112 (when (search-forward-regexp
2092 (format "^%s" base-name) nil t) 2113 (format "^%s" file) nil t)
2093 (end-of-line) 2114 (end-of-line)
2094 (setq end (point)) 2115 (setq end (point))
2095 (beginning-of-line) 2116 (beginning-of-line)
2096 (cond ((search-forward ";comment:" end t) 2117 (cond ((search-forward ";comment:" end t)
2097 (setq comment-beg (point)) 2118 (setq comment-beg-pos (point))
2098 (if (search-forward ";" end t) 2119 (if (search-forward ";" end t)
2099 (setq comment-end (- (point) 1)) 2120 (setq comment-end-pos (- (point) 1))
2100 (setq comment-end end)) 2121 (setq comment-end-pos end))
2101 (setq comment (buffer-substring 2122 (setq comment (buffer-substring
2102 comment-beg comment-end))))) 2123 comment-beg-pos comment-end-pos)))))
2103 (kill-buffer buf) 2124 (kill-buffer buf)
2104 comment))) 2125 comment)))
2105 2126
@@ -2153,6 +2174,8 @@ non-nil."
2153 (setq file (tumme-original-file-name)) 2174 (setq file (tumme-original-file-name))
2154 (if tumme-track-movement 2175 (if tumme-track-movement
2155 (tumme-track-original-file)) 2176 (tumme-track-original-file))
2177 (tumme-create-display-image-buffer)
2178 (display-buffer tumme-display-image-buffer)
2156 (tumme-display-image file))) 2179 (tumme-display-image file)))
2157 2180
2158(defun tumme-mouse-select-thumbnail (event) 2181(defun tumme-mouse-select-thumbnail (event)
@@ -2421,6 +2444,107 @@ when using per-directory thumbnail file storage"))
2421 (error nil)) 2444 (error nil))
2422 (kill-buffer buffer))) 2445 (kill-buffer buffer)))
2423 2446
2447(defvar tumme-widget-list nil
2448 "List to keep track of meta data in edit buffer.")
2449
2450;;;###autoload
2451(defun tumme-dired-edit-comment-and-tags ()
2452 "Edit comment and tags of current or marked image files.
2453Edit comment and tags for all marked image files in an
2454easy-to-use form."
2455 (interactive)
2456 (setq tumme-widget-list nil)
2457 ;; Setup buffer.
2458 (let ((files (dired-get-marked-files)))
2459 (switch-to-buffer "*Tumme Edit Meta Data*")
2460 (kill-all-local-variables)
2461 (make-local-variable 'widget-example-repeat)
2462 (let ((inhibit-read-only t))
2463 (erase-buffer))
2464 (remove-overlays)
2465 ;; Some help for the user.
2466 (widget-insert
2467"\nEdit comments and tags for each image. Separate multiple tags
2468with a comma. Move forward between fields using TAB or RET.
2469Move to the previous field using backtab (S-TAB). Save by
2470activating the Save button at the bottom of the form or cancel
2471the operation by activating the Cancel button.\n\n")
2472 ;; Here comes all images and a comment and tag field for each
2473 ;; image.
2474 (let (thumb-file img comment-widget tag-widget)
2475
2476 (dolist (file files)
2477
2478 (setq thumb-file (tumme-thumb-name file)
2479 img (create-image thumb-file))
2480
2481 (insert-image img)
2482 (widget-insert "\n\nComment: ")
2483 (setq comment-widget
2484 (widget-create 'editable-field
2485 :size 60
2486 :format "%v "
2487 :value (or (tumme-get-comment file) "")))
2488 (widget-insert "\nTags: ")
2489 (setq tag-widget
2490 (widget-create 'editable-field
2491 :size 60
2492 :format "%v "
2493 :value (or (mapconcat
2494 (lambda (tag)
2495 tag)
2496 (tumme-list-tags file)
2497 ",") "")))
2498 ;; Save information in all widgets so that we can use it when
2499 ;; the user saves the form.
2500 (setq tumme-widget-list
2501 (append tumme-widget-list
2502 (list (list file comment-widget tag-widget))))
2503 (widget-insert "\n\n")))
2504
2505 ;; Footer with Save and Cancel button.
2506 (widget-insert "\n")
2507 (widget-create 'push-button
2508 :notify
2509 (lambda (&rest ignore)
2510 (tumme-save-information-from-widgets)
2511 (bury-buffer)
2512 (message "Done."))
2513 "Save")
2514 (widget-insert " ")
2515 (widget-create 'push-button
2516 :notify
2517 (lambda (&rest ignore)
2518 (bury-buffer)
2519 (message "Operation canceled."))
2520 "Cancel")
2521 (widget-insert "\n")
2522 (use-local-map widget-keymap)
2523 (widget-setup)
2524 ;; Jump to the first widget.
2525 (widget-forward 1)))
2526
2527(defun tumme-save-information-from-widgets ()
2528 "Save information found in `tumme-widget-list'.
2529Use the information in `tumme-widget-list' to save comments and
2530tags to their respective image file. Internal function used by
2531`tumme-dired-edit-comment-and-tags'."
2532 (let (file comment tag-string tag-list lst)
2533 (tumme-write-comments
2534 (mapcar
2535 (lambda (widget)
2536 (setq file (car widget)
2537 comment (widget-value (cadr widget)))
2538 (cons file comment))
2539 tumme-widget-list))
2540 (tumme-write-tags
2541 (dolist (widget tumme-widget-list lst)
2542 (setq file (car widget)
2543 tag-string (widget-value (car (cddr widget)))
2544 tag-list (split-string tag-string ","))
2545 (dolist (tag tag-list)
2546 (push (cons file tag) lst))))))
2547
2424;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2548;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2425;;;;;;;;; TEST-SECTION ;;;;;;;;;;; 2549;;;;;;;;; TEST-SECTION ;;;;;;;;;;;
2426;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2550;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/lisp/xml.el b/lisp/xml.el
index 2ce3ec7b4f9..ca8f5bdc81b 100644
--- a/lisp/xml.el
+++ b/lisp/xml.el
@@ -165,22 +165,19 @@ If FILE is already visited, use its buffer and don't kill it.
165Returns the top node with all its children. 165Returns the top node with all its children.
166If PARSE-DTD is non-nil, the DTD is parsed rather than skipped. 166If PARSE-DTD is non-nil, the DTD is parsed rather than skipped.
167If PARSE-NS is non-nil, then QNAMES are expanded." 167If PARSE-NS is non-nil, then QNAMES are expanded."
168 (let ((keep)) 168 (if (get-file-buffer file)
169 (if (get-file-buffer file) 169 (with-current-buffer (get-file-buffer file)
170 (progn 170 (save-excursion
171 (set-buffer (get-file-buffer file)) 171 (xml-parse-region (point-min)
172 (setq keep (point))) 172 (point-max)
173 (let (auto-mode-alist) ; no need for xml-mode 173 (current-buffer)
174 (find-file file))) 174 parse-dtd parse-ns)))
175 175 (with-temp-buffer
176 (let ((xml (xml-parse-region (point-min) 176 (insert-file-contents file)
177 (point-max) 177 (xml-parse-region (point-min)
178 (current-buffer) 178 (point-max)
179 parse-dtd parse-ns))) 179 (current-buffer)
180 (if keep 180 parse-dtd parse-ns))))
181 (goto-char keep)
182 (kill-buffer (current-buffer)))
183 xml)))
184 181
185 182
186(defvar xml-name-re) 183(defvar xml-name-re)