aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorMiles Bader2005-05-26 05:42:19 +0000
committerMiles Bader2005-05-26 05:42:19 +0000
commitd2eeec7fb90dc54c4b08e85f452a23317c0ee65d (patch)
treecd13677b902ee91ff96c5f43ca30ae2aba828312 /lisp
parent5611ba87dd81c98d2cc00a4d01e19db3d26cf9d5 (diff)
parentc0e9b2d0ec9cb343733243371efecf77722b067f (diff)
downloademacs-d2eeec7fb90dc54c4b08e85f452a23317c0ee65d.tar.gz
emacs-d2eeec7fb90dc54c4b08e85f452a23317c0ee65d.zip
Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-55
Merge from emacs--cvs-trunk--0 Patches applied: * emacs--cvs-trunk--0 (patch 320-323) - Update from CVS
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog391
-rw-r--r--lisp/bindings.el20
-rw-r--r--lisp/buff-menu.el44
-rw-r--r--lisp/calc/calc-units.el120
-rw-r--r--lisp/calendar/cal-menu.el2
-rw-r--r--lisp/diff-mode.el30
-rw-r--r--lisp/dired.el25
-rw-r--r--lisp/emacs-lisp/bytecomp.el21
-rw-r--r--lisp/emacs-lisp/cl-extra.el70
-rw-r--r--lisp/emacs-lisp/cl-macs.el38
-rw-r--r--lisp/emacs-lisp/cl-seq.el209
-rw-r--r--lisp/emacs-lisp/cl.el69
-rw-r--r--lisp/emacs-lisp/derived.el1
-rw-r--r--lisp/emacs-lisp/easy-mmode.el6
-rw-r--r--lisp/emacs-lisp/easymenu.el14
-rw-r--r--lisp/emulation/tpu-extras.el6
-rw-r--r--lisp/emulation/viper-ex.el4
-rw-r--r--lisp/faces.el13
-rw-r--r--lisp/files.el9
-rw-r--r--lisp/font-core.el24
-rw-r--r--lisp/font-lock.el25
-rw-r--r--lisp/help.el4
-rw-r--r--lisp/hexl.el9
-rw-r--r--lisp/imenu.el69
-rw-r--r--lisp/language/viet-util.el2
-rw-r--r--lisp/log-edit.el8
-rw-r--r--lisp/mail/mailalias.el2
-rw-r--r--lisp/mail/rmail.el6
-rw-r--r--lisp/mail/sendmail.el3
-rw-r--r--lisp/mail/smtpmail.el7
-rw-r--r--lisp/net/rcompile.el2
-rw-r--r--lisp/progmodes/cc-align.el10
-rw-r--r--lisp/progmodes/cc-awk.el19
-rw-r--r--lisp/progmodes/cc-cmds.el9
-rw-r--r--lisp/progmodes/cc-defs.el2
-rw-r--r--lisp/progmodes/cc-engine.el34
-rw-r--r--lisp/progmodes/cc-fonts.el2
-rw-r--r--lisp/progmodes/cc-langs.el2
-rw-r--r--lisp/progmodes/cc-mode.el38
-rw-r--r--lisp/progmodes/cc-styles.el1
-rw-r--r--lisp/progmodes/cperl-mode.el23
-rw-r--r--lisp/progmodes/etags.el3
-rw-r--r--lisp/progmodes/flymake.el3
-rw-r--r--lisp/progmodes/gdb-ui.el26
-rw-r--r--lisp/progmodes/idlwave.el2
-rw-r--r--lisp/progmodes/make-mode.el14
-rw-r--r--lisp/progmodes/sh-script.el4
-rw-r--r--lisp/progmodes/vhdl-mode.el6
-rw-r--r--lisp/ruler-mode.el9
-rw-r--r--lisp/simple.el11
-rw-r--r--lisp/startup.el16
-rw-r--r--lisp/subr.el10
-rw-r--r--lisp/textmodes/org.el539
-rw-r--r--lisp/textmodes/table.el2
-rw-r--r--lisp/thumbs.el34
-rw-r--r--lisp/tmm.el2
-rw-r--r--lisp/vc-cvs.el21
-rw-r--r--lisp/vc.el6
-rw-r--r--lisp/vms-patch.el67
-rw-r--r--lisp/window.el5
60 files changed, 1519 insertions, 654 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index aaaf1be4fa8..d1e6655232c 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,333 @@
12005-05-26 Nick Roberts <nickrob@snap.net.nz>
2
3 * log-edit.el (log-edit-changelog-entries): Distinguish between
4 filenames like xfns.c and fns.c.
5 Coded by Stefan Monnier <monnier@iro.umontreal.ca>.
6
72005-05-25 Luc Teirlinck <teirllm@auburn.edu>
8
9 * buff-menu.el (Buffer-menu-revert-function): Improve handling of
10 point after reverting.
11 (Buffer-menu-make-sort-button): Handle the case where
12 `Buffer-menu-use-header-line' is nil.
13
142005-05-25 Thien-Thi Nguyen <ttn@gnu.org>
15
16 * vms-patch.el (vms-magic-right-square-brace, vms-magic-colon):
17 New funcs. In minibuffer-local-completion-map bind `]', `/'
18 and `:' to them.
19
202005-05-25 Stefan Monnier <monnier@iro.umontreal.ca>
21
22 * startup.el (normal-top-level): Allow modification of load-path while
23 we're iterating over it.
24
252005-05-25 Juanma Barranquero <lekktu@gmail.com>
26
27 * thumbs.el (thumbs-thumbsdir-max-size, thumbs-temp-file)
28 (thumbs-cleanup-thumbsdir, thumbs-call-convert)
29 (thumbs-resize-interactive, thumbs-insert-image)
30 (thumbs-insert-thumb, thumbs-dired-show-marked)
31 (thumbs-find-image-at-point, thumbs-delete-images)
32 (thumbs-rename-images, thumbs-next-image, thumbs-dired-setroot)
33 (thumbs-increment-image-size, thumbs-decrement-image-size):
34 Fix typos in docstrings.
35
362005-05-24 Andre Spiegel <spiegel@gnu.org>
37
38 * progmodes/cperl-mode.el (cperl-vc-header-alist): Obsoleted.
39 (cperl-vc-rcs-header, cperl-vc-sccs-header): New user options.
40 (cperl-mode): Use them.
41
422005-05-24 Juanma Barranquero <lekktu@gmail.com>
43
44 * window.el (quit-window, shrink-window-if-larger-than-buffer):
45 Doc fixes.
46
472005-05-24 Nick Roberts <nickrob@snap.net.nz>
48
49 * progmodes/gdb-ui.el (gdb-inferior-io-mode-map):
50 Bind C-d to gdb-inferior-io-eof.
51
52 * dired.el (dired-dnd-popup-notice): Use message-box.
53
542005-05-23 Masatake YAMATO <jet@gyve.org>
55
56 * bindings.el (mode-line-major-mode-keymap):
57 Bind [mode-line down-mouse-1] to `mouse-major-mode-menu'.
58
59 * faces.el (mode-line-highlight): New face.
60
61 * ruler-mode.el (ruler-mode-ruler): Use mode-line-highlight
62 as mouse-face.
63
64 * bindings.el (top-level, help-echo, mode-line-modified)
65 (mode-line-mule-info, mode-line-eol-desc): Use mode-line-highlight
66 as mouse-face.
67
682005-05-23 Juanma Barranquero <lekktu@gmail.com>
69
70 * progmodes/cc-engine.el (c-guess-basic-syntax):
71 Remove spurious call to `zerop'.
72
73 * emacs-lisp/cl.el (acons, pairlis): Add docstring.
74
752005-05-23 Martin Stjernholm <bug-cc-mode@gnu.org>
76
77 CC Mode update to 5.30.10:
78
79 * cc-fonts.el (c-font-lock-declarators): Fixed bug where the point
80 could go past the limit in decoration level 2, thereby causing
81 errors during interactive fontification.
82
83 * cc-mode.el (c-make-inherited-keymap): Fixed cc-bytecomp bug when
84 the file is evaluated interactively.
85
86 * cc-engine.el (c-guess-basic-syntax): Handle operator
87 declarations somewhat better in C++.
88
89 * cc-styles.el, cc-mode.el (c-run-mode-hooks): New helper macro to
90 make use of `run-mode-hooks' which has been added in Emacs 21.1.
91 (c-mode, c++-mode, objc-mode, java-mode, idl-mode, pike-mode)
92 (awk-mode): Use it.
93 (make-local-hook): Suppress warning about obsoleteness.
94
95 * cc-engine.el, cc-align.el, cc-cmds.el
96 (c-append-backslashes-forward, c-delete-backslashes-forward)
97 (c-find-decl-spots, c-semi&comma-no-newlines-before-nonblanks):
98 Compensate for return value from `forward-line' when it has moved
99 but not to a different line due to eob.
100
101 * cc-engine.el (c-guess-basic-syntax): Fixed anchoring in
102 `objc-method-intro' and `objc-method-args-cont'.
103
1042005-05-23 Alan Mackenzie <bug-cc-mode@gnu.org>
105
106 CC Mode update to 5.30.10:
107
108 * cc-mode.el, cc-engine.el, cc-align.el: Change the FSF's address
109 in the copyright statement. Incidentally, change "along with GNU
110 Emacs" to "along with this program" where it occurs.
111
112 * cc-mode.el: Add a fourth parameter `t' to the awk-mode autoload,
113 so that it is interactive, hence can be found by M-x awk-mode
114 whilst cc-mode is yet to be loaded. Reported by Glenn Morris
115 <gmorris+emacs@ast.cam.ac.uk>.
116
117 * cc-awk.el: Add character classes (e.g. "[:alpha:]") into AWK
118 Mode's regexps.
119
1202005-05-23 Kevin Ryde <user42@zip.com.au>
121
122 * cc-align.el (c-lineup-argcont): Ignore conses for {} pairs from
123 c-parse-state, to avoid a lisp error (on bad code).
124
1252005-05-23 Lute Kamstra <lute@gnu.org>
126
127 * subr.el (font-lock-defaults): Remove defvar as it's already
128 defined in font-core.el.
129
130 * font-lock.el (font-lock-beginning-of-syntax-function): Fix
131 docstring.
132
1332005-05-23 Nick Roberts <nickrob@snap.net.nz>
134
135 * progmodes/gdb-ui.el (gdb-info-locals-handler): Make regexps
136 more general and work when GDB variable "print pretty" is on,
137 as with Emacs, for example.
138
1392005-05-22 Luc Teirlinck <teirllm@auburn.edu>
140
141 * font-core.el: Update comment.
142
143 * emacs-lisp/easy-mmode.el (define-global-minor-mode): Use
144 `after-change-major-mode-hook' instead of `find-file-hook'.
145
146 * buff-menu.el (Buffer-menu-mode): Use `run-mode-hooks'.
147
1482005-05-22 Eli Zaretskii <eliz@gnu.org>
149
150 * simple.el (yank, yank-pop): Mention `yank-excluded-properties'
151 and `yank-handler' in the doc strings.
152
1532005-05-22 Stefan Monnier <monnier@iro.umontreal.ca>
154
155 * emacs-lisp/cl.el (eql): Remove. It's a builtin already.
156
1572005-05-22 Richard M. Stallman <rms@gnu.org>
158
159 * help.el (describe-key): Move print-help-return-message call
160 out of conditional.
161
162 * progmodes/etags.el (list-tags): Use with-no-warnings.
163
164 * mail/smtpmail.el (smtpmail-open-stream): Use with-no-warnings.
165 (smtpmail-send-queued-mail): Avoid beginning-of-buffer.
166 (starttls-extra-args, starttls-extra-arguments): Add defvars.
167
168 * mail/mailalias.el (mail-get-names): Avoid beginning-of-buffer.
169
170 * language/viet-util.el (viet-viscii-nonascii-translation-table):
171 Add defvar.
172
173 * emulation/viper-ex.el (viper-ex-work-buf, viper-ex-print-buf):
174 Use defvar, not defconst.
175
176 * hexl.el (hexl-follow-line): Use with-no-warnings.
177
178 * emulation/tpu-extras.el: Use write-file-functions instead of
179 write-file-hooks.
180
181 * dired.el (dired-font-lock-keywords): Fontify files with junk
182 extensions even if marked by -F.
183
1842005-05-22 Juanma Barranquero <lekktu@gmail.com>
185
186 * emacs-lisp/cl.el (pushnew, cl-macroexpand, floatp-safe, plusp)
187 (minusp, oddp, evenp, mapcar*, list*, copy-list, adjoin, subst):
188 * emacs-lisp/cl-extra.el (coerce, map, maplist, cl-mapc, mapl)
189 (mapcan, mapcon, some, every, notany, notevery, signum, isqrt)
190 (concatenate, list-length, get*, getf, cl-remprop):
191 * emacs-lisp/cl-macs.el (function*, case, ecase, typecase)
192 (etypecase, progv, lexical-let, lexical-let*)
193 (multiple-value-bind, multiple-value-setq, shiftf):
194 Improve argument/docstring consistency.
195
196 * subr.el (focus-frame, unfocus-frame):
197 Revert deletion on 2005-05-01.
198
1992005-05-22 Andre Spiegel <spiegel@gnu.org>
200
201 * vc-cvs.el (vc-cvs-checkout-model): Handle the case where FILE
202 doesn't exist.
203
204 * vc.el (vc-trunk-p): Add autoload cookie. The function is used
205 in vc-rcs.el when vc-mistrust-permissions is t, which is not the
206 default.
207
2082005-05-22 Nick Roberts <nickrob@snap.net.nz>
209
210 * emacs-lisp/bytecomp.el: Remove make-obsolete-variable for
211 already deleted variables: auto-fill-hook, blink-paren-hook,
212 lisp-indent-hook, inhibit-local-variables, unread-command-event
213 suspend-hooks, comment-indent-hook, meta-flag,
214 before-change-function, after-change-function,
215 font-lock-doc-string-face.
216
2172005-05-21 Luc Teirlinck <teirllm@auburn.edu>
218
219 * emacs-lisp/derived.el (define-derived-mode): Doc fix.
220
2212005-05-21 Eli Zaretskii <eliz@gnu.org>
222
223 * mail/rmail.el (rmail-reply): Filter the list in reply-to through
224 rmail-dont-reply-to.
225
2262005-05-21 Frederik Fouvry <fouvry@CoLi.Uni-SB.DE>
227
228 * mail/sendmail.el (mail-send): Use [[:space:]] instead of a
229 literal blank when splitting new-header-values.
230
2312005-05-21 Matt Hodges <MPHodges@member.fsf.org>
232
233 * calendar/cal-menu.el (cal-menu-update): Add separator as a
234 string so that tmm doesn't create a completion entry for it.
235
236 * textmodes/table.el (table-disable-menu): Ditto.
237
2382005-05-21 Richard M. Stallman <rms@gnu.org>
239
240 * progmodes/idlwave.el (idlwave-doc-header): Use insert-file-contents.
241
242 * progmodes/flymake.el (flymake-makehash): Use with-no-warnings.
243
244 * net/rcompile.el (remote-compile): Use compilation-start.
245
246 * tmm.el (tmm-shortcut): Avoid using beginning-of-buffer.
247
2482005-05-21 Daniel Pfeiffer <occitan@esperanto.org>
249
250 * files.el (auto-mode-alist): Check GNUmakefile before makefile.
251 Default to makefile-bsdmake-mode on BSD systems.
252
253 * imenu.el (imenu-generic-expression, imenu--generic-function'):
254 REGEXP may also be a search function now. The part of doc-string
255 for describing the structure was 95% identical to that of
256 `imenu--generic-function'. Unify it there.
257
258 * progmodes/make-mode.el (makefile-imenu-generic-expression):
259 Use function to find dependencies, because regexp alone is so complex,
260 it easily goes into an endless loop.
261 (makefile-makepp-mode): Also add submenu for Perl functions
262 defined in the makefile.
263 (makefile-bsdmake-mode): Special imenu-generic-expression no
264 longer needed, due to function call.
265 (makefile-match-dependency): Take BOUND into account when checking
266 if we're through.
267
2682005-05-20 Jay Belanger <belanger@truman.edu>
269
270 * calc/calc-units.el (calc-invalidate-units-table):
271 Use inhibit-read-only.
272 (math-build-units-table-buffer): Use view-mode.
273
2742005-05-20 David Kastrup <dak@gnu.org>
275
276 * emacs-lisp/easymenu.el (easy-menu-add): Correct docstring since
277 easy-menu-add is not a nop on Emacs; and clarify when to call it.
278
2792005-05-20 Lute Kamstra <lute@gnu.org>
280
281 * diff-mode.el (diff-header-face, diff-file-header-face)
282 (diff-index-face, diff-hunk-header-face, diff-removed-face)
283 (diff-added-face, diff-changed-face, diff-function-face)
284 (diff-context-face, diff-nonexistent-face): Put them in the
285 diff-mode customization group.
286
2872005-05-20 Stefan Monnier <monnier@iro.umontreal.ca>
288
289 * progmodes/vhdl-mode.el (vhdl-font-lock-match-item): Simplify regexp.
290
291 * progmodes/sh-script.el (sh-mode, sh-get-word): Minor regexp fixes.
292
293 * font-lock.el (lisp-font-lock-keywords-2): Don't error.
294 Minor regexp-optimization.
295
2962005-05-20 Carsten Dominik <dominik@science.uva.nl>
297
298 * textmodes/org.el (org-agenda-toggle-time-grid): New command.
299 (org-agenda-use-time-grid, org-agenda-time-grid): New options.
300 (org-agenda-add-time-grid-maybe): New function.
301 (org-agenda): Call `org-agenda-add-time-grid-maybe'.
302 (org-table-create): `dotimes' instead of `mapcar'.
303 (org-xor): Simplify implementation.
304 (org-agenda): `inhibit-redisplay' turned on.
305 (org-agenda-change-all-lines): Use `org-format-agenda-item' to get
306 a consistent line after a state change.
307 (org-agenda-remove-times-when-in-prefix): New option.
308 (org-prefix-has-time): New variable.
309 (org-parse-time-string): Optional argument NODEFAULT.
310 (org-format-agenda-item): Parse items for time-of-day
311 specifications and move these into the prefix if possible.
312 (org-agenda-priority): Get current heading, not previous heading
313 during agenda remote editing.
314
12005-05-20 Juanma Barranquero <lekktu@gmail.com> 3152005-05-20 Juanma Barranquero <lekktu@gmail.com>
2 316
317 * emacs-lisp/cl-seq.el (reduce, fill, replace, remove*)
318 (remove-if, remove-if-not, delete*, delete-if, delete-if-not)
319 (remove-duplicates, delete-duplicates, substitute)
320 (substitute-if, substitute-if-not, nsubstitute, nsubstitute-if)
321 (nsubstitute-if-not, find, find-if, find-if-not, position)
322 (position-if, position-if-not, count, count-if, count-if-not)
323 (mismatch, search, sort*, stable-sort, merge, member*)
324 (member-if, member-if-not, assoc*, assoc-if, assoc-if-not)
325 (rassoc*, rassoc-if, rassoc-if-not, union, nunion)
326 (intersection, nintersection, set-difference, nset-difference)
327 (set-exclusive-or, nset-exclusive-or, subsetp, subst-if)
328 (subst-if-not, nsubst, nsubst-if, nsubst-if-not, sublis)
329 (nsublis, tree-equal): Improve argument/docstring consistency.
330
3 * subr.el (send-string, send-region): 331 * subr.el (send-string, send-region):
4 Remove obsolescence declaration. 332 Remove obsolescence declaration.
5 (window-dot, set-window-dot, read-input, show-buffer) 333 (window-dot, set-window-dot, read-input, show-buffer)
@@ -68,6 +396,7 @@
68 (left-fringe-p): Function deleted. 396 (left-fringe-p): Function deleted.
69 397
70 * buff-menu.el (Buffer-menu-buffer-face): In group Buffer-menu. 398 * buff-menu.el (Buffer-menu-buffer-face): In group Buffer-menu.
399 (list-buffers-noselect): Set `font-lock-face' property, not `face'.
71 400
72 * dired-aux.el (dired-copy-file-recursive): Handle symlinks 401 * dired-aux.el (dired-copy-file-recursive): Handle symlinks
73 in recursive copy. 402 in recursive copy.
@@ -89,7 +418,7 @@
89 418
902005-05-19 Carsten Dominik <dominik@science.uva.nl> 4192005-05-19 Carsten Dominik <dominik@science.uva.nl>
91 420
92 * textmodes/reftex.el (reftex-isearch-minor-mode): Moved the 421 * textmodes/reftex.el (reftex-isearch-minor-mode): Move the
93 definition of this variable from reftex-global.el to reftex.el, 422 definition of this variable from reftex-global.el to reftex.el,
94 because it is needed in the menu. 423 because it is needed in the menu.
95 424
@@ -112,8 +441,8 @@
112 (makefile-add-this-line-macro): Simplify and integrate into 441 (makefile-add-this-line-macro): Simplify and integrate into
113 `makefile-pickup-macros. 442 `makefile-pickup-macros.
114 (makefile-pickup-filenames-as-targets): Simplify. 443 (makefile-pickup-filenames-as-targets): Simplify.
115 (makefile-previous-dependency, makefile-match-dependency): Don't 444 (makefile-previous-dependency, makefile-match-dependency):
116 stumble over `::'. 445 Don't stumble over `::'.
117 446
1182005-05-19 Nick Roberts <nickrob@snap.net.nz> 4472005-05-19 Nick Roberts <nickrob@snap.net.nz>
119 448
@@ -127,8 +456,8 @@
127 * help-fns.el (describe-variable): Remove hyperlinks in a 456 * help-fns.el (describe-variable): Remove hyperlinks in a
128 variable's value as these are quite frequently inappropriate. 457 variable's value as these are quite frequently inappropriate.
129 458
130 * follow.el (follow-submit-feedback, follow-mode): Remove 459 * follow.el (follow-submit-feedback, follow-mode):
131 references to post-command-idle-hook. 460 Remove references to post-command-idle-hook.
132 461
1332005-05-18 Daniel Pfeiffer <occitan@esperanto.org> 4622005-05-18 Daniel Pfeiffer <occitan@esperanto.org>
134 463
@@ -138,8 +467,8 @@
138 467
1392005-05-18 Jay Belanger <belanger@truman.edu> 4682005-05-18 Jay Belanger <belanger@truman.edu>
140 469
141 * calc/calc-help.el (calc-s-prefix-help): Add 470 * calc/calc-help.el (calc-s-prefix-help):
142 `calc-copy-special-constant' to help string. 471 Add `calc-copy-special-constant' to help string.
143 472
1442005-05-18 Luc Teirlinck <teirllm@auburn.edu> 4732005-05-18 Luc Teirlinck <teirllm@auburn.edu>
145 474
@@ -152,8 +481,8 @@
152 481
1532005-05-18 Carsten Dominik <dominik@science.uva.nl> 4822005-05-18 Carsten Dominik <dominik@science.uva.nl>
154 483
155 * textmodes/reftex-vars.el (reftex-cite-format-builtin): Support 484 * textmodes/reftex-vars.el (reftex-cite-format-builtin):
156 for jurabib. 485 Support for jurabib.
157 486
158 * textmodes/reftex.el (featurep): Define aliases for overlay 487 * textmodes/reftex.el (featurep): Define aliases for overlay
159 commands, for XEmacs compatibility, and use these aliases in 488 commands, for XEmacs compatibility, and use these aliases in
@@ -164,8 +493,8 @@
164 (reftex-access-search-path): Use `reftex-uniquify' instead of 493 (reftex-access-search-path): Use `reftex-uniquify' instead of
165 `reftex-uniq' 494 `reftex-uniq'
166 495
167 * textmodes/reftex-sel.el (reftex-select-unmark): Overlay 496 * textmodes/reftex-sel.el (reftex-select-unmark):
168 `before-string' property modification enables for Emacs as well. 497 Overlay `before-string' property modification enables for Emacs as well.
169 (reftex-select-item): Use `reftex-delete-overlay'. 498 (reftex-select-item): Use `reftex-delete-overlay'.
170 (reftex-select-mark): Use `reftex-make-overlay' and 499 (reftex-select-mark): Use `reftex-make-overlay' and
171 `reftex-overlay-put'. 500 `reftex-overlay-put'.
@@ -200,8 +529,7 @@
200 529
201 * progmodes/prolog.el (inferior-prolog-mode): Doc fix. 530 * progmodes/prolog.el (inferior-prolog-mode): Doc fix.
202 (prolog-consult-region): Replace `send-string' by 531 (prolog-consult-region): Replace `send-string' by
203 `process-send-string'; replace `send-region' by 532 `process-send-string'; replace `send-region' by `process-send-region'.
204 `process-send-region'.
205 533
206 * progmodes/delphi.el (delphi-log-msg): 534 * progmodes/delphi.el (delphi-log-msg):
207 Replace `set-window-dot' by `set-window-point'. 535 Replace `set-window-dot' by `set-window-point'.
@@ -232,8 +560,8 @@
232 loop. It should also be more efficient, because first it only 560 loop. It should also be more efficient, because first it only
233 searches for `:', instead of applying the very complex regexp. 561 searches for `:', instead of applying the very complex regexp.
234 (makefile-mode): Cancel `font-lock-support-mode', because blocks 562 (makefile-mode): Cancel `font-lock-support-mode', because blocks
235 to be fontified in one piece can be too long for JIT. Makefiles 563 to be fontified in one piece can be too long for JIT.
236 are never *that* big. 564 Makefiles are never *that* big.
237 565
2382005-05-17 Reiner Steib <Reiner.Steib@gmx.de> 5662005-05-17 Reiner Steib <Reiner.Steib@gmx.de>
239 567
@@ -259,8 +587,8 @@
259 587
2602005-05-16 Daniel Pfeiffer <occitan@esperanto.org> 5882005-05-16 Daniel Pfeiffer <occitan@esperanto.org>
261 589
262 * font-lock.el (lisp-font-lock-keywords-1): Set 590 * font-lock.el (lisp-font-lock-keywords-1):
263 `font-lock-negation-char-face' for [^...] char group. 591 Set `font-lock-negation-char-face' for [^...] char group.
264 (lisp-font-lock-keywords-2): Highlight regexp's \\( \\| \\). 592 (lisp-font-lock-keywords-2): Highlight regexp's \\( \\| \\).
265 593
266 * progmodes/make-mode.el (makefile-dependency-regex): Turn it into 594 * progmodes/make-mode.el (makefile-dependency-regex): Turn it into
@@ -274,11 +602,10 @@
274 might be the same one to be skipped by the initial [^$], leading 602 might be the same one to be skipped by the initial [^$], leading
275 to an overlooked variable use. 603 to an overlooked variable use.
276 (makefile-make-font-lock-keywords): Remove two parameters, which 604 (makefile-make-font-lock-keywords): Remove two parameters, which
277 are now variables that some of the modes set locally. Handle 605 are now variables that some of the modes set locally.
278 dependency and rule action matching through functions, because 606 Handle dependency and rule action matching through functions, because
279 regexps alone match too often. Dependency matching now comes 607 regexps alone match too often. Dependency matching now comes
280 last, so it can check, whether a colon already matched something 608 last, so it can check, whether a colon already matched something else.
281 else.
282 (makefile-mode): Inform that font-lock improves makefile parsing 609 (makefile-mode): Inform that font-lock improves makefile parsing
283 capabilities. 610 capabilities.
284 (makefile-match-dependency, makefile-match-action): New functions. 611 (makefile-match-dependency, makefile-match-action): New functions.
@@ -363,8 +690,8 @@
363 (reftex-bib-sort-year-reverse, reftex-format-citation): 690 (reftex-bib-sort-year-reverse, reftex-format-citation):
364 * textmodes/reftex-parse.el (reftex-init-section-numbers) 691 * textmodes/reftex-parse.el (reftex-init-section-numbers)
365 (reftex-section-number): 692 (reftex-section-number):
366 * textmodes/texinfmt.el (texinfo-paragraphindent): Replace 693 * textmodes/texinfmt.el (texinfo-paragraphindent):
367 `string-to-int' by `string-to-number'. 694 Replace `string-to-int' by `string-to-number'.
368 695
369 * international/latexenc.el: Add page marker to force the "Local 696 * international/latexenc.el: Add page marker to force the "Local
370 Variables:" string out of the last page. 697 Variables:" string out of the last page.
@@ -472,23 +799,22 @@
472 (tramp-pre-connection): Add parameter CHUNKSIZE. Make local 799 (tramp-pre-connection): Add parameter CHUNKSIZE. Make local
473 variable `tramp-chunksize'. Change callees. 800 variable `tramp-chunksize'. Change callees.
474 (tramp-open-connection-setup-interactive-shell): Check remote host 801 (tramp-open-connection-setup-interactive-shell): Check remote host
475 for buggy `send-process-string' implementation. Set 802 for buggy `send-process-string' implementation.
476 `tramp-chunksize' if found. Reported by Michael Kifer 803 Set `tramp-chunksize' if found. Reported by Michael Kifer
477 <kifer@cs.sunysb.edu> (and a lot of other people all the years). 804 <kifer@cs.sunysb.edu> (and a lot of other people all the years).
478 (tramp-handle-shell-command): `insert-buffer' cannot be used 805 (tramp-handle-shell-command): `insert-buffer' cannot be used
479 because the contents of the Tramp buffer is changed before 806 because the contents of the Tramp buffer is changed before
480 insertion (`expand-file' and alike). Reported by Fr,Ai(Bd,Ai(Bric Bothamy 807 insertion (`expand-file' and alike). Reported by Fr,Ai(Bd,Ai(Bric Bothamy
481 <frederic.bothamy@free.fr>. 808 <frederic.bothamy@free.fr>.
482 (tramp-set-auto-save): Actions should be done for Tramp file name 809 (tramp-set-auto-save): Actions should be done for Tramp file name
483 handler only. Ange-FTP has its own auto-save mechanism. Reported 810 handler only. Ange-FTP has its own auto-save mechanism.
484 by Richard G. Bielawski <Richard.G.Bielawski@wellsfargo.com>. 811 Reported by Richard G. Bielawski <Richard.G.Bielawski@wellsfargo.com>.
485 (tramp-set-auto-save-file-modes): Set file modes of 812 (tramp-set-auto-save-file-modes): Set file modes of
486 `buffer-auto-save-file-name' to ?\600 as fallback solution. 813 `buffer-auto-save-file-name' to ?\600 as fallback solution.
487 Reported by Ferenc Wagner <wferi@tba.elte.hu>. 814 Reported by Ferenc Wagner <wferi@tba.elte.hu>.
488 (tramp-bug): Remove obsolete variable. 815 (tramp-bug): Remove obsolete variable.
489 (tramp-append-tramp-buffers): Rewrite partly. More suitable check 816 (tramp-append-tramp-buffers): Rewrite partly. More suitable check
490 for presence of `mml-mode'. Make it running for older Emacsen as 817 for presence of `mml-mode'. Make it running for older Emacsen as well.
491 well.
492 818
4932005-05-14 John Paul Wallington <jpw@pobox.com> 8192005-05-14 John Paul Wallington <jpw@pobox.com>
494 820
@@ -540,15 +866,14 @@
540 866
5412005-05-13 Matt Hodges <MPHodges@member.fsf.org> 8672005-05-13 Matt Hodges <MPHodges@member.fsf.org>
542 868
543 * tmm.el (tmm-get-keymap): Include only active menus and menu 869 * tmm.el (tmm-get-keymap): Include only active menus and menu items.
544 items.
545 870
546 * emacs-lisp/easymenu.el (easy-menu-define): Doc fixes. 871 * emacs-lisp/easymenu.el (easy-menu-define): Doc fixes.
547 872
5482005-05-13 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> 8732005-05-13 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
549 874
550 * dired.el (dired-mode): make-variable-buffer-local => 875 * dired.el (dired-mode): make-variable-buffer-local =>
551 make-local-variable 876 make-local-variable.
552 877
5532005-05-13 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> 8782005-05-13 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
554 879
@@ -9592,7 +9917,7 @@
9592 (Info-build-toc): Don't check for special Info file names. 9917 (Info-build-toc): Don't check for special Info file names.
9593 Set main-file to nil if Info-find-file returns a symbol. 9918 Set main-file to nil if Info-find-file returns a symbol.
9594 9919
95952004-10-05 Emilio C. Lopes <eclig@gmx.net>: 99202004-10-05 Emilio C. Lopes <eclig@gmx.net>
9596 9921
9597 * calendar/calendar.el (calendar-goto-iso-week): Add autoload. 9922 * calendar/calendar.el (calendar-goto-iso-week): Add autoload.
9598 (calendar-mode-map): Add binding for `calendar-goto-iso-week'. 9923 (calendar-mode-map): Add binding for `calendar-goto-iso-week'.
diff --git a/lisp/bindings.el b/lisp/bindings.el
index b47cab84e49..38572cd5bd1 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -165,7 +165,8 @@ corresponding to the mode line clicked."
165 (eval-when-compile 165 (eval-when-compile
166 (let ((map (make-sparse-keymap))) 166 (let ((map (make-sparse-keymap)))
167 (define-key map [mode-line mouse-3] 'mode-line-change-eol) 167 (define-key map [mode-line mouse-3] 'mode-line-change-eol)
168 map)))) 168 map))
169 'mouse-face 'mode-line-highlight))
169 (push (cons eol (cons mnemonic desc)) mode-line-eol-desc-cache) 170 (push (cons eol (cons mnemonic desc)) mode-line-eol-desc-cache)
170 desc))) 171 desc)))
171 172
@@ -177,7 +178,8 @@ corresponding to the mode line clicked."
177 "Input method: " 178 "Input method: "
178 current-input-method 179 current-input-method
179 ". mouse-2: disable, mouse-3: describe") 180 ". mouse-2: disable, mouse-3: describe")
180 local-map ,mode-line-input-method-map)) 181 local-map ,mode-line-input-method-map
182 mouse-face mode-line-highlight))
181 ,(propertize 183 ,(propertize
182 "%z" 184 "%z"
183 'help-echo 185 'help-echo
@@ -191,6 +193,7 @@ corresponding to the mode line clicked."
191 " buffer; mouse-3: describe coding system") 193 " buffer; mouse-3: describe coding system")
192 (concat "Unibyte " (symbol-name buffer-file-coding-system) 194 (concat "Unibyte " (symbol-name buffer-file-coding-system)
193 " buffer"))))) 195 " buffer")))))
196 'mouse-face 'mode-line-highlight
194 'local-map mode-line-coding-system-map) 197 'local-map mode-line-coding-system-map)
195 (:eval (mode-line-eol-desc))) 198 (:eval (mode-line-eol-desc)))
196 "Mode-line control for displaying information of multilingual environment. 199 "Mode-line control for displaying information of multilingual environment.
@@ -235,7 +238,8 @@ Normally nil in most modes, since there is no process to display.")
235 "Not r"))))) 238 "Not r")))))
236 'local-map (purecopy (make-mode-line-mouse-map 239 'local-map (purecopy (make-mode-line-mouse-map
237 'mouse-3 240 'mouse-3
238 #'mode-line-toggle-read-only))) 241 #'mode-line-toggle-read-only))
242 'mouse-face 'mode-line-highlight)
239 (propertize 243 (propertize
240 "%1+" 244 "%1+"
241 'help-echo (purecopy (lambda (window object point) 245 'help-echo (purecopy (lambda (window object point)
@@ -246,7 +250,8 @@ Normally nil in most modes, since there is no process to display.")
246 "M" 250 "M"
247 "Not m"))))) 251 "Not m")))))
248 'local-map (purecopy (make-mode-line-mouse-map 252 'local-map (purecopy (make-mode-line-mouse-map
249 'mouse-3 #'mode-line-toggle-modified)))) 253 'mouse-3 #'mode-line-toggle-modified))
254 'mouse-face 'mode-line-highlight))
250 "Mode-line control for displaying whether current buffer is modified.") 255 "Mode-line control for displaying whether current buffer is modified.")
251 256
252(make-variable-buffer-local 'mode-line-modified) 257(make-variable-buffer-local 'mode-line-modified)
@@ -262,6 +267,7 @@ buffer size, the line number and the column number.")
262 267
263(defvar mode-line-major-mode-keymap 268(defvar mode-line-major-mode-keymap
264 (let ((map (make-sparse-keymap))) 269 (let ((map (make-sparse-keymap)))
270 (define-key map [mode-line down-mouse-1] 'mouse-major-mode-menu)
265 (define-key map [mode-line mouse-2] 'describe-mode) 271 (define-key map [mode-line mouse-2] 'describe-mode)
266 (define-key map [mode-line down-mouse-3] 'mode-line-mode-menu-1) 272 (define-key map [mode-line down-mouse-3] 'mode-line-mode-menu-1)
267 map) "\ 273 map) "\
@@ -303,13 +309,16 @@ Keymap to display on minor modes.")
303 (list 309 (list
304 (propertize "%[(" 'help-echo help-echo) 310 (propertize "%[(" 'help-echo help-echo)
305 `(:propertize ("" mode-name) 311 `(:propertize ("" mode-name)
306 help-echo "mouse-2: help for current major mode" 312 help-echo "mouse-1: major-mode-menu mouse-2: help for current major mode"
313 mouse-face mode-line-highlight
307 local-map ,mode-line-major-mode-keymap) 314 local-map ,mode-line-major-mode-keymap)
308 '("" mode-line-process) 315 '("" mode-line-process)
309 `(:propertize ("" minor-mode-alist) 316 `(:propertize ("" minor-mode-alist)
317 mouse-face mode-line-highlight
310 help-echo "mouse-2: help for minor modes, mouse-3: minor mode menu" 318 help-echo "mouse-2: help for minor modes, mouse-3: minor mode menu"
311 local-map ,mode-line-minor-mode-keymap) 319 local-map ,mode-line-minor-mode-keymap)
312 (propertize "%n" 'help-echo "mouse-2: widen" 320 (propertize "%n" 'help-echo "mouse-2: widen"
321 'mouse-face 'mode-line-highlight
313 'local-map (make-mode-line-mouse-map 322 'local-map (make-mode-line-mouse-map
314 'mouse-2 #'mode-line-widen)) 323 'mouse-2 #'mode-line-widen))
315 (propertize ")%]--" 'help-echo help-echo))) 324 (propertize ")%]--" 'help-echo help-echo)))
@@ -465,6 +474,7 @@ text properties for face, help-echo, and local-map to it."
465 'face 'Buffer-menu-buffer-face 474 'face 'Buffer-menu-buffer-face
466 'help-echo 475 'help-echo
467 (purecopy "mouse-1: previous buffer, mouse-3: next buffer") 476 (purecopy "mouse-1: previous buffer, mouse-3: next buffer")
477 'mouse-face 'mode-line-highlight
468 'local-map mode-line-buffer-identification-keymap))) 478 'local-map mode-line-buffer-identification-keymap)))
469 479
470(setq-default mode-line-buffer-identification 480(setq-default mode-line-buffer-identification
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index a968d14a0a9..7e9115a79dc 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -1,7 +1,7 @@
1;;; buff-menu.el --- buffer menu main function and support functions -*- coding:utf-8 -*- 1;;; buff-menu.el --- buffer menu main function and support functions -*- coding:utf-8 -*-
2 2
3;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 2000, 2001, 2002, 2003, 3;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 2000, 2001, 2002, 2003,
4;; 2004 Free Software Foundation, Inc. 4;; 2004, 2005 Free Software Foundation, Inc.
5 5
6;; Maintainer: FSF 6;; Maintainer: FSF
7;; Keywords: convenience 7;; Keywords: convenience
@@ -190,7 +190,7 @@ Letters do not insert themselves; instead, they are commands.
190 #'(lambda (&optional noconfirm) 'fast)) 190 #'(lambda (&optional noconfirm) 'fast))
191 (setq truncate-lines t) 191 (setq truncate-lines t)
192 (setq buffer-read-only t) 192 (setq buffer-read-only t)
193 (run-hooks 'buffer-menu-mode-hook)) 193 (run-mode-hooks 'buffer-menu-mode-hook))
194 194
195;; This function exists so we can make the doc string of Buffer-menu-mode 195;; This function exists so we can make the doc string of Buffer-menu-mode
196;; look nice. 196;; look nice.
@@ -203,17 +203,21 @@ Letters do not insert themselves; instead, they are commands.
203 (or (eq buffer-undo-list t) 203 (or (eq buffer-undo-list t)
204 (setq buffer-undo-list nil)) 204 (setq buffer-undo-list nil))
205 ;; We can not use save-excursion here. The buffer gets erased. 205 ;; We can not use save-excursion here. The buffer gets erased.
206 (let ((ocol (current-column)) 206 (let ((opoint (point))
207 (eobp (eobp))
208 (ocol (current-column))
207 (oline (progn (move-to-column 4) 209 (oline (progn (move-to-column 4)
208 (get-text-property (point) 'buffer))) 210 (get-text-property (point) 'buffer)))
209 (prop (point-min)) 211 (prop (point-min))
210 ;; do not make undo records for the reversion. 212 ;; do not make undo records for the reversion.
211 (buffer-undo-list t)) 213 (buffer-undo-list t))
212 (list-buffers-noselect Buffer-menu-files-only) 214 (list-buffers-noselect Buffer-menu-files-only)
213 (while (setq prop (next-single-property-change prop 'buffer)) 215 (if oline
214 (when (eq (get-text-property prop 'buffer) oline) 216 (while (setq prop (next-single-property-change prop 'buffer))
215 (goto-char prop) 217 (when (eq (get-text-property prop 'buffer) oline)
216 (move-to-column ocol))))) 218 (goto-char prop)
219 (move-to-column ocol)))
220 (goto-char (if eobp (point-max) opoint)))))
217 221
218(defun Buffer-menu-toggle-files-only (arg) 222(defun Buffer-menu-toggle-files-only (arg)
219 "Toggle whether the current buffer-menu displays only file buffers. 223 "Toggle whether the current buffer-menu displays only file buffers.
@@ -633,15 +637,29 @@ For more information, see the function `buffer-menu'."
633 (if (equal column Buffer-menu-sort-column) (setq column nil)) 637 (if (equal column Buffer-menu-sort-column) (setq column nil))
634 (propertize name 638 (propertize name
635 'help-echo (if column 639 'help-echo (if column
636 (concat "mouse-2: sort by " (downcase name)) 640 (if Buffer-menu-use-header-line
637 "mouse-2: sort by visited order") 641 (concat "mouse-2: sort by " (downcase name))
642 (concat "mouse-2, RET: sort by "
643 (downcase name)))
644 (if Buffer-menu-use-header-line
645 "mouse-2: sort by visited order"
646 "mouse-2, RET: sort by visited order"))
638 'mouse-face 'highlight 647 'mouse-face 'highlight
639 'keymap (let ((map (make-sparse-keymap))) 648 'keymap (let ((map (make-sparse-keymap)))
640 (define-key map [header-line mouse-2] 649 (if Buffer-menu-use-header-line
641 `(lambda (e) 650 (define-key map [header-line mouse-2]
642 (interactive "e") 651 `(lambda (e)
643 (save-window-excursion 652 (interactive "e")
653 (save-window-excursion
654 (if e (mouse-select-window e))
655 (Buffer-menu-sort ,column))))
656 (define-key map [mouse-2]
657 `(lambda (e)
658 (interactive "e")
644 (if e (mouse-select-window e)) 659 (if e (mouse-select-window e))
660 (Buffer-menu-sort ,column)))
661 (define-key map "\C-m"
662 `(lambda () (interactive)
645 (Buffer-menu-sort ,column)))) 663 (Buffer-menu-sort ,column))))
646 map))) 664 map)))
647 665
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el
index 6c694bc5ba8..0983b807fde 100644
--- a/lisp/calc/calc-units.el
+++ b/lisp/calc/calc-units.el
@@ -555,7 +555,7 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).")
555 (save-excursion 555 (save-excursion
556 (goto-char (point-min)) 556 (goto-char (point-min))
557 (if (looking-at "Calculator Units Table") 557 (if (looking-at "Calculator Units Table")
558 (let ((buffer-read-only nil)) 558 (let ((inhibit-read-only t))
559 (insert "(Obsolete) ")))))))) 559 (insert "(Obsolete) "))))))))
560 560
561(defun calc-get-unit-definition (uname) 561(defun calc-get-unit-definition (uname)
@@ -1310,65 +1310,65 @@ Entries are (SYMBOL EXPR DOC-STRING TEMP-TYPE BASE-UNITS).")
1310 (save-excursion 1310 (save-excursion
1311 (message "Formatting units table...") 1311 (message "Formatting units table...")
1312 (set-buffer buf) 1312 (set-buffer buf)
1313 (setq buffer-read-only nil) 1313 (let ((inhibit-read-only t))
1314 (erase-buffer) 1314 (erase-buffer)
1315 (insert "Calculator Units Table:\n\n") 1315 (insert "Calculator Units Table:\n\n")
1316 (insert "Unit Type Definition Description\n\n") 1316 (insert "Unit Type Definition Description\n\n")
1317 (while uptr 1317 (while uptr
1318 (setq u (car uptr) 1318 (setq u (car uptr)
1319 name (nth 2 u)) 1319 name (nth 2 u))
1320 (when (eq (car u) 'm) 1320 (when (eq (car u) 'm)
1321 (setq std t)) 1321 (setq std t))
1322 (setq shadowed (and std (assq (car u) math-additional-units))) 1322 (setq shadowed (and std (assq (car u) math-additional-units)))
1323 (when (and name 1323 (when (and name
1324 (> (length name) 1) 1324 (> (length name) 1)
1325 (eq (aref name 0) ?\*)) 1325 (eq (aref name 0) ?\*))
1326 (unless (eq uptr math-units-table) 1326 (unless (eq uptr math-units-table)
1327 (insert "\n")) 1327 (insert "\n"))
1328 (setq name (substring name 1))) 1328 (setq name (substring name 1)))
1329 (insert " ") 1329 (insert " ")
1330 (and shadowed (insert "(")) 1330 (and shadowed (insert "("))
1331 (insert (symbol-name (car u))) 1331 (insert (symbol-name (car u)))
1332 (and shadowed (insert ")")) 1332 (and shadowed (insert ")"))
1333 (if (nth 3 u) 1333 (if (nth 3 u)
1334 (progn 1334 (progn
1335 (indent-to 10) 1335 (indent-to 10)
1336 (insert (symbol-name (nth 3 u)))) 1336 (insert (symbol-name (nth 3 u))))
1337 (or std 1337 (or std
1338 (progn 1338 (progn
1339 (indent-to 10) 1339 (indent-to 10)
1340 (insert "U")))) 1340 (insert "U"))))
1341 (indent-to 14) 1341 (indent-to 14)
1342 (and shadowed (insert "(")) 1342 (and shadowed (insert "("))
1343 (if (nth 1 u) 1343 (if (nth 1 u)
1344 (insert (math-format-value (nth 1 u) 80)) 1344 (insert (math-format-value (nth 1 u) 80))
1345 (insert (symbol-name (car u)))) 1345 (insert (symbol-name (car u))))
1346 (and shadowed (insert ")")) 1346 (and shadowed (insert ")"))
1347 (indent-to 41) 1347 (indent-to 41)
1348 (insert " ") 1348 (insert " ")
1349 (when name 1349 (when name
1350 (insert name)) 1350 (insert name))
1351 (if shadowed 1351 (if shadowed
1352 (insert " (redefined above)") 1352 (insert " (redefined above)")
1353 (unless (nth 1 u) 1353 (unless (nth 1 u)
1354 (insert " (base unit)"))) 1354 (insert " (base unit)")))
1355 (insert "\n") 1355 (insert "\n")
1356 (setq uptr (cdr uptr))) 1356 (setq uptr (cdr uptr)))
1357 (insert "\n\nUnit Prefix Table:\n\n") 1357 (insert "\n\nUnit Prefix Table:\n\n")
1358 (setq uptr math-unit-prefixes) 1358 (setq uptr math-unit-prefixes)
1359 (while uptr 1359 (while uptr
1360 (setq u (car uptr)) 1360 (setq u (car uptr))
1361 (insert " " (char-to-string (car u))) 1361 (insert " " (char-to-string (car u)))
1362 (if (equal (nth 1 u) (nth 1 (nth 1 uptr))) 1362 (if (equal (nth 1 u) (nth 1 (nth 1 uptr)))
1363 (insert " " (char-to-string (car (car (setq uptr (cdr uptr))))) 1363 (insert " " (char-to-string (car (car (setq uptr (cdr uptr)))))
1364 " ") 1364 " ")
1365 (insert " ")) 1365 (insert " "))
1366 (insert "10^" (int-to-string (nth 2 (nth 1 u)))) 1366 (insert "10^" (int-to-string (nth 2 (nth 1 u))))
1367 (indent-to 15) 1367 (indent-to 15)
1368 (insert " " (nth 2 u) "\n") 1368 (insert " " (nth 2 u) "\n")
1369 (while (eq (car (car (setq uptr (cdr uptr)))) 0))) 1369 (while (eq (car (car (setq uptr (cdr uptr)))) 0)))
1370 (insert "\n") 1370 (insert "\n"))
1371 (setq buffer-read-only t) 1371 (view-mode)
1372 (message "Formatting units table...done")) 1372 (message "Formatting units table...done"))
1373 (setq math-units-table-buffer-valid t) 1373 (setq math-units-table-buffer-valid t)
1374 (let ((oldbuf (current-buffer))) 1374 (let ((oldbuf (current-buffer)))
diff --git a/lisp/calendar/cal-menu.el b/lisp/calendar/cal-menu.el
index 408de3826d4..6ace81fcb0e 100644
--- a/lisp/calendar/cal-menu.el
+++ b/lisp/calendar/cal-menu.el
@@ -221,7 +221,7 @@ not available."
221 l))) 221 l)))
222 (setq l (cons ["Mark Holidays" mark-calendar-holidays t] 222 (setq l (cons ["Mark Holidays" mark-calendar-holidays t]
223 (cons ["Unmark Calendar" calendar-unmark t] 223 (cons ["Unmark Calendar" calendar-unmark t]
224 (cons ["--" '("--") t] l)))) 224 (cons "--" l))))
225 (define-key calendar-mode-map [menu-bar Holidays] 225 (define-key calendar-mode-map [menu-bar Holidays]
226 (cons "Holidays" (easy-menu-create-menu "Holidays" (nreverse l)))) 226 (cons "Holidays" (easy-menu-create-menu "Holidays" (nreverse l))))
227 (define-key calendar-mode-map [menu-bar Holidays separator] 227 (define-key calendar-mode-map [menu-bar Holidays separator]
diff --git a/lisp/diff-mode.el b/lisp/diff-mode.el
index c16738f6570..aabd09e98ee 100644
--- a/lisp/diff-mode.el
+++ b/lisp/diff-mode.el
@@ -185,7 +185,8 @@ when editing big diffs)."
185 (((class color) (background dark)) 185 (((class color) (background dark))
186 :foreground "green" :weight bold) 186 :foreground "green" :weight bold)
187 (t :weight bold)) 187 (t :weight bold))
188 "`diff-mode' face inherited by hunk and index header faces.") 188 "`diff-mode' face inherited by hunk and index header faces."
189 :group 'diff-mode)
189(defvar diff-header-face 'diff-header-face) 190(defvar diff-header-face 'diff-header-face)
190 191
191(defface diff-file-header-face 192(defface diff-file-header-face
@@ -198,27 +199,32 @@ when editing big diffs)."
198 (((class color) (background dark)) 199 (((class color) (background dark))
199 :foreground "cyan" :weight bold) 200 :foreground "cyan" :weight bold)
200 (t :weight bold)) ; :height 1.3 201 (t :weight bold)) ; :height 1.3
201 "`diff-mode' face used to highlight file header lines.") 202 "`diff-mode' face used to highlight file header lines."
203 :group 'diff-mode)
202(defvar diff-file-header-face 'diff-file-header-face) 204(defvar diff-file-header-face 'diff-file-header-face)
203 205
204(defface diff-index-face 206(defface diff-index-face
205 '((t :inherit diff-file-header-face)) 207 '((t :inherit diff-file-header-face))
206 "`diff-mode' face used to highlight index header lines.") 208 "`diff-mode' face used to highlight index header lines."
209 :group 'diff-mode)
207(defvar diff-index-face 'diff-index-face) 210(defvar diff-index-face 'diff-index-face)
208 211
209(defface diff-hunk-header-face 212(defface diff-hunk-header-face
210 '((t :inherit diff-header-face)) 213 '((t :inherit diff-header-face))
211 "`diff-mode' face used to highlight hunk header lines.") 214 "`diff-mode' face used to highlight hunk header lines."
215 :group 'diff-mode)
212(defvar diff-hunk-header-face 'diff-hunk-header-face) 216(defvar diff-hunk-header-face 'diff-hunk-header-face)
213 217
214(defface diff-removed-face 218(defface diff-removed-face
215 '((t :inherit diff-changed-face)) 219 '((t :inherit diff-changed-face))
216 "`diff-mode' face used to highlight removed lines.") 220 "`diff-mode' face used to highlight removed lines."
221 :group 'diff-mode)
217(defvar diff-removed-face 'diff-removed-face) 222(defvar diff-removed-face 'diff-removed-face)
218 223
219(defface diff-added-face 224(defface diff-added-face
220 '((t :inherit diff-changed-face)) 225 '((t :inherit diff-changed-face))
221 "`diff-mode' face used to highlight added lines.") 226 "`diff-mode' face used to highlight added lines."
227 :group 'diff-mode)
222(defvar diff-added-face 'diff-added-face) 228(defvar diff-added-face 'diff-added-face)
223 229
224(defface diff-changed-face 230(defface diff-changed-face
@@ -226,12 +232,14 @@ when editing big diffs)."
226 :foreground "magenta" :weight bold :slant italic) 232 :foreground "magenta" :weight bold :slant italic)
227 (((type tty pc) (class color) (background dark)) 233 (((type tty pc) (class color) (background dark))
228 :foreground "yellow" :weight bold :slant italic)) 234 :foreground "yellow" :weight bold :slant italic))
229 "`diff-mode' face used to highlight changed lines.") 235 "`diff-mode' face used to highlight changed lines."
236 :group 'diff-mode)
230(defvar diff-changed-face 'diff-changed-face) 237(defvar diff-changed-face 'diff-changed-face)
231 238
232(defface diff-function-face 239(defface diff-function-face
233 '((t :inherit diff-context-face)) 240 '((t :inherit diff-context-face))
234 "`diff-mode' face used to highlight function names produced by \"diff -p\".") 241 "`diff-mode' face used to highlight function names produced by \"diff -p\"."
242 :group 'diff-mode)
235(defvar diff-function-face 'diff-function-face) 243(defvar diff-function-face 'diff-function-face)
236 244
237(defface diff-context-face 245(defface diff-context-face
@@ -239,12 +247,14 @@ when editing big diffs)."
239 :foreground "grey50") 247 :foreground "grey50")
240 (((class color) (background dark)) 248 (((class color) (background dark))
241 :foreground "grey70")) 249 :foreground "grey70"))
242 "`diff-mode' face used to highlight context and other side-information.") 250 "`diff-mode' face used to highlight context and other side-information."
251 :group 'diff-mode)
243(defvar diff-context-face 'diff-context-face) 252(defvar diff-context-face 'diff-context-face)
244 253
245(defface diff-nonexistent-face 254(defface diff-nonexistent-face
246 '((t :inherit diff-file-header-face)) 255 '((t :inherit diff-file-header-face))
247 "`diff-mode' face used to highlight nonexistent files in recursive diffs.") 256 "`diff-mode' face used to highlight nonexistent files in recursive diffs."
257 :group 'diff-mode)
248(defvar diff-nonexistent-face 'diff-nonexistent-face) 258(defvar diff-nonexistent-face 'diff-nonexistent-face)
249 259
250(defconst diff-yank-handler '(diff-yank-function)) 260(defconst diff-yank-handler '(diff-yank-function))
diff --git a/lisp/dired.el b/lisp/dired.el
index 43f05dcf881..b0d86297e71 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -418,7 +418,24 @@ Subexpression 2 must end right before the \\n or \\r.")
418 ;; It is quicker to first find just an extension, then go back to the 418 ;; It is quicker to first find just an extension, then go back to the
419 ;; start of that file name. So we do this complex MATCH-ANCHORED form. 419 ;; start of that file name. So we do this complex MATCH-ANCHORED form.
420 (list (concat "\\(" (regexp-opt completion-ignored-extensions) "\\|#\\)$") 420 (list (concat "\\(" (regexp-opt completion-ignored-extensions) "\\|#\\)$")
421 '(".+" (dired-move-to-filename) nil (0 dired-ignored-face))))) 421 '(".+" (dired-move-to-filename) nil (0 dired-ignored-face))))
422 ;;
423 ;; Files suffixed with `completion-ignored-extensions'
424 ;; plus a character put in by -F.
425 '(eval .
426 (list (concat "\\(" (regexp-opt completion-ignored-extensions)
427 "\\|#\\)[*=|]$")
428 '(".+" (progn
429 (end-of-line)
430 ;; If the last character is not part of the filename,
431 ;; move back to the start of the filename
432 ;; so it can be fontified.
433 ;; Otherwise, leave point at the end of the line;
434 ;; that way, nothing is fontified.
435 (unless (get-text-property (1- (point)) 'mouse-face)
436 (dired-move-to-filename)))
437 nil (0 dired-ignored-face))))
438)
422 "Additional expressions to highlight in Dired mode.") 439 "Additional expressions to highlight in Dired mode.")
423 440
424;;; Macros must be defined before they are used, for the byte compiler. 441;;; Macros must be defined before they are used, for the byte compiler.
@@ -3163,10 +3180,8 @@ Anything else means ask for each directory."
3163 :group 'dired) 3180 :group 'dired)
3164 3181
3165(defun dired-dnd-popup-notice () 3182(defun dired-dnd-popup-notice ()
3166 (x-popup-dialog 3183 (message-box
3167 t 3184 "Recursive copies not enabled.\nSee variable dired-recursive-copies."))
3168 '("Recursive copies not enabled.\nSee variable dired-recursive-copies."
3169 ("Ok" . nil))))
3170 3185
3171 3186
3172(defun dired-dnd-do-ask-action (uri) 3187(defun dired-dnd-do-ask-action (uri)
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index f1798d941bf..aab4efab9f8 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -4057,27 +4057,6 @@ For example, invoke `emacs -batch -f batch-byte-recompile-directory .'."
4057 (setq command-line-args-left (cdr command-line-args-left))) 4057 (setq command-line-args-left (cdr command-line-args-left)))
4058 (kill-emacs 0)) 4058 (kill-emacs 0))
4059 4059
4060
4061(make-obsolete-variable 'auto-fill-hook 'auto-fill-function "before 19.15")
4062(make-obsolete-variable 'blink-paren-hook 'blink-paren-function "before 19.15")
4063(make-obsolete-variable 'lisp-indent-hook 'lisp-indent-function "before 19.15")
4064(make-obsolete-variable 'inhibit-local-variables
4065 "use enable-local-variables (with the reversed sense)."
4066 "before 19.15")
4067(make-obsolete-variable 'unread-command-event
4068 "use unread-command-events; which is a list of events rather than a single event."
4069 "before 19.15")
4070(make-obsolete-variable 'suspend-hooks 'suspend-hook "before 19.15")
4071(make-obsolete-variable 'comment-indent-hook 'comment-indent-function "before 19.15")
4072(make-obsolete-variable 'meta-flag "use the set-input-mode function instead." "before 19.34")
4073(make-obsolete-variable 'before-change-function
4074 "use before-change-functions; which is a list of functions rather than a single function."
4075 "before 19.34")
4076(make-obsolete-variable 'after-change-function
4077 "use after-change-functions; which is a list of functions rather than a single function."
4078 "before 19.34")
4079(make-obsolete-variable 'font-lock-doc-string-face 'font-lock-string-face "before 19.34")
4080
4081(provide 'byte-compile) 4060(provide 'byte-compile)
4082(provide 'bytecomp) 4061(provide 'bytecomp)
4083 4062
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 727e45b1289..4efa87d5937 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -46,7 +46,8 @@
46 46
47(defun coerce (x type) 47(defun coerce (x type)
48 "Coerce OBJECT to type TYPE. 48 "Coerce OBJECT to type TYPE.
49TYPE is a Common Lisp type specifier." 49TYPE is a Common Lisp type specifier.
50\n(fn OBJECT TYPE)"
50 (cond ((eq type 'list) (if (listp x) x (append x nil))) 51 (cond ((eq type 'list) (if (listp x) x (append x nil)))
51 ((eq type 'vector) (if (vectorp x) x (vconcat x))) 52 ((eq type 'vector) (if (vectorp x) x (vconcat x)))
52 ((eq type 'string) (if (stringp x) x (concat x))) 53 ((eq type 'string) (if (stringp x) x (concat x)))
@@ -120,16 +121,17 @@ strings case-insensitively."
120 (nreverse cl-res)))) 121 (nreverse cl-res))))
121 122
122(defun map (cl-type cl-func cl-seq &rest cl-rest) 123(defun map (cl-type cl-func cl-seq &rest cl-rest)
123 "Map a function across one or more sequences, returning a sequence. 124 "Map a FUNCTION across one or more SEQUENCEs, returning a sequence.
124TYPE is the sequence type to return, FUNC is the function, and SEQS 125TYPE is the sequence type to return.
125are the argument sequences." 126\n(fn TYPE FUNCTION SEQUENCE...)"
126 (let ((cl-res (apply 'mapcar* cl-func cl-seq cl-rest))) 127 (let ((cl-res (apply 'mapcar* cl-func cl-seq cl-rest)))
127 (and cl-type (coerce cl-res cl-type)))) 128 (and cl-type (coerce cl-res cl-type))))
128 129
129(defun maplist (cl-func cl-list &rest cl-rest) 130(defun maplist (cl-func cl-list &rest cl-rest)
130 "Map FUNC to each sublist of LIST or LISTS. 131 "Map FUNCTION to each sublist of LIST or LISTs.
131Like `mapcar', except applies to lists and their cdr's rather than to 132Like `mapcar', except applies to lists and their cdr's rather than to
132the elements themselves." 133the elements themselves.
134\n(fn FUNCTION LIST...)"
133 (if cl-rest 135 (if cl-rest
134 (let ((cl-res nil) 136 (let ((cl-res nil)
135 (cl-args (cons cl-list (copy-sequence cl-rest))) 137 (cl-args (cons cl-list (copy-sequence cl-rest)))
@@ -146,14 +148,16 @@ the elements themselves."
146 (nreverse cl-res)))) 148 (nreverse cl-res))))
147 149
148(defun cl-mapc (cl-func cl-seq &rest cl-rest) 150(defun cl-mapc (cl-func cl-seq &rest cl-rest)
149 "Like `mapcar', but does not accumulate values returned by the function." 151 "Like `mapcar', but does not accumulate values returned by the function.
152\n(fn FUNCTION SEQUENCE...)"
150 (if cl-rest 153 (if cl-rest
151 (progn (apply 'map nil cl-func cl-seq cl-rest) 154 (progn (apply 'map nil cl-func cl-seq cl-rest)
152 cl-seq) 155 cl-seq)
153 (mapc cl-func cl-seq))) 156 (mapc cl-func cl-seq)))
154 157
155(defun mapl (cl-func cl-list &rest cl-rest) 158(defun mapl (cl-func cl-list &rest cl-rest)
156 "Like `maplist', but does not accumulate values returned by the function." 159 "Like `maplist', but does not accumulate values returned by the function.
160\n(fn FUNCTION LIST...)"
157 (if cl-rest 161 (if cl-rest
158 (apply 'maplist cl-func cl-list cl-rest) 162 (apply 'maplist cl-func cl-list cl-rest)
159 (let ((cl-p cl-list)) 163 (let ((cl-p cl-list))
@@ -161,16 +165,19 @@ the elements themselves."
161 cl-list) 165 cl-list)
162 166
163(defun mapcan (cl-func cl-seq &rest cl-rest) 167(defun mapcan (cl-func cl-seq &rest cl-rest)
164 "Like `mapcar', but nconc's together the values returned by the function." 168 "Like `mapcar', but nconc's together the values returned by the function.
169\n(fn FUNCTION SEQUENCE...)"
165 (apply 'nconc (apply 'mapcar* cl-func cl-seq cl-rest))) 170 (apply 'nconc (apply 'mapcar* cl-func cl-seq cl-rest)))
166 171
167(defun mapcon (cl-func cl-list &rest cl-rest) 172(defun mapcon (cl-func cl-list &rest cl-rest)
168 "Like `maplist', but nconc's together the values returned by the function." 173 "Like `maplist', but nconc's together the values returned by the function.
174\n(fn FUNCTION LIST...)"
169 (apply 'nconc (apply 'maplist cl-func cl-list cl-rest))) 175 (apply 'nconc (apply 'maplist cl-func cl-list cl-rest)))
170 176
171(defun some (cl-pred cl-seq &rest cl-rest) 177(defun some (cl-pred cl-seq &rest cl-rest)
172 "Return true if PREDICATE is true of any element of SEQ or SEQs. 178 "Return true if PREDICATE is true of any element of SEQ or SEQs.
173If so, return the true (non-nil) value returned by PREDICATE." 179If so, return the true (non-nil) value returned by PREDICATE.
180\n(fn PREDICATE SEQ...)"
174 (if (or cl-rest (nlistp cl-seq)) 181 (if (or cl-rest (nlistp cl-seq))
175 (catch 'cl-some 182 (catch 'cl-some
176 (apply 'map nil 183 (apply 'map nil
@@ -183,7 +190,8 @@ If so, return the true (non-nil) value returned by PREDICATE."
183 cl-x))) 190 cl-x)))
184 191
185(defun every (cl-pred cl-seq &rest cl-rest) 192(defun every (cl-pred cl-seq &rest cl-rest)
186 "Return true if PREDICATE is true of every element of SEQ or SEQs." 193 "Return true if PREDICATE is true of every element of SEQ or SEQs.
194\n(fn PREDICATE SEQ...)"
187 (if (or cl-rest (nlistp cl-seq)) 195 (if (or cl-rest (nlistp cl-seq))
188 (catch 'cl-every 196 (catch 'cl-every
189 (apply 'map nil 197 (apply 'map nil
@@ -195,11 +203,13 @@ If so, return the true (non-nil) value returned by PREDICATE."
195 (null cl-seq))) 203 (null cl-seq)))
196 204
197(defun notany (cl-pred cl-seq &rest cl-rest) 205(defun notany (cl-pred cl-seq &rest cl-rest)
198 "Return true if PREDICATE is false of every element of SEQ or SEQs." 206 "Return true if PREDICATE is false of every element of SEQ or SEQs.
207\n(fn PREDICATE SEQ...)"
199 (not (apply 'some cl-pred cl-seq cl-rest))) 208 (not (apply 'some cl-pred cl-seq cl-rest)))
200 209
201(defun notevery (cl-pred cl-seq &rest cl-rest) 210(defun notevery (cl-pred cl-seq &rest cl-rest)
202 "Return true if PREDICATE is false of some element of SEQ or SEQs." 211 "Return true if PREDICATE is false of some element of SEQ or SEQs.
212\n(fn PREDICATE SEQ...)"
203 (not (apply 'every cl-pred cl-seq cl-rest))) 213 (not (apply 'every cl-pred cl-seq cl-rest)))
204 214
205;;; Support for `loop'. 215;;; Support for `loop'.
@@ -332,16 +342,16 @@ If so, return the true (non-nil) value returned by PREDICATE."
332 (setq a (* (/ a (gcd a b)) b)))) 342 (setq a (* (/ a (gcd a b)) b))))
333 a))) 343 a)))
334 344
335(defun isqrt (a) 345(defun isqrt (x)
336 "Return the integer square root of the argument." 346 "Return the integer square root of the argument."
337 (if (and (integerp a) (> a 0)) 347 (if (and (integerp x) (> x 0))
338 (let ((g (cond ((<= a 100) 10) ((<= a 10000) 100) 348 (let ((g (cond ((<= x 100) 10) ((<= x 10000) 100)
339 ((<= a 1000000) 1000) (t a))) 349 ((<= x 1000000) 1000) (t x)))
340 g2) 350 g2)
341 (while (< (setq g2 (/ (+ g (/ a g)) 2)) g) 351 (while (< (setq g2 (/ (+ g (/ x g)) 2)) g)
342 (setq g g2)) 352 (setq g g2))
343 g) 353 g)
344 (if (eq a 0) 0 (signal 'arith-error nil)))) 354 (if (eq x 0) 0 (signal 'arith-error nil))))
345 355
346(defun floor* (x &optional y) 356(defun floor* (x &optional y)
347 "Return a list of the floor of X and the fractional part of X. 357 "Return a list of the floor of X and the fractional part of X.
@@ -388,9 +398,9 @@ With two arguments, return rounding and remainder of their quotient."
388 "The remainder of X divided by Y, with the same sign as X." 398 "The remainder of X divided by Y, with the same sign as X."
389 (nth 1 (truncate* x y))) 399 (nth 1 (truncate* x y)))
390 400
391(defun signum (a) 401(defun signum (x)
392 "Return 1 if A is positive, -1 if negative, 0 if zero." 402 "Return 1 if X is positive, -1 if negative, 0 if zero."
393 (cond ((> a 0) 1) ((< a 0) -1) (t 0))) 403 (cond ((> x 0) 1) ((< x 0) -1) (t 0)))
394 404
395 405
396;; Random numbers. 406;; Random numbers.
@@ -514,7 +524,8 @@ If START or END is negative, it counts from the end."
514 res)))))) 524 res))))))
515 525
516(defun concatenate (type &rest seqs) 526(defun concatenate (type &rest seqs)
517 "Concatenate, into a sequence of type TYPE, the argument SEQUENCES." 527 "Concatenate, into a sequence of type TYPE, the argument SEQUENCEs.
528\n(fn TYPE SEQUENCE...)"
518 (cond ((eq type 'vector) (apply 'vconcat seqs)) 529 (cond ((eq type 'vector) (apply 'vconcat seqs))
519 ((eq type 'string) (apply 'concat seqs)) 530 ((eq type 'string) (apply 'concat seqs))
520 ((eq type 'list) (apply 'append (append seqs '(nil)))) 531 ((eq type 'list) (apply 'append (append seqs '(nil))))
@@ -532,7 +543,7 @@ If START or END is negative, it counts from the end."
532 (nconc (nreverse x) y)) 543 (nconc (nreverse x) y))
533 544
534(defun list-length (x) 545(defun list-length (x)
535 "Return the length of a list. Return nil if list is circular." 546 "Return the length of list X. Return nil if list is circular."
536 (let ((n 0) (fast x) (slow x)) 547 (let ((n 0) (fast x) (slow x))
537 (while (and (cdr fast) (not (and (eq fast slow) (> n 0)))) 548 (while (and (cdr fast) (not (and (eq fast slow) (> n 0))))
538 (setq n (+ n 2) fast (cdr (cdr fast)) slow (cdr slow))) 549 (setq n (+ n 2) fast (cdr (cdr fast)) slow (cdr slow)))
@@ -550,7 +561,8 @@ If START or END is negative, it counts from the end."
550;;; Property lists. 561;;; Property lists.
551 562
552(defun get* (sym tag &optional def) ; See compiler macro in cl-macs.el 563(defun get* (sym tag &optional def) ; See compiler macro in cl-macs.el
553 "Return the value of SYMBOL's PROPNAME property, or DEFAULT if none." 564 "Return the value of SYMBOL's PROPNAME property, or DEFAULT if none.
565\n(fn SYMBOL PROPNAME &optional DEFAULT)"
554 (or (get sym tag) 566 (or (get sym tag)
555 (and def 567 (and def
556 (let ((plist (symbol-plist sym))) 568 (let ((plist (symbol-plist sym)))
@@ -560,7 +572,8 @@ If START or END is negative, it counts from the end."
560 572
561(defun getf (plist tag &optional def) 573(defun getf (plist tag &optional def)
562 "Search PROPLIST for property PROPNAME; return its value or DEFAULT. 574 "Search PROPLIST for property PROPNAME; return its value or DEFAULT.
563PROPLIST is a list of the sort returned by `symbol-plist'." 575PROPLIST is a list of the sort returned by `symbol-plist'.
576\n(fn PROPLIST PROPNAME &optional DEFAULT)"
564 (setplist '--cl-getf-symbol-- plist) 577 (setplist '--cl-getf-symbol-- plist)
565 (or (get '--cl-getf-symbol-- tag) 578 (or (get '--cl-getf-symbol-- tag)
566 ;; Originally we called get* here, 579 ;; Originally we called get* here,
@@ -582,7 +595,8 @@ PROPLIST is a list of the sort returned by `symbol-plist'."
582 (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t)))) 595 (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t))))
583 596
584(defun cl-remprop (sym tag) 597(defun cl-remprop (sym tag)
585 "Remove from SYMBOL's plist the property PROP and its value." 598 "Remove from SYMBOL's plist the property PROPNAME and its value.
599\n(fn SYMBOL PROPNAME)"
586 (let ((plist (symbol-plist sym))) 600 (let ((plist (symbol-plist sym)))
587 (if (and plist (eq tag (car plist))) 601 (if (and plist (eq tag (car plist)))
588 (progn (setplist sym (cdr (cdr plist))) t) 602 (progn (setplist sym (cdr (cdr plist))) t)
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 8bc195bdae8..1be2f9171a6 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -207,8 +207,8 @@ and BODY is implicitly surrounded by (block NAME ...).
207 207
208(defmacro function* (func) 208(defmacro function* (func)
209 "Introduce a function. 209 "Introduce a function.
210Like normal `function', except that if argument is a lambda form, its 210Like normal `function', except that if argument is a lambda form,
211ARGLIST allows full Common Lisp conventions." 211its argument list allows full Common Lisp conventions."
212 (if (eq (car-safe func) 'lambda) 212 (if (eq (car-safe func) 'lambda)
213 (let* ((res (cl-transform-lambda (cdr func) 'cl-none)) 213 (let* ((res (cl-transform-lambda (cdr func) 'cl-none))
214 (form (list 'function (cons 'lambda (cdr res))))) 214 (form (list 'function (cons 'lambda (cdr res)))))
@@ -488,13 +488,14 @@ The result of the body appears to the compiler as a quoted constant."
488;;; Conditional control structures. 488;;; Conditional control structures.
489 489
490(defmacro case (expr &rest clauses) 490(defmacro case (expr &rest clauses)
491 "Eval EXPR and choose from CLAUSES on that value. 491 "Eval EXPR and choose among clauses on that value.
492Each clause looks like (KEYLIST BODY...). EXPR is evaluated and compared 492Each clause looks like (KEYLIST BODY...). EXPR is evaluated and compared
493against each key in each KEYLIST; the corresponding BODY is evaluated. 493against each key in each KEYLIST; the corresponding BODY is evaluated.
494If no clause succeeds, case returns nil. A single atom may be used in 494If no clause succeeds, case returns nil. A single atom may be used in
495place of a KEYLIST of one atom. A KEYLIST of t or `otherwise' is 495place of a KEYLIST of one atom. A KEYLIST of t or `otherwise' is
496allowed only in the final clause, and matches if no other keys match. 496allowed only in the final clause, and matches if no other keys match.
497Key values are compared by `eql'." 497Key values are compared by `eql'.
498\n(fn EXPR (KEYLIST BODY...)...)"
498 (let* ((temp (if (cl-simple-expr-p expr 3) expr (make-symbol "--cl-var--"))) 499 (let* ((temp (if (cl-simple-expr-p expr 3) expr (make-symbol "--cl-var--")))
499 (head-list nil) 500 (head-list nil)
500 (body (cons 501 (body (cons
@@ -522,15 +523,17 @@ Key values are compared by `eql'."
522 523
523(defmacro ecase (expr &rest clauses) 524(defmacro ecase (expr &rest clauses)
524 "Like `case', but error if no case fits. 525 "Like `case', but error if no case fits.
525`otherwise'-clauses are not allowed." 526`otherwise'-clauses are not allowed.
527\n(fn EXPR (KEYLIST BODY...)...)"
526 (list* 'case expr (append clauses '((ecase-error-flag))))) 528 (list* 'case expr (append clauses '((ecase-error-flag)))))
527 529
528(defmacro typecase (expr &rest clauses) 530(defmacro typecase (expr &rest clauses)
529 "Evals EXPR, chooses from CLAUSES on that value. 531 "Evals EXPR, chooses among clauses on that value.
530Each clause looks like (TYPE BODY...). EXPR is evaluated and, if it 532Each clause looks like (TYPE BODY...). EXPR is evaluated and, if it
531satisfies TYPE, the corresponding BODY is evaluated. If no clause succeeds, 533satisfies TYPE, the corresponding BODY is evaluated. If no clause succeeds,
532typecase returns nil. A TYPE of t or `otherwise' is allowed only in the 534typecase returns nil. A TYPE of t or `otherwise' is allowed only in the
533final clause, and matches if no other keys match." 535final clause, and matches if no other keys match.
536\n(fn EXPR (TYPE BODY...)...)"
534 (let* ((temp (if (cl-simple-expr-p expr 3) expr (make-symbol "--cl-var--"))) 537 (let* ((temp (if (cl-simple-expr-p expr 3) expr (make-symbol "--cl-var--")))
535 (type-list nil) 538 (type-list nil)
536 (body (cons 539 (body (cons
@@ -552,7 +555,8 @@ final clause, and matches if no other keys match."
552 555
553(defmacro etypecase (expr &rest clauses) 556(defmacro etypecase (expr &rest clauses)
554 "Like `typecase', but error if no case fits. 557 "Like `typecase', but error if no case fits.
555`otherwise'-clauses are not allowed." 558`otherwise'-clauses are not allowed.
559\n(fn EXPR (TYPE BODY...)...)"
556 (list* 'typecase expr (append clauses '((ecase-error-flag))))) 560 (list* 'typecase expr (append clauses '((ecase-error-flag)))))
557 561
558 562
@@ -1273,7 +1277,7 @@ before assigning any symbols SYM to the corresponding values.
1273(defmacro progv (symbols values &rest body) 1277(defmacro progv (symbols values &rest body)
1274 "Bind SYMBOLS to VALUES dynamically in BODY. 1278 "Bind SYMBOLS to VALUES dynamically in BODY.
1275The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists. 1279The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists.
1276Each SYMBOL in the first list is bound to the corresponding VALUE in the 1280Each symbol in the first list is bound to the corresponding value in the
1277second list (or made unbound if VALUES is shorter than SYMBOLS); then the 1281second list (or made unbound if VALUES is shorter than SYMBOLS); then the
1278BODY forms are executed and their result is returned. This is much like 1282BODY forms are executed and their result is returned. This is much like
1279a `let' form, except that the list of symbols can be computed at run-time." 1283a `let' form, except that the list of symbols can be computed at run-time."
@@ -1284,7 +1288,7 @@ a `let' form, except that the list of symbols can be computed at run-time."
1284 1288
1285;;; This should really have some way to shadow 'byte-compile properties, etc. 1289;;; This should really have some way to shadow 'byte-compile properties, etc.
1286(defmacro flet (bindings &rest body) 1290(defmacro flet (bindings &rest body)
1287 "Make temporary function defns. 1291 "Make temporary function definitions.
1288This is an analogue of `let' that operates on the function cell of FUNC 1292This is an analogue of `let' that operates on the function cell of FUNC
1289rather than its value cell. The FORMs are evaluated with the specified 1293rather than its value cell. The FORMs are evaluated with the specified
1290function definitions in place, then the definitions are undone (the FUNCs 1294function definitions in place, then the definitions are undone (the FUNCs
@@ -1311,7 +1315,7 @@ go back to their previous definitions, or lack thereof).
1311 body)) 1315 body))
1312 1316
1313(defmacro labels (bindings &rest body) 1317(defmacro labels (bindings &rest body)
1314 "Make temporary func bindings. 1318 "Make temporary function bindings.
1315This is like `flet', except the bindings are lexical instead of dynamic. 1319This is like `flet', except the bindings are lexical instead of dynamic.
1316Unlike `flet', this macro is fully compliant with the Common Lisp standard. 1320Unlike `flet', this macro is fully compliant with the Common Lisp standard.
1317 1321
@@ -1369,7 +1373,8 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...).
1369(defmacro lexical-let (bindings &rest body) 1373(defmacro lexical-let (bindings &rest body)
1370 "Like `let', but lexically scoped. 1374 "Like `let', but lexically scoped.
1371The main visible difference is that lambdas inside BODY will create 1375The main visible difference is that lambdas inside BODY will create
1372lexical closures as in Common Lisp." 1376lexical closures as in Common Lisp.
1377\n(fn VARLIST BODY)"
1373 (let* ((cl-closure-vars cl-closure-vars) 1378 (let* ((cl-closure-vars cl-closure-vars)
1374 (vars (mapcar (function 1379 (vars (mapcar (function
1375 (lambda (x) 1380 (lambda (x)
@@ -1411,7 +1416,8 @@ lexical closures as in Common Lisp."
1411(defmacro lexical-let* (bindings &rest body) 1416(defmacro lexical-let* (bindings &rest body)
1412 "Like `let*', but lexically scoped. 1417 "Like `let*', but lexically scoped.
1413The main visible difference is that lambdas inside BODY will create 1418The main visible difference is that lambdas inside BODY will create
1414lexical closures as in Common Lisp." 1419lexical closures as in Common Lisp.
1420\n(fn VARLIST BODY)"
1415 (if (null bindings) (cons 'progn body) 1421 (if (null bindings) (cons 'progn body)
1416 (setq bindings (reverse bindings)) 1422 (setq bindings (reverse bindings))
1417 (while bindings 1423 (while bindings
@@ -1435,7 +1441,7 @@ is analogous to the Common Lisp `multiple-value-bind' macro, using lists to
1435simulate true multiple return values. For compatibility, (values A B C) is 1441simulate true multiple return values. For compatibility, (values A B C) is
1436a synonym for (list A B C). 1442a synonym for (list A B C).
1437 1443
1438\(fn (SYM SYM...) FORM BODY)" 1444\(fn (SYM...) FORM BODY)"
1439 (let ((temp (make-symbol "--cl-var--")) (n -1)) 1445 (let ((temp (make-symbol "--cl-var--")) (n -1))
1440 (list* 'let* (cons (list temp form) 1446 (list* 'let* (cons (list temp form)
1441 (mapcar (function 1447 (mapcar (function
@@ -1451,7 +1457,7 @@ each of the symbols SYM in turn. This is analogous to the Common Lisp
1451`multiple-value-setq' macro, using lists to simulate true multiple return 1457`multiple-value-setq' macro, using lists to simulate true multiple return
1452values. For compatibility, (values A B C) is a synonym for (list A B C). 1458values. For compatibility, (values A B C) is a synonym for (list A B C).
1453 1459
1454\(fn (SYM SYM...) FORM)" 1460\(fn (SYM...) FORM)"
1455 (cond ((null vars) (list 'progn form nil)) 1461 (cond ((null vars) (list 'progn form nil))
1456 ((null (cdr vars)) (list 'setq (car vars) (list 'car form))) 1462 ((null (cdr vars)) (list 'setq (car vars) (list 'car form)))
1457 (t 1463 (t
@@ -1967,7 +1973,7 @@ The form returns true if TAG was found and removed, nil otherwise."
1967Example: (shiftf A B C) sets A to B, B to C, and returns the old A. 1973Example: (shiftf A B C) sets A to B, B to C, and returns the old A.
1968Each PLACE may be a symbol, or any generalized variable allowed by `setf'. 1974Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
1969 1975
1970\(fn PLACE PLACE... VAL)" 1976\(fn PLACE... VAL)"
1971 (cond 1977 (cond
1972 ((null args) place) 1978 ((null args) place)
1973 ((symbolp place) `(prog1 ,place (setq ,place (shiftf ,@args)))) 1979 ((symbolp place) `(prog1 ,place (setq ,place (shiftf ,@args))))
diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
index cb202700a00..35403df1d0b 100644
--- a/lisp/emacs-lisp/cl-seq.el
+++ b/lisp/emacs-lisp/cl-seq.el
@@ -125,8 +125,9 @@
125 125
126 126
127(defun reduce (cl-func cl-seq &rest cl-keys) 127(defun reduce (cl-func cl-seq &rest cl-keys)
128 "Reduce two-argument FUNCTION across SEQUENCE. 128 "Reduce two-argument FUNCTION across SEQ.
129Keywords supported: :start :end :from-end :initial-value :key" 129\nKeywords supported: :start :end :from-end :initial-value :key
130\n(fn FUNCTION SEQ [KEYWORD VALUE]...)"
130 (cl-parsing-keywords (:from-end (:start 0) :end :initial-value :key) () 131 (cl-parsing-keywords (:from-end (:start 0) :end :initial-value :key) ()
131 (or (listp cl-seq) (setq cl-seq (append cl-seq nil))) 132 (or (listp cl-seq) (setq cl-seq (append cl-seq nil)))
132 (setq cl-seq (subseq cl-seq cl-start cl-end)) 133 (setq cl-seq (subseq cl-seq cl-start cl-end))
@@ -145,7 +146,8 @@ Keywords supported: :start :end :from-end :initial-value :key"
145 146
146(defun fill (seq item &rest cl-keys) 147(defun fill (seq item &rest cl-keys)
147 "Fill the elements of SEQ with ITEM. 148 "Fill the elements of SEQ with ITEM.
148Keywords supported: :start :end" 149\nKeywords supported: :start :end
150\n(fn SEQ ITEM [KEYWORD VALUE]...)"
149 (cl-parsing-keywords ((:start 0) :end) () 151 (cl-parsing-keywords ((:start 0) :end) ()
150 (if (listp seq) 152 (if (listp seq)
151 (let ((p (nthcdr cl-start seq)) 153 (let ((p (nthcdr cl-start seq))
@@ -164,7 +166,8 @@ Keywords supported: :start :end"
164(defun replace (cl-seq1 cl-seq2 &rest cl-keys) 166(defun replace (cl-seq1 cl-seq2 &rest cl-keys)
165 "Replace the elements of SEQ1 with the elements of SEQ2. 167 "Replace the elements of SEQ1 with the elements of SEQ2.
166SEQ1 is destructively modified, then returned. 168SEQ1 is destructively modified, then returned.
167Keywords supported: :start1 :end1 :start2 :end2" 169\nKeywords supported: :start1 :end1 :start2 :end2
170\n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
168 (cl-parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) () 171 (cl-parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) ()
169 (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1)) 172 (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1))
170 (or (= cl-start1 cl-start2) 173 (or (= cl-start1 cl-start2)
@@ -206,7 +209,8 @@ Keywords supported: :start1 :end1 :start2 :end2"
206 "Remove all occurrences of ITEM in SEQ. 209 "Remove all occurrences of ITEM in SEQ.
207This is a non-destructive function; it makes a copy of SEQ if necessary 210This is a non-destructive function; it makes a copy of SEQ if necessary
208to avoid corrupting the original SEQ. 211to avoid corrupting the original SEQ.
209Keywords supported: :test :test-not :key :count :start :end :from-end" 212\nKeywords supported: :test :test-not :key :count :start :end :from-end
213\n(fn ITEM SEQ [KEYWORD VALUE]...)"
210 (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end 214 (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end
211 (:start 0) :end) () 215 (:start 0) :end) ()
212 (if (<= (or cl-count (setq cl-count 8000000)) 0) 216 (if (<= (or cl-count (setq cl-count 8000000)) 0)
@@ -250,20 +254,23 @@ Keywords supported: :test :test-not :key :count :start :end :from-end"
250 "Remove all items satisfying PREDICATE in SEQ. 254 "Remove all items satisfying PREDICATE in SEQ.
251This is a non-destructive function; it makes a copy of SEQ if necessary 255This is a non-destructive function; it makes a copy of SEQ if necessary
252to avoid corrupting the original SEQ. 256to avoid corrupting the original SEQ.
253Keywords supported: :key :count :start :end :from-end" 257\nKeywords supported: :key :count :start :end :from-end
258\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
254 (apply 'remove* nil cl-list :if cl-pred cl-keys)) 259 (apply 'remove* nil cl-list :if cl-pred cl-keys))
255 260
256(defun remove-if-not (cl-pred cl-list &rest cl-keys) 261(defun remove-if-not (cl-pred cl-list &rest cl-keys)
257 "Remove all items not satisfying PREDICATE in SEQ. 262 "Remove all items not satisfying PREDICATE in SEQ.
258This is a non-destructive function; it makes a copy of SEQ if necessary 263This is a non-destructive function; it makes a copy of SEQ if necessary
259to avoid corrupting the original SEQ. 264to avoid corrupting the original SEQ.
260Keywords supported: :key :count :start :end :from-end" 265\nKeywords supported: :key :count :start :end :from-end
266\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
261 (apply 'remove* nil cl-list :if-not cl-pred cl-keys)) 267 (apply 'remove* nil cl-list :if-not cl-pred cl-keys))
262 268
263(defun delete* (cl-item cl-seq &rest cl-keys) 269(defun delete* (cl-item cl-seq &rest cl-keys)
264 "Remove all occurrences of ITEM in SEQ. 270 "Remove all occurrences of ITEM in SEQ.
265This is a destructive function; it reuses the storage of SEQ whenever possible. 271This is a destructive function; it reuses the storage of SEQ whenever possible.
266Keywords supported: :test :test-not :key :count :start :end :from-end" 272\nKeywords supported: :test :test-not :key :count :start :end :from-end
273\n(fn ITEM SEQ [KEYWORD VALUE]...)"
267 (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end 274 (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end
268 (:start 0) :end) () 275 (:start 0) :end) ()
269 (if (<= (or cl-count (setq cl-count 8000000)) 0) 276 (if (<= (or cl-count (setq cl-count 8000000)) 0)
@@ -305,23 +312,27 @@ Keywords supported: :test :test-not :key :count :start :end :from-end"
305(defun delete-if (cl-pred cl-list &rest cl-keys) 312(defun delete-if (cl-pred cl-list &rest cl-keys)
306 "Remove all items satisfying PREDICATE in SEQ. 313 "Remove all items satisfying PREDICATE in SEQ.
307This is a destructive function; it reuses the storage of SEQ whenever possible. 314This is a destructive function; it reuses the storage of SEQ whenever possible.
308Keywords supported: :key :count :start :end :from-end" 315\nKeywords supported: :key :count :start :end :from-end
316\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
309 (apply 'delete* nil cl-list :if cl-pred cl-keys)) 317 (apply 'delete* nil cl-list :if cl-pred cl-keys))
310 318
311(defun delete-if-not (cl-pred cl-list &rest cl-keys) 319(defun delete-if-not (cl-pred cl-list &rest cl-keys)
312 "Remove all items not satisfying PREDICATE in SEQ. 320 "Remove all items not satisfying PREDICATE in SEQ.
313This is a destructive function; it reuses the storage of SEQ whenever possible. 321This is a destructive function; it reuses the storage of SEQ whenever possible.
314Keywords supported: :key :count :start :end :from-end" 322\nKeywords supported: :key :count :start :end :from-end
323\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
315 (apply 'delete* nil cl-list :if-not cl-pred cl-keys)) 324 (apply 'delete* nil cl-list :if-not cl-pred cl-keys))
316 325
317(defun remove-duplicates (cl-seq &rest cl-keys) 326(defun remove-duplicates (cl-seq &rest cl-keys)
318 "Return a copy of SEQ with all duplicate elements removed. 327 "Return a copy of SEQ with all duplicate elements removed.
319Keywords supported: :test :test-not :key :start :end :from-end" 328\nKeywords supported: :test :test-not :key :start :end :from-end
329\n(fn SEQ [KEYWORD VALUE]...)"
320 (cl-delete-duplicates cl-seq cl-keys t)) 330 (cl-delete-duplicates cl-seq cl-keys t))
321 331
322(defun delete-duplicates (cl-seq &rest cl-keys) 332(defun delete-duplicates (cl-seq &rest cl-keys)
323 "Remove all duplicate elements from SEQ (destructively). 333 "Remove all duplicate elements from SEQ (destructively).
324Keywords supported: :test :test-not :key :start :end :from-end" 334\nKeywords supported: :test :test-not :key :start :end :from-end
335\n(fn SEQ [KEYWORD VALUE]...)"
325 (cl-delete-duplicates cl-seq cl-keys nil)) 336 (cl-delete-duplicates cl-seq cl-keys nil))
326 337
327(defun cl-delete-duplicates (cl-seq cl-keys cl-copy) 338(defun cl-delete-duplicates (cl-seq cl-keys cl-copy)
@@ -368,7 +379,8 @@ Keywords supported: :test :test-not :key :start :end :from-end"
368 "Substitute NEW for OLD in SEQ. 379 "Substitute NEW for OLD in SEQ.
369This is a non-destructive function; it makes a copy of SEQ if necessary 380This is a non-destructive function; it makes a copy of SEQ if necessary
370to avoid corrupting the original SEQ. 381to avoid corrupting the original SEQ.
371Keywords supported: :test :test-not :key :count :start :end :from-end" 382\nKeywords supported: :test :test-not :key :count :start :end :from-end
383\n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
372 (cl-parsing-keywords (:test :test-not :key :if :if-not :count 384 (cl-parsing-keywords (:test :test-not :key :if :if-not :count
373 (:start 0) :end :from-end) () 385 (:start 0) :end :from-end) ()
374 (if (or (eq cl-old cl-new) 386 (if (or (eq cl-old cl-new)
@@ -388,20 +400,23 @@ Keywords supported: :test :test-not :key :count :start :end :from-end"
388 "Substitute NEW for all items satisfying PREDICATE in SEQ. 400 "Substitute NEW for all items satisfying PREDICATE in SEQ.
389This is a non-destructive function; it makes a copy of SEQ if necessary 401This is a non-destructive function; it makes a copy of SEQ if necessary
390to avoid corrupting the original SEQ. 402to avoid corrupting the original SEQ.
391Keywords supported: :key :count :start :end :from-end" 403\nKeywords supported: :key :count :start :end :from-end
404\n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
392 (apply 'substitute cl-new nil cl-list :if cl-pred cl-keys)) 405 (apply 'substitute cl-new nil cl-list :if cl-pred cl-keys))
393 406
394(defun substitute-if-not (cl-new cl-pred cl-list &rest cl-keys) 407(defun substitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
395 "Substitute NEW for all items not satisfying PREDICATE in SEQ. 408 "Substitute NEW for all items not satisfying PREDICATE in SEQ.
396This is a non-destructive function; it makes a copy of SEQ if necessary 409This is a non-destructive function; it makes a copy of SEQ if necessary
397to avoid corrupting the original SEQ. 410to avoid corrupting the original SEQ.
398Keywords supported: :key :count :start :end :from-end" 411\nKeywords supported: :key :count :start :end :from-end
412\n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
399 (apply 'substitute cl-new nil cl-list :if-not cl-pred cl-keys)) 413 (apply 'substitute cl-new nil cl-list :if-not cl-pred cl-keys))
400 414
401(defun nsubstitute (cl-new cl-old cl-seq &rest cl-keys) 415(defun nsubstitute (cl-new cl-old cl-seq &rest cl-keys)
402 "Substitute NEW for OLD in SEQ. 416 "Substitute NEW for OLD in SEQ.
403This is a destructive function; it reuses the storage of SEQ whenever possible. 417This is a destructive function; it reuses the storage of SEQ whenever possible.
404Keywords supported: :test :test-not :key :count :start :end :from-end" 418\nKeywords supported: :test :test-not :key :count :start :end :from-end
419\n(fn NEW OLD SEQ [KEYWORD VALUE]...)"
405 (cl-parsing-keywords (:test :test-not :key :if :if-not :count 420 (cl-parsing-keywords (:test :test-not :key :if :if-not :count
406 (:start 0) :end :from-end) () 421 (:start 0) :end :from-end) ()
407 (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count 8000000)) 0) 422 (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count 8000000)) 0)
@@ -433,38 +448,44 @@ Keywords supported: :test :test-not :key :count :start :end :from-end"
433(defun nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys) 448(defun nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys)
434 "Substitute NEW for all items satisfying PREDICATE in SEQ. 449 "Substitute NEW for all items satisfying PREDICATE in SEQ.
435This is a destructive function; it reuses the storage of SEQ whenever possible. 450This is a destructive function; it reuses the storage of SEQ whenever possible.
436Keywords supported: :key :count :start :end :from-end" 451\nKeywords supported: :key :count :start :end :from-end
452\n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
437 (apply 'nsubstitute cl-new nil cl-list :if cl-pred cl-keys)) 453 (apply 'nsubstitute cl-new nil cl-list :if cl-pred cl-keys))
438 454
439(defun nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys) 455(defun nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
440 "Substitute NEW for all items not satisfying PREDICATE in SEQ. 456 "Substitute NEW for all items not satisfying PREDICATE in SEQ.
441This is a destructive function; it reuses the storage of SEQ whenever possible. 457This is a destructive function; it reuses the storage of SEQ whenever possible.
442Keywords supported: :key :count :start :end :from-end" 458\nKeywords supported: :key :count :start :end :from-end
459\n(fn NEW PREDICATE SEQ [KEYWORD VALUE]...)"
443 (apply 'nsubstitute cl-new nil cl-list :if-not cl-pred cl-keys)) 460 (apply 'nsubstitute cl-new nil cl-list :if-not cl-pred cl-keys))
444 461
445(defun find (cl-item cl-seq &rest cl-keys) 462(defun find (cl-item cl-seq &rest cl-keys)
446 "Find the first occurrence of ITEM in LIST. 463 "Find the first occurrence of ITEM in SEQ.
447Return the matching ITEM, or nil if not found. 464Return the matching ITEM, or nil if not found.
448Keywords supported: :test :test-not :key :start :end :from-end" 465\nKeywords supported: :test :test-not :key :start :end :from-end
466\n(fn ITEM SEQ [KEYWORD VALUE]...)"
449 (let ((cl-pos (apply 'position cl-item cl-seq cl-keys))) 467 (let ((cl-pos (apply 'position cl-item cl-seq cl-keys)))
450 (and cl-pos (elt cl-seq cl-pos)))) 468 (and cl-pos (elt cl-seq cl-pos))))
451 469
452(defun find-if (cl-pred cl-list &rest cl-keys) 470(defun find-if (cl-pred cl-list &rest cl-keys)
453 "Find the first item satisfying PREDICATE in LIST. 471 "Find the first item satisfying PREDICATE in SEQ.
454Return the matching ITEM, or nil if not found. 472Return the matching item, or nil if not found.
455Keywords supported: :key :start :end :from-end" 473\nKeywords supported: :key :start :end :from-end
474\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
456 (apply 'find nil cl-list :if cl-pred cl-keys)) 475 (apply 'find nil cl-list :if cl-pred cl-keys))
457 476
458(defun find-if-not (cl-pred cl-list &rest cl-keys) 477(defun find-if-not (cl-pred cl-list &rest cl-keys)
459 "Find the first item not satisfying PREDICATE in LIST. 478 "Find the first item not satisfying PREDICATE in SEQ.
460Return the matching ITEM, or nil if not found. 479Return the matching item, or nil if not found.
461Keywords supported: :key :start :end :from-end" 480\nKeywords supported: :key :start :end :from-end
481\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
462 (apply 'find nil cl-list :if-not cl-pred cl-keys)) 482 (apply 'find nil cl-list :if-not cl-pred cl-keys))
463 483
464(defun position (cl-item cl-seq &rest cl-keys) 484(defun position (cl-item cl-seq &rest cl-keys)
465 "Find the first occurrence of ITEM in LIST. 485 "Find the first occurrence of ITEM in SEQ.
466Return the index of the matching item, or nil if not found. 486Return the index of the matching item, or nil if not found.
467Keywords supported: :test :test-not :key :start :end :from-end" 487\nKeywords supported: :test :test-not :key :start :end :from-end
488\n(fn ITEM SEQ [KEYWORD VALUE]...)"
468 (cl-parsing-keywords (:test :test-not :key :if :if-not 489 (cl-parsing-keywords (:test :test-not :key :if :if-not
469 (:start 0) :end :from-end) () 490 (:start 0) :end :from-end) ()
470 (cl-position cl-item cl-seq cl-start cl-end cl-from-end))) 491 (cl-position cl-item cl-seq cl-start cl-end cl-from-end)))
@@ -491,20 +512,23 @@ Keywords supported: :test :test-not :key :start :end :from-end"
491 (and (< cl-start cl-end) cl-start)))) 512 (and (< cl-start cl-end) cl-start))))
492 513
493(defun position-if (cl-pred cl-list &rest cl-keys) 514(defun position-if (cl-pred cl-list &rest cl-keys)
494 "Find the first item satisfying PREDICATE in LIST. 515 "Find the first item satisfying PREDICATE in SEQ.
495Return the index of the matching item, or nil if not found. 516Return the index of the matching item, or nil if not found.
496Keywords supported: :key :start :end :from-end" 517\nKeywords supported: :key :start :end :from-end
518\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
497 (apply 'position nil cl-list :if cl-pred cl-keys)) 519 (apply 'position nil cl-list :if cl-pred cl-keys))
498 520
499(defun position-if-not (cl-pred cl-list &rest cl-keys) 521(defun position-if-not (cl-pred cl-list &rest cl-keys)
500 "Find the first item not satisfying PREDICATE in LIST. 522 "Find the first item not satisfying PREDICATE in SEQ.
501Return the index of the matching item, or nil if not found. 523Return the index of the matching item, or nil if not found.
502Keywords supported: :key :start :end :from-end" 524\nKeywords supported: :key :start :end :from-end
525\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
503 (apply 'position nil cl-list :if-not cl-pred cl-keys)) 526 (apply 'position nil cl-list :if-not cl-pred cl-keys))
504 527
505(defun count (cl-item cl-seq &rest cl-keys) 528(defun count (cl-item cl-seq &rest cl-keys)
506 "Count the number of occurrences of ITEM in LIST. 529 "Count the number of occurrences of ITEM in SEQ.
507Keywords supported: :test :test-not :key :start :end" 530\nKeywords supported: :test :test-not :key :start :end
531\n(fn ITEM SEQ [KEYWORD VALUE]...)"
508 (cl-parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) () 532 (cl-parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) ()
509 (let ((cl-count 0) cl-x) 533 (let ((cl-count 0) cl-x)
510 (or cl-end (setq cl-end (length cl-seq))) 534 (or cl-end (setq cl-end (length cl-seq)))
@@ -516,20 +540,23 @@ Keywords supported: :test :test-not :key :start :end"
516 cl-count))) 540 cl-count)))
517 541
518(defun count-if (cl-pred cl-list &rest cl-keys) 542(defun count-if (cl-pred cl-list &rest cl-keys)
519 "Count the number of items satisfying PREDICATE in LIST. 543 "Count the number of items satisfying PREDICATE in SEQ.
520Keywords supported: :key :start :end" 544\nKeywords supported: :key :start :end
545\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
521 (apply 'count nil cl-list :if cl-pred cl-keys)) 546 (apply 'count nil cl-list :if cl-pred cl-keys))
522 547
523(defun count-if-not (cl-pred cl-list &rest cl-keys) 548(defun count-if-not (cl-pred cl-list &rest cl-keys)
524 "Count the number of items not satisfying PREDICATE in LIST. 549 "Count the number of items not satisfying PREDICATE in SEQ.
525Keywords supported: :key :start :end" 550\nKeywords supported: :key :start :end
551\n(fn PREDICATE SEQ [KEYWORD VALUE]...)"
526 (apply 'count nil cl-list :if-not cl-pred cl-keys)) 552 (apply 'count nil cl-list :if-not cl-pred cl-keys))
527 553
528(defun mismatch (cl-seq1 cl-seq2 &rest cl-keys) 554(defun mismatch (cl-seq1 cl-seq2 &rest cl-keys)
529 "Compare SEQ1 with SEQ2, return index of first mismatching element. 555 "Compare SEQ1 with SEQ2, return index of first mismatching element.
530Return nil if the sequences match. If one sequence is a prefix of the 556Return nil if the sequences match. If one sequence is a prefix of the
531other, the return value indicates the end of the shorter sequence. 557other, the return value indicates the end of the shorter sequence.
532Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end" 558\nKeywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end
559\n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
533 (cl-parsing-keywords (:test :test-not :key :from-end 560 (cl-parsing-keywords (:test :test-not :key :from-end
534 (:start1 0) :end1 (:start2 0) :end2) () 561 (:start1 0) :end1 (:start2 0) :end2) ()
535 (or cl-end1 (setq cl-end1 (length cl-seq1))) 562 (or cl-end1 (setq cl-end1 (length cl-seq1)))
@@ -558,7 +585,8 @@ Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end"
558 "Search for SEQ1 as a subsequence of SEQ2. 585 "Search for SEQ1 as a subsequence of SEQ2.
559Return the index of the leftmost element of the first match found; 586Return the index of the leftmost element of the first match found;
560return nil if there are no matches. 587return nil if there are no matches.
561Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end" 588\nKeywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end
589\n(fn SEQ1 SEQ2 [KEYWORD VALUE]...)"
562 (cl-parsing-keywords (:test :test-not :key :from-end 590 (cl-parsing-keywords (:test :test-not :key :from-end
563 (:start1 0) :end1 (:start2 0) :end2) () 591 (:start1 0) :end1 (:start2 0) :end2) ()
564 (or cl-end1 (setq cl-end1 (length cl-seq1))) 592 (or cl-end1 (setq cl-end1 (length cl-seq1)))
@@ -580,9 +608,10 @@ Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end"
580 (and (< cl-start2 cl-end2) cl-pos))))) 608 (and (< cl-start2 cl-end2) cl-pos)))))
581 609
582(defun sort* (cl-seq cl-pred &rest cl-keys) 610(defun sort* (cl-seq cl-pred &rest cl-keys)
583 "Sort the argument SEQUENCE according to PREDICATE. 611 "Sort the argument SEQ according to PREDICATE.
584This is a destructive function; it reuses the storage of SEQUENCE if possible. 612This is a destructive function; it reuses the storage of SEQ if possible.
585Keywords supported: :key" 613\nKeywords supported: :key
614\n(fn SEQ PREDICATE [KEYWORD VALUE]...)"
586 (if (nlistp cl-seq) 615 (if (nlistp cl-seq)
587 (replace cl-seq (apply 'sort* (append cl-seq nil) cl-pred cl-keys)) 616 (replace cl-seq (apply 'sort* (append cl-seq nil) cl-pred cl-keys))
588 (cl-parsing-keywords (:key) () 617 (cl-parsing-keywords (:key) ()
@@ -593,16 +622,18 @@ Keywords supported: :key"
593 (funcall cl-key cl-y))))))))) 622 (funcall cl-key cl-y)))))))))
594 623
595(defun stable-sort (cl-seq cl-pred &rest cl-keys) 624(defun stable-sort (cl-seq cl-pred &rest cl-keys)
596 "Sort the argument SEQUENCE stably according to PREDICATE. 625 "Sort the argument SEQ stably according to PREDICATE.
597This is a destructive function; it reuses the storage of SEQUENCE if possible. 626This is a destructive function; it reuses the storage of SEQ if possible.
598Keywords supported: :key" 627\nKeywords supported: :key
628\n(fn SEQ PREDICATE [KEYWORD VALUE]...)"
599 (apply 'sort* cl-seq cl-pred cl-keys)) 629 (apply 'sort* cl-seq cl-pred cl-keys))
600 630
601(defun merge (cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys) 631(defun merge (cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys)
602 "Destructively merge the two sequences to produce a new sequence. 632 "Destructively merge the two sequences to produce a new sequence.
603TYPE is the sequence type to return, SEQ1 and SEQ2 are the two 633TYPE is the sequence type to return, SEQ1 and SEQ2 are the two argument
604argument sequences, and PRED is a `less-than' predicate on the elements. 634sequences, and PREDICATE is a `less-than' predicate on the elements.
605Keywords supported: :key" 635\nKeywords supported: :key
636\n(fn TYPE SEQ1 SEQ2 PREDICATE [KEYWORD VALUE]...)"
606 (or (listp cl-seq1) (setq cl-seq1 (append cl-seq1 nil))) 637 (or (listp cl-seq1) (setq cl-seq1 (append cl-seq1 nil)))
607 (or (listp cl-seq2) (setq cl-seq2 (append cl-seq2 nil))) 638 (or (listp cl-seq2) (setq cl-seq2 (append cl-seq2 nil)))
608 (cl-parsing-keywords (:key) () 639 (cl-parsing-keywords (:key) ()
@@ -618,7 +649,8 @@ Keywords supported: :key"
618(defun member* (cl-item cl-list &rest cl-keys) 649(defun member* (cl-item cl-list &rest cl-keys)
619 "Find the first occurrence of ITEM in LIST. 650 "Find the first occurrence of ITEM in LIST.
620Return the sublist of LIST whose car is ITEM. 651Return the sublist of LIST whose car is ITEM.
621Keywords supported: :test :test-not :key" 652\nKeywords supported: :test :test-not :key
653\n(fn ITEM LIST [KEYWORD VALUE]...)"
622 (if cl-keys 654 (if cl-keys
623 (cl-parsing-keywords (:test :test-not :key :if :if-not) () 655 (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
624 (while (and cl-list (not (cl-check-test cl-item (car cl-list)))) 656 (while (and cl-list (not (cl-check-test cl-item (car cl-list))))
@@ -631,13 +663,15 @@ Keywords supported: :test :test-not :key"
631(defun member-if (cl-pred cl-list &rest cl-keys) 663(defun member-if (cl-pred cl-list &rest cl-keys)
632 "Find the first item satisfying PREDICATE in LIST. 664 "Find the first item satisfying PREDICATE in LIST.
633Return the sublist of LIST whose car matches. 665Return the sublist of LIST whose car matches.
634Keywords supported: :key" 666\nKeywords supported: :key
667\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
635 (apply 'member* nil cl-list :if cl-pred cl-keys)) 668 (apply 'member* nil cl-list :if cl-pred cl-keys))
636 669
637(defun member-if-not (cl-pred cl-list &rest cl-keys) 670(defun member-if-not (cl-pred cl-list &rest cl-keys)
638 "Find the first item not satisfying PREDICATE in LIST. 671 "Find the first item not satisfying PREDICATE in LIST.
639Return the sublist of LIST whose car matches. 672Return the sublist of LIST whose car matches.
640Keywords supported: :key" 673\nKeywords supported: :key
674\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
641 (apply 'member* nil cl-list :if-not cl-pred cl-keys)) 675 (apply 'member* nil cl-list :if-not cl-pred cl-keys))
642 676
643(defun cl-adjoin (cl-item cl-list &rest cl-keys) 677(defun cl-adjoin (cl-item cl-list &rest cl-keys)
@@ -649,7 +683,8 @@ Keywords supported: :key"
649;;; See compiler macro in cl-macs.el 683;;; See compiler macro in cl-macs.el
650(defun assoc* (cl-item cl-alist &rest cl-keys) 684(defun assoc* (cl-item cl-alist &rest cl-keys)
651 "Find the first item whose car matches ITEM in LIST. 685 "Find the first item whose car matches ITEM in LIST.
652Keywords supported: :test :test-not :key" 686\nKeywords supported: :test :test-not :key
687\n(fn ITEM LIST [KEYWORD VALUE]...)"
653 (if cl-keys 688 (if cl-keys
654 (cl-parsing-keywords (:test :test-not :key :if :if-not) () 689 (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
655 (while (and cl-alist 690 (while (and cl-alist
@@ -663,17 +698,20 @@ Keywords supported: :test :test-not :key"
663 698
664(defun assoc-if (cl-pred cl-list &rest cl-keys) 699(defun assoc-if (cl-pred cl-list &rest cl-keys)
665 "Find the first item whose car satisfies PREDICATE in LIST. 700 "Find the first item whose car satisfies PREDICATE in LIST.
666Keywords supported: :key" 701\nKeywords supported: :key
702\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
667 (apply 'assoc* nil cl-list :if cl-pred cl-keys)) 703 (apply 'assoc* nil cl-list :if cl-pred cl-keys))
668 704
669(defun assoc-if-not (cl-pred cl-list &rest cl-keys) 705(defun assoc-if-not (cl-pred cl-list &rest cl-keys)
670 "Find the first item whose car does not satisfy PREDICATE in LIST. 706 "Find the first item whose car does not satisfy PREDICATE in LIST.
671Keywords supported: :key" 707\nKeywords supported: :key
708\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
672 (apply 'assoc* nil cl-list :if-not cl-pred cl-keys)) 709 (apply 'assoc* nil cl-list :if-not cl-pred cl-keys))
673 710
674(defun rassoc* (cl-item cl-alist &rest cl-keys) 711(defun rassoc* (cl-item cl-alist &rest cl-keys)
675 "Find the first item whose cdr matches ITEM in LIST. 712 "Find the first item whose cdr matches ITEM in LIST.
676Keywords supported: :test :test-not :key" 713\nKeywords supported: :test :test-not :key
714\n(fn ITEM LIST [KEYWORD VALUE]...)"
677 (if (or cl-keys (numberp cl-item)) 715 (if (or cl-keys (numberp cl-item))
678 (cl-parsing-keywords (:test :test-not :key :if :if-not) () 716 (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
679 (while (and cl-alist 717 (while (and cl-alist
@@ -685,12 +723,14 @@ Keywords supported: :test :test-not :key"
685 723
686(defun rassoc-if (cl-pred cl-list &rest cl-keys) 724(defun rassoc-if (cl-pred cl-list &rest cl-keys)
687 "Find the first item whose cdr satisfies PREDICATE in LIST. 725 "Find the first item whose cdr satisfies PREDICATE in LIST.
688Keywords supported: :key" 726\nKeywords supported: :key
727\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
689 (apply 'rassoc* nil cl-list :if cl-pred cl-keys)) 728 (apply 'rassoc* nil cl-list :if cl-pred cl-keys))
690 729
691(defun rassoc-if-not (cl-pred cl-list &rest cl-keys) 730(defun rassoc-if-not (cl-pred cl-list &rest cl-keys)
692 "Find the first item whose cdr does not satisfy PREDICATE in LIST. 731 "Find the first item whose cdr does not satisfy PREDICATE in LIST.
693Keywords supported: :key" 732\nKeywords supported: :key
733\n(fn PREDICATE LIST [KEYWORD VALUE]...)"
694 (apply 'rassoc* nil cl-list :if-not cl-pred cl-keys)) 734 (apply 'rassoc* nil cl-list :if-not cl-pred cl-keys))
695 735
696(defun union (cl-list1 cl-list2 &rest cl-keys) 736(defun union (cl-list1 cl-list2 &rest cl-keys)
@@ -698,7 +738,8 @@ Keywords supported: :key"
698The result list contains all items that appear in either LIST1 or LIST2. 738The result list contains all items that appear in either LIST1 or LIST2.
699This is a non-destructive function; it makes a copy of the data if necessary 739This is a non-destructive function; it makes a copy of the data if necessary
700to avoid corrupting the original LIST1 and LIST2. 740to avoid corrupting the original LIST1 and LIST2.
701Keywords supported: :test :test-not :key" 741\nKeywords supported: :test :test-not :key
742\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
702 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) 743 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
703 ((equal cl-list1 cl-list2) cl-list1) 744 ((equal cl-list1 cl-list2) cl-list1)
704 (t 745 (t
@@ -717,7 +758,8 @@ Keywords supported: :test :test-not :key"
717The result list contains all items that appear in either LIST1 or LIST2. 758The result list contains all items that appear in either LIST1 or LIST2.
718This is a destructive function; it reuses the storage of LIST1 and LIST2 759This is a destructive function; it reuses the storage of LIST1 and LIST2
719whenever possible. 760whenever possible.
720Keywords supported: :test :test-not :key" 761\nKeywords supported: :test :test-not :key
762\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
721 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) 763 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
722 (t (apply 'union cl-list1 cl-list2 cl-keys)))) 764 (t (apply 'union cl-list1 cl-list2 cl-keys))))
723 765
@@ -726,7 +768,8 @@ Keywords supported: :test :test-not :key"
726The result list contains all items that appear in both LIST1 and LIST2. 768The result list contains all items that appear in both LIST1 and LIST2.
727This is a non-destructive function; it makes a copy of the data if necessary 769This is a non-destructive function; it makes a copy of the data if necessary
728to avoid corrupting the original LIST1 and LIST2. 770to avoid corrupting the original LIST1 and LIST2.
729Keywords supported: :test :test-not :key" 771\nKeywords supported: :test :test-not :key
772\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
730 (and cl-list1 cl-list2 773 (and cl-list1 cl-list2
731 (if (equal cl-list1 cl-list2) cl-list1 774 (if (equal cl-list1 cl-list2) cl-list1
732 (cl-parsing-keywords (:key) (:test :test-not) 775 (cl-parsing-keywords (:key) (:test :test-not)
@@ -747,7 +790,8 @@ Keywords supported: :test :test-not :key"
747The result list contains all items that appear in both LIST1 and LIST2. 790The result list contains all items that appear in both LIST1 and LIST2.
748This is a destructive function; it reuses the storage of LIST1 and LIST2 791This is a destructive function; it reuses the storage of LIST1 and LIST2
749whenever possible. 792whenever possible.
750Keywords supported: :test :test-not :key" 793\nKeywords supported: :test :test-not :key
794\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
751 (and cl-list1 cl-list2 (apply 'intersection cl-list1 cl-list2 cl-keys))) 795 (and cl-list1 cl-list2 (apply 'intersection cl-list1 cl-list2 cl-keys)))
752 796
753(defun set-difference (cl-list1 cl-list2 &rest cl-keys) 797(defun set-difference (cl-list1 cl-list2 &rest cl-keys)
@@ -755,7 +799,8 @@ Keywords supported: :test :test-not :key"
755The result list contains all items that appear in LIST1 but not LIST2. 799The result list contains all items that appear in LIST1 but not LIST2.
756This is a non-destructive function; it makes a copy of the data if necessary 800This is a non-destructive function; it makes a copy of the data if necessary
757to avoid corrupting the original LIST1 and LIST2. 801to avoid corrupting the original LIST1 and LIST2.
758Keywords supported: :test :test-not :key" 802\nKeywords supported: :test :test-not :key
803\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
759 (if (or (null cl-list1) (null cl-list2)) cl-list1 804 (if (or (null cl-list1) (null cl-list2)) cl-list1
760 (cl-parsing-keywords (:key) (:test :test-not) 805 (cl-parsing-keywords (:key) (:test :test-not)
761 (let ((cl-res nil)) 806 (let ((cl-res nil))
@@ -773,7 +818,8 @@ Keywords supported: :test :test-not :key"
773The result list contains all items that appear in LIST1 but not LIST2. 818The result list contains all items that appear in LIST1 but not LIST2.
774This is a destructive function; it reuses the storage of LIST1 and LIST2 819This is a destructive function; it reuses the storage of LIST1 and LIST2
775whenever possible. 820whenever possible.
776Keywords supported: :test :test-not :key" 821\nKeywords supported: :test :test-not :key
822\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
777 (if (or (null cl-list1) (null cl-list2)) cl-list1 823 (if (or (null cl-list1) (null cl-list2)) cl-list1
778 (apply 'set-difference cl-list1 cl-list2 cl-keys))) 824 (apply 'set-difference cl-list1 cl-list2 cl-keys)))
779 825
@@ -782,7 +828,8 @@ Keywords supported: :test :test-not :key"
782The result list contains all items that appear in exactly one of LIST1, LIST2. 828The result list contains all items that appear in exactly one of LIST1, LIST2.
783This is a non-destructive function; it makes a copy of the data if necessary 829This is a non-destructive function; it makes a copy of the data if necessary
784to avoid corrupting the original LIST1 and LIST2. 830to avoid corrupting the original LIST1 and LIST2.
785Keywords supported: :test :test-not :key" 831\nKeywords supported: :test :test-not :key
832\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
786 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) 833 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
787 ((equal cl-list1 cl-list2) nil) 834 ((equal cl-list1 cl-list2) nil)
788 (t (append (apply 'set-difference cl-list1 cl-list2 cl-keys) 835 (t (append (apply 'set-difference cl-list1 cl-list2 cl-keys)
@@ -793,7 +840,8 @@ Keywords supported: :test :test-not :key"
793The result list contains all items that appear in exactly one of LIST1, LIST2. 840The result list contains all items that appear in exactly one of LIST1, LIST2.
794This is a destructive function; it reuses the storage of LIST1 and LIST2 841This is a destructive function; it reuses the storage of LIST1 and LIST2
795whenever possible. 842whenever possible.
796Keywords supported: :test :test-not :key" 843\nKeywords supported: :test :test-not :key
844\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
797 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) 845 (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
798 ((equal cl-list1 cl-list2) nil) 846 ((equal cl-list1 cl-list2) nil)
799 (t (nconc (apply 'nset-difference cl-list1 cl-list2 cl-keys) 847 (t (nconc (apply 'nset-difference cl-list1 cl-list2 cl-keys)
@@ -802,7 +850,8 @@ Keywords supported: :test :test-not :key"
802(defun subsetp (cl-list1 cl-list2 &rest cl-keys) 850(defun subsetp (cl-list1 cl-list2 &rest cl-keys)
803 "Return true if LIST1 is a subset of LIST2. 851 "Return true if LIST1 is a subset of LIST2.
804I.e., if every element of LIST1 also appears in LIST2. 852I.e., if every element of LIST1 also appears in LIST2.
805Keywords supported: :test :test-not :key" 853\nKeywords supported: :test :test-not :key
854\n(fn LIST1 LIST2 [KEYWORD VALUE]...)"
806 (cond ((null cl-list1) t) ((null cl-list2) nil) 855 (cond ((null cl-list1) t) ((null cl-list2) nil)
807 ((equal cl-list1 cl-list2) t) 856 ((equal cl-list1 cl-list2) t)
808 (t (cl-parsing-keywords (:key) (:test :test-not) 857 (t (cl-parsing-keywords (:key) (:test :test-not)
@@ -815,38 +864,44 @@ Keywords supported: :test :test-not :key"
815(defun subst-if (cl-new cl-pred cl-tree &rest cl-keys) 864(defun subst-if (cl-new cl-pred cl-tree &rest cl-keys)
816 "Substitute NEW for elements matching PREDICATE in TREE (non-destructively). 865 "Substitute NEW for elements matching PREDICATE in TREE (non-destructively).
817Return a copy of TREE with all matching elements replaced by NEW. 866Return a copy of TREE with all matching elements replaced by NEW.
818Keywords supported: :key" 867\nKeywords supported: :key
868\n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
819 (apply 'sublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys)) 869 (apply 'sublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
820 870
821(defun subst-if-not (cl-new cl-pred cl-tree &rest cl-keys) 871(defun subst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
822 "Substitute NEW for elts not matching PREDICATE in TREE (non-destructively). 872 "Substitute NEW for elts not matching PREDICATE in TREE (non-destructively).
823Return a copy of TREE with all non-matching elements replaced by NEW. 873Return a copy of TREE with all non-matching elements replaced by NEW.
824Keywords supported: :key" 874\nKeywords supported: :key
875\n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
825 (apply 'sublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys)) 876 (apply 'sublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
826 877
827(defun nsubst (cl-new cl-old cl-tree &rest cl-keys) 878(defun nsubst (cl-new cl-old cl-tree &rest cl-keys)
828 "Substitute NEW for OLD everywhere in TREE (destructively). 879 "Substitute NEW for OLD everywhere in TREE (destructively).
829Any element of TREE which is `eql' to OLD is changed to NEW (via a call 880Any element of TREE which is `eql' to OLD is changed to NEW (via a call
830to `setcar'). 881to `setcar').
831Keywords supported: :test :test-not :key" 882\nKeywords supported: :test :test-not :key
883\n(fn NEW OLD TREE [KEYWORD VALUE]...)"
832 (apply 'nsublis (list (cons cl-old cl-new)) cl-tree cl-keys)) 884 (apply 'nsublis (list (cons cl-old cl-new)) cl-tree cl-keys))
833 885
834(defun nsubst-if (cl-new cl-pred cl-tree &rest cl-keys) 886(defun nsubst-if (cl-new cl-pred cl-tree &rest cl-keys)
835 "Substitute NEW for elements matching PREDICATE in TREE (destructively). 887 "Substitute NEW for elements matching PREDICATE in TREE (destructively).
836Any element of TREE which matches is changed to NEW (via a call to `setcar'). 888Any element of TREE which matches is changed to NEW (via a call to `setcar').
837Keywords supported: :key" 889\nKeywords supported: :key
890\n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
838 (apply 'nsublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys)) 891 (apply 'nsublis (list (cons nil cl-new)) cl-tree :if cl-pred cl-keys))
839 892
840(defun nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys) 893(defun nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
841 "Substitute NEW for elements not matching PREDICATE in TREE (destructively). 894 "Substitute NEW for elements not matching PREDICATE in TREE (destructively).
842Any element of TREE which matches is changed to NEW (via a call to `setcar'). 895Any element of TREE which matches is changed to NEW (via a call to `setcar').
843Keywords supported: :key" 896\nKeywords supported: :key
897\n(fn NEW PREDICATE TREE [KEYWORD VALUE]...)"
844 (apply 'nsublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys)) 898 (apply 'nsublis (list (cons nil cl-new)) cl-tree :if-not cl-pred cl-keys))
845 899
846(defun sublis (cl-alist cl-tree &rest cl-keys) 900(defun sublis (cl-alist cl-tree &rest cl-keys)
847 "Perform substitutions indicated by ALIST in TREE (non-destructively). 901 "Perform substitutions indicated by ALIST in TREE (non-destructively).
848Return a copy of TREE with all matching elements replaced. 902Return a copy of TREE with all matching elements replaced.
849Keywords supported: :test :test-not :key" 903\nKeywords supported: :test :test-not :key
904\n(fn ALIST TREE [KEYWORD VALUE]...)"
850 (cl-parsing-keywords (:test :test-not :key :if :if-not) () 905 (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
851 (cl-sublis-rec cl-tree))) 906 (cl-sublis-rec cl-tree)))
852 907
@@ -867,7 +922,8 @@ Keywords supported: :test :test-not :key"
867(defun nsublis (cl-alist cl-tree &rest cl-keys) 922(defun nsublis (cl-alist cl-tree &rest cl-keys)
868 "Perform substitutions indicated by ALIST in TREE (destructively). 923 "Perform substitutions indicated by ALIST in TREE (destructively).
869Any matching element of TREE is changed via a call to `setcar'. 924Any matching element of TREE is changed via a call to `setcar'.
870Keywords supported: :test :test-not :key" 925\nKeywords supported: :test :test-not :key
926\n(fn ALIST TREE [KEYWORD VALUE]...)"
871 (cl-parsing-keywords (:test :test-not :key :if :if-not) () 927 (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
872 (let ((cl-hold (list cl-tree))) 928 (let ((cl-hold (list cl-tree)))
873 (cl-nsublis-rec cl-hold) 929 (cl-nsublis-rec cl-hold)
@@ -888,9 +944,10 @@ Keywords supported: :test :test-not :key"
888 (setq cl-tree (cdr cl-tree)))))) 944 (setq cl-tree (cdr cl-tree))))))
889 945
890(defun tree-equal (cl-x cl-y &rest cl-keys) 946(defun tree-equal (cl-x cl-y &rest cl-keys)
891 "Return t if trees X and Y have `eql' leaves. 947 "Return t if trees TREE1 and TREE2 have `eql' leaves.
892Atoms are compared by `eql'; cons cells are compared recursively. 948Atoms are compared by `eql'; cons cells are compared recursively.
893Keywords supported: :test :test-not :key" 949\nKeywords supported: :test :test-not :key
950\n(fn TREE1 TREE2 [KEYWORD VALUE]...)"
894 (cl-parsing-keywords (:test :test-not :key) () 951 (cl-parsing-keywords (:test :test-not :key) ()
895 (cl-tree-equal-rec cl-x cl-y))) 952 (cl-tree-equal-rec cl-x cl-y)))
896 953
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
index 11835629bd7..e7f736cfd72 100644
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -112,16 +112,6 @@ a future Emacs interpreter will be able to use it.")
112(defun cl-cannot-unload () 112(defun cl-cannot-unload ()
113 (error "Cannot unload the feature `cl'")) 113 (error "Cannot unload the feature `cl'"))
114 114
115;;; Predicates.
116
117(defun eql (a b) ; See compiler macro in cl-macs.el
118 "Return t if the two args are the same Lisp object.
119Floating-point numbers of equal value are `eql', but they may not be `eq'."
120 (if (numberp a)
121 (equal a b)
122 (eq a b)))
123
124
125;;; Generalized variables. These macros are defined here so that they 115;;; Generalized variables. These macros are defined here so that they
126;;; can safely be used in .emacs files. 116;;; can safely be used in .emacs files.
127 117
@@ -162,7 +152,8 @@ be a symbol, or any generalized variable allowed by `setf'."
162 "(pushnew X PLACE): insert X at the head of the list if not already there. 152 "(pushnew X PLACE): insert X at the head of the list if not already there.
163Like (push X PLACE), except that the list is unmodified if X is `eql' to 153Like (push X PLACE), except that the list is unmodified if X is `eql' to
164an element already on the list. 154an element already on the list.
165Keywords supported: :test :test-not :key" 155\nKeywords supported: :test :test-not :key
156\n(fn X PLACE [KEYWORD VALUE]...)"
166 (if (symbolp place) (list 'setq place (list* 'adjoin x place keys)) 157 (if (symbolp place) (list 'setq place (list* 'adjoin x place keys))
167 (list* 'callf2 'adjoin x place keys))) 158 (list* 'callf2 'adjoin x place keys)))
168 159
@@ -256,7 +247,8 @@ Otherwise, the macro is expanded and the expansion is considered
256in place of FORM. When a non-macro-call results, it is returned. 247in place of FORM. When a non-macro-call results, it is returned.
257 248
258The second optional arg ENVIRONMENT specifies an environment of macro 249The second optional arg ENVIRONMENT specifies an environment of macro
259definitions to shadow the loaded ones for use in file byte-compilation." 250definitions to shadow the loaded ones for use in file byte-compilation.
251\n(fn FORM &optional ENVIRONMENT)"
260 (let ((cl-macro-environment cl-env)) 252 (let ((cl-macro-environment cl-env))
261 (while (progn (setq cl-macro (funcall cl-old-macroexpand cl-macro cl-env)) 253 (while (progn (setq cl-macro (funcall cl-old-macroexpand cl-macro cl-env))
262 (and (symbolp cl-macro) 254 (and (symbolp cl-macro)
@@ -300,27 +292,27 @@ definitions to shadow the loaded ones for use in file byte-compilation."
300 292
301;;; Numbers. 293;;; Numbers.
302 294
303(defun floatp-safe (x) 295(defun floatp-safe (object)
304 "Return t if OBJECT is a floating point number. 296 "Return t if OBJECT is a floating point number.
305On Emacs versions that lack floating-point support, this function 297On Emacs versions that lack floating-point support, this function
306always returns nil." 298always returns nil."
307 (and (numberp x) (not (integerp x)))) 299 (and (numberp object) (not (integerp object))))
308 300
309(defun plusp (x) 301(defun plusp (number)
310 "Return t if NUMBER is positive." 302 "Return t if NUMBER is positive."
311 (> x 0)) 303 (> number 0))
312 304
313(defun minusp (x) 305(defun minusp (number)
314 "Return t if NUMBER is negative." 306 "Return t if NUMBER is negative."
315 (< x 0)) 307 (< number 0))
316 308
317(defun oddp (x) 309(defun oddp (integer)
318 "Return t if INTEGER is odd." 310 "Return t if INTEGER is odd."
319 (eq (logand x 1) 1)) 311 (eq (logand integer 1) 1))
320 312
321(defun evenp (x) 313(defun evenp (integer)
322 "Return t if INTEGER is even." 314 "Return t if INTEGER is even."
323 (eq (logand x 1) 0)) 315 (eq (logand integer 1) 0))
324 316
325(defvar *random-state* (vector 'cl-random-state-tag -1 30 (cl-random-time))) 317(defvar *random-state* (vector 'cl-random-state-tag -1 30 (cl-random-time)))
326 318
@@ -344,7 +336,8 @@ always returns nil."
344If there are several SEQs, FUNCTION is called with that many arguments, 336If there are several SEQs, FUNCTION is called with that many arguments,
345and mapping stops as soon as the shortest list runs out. With just one 337and mapping stops as soon as the shortest list runs out. With just one
346SEQ, this is like `mapcar'. With several, it is like the Common Lisp 338SEQ, this is like `mapcar'. With several, it is like the Common Lisp
347`mapcar' function extended to arbitrary sequence types." 339`mapcar' function extended to arbitrary sequence types.
340\n(fn FUNCTION SEQ...)"
348 (if cl-rest 341 (if cl-rest
349 (if (or (cdr cl-rest) (nlistp cl-x) (nlistp (car cl-rest))) 342 (if (or (cdr cl-rest) (nlistp cl-x) (nlistp (car cl-rest)))
350 (cl-mapcar-many cl-func (cons cl-x cl-rest)) 343 (cl-mapcar-many cl-func (cons cl-x cl-rest))
@@ -503,9 +496,10 @@ SEQ, this is like `mapcar'. With several, it is like the Common Lisp
503;; x)) 496;; x))
504 497
505(defun list* (arg &rest rest) ; See compiler macro in cl-macs.el 498(defun list* (arg &rest rest) ; See compiler macro in cl-macs.el
506 "Return a new list with specified args as elements, consed to last arg. 499 "Return a new list with specified ARGs as elements, consed to last ARG.
507Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to 500Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
508`(cons A (cons B (cons C D)))'." 501`(cons A (cons B (cons C D)))'.
502\n(fn ARG...)"
509 (cond ((not rest) arg) 503 (cond ((not rest) arg)
510 ((not (cdr rest)) (cons arg (car rest))) 504 ((not (cdr rest)) (cons arg (car rest)))
511 (t (let* ((n (length rest)) 505 (t (let* ((n (length rest))
@@ -522,8 +516,8 @@ Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
522 (nreverse res))) 516 (nreverse res)))
523 517
524(defun copy-list (list) 518(defun copy-list (list)
525 "Return a copy of a list, which may be a dotted list. 519 "Return a copy of LIST, which may be a dotted list.
526The elements of the list are not copied, just the list structure itself." 520The elements of LIST are not copied, just the list structure itself."
527 (if (consp list) 521 (if (consp list)
528 (let ((res nil)) 522 (let ((res nil))
529 (while (consp list) (push (pop list) res)) 523 (while (consp list) (push (pop list) res))
@@ -544,7 +538,8 @@ The elements of the list are not copied, just the list structure itself."
544(defun adjoin (cl-item cl-list &rest cl-keys) ; See compiler macro in cl-macs 538(defun adjoin (cl-item cl-list &rest cl-keys) ; See compiler macro in cl-macs
545 "Return ITEM consed onto the front of LIST only if it's not already there. 539 "Return ITEM consed onto the front of LIST only if it's not already there.
546Otherwise, return LIST unmodified. 540Otherwise, return LIST unmodified.
547Keywords supported: :test :test-not :key" 541\nKeywords supported: :test :test-not :key
542\n(fn ITEM LIST [KEYWORD VALUE]...)"
548 (cond ((or (equal cl-keys '(:test eq)) 543 (cond ((or (equal cl-keys '(:test eq))
549 (and (null cl-keys) (not (numberp cl-item)))) 544 (and (null cl-keys) (not (numberp cl-item))))
550 (if (memq cl-item cl-list) cl-list (cons cl-item cl-list))) 545 (if (memq cl-item cl-list) cl-list (cons cl-item cl-list)))
@@ -555,7 +550,8 @@ Keywords supported: :test :test-not :key"
555(defun subst (cl-new cl-old cl-tree &rest cl-keys) 550(defun subst (cl-new cl-old cl-tree &rest cl-keys)
556 "Substitute NEW for OLD everywhere in TREE (non-destructively). 551 "Substitute NEW for OLD everywhere in TREE (non-destructively).
557Return a copy of TREE with all elements `eql' to OLD replaced by NEW. 552Return a copy of TREE with all elements `eql' to OLD replaced by NEW.
558Keywords supported: :test :test-not :key" 553\nKeywords supported: :test :test-not :key
554\n(fn NEW OLD TREE [KEYWORD VALUE]...)"
559 (if (or cl-keys (and (numberp cl-old) (not (integerp cl-old)))) 555 (if (or cl-keys (and (numberp cl-old) (not (integerp cl-old))))
560 (apply 'sublis (list (cons cl-old cl-new)) cl-tree cl-keys) 556 (apply 'sublis (list (cons cl-old cl-new)) cl-tree cl-keys)
561 (cl-do-subst cl-new cl-old cl-tree))) 557 (cl-do-subst cl-new cl-old cl-tree)))
@@ -569,8 +565,17 @@ Keywords supported: :test :test-not :key"
569 cl-tree (cons a d)))) 565 cl-tree (cons a d))))
570 (t cl-tree))) 566 (t cl-tree)))
571 567
572(defun acons (a b c) (cons (cons a b) c)) 568(defun acons (key value alist)
573(defun pairlis (a b &optional c) (nconc (mapcar* 'cons a b) c)) 569 "Add KEY and VALUE to ALIST.
570Return a new list with (cons KEY VALUE) as car and ALIST as cdr."
571 (cons (cons key value) alist))
572
573(defun pairlis (keys values &optional alist)
574 "Make an alist from KEYS and VALUES.
575Return a new alist composed by associating KEYS to corresponding VALUES;
576the process stops as soon as KEYS or VALUES run out.
577If ALIST is non-nil, the new pairs are prepended to it."
578 (nconc (mapcar* 'cons keys values) alist))
574 579
575 580
576;;; Miscellaneous. 581;;; Miscellaneous.
@@ -699,5 +704,5 @@ Keywords supported: :test :test-not :key"
699 704
700(run-hooks 'cl-load-hook) 705(run-hooks 'cl-load-hook)
701 706
702;;; arch-tag: 5f07fa74-f153-4524-9303-21f5be125851 707;; arch-tag: 5f07fa74-f153-4524-9303-21f5be125851
703;;; cl.el ends here 708;;; cl.el ends here
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index c00028ad218..5ba9c094355 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -132,6 +132,7 @@ BODY can start with a bunch of keyword arguments. The following keyword
132 arguments are currently understood: 132 arguments are currently understood:
133:group GROUP 133:group GROUP
134 Declare the customization group that corresponds to this mode. 134 Declare the customization group that corresponds to this mode.
135 The command `customize-mode' uses this.
135:syntax-table TABLE 136:syntax-table TABLE
136 Use TABLE instead of the default. 137 Use TABLE instead of the default.
137 A nil value means to simply use the same syntax-table as the parent. 138 A nil value means to simply use the same syntax-table as the parent.
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 0892af1bb35..188dc172e07 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -172,7 +172,7 @@ For example, you could write
172 (setq group 172 (setq group
173 `(:group ',(intern (replace-regexp-in-string 173 `(:group ',(intern (replace-regexp-in-string
174 "-mode\\'" "" mode-name))))) 174 "-mode\\'" "" mode-name)))))
175 175
176 `(progn 176 `(progn
177 ;; Define the variable to enable or disable the mode. 177 ;; Define the variable to enable or disable the mode.
178 ,(if (not globalp) 178 ,(if (not globalp)
@@ -306,9 +306,9 @@ in which `%s' turns it on."
306 ;; Setup hook to handle future mode changes and new buffers. 306 ;; Setup hook to handle future mode changes and new buffers.
307 (if ,global-mode 307 (if ,global-mode
308 (progn 308 (progn
309 (add-hook 'find-file-hook ',buffers) 309 (add-hook 'after-change-major-mode-hook ',buffers)
310 (add-hook 'change-major-mode-hook ',cmmh)) 310 (add-hook 'change-major-mode-hook ',cmmh))
311 (remove-hook 'find-file-hook ',buffers) 311 (remove-hook 'after-change-major-mode-hook ',buffers)
312 (remove-hook 'change-major-mode-hook ',cmmh)) 312 (remove-hook 'change-major-mode-hook ',cmmh))
313 313
314 ;; Go through existing buffers. 314 ;; Go through existing buffers.
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
index c9f1769ae14..b3160c9b752 100644
--- a/lisp/emacs-lisp/easymenu.el
+++ b/lisp/emacs-lisp/easymenu.el
@@ -471,11 +471,15 @@ Contrary to XEmacs, this is a nop on Emacs since menus are automatically
471 471
472(defun easy-menu-add (menu &optional map) 472(defun easy-menu-add (menu &optional map)
473 "Add the menu to the menubar. 473 "Add the menu to the menubar.
474This is a nop on Emacs since menus are automatically activated when the 474On Emacs, menus are already automatically activated when the
475corresponding keymap is activated. On XEmacs this is needed to actually 475corresponding keymap is activated. On XEmacs this is needed to
476add the menu to the current menubar. 476actually add the menu to the current menubar.
477Maybe precalculate equivalent key bindings. 477
478Do it only if `easy-menu-precalculate-equivalent-keybindings' is on." 478This also precalculates equivalent key bindings when
479`easy-menu-precalculate-equivalent-keybindings' is on.
480
481You should call this once the menu and keybindings are set up
482completely and menu filter functions can be expected to work."
479 (when easy-menu-precalculate-equivalent-keybindings 483 (when easy-menu-precalculate-equivalent-keybindings
480 (if (and (symbolp menu) (not (keymapp menu)) (boundp menu)) 484 (if (and (symbolp menu) (not (keymapp menu)) (boundp menu))
481 (setq menu (symbol-value menu))) 485 (setq menu (symbol-value menu)))
diff --git a/lisp/emulation/tpu-extras.el b/lisp/emulation/tpu-extras.el
index 9c417dd3a40..427ef19bccd 100644
--- a/lisp/emulation/tpu-extras.el
+++ b/lisp/emulation/tpu-extras.el
@@ -144,9 +144,9 @@ the previous line when starting from a line beginning."
144 "Eliminate whitespace at ends of lines, if the cursor is free." 144 "Eliminate whitespace at ends of lines, if the cursor is free."
145 (if (and (buffer-modified-p) tpu-cursor-free) (tpu-trim-line-ends))) 145 (if (and (buffer-modified-p) tpu-cursor-free) (tpu-trim-line-ends)))
146 146
147(or (memq 'tpu-write-file-hook write-file-hooks) 147(or (memq 'tpu-write-file-hook write-file-functions)
148 (setq write-file-hooks 148 (setq write-file-functions
149 (cons 'tpu-write-file-hook write-file-hooks))) 149 (cons 'tpu-write-file-hook write-file-functions)))
150 150
151 151
152;;; Utility routines for implementing scroll margins 152;;; Utility routines for implementing scroll margins
diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el
index 7e8a5cbeb99..c29e0e26ba5 100644
--- a/lisp/emulation/viper-ex.el
+++ b/lisp/emulation/viper-ex.el
@@ -67,10 +67,10 @@
67;;; Variables 67;;; Variables
68 68
69(defconst viper-ex-work-buf-name " *ex-working-space*") 69(defconst viper-ex-work-buf-name " *ex-working-space*")
70(defconst viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name)) 70(defvar viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
71(defconst viper-ex-tmp-buf-name " *ex-tmp*") 71(defconst viper-ex-tmp-buf-name " *ex-tmp*")
72(defconst viper-ex-print-buf-name " *ex-print*") 72(defconst viper-ex-print-buf-name " *ex-print*")
73(defconst viper-ex-print-buf (get-buffer-create viper-ex-print-buf-name)) 73(defvar viper-ex-print-buf (get-buffer-create viper-ex-print-buf-name))
74 74
75 75
76;;; ex-commands... 76;;; ex-commands...
diff --git a/lisp/faces.el b/lisp/faces.el
index f4522c8a155..5f19ba7a880 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -1844,9 +1844,22 @@ created."
1844 :group 'modeline 1844 :group 'modeline
1845 :group 'basic-faces) 1845 :group 'basic-faces)
1846 1846
1847(defface mode-line-highlight
1848 '((((class color) (min-colors 88) (background light))
1849 :background "RoyalBlue4" :foreground "white")
1850 (((class color) (min-colors 88) (background dark))
1851 :background "light sky blue" :foreground "black")
1852 (t
1853 :inverse-video t))
1854 "Basic mode line face for highlighting."
1855 :version "22.1"
1856 :group 'modeline
1857 :group 'basic-faces)
1858
1847;; Make `modeline' an alias for `mode-line', for compatibility. 1859;; Make `modeline' an alias for `mode-line', for compatibility.
1848(put 'modeline 'face-alias 'mode-line) 1860(put 'modeline 'face-alias 'mode-line)
1849(put 'modeline-inactive 'face-alias 'mode-line-inactive) 1861(put 'modeline-inactive 'face-alias 'mode-line-inactive)
1862(put 'modeline-higilight 'face-alias 'mode-line-highlight)
1850 1863
1851(defface header-line 1864(defface header-line
1852 '((default 1865 '((default
diff --git a/lisp/files.el b/lisp/files.el
index d519f041152..4602b4e1efa 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -1744,7 +1744,7 @@ in that case, this function acts as if `enable-local-variables' were t."
1744 (mapc 1744 (mapc
1745 (lambda (elt) 1745 (lambda (elt)
1746 (cons (purecopy (car elt)) (cdr elt))) 1746 (cons (purecopy (car elt)) (cdr elt)))
1747 '(;; do this first, so that .html.pl is Polish html, not Perl 1747 `(;; do this first, so that .html.pl is Polish html, not Perl
1748 ("\\.s?html?\\(\\.[a-zA-Z_]+\\)?\\'" . html-mode) 1748 ("\\.s?html?\\(\\.[a-zA-Z_]+\\)?\\'" . html-mode)
1749 ("\\.te?xt\\'" . text-mode) 1749 ("\\.te?xt\\'" . text-mode)
1750 ("\\.[tT]e[xX]\\'" . tex-mode) 1750 ("\\.[tT]e[xX]\\'" . tex-mode)
@@ -1762,9 +1762,12 @@ in that case, this function acts as if `enable-local-variables' were t."
1762 ("\\.ad[abs]\\'" . ada-mode) 1762 ("\\.ad[abs]\\'" . ada-mode)
1763 ("\\.ad[bs].dg\\'" . ada-mode) 1763 ("\\.ad[bs].dg\\'" . ada-mode)
1764 ("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode) 1764 ("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode)
1765 ("\\.mk\\'" . makefile-gmake-mode) ; Might be any make, give Gnu the host advantage
1766 ("[Mm]akefile\\'" . makefile-mode)
1767 ("GNUmakefile\\'" . makefile-gmake-mode) 1765 ("GNUmakefile\\'" . makefile-gmake-mode)
1766 ,@(if (memq system-type '(berkeley-unix next-mach darwin))
1767 '(("\\.mk\\'" . makefile-bsdmake-mode)
1768 ("[Mm]akefile\\'" . makefile-bsdmake-mode))
1769 '(("\\.mk\\'" . makefile-gmake-mode) ; Might be any make, give Gnu the host advantage
1770 ("[Mm]akefile\\'" . makefile-mode)))
1768 ("Makeppfile\\'" . makefile-makepp-mode) 1771 ("Makeppfile\\'" . makefile-makepp-mode)
1769 ("\\.am\\'" . makefile-automake-mode) 1772 ("\\.am\\'" . makefile-automake-mode)
1770 ;; Less common extensions come here 1773 ;; Less common extensions come here
diff --git a/lisp/font-core.el b/lisp/font-core.el
index a077ce756c0..056c1b3515b 100644
--- a/lisp/font-core.el
+++ b/lisp/font-core.el
@@ -231,24 +231,20 @@ this function onto `change-major-mode-hook'."
231;; hook is run, the major mode is in the process of being changed and we do not 231;; hook is run, the major mode is in the process of being changed and we do not
232;; know what the final major mode will be. So, `font-lock-change-major-mode' 232;; know what the final major mode will be. So, `font-lock-change-major-mode'
233;; only (a) notes the name of the current buffer, and (b) adds our function 233;; only (a) notes the name of the current buffer, and (b) adds our function
234;; `turn-on-font-lock-if-enabled' to the hook variables `find-file-hook' and 234;; `turn-on-font-lock-if-enabled' to the hook variables
235;; `post-command-hook' (for buffers that are not visiting files). By the time 235;; `after-change-major-mode-hook' and `post-command-hook' (for modes
236;; that do not yet run `after-change-major-mode-hook'). By the time
236;; the functions on the first of these hooks to be run are run, the new major 237;; the functions on the first of these hooks to be run are run, the new major
237;; mode is assumed to be in place. This way we get a Font Lock function run 238;; mode is assumed to be in place. This way we get a Font Lock function run
238;; when a major mode is turned on, without knowing major modes or their hooks. 239;; when a major mode is turned on, without knowing major modes or their hooks.
239;; 240;;
240;; Naturally this requires that (a) major modes run `kill-all-local-variables', 241;; Naturally this requires that major modes run `kill-all-local-variables'
241;; as they are supposed to do, and (b) the major mode is in place after the 242;; and `after-change-major-mode-hook', as they are supposed to. For modes
242;; file is visited or the command that ran `kill-all-local-variables' has 243;; that do not run `after-change-major-mode-hook' yet, `post-command-hook'
243;; finished, whichever the sooner. Arguably, any major mode that does not 244;; takes care of things if the mode is set directly or indirectly by
244;; follow the convension (a) is broken, and I can't think of any reason why (b) 245;; an interactive command; however, problems can occur if the mode is
245;; would not be met (except `gnudoit' on non-files). However, it is not clean. 246;; set by a timer or process: in that case, proper handling of Font Lock mode
246;; 247;; may be delayed until the next interactive command.
247;; Probably the cleanest solution is to have each major mode function run some
248;; hook, e.g., `major-mode-hook', but maybe implementing that change is
249;; impractical. I am personally against making `setq' a macro or be advised,
250;; or have a special function such as `set-major-mode', but maybe someone can
251;; come up with another solution?
252 248
253;; User interface. 249;; User interface.
254;; 250;;
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 5065553121d..8ef14191a0a 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -563,11 +563,11 @@ is not in a string or comment and not within any bracket-pairs (or else,
563a place such that any bracket-pairs outside it can be ignored for Emacs 563a place such that any bracket-pairs outside it can be ignored for Emacs
564syntax analysis and fontification). 564syntax analysis and fontification).
565 565
566If this is nil, the beginning of the buffer is used, which is 566If this is nil, Font Lock uses `syntax-begin-function' to move back
567always correct but tends to be slow. 567outside of any comment, string, or sexp. This variable is semi-obsolete;
568This is normally set via `font-lock-defaults'. 568we recommend setting `syntax-begin-function' instead.
569This variable is semi-obsolete; we recommend setting 569
570`syntax-begin-function' instead.") 570This is normally set via `font-lock-defaults'.")
571 571
572(defvar font-lock-mark-block-function nil 572(defvar font-lock-mark-block-function nil
573 "*Non-nil means use this function to mark a block of text. 573 "*Non-nil means use this function to mark a block of text.
@@ -2054,19 +2054,22 @@ This function could be MATCHER in a MATCH-ANCHORED `font-lock-keywords' item."
2054 ("\\<:\\sw+\\>" 0 font-lock-builtin-face) 2054 ("\\<:\\sw+\\>" 0 font-lock-builtin-face)
2055 ;; ELisp and CLisp `&' keywords as types. 2055 ;; ELisp and CLisp `&' keywords as types.
2056 ("\\&\\sw+\\>" . font-lock-type-face) 2056 ("\\&\\sw+\\>" . font-lock-type-face)
2057 ;; Make regexp grouping constructs bold, so they stand out, but only in strings. 2057 ;; Make regexp grouping constructs bold, so they stand out, but only
2058 ;; in strings.
2058 ((lambda (bound) 2059 ((lambda (bound)
2059 (if (re-search-forward "\\([\\][\\]\\)\\([(|)]\\)\\(\\?:\\)?" bound) 2060 (if (re-search-forward "\\(\\\\\\\\\\)\\([(|)]\\)\\(\\?:\\)?" bound t)
2060 (let ((face (get-text-property (1- (point)) 'face))) 2061 (let ((face (get-text-property (1- (point)) 'face)))
2061 (if (listp face) 2062 (if (listp face)
2062 (memq 'font-lock-string-face face) 2063 (memq 'font-lock-string-face face)
2063 (eq 'font-lock-string-face face))))) 2064 (eq 'font-lock-string-face face)))))
2064 (1 font-lock-comment-face prepend) ; Should we introduce a lowlight face for this? 2065 ;; Should we introduce a lowlight face for this?
2065 ; Ideally that would retain the color, dimmed 50%. 2066 ;; Ideally that would retain the color, dimmed.
2067 (1 font-lock-comment-face prepend)
2066 (2 'bold prepend) 2068 (2 'bold prepend)
2067 (3 font-lock-type-face prepend t)) 2069 (3 font-lock-type-face prepend t))
2068 ;; Underline innermost grouping, so that you can more easily see what belongs together. 2070 ;; Underline innermost grouping, so that you can more easily see what
2069 ;; 2005-05-12: Font-lock can go into an unbreakable endless loop on this -- something's broken. 2071 ;; belongs together. 2005-05-12: Font-lock can go into an
2072 ;; unbreakable endless loop on this -- something's broken.
2070 ;;("[\\][\\][(]\\(?:\\?:\\)?\\(\\(?:[^\\\"]+\\|[\\]\\(?:[^\\]\\|[\\][^(]\\)\\)+?\\)[\\][\\][)]" 2073 ;;("[\\][\\][(]\\(?:\\?:\\)?\\(\\(?:[^\\\"]+\\|[\\]\\(?:[^\\]\\|[\\][^(]\\)\\)+?\\)[\\][\\][)]"
2071 ;;1 'underline prepend) 2074 ;;1 'underline prepend)
2072;;; This is too general -- rms. 2075;;; This is too general -- rms.
diff --git a/lisp/help.el b/lisp/help.el
index 76fc43d63ef..3323c329c97 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -698,8 +698,8 @@ the last key hit are used."
698 (princ " runs the command ") 698 (princ " runs the command ")
699 (prin1 defn) 699 (prin1 defn)
700 (princ "\n which is ") 700 (princ "\n which is ")
701 (describe-function-1 defn)))) 701 (describe-function-1 defn)))))
702 (print-help-return-message)))))))) 702 (print-help-return-message)))))))
703 703
704 704
705(defun describe-mode (&optional buffer) 705(defun describe-mode (&optional buffer)
diff --git a/lisp/hexl.el b/lisp/hexl.el
index 35674e1d10a..db6edfa48c1 100644
--- a/lisp/hexl.el
+++ b/lisp/hexl.el
@@ -926,10 +926,11 @@ Customize the variable `hexl-follow-ascii' to disable this feature."
926 "Activate `hl-line-mode'" 926 "Activate `hl-line-mode'"
927 (require 'frame) 927 (require 'frame)
928 (require 'hl-line) 928 (require 'hl-line)
929 (set (make-local-variable 'hl-line-range-function) 929 (with-no-warnings
930 'hexl-highlight-line-range) 930 (set (make-local-variable 'hl-line-range-function)
931 (set (make-local-variable 'hl-line-face) 931 'hexl-highlight-line-range)
932 'highlight) 932 (set (make-local-variable 'hl-line-face)
933 'highlight))
933 (hl-line-mode 1)) 934 (hl-line-mode 1))
934 935
935(defun hexl-highlight-line-range () 936(defun hexl-highlight-line-range ()
diff --git a/lisp/imenu.el b/lisp/imenu.el
index 92e00282ea0..0ebdbc4b5f3 100644
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -192,32 +192,9 @@ with name concatenation."
192(defvar imenu-generic-expression nil 192(defvar imenu-generic-expression nil
193 "The regex pattern to use for creating a buffer index. 193 "The regex pattern to use for creating a buffer index.
194 194
195If non-nil this pattern is passed to `imenu--generic-function' 195If non-nil this pattern is passed to `imenu--generic-function' to
196to create a buffer index. 196create a buffer index. Look there for the documentation of this
197 197pattern's structure.
198The value should be an alist with elements that look like this:
199 (MENU-TITLE REGEXP INDEX)
200or like this:
201 (MENU-TITLE REGEXP INDEX FUNCTION ARGUMENTS...)
202with zero or more ARGUMENTS. The former format creates a simple element in
203the index alist when it matches; the latter creates a special element
204of the form (NAME POSITION-MARKER FUNCTION ARGUMENTS...)
205with FUNCTION and ARGUMENTS copied from `imenu-generic-expression'.
206
207MENU-TITLE is a string used as the title for the submenu or nil if the
208entries are not nested.
209
210REGEXP is a regexp that should match a construct in the buffer that is
211to be displayed in the menu; i.e., function or variable definitions,
212etc. It contains a substring which is the name to appear in the
213menu. See the info section on Regexps for more information.
214
215INDEX points to the substring in REGEXP that contains the name (of the
216function, variable or type) that is to appear in the menu.
217
218The variable `imenu-case-fold-search' determines whether or not the
219regexp matches are case sensitive, and `imenu-syntax-alist' can be
220used to alter the syntax table for the search.
221 198
222For example, see the value of `fortran-imenu-generic-expression' used by 199For example, see the value of `fortran-imenu-generic-expression' used by
223`fortran-mode' with `imenu-syntax-alist' set locally to give the 200`fortran-mode' with `imenu-syntax-alist' set locally to give the
@@ -750,21 +727,33 @@ for modes which use `imenu--generic-function'. If it is not set, but
750 "Return an index of the current buffer as an alist. 727 "Return an index of the current buffer as an alist.
751 728
752PATTERNS is an alist with elements that look like this: 729PATTERNS is an alist with elements that look like this:
753 (MENU-TITLE REGEXP INDEX). 730 (MENU-TITLE REGEXP INDEX)
754or like this: 731or like this:
755 (MENU-TITLE REGEXP INDEX FUNCTION ARGUMENTS...) 732 (MENU-TITLE REGEXP INDEX FUNCTION ARGUMENTS...)
756with zero or more ARGUMENTS. 733with zero or more ARGUMENTS. The former format creates a simple
757 734element in the index alist when it matches; the latter creates a
758MENU-TITLE is a string used as the title for the submenu or nil if the 735special element of the form (NAME POSITION-MARKER FUNCTION
759entries are not nested. 736ARGUMENTS...) with FUNCTION and ARGUMENTS copied from
737`imenu-generic-expression'.
738
739MENU-TITLE is a string used as the title for the submenu or nil
740if the entries are not nested.
741
742REGEXP is a regexp that should match a construct in the buffer
743that is to be displayed in the menu; i.e., function or variable
744definitions, etc. It contains a substring which is the name to
745appear in the menu. See the info section on Regexps for more
746information. REGEXP may also be a function, called without
747arguments. It is expected to search backwards. It shall return
748true and set `match-data' iff it finds another element.
749
750INDEX points to the substring in REGEXP that contains the
751name (of the function, variable or type) that is to appear in the
752menu.
760 753
761REGEXP is a regexp that should match a construct in the buffer that is 754The variable `imenu-case-fold-search' determines whether or not the
762to be displayed in the menu; i.e., function or variable definitions, 755regexp matches are case sensitive, and `imenu-syntax-alist' can be
763etc. It contains a substring which is the name to appear in the 756used to alter the syntax table for the search.
764menu. See the info section on Regexps for more information.
765
766INDEX points to the substring in REGEXP that contains the name (of the
767function, variable or type) that is to appear in the menu.
768 757
769See `lisp-imenu-generic-expression' for an example of PATTERNS. 758See `lisp-imenu-generic-expression' for an example of PATTERNS.
770 759
@@ -811,7 +800,9 @@ depending on PATTERNS."
811 start beg) 800 start beg)
812 ;; Go backwards for convenience of adding items in order. 801 ;; Go backwards for convenience of adding items in order.
813 (goto-char (point-max)) 802 (goto-char (point-max))
814 (while (and (re-search-backward regexp nil t) 803 (while (and (if (functionp regexp)
804 (funcall regexp)
805 (re-search-backward regexp nil t))
815 ;; Exit the loop if we get an empty match, 806 ;; Exit the loop if we get an empty match,
816 ;; because it means a bad regexp was specified. 807 ;; because it means a bad regexp was specified.
817 (not (= (match-beginning 0) (match-end 0)))) 808 (not (= (match-beginning 0) (match-end 0))))
diff --git a/lisp/language/viet-util.el b/lisp/language/viet-util.el
index c854238b6a4..0b552a61fe5 100644
--- a/lisp/language/viet-util.el
+++ b/lisp/language/viet-util.el
@@ -41,6 +41,8 @@
41 41
42;;; Code: 42;;; Code:
43 43
44(defvar viet-viscii-nonascii-translation-table)
45
44;;;###autoload 46;;;###autoload
45(defun viet-encode-viscii-char (char) 47(defun viet-encode-viscii-char (char)
46 "Return VISCII character code of CHAR if appropriate." 48 "Return VISCII character code of CHAR if appropriate."
diff --git a/lisp/log-edit.el b/lisp/log-edit.el
index 1fa48b65aee..09116e0584f 100644
--- a/lisp/log-edit.el
+++ b/lisp/log-edit.el
@@ -607,8 +607,12 @@ where LOGBUFFER is the name of the ChangeLog buffer, and each
607 (search-forward pattern nil t)))) 607 (search-forward pattern nil t))))
608 (setq pattern (file-name-nondirectory file))) 608 (setq pattern (file-name-nondirectory file)))
609 609
610 (setq pattern (concat "\\(^\\|[^[:alnum:]]\\)"
611 pattern
612 "\\($\\|[^[:alnum:]]\\)"))
613
610 (let (texts) 614 (let (texts)
611 (while (search-forward pattern nil t) 615 (while (re-search-forward pattern nil t)
612 (let ((entry (log-edit-changelog-entry))) 616 (let ((entry (log-edit-changelog-entry)))
613 (push entry texts) 617 (push entry texts)
614 (goto-char (elt entry 1)))) 618 (goto-char (elt entry 1))))
@@ -646,5 +650,5 @@ Sort REGIONS front-to-back first."
646 650
647(provide 'log-edit) 651(provide 'log-edit)
648 652
649;;; arch-tag: 8089b39c-983b-4e83-93cd-ed0a64c7fdcc 653;; arch-tag: 8089b39c-983b-4e83-93cd-ed0a64c7fdcc
650;;; log-edit.el ends here 654;;; log-edit.el ends here
diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el
index 88f166707c3..d4c5c2c3261 100644
--- a/lisp/mail/mailalias.el
+++ b/lisp/mail/mailalias.el
@@ -435,7 +435,7 @@ PATTERN is the string we want to complete."
435 (if mail-passwd-command 435 (if mail-passwd-command
436 (call-process shell-file-name nil t nil 436 (call-process shell-file-name nil t nil
437 shell-command-switch mail-passwd-command)) 437 shell-command-switch mail-passwd-command))
438 (beginning-of-buffer) 438 (goto-char (point-min))
439 (setq mail-local-names nil) 439 (setq mail-local-names nil)
440 (while (not (eobp)) 440 (while (not (eobp))
441 ;;Recognize lines like 441 ;;Recognize lines like
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 858eeff40bf..3fa8b3df3cd 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -3444,7 +3444,11 @@ use \\[mail-yank-original] to yank the original message into it."
3444 ;; I don't know whether there are other mailers that still 3444 ;; I don't know whether there are other mailers that still
3445 ;; need the names to be stripped. 3445 ;; need the names to be stripped.
3446;;; (mail-strip-quoted-names reply-to) 3446;;; (mail-strip-quoted-names reply-to)
3447 reply-to 3447 ;; Remove unwanted names from reply-to, since Mail-Followup-To
3448 ;; header causes all the names in it to wind up in reply-to, not
3449 ;; in cc. But if what's left is an empty list, use the original.
3450 (let* ((reply-to-list (rmail-dont-reply-to reply-to)))
3451 (if (string= reply-to-list "") reply-to reply-to-list))
3448 subject 3452 subject
3449 (rmail-make-in-reply-to-field from date message-id) 3453 (rmail-make-in-reply-to-field from date message-id)
3450 (if just-sender 3454 (if just-sender
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index 5667aa85ff1..73f99263da2 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -810,7 +810,8 @@ the user from the mailer."
810 '(lambda (e) 810 '(lambda (e)
811 (unless (member e l) 811 (unless (member e l)
812 (push e l))) 812 (push e l)))
813 (split-string new-header-values ", +" t)) 813 (split-string new-header-values
814 ",[[:space:]]+" t))
814 (mapconcat 'identity l ", ")) 815 (mapconcat 'identity l ", "))
815 "\n")) 816 "\n"))
816 ;; Add Mail-Reply-To if none yet 817 ;; Add Mail-Reply-To if none yet
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index 3cf17f8968d..931e1417a2d 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -396,7 +396,7 @@ This is relative to `smtpmail-queue-dir'.")
396 ;;; mail, send it, etc... 396 ;;; mail, send it, etc...
397 (let ((file-msg "")) 397 (let ((file-msg ""))
398 (insert-file-contents smtpmail-queue-index) 398 (insert-file-contents smtpmail-queue-index)
399 (beginning-of-buffer) 399 (goto-char (point-min))
400 (while (not (eobp)) 400 (while (not (eobp))
401 (setq file-msg (buffer-substring (point) (line-end-position))) 401 (setq file-msg (buffer-substring (point) (line-end-position)))
402 (load file-msg) 402 (load file-msg)
@@ -465,11 +465,14 @@ This is relative to `smtpmail-queue-dir'.")
465 (push el2 result))) 465 (push el2 result)))
466 (nreverse result))) 466 (nreverse result)))
467 467
468(defvar starttls-extra-args)
469(defvar starttls-extra-arguments)
470
468(defun smtpmail-open-stream (process-buffer host port) 471(defun smtpmail-open-stream (process-buffer host port)
469 (let ((cred (smtpmail-find-credentials 472 (let ((cred (smtpmail-find-credentials
470 smtpmail-starttls-credentials host port))) 473 smtpmail-starttls-credentials host port)))
471 (if (null (and cred (condition-case () 474 (if (null (and cred (condition-case ()
472 (progn 475 (with-no-warnings
473 (require 'starttls) 476 (require 'starttls)
474 (call-process (if starttls-use-gnutls 477 (call-process (if starttls-use-gnutls
475 starttls-gnutls-program 478 starttls-gnutls-program
diff --git a/lisp/net/rcompile.el b/lisp/net/rcompile.el
index c9078ac2d76..6928b2f4943 100644
--- a/lisp/net/rcompile.el
+++ b/lisp/net/rcompile.el
@@ -168,7 +168,7 @@ See \\[compile]."
168 compile-command))) 168 compile-command)))
169 (setq remote-compile-host host) 169 (setq remote-compile-host host)
170 (save-some-buffers nil nil) 170 (save-some-buffers nil nil)
171 (compile-internal compile-command "No more errors") 171 (compilation-start compile-command)
172 ;; Set comint-file-name-prefix in the compilation buffer so 172 ;; Set comint-file-name-prefix in the compilation buffer so
173 ;; compilation-parse-errors will find referenced files by ange-ftp. 173 ;; compilation-parse-errors will find referenced files by ange-ftp.
174 (with-current-buffer compilation-last-buffer 174 (with-current-buffer compilation-last-buffer
diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el
index c5dd091f291..139bfc8aa5a 100644
--- a/lisp/progmodes/cc-align.el
+++ b/lisp/progmodes/cc-align.el
@@ -24,9 +24,9 @@
24;; GNU General Public License for more details. 24;; GNU General Public License for more details.
25 25
26;; You should have received a copy of the GNU General Public License 26;; You should have received a copy of the GNU General Public License
27;; along with GNU Emacs; see the file COPYING. If not, write to 27;; along with this program; see the file COPYING. If not, write to
28;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 28;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
29;; Boston, MA 02111-1307, USA. 29;; Boston, MA 02110-1301, USA.
30 30
31;;; Commentary: 31;;; Commentary:
32 32
@@ -175,7 +175,8 @@ Works with: arglist-cont, arglist-cont-nonempty."
175 (let ((open-paren (elt c-syntactic-element 2)) 175 (let ((open-paren (elt c-syntactic-element 2))
176 (paren-state (c-parse-state))) 176 (paren-state (c-parse-state)))
177 (while (not (eq (car paren-state) open-paren)) 177 (while (not (eq (car paren-state) open-paren))
178 (goto-char (car paren-state)) 178 (unless (consp (car paren-state)) ;; ignore matched braces
179 (goto-char (car paren-state)))
179 (setq paren-state (cdr paren-state))))) 180 (setq paren-state (cdr paren-state)))))
180 181
181 (let ((start (point)) c) 182 (let ((start (point)) c)
@@ -1171,6 +1172,7 @@ Otherwise, no determination is made."
1171 ;;(/= (point-max) 1172 ;;(/= (point-max)
1172 ;; (save-excursion (skip-syntax-forward " ") (point)) 1173 ;; (save-excursion (skip-syntax-forward " ") (point))
1173 (zerop (forward-line 1)) 1174 (zerop (forward-line 1))
1175 (bolp) ; forward-line has funny behavior at eob.
1174 (not (looking-at "^[ \t]*$"))) 1176 (not (looking-at "^[ \t]*$")))
1175 'stop 1177 'stop
1176 nil))) 1178 nil)))
diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el
index dbcfa9d991e..419803a7ada 100644
--- a/lisp/progmodes/cc-awk.el
+++ b/lisp/progmodes/cc-awk.el
@@ -2,7 +2,7 @@
2 2
3;; Copyright (C) 1988,94,96,2000,01,02,03 Free Software Foundation, Inc. 3;; Copyright (C) 1988,94,96,2000,01,02,03 Free Software Foundation, Inc.
4 4
5;; Author: Alan Mackenzie (originally based on awk-mode.el) 5;; Author: Alan Mackenzie <acm@muc.de> (originally based on awk-mode.el)
6;; Maintainer: FSF 6;; Maintainer: FSF
7;; Keywords: AWK, cc-mode, unix, languages 7;; Keywords: AWK, cc-mode, unix, languages
8 8
@@ -526,13 +526,22 @@
526;; Matches any AWK regexp character which doesn't require special analysis. 526;; Matches any AWK regexp character which doesn't require special analysis.
527(defconst c-awk-escaped-newlines*-re "\\(\\\\[\n\r]\\)*") 527(defconst c-awk-escaped-newlines*-re "\\(\\\\[\n\r]\\)*")
528;; Matches a (possibly empty) sequence of escaped newlines. 528;; Matches a (possibly empty) sequence of escaped newlines.
529
530;; NOTE: In what follows, "[asdf]" in a regexp will be called a "character
531;; list", and "[:alpha:]" inside a character list will be known as a
532;; "character class". These terms for these things vary between regexp
533;; descriptions .
529(defconst c-awk-regexp-char-class-re 534(defconst c-awk-regexp-char-class-re
535 "\\[:[a-z]+:\\]")
536 ;; Matches a character class spec (e.g. [:alpha:]).
537(defconst c-awk-regexp-char-list-re
530 (concat "\\[" c-awk-escaped-newlines*-re "^?" c-awk-escaped-newlines*-re "]?" 538 (concat "\\[" c-awk-escaped-newlines*-re "^?" c-awk-escaped-newlines*-re "]?"
531 "\\(" c-awk-esc-pair-re "\\|" "[^]\n\r]" "\\)*" "\\(]\\|$\\)")) 539 "\\(" c-awk-esc-pair-re "\\|" c-awk-regexp-char-class-re
532;; Matches a regexp char class, up to (but not including) EOL if the ] is 540 "\\|" "[^]\n\r]" "\\)*" "\\(]\\|$\\)"))
541;; Matches a regexp char list, up to (but not including) EOL if the ] is
533;; missing. 542;; missing.
534(defconst c-awk-regexp-innards-re 543(defconst c-awk-regexp-innards-re
535 (concat "\\(" c-awk-esc-pair-re "\\|" c-awk-regexp-char-class-re 544 (concat "\\(" c-awk-esc-pair-re "\\|" c-awk-regexp-char-list-re
536 "\\|" c-awk-regexp-normal-re "\\)*")) 545 "\\|" c-awk-regexp-normal-re "\\)*"))
537;; Matches the inside of an AWK regexp (i.e. without the enclosing /s) 546;; Matches the inside of an AWK regexp (i.e. without the enclosing /s)
538(defconst c-awk-regexp-without-end-re 547(defconst c-awk-regexp-without-end-re
@@ -549,7 +558,7 @@
549;; A "neutral" char(pair). Doesn't change the "state" of a subsequent /. 558;; A "neutral" char(pair). Doesn't change the "state" of a subsequent /.
550;; This is space/tab, braces, an auto-increment/decrement operator or an 559;; This is space/tab, braces, an auto-increment/decrement operator or an
551;; escaped character. Or one of the (illegal) characters @ or `. But NOT an 560;; escaped character. Or one of the (illegal) characters @ or `. But NOT an
552;; end of line (even if escpaed). 561;; end of line (even if escaped).
553(defconst c-awk-neutrals*-re 562(defconst c-awk-neutrals*-re
554 (concat "\\(" c-awk-neutral-re "\\)*")) 563 (concat "\\(" c-awk-neutral-re "\\)*"))
555;; A (possibly empty) string of neutral characters (or character pairs). 564;; A (possibly empty) string of neutral characters (or character pairs).
diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el
index 806fbade693..7be8e370f07 100644
--- a/lisp/progmodes/cc-cmds.el
+++ b/lisp/progmodes/cc-cmds.el
@@ -2441,7 +2441,8 @@ command to conveniently insert and align the necessary backslashes."
2441 (delete-region (point) end) 2441 (delete-region (point) end)
2442 (indent-to column 1))) 2442 (indent-to column 1)))
2443 2443
2444 (= (forward-line 1) 0)))) 2444 (zerop (forward-line 1)))
2445 (bolp))) ; forward-line has funny behavior at eob.
2445 2446
2446 ;; Make sure there are backslashes with at least one space in 2447 ;; Make sure there are backslashes with at least one space in
2447 ;; front of them. 2448 ;; front of them.
@@ -2466,7 +2467,8 @@ command to conveniently insert and align the necessary backslashes."
2466 (insert ?\\) 2467 (insert ?\\)
2467 (insert ?\ ?\\))) 2468 (insert ?\ ?\\)))
2468 2469
2469 (= (forward-line 1) 0))))))) 2470 (zerop (forward-line 1)))
2471 (bolp)))))) ; forward-line has funny behavior at eob.
2470 2472
2471(defun c-delete-backslashes-forward (to-mark point-pos) 2473(defun c-delete-backslashes-forward (to-mark point-pos)
2472 ;; This function does not do any hidden buffer changes. 2474 ;; This function does not do any hidden buffer changes.
@@ -2481,7 +2483,8 @@ command to conveniently insert and align the necessary backslashes."
2481 (skip-chars-backward " \t" (if (>= (point) point-pos) 2483 (skip-chars-backward " \t" (if (>= (point) point-pos)
2482 point-pos)) 2484 point-pos))
2483 (point)))) 2485 (point))))
2484 (= (forward-line 1) 0))))) 2486 (zerop (forward-line 1)))
2487 (bolp)))) ; forward-line has funny behavior at eob.
2485 2488
2486 2489
2487 2490
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index 64f3a72f56f..d9caca90666 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -104,7 +104,7 @@
104 104
105;;; Variables also used at compile time. 105;;; Variables also used at compile time.
106 106
107(defconst c-version "5.30.9" 107(defconst c-version "5.30.10"
108 "CC Mode version number.") 108 "CC Mode version number.")
109 109
110(defconst c-version-sym (intern c-version)) 110(defconst c-version-sym (intern c-version))
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 0a4cb6c8cd6..e9ed474e792 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -24,9 +24,9 @@
24;; GNU General Public License for more details. 24;; GNU General Public License for more details.
25 25
26;; You should have received a copy of the GNU General Public License 26;; You should have received a copy of the GNU General Public License
27;; along with GNU Emacs; see the file COPYING. If not, write to 27;; along with this program; see the file COPYING. If not, write to
28;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 28;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
29;; Boston, MA 02111-1307, USA. 29;; Boston, MA 02110-1301, USA.
30 30
31;;; Commentary: 31;;; Commentary:
32 32
@@ -3198,6 +3198,7 @@ This function does not do any hidden buffer changes."
3198 ;; when font-lock refontifies the current line only. 3198 ;; when font-lock refontifies the current line only.
3199 (when (save-excursion 3199 (when (save-excursion
3200 (and (= (forward-line 1) 0) 3200 (and (= (forward-line 1) 0)
3201 (bolp) ; forward-line has funny behavior at eob.
3201 (or (< (c-point 'eol) cfd-limit) 3202 (or (< (c-point 'eol) cfd-limit)
3202 (progn (backward-char) 3203 (progn (backward-char)
3203 (not (eq (char-before) ?\\)))))) 3204 (not (eq (char-before) ?\\))))))
@@ -4551,7 +4552,7 @@ brace."
4551 ;; operator token preceded by "operator". 4552 ;; operator token preceded by "operator".
4552 (save-excursion 4553 (save-excursion
4553 (and (c-safe (c-backward-sexp) t) 4554 (and (c-safe (c-backward-sexp) t)
4554 (looking-at "operator\\([^_]\\|$\\)"))) 4555 (looking-at "operator\\>\\([^_]\\|$\\)")))
4555 (and (eq (char-before) ?<) 4556 (and (eq (char-before) ?<)
4556 (c-with-syntax-table c++-template-syntax-table 4557 (c-with-syntax-table c++-template-syntax-table
4557 (if (c-safe (goto-char (c-up-list-forward (point)))) 4558 (if (c-safe (goto-char (c-up-list-forward (point))))
@@ -6104,7 +6105,12 @@ This function does not do any hidden buffer changes."
6104 ;; Note: We use the fact that lim is always after any 6105 ;; Note: We use the fact that lim is always after any
6105 ;; preceding brace sexp. 6106 ;; preceding brace sexp.
6106 (while (and (zerop (c-backward-token-2 1 t lim)) 6107 (while (and (zerop (c-backward-token-2 1 t lim))
6107 (not (looking-at "[;<,=]")))) 6108 (or (not (looking-at "[;<,=]"))
6109 (and c-overloadable-operators-regexp
6110 (looking-at c-overloadable-operators-regexp)
6111 (save-excursion
6112 (c-backward-token-2 1 nil lim)
6113 (looking-at "operator\\>[^_]"))))))
6108 (or (memq (char-after) '(?, ?=)) 6114 (or (memq (char-after) '(?, ?=))
6109 (and (c-major-mode-is 'c++-mode) 6115 (and (c-major-mode-is 'c++-mode)
6110 (zerop (c-backward-token-2 1 nil lim)) 6116 (zerop (c-backward-token-2 1 nil lim))
@@ -6237,7 +6243,15 @@ This function does not do any hidden buffer changes."
6237 ;; CASE 5I: ObjC method definition. 6243 ;; CASE 5I: ObjC method definition.
6238 ((and c-opt-method-key 6244 ((and c-opt-method-key
6239 (looking-at c-opt-method-key)) 6245 (looking-at c-opt-method-key))
6240 (c-beginning-of-statement-1 lim) 6246 (c-beginning-of-statement-1 nil t)
6247 (if (= (point) indent-point)
6248 ;; Handle the case when it's the first (non-comment)
6249 ;; thing in the buffer. Can't look for a 'same return
6250 ;; value from cbos1 since ObjC directives currently
6251 ;; aren't recognized fully, so that we get 'same
6252 ;; instead of 'previous if it moved over a preceding
6253 ;; directive.
6254 (goto-char (point-min)))
6241 (c-add-syntax 'objc-method-intro (c-point 'boi))) 6255 (c-add-syntax 'objc-method-intro (c-point 'boi)))
6242 ;; CASE 5P: AWK pattern or function or continuation 6256 ;; CASE 5P: AWK pattern or function or continuation
6243 ;; thereof. 6257 ;; thereof.
@@ -6316,11 +6330,13 @@ This function does not do any hidden buffer changes."
6316 ;; CASE 5K: we are at an ObjC method definition 6330 ;; CASE 5K: we are at an ObjC method definition
6317 ;; continuation line. 6331 ;; continuation line.
6318 ((and c-opt-method-key 6332 ((and c-opt-method-key
6319 (progn 6333 (save-excursion
6334 (goto-char indent-point)
6320 (c-beginning-of-statement-1 lim) 6335 (c-beginning-of-statement-1 lim)
6321 (beginning-of-line) 6336 (beginning-of-line)
6322 (looking-at c-opt-method-key))) 6337 (when (looking-at c-opt-method-key)
6323 (c-add-syntax 'objc-method-args-cont (point))) 6338 (setq placeholder (point)))))
6339 (c-add-syntax 'objc-method-args-cont placeholder))
6324 ;; CASE 5L: we are at the first argument of a template 6340 ;; CASE 5L: we are at the first argument of a template
6325 ;; arglist that begins on the previous line. 6341 ;; arglist that begins on the previous line.
6326 ((eq (char-before) ?<) 6342 ((eq (char-before) ?<)
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index 26c0bdaf60f..29946dc4682 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -875,7 +875,7 @@ casts and declarations are fontified. Used on level 2 and higher."
875 ;; with array initializers. Otherwise stop at braces 875 ;; with array initializers. Otherwise stop at braces
876 ;; to avoid going past full function and class blocks. 876 ;; to avoid going past full function and class blocks.
877 (and (if (and (eq got-init ?=) 877 (and (if (and (eq got-init ?=)
878 (= (c-forward-token-2) 0) 878 (= (c-forward-token-2 1 nil limit) 0)
879 (looking-at "{")) 879 (looking-at "{"))
880 (c-safe (c-forward-sexp) t) 880 (c-safe (c-forward-sexp) t)
881 t) 881 t)
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 6a36f89c8d3..94d58c66061 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -1186,7 +1186,7 @@ will be handled."
1186(c-lang-defvar c-brace-list-key (c-lang-const c-brace-list-key)) 1186(c-lang-defvar c-brace-list-key (c-lang-const c-brace-list-key))
1187 1187
1188(c-lang-defconst c-other-block-decl-kwds 1188(c-lang-defconst c-other-block-decl-kwds
1189 "Keywords where the following block (if any) contain another 1189 "Keywords where the following block (if any) contains another
1190declaration level that should not be considered a class. 1190declaration level that should not be considered a class.
1191 1191
1192If any of these also are on `c-type-list-kwds', `c-ref-list-kwds', 1192If any of these also are on `c-type-list-kwds', `c-ref-list-kwds',
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index eaa798217cf..0f17a003ef4 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -24,9 +24,9 @@
24;; GNU General Public License for more details. 24;; GNU General Public License for more details.
25 25
26;; You should have received a copy of the GNU General Public License 26;; You should have received a copy of the GNU General Public License
27;; along with GNU Emacs; see the file COPYING. If not, write to 27;; along with this program; see the file COPYING. If not, write to
28;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 28;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
29;; Boston, MA 02111-1307, USA. 29;; Boston, MA 02110-1301, USA.
30 30
31;;; Commentary: 31;;; Commentary:
32 32
@@ -91,10 +91,12 @@
91(cc-require 'cc-align) 91(cc-require 'cc-align)
92(cc-require 'cc-menus) 92(cc-require 'cc-menus)
93 93
94;; SILENCE the compiler. 94;; Silence the compiler.
95(cc-bytecomp-defvar comment-line-break-function) ; (X)Emacs 20+ 95(cc-bytecomp-defvar comment-line-break-function) ; (X)Emacs 20+
96(cc-bytecomp-defvar adaptive-fill-first-line-regexp) ; Emacs 20+ 96(cc-bytecomp-defvar adaptive-fill-first-line-regexp) ; Emacs 20+
97(cc-bytecomp-defun set-keymap-parents) ; XEmacs 97(cc-bytecomp-defun set-keymap-parents) ; XEmacs
98(cc-bytecomp-defun run-mode-hooks) ; Emacs 21.1+
99(cc-bytecomp-obsolete-fun make-local-hook) ; Marked obsolete in Emacs 21.1.
98 100
99;; We set these variables during mode init, yet we don't require 101;; We set these variables during mode init, yet we don't require
100;; font-lock. 102;; font-lock.
@@ -201,12 +203,15 @@ control). See \"cc-mode.el\" for more info."
201 203
202(defun c-make-inherited-keymap () 204(defun c-make-inherited-keymap ()
203 (let ((map (make-sparse-keymap))) 205 (let ((map (make-sparse-keymap)))
206 ;; Necessary to use `cc-bytecomp-fboundp' below since this
207 ;; function is called from top-level forms that are evaluated
208 ;; while cc-bytecomp is active when one does M-x eval-buffer.
204 (cond 209 (cond
205 ;; XEmacs 210 ;; XEmacs
206 ((fboundp 'set-keymap-parents) 211 ((cc-bytecomp-fboundp 'set-keymap-parents)
207 (set-keymap-parents map c-mode-base-map)) 212 (set-keymap-parents map c-mode-base-map))
208 ;; Emacs 213 ;; Emacs
209 ((fboundp 'set-keymap-parent) 214 ((cc-bytecomp-fboundp 'set-keymap-parent)
210 (set-keymap-parent map c-mode-base-map)) 215 (set-keymap-parent map c-mode-base-map))
211 ;; incompatible 216 ;; incompatible
212 (t (error "CC Mode is incompatible with this version of Emacs"))) 217 (t (error "CC Mode is incompatible with this version of Emacs")))
@@ -587,6 +592,13 @@ Note that the style variables are always made local to the buffer."
587 592
588(add-hook 'hack-local-variables-hook 'c-postprocess-file-styles) 593(add-hook 'hack-local-variables-hook 'c-postprocess-file-styles)
589 594
595(defmacro c-run-mode-hooks (&rest hooks)
596 ;; Emacs 21.1 has introduced a system with delayed mode hooks that
597 ;; require the use of the new function `run-mode-hooks'.
598 (if (cc-bytecomp-fboundp 'run-mode-hooks)
599 `(run-mode-hooks ,@hooks)
600 `(progn ,@(mapcar (lambda (hook) `(run-hooks ,hook)) hooks))))
601
590 602
591;; Support for C 603;; Support for C
592 604
@@ -667,7 +679,7 @@ Key bindings:
667 (c-common-init 'c-mode) 679 (c-common-init 'c-mode)
668 (easy-menu-add c-c-menu) 680 (easy-menu-add c-c-menu)
669 (cc-imenu-init cc-imenu-c-generic-expression) 681 (cc-imenu-init cc-imenu-c-generic-expression)
670 (run-mode-hooks 'c-mode-common-hook 'c-mode-hook) 682 (c-run-mode-hooks 'c-mode-common-hook 'c-mode-hook)
671 (c-update-modeline)) 683 (c-update-modeline))
672 684
673 685
@@ -730,7 +742,7 @@ Key bindings:
730 (c-common-init 'c++-mode) 742 (c-common-init 'c++-mode)
731 (easy-menu-add c-c++-menu) 743 (easy-menu-add c-c++-menu)
732 (cc-imenu-init cc-imenu-c++-generic-expression) 744 (cc-imenu-init cc-imenu-c++-generic-expression)
733 (run-mode-hooks 'c-mode-common-hook 'c++-mode-hook) 745 (c-run-mode-hooks 'c-mode-common-hook 'c++-mode-hook)
734 (c-update-modeline)) 746 (c-update-modeline))
735 747
736 748
@@ -794,7 +806,7 @@ Key bindings:
794 (c-common-init 'objc-mode) 806 (c-common-init 'objc-mode)
795 (easy-menu-add c-objc-menu) 807 (easy-menu-add c-objc-menu)
796 (cc-imenu-init nil 'cc-imenu-objc-function) 808 (cc-imenu-init nil 'cc-imenu-objc-function)
797 (run-mode-hooks 'c-mode-common-hook 'objc-mode-hook) 809 (c-run-mode-hooks 'c-mode-common-hook 'objc-mode-hook)
798 (c-update-modeline)) 810 (c-update-modeline))
799 811
800 812
@@ -864,7 +876,7 @@ Key bindings:
864 (c-common-init 'java-mode) 876 (c-common-init 'java-mode)
865 (easy-menu-add c-java-menu) 877 (easy-menu-add c-java-menu)
866 (cc-imenu-init cc-imenu-java-generic-expression) 878 (cc-imenu-init cc-imenu-java-generic-expression)
867 (run-mode-hooks 'c-mode-common-hook 'java-mode-hook) 879 (c-run-mode-hooks 'c-mode-common-hook 'java-mode-hook)
868 (c-update-modeline)) 880 (c-update-modeline))
869 881
870 882
@@ -922,7 +934,7 @@ Key bindings:
922 (c-common-init 'idl-mode) 934 (c-common-init 'idl-mode)
923 (easy-menu-add c-idl-menu) 935 (easy-menu-add c-idl-menu)
924 ;;(cc-imenu-init cc-imenu-idl-generic-expression) ;TODO 936 ;;(cc-imenu-init cc-imenu-idl-generic-expression) ;TODO
925 (run-mode-hooks 'c-mode-common-hook 'idl-mode-hook) 937 (c-run-mode-hooks 'c-mode-common-hook 'idl-mode-hook)
926 (c-update-modeline)) 938 (c-update-modeline))
927 939
928 940
@@ -984,7 +996,7 @@ Key bindings:
984 (c-common-init 'pike-mode) 996 (c-common-init 'pike-mode)
985 (easy-menu-add c-pike-menu) 997 (easy-menu-add c-pike-menu)
986 ;;(cc-imenu-init cc-imenu-pike-generic-expression) ;TODO 998 ;;(cc-imenu-init cc-imenu-pike-generic-expression) ;TODO
987 (run-mode-hooks 'c-mode-common-hook 'pike-mode-hook) 999 (c-run-mode-hooks 'c-mode-common-hook 'pike-mode-hook)
988 (c-update-modeline)) 1000 (c-update-modeline))
989 1001
990 1002
@@ -1076,7 +1088,7 @@ Key bindings:
1076 ;; in cc-engine.el, just before (defun c-fast-in-literal ... 1088 ;; in cc-engine.el, just before (defun c-fast-in-literal ...
1077 (defalias 'c-in-literal 'c-slow-in-literal) 1089 (defalias 'c-in-literal 'c-slow-in-literal)
1078 1090
1079 (run-mode-hooks 'c-mode-common-hook 'awk-mode-hook) 1091 (c-run-mode-hooks 'c-mode-common-hook 'awk-mode-hook)
1080 (c-update-modeline)) 1092 (c-update-modeline))
1081) ;; closes the (if (not (memq 'syntax-properties c-emacs-features)) 1093) ;; closes the (if (not (memq 'syntax-properties c-emacs-features))
1082 1094
diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el
index 1a26e54bf06..14f988feb03 100644
--- a/lisp/progmodes/cc-styles.el
+++ b/lisp/progmodes/cc-styles.el
@@ -48,6 +48,7 @@
48 48
49;; Silence the compiler. 49;; Silence the compiler.
50(cc-bytecomp-defvar adaptive-fill-first-line-regexp) ; Emacs 50(cc-bytecomp-defvar adaptive-fill-first-line-regexp) ; Emacs
51(cc-bytecomp-obsolete-fun make-local-hook) ; Marked obsolete in Emacs 21.1.
51 52
52 53
53(defvar c-style-alist 54(defvar c-style-alist
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 436bc04d044..4abd8123e6a 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -342,10 +342,19 @@ Affects: `cperl-font-lock', `cperl-electric-lbrace-space',
342 :type 'integer 342 :type 'integer
343 :group 'cperl-indentation-details) 343 :group 'cperl-indentation-details)
344 344
345(defcustom cperl-vc-header-alist '((SCCS "($sccs) = ('%W\%' =~ /(\\d+(\\.\\d+)+)/) ;") 345(defvar cperl-vc-header-alist nil)
346 (RCS "($rcs) = (' $Id\$ ' =~ /(\\d+(\\.\\d+)+)/) ;")) 346(make-obsolete-variable
347 "*What to use as `vc-header-alist' in CPerl." 347 'cperl-vc-header-alist
348 :type '(repeat (list symbol string)) 348 "use cperl-vc-rcs-header or cperl-vc-sccs-header instead.")
349
350(defcustom cperl-vc-sccs-header '("($sccs) = ('%W\%' =~ /(\\d+(\\.\\d+)+)/) ;")
351 "*Special version of `vc-sccs-header' that is used in CPerl mode buffers."
352 :type '(repeat string)
353 :group 'cperl)
354
355(defcustom cperl-vc-rcs-header '("($rcs) = (' $Id\$ ' =~ /(\\d+(\\.\\d+)+)/) ;")
356 "*Special version of `vc-rcs-header' that is used in CPerl mode buffers."
357 :type '(repeat string)
349 :group 'cperl) 358 :group 'cperl)
350 359
351(defcustom cperl-clobber-mode-lists 360(defcustom cperl-clobber-mode-lists
@@ -1485,8 +1494,10 @@ or as help on variables `cperl-tips', `cperl-problems',
1485 (function cperl-imenu--create-perl-index)) 1494 (function cperl-imenu--create-perl-index))
1486 (make-local-variable 'imenu-sort-function) 1495 (make-local-variable 'imenu-sort-function)
1487 (setq imenu-sort-function nil) 1496 (setq imenu-sort-function nil)
1488 (make-local-variable 'vc-header-alist) 1497 (make-local-variable 'vc-rcs-header)
1489 (set 'vc-header-alist cperl-vc-header-alist) ; Avoid warning 1498 (set 'vc-rcs-header cperl-vc-rcs-header)
1499 (make-local-variable 'vc-sccs-header)
1500 (set 'vc-sccs-header cperl-vc-sccs-header)
1490 (make-local-variable 'font-lock-defaults) 1501 (make-local-variable 'font-lock-defaults)
1491 (setq font-lock-defaults 1502 (setq font-lock-defaults
1492 (cond 1503 (cond
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 32ede0e1474..b119b03f0bf 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -1858,7 +1858,8 @@ directory specification."
1858 (error "File %s not in current tags tables" file))))) 1858 (error "File %s not in current tags tables" file)))))
1859 (with-current-buffer "*Tags List*" 1859 (with-current-buffer "*Tags List*"
1860 (require 'apropos) 1860 (require 'apropos)
1861 (apropos-mode) 1861 (with-no-warnings
1862 (apropos-mode))
1862 (setq buffer-read-only t))) 1863 (setq buffer-read-only t)))
1863 1864
1864;;;###autoload 1865;;;###autoload
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 5463ee3ffa9..28a6aae2435 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -47,7 +47,8 @@
47(defsubst flymake-makehash (&optional test) 47(defsubst flymake-makehash (&optional test)
48 (if (fboundp 'make-hash-table) 48 (if (fboundp 'make-hash-table)
49 (if test (make-hash-table :test test) (make-hash-table)) 49 (if test (make-hash-table :test test) (make-hash-table))
50 (makehash test))) 50 (with-no-warnings
51 (makehash test))))
51 52
52(defalias 'flymake-float-time 53(defalias 'flymake-float-time
53 (if (fboundp 'float-time) 54 (if (fboundp 'float-time)
diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el
index ba0266de574..1a26b64beca 100644
--- a/lisp/progmodes/gdb-ui.el
+++ b/lisp/progmodes/gdb-ui.el
@@ -698,6 +698,7 @@ The key should be one of the cars in `gdb-buffer-rules-assoc'."
698 (define-key map "\C-c\C-z" 'gdb-inferior-io-stop) 698 (define-key map "\C-c\C-z" 'gdb-inferior-io-stop)
699 (define-key map "\C-c\C-\\" 'gdb-inferior-io-quit) 699 (define-key map "\C-c\C-\\" 'gdb-inferior-io-quit)
700 (define-key map "\C-c\C-d" 'gdb-inferior-io-eof) 700 (define-key map "\C-c\C-d" 'gdb-inferior-io-eof)
701 (define-key map "\C-d" 'gdb-inferior-io-eof)
701 map)) 702 map))
702 703
703(define-derived-mode gdb-inferior-io-mode comint-mode "Inferior I/O" 704(define-derived-mode gdb-inferior-io-mode comint-mode "Inferior I/O"
@@ -953,7 +954,7 @@ function is used to change the focus of GUD tooltips to #define
953directives." 954directives."
954 (setq gdb-active-process nil) 955 (setq gdb-active-process nil)
955 (gdb-stopping ignored)) 956 (gdb-stopping ignored))
956 957
957(defun gdb-frame-begin (ignored) 958(defun gdb-frame-begin (ignored)
958 (let ((sink gdb-output-sink)) 959 (let ((sink gdb-output-sink))
959 (cond 960 (cond
@@ -1303,7 +1304,8 @@ static char *magick[] = {
1303 (looking-at "\\(\\S-+\\):\\([0-9]+\\)") 1304 (looking-at "\\(\\S-+\\):\\([0-9]+\\)")
1304 (let ((line (match-string 2)) (buffer-read-only nil) 1305 (let ((line (match-string 2)) (buffer-read-only nil)
1305 (file (match-string 1))) 1306 (file (match-string 1)))
1306 (add-text-properties (point-at-bol) (point-at-eol) 1307 (add-text-properties (line-beginning-position)
1308 (line-end-position)
1307 '(mouse-face highlight 1309 '(mouse-face highlight
1308 help-echo "mouse-2, RET: visit breakpoint")) 1310 help-echo "mouse-2, RET: visit breakpoint"))
1309 (unless (file-exists-p file) 1311 (unless (file-exists-p file)
@@ -1504,13 +1506,13 @@ static char *magick[] = {
1504 (let ((buffer-read-only nil)) 1506 (let ((buffer-read-only nil))
1505 (goto-char (point-min)) 1507 (goto-char (point-min))
1506 (while (< (point) (point-max)) 1508 (while (< (point) (point-max))
1507 (add-text-properties (point-at-bol) (point-at-eol) 1509 (add-text-properties (line-beginning-position) (line-end-position)
1508 '(mouse-face highlight 1510 '(mouse-face highlight
1509 help-echo "mouse-2, RET: Select frame")) 1511 help-echo "mouse-2, RET: Select frame"))
1510 (beginning-of-line) 1512 (beginning-of-line)
1511 (when (and (looking-at "^#\\([0-9]+\\)") 1513 (when (and (looking-at "^#\\([0-9]+\\)")
1512 (equal (match-string 1) gdb-current-stack-level)) 1514 (equal (match-string 1) gdb-current-stack-level))
1513 (put-text-property (point-at-bol) (point-at-eol) 1515 (put-text-property (line-beginning-position) (line-end-position)
1514 'face '(:inverse-video t))) 1516 'face '(:inverse-video t)))
1515 (forward-line 1)))))) 1517 (forward-line 1))))))
1516 1518
@@ -1588,7 +1590,7 @@ static char *magick[] = {
1588 (let ((buffer-read-only nil)) 1590 (let ((buffer-read-only nil))
1589 (goto-char (point-min)) 1591 (goto-char (point-min))
1590 (while (< (point) (point-max)) 1592 (while (< (point) (point-max))
1591 (add-text-properties (point-at-bol) (point-at-eol) 1593 (add-text-properties (line-beginning-position) (line-end-position)
1592 '(mouse-face highlight 1594 '(mouse-face highlight
1593 help-echo "mouse-2, RET: select thread")) 1595 help-echo "mouse-2, RET: select thread"))
1594 (forward-line 1))))) 1596 (forward-line 1)))))
@@ -1974,14 +1976,14 @@ corresponding to the mode line clicked."
1974 (let ((buf (gdb-get-buffer 'gdb-partial-output-buffer))) 1976 (let ((buf (gdb-get-buffer 'gdb-partial-output-buffer)))
1975 (with-current-buffer buf 1977 (with-current-buffer buf
1976 (goto-char (point-min)) 1978 (goto-char (point-min))
1977 (while (re-search-forward "^ .*\n" nil t) 1979 (while (re-search-forward "^[ }].*\n" nil t)
1978 (replace-match "" nil nil)) 1980 (replace-match "" nil nil))
1979 (goto-char (point-min)) 1981 (goto-char (point-min))
1980 (while (re-search-forward "{[-0-9, {}\]*\n" nil t) 1982 (while (re-search-forward "{\\(.*=.*\n\\|\n\\)" nil t)
1981 (replace-match "(array);\n" nil nil)) 1983 (replace-match "(structure);\n" nil nil))
1982 (goto-char (point-min)) 1984 (goto-char (point-min))
1983 (while (re-search-forward "{.*=.*\n" nil t) 1985 (while (re-search-forward "\\s-*{.*\n" nil t)
1984 (replace-match "(structure);\n" nil nil)))) 1986 (replace-match " (array);\n" nil nil))))
1985 (let ((buf (gdb-get-buffer 'gdb-locals-buffer))) 1987 (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
1986 (and buf (with-current-buffer buf 1988 (and buf (with-current-buffer buf
1987 (let ((p (point)) 1989 (let ((p (point))
@@ -2316,8 +2318,8 @@ BUFFER nil or omitted means use the current buffer."
2316 (delete-overlay overlay)))) 2318 (delete-overlay overlay))))
2317 2319
2318(defun gdb-put-breakpoint-icon (enabled bptno) 2320(defun gdb-put-breakpoint-icon (enabled bptno)
2319 (let ((start (progn (beginning-of-line) (- (point) 1))) 2321 (let ((start (- (line-beginning-position) 1))
2320 (end (progn (end-of-line) (+ (point) 1))) 2322 (end (+ (line-end-position) 1))
2321 (putstring (if enabled "B" "b"))) 2323 (putstring (if enabled "B" "b")))
2322 (add-text-properties 2324 (add-text-properties
2323 0 1 '(help-echo "mouse-1: set/clear bkpt, mouse-3: enable/disable bkpt") 2325 0 1 '(help-echo "mouse-1: set/clear bkpt, mouse-3: enable/disable bkpt")
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index 35e4b68c9b8..a118b0055a9 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -3548,7 +3548,7 @@ is non-nil."
3548 (let ((pos (point))) 3548 (let ((pos (point)))
3549 (if idlwave-file-header 3549 (if idlwave-file-header
3550 (cond ((car idlwave-file-header) 3550 (cond ((car idlwave-file-header)
3551 (insert-file (car idlwave-file-header))) 3551 (insert-file-contents (car idlwave-file-header)))
3552 ((stringp (car (cdr idlwave-file-header))) 3552 ((stringp (car (cdr idlwave-file-header)))
3553 (insert (car (cdr idlwave-file-header)))))) 3553 (insert (car (cdr idlwave-file-header))))))
3554 (goto-char pos))) 3554 (goto-char pos)))
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index 86002768757..05c3ac50787 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -484,7 +484,7 @@ not be enclosed in { } or ( )."
484 ("\\\\\n" 0 "."))) 484 ("\\\\\n" 0 ".")))
485 485
486(defvar makefile-imenu-generic-expression 486(defvar makefile-imenu-generic-expression
487 `(("Dependencies" ,makefile-dependency-regex 1) 487 `(("Dependencies" makefile-previous-dependency 1)
488 ("Macro Assignment" ,makefile-macroassign-regex 1)) 488 ("Macro Assignment" ,makefile-macroassign-regex 1))
489 "Imenu generic expression for Makefile mode. See `imenu-generic-expression'.") 489 "Imenu generic expression for Makefile mode. See `imenu-generic-expression'.")
490 490
@@ -854,7 +854,10 @@ Makefile mode can be configured by modifying the following variables:
854 "^\t[ \t]*\\(\\(?:\\(?:noecho\\|ignore[-_]error\\|[-@]+\\)[ \t]*\\)*\\)\\(\\(&\\S +\\)?\\(?:.+\\\\\n\\)*.+\\)") 854 "^\t[ \t]*\\(\\(?:\\(?:noecho\\|ignore[-_]error\\|[-@]+\\)[ \t]*\\)*\\)\\(\\(&\\S +\\)?\\(?:.+\\\\\n\\)*.+\\)")
855 855
856 (setq font-lock-defaults 856 (setq font-lock-defaults
857 `(makefile-makepp-font-lock-keywords ,@(cdr font-lock-defaults)))) 857 `(makefile-makepp-font-lock-keywords ,@(cdr font-lock-defaults))
858 imenu-generic-expression
859 `(("Functions" "^[ \t]*\\(?:make\\)?sub[ \t]+\\([A-Za-z0-9_]+\\)" 1)
860 ,@imenu-generic-expression)))
858 861
859;;;###autoload 862;;;###autoload
860(define-derived-mode makefile-bsdmake-mode makefile-mode "BSDmakefile" 863(define-derived-mode makefile-bsdmake-mode makefile-mode "BSDmakefile"
@@ -866,10 +869,7 @@ Makefile mode can be configured by modifying the following variables:
866 (set (make-local-variable 'makefile-rule-action-regex) 869 (set (make-local-variable 'makefile-rule-action-regex)
867 "^\t[ \t]*\\([-+@]*\\)[ \t]*\\(\\(?:.+\\\\\n\\)*.+\\)") 870 "^\t[ \t]*\\([-+@]*\\)[ \t]*\\(\\(?:.+\\\\\n\\)*.+\\)")
868 (setq font-lock-defaults 871 (setq font-lock-defaults
869 `(makefile-bsdmake-font-lock-keywords ,@(cdr font-lock-defaults)) 872 `(makefile-bsdmake-font-lock-keywords ,@(cdr font-lock-defaults))))
870 imenu-generic-expression
871 `(("Dependencies" ,makefile-dependency-regex 1)
872 ,@(cdr imenu-generic-expression))))
873 873
874 874
875 875
@@ -1682,7 +1682,7 @@ matched in a rule action."
1682 (catch 'found 1682 (catch 'found
1683 (let ((pt (point))) 1683 (let ((pt (point)))
1684 (while (progn (skip-chars-forward makefile-dependency-skip bound) 1684 (while (progn (skip-chars-forward makefile-dependency-skip bound)
1685 (not (eobp))) 1685 (< (point) (or bound (point-max))))
1686 (forward-char) 1686 (forward-char)
1687 (or (eq (char-after) ?=) 1687 (or (eq (char-after) ?=)
1688 (get-text-property (1- (point)) 'face) 1688 (get-text-property (1- (point)) 'face)
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index 0173c419b5d..87915933862 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -1389,7 +1389,7 @@ with your script for an edit-interpret-debug cycle."
1389 (cond ((looking-at "#![ \t]?\\([^ \t\n]*/bin/env[ \t]\\)?\\([^ \t\n]+\\)") 1389 (cond ((looking-at "#![ \t]?\\([^ \t\n]*/bin/env[ \t]\\)?\\([^ \t\n]+\\)")
1390 (match-string 2)) 1390 (match-string 2))
1391 ((and buffer-file-name 1391 ((and buffer-file-name
1392 (string-match "\\.m?spec$" buffer-file-name)) 1392 (string-match "\\.m?spec\\'" buffer-file-name))
1393 "rpm"))))) 1393 "rpm")))))
1394 (sh-set-shell (or interpreter sh-shell-file) nil nil)) 1394 (sh-set-shell (or interpreter sh-shell-file) nil nil))
1395 (run-hooks 'sh-mode-hook)) 1395 (run-hooks 'sh-mode-hook))
@@ -2290,7 +2290,7 @@ we go to the end of the previous line and do not check for continuations."
2290 (if (looking-at "[\"'`]") 2290 (if (looking-at "[\"'`]")
2291 (sh-safe-forward-sexp) 2291 (sh-safe-forward-sexp)
2292 ;; (> (skip-chars-forward "^ \t\n\"'`") 0) 2292 ;; (> (skip-chars-forward "^ \t\n\"'`") 0)
2293 (> (skip-chars-forward "-_a-zA-Z\$0-9") 0) 2293 (> (skip-chars-forward "-_a-zA-Z$0-9") 0)
2294 )) 2294 ))
2295 (buffer-substring start (point)) 2295 (buffer-substring start (point))
2296 )) 2296 ))
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index 12f04895f98..f840ef356d9 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -12364,8 +12364,8 @@ File statistics: \"%s\"\n\
12364 (save-match-data 12364 (save-match-data
12365 (goto-char (match-end 1)) 12365 (goto-char (match-end 1))
12366 ;; move to next item 12366 ;; move to next item
12367 (if (looking-at "\\(\\s-*,\\)") 12367 (if (looking-at "\\s-*,")
12368 (goto-char (match-end 1)) 12368 (goto-char (match-end 0))
12369 (end-of-line) t)))) 12369 (end-of-line) t))))
12370 (error t))) 12370 (error t)))
12371 12371
@@ -12736,7 +12736,7 @@ This does background highlighting of translate-off regions.")
12736 '(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords))) 12736 '(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords)))
12737 (when (fboundp 'font-lock-unset-defaults) 12737 (when (fboundp 'font-lock-unset-defaults)
12738 (font-lock-unset-defaults)) ; not implemented in XEmacs 12738 (font-lock-unset-defaults)) ; not implemented in XEmacs
12739 (font-lock-set-defaults) 12739 (font-lock-set-defaults) ;What for? --Stef
12740 (font-lock-mode nil) 12740 (font-lock-mode nil)
12741 (font-lock-mode t)) 12741 (font-lock-mode t))
12742 12742
diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el
index e4e52bbd746..b0f1dcf6e03 100644
--- a/lisp/ruler-mode.el
+++ b/lisp/ruler-mode.el
@@ -696,6 +696,9 @@ Optional argument PROPS specifies other text properties to apply."
696 (put-text-property 696 (put-text-property
697 i (1+ i) 'face 'ruler-mode-goal-column-face 697 i (1+ i) 'face 'ruler-mode-goal-column-face
698 ruler) 698 ruler)
699 (put-text-property
700 i (1+ i) 'mouse-face 'mode-line-highlight
701 ruler)
699 (put-text-property 702 (put-text-property
700 i (1+ i) 'help-echo ruler-mode-goal-column-help-echo 703 i (1+ i) 'help-echo ruler-mode-goal-column-help-echo
701 ruler)) 704 ruler))
@@ -705,6 +708,9 @@ Optional argument PROPS specifies other text properties to apply."
705 (put-text-property 708 (put-text-property
706 i (1+ i) 'face 'ruler-mode-comment-column-face 709 i (1+ i) 'face 'ruler-mode-comment-column-face
707 ruler) 710 ruler)
711 (put-text-property
712 i (1+ i) 'mouse-face 'mode-line-highlight
713 ruler)
708 (put-text-property 714 (put-text-property
709 i (1+ i) 'help-echo ruler-mode-comment-column-help-echo 715 i (1+ i) 'help-echo ruler-mode-comment-column-help-echo
710 ruler)) 716 ruler))
@@ -714,6 +720,9 @@ Optional argument PROPS specifies other text properties to apply."
714 (put-text-property 720 (put-text-property
715 i (1+ i) 'face 'ruler-mode-fill-column-face 721 i (1+ i) 'face 'ruler-mode-fill-column-face
716 ruler) 722 ruler)
723 (put-text-property
724 i (1+ i) 'mouse-face 'mode-line-highlight
725 ruler)
717 (put-text-property 726 (put-text-property
718 i (1+ i) 'help-echo ruler-mode-fill-column-help-echo 727 i (1+ i) 'help-echo ruler-mode-fill-column-help-echo
719 ruler)) 728 ruler))
diff --git a/lisp/simple.el b/lisp/simple.el
index b8c5e20b750..240896b5eef 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2568,7 +2568,11 @@ With argument N, insert the Nth previous kill.
2568If N is negative, this is a more recent kill. 2568If N is negative, this is a more recent kill.
2569 2569
2570The sequence of kills wraps around, so that after the oldest one 2570The sequence of kills wraps around, so that after the oldest one
2571comes the newest one." 2571comes the newest one.
2572
2573When this command inserts killed text into the buffer, it honors
2574`yank-excluded-properties' and `yank-handler' as described in the
2575doc string for `insert-for-yank-1', which see."
2572 (interactive "*p") 2576 (interactive "*p")
2573 (if (not (eq last-command 'yank)) 2577 (if (not (eq last-command 'yank))
2574 (error "Previous command was not a yank")) 2578 (error "Previous command was not a yank"))
@@ -2600,6 +2604,11 @@ killed OR yanked. Put point at end, and set mark at beginning.
2600With just \\[universal-argument] as argument, same but put point at beginning (and mark at end). 2604With just \\[universal-argument] as argument, same but put point at beginning (and mark at end).
2601With argument N, reinsert the Nth most recently killed stretch of killed 2605With argument N, reinsert the Nth most recently killed stretch of killed
2602text. 2606text.
2607
2608When this command inserts killed text into the buffer, it honors
2609`yank-excluded-properties' and `yank-handler' as described in the
2610doc string for `insert-for-yank-1', which see.
2611
2603See also the command \\[yank-pop]." 2612See also the command \\[yank-pop]."
2604 (interactive "*P") 2613 (interactive "*P")
2605 (setq yank-window-start (window-start)) 2614 (setq yank-window-start (window-start))
diff --git a/lisp/startup.el b/lisp/startup.el
index 96213f2924e..bfe455600ae 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -368,11 +368,17 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'."
368 ;; of that dir into load-path, 368 ;; of that dir into load-path,
369 ;; Look for a leim-list.el file too. Loading it will register 369 ;; Look for a leim-list.el file too. Loading it will register
370 ;; available input methods. 370 ;; available input methods.
371 (dolist (dir load-path) 371 (let ((tail load-path) dir)
372 (let ((default-directory dir)) 372 (while tail
373 (load (expand-file-name "subdirs.el") t t t)) 373 (setq dir (car tail))
374 (let ((default-directory dir)) 374 (let ((default-directory dir))
375 (load (expand-file-name "leim-list.el") t t t))) 375 (load (expand-file-name "subdirs.el") t t t))
376 (let ((default-directory dir))
377 (load (expand-file-name "leim-list.el") t t t))
378 ;; We don't use a dolist loop and we put this "setq-cdr" command at
379 ;; the end, because the subdirs.el files may add elements to the end
380 ;; of load-path and we want to take it into account.
381 (setq tail (cdr tail))))
376 (unless (eq system-type 'vax-vms) 382 (unless (eq system-type 'vax-vms)
377 ;; If the PWD environment variable isn't accurate, delete it. 383 ;; If the PWD environment variable isn't accurate, delete it.
378 (let ((pwd (getenv "PWD"))) 384 (let ((pwd (getenv "PWD")))
diff --git a/lisp/subr.el b/lisp/subr.el
index d91642c5cbe..f284c18ce5e 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -784,6 +784,12 @@ is converted into a string by expressing it in decimal."
784 baud-rate) 784 baud-rate)
785(make-obsolete 'baud-rate "use the `baud-rate' variable instead." "before 19.15") 785(make-obsolete 'baud-rate "use the `baud-rate' variable instead." "before 19.15")
786 786
787;; These are used by VM and some old programs
788(defalias 'focus-frame 'ignore "")
789(make-obsolete 'focus-frame "it does nothing." "22.1")
790(defalias 'unfocus-frame 'ignore "")
791(make-obsolete 'unfocus-frame "it does nothing." "22.1")
792
787 793
788;;;; Obsolescence declarations for variables, and aliases. 794;;;; Obsolescence declarations for variables, and aliases.
789 795
@@ -1452,10 +1458,6 @@ BEG and END default respectively to the beginning and end of buffer."
1452 1458
1453;;;; Miscellanea. 1459;;;; Miscellanea.
1454 1460
1455;; A number of major modes set this locally.
1456;; Give it a global value to avoid compiler warnings.
1457(defvar font-lock-defaults nil)
1458
1459(defvar suspend-hook nil 1461(defvar suspend-hook nil
1460 "Normal hook run by `suspend-emacs', before suspending.") 1462 "Normal hook run by `suspend-emacs', before suspending.")
1461 1463
diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el
index 1b3585d56a9..bd81f97138c 100644
--- a/lisp/textmodes/org.el
+++ b/lisp/textmodes/org.el
@@ -5,7 +5,7 @@
5;; Author: Carsten Dominik <dominik at science dot uva dot nl> 5;; Author: Carsten Dominik <dominik at science dot uva dot nl>
6;; Keywords: outlines, hypermedia, calendar 6;; Keywords: outlines, hypermedia, calendar
7;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ 7;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/
8;; Version: 3.08 8;; Version: 3.09
9;; 9;;
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11;; 11;;
@@ -31,27 +31,30 @@
31;; project planning with a fast and effective plain-text system. 31;; project planning with a fast and effective plain-text system.
32;; 32;;
33;; Org-mode develops organizational tasks around a NOTES file that contains 33;; Org-mode develops organizational tasks around a NOTES file that contains
34;; information about projects as plain text. Org-mode is implemented on 34;; information about projects as plain text. Org-mode is implemented on top
35;; top of outline-mode - ideal to keep the content of large files well 35;; of outline-mode - ideal to keep the content of large files well structured.
36;; structured. It supports ToDo items, deadlines and time stamps, which 36;; It supports ToDo items, deadlines and time stamps, which can be extracted
37;; magically appear in the diary listing of the Emacs calendar. Tables are 37;; to create a daily/weekly agenda that also integrates the diary of the Emacs
38;; easily created with a built-in table editor. Plain text URL-like links 38;; calendar. Tables are easily created with a built-in table editor. Plain
39;; connect to websites, emails (VM,RMAIL,WANDERLUST), Usenet messages (Gnus), 39;; text URL-like links connect to websites, emails (VM, RMAIL, WANDERLUST),
40;; BBDB entries, and any files related to the projects. For printing and 40;; Usenet messages (Gnus), BBDB entries, and any files related to the
41;; sharing of notes, an Org-mode file (or a part of it) can be exported as 41;; projects. For printing and sharing of notes, an Org-mode file (or a part
42;; a structured ASCII file, or as HTML. 42;; of it) can be exported as a structured ASCII file, or as HTML.
43;; 43;;
44;; Installation 44;; Installation
45;; ------------ 45;; ------------
46;; The instruction below assume that you have downloaded Org-mode from the 46;; If Org-mode is part of the Emacs distribution or an XEmacs package, you
47;; web. If Org-mode is part of the Emacs distribution or an XEmacs package, 47;; only need to copy the following lines to your .emacs file. The last two
48;; you only need to add to .emacs the last three lines of Lisp code listed 48;; lines define *global* keys for the commands `org-store-link' and
49;; below, i.e. the `auto-mode-alist' modification and the global key bindings. 49;; `org-agenda' - please choose suitable keys yourself.
50;; 50;;
51;; Byte-compile org.el and put it on your load path. Then copy the 51;; (add-to-list 'auto-mode-alist '("\\.org$" . org-mode))
52;; following lines into .emacs. The last two lines define *global* 52;; (define-key global-map "\C-cl" 'org-store-link)
53;; keys for the commands `org-store-link' and `org-agenda' - please 53;; (define-key global-map "\C-ca" 'org-agenda)
54;; choose suitable keys yourself. 54;;
55;; If you have downloaded Org-mode from the Web, you must byte-compile
56;; org.el and put it on your load path. In addition to the Emacs Lisp
57;; lines above, you also need to add the following lines to .emacs:
55;; 58;;
56;; (autoload 'org-mode "org" "Org mode" t) 59;; (autoload 'org-mode "org" "Org mode" t)
57;; (autoload 'org-diary "org" "Diary entries from Org mode") 60;; (autoload 'org-diary "org" "Diary entries from Org mode")
@@ -59,12 +62,9 @@
59;; (autoload 'org-store-link "org" "Store a link to the current location" t) 62;; (autoload 'org-store-link "org" "Store a link to the current location" t)
60;; (autoload 'orgtbl-mode "org" "Org tables as a minor mode" t) 63;; (autoload 'orgtbl-mode "org" "Org tables as a minor mode" t)
61;; (autoload 'turn-on-orgtbl "org" "Org tables as a minor mode") 64;; (autoload 'turn-on-orgtbl "org" "Org tables as a minor mode")
62;; (add-to-list 'auto-mode-alist '("\\.org$" . org-mode))
63;; (define-key global-map "\C-cl" 'org-store-link)
64;; (define-key global-map "\C-ca" 'org-agenda)
65;; 65;;
66;; This will put all files with extension ".org" into Org-mode. As an 66;; This setup will put all files with extension ".org" into Org-mode. As
67;; alternative, make the first line of a file look like this: 67;; an alternative, make the first line of a file look like this:
68;; 68;;
69;; MY PROJECTS -*- mode: org; -*- 69;; MY PROJECTS -*- mode: org; -*-
70;; 70;;
@@ -73,12 +73,18 @@
73;; 73;;
74;; Documentation 74;; Documentation
75;; ------------- 75;; -------------
76;; The documentation of Org-mode can be found in the TeXInfo file. 76;; The documentation of Org-mode can be found in the TeXInfo file. The
77;; The distribution also contains a PDF version of it. At the homepage 77;; distribution also contains a PDF version of it. At the homepage of
78;; of Org-mode, you can read the same text online as HTML. 78;; Org-mode, you can read the same text online as HTML. There is also an
79;; excellent reference card made by Philip Rooke.
79;; 80;;
80;; Changes: 81;; Changes:
81;; ------- 82;; -------
83;; Version 3.09
84;; - Time-of-day specifications in agenda are extracted and placed
85;; into the prefix. Timed entries can be placed into a time grid for
86;; day.
87;;
82;; Version 3.08 88;; Version 3.08
83;; - "|" no longer allowed as part of a link, to allow links in tables. 89;; - "|" no longer allowed as part of a link, to allow links in tables.
84;; - The prefix of items in the agenda buffer can be configured. 90;; - The prefix of items in the agenda buffer can be configured.
@@ -136,7 +142,7 @@
136;; warnings about upcoming deadlines/overdue scheduled items. 142;; warnings about upcoming deadlines/overdue scheduled items.
137;; That functionality is now limited to the (multifile) agenda. 143;; That functionality is now limited to the (multifile) agenda.
138;; - When reading a date, the calendar can be manipulated with keys. 144;; - When reading a date, the calendar can be manipulated with keys.
139;; - Link support for RMAIL and Wanderlust (from planner.el, untested) 145;; - Link support for RMAIL and Wanderlust (from planner.el, untested).
140;; - Minor bug fixes and documentation improvements. 146;; - Minor bug fixes and documentation improvements.
141 147
142;;; Code: 148;;; Code:
@@ -148,16 +154,15 @@
148 154
149;;; Customization variables 155;;; Customization variables
150 156
151(defvar org-version "3.08" 157(defvar org-version "3.09"
152 "The version number of the file org.el.") 158 "The version number of the file org.el.")
153(defun org-version () 159(defun org-version ()
154 (interactive) 160 (interactive)
155 (message "Org-mode version %s" org-version)) 161 (message "Org-mode version %s" org-version))
156 162
157;; The following two constants are for compatibility with different 163;; The following two constants are for compatibility with different Emacs
158;; Emacs versions (Emacs versus XEmacs) and with different versions of 164;; versions (Emacs versus XEmacs) and with different versions of outline.el.
159;; outline.el. All the compatibility code in org.el is based on these two 165;; The compatibility code in org.el is based on these two constants.
160;; constants.
161(defconst org-xemacs-p (featurep 'xemacs) 166(defconst org-xemacs-p (featurep 'xemacs)
162 "Are we running xemacs?") 167 "Are we running xemacs?")
163(defconst org-noutline-p (featurep 'noutline) 168(defconst org-noutline-p (featurep 'noutline)
@@ -570,7 +575,7 @@ the grouped in categories, don't sort the categories, but keep them in
570the sequence given in `org-agenda-files'. Within each category sort by 575the sequence given in `org-agenda-files'. Within each category sort by
571priority. 576priority.
572 577
573Leaving out the `category-keep' would mean that items will be sorted across 578Leaving out `category-keep' would mean that items will be sorted across
574categories by priority." 579categories by priority."
575 :group 'org-agenda 580 :group 'org-agenda
576 :type '(repeat 581 :type '(repeat
@@ -583,7 +588,7 @@ categories by priority."
583 (const priority-up) 588 (const priority-up)
584 (const priority-down)))) 589 (const priority-down))))
585 590
586(defcustom org-agenda-prefix-format " %-12:c% s" 591(defcustom org-agenda-prefix-format " %-12:c%?-12t% s"
587 "Format specification for the prefix of items in the agenda buffer. 592 "Format specification for the prefix of items in the agenda buffer.
588This format works similar to a printf format, with the following meaning: 593This format works similar to a printf format, with the following meaning:
589 594
@@ -593,22 +598,39 @@ This format works similar to a printf format, with the following meaning:
593 format HH:MM 598 format HH:MM
594 %s Scheduling/Deadline information, a short string 599 %s Scheduling/Deadline information, a short string
595 600
596In addition to the normal printf field modifiers like field width and 601All specifiers work basically like the standard `%s' of printf, but may
597padding instructions, in this format you can also add an additional 602contain two additional characters: A question mark just after the `%' and
598punctuation or whitespace character just before the final format letter. 603a whitespace/punctuation character just before the final letter.
599This character will be appended to the field value if the value is not 604
600empty. For example, the format \"%-12:c\" leads to \"Diary: \" if 605If the first character after `%' is a question mark, the entire field
601the category is \"Diary\". If the category were be empty, no additional 606will only be included if the corresponding value applies to the
602colon would be interted. 607current entry. This is useful for fields which should have fixed
603 608width when present, but zero width when absent. For example,
604Including `%t' in the format string leads to a double time specification 609\"%?-12t\" will result in a 12 character time field if a time of the
605because the headline/diary item will contain the time specification as 610day is specified, but will completely disappear in entries which do
606well. However, using `%t' in the format will result in a canonical 24 611not contain a time.
607hour time specification at a consistent position in the prefix, while the 612
608time specification in the headline/diary item may be at any position and in 613If there is punctuation or whitespace character just before the final
609various formats. 614format letter, this character will be appended to the field value if
610Example: 615the value is not empty. For example, the format \"%-12:c\" leads to
611 (setq org-agenda-prefix-format \" %-12:c% t% s\")" 616\"Diary: \" if the category is \"Diary\". If the category were be
617empty, no additional colon would be interted.
618
619The default value of this option is \" %-12:c%?-12t% s\", meaning:
620- Indent the line with two space characters
621- Give the category in a 12 chars wide field, padded with whitespace on
622 the right (because of `-'). Append a colon if there is a category
623 (because of `:').
624- If there is a time-of-day, put it into a 12 chars wide field. If no
625 time, don't put in an empty field, just skip it (because of '?').
626- Finally, put the scheduling information and append a whitespace.
627
628As another example, if you don't want the time-of-day of entries in
629the prefix, you could use:
630
631 (setq org-agenda-prefix-format \" %-11:c% s\")
632
633See also the variable `org-agenda-remove-times-when-in-prefix'."
612 :type 'string 634 :type 'string
613 :group 'org-agenda) 635 :group 'org-agenda)
614 636
@@ -618,13 +640,64 @@ Example:
618 :group 'org-agenda) 640 :group 'org-agenda)
619 641
620(defvar org-prefix-format-compiled nil 642(defvar org-prefix-format-compiled nil
621 "The compiled version of `org-???-prefix-format'.") 643 "The compiled version of the most recently used prefix format.
644Depending on which command was used last, this may be the compiled version
645of `org-agenda-prefix-format' or `org-timeline-prefix-format'.")
646
647(defcustom org-agenda-use-time-grid t
648 "Non-nil means, show a time grid in the agenda schedule.
649A time grid is a set of lines for specific times (like every two hours between
6508:00 and 20:00. The items scheduled for a day at specific times are
651sorted in between these lines.
652For deails about when the grid will be shown, and what it will look like, see
653the variable `org-agenda-time-grid'."
654 :group 'org-agenda
655 :type 'boolean)
656
657(defcustom org-agenda-time-grid
658 '((daily today require-timed)
659 "----------------"
660 (800 1000 1200 1400 1600 1800 2000))
661
662 "FIXME: document"
663 :group 'org-agenda
664 :type
665 '(list
666 (set :greedy t :tag "Grid Display Options"
667 (const :tag "Show grid in single day agenda display" daily)
668 (const :tag "Show grid in weekly agenda display" weekly)
669 (const :tag "Always show grid for today" today)
670 (const :tag "Show grid only if any timed entries are present"
671 require-timed)
672 (const :tag "Skip grid times already present in an entry"
673 remove-match))
674 (string :tag "Grid String")
675 (repeat :tag "Grid Times" (integer :tag "Time"))))
676
677(defcustom org-agenda-remove-times-when-in-prefix t
678 "Non-nil means, remove duplicate time specifications in agenda items.
679When the format `org-agenda-prefix-format' contains a `%t' specifier, a
680time-of-day specification in a headline or diary entry is extracted and
681placed into the prefix. If this option is non-nil, the original specification
682\(a timestamp or -range, or just a plain time(range) specification like
68311:30-4pm) will be removed for agenda display. This makes the agenda less
684cluttered.
685The option can be t or nil. It may also be the symbol `beg', indicating
686that the time should only be removed what it is located at the beginning of
687the headline/diary entry."
688 :group 'org-agenda
689 :type '(choice
690 (const :tag "Always" t)
691 (const :tag "Never" nil)
692 (const :tag "When at beginning of entry" beg)))
622 693
623(defcustom org-sort-agenda-notime-is-late t 694(defcustom org-sort-agenda-notime-is-late t
624 "Non-nil means, items without time are considered late. 695 "Non-nil means, items without time are considered late.
625This is only relevant for sorting. When t, items which have no explicit 696This is only relevant for sorting. When t, items which have no explicit
626time like 15:30 will be considered as 24:01, i.e. later than any items which 697time like 15:30 will be considered as 24:01, i.e. later than any items which
627do have a time. When nil, the default time is before 0:00." 698do have a time. When nil, the default time is before 0:00. You can use this
699option to decide if the schedule for today should come before or after timeless
700agenda entries."
628 :group 'org-agenda 701 :group 'org-agenda
629 :type 'boolean) 702 :type 'boolean)
630 703
@@ -1370,6 +1443,14 @@ When this is non-nil, the headline after the keyword is set to the
1370 "Face used for tables." 1443 "Face used for tables."
1371 :group 'org-faces) 1444 :group 'org-faces)
1372 1445
1446(defface org-time-grid-face ;; font-lock-variable-name-face
1447 '((((type tty) (class color)) (:foreground "yellow" :weight light))
1448 (((class color) (background light)) (:foreground "DarkGoldenrod"))
1449 (((class color) (background dark)) (:foreground "LightGoldenrod"))
1450 (t (:bold t :italic t)))
1451 "Face used for level 2 headlines."
1452 :group 'org-faces)
1453
1373(defvar org-level-faces 1454(defvar org-level-faces
1374 '( 1455 '(
1375 org-level-1-face 1456 org-level-1-face
@@ -1496,7 +1577,7 @@ The following commands are available:
1496 (save-excursion 1577 (save-excursion
1497 (goto-char (point-min)) 1578 (goto-char (point-min))
1498 (insert " -*- mode: org -*-\n\n"))) 1579 (insert " -*- mode: org -*-\n\n")))
1499 (run-hooks 'org-mode-hook) ;FIXME: Should be run-mode-hooks. 1580 (run-hooks 'org-mode-hook)
1500 (unless org-inhibit-startup 1581 (unless org-inhibit-startup
1501 (if org-startup-with-deadline-check 1582 (if org-startup-with-deadline-check
1502 (call-interactively 'org-check-deadlines) 1583 (call-interactively 'org-check-deadlines)
@@ -1565,7 +1646,7 @@ The following commands are available:
1565 (save-excursion 1646 (save-excursion
1566 (org-back-to-heading t) 1647 (org-back-to-heading t)
1567 (- (match-end 0) (match-beginning 0)))) 1648 (- (match-end 0) (match-beginning 0))))
1568 1649
1569(defvar org-font-lock-keywords nil) 1650(defvar org-font-lock-keywords nil)
1570 1651
1571(defun org-set-font-lock-defaults () 1652(defun org-set-font-lock-defaults ()
@@ -2844,13 +2925,17 @@ days in order to avoid rounding problems."
2844(defun org-time-string-to-time (s) 2925(defun org-time-string-to-time (s)
2845 (apply 'encode-time (org-parse-time-string s))) 2926 (apply 'encode-time (org-parse-time-string s)))
2846 2927
2847(defun org-parse-time-string (s) 2928(defun org-parse-time-string (s &optional nodefault)
2848 "Parse the standard Org-mode time string. 2929 "Parse the standard Org-mode time string.
2849This should be a lot faster than the normal `parse-time-string'." 2930This should be a lot faster than the normal `parse-time-string'.
2931If time is not given, defaults to 0:00. However, with optional NODEFAULT,
2932hour and minute fields will be nil if not given."
2850 (if (string-match org-ts-regexp1 s) 2933 (if (string-match org-ts-regexp1 s)
2851 (list 0 2934 (list 0
2852 (string-to-number (or (match-string 8 s) "0")) 2935 (if (or (match-beginning 8) (not nodefault))
2853 (string-to-number (or (match-string 7 s) "0")) 2936 (string-to-number (or (match-string 8 s) "0")))
2937 (if (or (match-beginning 7) (not nodefault))
2938 (string-to-number (or (match-string 7 s) "0")))
2854 (string-to-number (match-string 4 s)) 2939 (string-to-number (match-string 4 s))
2855 (string-to-number (match-string 3 s)) 2940 (string-to-number (match-string 3 s))
2856 (string-to-number (match-string 2 s)) 2941 (string-to-number (match-string 2 s))
@@ -3056,6 +3141,7 @@ The following commands are available:
3056 3141
3057(define-key org-agenda-mode-map "f" 'org-agenda-follow-mode) 3142(define-key org-agenda-mode-map "f" 'org-agenda-follow-mode)
3058(define-key org-agenda-mode-map "d" 'org-agenda-toggle-diary) 3143(define-key org-agenda-mode-map "d" 'org-agenda-toggle-diary)
3144(define-key org-agenda-mode-map "g" 'org-agenda-toggle-time-grid)
3059(define-key org-agenda-mode-map "r" 'org-agenda-redo) 3145(define-key org-agenda-mode-map "r" 'org-agenda-redo)
3060(define-key org-agenda-mode-map "q" 'org-agenda-quit) 3146(define-key org-agenda-mode-map "q" 'org-agenda-quit)
3061(define-key org-agenda-mode-map "x" 'org-agenda-exit) 3147(define-key org-agenda-mode-map "x" 'org-agenda-exit)
@@ -3115,7 +3201,7 @@ The following commands are available:
3115 ["Decrease Priority" org-agenda-priority-down t] 3201 ["Decrease Priority" org-agenda-priority-down t]
3116 ["Show Priority" org-agenda-show-priority t]) 3202 ["Show Priority" org-agenda-show-priority t])
3117 "--" 3203 "--"
3118 ["Rebuild" org-agenda-redo t] 3204 ["Rebuild buffer" org-agenda-redo t]
3119 ["Goto Today" org-agenda-goto-today t] 3205 ["Goto Today" org-agenda-goto-today t]
3120 ["Next Dates" org-agenda-later (local-variable-p 'starting-day)] 3206 ["Next Dates" org-agenda-later (local-variable-p 'starting-day)]
3121 ["Previous Dates" org-agenda-earlier (local-variable-p 'starting-day)] 3207 ["Previous Dates" org-agenda-earlier (local-variable-p 'starting-day)]
@@ -3124,6 +3210,8 @@ The following commands are available:
3124 (local-variable-p 'starting-day)] 3210 (local-variable-p 'starting-day)]
3125 ["Include Diary" org-agenda-toggle-diary 3211 ["Include Diary" org-agenda-toggle-diary
3126 :style toggle :selected org-agenda-include-diary :active t] 3212 :style toggle :selected org-agenda-include-diary :active t]
3213 ["Use Time Grid" org-agenda-toggle-time-grid
3214 :style toggle :selected org-agenda-use-time-grid :active t]
3127 "--" 3215 "--"
3128 ["New Diary Entry" org-agenda-diary-entry t] 3216 ["New Diary Entry" org-agenda-diary-entry t]
3129 ("Calendar Commands" 3217 ("Calendar Commands"
@@ -3294,11 +3382,13 @@ NDAYS defaults to `org-agenda-ndays'."
3294 (d (- nt n1))) 3382 (d (- nt n1)))
3295 (- sd (+ (if (< d 0) 7 0) d))))) 3383 (- sd (+ (if (< d 0) 7 0) d)))))
3296 (day-numbers (list start)) 3384 (day-numbers (list start))
3297 s e rtn rtnall file date d start-pos end-pos) 3385 (inhibit-redisplay t)
3386 s e rtn rtnall file date d start-pos end-pos todayp nd)
3298 (setq org-agenda-redo-command 3387 (setq org-agenda-redo-command
3299 (list 'org-agenda include-all start-day ndays)) 3388 (list 'org-agenda include-all start-day ndays))
3300 ;; Make the list of days 3389 ;; Make the list of days
3301 (setq ndays (or ndays org-agenda-ndays)) 3390 (setq ndays (or ndays org-agenda-ndays)
3391 nd ndays)
3302 (while (> ndays 1) 3392 (while (> ndays 1)
3303 (push (1+ (car day-numbers)) day-numbers) 3393 (push (1+ (car day-numbers)) day-numbers)
3304 (setq ndays (1- ndays))) 3394 (setq ndays (1- ndays)))
@@ -3324,11 +3414,15 @@ NDAYS defaults to `org-agenda-ndays'."
3324 rtn (org-agenda-get-day-entries 3414 rtn (org-agenda-get-day-entries
3325 file date :todo)) 3415 file date :todo))
3326 (setq rtnall (append rtnall rtn)))) 3416 (setq rtnall (append rtnall rtn))))
3327 (if rtnall (insert (org-finalize-agenda-entries rtnall) "\n"))) 3417 (when rtnall
3418 (insert "ALL CURRENTLY OPEN TODO ITEMS:\n")
3419 (add-text-properties (point-min) (1- (point))
3420 (list 'face 'org-link-face))
3421 (insert (org-finalize-agenda-entries rtnall) "\n")))
3328 (while (setq d (pop day-numbers)) 3422 (while (setq d (pop day-numbers))
3329 (setq date (calendar-gregorian-from-absolute d) 3423 (setq date (calendar-gregorian-from-absolute d)
3330 s (point)) 3424 s (point))
3331 (if (or (= d today) 3425 (if (or (setq todayp (= d today))
3332 (and (not start-pos) (= d sd))) 3426 (and (not start-pos) (= d sd)))
3333 (setq start-pos (point)) 3427 (setq start-pos (point))
3334 (if (and start-pos (not end-pos)) 3428 (if (and start-pos (not end-pos))
@@ -3347,14 +3441,18 @@ NDAYS defaults to `org-agenda-ndays'."
3347 (setq rtnall (append rtnall rtn)))) 3441 (setq rtnall (append rtnall rtn))))
3348 (if (or rtnall org-agenda-show-all-dates) 3442 (if (or rtnall org-agenda-show-all-dates)
3349 (progn 3443 (progn
3350 (insert (format "%-9s %2d %-9s %4d\n" 3444 (insert (format "%-9s %2d %s %4d\n"
3351 (calendar-day-name date) 3445 (calendar-day-name date)
3352 (extract-calendar-day date) 3446 (extract-calendar-day date)
3353 (calendar-month-name (extract-calendar-month date)) 3447 (calendar-month-name (extract-calendar-month date))
3354 (extract-calendar-year date))) 3448 (extract-calendar-year date)))
3355 (put-text-property s (1- (point)) 'face 3449 (put-text-property s (1- (point)) 'face
3356 'org-link-face) 3450 'org-link-face)
3357 (if rtnall (insert (org-finalize-agenda-entries rtnall) "\n")) 3451 (if rtnall (insert
3452 (org-finalize-agenda-entries ;; FIXME: condition needed
3453 (org-agenda-add-time-grid-maybe
3454 rtnall nd todayp))
3455 "\n"))
3358 (put-text-property s (1- (point)) 'day d)))) 3456 (put-text-property s (1- (point)) 'day d))))
3359 (goto-char (point-min)) 3457 (goto-char (point-min))
3360 (setq buffer-read-only t) 3458 (setq buffer-read-only t)
@@ -3502,6 +3600,15 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
3502 (message "Diary inclusion turned %s" 3600 (message "Diary inclusion turned %s"
3503 (if org-agenda-include-diary "on" "off"))) 3601 (if org-agenda-include-diary "on" "off")))
3504 3602
3603(defun org-agenda-toggle-time-grid ()
3604 "Toggle follow mode in an agenda buffer."
3605 (interactive)
3606 (setq org-agenda-use-time-grid (not org-agenda-use-time-grid))
3607 (org-agenda-redo)
3608 (org-agenda-set-mode-name)
3609 (message "Time-grid turned %s"
3610 (if org-agenda-use-time-grid "on" "off")))
3611
3505(defun org-agenda-set-mode-name () 3612(defun org-agenda-set-mode-name ()
3506 "Set the mode name to indicate all the small mode settings." 3613 "Set the mode name to indicate all the small mode settings."
3507 (setq mode-name 3614 (setq mode-name
@@ -3509,7 +3616,8 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
3509 (if (equal org-agenda-ndays 1) " Day" "") 3616 (if (equal org-agenda-ndays 1) " Day" "")
3510 (if (equal org-agenda-ndays 7) " Week" "") 3617 (if (equal org-agenda-ndays 7) " Week" "")
3511 (if org-agenda-follow-mode " Follow" "") 3618 (if org-agenda-follow-mode " Follow" "")
3512 (if org-agenda-include-diary " Diary" ""))) 3619 (if org-agenda-include-diary " Diary" "")
3620 (if org-agenda-use-time-grid " Grid" "")))
3513 (force-mode-line-update)) 3621 (force-mode-line-update))
3514 3622
3515(defun org-agenda-post-command-hook () 3623(defun org-agenda-post-command-hook ()
@@ -3524,7 +3632,7 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
3524 "Get the (Emacs Calendar) diary entries for DATE." 3632 "Get the (Emacs Calendar) diary entries for DATE."
3525 (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*") 3633 (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*")
3526 (diary-display-hook '(fancy-diary-display)) 3634 (diary-display-hook '(fancy-diary-display))
3527 (list-diary-entries-hook 3635 (list-diary-entries-hook
3528 (cons 'org-diary-default-entry list-diary-entries-hook)) 3636 (cons 'org-diary-default-entry list-diary-entries-hook))
3529 entries 3637 entries
3530 (org-disable-diary t)) 3638 (org-disable-diary t))
@@ -3551,7 +3659,7 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
3551 (setq entries 3659 (setq entries
3552 (mapcar 3660 (mapcar
3553 (lambda (x) 3661 (lambda (x)
3554 (setq x (org-format-agenda-item "" x "Diary")) 3662 (setq x (org-format-agenda-item "" x "Diary" 'time))
3555 ;; Extend the text properties to the beginning of the line 3663 ;; Extend the text properties to the beginning of the line
3556 (add-text-properties 3664 (add-text-properties
3557 0 (length x) 3665 0 (length x)
@@ -3764,7 +3872,7 @@ the documentation of `org-diary'."
3764 arg results rtn) 3872 arg results rtn)
3765 (if (not buffer) 3873 (if (not buffer)
3766 ;; If file does not exist, make sure an error message ends up in diary 3874 ;; If file does not exist, make sure an error message ends up in diary
3767 (format "ORG-AGENDA-ERROR: No such org-file %s" file) 3875 (list (format "ORG-AGENDA-ERROR: No such org-file %s" file))
3768 (with-current-buffer buffer 3876 (with-current-buffer buffer
3769 (unless (eq major-mode 'org-mode) 3877 (unless (eq major-mode 'org-mode)
3770 (error "Agenda file %s is not in `org-mode'" file)) 3878 (error "Agenda file %s is not in `org-mode'" file))
@@ -3796,8 +3904,8 @@ the documentation of `org-diary'."
3796 ((and (eq arg :deadline) 3904 ((and (eq arg :deadline)
3797 (equal date (calendar-current-date))) 3905 (equal date (calendar-current-date)))
3798 (setq rtn (org-agenda-get-deadlines)) 3906 (setq rtn (org-agenda-get-deadlines))
3799 (setq results (append results rtn)))))))))) 3907 (setq results (append results rtn))))))))
3800 results)) 3908 results))))
3801 3909
3802(defun org-entry-is-done-p () 3910(defun org-entry-is-done-p ()
3803 "Is the current entry marked DONE?" 3911 "Is the current entry marked DONE?"
@@ -3876,7 +3984,7 @@ the documentation of `org-diary'."
3876 (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) 3984 (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
3877 0 11))) 3985 0 11)))
3878 marker hdmarker deadlinep scheduledp donep tmp priority 3986 marker hdmarker deadlinep scheduledp donep tmp priority
3879 ee txt) 3987 ee txt timestr)
3880 (goto-char (point-min)) 3988 (goto-char (point-min))
3881 (while (re-search-forward regexp nil t) 3989 (while (re-search-forward regexp nil t)
3882 (if (not (save-match-data (org-at-date-range-p))) 3990 (if (not (save-match-data (org-at-date-range-p)))
@@ -3886,9 +3994,13 @@ the documentation of `org-diary'."
3886 (- (match-beginning 0) 3994 (- (match-beginning 0)
3887 org-ds-keyword-length)) 3995 org-ds-keyword-length))
3888 (match-beginning 0)) 3996 (match-beginning 0))
3997 timestr (buffer-substring (match-beginning 0) (point-at-eol))
3889 deadlinep (string-match org-deadline-regexp tmp) 3998 deadlinep (string-match org-deadline-regexp tmp)
3890 scheduledp (string-match org-scheduled-regexp tmp) 3999 scheduledp (string-match org-scheduled-regexp tmp)
3891 donep (org-entry-is-done-p)) 4000 donep (org-entry-is-done-p))
4001 (if (string-match ">" timestr)
4002 ;; substring should only run to end of time stamp
4003 (setq timestr (substring timestr 0 (match-end 0))))
3892 (save-excursion 4004 (save-excursion
3893 (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t) 4005 (if (re-search-backward "\\(^\\|\r\\)\\*+" nil t)
3894 (progn 4006 (progn
@@ -3899,7 +4011,7 @@ the documentation of `org-diary'."
3899 (format "%s%s" 4011 (format "%s%s"
3900 (if deadlinep "Deadline: " "") 4012 (if deadlinep "Deadline: " "")
3901 (if scheduledp "Scheduled: " "")) 4013 (if scheduledp "Scheduled: " ""))
3902 (match-string 1)))) 4014 (match-string 1) nil timestr)))
3903 (setq txt org-agenda-no-heading-message)) 4015 (setq txt org-agenda-no-heading-message))
3904 (setq priority (org-get-priority txt)) 4016 (setq priority (org-get-priority txt))
3905 (add-text-properties 4017 (add-text-properties
@@ -4044,10 +4156,11 @@ the documentation of `org-diary'."
4044 (abbreviate-file-name (buffer-file-name))))) 4156 (abbreviate-file-name (buffer-file-name)))))
4045 (regexp org-tr-regexp) 4157 (regexp org-tr-regexp)
4046 (d0 (calendar-absolute-from-gregorian date)) 4158 (d0 (calendar-absolute-from-gregorian date))
4047 marker hdmarker ee txt d1 d2 s1 s2) 4159 marker hdmarker ee txt d1 d2 s1 s2 timestr)
4048 (goto-char (point-min)) 4160 (goto-char (point-min))
4049 (while (re-search-forward regexp nil t) 4161 (while (re-search-forward regexp nil t)
4050 (setq s1 (match-string 1) 4162 (setq timestr (match-string 0)
4163 s1 (match-string 1)
4051 s2 (match-string 2) 4164 s2 (match-string 2)
4052 d1 (time-to-days (org-time-string-to-time s1)) 4165 d1 (time-to-days (org-time-string-to-time s1))
4053 d2 (time-to-days (org-time-string-to-time s2))) 4166 d2 (time-to-days (org-time-string-to-time s2)))
@@ -4062,9 +4175,9 @@ the documentation of `org-diary'."
4062 (goto-char (match-end 1)) 4175 (goto-char (match-end 1))
4063 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") 4176 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)")
4064 (setq txt (org-format-agenda-item 4177 (setq txt (org-format-agenda-item
4065 (format "(%d/%d): " 4178 (format (if (= d1 d2) "" "(%d/%d): ")
4066 (1+ (- d0 d1)) (1+ (- d2 d1))) 4179 (1+ (- d0 d1)) (1+ (- d2 d1)))
4067 (match-string 1)))) 4180 (match-string 1) nil (if (= d0 d1) timestr))))
4068 (setq txt org-agenda-no-heading-message)) 4181 (setq txt org-agenda-no-heading-message))
4069 (add-text-properties 4182 (add-text-properties
4070 0 (length txt) (append (list 'org-marker marker 4183 0 (length txt) (append (list 'org-marker marker
@@ -4077,66 +4190,187 @@ the documentation of `org-diary'."
4077 ;; Sort the entries by expiration date. 4190 ;; Sort the entries by expiration date.
4078 (nreverse ee))) 4191 (nreverse ee)))
4079 4192
4080(defun org-format-agenda-item (prefix txt &optional category) 4193
4194
4195(defconst org-plain-time-of-day-regexp
4196 (concat
4197 "\\(\\<[012]?[0-9]"
4198 "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)"
4199 "\\(--?"
4200 "\\(\\<[012]?[0-9]"
4201 "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)"
4202 "\\)?")
4203 "Regular expression to match a plain time or time range.
4204Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following
4205groups carry important information:
42060 the full match
42071 the first time, range or not
42088 the second time, if it is a range.")
4209
4210(defconst org-stamp-time-of-day-regexp
4211 (concat
4212 "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} +[a-zA-Z]+ +\\)"
4213 "\\([012][0-9]:[0-5][0-9]\\)>"
4214 "\\(--?"
4215 "<\\1\\([012][0-9]:[0-5][0-9]\\)>\\)?")
4216 "Regular expression to match a timestamp time or time range.
4217After a match, the following groups carry important information:
42180 the full match
42191 date plus weekday, for backreferencing to make sure both times on same day
42202 the first time, range or not
42214 the second time, if it is a range.")
4222
4223(defvar org-prefix-has-time nil
4224 "A flag, set by `org-compile-prefix-format'.
4225The flag is set if the currently compiled format contains a `%t'.")
4226
4227(defun org-format-agenda-item (extra txt &optional category dotime noprefix)
4081 "Format TXT to be inserted into the agenda buffer. 4228 "Format TXT to be inserted into the agenda buffer.
4082In particular, this indents the line and adds a category." 4229In particular, it adds the prefix and corresponding text properties. EXTRA
4083 (let* ((category (or category 4230must be a string and replaces the `%s' specifier in the prefix format.
4084 org-category 4231CATEGORY (string, symbol or nil) may be used to overule the default
4085 (file-name-sans-extension 4232category taken from local variable or file name. It will replace the `%c'
4086 (file-name-nondirectory (buffer-file-name))))) 4233specifier in the format. DOTIME, when non-nil, indicates that a
4087 (extra prefix) 4234time-of-day should be extracted from TXT for sorting of this entry, and for
4088 (time-of-day (org-get-time-of-day txt)) 4235the `%t' specifier in the format. When DOTIME is a string, this string is
4089 (t1 (if time-of-day (concat "0" (int-to-string time-of-day)) "0000")) 4236searched for a time before TXT is. NOPREFIX is a flag and indicates that
4090 (time (if time-of-day 4237only the correctly processes TXT should be returned - this is used by
4091 (concat (substring t1 -4 -2) 4238`org-agenda-change-all-lines'."
4092 ":" (substring t1 -2)) 4239 (save-match-data
4093 "")) 4240 ;; Diary entries sometimes have extra whitespace at the beginning
4094 rtn) 4241 (if (string-match "^ +" txt) (setq txt (replace-match "" nil nil txt)))
4095 (if (symbolp category) (setq category (symbol-name category))) 4242 (let* ((category (or category
4096 (setq rtn (concat (eval org-prefix-format-compiled) txt)) 4243 org-category
4097 (add-text-properties 4244 (if (buffer-file-name)
4098 0 (length rtn) (list 'category (downcase category) 4245 (file-name-sans-extension
4099 'prefix-length (- (length rtn) (length txt)) 4246 (file-name-nondirectory (buffer-file-name)))
4100 'time-of-day time-of-day) 4247 "")))
4101 rtn) 4248 time ;; needed for the eval of the prefix format
4102 rtn)) 4249 (ts (if dotime (concat (if (stringp dotime) dotime "") txt)))
4103 4250 (time-of-day (and dotime (org-get-time-of-day ts)))
4251 stamp plain s0 s1 s2 rtn)
4252 (when (and dotime time-of-day org-prefix-has-time)
4253 ;; Extract starting and ending time and move them to prefix
4254 (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts))
4255 (setq plain (string-match org-plain-time-of-day-regexp ts)))
4256 (setq s0 (match-string 0 ts)
4257 s1 (match-string (if plain 1 2) ts)
4258 s2 (match-string (if plain 8 4) ts))
4259
4260 ;; If the times are in TXT (not in DOTIMES), and the prefix will list
4261 ;; them, we might want to remove them there to avoid duplication.
4262 ;; The user can turn this off with a variable.
4263 (if (and org-agenda-remove-times-when-in-prefix (or stamp plain)
4264 (string-match (concat (regexp-quote s0) " *") txt)
4265 (if (eq org-agenda-remove-times-when-in-prefix 'beg)
4266 (= (match-beginning 0) 0)
4267 t))
4268 (setq txt (replace-match "" nil nil txt))))
4269 ;; Normalize the time(s) to 24 hour
4270 (if s1 (setq s1 (org-get-time-of-day s1 'string)))
4271 (if s2 (setq s2 (org-get-time-of-day s2 'string))))
4272
4273 ;; Create the final string
4274 (if noprefix
4275 (setq rtn txt)
4276 ;; Prepare the variables needed in the eval of the compiled format
4277 (setq time (cond (s2 (concat s1 "-" s2))
4278 (s1 (concat s1 "......"))
4279 (t ""))
4280 extra (or extra "")
4281 category (if (symbolp category) (symbol-name category) category))
4282 ;; Evaluate the compiled format
4283 (setq rtn (concat (eval org-prefix-format-compiled) txt)))
4284
4285 ;; And finally add the text properties
4286 (add-text-properties
4287 0 (length rtn) (list 'category (downcase category)
4288 'prefix-length (- (length rtn) (length txt))
4289 'time-of-day time-of-day
4290 'dotime dotime)
4291 rtn)
4292 rtn)))
4293
4294(defun org-agenda-add-time-grid-maybe (list ndays todayp)
4295 (catch 'exit
4296 (cond ((not org-agenda-use-time-grid) (throw 'exit list))
4297 ((and todayp (member 'today (car org-agenda-time-grid))))
4298 ((and (= ndays 1) (member 'daily (car org-agenda-time-grid))))
4299 ((member 'weekly (car org-agenda-time-grid)))
4300 (t (throw 'exit list)))
4301 (let* ((have (delq nil (mapcar
4302 (lambda (x) (get-text-property 1 'time-of-day x))
4303 list)))
4304 (string (nth 1 org-agenda-time-grid))
4305 (gridtimes (nth 2 org-agenda-time-grid))
4306 (req (car org-agenda-time-grid))
4307 (remove (member 'remove-match req))
4308 new time)
4309 (if (and (member 'require-timed req) (not have))
4310 ;; don't show empty grid
4311 (throw 'exit list))
4312 (while (setq time (pop gridtimes))
4313 (unless (and remove (member time have))
4314 (setq time (int-to-string time))
4315 (push (org-format-agenda-item
4316 nil string "" ;; FIXME: put a category?
4317 (concat (substring time 0 -2) ":" (substring time -2)))
4318 new)
4319 (put-text-property
4320 1 (length (car new)) 'face 'org-time-grid-face (car new))))
4321 (if (member 'time-up org-agenda-sorting-strategy)
4322 (append new list)
4323 (append list new)))))
4324
4104(defun org-compile-prefix-format (format) 4325(defun org-compile-prefix-format (format)
4105 "Compile the prefix format into a Lisp form that can be evaluated. 4326 "Compile the prefix format into a Lisp form that can be evaluated.
4106The resulting form is returned and stored in the variable 4327The resulting form is returned and stored in the variable
4107`org-prefix-format-compiled'." 4328`org-prefix-format-compiled'."
4108 (let ((start 0) varform vars (s format) c) 4329 (setq org-prefix-has-time nil)
4109 (while (string-match "%\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cts]\\)" 4330 (let ((start 0) varform vars var (s format) c f opt)
4331 (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cts]\\)"
4110 s start) 4332 s start)
4111 (setq var (cdr (assoc (match-string 3 s) 4333 (setq var (cdr (assoc (match-string 4 s)
4112 '(("c" . category) ("t" . time) ("s" . extra)))) 4334 '(("c" . category) ("t" . time) ("s" . extra))))
4113 c (match-string 2 s) 4335 c (or (match-string 3 s) "")
4336 opt (match-beginning 1)
4114 start (1+ (match-beginning 0))) 4337 start (1+ (match-beginning 0)))
4115 (if (= (length c) 1) 4338 (if (equal var 'time) (setq org-prefix-has-time t))
4116 (setq varform `(if (equal "" ,var) "" (concat ,var ,c))) 4339 (setq f (concat "%" (match-string 2 s) "s"))
4117 (setq varform var)) 4340 (if opt
4118 (setq s (replace-match "%\\1s" t nil s)) 4341 (setq varform
4342 `(if (equal "" ,var)
4343 ""
4344 (format ,f (if (equal "" ,var) "" (concat ,var ,c)))))
4345 (setq varform `(format ,f (if (equal ,var "") "" (concat ,var ,c)))))
4346 (setq s (replace-match "%s" t nil s))
4119 (push varform vars)) 4347 (push varform vars))
4120 (setq vars (nreverse vars)) 4348 (setq vars (nreverse vars))
4121 (setq org-prefix-format-compiled `(format ,s ,@vars)))) 4349 (setq org-prefix-format-compiled `(format ,s ,@vars))))
4122 4350
4123(defun org-get-time-of-day (s) 4351(defun org-get-time-of-day (s &optional string)
4124 "Check string S for a time of day. 4352 "Check string S for a time of day.
4125If found, return it as a military time number between 0 and 2400. 4353If found, return it as a military time number between 0 and 2400.
4126If not found, return nil." 4354If not found, return nil.
4355The optional STRING argument forces conversion into a 5 character wide string
4356HH:MM."
4127 (save-match-data 4357 (save-match-data
4128 (when (or 4358 (when
4129 (string-match 4359 (or
4130 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\>" s) 4360 (string-match
4131 (string-match 4361 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s)
4132 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\>" s)) 4362 (string-match
4133 (+ (* 100 (+ (string-to-number (match-string 1 s)) 4363 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s))
4134 (if (and (match-beginning 4) 4364 (let* ((t0 (+ (* 100
4135 (equal (downcase (match-string 4 s)) "pm")) 4365 (+ (string-to-number (match-string 1 s))
4136 12 0))) 4366 (if (and (match-beginning 4)
4137 (if (match-beginning 3) 4367 (equal (downcase (match-string 4 s)) "pm"))
4138 (string-to-number (match-string 3 s)) 4368 12 0)))
4139 0))))) 4369 (if (match-beginning 3)
4370 (string-to-number (match-string 3 s))
4371 0)))
4372 (t1 (concat " " (int-to-string t0))))
4373 (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0)))))
4140 4374
4141(defun org-finalize-agenda-entries (list) 4375(defun org-finalize-agenda-entries (list)
4142 "Sort and concatenate the agenda items." 4376 "Sort and concatenate the agenda items."
@@ -4295,23 +4529,30 @@ the same tree node, and the headline of the tree node in the Org-mode file."
4295 4529
4296(defun org-agenda-change-all-lines (newhead hdmarker &optional fixface) 4530(defun org-agenda-change-all-lines (newhead hdmarker &optional fixface)
4297 "Change all lines in the agenda buffer which match hdmarker. 4531 "Change all lines in the agenda buffer which match hdmarker.
4298The new content of the line will be NEWHEAD. HDMARKER is checked with 4532The new content of the line will be NEWHEAD (as modified by
4299`equal' against all `org-hd-marker' text properties in the file." 4533`org-format-agenda-item'). HDMARKER is checked with
4300 (let* (props m pl undone-face done-face) 4534`equal' against all `org-hd-marker' text properties in the file.
4535If FIXFACE is non-nil, the face of each item is modified acording to
4536the new TODO state."
4537 (let* (props m pl undone-face done-face finish new dotime)
4538; (setq newhead (org-format-agenda-item "x" newhead "x" nil 'noprefix))
4301 (save-excursion 4539 (save-excursion
4302 (goto-char (point-max)) 4540 (goto-char (point-max))
4303 (beginning-of-line 1) 4541 (beginning-of-line 1)
4304 (while (not (bobp)) 4542 (while (not finish)
4543 (setq finish (bobp))
4305 (when (and (setq m (get-text-property (point) 'org-hd-marker)) 4544 (when (and (setq m (get-text-property (point) 'org-hd-marker))
4306 (equal m hdmarker)) 4545 (equal m hdmarker))
4307 (setq props (text-properties-at (point)) 4546 (setq props (text-properties-at (point))
4547 dotime (get-text-property (point) 'dotime)
4548 new (org-format-agenda-item "x" newhead "x" dotime 'noprefix)
4308 pl (get-text-property (point) 'prefix-length) 4549 pl (get-text-property (point) 'prefix-length)
4309 undone-face (get-text-property (point) 'undone-face) 4550 undone-face (get-text-property (point) 'undone-face)
4310 done-face (get-text-property (point) 'done-face)) 4551 done-face (get-text-property (point) 'done-face))
4311 (move-to-column pl) 4552 (move-to-column pl)
4312 (if (looking-at ".*") 4553 (if (looking-at ".*")
4313 (progn 4554 (progn
4314 (replace-match newhead t t) 4555 (replace-match new t t)
4315 (beginning-of-line 1) 4556 (beginning-of-line 1)
4316 (add-text-properties (point-at-bol) (point-at-eol) props) 4557 (add-text-properties (point-at-bol) (point-at-eol) props)
4317 (if fixface 4558 (if fixface
@@ -4355,6 +4596,7 @@ the same tree node, and the headline of the tree node in the Org-mode file."
4355 (and (outline-next-heading) 4596 (and (outline-next-heading)
4356 (org-flag-heading nil))) ; show the next heading 4597 (org-flag-heading nil))) ; show the next heading
4357 (funcall 'org-priority force-direction) 4598 (funcall 'org-priority force-direction)
4599 (end-of-line 1)
4358 (setq newhead (org-get-heading))) 4600 (setq newhead (org-get-heading)))
4359 (org-agenda-change-all-lines newhead hdmarker) 4601 (org-agenda-change-all-lines newhead hdmarker)
4360 (beginning-of-line 1))) 4602 (beginning-of-line 1)))
@@ -4519,7 +4761,7 @@ This is a command that has to be installed in `calendar-mode-map'."
4519 "ISO: " (calendar-iso-date-string date) "\n" 4761 "ISO: " (calendar-iso-date-string date) "\n"
4520 "Day of Yr: " (calendar-day-of-year-string date) "\n" 4762 "Day of Yr: " (calendar-day-of-year-string date) "\n"
4521 "Julian: " (calendar-julian-date-string date) "\n" 4763 "Julian: " (calendar-julian-date-string date) "\n"
4522 "Astronomic: " (calendar-astro-date-string date) 4764 "Astron. JD: " (calendar-astro-date-string date)
4523 " (Julian date number at noon UTC)\n" 4765 " (Julian date number at noon UTC)\n"
4524 "Hebrew: " (calendar-hebrew-date-string date) " (until sunset)\n" 4766 "Hebrew: " (calendar-hebrew-date-string date) " (until sunset)\n"
4525 "Islamic: " (calendar-islamic-date-string date) " (until sunset)\n" 4767 "Islamic: " (calendar-islamic-date-string date) " (until sunset)\n"
@@ -4865,10 +5107,11 @@ For file links, arg negates `org-line-numbers-in-file-links'."
4865 ((fboundp 'gnus-group-name) 5107 ((fboundp 'gnus-group-name)
4866 (gnus-group-name)) 5108 (gnus-group-name))
4867 (t "???")))) 5109 (t "???"))))
4868 (setq link (concat (if (org-xor arg org-usenet-links-prefer-google) 5110 (setq link (concat
4869 "http://groups.google.com/groups?group=" 5111 (if (org-xor arg org-usenet-links-prefer-google)
4870 "gnus:") 5112 "http://groups.google.com/groups?group="
4871 group)))) 5113 "gnus:")
5114 group))))
4872 5115
4873 ((memq major-mode '(gnus-summary-mode gnus-article-mode)) 5116 ((memq major-mode '(gnus-summary-mode gnus-article-mode))
4874 (and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary)) 5117 (and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary))
@@ -4919,9 +5162,7 @@ For file links, arg negates `org-line-numbers-in-file-links'."
4919 5162
4920(defun org-xor (a b) 5163(defun org-xor (a b)
4921 "Exclusive or." 5164 "Exclusive or."
4922 ;; (if a (not b) b) 5165 (if a (not b) b))
4923 (or (and a (not b))
4924 (and b (not a))))
4925 5166
4926(defun org-get-header (header) 5167(defun org-get-header (header)
4927 "Find a header field in the current buffer." 5168 "Find a header field in the current buffer."
@@ -5217,7 +5458,8 @@ SIZE is a string Columns x Rows like for example \"3x2\"."
5217 (point-at-bol) (point))) 5458 (point-at-bol) (point)))
5218 (beginning-of-line 1) 5459 (beginning-of-line 1)
5219 (newline)) 5460 (newline))
5220 (mapcar (lambda (x) (insert line)) (make-list rows t)) 5461 ;; (mapcar (lambda (x) (insert line)) (make-list rows t))
5462 (dotimes (i rows) (insert line))
5221 (goto-char pos) 5463 (goto-char pos)
5222 (if (> rows 1) 5464 (if (> rows 1)
5223 ;; Insert a hline after the first row. 5465 ;; Insert a hline after the first row.
@@ -5285,8 +5527,7 @@ Such a file can be imported into a spreadsheet program like Excel."
5285 (unless (or (not (file-exists-p file)) 5527 (unless (or (not (file-exists-p file))
5286 (y-or-n-p (format "Overwrite file %s? " file))) 5528 (y-or-n-p (format "Overwrite file %s? " file)))
5287 (error "Abort")) 5529 (error "Abort"))
5288 (save-excursion 5530 (with-current-buffer (find-file-noselect file)
5289 (find-file file)
5290 (setq buf (current-buffer)) 5531 (setq buf (current-buffer))
5291 (erase-buffer) 5532 (erase-buffer)
5292 (fundamental-mode) 5533 (fundamental-mode)
@@ -5406,12 +5647,18 @@ This is being used to correctly align a single field after TAB or RET.")
5406 (setq rfmt (concat rfmt "\n") 5647 (setq rfmt (concat rfmt "\n")
5407 hfmt (concat (substring hfmt 0 -1) "|\n")) 5648 hfmt (concat (substring hfmt 0 -1) "|\n"))
5408 ;; Produce the new table 5649 ;; Produce the new table
5409 (while lines 5650 ;;(while lines
5410 (setq l (pop lines)) 5651 ;; (setq l (pop lines))
5411 (if l 5652 ;; (if l
5412 (setq new (concat new (apply 'format rfmt 5653 ;; (setq new (concat new (apply 'format rfmt
5413 (append (pop fields) emptystrings)))) 5654 ;; (append (pop fields) emptystrings))))
5414 (setq new (concat new hfmt)))) 5655 ;; (setq new (concat new hfmt))))
5656 (setq new (mapconcat
5657 (lambda (l)
5658 (if l (apply 'format rfmt
5659 (append (pop fields) emptystrings))
5660 hfmt))
5661 lines ""))
5415 ;; Replace the old one 5662 ;; Replace the old one
5416 (delete-region beg end) 5663 (delete-region beg end)
5417 (move-marker end nil) 5664 (move-marker end nil)
@@ -8480,9 +8727,7 @@ to a visible line beginning. This makes the function of C-a more intuitive."
8480 (get-char-property (point) 'invisible)) 8727 (get-char-property (point) 'invisible))
8481 (save-excursion 8728 (save-excursion
8482 (skip-chars-backward "^\r\n") 8729 (skip-chars-backward "^\r\n")
8483 (if (bobp) 8730 (equal (char-before) ?\r))))
8484 nil
8485 (equal (char-before) ?\r)))))
8486 8731
8487(defun org-back-to-heading (&optional invisible-ok) 8732(defun org-back-to-heading (&optional invisible-ok)
8488 "Move to previous heading line, or beg of this line if it's a heading. 8733 "Move to previous heading line, or beg of this line if it's a heading.
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index 118ca3bb3fa..430a196166f 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -1272,7 +1272,7 @@ This is always set to nil at the entry to `table-with-cache-buffer' before execu
1272 (if (featurep 'xemacs) 1272 (if (featurep 'xemacs)
1273 (progn 1273 (progn
1274 (easy-menu-add-item nil '("Tools") table-global-menu-map)) 1274 (easy-menu-add-item nil '("Tools") table-global-menu-map))
1275 (easy-menu-add-item (current-global-map) '("menu-bar" "tools") '("--")) 1275 (easy-menu-add-item (current-global-map) '("menu-bar" "tools") "--")
1276 (easy-menu-add-item (current-global-map) '("menu-bar" "tools") table-global-menu-map))) 1276 (easy-menu-add-item (current-global-map) '("menu-bar" "tools") table-global-menu-map)))
1277 1277
1278;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1278;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/lisp/thumbs.el b/lisp/thumbs.el
index fd3cb13de98..1657c4b01a9 100644
--- a/lisp/thumbs.el
+++ b/lisp/thumbs.el
@@ -83,7 +83,7 @@
83 83
84(defcustom thumbs-thumbsdir-max-size 50000000 84(defcustom thumbs-thumbsdir-max-size 50000000
85 "Max size for thumbnails directory. 85 "Max size for thumbnails directory.
86When it reach that size (in bytes), a warning is send." 86When it reachs that size (in bytes), a warning is sent."
87 :type 'string 87 :type 'string
88 :group 'thumbs) 88 :group 'thumbs)
89 89
@@ -142,7 +142,7 @@ see some of your images."
142;; Initialize some variable, for later use. 142;; Initialize some variable, for later use.
143(defvar thumbs-temp-file 143(defvar thumbs-temp-file
144 (concat thumbs-temp-dir thumbs-temp-prefix) 144 (concat thumbs-temp-dir thumbs-temp-prefix)
145 "Temporary filesname for images.") 145 "Temporary filename for images.")
146 146
147(defvar thumbs-current-tmp-filename 147(defvar thumbs-current-tmp-filename
148 nil 148 nil
@@ -188,8 +188,8 @@ The name is made by appending a number to PREFIX, default \"Thumbs\"."
188 188
189(defun thumbs-cleanup-thumbsdir () 189(defun thumbs-cleanup-thumbsdir ()
190 "Clean the thumbnails directory. 190 "Clean the thumbnails directory.
191If the total size of all files in 'thumbs-thumbsdir' is bigger than 191If the total size of all files in `thumbs-thumbsdir' is bigger than
192'thumbs-thumbsdir-max-size', files are deleted until the max size is 192`thumbs-thumbsdir-max-size', files are deleted until the max size is
193reached." 193reached."
194 (let* ((filesL 194 (let* ((filesL
195 (sort 195 (sort
@@ -217,11 +217,11 @@ reached."
217FILEIN is the input file, 217FILEIN is the input file,
218FILEOUT is the output file, 218FILEOUT is the output file,
219ACTION is the command to send to convert. 219ACTION is the command to send to convert.
220Optional argument are: 220Optional arguments are:
221ARG any arguments to the ACTION command, 221ARG any arguments to the ACTION command,
222OUTPUT-FORMAT is the file format to output, default is jpeg 222OUTPUT-FORMAT is the file format to output (default is jpeg),
223ACTION-PREFIX is the symbol to place before the ACTION command 223ACTION-PREFIX is the symbol to place before the ACTION command
224 (default to '-' but can sometime be '+')." 224 (defaults to '-' but can sometimes be '+')."
225 (let ((command (format "%s %s%s %s \"%s\" \"%s:%s\"" 225 (let ((command (format "%s %s%s %s \"%s\" \"%s:%s\""
226 thumbs-conversion-program 226 thumbs-conversion-program
227 (or action-prefix "-") 227 (or action-prefix "-")
@@ -241,7 +241,7 @@ ACTION-PREFIX is the symbol to place before the ACTION command
241 (round (- n (/ (* d n) 100)))) 241 (round (- n (/ (* d n) 100))))
242 242
243(defun thumbs-increment-image-size (s) 243(defun thumbs-increment-image-size (s)
244 "Increment S (a cons of width x heigh)." 244 "Increment S (a cons of width x height)."
245 (cons 245 (cons
246 (thumbs-increment-image-size-element (car s) 246 (thumbs-increment-image-size-element (car s)
247 thumbs-image-resizing-step) 247 thumbs-image-resizing-step)
@@ -249,7 +249,7 @@ ACTION-PREFIX is the symbol to place before the ACTION command
249 thumbs-image-resizing-step))) 249 thumbs-image-resizing-step)))
250 250
251(defun thumbs-decrement-image-size (s) 251(defun thumbs-decrement-image-size (s)
252 "Decrement S (a cons of width x heigh)." 252 "Decrement S (a cons of width x height)."
253 (cons 253 (cons
254 (thumbs-decrement-image-size-element (car s) 254 (thumbs-decrement-image-size-element (car s)
255 thumbs-image-resizing-step) 255 thumbs-image-resizing-step)
@@ -349,7 +349,7 @@ Or, alternatively, a SIZE may be specified."
349 "Insert image IMG at point. 349 "Insert image IMG at point.
350TYPE and RELIEF will be used in constructing the image; see `image' 350TYPE and RELIEF will be used in constructing the image; see `image'
351in the emacs-lisp manual for further documentation. 351in the emacs-lisp manual for further documentation.
352if MARKED is non-nil, the image is marked." 352If MARKED is non-nil, the image is marked."
353 (let ((i `(image :type ,type 353 (let ((i `(image :type ,type
354 :file ,img 354 :file ,img
355 :relief ,relief 355 :relief ,relief
@@ -361,7 +361,7 @@ if MARKED is non-nil, the image is marked."
361 361
362(defun thumbs-insert-thumb (img &optional marked) 362(defun thumbs-insert-thumb (img &optional marked)
363 "Insert the thumbnail for IMG at point. 363 "Insert the thumbnail for IMG at point.
364if MARKED is non-nil, the image is marked" 364If MARKED is non-nil, the image is marked."
365 (thumbs-insert-image 365 (thumbs-insert-image
366 (thumbs-make-thumb img) 'jpeg thumbs-relief marked) 366 (thumbs-make-thumb img) 'jpeg thumbs-relief marked)
367 (put-text-property (1- (point)) (point) 367 (put-text-property (1- (point)) (point)
@@ -403,7 +403,7 @@ and SAME-WINDOW to show thumbs in the same window."
403 403
404;;;###autoload 404;;;###autoload
405(defun thumbs-dired-show-marked () 405(defun thumbs-dired-show-marked ()
406 "In Dired, make a thumbs buffer with all marked files." 406 "In dired, make a thumbs buffer with all marked files."
407 (interactive) 407 (interactive)
408 (thumbs-show-thumbs-list (dired-get-marked-files) nil t)) 408 (thumbs-show-thumbs-list (dired-get-marked-files) nil t))
409 409
@@ -435,7 +435,7 @@ and SAME-WINDOW to show thumbs in the same window."
435 435
436(defun thumbs-find-image-at-point (&optional img otherwin) 436(defun thumbs-find-image-at-point (&optional img otherwin)
437 "Display image IMG for thumbnail at point. 437 "Display image IMG for thumbnail at point.
438use another window it OTHERWIN is t." 438Use another window if OTHERWIN is t."
439 (interactive) 439 (interactive)
440 (let* ((i (or img (thumbs-current-image)))) 440 (let* ((i (or img (thumbs-current-image))))
441 (thumbs-find-image i (point) otherwin))) 441 (thumbs-find-image i (point) otherwin)))
@@ -499,7 +499,7 @@ Open another window."
499 (nreverse list)))) 499 (nreverse list))))
500 500
501(defun thumbs-delete-images () 501(defun thumbs-delete-images ()
502 "Delete the image at point (and it's thumbnail) (or marked files if any)." 502 "Delete the image at point (and its thumbnail) (or marked files if any)."
503 (interactive) 503 (interactive)
504 (let ((files (or thumbs-markedL (list (thumbs-current-image))))) 504 (let ((files (or thumbs-markedL (list (thumbs-current-image)))))
505 (if (yes-or-no-p (format "Really delete %d files? " (length files))) 505 (if (yes-or-no-p (format "Really delete %d files? " (length files)))
@@ -520,7 +520,7 @@ Open another window."
520 (delq x thumbs-markedL))))))))) 520 (delq x thumbs-markedL)))))))))
521 521
522(defun thumbs-rename-images (newfile) 522(defun thumbs-rename-images (newfile)
523 "Rename the image at point (and it's thumbnail) (or marked files if any)." 523 "Rename the image at point (and its thumbnail) (or marked files if any)."
524 (interactive "FRename to file or directory: ") 524 (interactive "FRename to file or directory: ")
525 (let ((files (or thumbs-markedL (list (thumbs-current-image)))) 525 (let ((files (or thumbs-markedL (list (thumbs-current-image))))
526 failures) 526 failures)
@@ -574,7 +574,7 @@ Open another window."
574 thumbs-current-image-filename i)))) 574 thumbs-current-image-filename i))))
575 575
576(defun thumbs-next-image () 576(defun thumbs-next-image ()
577 "Show next image." 577 "Show the next image."
578 (interactive) 578 (interactive)
579 (let* ((i (1+ thumbs-image-num)) 579 (let* ((i (1+ thumbs-image-num))
580 (list (thumbs-file-alist)) 580 (list (thumbs-file-alist))
@@ -782,7 +782,7 @@ ACTION and ARG should be a valid convert command."
782 782
783;;;###autoload 783;;;###autoload
784(defun thumbs-dired-setroot () 784(defun thumbs-dired-setroot ()
785 "In dired, Call the setroot program on the image at point." 785 "In dired, call the setroot program on the image at point."
786 (interactive) 786 (interactive)
787 (thumbs-call-setroot-command (dired-get-filename))) 787 (thumbs-call-setroot-command (dired-get-filename)))
788 788
diff --git a/lisp/tmm.el b/lisp/tmm.el
index 3e0a8e95701..168dbdd14dc 100644
--- a/lisp/tmm.el
+++ b/lisp/tmm.el
@@ -362,7 +362,7 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
362 (if (memq c tmm-short-cuts) 362 (if (memq c tmm-short-cuts)
363 (if (equal (buffer-name) "*Completions*") 363 (if (equal (buffer-name) "*Completions*")
364 (progn 364 (progn
365 (beginning-of-buffer) 365 (goto-char (point-min))
366 (re-search-forward 366 (re-search-forward
367 (concat "\\(^\\|[ \t]\\)" (char-to-string c) tmm-mid-prompt)) 367 (concat "\\(^\\|[ \t]\\)" (char-to-string c) tmm-mid-prompt))
368 (choose-completion)) 368 (choose-completion))
diff --git a/lisp/vc-cvs.el b/lisp/vc-cvs.el
index 1136ce565a8..e4e9f0b0137 100644
--- a/lisp/vc-cvs.el
+++ b/lisp/vc-cvs.el
@@ -236,16 +236,19 @@ See also variable `vc-cvs-sticky-date-format-string'."
236 236
237(defun vc-cvs-checkout-model (file) 237(defun vc-cvs-checkout-model (file)
238 "CVS-specific version of `vc-checkout-model'." 238 "CVS-specific version of `vc-checkout-model'."
239 (if (or (getenv "CVSREAD") 239 (if (getenv "CVSREAD")
240 ;; If the file is not writable (despite CVSREAD being
241 ;; undefined), this is probably because the file is being
242 ;; "watched" by other developers.
243 ;; (If vc-mistrust-permissions was t, we actually shouldn't
244 ;; trust this, but there is no other way to learn this from CVS
245 ;; at the moment (version 1.9).)
246 (string-match "r-..-..-." (nth 8 (file-attributes file))))
247 'announce 240 'announce
248 'implicit)) 241 (let ((attrib (file-attributes file)))
242 (if (and attrib ;; don't check further if FILE doesn't exist
243 ;; If the file is not writable (despite CVSREAD being
244 ;; undefined), this is probably because the file is being
245 ;; "watched" by other developers.
246 ;; (If vc-mistrust-permissions was t, we actually shouldn't
247 ;; trust this, but there is no other way to learn this from CVS
248 ;; at the moment (version 1.9).)
249 (string-match "r-..-..-." (nth 8 attrib)))
250 'announce
251 'implicit))))
249 252
250(defun vc-cvs-mode-line-string (file) 253(defun vc-cvs-mode-line-string (file)
251 "Return string for placement into the modeline for FILE. 254 "Return string for placement into the modeline for FILE.
diff --git a/lisp/vc.el b/lisp/vc.el
index c5929f1da8b..24fae514ea5 100644
--- a/lisp/vc.el
+++ b/lisp/vc.el
@@ -46,7 +46,8 @@
46 46
47;; This mode is fully documented in the Emacs user's manual. 47;; This mode is fully documented in the Emacs user's manual.
48;; 48;;
49;; Supported version-control systems presently include SCCS, RCS, and CVS. 49;; Supported version-control systems presently include CVS, RCS, GNU Arch,
50;; Subversion, Meta-CVS, and SCCS (or its free replacement, CSSC).
50;; 51;;
51;; Some features will not work with old RCS versions. Where 52;; Some features will not work with old RCS versions. Where
52;; appropriate, VC finds out which version you have, and allows or 53;; appropriate, VC finds out which version you have, and allows or
@@ -68,7 +69,7 @@
68;; 69;;
69;; The vc code maintains some internal state in order to reduce expensive 70;; The vc code maintains some internal state in order to reduce expensive
70;; version-control operations to a minimum. Some names are only computed 71;; version-control operations to a minimum. Some names are only computed
71;; once. If you perform version control operations with RCS/SCCS/CVS while 72;; once. If you perform version control operations with the backend while
72;; vc's back is turned, or move/rename master files while vc is running, 73;; vc's back is turned, or move/rename master files while vc is running,
73;; vc may get seriously confused. Don't do these things! 74;; vc may get seriously confused. Don't do these things!
74;; 75;;
@@ -737,6 +738,7 @@ in their implementation of vc-BACKEND-diff.")
737;; functions that operate on RCS revision numbers. This code should 738;; functions that operate on RCS revision numbers. This code should
738;; also be moved into the backends. It stays for now, however, since 739;; also be moved into the backends. It stays for now, however, since
739;; it is used in code below. 740;; it is used in code below.
741;;;###autoload
740(defun vc-trunk-p (rev) 742(defun vc-trunk-p (rev)
741 "Return t if REV is a revision on the trunk." 743 "Return t if REV is a revision on the trunk."
742 (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev)))) 744 (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev))))
diff --git a/lisp/vms-patch.el b/lisp/vms-patch.el
index 60033dc7f20..d8d44d9d752 100644
--- a/lisp/vms-patch.el
+++ b/lisp/vms-patch.el
@@ -193,5 +193,72 @@ following bindings are established.
193All other Emacs commands are still available." 193All other Emacs commands are still available."
194 t) 194 t)
195 195
196;;;
197;;; Filename handling in the minibuffer
198;;;
199(defun vms-magic-right-square-brace ()
200 "\
201Insert a right square brace, but do other things first depending on context.
202During filename completion, when point is at the end of the line and the
203character before is not a right square brace, do one of three things before
204inserting the brace:
205 - If there are already two left square braces preceding, do nothing special.
206 - If there is a previous right-square-brace, convert it to dot.
207 - If the character before is dot, delete it.
208Additionally, if the preceding chars are right-square-brace followed by
209either \"-\" or \"..\", strip one level of directory hierarchy."
210 (interactive)
211 (when (and minibuffer-completing-file-name
212 (= (point) (point-max))
213 (not (= 93 (char-before))))
214 (cond
215 ;; Avoid clobbering: user:[one.path][another.path
216 ((search-backward "[" (field-beginning) t 2))
217 ((search-backward "]" (field-beginning) t)
218 (delete-char 1)
219 (insert ".")
220 (goto-char (point-max)))
221 ((= ?. (char-before))
222 (delete-char -1)))
223 (goto-char (point-max))
224 (let ((specs '(".." "-"))
225 (pmax (point-max)))
226 (while specs
227 (let* ((up (car specs))
228 (len (length up))
229 (cut (- (point) len)))
230 (when (and (< (1+ len) pmax)
231 (= ?. (char-before cut))
232 (string= up (buffer-substring cut (point))))
233 (delete-char (- (1+ len)))
234 (while (not (let ((c (char-before)))
235 (or (= ?. c) (= 91 c))))
236 (delete-char -1))
237 (when (= ?. (char-before)) (delete-char -1))
238 (setq specs nil)))
239 (setq specs (cdr specs)))))
240 (insert "]"))
241
242(defun vms-magic-colon ()
243 "\
244Insert a colon, but do other things first depending on context.
245During filename completion, when point is at the end of the line
246and the line contains a right square brace, remove all characters
247from the beginning of the line up to and including such brace.
248This enables one to type a new filespec without having to delete
249the old one."
250 (interactive)
251 (when (and minibuffer-completing-file-name
252 (= (point) (point-max))
253 (search-backward "]" (field-beginning) t))
254 (delete-region (field-beginning) (1+ (point)))
255 (goto-char (point-max)))
256 (insert ":"))
257
258(let ((m minibuffer-local-completion-map))
259 (define-key m "]" 'vms-magic-right-square-brace)
260 (define-key m "/" 'vms-magic-right-square-brace)
261 (define-key m ":" 'vms-magic-colon))
262
196;;; arch-tag: c178494e-2c37-4d02-99b7-e47e615656cf 263;;; arch-tag: c178494e-2c37-4d02-99b7-e47e615656cf
197;;; vms-patch.el ends here 264;;; vms-patch.el ends here
diff --git a/lisp/window.el b/lisp/window.el
index 8c46addf444..c797111f111 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -543,8 +543,7 @@ Do not shrink to less than `window-min-height' lines.
543Do nothing if the buffer contains more lines than the present window height, 543Do nothing if the buffer contains more lines than the present window height,
544or if some of the window's contents are scrolled out of view, 544or if some of the window's contents are scrolled out of view,
545or if shrinking this window would also shrink another window. 545or if shrinking this window would also shrink another window.
546or if the window is the only window of its frame. 546or if the window is the only window of its frame."
547Return non-nil if the window was shrunk."
548 (interactive) 547 (interactive)
549 (when (null window) 548 (when (null window)
550 (setq window (selected-window))) 549 (setq window (selected-window)))
@@ -583,7 +582,7 @@ Return non-nil if the window was shrunk."
583 582
584(defun quit-window (&optional kill window) 583(defun quit-window (&optional kill window)
585 "Quit the current buffer. Bury it, and maybe delete the selected frame. 584 "Quit the current buffer. Bury it, and maybe delete the selected frame.
586\(The frame is deleted if it is contains a dedicated window for the buffer.) 585\(The frame is deleted if it contains a dedicated window for the buffer.)
587With a prefix argument, kill the buffer instead. 586With a prefix argument, kill the buffer instead.
588 587
589Noninteractively, if KILL is non-nil, then kill the current buffer, 588Noninteractively, if KILL is non-nil, then kill the current buffer,