aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorKaroly Lorentey2005-12-03 14:25:50 +0000
committerKaroly Lorentey2005-12-03 14:25:50 +0000
commit9ef706664e98e37e9633712126bae99869904677 (patch)
tree193bce7424700e4c7d70f54b04f7f81d64525554 /lisp
parent950bed4bb96d2a580818bdaab64a164c7c9a1c1e (diff)
parent9f6efa0c78099f2f028c4db1db5a58567a1cfb4e (diff)
downloademacs-9ef706664e98e37e9633712126bae99869904677.tar.gz
emacs-9ef706664e98e37e9633712126bae99869904677.zip
Merged from miles@gnu.org--gnu-2005 (patch 659-663)
Patches applied: * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-659 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-660 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-661 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-662 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-663 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-445
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog468
-rw-r--r--lisp/apropos.el21
-rw-r--r--lisp/arc-mode.el2
-rw-r--r--lisp/buff-menu.el9
-rw-r--r--lisp/calc/calc-embed.el2
-rw-r--r--lisp/calc/calc-misc.el7
-rw-r--r--lisp/calc/calc-prog.el2
-rw-r--r--lisp/calc/calc.el19
-rw-r--r--lisp/complete.el57
-rw-r--r--lisp/completion.el819
-rw-r--r--lisp/cus-edit.el19
-rw-r--r--lisp/cus-face.el11
-rw-r--r--lisp/custom.el10
-rw-r--r--lisp/dabbrev.el94
-rw-r--r--lisp/dframe.el4
-rw-r--r--lisp/ediff-wind.el10
-rw-r--r--lisp/ediff.el2
-rw-r--r--lisp/emacs-lisp/autoload.el9
-rw-r--r--lisp/emacs-lisp/cl-macs.el7
-rw-r--r--lisp/emacs-lisp/elp.el66
-rw-r--r--lisp/emulation/cua-rect.el10
-rw-r--r--lisp/emulation/viper-keym.el5
-rw-r--r--lisp/emulation/viper.el5
-rw-r--r--lisp/files.el2
-rw-r--r--lisp/font-lock.el5
-rw-r--r--lisp/gnus/ChangeLog6
-rw-r--r--lisp/gnus/gnus-delay.el3
-rw-r--r--lisp/help-fns.el5
-rw-r--r--lisp/help.el122
-rw-r--r--lisp/hi-lock.el178
-rw-r--r--lisp/ido.el149
-rw-r--r--lisp/info.el71
-rw-r--r--lisp/international/latexenc.el3
-rw-r--r--lisp/isearch.el21
-rw-r--r--lisp/loadup.el4
-rw-r--r--lisp/log-edit.el113
-rw-r--r--lisp/longlines.el17
-rw-r--r--lisp/ls-lisp.el31
-rw-r--r--lisp/mail/mailheader.el4
-rw-r--r--lisp/mail/sendmail.el77
-rw-r--r--lisp/mouse.el13
-rw-r--r--lisp/net/goto-addr.el4
-rw-r--r--lisp/paren.el9
-rw-r--r--lisp/progmodes/compile.el13
-rw-r--r--lisp/progmodes/gdb-ui.el167
-rw-r--r--lisp/progmodes/gud.el39
-rw-r--r--lisp/progmodes/octave-inf.el7
-rw-r--r--lisp/progmodes/sh-script.el2
-rw-r--r--lisp/recentf.el85
-rw-r--r--lisp/replace.el100
-rw-r--r--lisp/simple.el24
-rw-r--r--lisp/speedbar.el12
-rw-r--r--lisp/term/mac-win.el11
-rw-r--r--lisp/term/w32-win.el2
-rw-r--r--lisp/textmodes/flyspell.el51
-rw-r--r--lisp/textmodes/org.el399
-rw-r--r--lisp/view.el13
-rw-r--r--lisp/xt-mouse.el10
58 files changed, 2147 insertions, 1283 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 3a9e3f9c83d..00797a5140e 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,465 @@
12005-12-01 Nick Roberts <nickrob@snap.net.nz>
2
3 * progmodes/gdb-ui.el (gdb-ann3): Bind mouse-2 to gdb-mouse-until
4 in the margin also.
5 (gdb-breakpoints-mode-map): Use D instead of d for
6 gdb-delete-breakpoint.
7 (gdb-get-frame-number): Require a number to match on.
8 (gdb-threads-mode-map): Add follow-link binding.
9
102005-11-30 Jason Rumney <jasonr@gnu.org>
11
12 * isearch.el (isearch-mode-map): Avoid exiting search on
13 language-change event.
14
152005-11-30 Romain Francoise <romain@orebokech.com>
16
17 * speedbar.el (speedbar-default-position): New defcustom.
18 (speedbar-frame-reposition-smartly): Use it.
19
20 * dframe.el (dframe-reposition-frame-emacs): Fix position
21 computation for 'left location.
22 Update copyright year.
23
242005-11-30 Stefan Monnier <monnier@iro.umontreal.ca>
25
26 * help.el (help-map): Move initialization into declaration.
27
28 * emacs-lisp/autoload.el (make-autoload): Handle defgroup specially.
29
30 * help-fns.el (help-argument-name): Don't autoload.
31 It's useless and triggers a bug in cus-dep.el causing ldefs-boot
32 to be re-loaded when customizing the `help' group.
33
342005-11-30 John Paul Wallington <jpw@gnu.org>
35
36 * help-fns.el (describe-function-1): Fill arglist output.
37
382005-11-30 Kim F. Storm <storm@cua.dk>
39
40 * emulation/cua-rect.el (cua--rectangle-overlays): Make permanent-local.
41 (cua--rectangle-post-command): Cleanup overlays and deactivate mark
42 after revert-buffer (or anything else which kills all local variables).
43
44 * apropos.el (apropos-parse-pattern): Doc fix.
45 Set apropos-regexp directly, rather than expecting callers to do so.
46 (apropos-command, apropos, apropos-value, apropos-documentation):
47 Simplify calls to apropos-parse-pattern.
48
492005-11-29 Chong Yidong <cyd@stupidchicken.com>
50
51 * hi-lock.el (hi-lock-line-face-buffer, hi-lock-face-buffer)
52 (hi-lock-face-phrase-buffer): Use hi-yellow face.
53 (hi-lock-write-interactive-patterns): Use comment-region.
54
55 * longlines.el (longlines-mode): Add mail-setup-hook.
56
57 * mail/mailheader.el, mail/sendmail.el: Revert 2005-11-17 changes.
58
59 * simple.el (sendmail-user-agent-compose, next-line):
60 Conditionally use hard-newline.
61
622005-11-29 Reiner Steib <Reiner.Steib@gmx.de>
63
64 * international/latexenc.el (latex-inputenc-coding-alist):
65 Reword doc string.
66
672005-11-29 Chong Yidong <cyd@stupidchicken.com>
68
69 * help.el (describe-key-briefly, describe-key): Recognize default
70 bindings.
71
722005-11-29 Romain Francoise <romain@orebokech.com>
73
74 * view.el (view-inhibit-help-message): New defcustom.
75 (view-mode-enter): Use it.
76
772005-11-29 Michael Kifer <kifer@cs.stonybrook.edu>
78
79 * ediff-wind (ediff-setup-control-frame, ediff-make-wide-display):
80 Preserve user position.
81
822005-11-28 Luc Teirlinck <teirllm@auburn.edu>
83
84 * font-lock.el: Throw error if facemenu is not loaded to prevent
85 accidental change of loading order in loadup.el. (Suggested by RMS.)
86
87 * loadup.el: Add comment explaining why facemenu must be loaded
88 before font-lock.
89
902005-11-28 Jay Belanger <belanger@truman.edu>
91
92 * calc/calc.el: Change global keybinding for calc-dispatch to "\C-x*".
93 (calc-dispatch-map): Add more keys for `calc-same-interface'.
94
95 * calc/calc-misc.el (calc-dispatch-help): Update docstring.
96
97 * calc/calc-embed.el (calc-do-embedded): Update help message.
98
99 * calc/calc-prog.el (calc-user-define-invokation): Update help message.
100
1012005-11-28 Stefan Monnier <monnier@iro.umontreal.ca>
102
103 * log-edit.el (log-edit-insert-cvs-rcstemplate): Ignore stderr.
104
105 * emacs-lisp/elp.el (elp-not-profilable): Replace interactive-p with
106 called-interactively-p.
107 (elp-profilable-p): Rename from elp-not-profilable-p.
108 Invert result and take into account macros and autoloaded functions.
109 (elp-instrument-function): Update call.
110 (elp-instrument-package): Update call. Add completion.
111 (elp-pack-number): Use match-string.
112 (elp-results-jump-to-definition-by-mouse): Merge into
113 elp-results-jump-to-definition and then remove.
114 (elp-output-insert-symname): Make help echo text single-line.
115
116 * replace.el (query-replace-map): Move initialization into declaration.
117 (occur-engine): Use with-current-buffer.
118 (occur-mode-goto-occurrence): Make it work for mouse-clicks as well.
119 (occur-mode-mouse-goto): Replace with an alias.
120
1212005-11-28 Juri Linkov <juri@jurta.org>
122
123 * simple.el (quoted-insert): Let-bind input-method-function to nil.
124
125 * term/w32-win.el: Bind [S-tab] to [backtab].
126
127 * info.el (Info-fontify-node): Set 2nd arg `noerror' of
128 `Info-find-file' to t.
129
130 * replace.el (occur-mode-mouse-goto): Pop, don't switch.
131 (occur-mode-goto-occurrence): Let-bind same-window-buffer-names
132 and same-window-regexps.
133 (occur-next-error): Don't move point for arg 0.
134
1352005-11-28 Chong Yidong <cyd@stupidchicken.com>
136
137 * replace.el (occur-mode-goto-occurrence): Pop, don't switch.
138
1392005-11-28 Stefan Monnier <monnier@iro.umontreal.ca>
140
141 * log-edit.el (log-edit-changelog-use-first): New var.
142 (log-edit-changelog-ours-p): Use it.
143 (log-edit-insert-changelog): Set it with new arg `use-first'.
144 (log-edit-insert-cvs-rcstemplate, log-edit-insert-filenames): New funs.
145 (log-edit-hook): Add them to the list of suggested options.
146
147 * textmodes/flyspell.el (flyspell-last-buffer): New var.
148 (flyspell-accept-buffer-local-defs): Use it to avoid doing silly
149 redundant work.
150 (flyspell-mode-on): Use add-hook for after-change-functions.
151 (flyspell-mode-off): Use remove-hook for after-change-functions.
152 (flyspell-changes): Make it buffer-local.
153 (flyspell-after-change-function): Make it non-interactive. Use push.
154 (flyspell-post-command-hook): Check input-pending-p while processing
155 the potentially long list of buffer changes.
156
1572005-11-28 L$,1 q(Brentey K,Aa(Broly <lorentey@elte.hu>
158
159 * buff-menu.el (list-buffers-noselect): Display the selected
160 frame's buffer list, not the global one.
161
1622005-11-28 Nick Roberts <nickrob@snap.net.nz>
163
164 * xt-mouse.el (xterm-mouse-event): Set last-input-event so
165 that (list last-input-event) works as in interactive spec.
166
1672005-11-27 Luc Teirlinck <teirllm@auburn.edu>
168
169 * loadup.el ("facemenu"): Load facemenu before font-lock, because
170 `facemenu-keymap' needs to be defined when font-lock is loaded.
171 Otherwise, `M-o M-o' is not bound to `font-lock-fontify-block'.
172
1732005-11-27 Stefan Monnier <monnier@iro.umontreal.ca>
174
175 * completion.el: Remove useless leading * in defcustom docstrings.
176 (save-completions-file-name): Use ~/.emacs.d if available.
177 (completion-standard-syntax-table): Rename from
178 cmpl-standard-syntax-table and fold initialization into declaration,
179 thus removing cmpl-make-standard-completion-syntax-table.
180 (completion-lisp-syntax-table, completion-c-syntax-table)
181 (completion-fortran-syntax-table, completion-c-def-syntax-table): Idem.
182 (cmpl-saved-syntax, cmpl-saved-point): Remove.
183 (symbol-under-point, symbol-before-point)
184 (symbol-under-or-before-point, symbol-before-point-for-complete)
185 (add-completions-from-c-buffer): Use with-syntax-table.
186 (make-completion): Don't return a list of completion entries.
187 Update callers.
188 (cmpl-prefix-entry-head, cmpl-prefix-entry-tail): Use defalias.
189 (completion-initialize): Rename from initialize-completions.
190 (completion-find-file-hook): Rename from cmpl-find-file-hook.
191 (kill-emacs-save-completions): Collect stats here.
192 (save-completions-to-file, load-completions-from-file):
193 Use with-current-buffer.
194 (completion-def-wrapper): Rename from def-completion-wrapper. Make it
195 into a function. Move all calls to toplevel.
196 (completion-lisp-mode-hook): New fun.
197 (completion-c-mode-hook, completion-setup-fortran-mode):
198 Set the syntax-table here. Use local-set-key.
199 (completion-saved-bindings): New var.
200 (dynamic-completion-mode): Make it into a proper minor mode.
201 (load-completions-from-file): Remove unused var `num-uses'.
202
203 * emacs-lisp/cl-macs.el (defstruct): Don't define the default
204 constructor if it is explicitly overridden.
205
206 * complete.el (PC-completion-as-file-name-predicate):
207 Use minibuffer-completing-file-name.
208 (partial-completion-mode): Use find-file-not-found-functions.
209 (PC-lisp-complete-symbol): Use with-syntax-table.
210 (PC-look-for-include-file): Remove dead setq.
211 (PC-look-for-include-file, PC-expand-many-files, PC-do-completion)
212 (PC-complete): Use with-current-buffer.
213
214 * progmodes/sh-script.el (sh-font-lock-syntactic-keywords): \ doesn't
215 escape single quotes.
216
2172005-11-27 Luc Teirlinck <teirllm@auburn.edu>
218
219 * dabbrev.el (dabbrev-completion): Simplify code, by getting rid
220 of `if' whose condition always returned nil. Doc fix.
221
222 * buff-menu.el (Buffer-menu-revert-function): Make the selected
223 window's buffer the current buffer around the call to
224 `list-buffers-noselect'. This is necessary to mark that buffer
225 with a `.' in the Buffer Menu when called from Lisp, for instance
226 by Auto Revert Mode.
227
2282005-11-28 Nick Roberts <nickrob@snap.net.nz>
229
230 * progmodes/gdb-ui.el (gdb-stopped): Detect child process when
231 attaching to it.
232 (gdb-pre-prompt): Make sure gdb-error is reset.
233
234 * progmodes/gud.el (gud-gdb-marker-filter): When GDB is invoked
235 with a child process, detect it.
236 (gud-speedbar-buttons): Match regexp more carefully.
237
2382005-11-27 Richard M. Stallman <rms@gnu.org>
239
240 * mouse.el (mouse-drag-move-window-bottom):
241 Use adjust-window-trailing-edge.
242
2432005-11-27 Luc Teirlinck <teirllm@auburn.edu>
244
245 * simple.el (blink-matching-open): Ignore
246 `blink-matching-paren-on-screen' if `show-paren-mode' is enabled.
247 (blink-matching-paren-on-screen): Update docstring.
248
249 * paren.el (show-paren-mode): No longer change
250 `blink-matching-paren-on-screen'.
251
2522005-11-27 John Paul Wallington <jpw@pobox.com>
253
254 * progmodes/gdb-ui.el (gdb-goto-breakpoint, gdb-frames-select)
255 (gdb-threads-select, gdb-edit-register-value):
256 Use `posn-set-point' instead of `mouse-set-point' because the
257 latter is not fbound when configured without X.
258
2592005-11-27 Kim F. Storm <storm@cua.dk>
260
261 * emulation/cua-rect.el (cua--highlight-rectangle): Preserve
262 existing face when partially highlighting a TAB in a rectangle.
263
2642005-11-26 Kim F. Storm <storm@cua.dk>
265
266 * ido.el (ido-mode-map): Doc fix.
267 (ido-mode-common-map, ido-mode-file-map)
268 (ido-mode-file-dir-map, ido-mode-buffer-map): New keymaps.
269 (ido-define-mode-map): Rewrite. Select one of the new maps as
270 parent for ido-mode-map instead of building from scratch.
271 (ido-init-mode-maps): New defun to initialize new maps.
272 (ido-mode): Call it.
273 (ido-switch-buffer): Doc fix -- use \<ido-mode-buffer-map>.
274 (ido-find-file): Doc fix -- use \<ido-mode-file-map>.
275
2762005-11-26 John Paul Wallington <jpw@pobox.com>
277
278 * arc-mode.el (archive-extract): Use `posn-set-point' instead of
279 `mouse-set-point' because the latter is not fbound when configured
280 without X.
281
2822005-11-26 Thien-Thi Nguyen <ttn@gnu.org>
283
284 * files.el (file-relative-name): Doc fix.
285
2862005-11-26 Kurt Hornik <Kurt.Hornik@wu-wien.ac.at>
287
288 * progmodes/octave-inf.el (inferior-octave-startup): Force a
289 non-empty string for secondary prompt PS2.
290
2912005-11-25 Chong Yidong <cyd@stupidchicken.com>
292
293 * progmodes/compile.el (compilation-setup): Fix last change.
294
2952005-11-26 Nick Roberts <nickrob@snap.net.nz>
296
297 * progmodes/gdb-ui.el (gdb-info-breakpoints-custom)
298 (gdb-mouse-toggle-breakpoint-margin)
299 (gdb-mouse-toggle-breakpoint-fringe, gdb-threads-select):
300 Add gdb-server-prefix to keep out of command history.
301 (gdb-edit-register-value): New function.
302 (gdb-registers-mode-map): Bind mouse-2 and RET to it.
303 (gdb-info-registers-custom): Use above map.
304
3052005-11-25 Chong Yidong <cyd@stupidchicken.com>
306
307 * custom.el (enable-theme): Signal error if argument is not a
308 theme. Don't recalculate a face if it's not loaded yet.
309
310 * cus-face.el (custom-theme-set-faces): Don't change saved-face if
311 the `user' theme is in effect.
312
313 * info.el (Info-on-current-buffer): Record actual filename in
314 Info-current-file, instead of t, or a fake filename if a non-file
315 buffer. Make autoload.
316 (Info-find-node, Info-revert-find-node): No need to check for
317 Info-current-file nil.
318 (Info-set-mode-line, Info-up, Info-copy-current-node-name):
319 Info-current-file is now never `t'.
320 (Info-fontify-node): Many simplifications due to Info-current-file
321 always being valid. Use Info-find-file to find node filename.
322
3232005-11-25 David Kastrup <dak@gnu.org>
324
325 * longlines.el (longlines-wrap-line): Reorder wrapping to "insert
326 new character, then delete" in order to preserve markers.
327
3282005-11-25 David Ponce <david@dponce.com>
329
330 * recentf.el (recentf-arrange-by-rule): Handle a special
331 `auto-mode-alist'-like "strip suffix" rule.
332 (recentf-build-mode-rules): Handle second level auto-mode entries.
333
3342005-11-25 Michael Kifer <kifer@cs.stonybrook.edu>
335
336 * viper-keym.el (viper-ESC-key): Use different values in terminal and
337 window modes.
338
339 * viper.el (viper-emacs-state-mode-list): Delete mail-mode, add
340 jde-javadoc-checker-report-mode.
341
342 * ediff-wind (ediff-make-wide-display): Slight simplification.
343
344 * ediff.el (ediff-date): Change the date of last update.
345
3462005-11-24 Chong Yidong <cyd@stupidchicken.com>
347
348 * hi-lock.el (hi-lock-buffer-mode): Renamed from `hi-lock-mode'.
349 Use define-minor-mode, and make it a local mode. Turn on font-lock.
350 (hi-lock-mode): New global minor mode.
351 (turn-on-hi-lock-if-enabled): New function.
352 (hi-lock-line-face-buffer, hi-lock-face-buffer, hi-lock-set-pattern):
353 Change arguments to regexp and face instead of a font-lock pattern.
354 Directly set face property, instead of refontifying.
355 (hi-lock-font-lock-hook): Check if font-lock is being turned on.
356 (hi-lock-find-patterns): Use line-number-at-pos.
357
358 (hi-lock-face-phrase-buffer): Call hi-lock-buffer-mode. Use new
359 arguments for hi-lock-set-pattern.
360 (hi-lock-unface-buffer, hi-lock-set-file-patterns): Call
361 font-lock-fontify-buffer.
362 (hi-lock-find-file-hook, hi-lock-current-line)
363 (hi-lock-refontify, hi-lock-set-patterns): Delete unused functions.
364
365 (hi-lock-font-lock-hook): Turn off hi-lock when font lock is
366 turned off.
367
368 * progmodes/compile.el (compilation-setup): Don't fiddle with
369 font-lock-defaults.
370
3712005-11-25 Nick Roberts <nickrob@snap.net.nz>
372
373 * progmodes/gdb-ui.el (gdb-var-create-handler)
374 (gdb-var-list-children-handler): Find values for all variable
375 objects. gud-speedbar-buttons decides whether to display them.
376
3772005-11-24 Romain Francoise <romain@orebokech.com>
378
379 * info.el (Info-speedbar-fetch-file-nodes): Prefix temporary
380 buffer name with a space.
381
3822005-11-24 Carsten Dominik <dominik@science.uva.nl>
383
384 * textmodes/org.el: (org-export-plain-list-max-depth): Renamed from
385 `org-export-local-list-max-depth'. Change default value to 3.
386 (org-auto-renumber-ordered-lists)
387 (org-plain-list-ordered-item-terminator): New options.
388 (org-at-item-p, org-beginning-of-item, org-end-of-item)
389 (org-get-indentation, org-get-string-indentation)
390 (org-maybe-renumber-ordered-list, org-renumber-ordered-list): New
391 functions.
392 (org-move-item-down, org-move-item-up): New commands.
393 (org-export-as-html): New classes for CSS support. Bug fix in
394 regular expression detecting fixed-width regions. Respect
395 `org-local-list-ordered-item-terminator'.
396 (org-set-autofill-regexps, org-adaptive-fill-function): "1)" is
397 also a list item.
398 (org-metaup, org-metadown, org-shiftmetaup, org-shiftmetadown):
399 New item moving functions.
400
4012005-11-24 Juri Linkov <juri@jurta.org>
402
403 * isearch.el (isearch-repeat): With empty search ring set
404 `isearch-error' to the error string instead of signaling error
405 with the function `error'.
406
4072005-11-24 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
408
409 * term/mac-win.el: Make modifier `ctrl' an alias for `control'.
410
4112005-11-24 Nick Roberts <nickrob@snap.net.nz>
412
413 * progmodes/gdb-ui.el (gdb-speedbar-auto-raise): New function
414 and variable.
415 (gdb-var-create-handler, gdb-var-list-children-handler):
416 Don't match on "char **...".
417 (gdb-var-update-handler): Find values for all variable objects.
418 (gdb-info-frames-custom): Identify frames by leading "#".
419
420 * progmodes/gud.el (gud-speedbar-menu-items): Add
421 gdb-speedbar-auto-raise as radio button.
422 (gud-speedbar-buttons): Raise speedbar if requested.
423 Don't match on "char **...".
424 (gud-speedbar-buttons): Add (pointer) value for non-leaves.
425 Make it editable.
426
4272005-11-23 Chong Yidong <cyd@stupidchicken.com>
428
429 * info.el (Info-fontify-node): Handle the case where
430 Info-current-file is t.
431
4322005-11-23 Stefan Monnier <monnier@iro.umontreal.ca>
433
434 * simple.el (blink-matching-open): Fix off-by-one in last change.
435
4362005-11-23 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
437
438 * term/mac-win.el: Don't change default directory.
439
4402005-11-22 Luc Teirlinck <teirllm@auburn.edu>
441
442 * cus-edit.el (Custom-reset-standard): Make it handle Custom group
443 buffers correctly. (It used to throw an error in such buffers.)
444 Make it ask for confirmation in group buffers and other Custom
445 buffers containing more than one customization item.
446
4472005-11-22 John Paul Wallington <jpw@gnu.org>
448
449 * net/goto-addr.el (goto-address-fontify): Put `follow-link'
450 property on mail and url overlays.
451 (goto-address-at-point): Use `posn-set-point' instead of
452 `mouse-set-point' because the latter is not fbound when configured
453 without X.
454
4552005-11-22 Lars Hansen <larsh@soem.dk>
456
457 * ls-lisp.el (ls-lisp-parse-symlink): Delete.
458 (ls-lisp-classify, ls-lisp-format): Delete call to
459 ls-lisp-parse-symlink.
460 (ls-lisp-handle-switches): Handle symlinks to directories as
461 directories when ls-lisp-dirs-first in non-nil.
462
12005-11-21 Luc Teirlinck <teirllm@auburn.edu> 4632005-11-21 Luc Teirlinck <teirllm@auburn.edu>
2 464
3 * startup.el (command-line): Make sure that loaddefs.el is handled 465 * startup.el (command-line): Make sure that loaddefs.el is handled
@@ -37,6 +499,12 @@
37 * faces.el: Revert 2005-11-17 change. :ignore-defface is now 499 * faces.el: Revert 2005-11-17 change. :ignore-defface is now
38 handled automagically. 500 handled automagically.
39 501
5022005-11-20 Andreas Schwab <schwab@suse.de>
503
504 * descr-text.el (describe-char): When copying overlays put them
505 over the full char description instead of just the first character
506 of it.
507
402005-11-20 Juri Linkov <juri@jurta.org> 5082005-11-20 Juri Linkov <juri@jurta.org>
41 509
42 * simple.el (what-cursor-position): 510 * simple.el (what-cursor-position):
diff --git a/lisp/apropos.el b/lisp/apropos.el
index 5eda7567ef0..4e5109c1efb 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -301,7 +301,9 @@ kind of objects to search."
301 301
302(defun apropos-parse-pattern (pattern) 302(defun apropos-parse-pattern (pattern)
303 "Rewrite a list of words to a regexp matching all permutations. 303 "Rewrite a list of words to a regexp matching all permutations.
304If PATTERN is a string, that means it is already a regexp." 304If PATTERN is a string, that means it is already a regexp.
305This updates variables `apropos-pattern', `apropos-pattern-quoted',
306`apropos-regexp', `apropos-words', and `apropos-all-words-regexp'."
305 (setq apropos-words nil 307 (setq apropos-words nil
306 apropos-all-words nil) 308 apropos-all-words nil)
307 (if (consp pattern) 309 (if (consp pattern)
@@ -325,11 +327,14 @@ If PATTERN is a string, that means it is already a regexp."
325 (setq syn (cdr syn)))) 327 (setq syn (cdr syn))))
326 (setq apropos-words (cons s apropos-words) 328 (setq apropos-words (cons s apropos-words)
327 apropos-all-words (cons a apropos-all-words)))) 329 apropos-all-words (cons a apropos-all-words))))
328 (setq apropos-all-words-regexp (apropos-words-to-regexp apropos-all-words ".+")) 330 (setq apropos-all-words-regexp
329 (apropos-words-to-regexp apropos-words ".*?")) 331 (apropos-words-to-regexp apropos-all-words ".+"))
332 (setq apropos-regexp
333 (apropos-words-to-regexp apropos-words ".*?")))
330 (setq apropos-pattern-quoted (regexp-quote pattern) 334 (setq apropos-pattern-quoted (regexp-quote pattern)
331 apropos-all-words-regexp pattern 335 apropos-all-words-regexp pattern
332 apropos-pattern pattern))) 336 apropos-pattern pattern
337 apropos-regexp pattern)))
333 338
334 339
335(defun apropos-calc-scores (str words) 340(defun apropos-calc-scores (str words)
@@ -442,7 +447,7 @@ while a list of strings is used as a word list."
442 (if (or current-prefix-arg apropos-do-all) 447 (if (or current-prefix-arg apropos-do-all)
443 "command or function" "command")) 448 "command or function" "command"))
444 current-prefix-arg)) 449 current-prefix-arg))
445 (setq apropos-regexp (apropos-parse-pattern pattern)) 450 (apropos-parse-pattern pattern)
446 (let ((message 451 (let ((message
447 (let ((standard-output (get-buffer-create "*Apropos*"))) 452 (let ((standard-output (get-buffer-create "*Apropos*")))
448 (print-help-return-message 'identity)))) 453 (print-help-return-message 'identity))))
@@ -508,7 +513,7 @@ show unbound symbols and key bindings, which is a little more
508time-consuming. Returns list of symbols and documentation found." 513time-consuming. Returns list of symbols and documentation found."
509 (interactive (list (apropos-read-pattern "symbol") 514 (interactive (list (apropos-read-pattern "symbol")
510 current-prefix-arg)) 515 current-prefix-arg))
511 (setq apropos-regexp (apropos-parse-pattern pattern)) 516 (apropos-parse-pattern pattern)
512 (apropos-symbols-internal 517 (apropos-symbols-internal
513 (apropos-internal apropos-regexp 518 (apropos-internal apropos-regexp
514 (and (not do-all) 519 (and (not do-all)
@@ -577,7 +582,7 @@ at the function and at the names and values of properties.
577Returns list of symbols and values found." 582Returns list of symbols and values found."
578 (interactive (list (apropos-read-pattern "value") 583 (interactive (list (apropos-read-pattern "value")
579 current-prefix-arg)) 584 current-prefix-arg))
580 (setq apropos-regexp (apropos-parse-pattern pattern)) 585 (apropos-parse-pattern pattern)
581 (or do-all (setq do-all apropos-do-all)) 586 (or do-all (setq do-all apropos-do-all))
582 (setq apropos-accumulator ()) 587 (setq apropos-accumulator ())
583 (let (f v p) 588 (let (f v p)
@@ -623,7 +628,7 @@ bindings.
623Returns list of symbols and documentation found." 628Returns list of symbols and documentation found."
624 (interactive (list (apropos-read-pattern "documentation") 629 (interactive (list (apropos-read-pattern "documentation")
625 current-prefix-arg)) 630 current-prefix-arg))
626 (setq apropos-regexp (apropos-parse-pattern pattern)) 631 (apropos-parse-pattern pattern)
627 (or do-all (setq do-all apropos-do-all)) 632 (or do-all (setq do-all apropos-do-all))
628 (setq apropos-accumulator () apropos-files-scanned ()) 633 (setq apropos-accumulator () apropos-files-scanned ())
629 (let ((standard-input (get-buffer-create " apropos-temp")) 634 (let ((standard-input (get-buffer-create " apropos-temp"))
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index ae5ff9a4dbc..c376070ea3b 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -895,7 +895,7 @@ using `make-temp-file', and the generated name is returned."
895(defun archive-extract (&optional other-window-p event) 895(defun archive-extract (&optional other-window-p event)
896 "In archive mode, extract this entry of the archive into its own buffer." 896 "In archive mode, extract this entry of the archive into its own buffer."
897 (interactive (list nil last-input-event)) 897 (interactive (list nil last-input-event))
898 (if event (mouse-set-point event)) 898 (if event (posn-set-point (event-end event)))
899 (let* ((view-p (eq other-window-p 'view)) 899 (let* ((view-p (eq other-window-p 'view))
900 (descr (archive-get-descr)) 900 (descr (archive-get-descr))
901 (ename (aref descr 0)) 901 (ename (aref descr 0))
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index e48aa9e34b4..818fc19a4fd 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -210,7 +210,12 @@ Letters do not insert themselves; instead, they are commands.
210 (prop (point-min)) 210 (prop (point-min))
211 ;; do not make undo records for the reversion. 211 ;; do not make undo records for the reversion.
212 (buffer-undo-list t)) 212 (buffer-undo-list t))
213 (list-buffers-noselect Buffer-menu-files-only) 213 ;; We can be called by Auto Revert Mode with the "*Buffer Menu*"
214 ;; temporarily the current buffer. Make sure that the
215 ;; interactively current buffer is correctly identified with a `.'
216 ;; by `list-buffers-noselect'.
217 (with-current-buffer (window-buffer)
218 (list-buffers-noselect Buffer-menu-files-only))
214 (if oline 219 (if oline
215 (while (setq prop (next-single-property-change prop 'buffer)) 220 (while (setq prop (next-single-property-change prop 'buffer))
216 (when (eq (get-text-property prop 'buffer) oline) 221 (when (eq (get-text-property prop 'buffer) oline)
@@ -717,7 +722,7 @@ For more information, see the function `buffer-menu'."
717 (if (memq c '(?\n ?\s)) c underline)) 722 (if (memq c '(?\n ?\s)) c underline))
718 header))))) 723 header)))))
719 ;; Collect info for every buffer we're interested in. 724 ;; Collect info for every buffer we're interested in.
720 (dolist (buffer (or buffer-list (buffer-list))) 725 (dolist (buffer (or buffer-list (buffer-list (selected-frame))))
721 (with-current-buffer buffer 726 (with-current-buffer buffer
722 (let ((name (buffer-name)) 727 (let ((name (buffer-name))
723 (file buffer-file-name)) 728 (file buffer-file-name))
diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el
index 4127c0b33da..7878034694e 100644
--- a/lisp/calc/calc-embed.el
+++ b/lisp/calc/calc-embed.el
@@ -315,7 +315,7 @@
315 (or (eq calc-embedded-quiet t) 315 (or (eq calc-embedded-quiet t)
316 (message "Embedded Calc mode enabled; %s to return to normal" 316 (message "Embedded Calc mode enabled; %s to return to normal"
317 (if calc-embedded-quiet 317 (if calc-embedded-quiet
318 "Type `M-# x'" 318 "Type `C-x * x'"
319 "Give this command again"))))) 319 "Give this command again")))))
320 (scroll-down 0)) ; fix a bug which occurs when truncate-lines is changed. 320 (scroll-down 0)) ; fix a bug which occurs when truncate-lines is changed.
321 321
diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el
index ba80f455b4f..ca8e8bbdbfe 100644
--- a/lisp/calc/calc-misc.el
+++ b/lisp/calc/calc-misc.el
@@ -33,7 +33,7 @@
33(require 'calc-macs) 33(require 'calc-macs)
34 34
35(defun calc-dispatch-help (arg) 35(defun calc-dispatch-help (arg)
36 "M-# is a prefix key; follow it with one of these letters: 36 "C-x* is a prefix key sequence; follow it with one of these letters:
37 37
38For turning Calc on and off: 38For turning Calc on and off:
39 C calc. Start the Calculator in a window at the bottom of the screen. 39 C calc. Start the Calculator in a window at the bottom of the screen.
@@ -73,8 +73,9 @@ Miscellaneous:
73 M read-kbd-macro. Read a region of keystroke names as a keyboard macro. 73 M read-kbd-macro. Read a region of keystroke names as a keyboard macro.
74 0 (zero) calc-reset. Reset Calc stack and modes to default state. 74 0 (zero) calc-reset. Reset Calc stack and modes to default state.
75 75
76Press twice (`M-# M-#' or `M-# #') to turn Calc on or off using the same 76Press `*' twice (`C-x * *') to turn Calc on or off using the same
77Calc user interface as before (either M-# C or M-# K; initially M-# C)." 77Calc user interface as before (either C-x * C or C-x * K; initially C-x * C).
78"
78 (interactive "P") 79 (interactive "P")
79 (calc-check-defines) 80 (calc-check-defines)
80 (if calc-dispatch-help 81 (if calc-dispatch-help
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el
index 2bbbbcceee5..8736d4375dd 100644
--- a/lisp/calc/calc-prog.el
+++ b/lisp/calc/calc-prog.el
@@ -667,7 +667,7 @@
667 (or last-kbd-macro 667 (or last-kbd-macro
668 (error "No keyboard macro defined")) 668 (error "No keyboard macro defined"))
669 (setq calc-invocation-macro last-kbd-macro) 669 (setq calc-invocation-macro last-kbd-macro)
670 (message "Use `M-# Z' to invoke this macro")) 670 (message "Use `C-x * Z' to invoke this macro"))
671 671
672(defun calc-user-define-edit () 672(defun calc-user-define-edit ()
673 (interactive) ; but no calc-wrapper! 673 (interactive) ; but no calc-wrapper!
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index bd161132ddf..fe55b7587f3 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -816,11 +816,6 @@ If nil, selections displayed but ignored.")
816;; Verify that Calc is running on the right kind of system. 816;; Verify that Calc is running on the right kind of system.
817(defvar calc-emacs-type-lucid (not (not (string-match "Lucid" emacs-version)))) 817(defvar calc-emacs-type-lucid (not (not (string-match "Lucid" emacs-version))))
818 818
819;; Set up the standard keystroke (M-#) to run the Calculator, if that key
820;; has not yet been bound to anything. For best results, the user should
821;; do this before Calc is even loaded, so that M-# can auto-load Calc.
822(or (global-key-binding "\e#") (global-set-key "\e#" 'calc-dispatch))
823
824;; Set up the autoloading linkage. 819;; Set up the autoloading linkage.
825(let ((name (and (fboundp 'calc-dispatch) 820(let ((name (and (fboundp 'calc-dispatch)
826 (eq (car-safe (symbol-function 'calc-dispatch)) 'autoload) 821 (eq (car-safe (symbol-function 'calc-dispatch)) 'autoload)
@@ -1046,14 +1041,20 @@ If nil, selections displayed but ignored.")
1046 ( ?x . calc-quit ) 1041 ( ?x . calc-quit )
1047 ( ?y . calc-copy-to-buffer ) 1042 ( ?y . calc-copy-to-buffer )
1048 ( ?z . calc-user-invocation ) 1043 ( ?z . calc-user-invocation )
1049 ( ?= . calc-embedded-update-formula )
1050 ( ?\' . calc-embedded-new-formula ) 1044 ( ?\' . calc-embedded-new-formula )
1051 ( ?\` . calc-embedded-edit ) 1045 ( ?\` . calc-embedded-edit )
1052 ( ?: . calc-grab-sum-down ) 1046 ( ?: . calc-grab-sum-down )
1053 ( ?_ . calc-grab-sum-across ) 1047 ( ?_ . calc-grab-sum-across )
1054 ( ?0 . calc-reset ) 1048 ( ?0 . calc-reset )
1049 ( ?? . calc-dispatch-help )
1055 ( ?# . calc-same-interface ) 1050 ( ?# . calc-same-interface )
1056 ( ?? . calc-dispatch-help ) )) 1051 ( ?& . calc-same-interface )
1052 ( ?\\ . calc-same-interface )
1053 ( ?= . calc-same-interface )
1054 ( ?* . calc-same-interface )
1055 ( ?/ . calc-same-interface )
1056 ( ?+ . calc-same-interface )
1057 ( ?- . calc-same-interface ) ))
1057 map)) 1058 map))
1058 1059
1059;;;; (Autoloads here) 1060;;;; (Autoloads here)
@@ -1095,7 +1096,7 @@ If nil, selections displayed but ignored.")
1095 report-calc-bug))) 1096 report-calc-bug)))
1096 1097
1097 1098
1098;;;###autoload (global-set-key "\e#" 'calc-dispatch) 1099;;;###autoload (define-key ctl-x-map "*" 'calc-dispatch)
1099 1100
1100;;;###autoload 1101;;;###autoload
1101(defun calc-dispatch (&optional arg) 1102(defun calc-dispatch (&optional arg)
@@ -3534,7 +3535,7 @@ Also looks for the equivalent TeX words, \\gets and \\evalto."
3534(defun calc-user-invocation () 3535(defun calc-user-invocation ()
3535 (interactive) 3536 (interactive)
3536 (unless calc-invocation-macro 3537 (unless calc-invocation-macro
3537 (error "Use `Z I' inside Calc to define a `M-# Z' keyboard macro")) 3538 (error "Use `Z I' inside Calc to define a `C-x * Z' keyboard macro"))
3538 (execute-kbd-macro calc-invocation-macro nil)) 3539 (execute-kbd-macro calc-invocation-macro nil))
3539 3540
3540;;; User-programmability. 3541;;; User-programmability.
diff --git a/lisp/complete.el b/lisp/complete.el
index 4a2ce48f152..f5ab178e1b3 100644
--- a/lisp/complete.el
+++ b/lisp/complete.el
@@ -216,9 +216,9 @@ the *Completions* buffer."
216 (PC-bindings partial-completion-mode) 216 (PC-bindings partial-completion-mode)
217 ;; Deal with include file feature... 217 ;; Deal with include file feature...
218 (cond ((not partial-completion-mode) 218 (cond ((not partial-completion-mode)
219 (remove-hook 'find-file-not-found-hooks 'PC-look-for-include-file)) 219 (remove-hook 'find-file-not-found-functions 'PC-look-for-include-file))
220 ((not PC-disable-includes) 220 ((not PC-disable-includes)
221 (add-hook 'find-file-not-found-hooks 'PC-look-for-include-file))) 221 (add-hook 'find-file-not-found-functions 'PC-look-for-include-file)))
222 ;; ... with some underhand redefining. 222 ;; ... with some underhand redefining.
223 (cond ((and (not partial-completion-mode) 223 (cond ((and (not partial-completion-mode)
224 (functionp PC-old-read-file-name-internal)) 224 (functionp PC-old-read-file-name-internal))
@@ -261,8 +261,7 @@ Word-delimiters for the purposes of Partial Completion are \"-\", \"_\",
261 ;; and this command is repeated, scroll that window. 261 ;; and this command is repeated, scroll that window.
262 (if (and window (window-buffer window) 262 (if (and window (window-buffer window)
263 (buffer-name (window-buffer window))) 263 (buffer-name (window-buffer window)))
264 (save-excursion 264 (with-current-buffer (window-buffer window)
265 (set-buffer (window-buffer window))
266 (if (pos-visible-in-window-p (point-max) window) 265 (if (pos-visible-in-window-p (point-max) window)
267 (set-window-start window (point-min) nil) 266 (set-window-start window (point-min) nil)
268 (scroll-other-window))) 267 (scroll-other-window)))
@@ -346,11 +345,8 @@ See `PC-complete' for details."
346(defvar PC-delims-list nil) 345(defvar PC-delims-list nil)
347 346
348(defvar PC-completion-as-file-name-predicate 347(defvar PC-completion-as-file-name-predicate
349 (function 348 (lambda () minibuffer-completing-file-name)
350 (lambda () 349 "A function testing whether a minibuffer completion now will work filename-style.
351 (memq minibuffer-completion-table
352 '(read-file-name-internal read-directory-name-internal))))
353 "A function testing whether a minibuffer completion now will work filename-style.
354The function takes no arguments, and typically looks at the value 350The function takes no arguments, and typically looks at the value
355of `minibuffer-completion-table' and the minibuffer contents.") 351of `minibuffer-completion-table' and the minibuffer contents.")
356 352
@@ -665,8 +661,7 @@ of `minibuffer-completion-table' and the minibuffer contents.")
665 (eq mode 'help)) 661 (eq mode 'help))
666 (with-output-to-temp-buffer "*Completions*" 662 (with-output-to-temp-buffer "*Completions*"
667 (display-completion-list (sort helpposs 'string-lessp)) 663 (display-completion-list (sort helpposs 'string-lessp))
668 (save-excursion 664 (with-current-buffer standard-output
669 (set-buffer standard-output)
670 ;; Record which part of the buffer we are completing 665 ;; Record which part of the buffer we are completing
671 ;; so that choosing a completion from the list 666 ;; so that choosing a completion from the list
672 ;; knows how much old text to replace. 667 ;; knows how much old text to replace.
@@ -732,16 +727,12 @@ Otherwise, all symbols with function definitions, values
732or properties are considered." 727or properties are considered."
733 (interactive) 728 (interactive)
734 (let* ((end (point)) 729 (let* ((end (point))
735 (buffer-syntax (syntax-table)) 730 (beg (save-excursion
736 (beg (unwind-protect 731 (with-syntax-table lisp-mode-syntax-table
737 (save-excursion 732 (backward-sexp 1)
738 (if lisp-mode-syntax-table 733 (while (= (char-syntax (following-char)) ?\')
739 (set-syntax-table lisp-mode-syntax-table)) 734 (forward-char 1))
740 (backward-sexp 1) 735 (point))))
741 (while (= (char-syntax (following-char)) ?\')
742 (forward-char 1))
743 (point))
744 (set-syntax-table buffer-syntax)))
745 (minibuffer-completion-table obarray) 736 (minibuffer-completion-table obarray)
746 (minibuffer-completion-predicate 737 (minibuffer-completion-predicate
747 (if (eq (char-after (1- beg)) ?\() 738 (if (eq (char-after (1- beg)) ?\()
@@ -767,12 +758,11 @@ or properties are considered."
767 (goto-char end) 758 (goto-char end)
768 (PC-do-completion nil beg end))) 759 (PC-do-completion nil beg end)))
769 760
770;;; Use the shell to do globbing. 761;; Use the shell to do globbing.
771;;; This could now use file-expand-wildcards instead. 762;; This could now use file-expand-wildcards instead.
772 763
773(defun PC-expand-many-files (name) 764(defun PC-expand-many-files (name)
774 (save-excursion 765 (with-current-buffer (generate-new-buffer " *Glob Output*")
775 (set-buffer (generate-new-buffer " *Glob Output*"))
776 (erase-buffer) 766 (erase-buffer)
777 (shell-command (concat "echo " name) t) 767 (shell-command (concat "echo " name) t)
778 (goto-char (point-min)) 768 (goto-char (point-min))
@@ -804,9 +794,9 @@ or properties are considered."
804 (setq files (cdr files))) 794 (setq files (cdr files)))
805 p)))) 795 p))))
806 796
807;;; Facilities for loading C header files. This is independent from the 797;; Facilities for loading C header files. This is independent from the
808;;; main completion code. See also the variable `PC-include-file-path' 798;; main completion code. See also the variable `PC-include-file-path'
809;;; at top of this file. 799;; at top of this file.
810 800
811(defun PC-look-for-include-file () 801(defun PC-look-for-include-file ()
812 (if (string-match "[\"<]\\([^\"<>]*\\)[\">]?$" (buffer-file-name)) 802 (if (string-match "[\"<]\\([^\"<>]*\\)[\">]?$" (buffer-file-name))
@@ -817,8 +807,7 @@ or properties are considered."
817 new-buf) 807 new-buf)
818 (kill-buffer (current-buffer)) 808 (kill-buffer (current-buffer))
819 (if (equal name "") 809 (if (equal name "")
820 (save-excursion 810 (with-current-buffer (car (buffer-list))
821 (set-buffer (car (buffer-list)))
822 (save-excursion 811 (save-excursion
823 (beginning-of-line) 812 (beginning-of-line)
824 (if (looking-at 813 (if (looking-at
@@ -855,8 +844,7 @@ or properties are considered."
855 (if path 844 (if path
856 (setq name (concat (file-name-as-directory (car path)) name)) 845 (setq name (concat (file-name-as-directory (car path)) name))
857 (error "No such include file: <%s>" name))) 846 (error "No such include file: <%s>" name)))
858 (let ((dir (save-excursion 847 (let ((dir (with-current-buffer (car (buffer-list))
859 (set-buffer (car (buffer-list)))
860 default-directory))) 848 default-directory)))
861 (if (file-exists-p (concat dir name)) 849 (if (file-exists-p (concat dir name))
862 (setq name (concat dir name)) 850 (setq name (concat dir name))
@@ -865,8 +853,7 @@ or properties are considered."
865 (if new-buf 853 (if new-buf
866 ;; no need to verify last-modified time for this! 854 ;; no need to verify last-modified time for this!
867 (set-buffer new-buf) 855 (set-buffer new-buf)
868 (setq new-buf (create-file-buffer name)) 856 (set-buffer (create-file-buffer name))
869 (set-buffer new-buf)
870 (erase-buffer) 857 (erase-buffer)
871 (insert-file-contents name t)) 858 (insert-file-contents name t))
872 ;; Returning non-nil with the new buffer current 859 ;; Returning non-nil with the new buffer current
@@ -885,7 +872,7 @@ or properties are considered."
885 env (substring env 0 pos))) 872 env (substring env 0 pos)))
886 path))) 873 path)))
887 874
888;;; This is adapted from lib-complete.el, by Mike Williams. 875;; This is adapted from lib-complete.el, by Mike Williams.
889(defun PC-include-file-all-completions (file search-path &optional full) 876(defun PC-include-file-all-completions (file search-path &optional full)
890 "Return all completions for FILE in any directory on SEARCH-PATH. 877 "Return all completions for FILE in any directory on SEARCH-PATH.
891If optional third argument FULL is non-nil, returned pathnames should be 878If optional third argument FULL is non-nil, returned pathnames should be
diff --git a/lisp/completion.el b/lisp/completion.el
index 12df9a52714..2cd30e6513f 100644
--- a/lisp/completion.el
+++ b/lisp/completion.el
@@ -82,11 +82,11 @@
82;; SAVING/LOADING COMPLETIONS 82;; SAVING/LOADING COMPLETIONS
83;; Completions are automatically saved from one session to another 83;; Completions are automatically saved from one session to another
84;; (unless save-completions-flag or enable-completion is nil). 84;; (unless save-completions-flag or enable-completion is nil).
85;; Loading this file (or calling initialize-completions) causes EMACS 85;; Activating this minor-mode calling completion-initialize) causes Emacs
86;; to load a completions database for a saved completions file 86;; to load a completions database for a saved completions file
87;; (default: ~/.completions). When you exit, EMACS saves a copy of the 87;; (default: ~/.completions). When you exit, Emacs saves a copy of the
88;; completions that you 88;; completions that you
89;; often use. When you next start, EMACS loads in the saved completion file. 89;; often use. When you next start, Emacs loads in the saved completion file.
90;; 90;;
91;; The number of completions saved depends loosely on 91;; The number of completions saved depends loosely on
92;; *saved-completions-decay-factor*. Completions that have never been 92;; *saved-completions-decay-factor*. Completions that have never been
@@ -141,8 +141,8 @@
141;; App --> Appropriately] 141;; App --> Appropriately]
142;; 142;;
143;; INITIALIZATION 143;; INITIALIZATION
144;; The form `(initialize-completions)' initializes the completion system by 144;; The form `(completion-initialize)' initializes the completion system by
145;; trying to load in the user's completions. After the first cal, further 145;; trying to load in the user's completions. After the first call, further
146;; calls have no effect so one should be careful not to put the form in a 146;; calls have no effect so one should be careful not to put the form in a
147;; site's standard site-init file. 147;; site's standard site-init file.
148;; 148;;
@@ -180,7 +180,7 @@
180;; complete 180;; complete
181;; Inserts a completion at point 181;; Inserts a completion at point
182;; 182;;
183;; initialize-completions 183;; completion-initialize
184;; Loads the completions file and sets up so that exiting emacs will 184;; Loads the completions file and sets up so that exiting emacs will
185;; save them. 185;; save them.
186;; 186;;
@@ -286,59 +286,65 @@
286 286
287 287
288(defcustom enable-completion t 288(defcustom enable-completion t
289 "*Non-nil means enable recording and saving of completions. 289 "Non-nil means enable recording and saving of completions.
290If nil, no new words are added to the database or saved to the init file." 290If nil, no new words are added to the database or saved to the init file."
291 :type 'boolean 291 :type 'boolean
292 :group 'completion) 292 :group 'completion)
293 293
294(defcustom save-completions-flag t 294(defcustom save-completions-flag t
295 "*Non-nil means save most-used completions when exiting Emacs. 295 "Non-nil means save most-used completions when exiting Emacs.
296See also `save-completions-retention-time'." 296See also `save-completions-retention-time'."
297 :type 'boolean 297 :type 'boolean
298 :group 'completion) 298 :group 'completion)
299 299
300(defcustom save-completions-file-name (convert-standard-filename "~/.completions") 300(defcustom save-completions-file-name
301 "*The filename to save completions to." 301 (let ((olddef (convert-standard-filename "~/.completions")))
302 (cond
303 ((file-readable-p olddef) olddef)
304 ((file-directory-p (convert-standard-filename "~/.emacs.d/"))
305 (convert-standard-filename (expand-file-name completions "~/.emacs.d/")))
306 (t olddef)))
307 "The filename to save completions to."
302 :type 'file 308 :type 'file
303 :group 'completion) 309 :group 'completion)
304 310
305(defcustom save-completions-retention-time 336 311(defcustom save-completions-retention-time 336
306 "*Discard a completion if unused for this many hours. 312 "Discard a completion if unused for this many hours.
307\(1 day = 24, 1 week = 168). If this is 0, non-permanent completions 313\(1 day = 24, 1 week = 168). If this is 0, non-permanent completions
308will not be saved unless these are used. Default is two weeks." 314will not be saved unless these are used. Default is two weeks."
309 :type 'integer 315 :type 'integer
310 :group 'completion) 316 :group 'completion)
311 317
312(defcustom completion-on-separator-character nil 318(defcustom completion-on-separator-character nil
313 "*Non-nil means separator characters mark previous word as used. 319 "Non-nil means separator characters mark previous word as used.
314This means the word will be saved as a completion." 320This means the word will be saved as a completion."
315 :type 'boolean 321 :type 'boolean
316 :group 'completion) 322 :group 'completion)
317 323
318(defcustom completions-file-versions-kept kept-new-versions 324(defcustom completions-file-versions-kept kept-new-versions
319 "*Number of versions to keep for the saved completions file." 325 "Number of versions to keep for the saved completions file."
320 :type 'integer 326 :type 'integer
321 :group 'completion) 327 :group 'completion)
322 328
323(defcustom completion-prompt-speed-threshold 4800 329(defcustom completion-prompt-speed-threshold 4800
324 "*Minimum output speed at which to display next potential completion." 330 "Minimum output speed at which to display next potential completion."
325 :type 'integer 331 :type 'integer
326 :group 'completion) 332 :group 'completion)
327 333
328(defcustom completion-cdabbrev-prompt-flag nil 334(defcustom completion-cdabbrev-prompt-flag nil
329 "*If non-nil, the next completion prompt does a cdabbrev search. 335 "If non-nil, the next completion prompt does a cdabbrev search.
330This can be time consuming." 336This can be time consuming."
331 :type 'boolean 337 :type 'boolean
332 :group 'completion) 338 :group 'completion)
333 339
334(defcustom completion-search-distance 15000 340(defcustom completion-search-distance 15000
335 "*How far to search in the buffer when looking for completions. 341 "How far to search in the buffer when looking for completions.
336In number of characters. If nil, search the whole buffer." 342In number of characters. If nil, search the whole buffer."
337 :type 'integer 343 :type 'integer
338 :group 'completion) 344 :group 'completion)
339 345
340(defcustom completions-merging-modes '(lisp c) 346(defcustom completions-merging-modes '(lisp c)
341 "*List of modes {`c' or `lisp'} for automatic completions merging. 347 "List of modes {`c' or `lisp'} for automatic completions merging.
342Definitions from visited files which have these modes 348Definitions from visited files which have these modes
343are automatically added to the completion database." 349are automatically added to the completion database."
344 :type '(set (const lisp) (const c)) 350 :type '(set (const lisp) (const c))
@@ -495,7 +501,7 @@ Used to decide whether to save completions.")
495;; Table definitions 501;; Table definitions
496;;----------------------------------------------- 502;;-----------------------------------------------
497 503
498(defun cmpl-make-standard-completion-syntax-table () 504(defconst completion-standard-syntax-table
499 (let ((table (make-syntax-table)) 505 (let ((table (make-syntax-table))
500 i) 506 i)
501 ;; Default syntax is whitespace. 507 ;; Default syntax is whitespace.
@@ -523,36 +529,9 @@ Used to decide whether to save completions.")
523 (modify-syntax-entry char "w" table))) 529 (modify-syntax-entry char "w" table)))
524 table)) 530 table))
525 531
526(defconst cmpl-standard-syntax-table (cmpl-make-standard-completion-syntax-table)) 532(defvar completion-syntax-table completion-standard-syntax-table
527
528(defun cmpl-make-lisp-completion-syntax-table ()
529 (let ((table (copy-syntax-table cmpl-standard-syntax-table))
530 (symbol-chars '(?! ?& ?? ?= ?^)))
531 (dolist (char symbol-chars)
532 (modify-syntax-entry char "_" table))
533 table))
534
535(defun cmpl-make-c-completion-syntax-table ()
536 (let ((table (copy-syntax-table cmpl-standard-syntax-table))
537 (separator-chars '(?+ ?* ?/ ?: ?%)))
538 (dolist (char separator-chars)
539 (modify-syntax-entry char " " table))
540 table))
541
542(defun cmpl-make-fortran-completion-syntax-table ()
543 (let ((table (copy-syntax-table cmpl-standard-syntax-table))
544 (separator-chars '(?+ ?- ?* ?/ ?:)))
545 (dolist (char separator-chars)
546 (modify-syntax-entry char " " table))
547 table))
548
549(defconst cmpl-lisp-syntax-table (cmpl-make-lisp-completion-syntax-table))
550(defconst cmpl-c-syntax-table (cmpl-make-c-completion-syntax-table))
551(defconst cmpl-fortran-syntax-table (cmpl-make-fortran-completion-syntax-table))
552
553(defvar cmpl-syntax-table cmpl-standard-syntax-table
554 "This variable holds the current completion syntax table.") 533 "This variable holds the current completion syntax table.")
555(make-variable-buffer-local 'cmpl-syntax-table) 534(make-variable-buffer-local 'completion-syntax-table)
556 535
557;;----------------------------------------------- 536;;-----------------------------------------------
558;; Symbol functions 537;; Symbol functions
@@ -561,43 +540,34 @@ Used to decide whether to save completions.")
561 "Holds first character of symbol, after any completion symbol function.") 540 "Holds first character of symbol, after any completion symbol function.")
562(defvar cmpl-symbol-end nil 541(defvar cmpl-symbol-end nil
563 "Holds last character of symbol, after any completion symbol function.") 542 "Holds last character of symbol, after any completion symbol function.")
564;; These are temp. vars. we use to avoid using let.
565;; Why ? Small speed improvement.
566(defvar cmpl-saved-syntax nil)
567(defvar cmpl-saved-point nil)
568 543
569(defun symbol-under-point () 544(defun symbol-under-point ()
570 "Return the symbol that the point is currently on. 545 "Return the symbol that the point is currently on.
571But only if it is longer than `completion-min-length'." 546But only if it is longer than `completion-min-length'."
572 (setq cmpl-saved-syntax (syntax-table)) 547 (with-syntax-table completion-syntax-table
573 (unwind-protect 548 (when (memq (char-syntax (following-char)) '(?w ?_))
574 (progn 549 ;; Cursor is on following-char and after preceding-char
575 (set-syntax-table cmpl-syntax-table) 550 (let ((saved-point (point)))
576 (cond 551 (setq cmpl-symbol-start (scan-sexps (1+ saved-point) -1)
577 ;; Cursor is on following-char and after preceding-char 552 cmpl-symbol-end (scan-sexps saved-point 1))
578 ((memq (char-syntax (following-char)) '(?w ?_)) 553 ;; Remove chars to ignore at the start.
579 (setq cmpl-saved-point (point) 554 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
580 cmpl-symbol-start (scan-sexps (1+ cmpl-saved-point) -1) 555 (goto-char cmpl-symbol-start)
581 cmpl-symbol-end (scan-sexps cmpl-saved-point 1)) 556 (forward-word 1)
582 ;; Remove chars to ignore at the start. 557 (setq cmpl-symbol-start (point))
583 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) 558 (goto-char saved-point)))
584 (goto-char cmpl-symbol-start) 559 ;; Remove chars to ignore at the end.
585 (forward-word 1) 560 (cond ((= (char-syntax (char-after (1- cmpl-symbol-end))) ?w)
586 (setq cmpl-symbol-start (point)) 561 (goto-char cmpl-symbol-end)
587 (goto-char cmpl-saved-point))) 562 (forward-word -1)
588 ;; Remove chars to ignore at the end. 563 (setq cmpl-symbol-end (point))
589 (cond ((= (char-syntax (char-after (1- cmpl-symbol-end))) ?w) 564 (goto-char saved-point)))
590 (goto-char cmpl-symbol-end) 565 ;; Return completion if the length is reasonable.
591 (forward-word -1) 566 (if (and (<= completion-min-length
592 (setq cmpl-symbol-end (point)) 567 (- cmpl-symbol-end cmpl-symbol-start))
593 (goto-char cmpl-saved-point))) 568 (<= (- cmpl-symbol-end cmpl-symbol-start)
594 ;; Return completion if the length is reasonable. 569 completion-max-length))
595 (if (and (<= completion-min-length 570 (buffer-substring cmpl-symbol-start cmpl-symbol-end))))))
596 (- cmpl-symbol-end cmpl-symbol-start))
597 (<= (- cmpl-symbol-end cmpl-symbol-start)
598 completion-max-length))
599 (buffer-substring cmpl-symbol-start cmpl-symbol-end)))))
600 (set-syntax-table cmpl-saved-syntax)))
601 571
602;; tests for symbol-under-point 572;; tests for symbol-under-point
603;; `^' indicates cursor pos. where value is returned 573;; `^' indicates cursor pos. where value is returned
@@ -615,46 +585,42 @@ But only if it is longer than `completion-min-length'."
615 "Return a string of the symbol immediately before point. 585 "Return a string of the symbol immediately before point.
616Returns nil if there isn't one longer than `completion-min-length'." 586Returns nil if there isn't one longer than `completion-min-length'."
617 ;; This is called when a word separator is typed so it must be FAST ! 587 ;; This is called when a word separator is typed so it must be FAST !
618 (setq cmpl-saved-syntax (syntax-table)) 588 (with-syntax-table completion-syntax-table
619 (unwind-protect 589 ;; Cursor is on following-char and after preceding-char
620 (progn 590 (cond ((= (setq cmpl-preceding-syntax (char-syntax (preceding-char))) ?_)
621 (set-syntax-table cmpl-syntax-table) 591 ;; Number of chars to ignore at end.
622 ;; Cursor is on following-char and after preceding-char 592 (setq cmpl-symbol-end (point)
623 (cond ((= (setq cmpl-preceding-syntax (char-syntax (preceding-char))) ?_) 593 cmpl-symbol-start (scan-sexps cmpl-symbol-end -1))
624 ;; Number of chars to ignore at end. 594 ;; Remove chars to ignore at the start.
625 (setq cmpl-symbol-end (point) 595 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
626 cmpl-symbol-start (scan-sexps cmpl-symbol-end -1)) 596 (goto-char cmpl-symbol-start)
627 ;; Remove chars to ignore at the start. 597 (forward-word 1)
628 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) 598 (setq cmpl-symbol-start (point))
629 (goto-char cmpl-symbol-start) 599 (goto-char cmpl-symbol-end)))
630 (forward-word 1) 600 ;; Return value if long enough.
631 (setq cmpl-symbol-start (point)) 601 (if (>= cmpl-symbol-end
632 (goto-char cmpl-symbol-end))) 602 (+ cmpl-symbol-start completion-min-length))
633 ;; Return value if long enough. 603 (buffer-substring cmpl-symbol-start cmpl-symbol-end)))
634 (if (>= cmpl-symbol-end 604 ((= cmpl-preceding-syntax ?w)
635 (+ cmpl-symbol-start completion-min-length)) 605 ;; chars to ignore at end
636 (buffer-substring cmpl-symbol-start cmpl-symbol-end))) 606 (let ((saved-point (point)))
637 ((= cmpl-preceding-syntax ?w) 607 (setq cmpl-symbol-start (scan-sexps saved-point -1))
638 ;; chars to ignore at end 608 ;; take off chars. from end
639 (setq cmpl-saved-point (point) 609 (forward-word -1)
640 cmpl-symbol-start (scan-sexps cmpl-saved-point -1)) 610 (setq cmpl-symbol-end (point))
641 ;; take off chars. from end 611 ;; remove chars to ignore at the start
642 (forward-word -1) 612 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
643 (setq cmpl-symbol-end (point)) 613 (goto-char cmpl-symbol-start)
644 ;; remove chars to ignore at the start 614 (forward-word 1)
645 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) 615 (setq cmpl-symbol-start (point))))
646 (goto-char cmpl-symbol-start) 616 ;; Restore state.
647 (forward-word 1) 617 (goto-char saved-point)
648 (setq cmpl-symbol-start (point)))) 618 ;; Return completion if the length is reasonable
649 ;; Restore state. 619 (if (and (<= completion-min-length
650 (goto-char cmpl-saved-point) 620 (- cmpl-symbol-end cmpl-symbol-start))
651 ;; Return completion if the length is reasonable 621 (<= (- cmpl-symbol-end cmpl-symbol-start)
652 (if (and (<= completion-min-length 622 completion-max-length))
653 (- cmpl-symbol-end cmpl-symbol-start)) 623 (buffer-substring cmpl-symbol-start cmpl-symbol-end)))))))
654 (<= (- cmpl-symbol-end cmpl-symbol-start)
655 completion-max-length))
656 (buffer-substring cmpl-symbol-start cmpl-symbol-end)))))
657 (set-syntax-table cmpl-saved-syntax)))
658 624
659;; tests for symbol-before-point 625;; tests for symbol-before-point
660;; `^' indicates cursor pos. where value is returned 626;; `^' indicates cursor pos. where value is returned
@@ -675,17 +641,11 @@ Returns nil if there isn't one longer than `completion-min-length'."
675 ;; copying all the code. 641 ;; copying all the code.
676 ;; However, it is only used by the completion string prompter. 642 ;; However, it is only used by the completion string prompter.
677 ;; If it comes into common use, it could be rewritten. 643 ;; If it comes into common use, it could be rewritten.
678 (cond ((memq (progn 644 (if (memq (with-syntax-table completion-syntax-table
679 (setq cmpl-saved-syntax (syntax-table)) 645 (char-syntax (following-char)))
680 (unwind-protect 646 '(?w ?_))
681 (progn 647 (symbol-under-point)
682 (set-syntax-table cmpl-syntax-table) 648 (symbol-before-point)))
683 (char-syntax (following-char)))
684 (set-syntax-table cmpl-saved-syntax)))
685 '(?w ?_))
686 (symbol-under-point))
687 (t
688 (symbol-before-point))))
689 649
690 650
691(defun symbol-before-point-for-complete () 651(defun symbol-before-point-for-complete ()
@@ -693,28 +653,23 @@ Returns nil if there isn't one longer than `completion-min-length'."
693 ;; or nil if there isn't one. Like symbol-before-point but doesn't trim the 653 ;; or nil if there isn't one. Like symbol-before-point but doesn't trim the
694 ;; end chars." 654 ;; end chars."
695 ;; Cursor is on following-char and after preceding-char 655 ;; Cursor is on following-char and after preceding-char
696 (setq cmpl-saved-syntax (syntax-table)) 656 (with-syntax-table completion-syntax-table
697 (unwind-protect 657 (cond ((memq (setq cmpl-preceding-syntax (char-syntax (preceding-char)))
698 (progn 658 '(?_ ?w))
699 (set-syntax-table cmpl-syntax-table) 659 (setq cmpl-symbol-end (point)
700 (cond ((memq (setq cmpl-preceding-syntax (char-syntax (preceding-char))) 660 cmpl-symbol-start (scan-sexps cmpl-symbol-end -1))
701 '(?_ ?w)) 661 ;; Remove chars to ignore at the start.
702 (setq cmpl-symbol-end (point) 662 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
703 cmpl-symbol-start (scan-sexps cmpl-symbol-end -1)) 663 (goto-char cmpl-symbol-start)
704 ;; Remove chars to ignore at the start. 664 (forward-word 1)
705 (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) 665 (setq cmpl-symbol-start (point))
706 (goto-char cmpl-symbol-start) 666 (goto-char cmpl-symbol-end)))
707 (forward-word 1) 667 ;; Return completion if the length is reasonable.
708 (setq cmpl-symbol-start (point)) 668 (if (and (<= completion-prefix-min-length
709 (goto-char cmpl-symbol-end))) 669 (- cmpl-symbol-end cmpl-symbol-start))
710 ;; Return completion if the length is reasonable. 670 (<= (- cmpl-symbol-end cmpl-symbol-start)
711 (if (and (<= completion-prefix-min-length 671 completion-max-length))
712 (- cmpl-symbol-end cmpl-symbol-start)) 672 (buffer-substring cmpl-symbol-start cmpl-symbol-end))))))
713 (<= (- cmpl-symbol-end cmpl-symbol-start)
714 completion-max-length))
715 (buffer-substring cmpl-symbol-start cmpl-symbol-end)))))
716 ;; Restore syntax table.
717 (set-syntax-table cmpl-saved-syntax)))
718 673
719;; tests for symbol-before-point-for-complete 674;; tests for symbol-before-point-for-complete
720;; `^' indicates cursor pos. where value is returned 675;; `^' indicates cursor pos. where value is returned
@@ -866,7 +821,7 @@ This is sensitive to `case-fold-search'."
866 (setq saved-point (point) 821 (setq saved-point (point)
867 saved-syntax (syntax-table)) 822 saved-syntax (syntax-table))
868 ;; Restore completion state 823 ;; Restore completion state
869 (set-syntax-table cmpl-syntax-table) 824 (set-syntax-table completion-syntax-table)
870 (goto-char cdabbrev-current-point) 825 (goto-char cdabbrev-current-point)
871 ;; Loop looking for completions 826 ;; Loop looking for completions
872 (while 827 (while
@@ -1010,8 +965,8 @@ Each symbol is bound to a single completion entry.")
1010 965
1011;; CONSTRUCTOR 966;; CONSTRUCTOR
1012(defun make-completion (string) 967(defun make-completion (string)
1013 "Return a list of a completion entry." 968 "Return a completion entry."
1014 (list (list string 0 nil current-completion-source))) 969 (list string 0 nil current-completion-source))
1015 970
1016;; Obsolete 971;; Obsolete
1017;;(defmacro cmpl-prefix-entry-symbol (completion-entry) 972;;(defmacro cmpl-prefix-entry-symbol (completion-entry)
@@ -1026,11 +981,9 @@ Each symbol is bound to a single completion entry.")
1026 981
1027;; READER Macros 982;; READER Macros
1028 983
1029(defmacro cmpl-prefix-entry-head (prefix-entry) 984(defalias 'cmpl-prefix-entry-head 'car)
1030 (list 'car prefix-entry))
1031 985
1032(defmacro cmpl-prefix-entry-tail (prefix-entry) 986(defalias 'cmpl-prefix-entry-tail 'cdr)
1033 (list 'cdr prefix-entry))
1034 987
1035;; WRITER Macros 988;; WRITER Macros
1036 989
@@ -1092,17 +1045,17 @@ Each symbol is bound to a single completion entry.")
1092;; These are the internal functions used to update the datebase 1045;; These are the internal functions used to update the datebase
1093;; 1046;;
1094;; 1047;;
1095(defvar completion-to-accept nil) 1048(defvar completion-to-accept nil
1096 ;;"Set to a string that is pending its acceptance." 1049 "Set to a string that is pending its acceptance.")
1097 ;; this checked by the top level reading functions 1050 ;; this checked by the top level reading functions
1098 1051
1099(defvar cmpl-db-downcase-string nil) 1052(defvar cmpl-db-downcase-string nil
1100 ;; "Setup by find-exact-completion, etc. The given string, downcased." 1053 "Setup by `find-exact-completion', etc. The given string, downcased.")
1101(defvar cmpl-db-symbol nil) 1054(defvar cmpl-db-symbol nil
1102 ;; "The interned symbol corresponding to cmpl-db-downcase-string. 1055 "The interned symbol corresponding to `cmpl-db-downcase-string'.
1103 ;; Set up by cmpl-db-symbol." 1056Set up by `cmpl-db-symbol'.")
1104(defvar cmpl-db-prefix-symbol nil) 1057(defvar cmpl-db-prefix-symbol nil
1105 ;; "The interned prefix symbol corresponding to cmpl-db-downcase-string." 1058 "The interned prefix symbol corresponding to `cmpl-db-downcase-string'.")
1106(defvar cmpl-db-entry nil) 1059(defvar cmpl-db-entry nil)
1107(defvar cmpl-db-debug-p nil 1060(defvar cmpl-db-debug-p nil
1108 "Set to t if you want to debug the database.") 1061 "Set to t if you want to debug the database.")
@@ -1190,7 +1143,7 @@ Returns the completion entry."
1190 (or (find-exact-completion string) 1143 (or (find-exact-completion string)
1191 ;; not there 1144 ;; not there
1192 (let (;; create an entry 1145 (let (;; create an entry
1193 (entry (make-completion string)) 1146 (entry (list (make-completion string)))
1194 ;; setup the prefix 1147 ;; setup the prefix
1195 (prefix-entry (find-cmpl-prefix-entry 1148 (prefix-entry (find-cmpl-prefix-entry
1196 (substring cmpl-db-downcase-string 0 1149 (substring cmpl-db-downcase-string 0
@@ -1244,7 +1197,7 @@ Returns the completion entry."
1244 cmpl-db-entry) 1197 cmpl-db-entry)
1245 ;; not there 1198 ;; not there
1246 (let (;; create an entry 1199 (let (;; create an entry
1247 (entry (make-completion completion-string)) 1200 (entry (list (make-completion completion-string)))
1248 ;; setup the prefix 1201 ;; setup the prefix
1249 (prefix-entry (find-cmpl-prefix-entry 1202 (prefix-entry (find-cmpl-prefix-entry
1250 (substring cmpl-db-downcase-string 0 1203 (substring cmpl-db-downcase-string 0
@@ -1650,7 +1603,7 @@ Prefix args ::
1650 (setq cmpl-current-index (+ cmpl-current-index (or arg 1)))) 1603 (setq cmpl-current-index (+ cmpl-current-index (or arg 1))))
1651 (t 1604 (t
1652 (if (not cmpl-initialized-p) 1605 (if (not cmpl-initialized-p)
1653 (initialize-completions)) ;; make sure everything's loaded 1606 (completion-initialize)) ;; make sure everything's loaded
1654 (cond ((consp current-prefix-arg) ;; control-u 1607 (cond ((consp current-prefix-arg) ;; control-u
1655 (setq arg 0) 1608 (setq arg 0)
1656 (setq cmpl-leave-point-at-start t)) 1609 (setq cmpl-leave-point-at-start t))
@@ -1752,9 +1705,8 @@ Prefix args ::
1752 (let ((completions-merging-modes nil)) 1705 (let ((completions-merging-modes nil))
1753 (setq buffer (find-file-noselect file)))) 1706 (setq buffer (find-file-noselect file))))
1754 (unwind-protect 1707 (unwind-protect
1755 (save-excursion 1708 (with-current-buffer buffer
1756 (set-buffer buffer) 1709 (add-completions-from-buffer))
1757 (add-completions-from-buffer))
1758 (if (not buffer-already-there-p) 1710 (if (not buffer-already-there-p)
1759 (kill-buffer buffer))))) 1711 (kill-buffer buffer)))))
1760 1712
@@ -1781,7 +1733,7 @@ Prefix args ::
1781 start-num))))) 1733 start-num)))))
1782 1734
1783;; Find file hook 1735;; Find file hook
1784(defun cmpl-find-file-hook () 1736(defun completion-find-file-hook ()
1785 (cond (enable-completion 1737 (cond (enable-completion
1786 (cond ((and (memq major-mode '(emacs-lisp-mode lisp-mode)) 1738 (cond ((and (memq major-mode '(emacs-lisp-mode lisp-mode))
1787 (memq 'lisp completions-merging-modes)) 1739 (memq 'lisp completions-merging-modes))
@@ -1864,7 +1816,7 @@ Prefix args ::
1864;; Whitespace chars (have symbol syntax) 1816;; Whitespace chars (have symbol syntax)
1865;; Everything else has word syntax 1817;; Everything else has word syntax
1866 1818
1867(defun cmpl-make-c-def-completion-syntax-table () 1819(defconst completion-c-def-syntax-table
1868 (let ((table (make-syntax-table)) 1820 (let ((table (make-syntax-table))
1869 (whitespace-chars '(? ?\n ?\t ?\f ?\v ?\r)) 1821 (whitespace-chars '(? ?\n ?\t ?\f ?\v ?\r))
1870 ;; unfortunately the ?( causes the parens to appear unbalanced 1822 ;; unfortunately the ?( causes the parens to appear unbalanced
@@ -1885,8 +1837,6 @@ Prefix args ::
1885 (modify-syntax-entry ?\} "){" table) 1837 (modify-syntax-entry ?\} "){" table)
1886 table)) 1838 table))
1887 1839
1888(defconst cmpl-c-def-syntax-table (cmpl-make-c-def-completion-syntax-table))
1889
1890;; Regexps 1840;; Regexps
1891(defconst *c-def-regexp* 1841(defconst *c-def-regexp*
1892 ;; This stops on lines with possible definitions 1842 ;; This stops on lines with possible definitions
@@ -1930,81 +1880,77 @@ Prefix args ::
1930 ;; Benchmark -- 1880 ;; Benchmark --
1931 ;; Sun 3/280-- 1250 lines/sec. 1881 ;; Sun 3/280-- 1250 lines/sec.
1932 1882
1933 (let (string next-point char 1883 (let (string next-point char)
1934 (saved-syntax (syntax-table)))
1935 (save-excursion 1884 (save-excursion
1936 (goto-char (point-min)) 1885 (goto-char (point-min))
1937 (catch 'finish-add-completions 1886 (catch 'finish-add-completions
1938 (unwind-protect 1887 (with-syntax-table completion-c-def-syntax-table
1939 (while t 1888 (while t
1940 ;; we loop here only when scan-sexps fails 1889 ;; we loop here only when scan-sexps fails
1941 ;; (i.e. unbalance exps.) 1890 ;; (i.e. unbalance exps.)
1942 (set-syntax-table cmpl-c-def-syntax-table) 1891 (condition-case e
1943 (condition-case e 1892 (while t
1944 (while t 1893 (re-search-forward *c-def-regexp*)
1945 (re-search-forward *c-def-regexp*) 1894 (cond
1946 (cond 1895 ((= (preceding-char) ?#)
1947 ((= (preceding-char) ?#) 1896 ;; preprocessor macro, see if it's one we handle
1948 ;; preprocessor macro, see if it's one we handle 1897 (setq string (buffer-substring (point) (+ (point) 6)))
1949 (setq string (buffer-substring (point) (+ (point) 6))) 1898 (cond ((member string '("define" "ifdef "))
1950 (cond ((or (string-equal string "define") 1899 ;; skip forward over definition symbol
1951 (string-equal string "ifdef ")) 1900 ;; and add it to database
1952 ;; skip forward over definition symbol 1901 (and (forward-word 2)
1953 ;; and add it to database 1902 (setq string (symbol-before-point))
1954 (and (forward-word 2) 1903 ;;(push string foo)
1955 (setq string (symbol-before-point)) 1904 (add-completion-to-tail-if-new string)))))
1956 ;;(push string foo) 1905 (t
1957 (add-completion-to-tail-if-new string))))) 1906 ;; C definition
1958 (t 1907 (setq next-point (point))
1959 ;; C definition 1908 (while (and
1960 (setq next-point (point)) 1909 next-point
1961 (while (and 1910 ;; scan to next separator char.
1962 next-point 1911 (setq next-point (scan-sexps next-point 1)))
1963 ;; scan to next separator char. 1912 ;; position the point on the word we want to add
1964 (setq next-point (scan-sexps next-point 1))) 1913 (goto-char next-point)
1965 ;; position the point on the word we want to add 1914 (while (= (setq char (following-char)) ?*)
1966 (goto-char next-point) 1915 ;; handle pointer ref
1967 (while (= (setq char (following-char)) ?*) 1916 ;; move to next separator char.
1968 ;; handle pointer ref 1917 (goto-char
1969 ;; move to next separator char. 1918 (setq next-point (scan-sexps (point) 1))))
1970 (goto-char 1919 (forward-word -1)
1971 (setq next-point (scan-sexps (point) 1)))) 1920 ;; add to database
1972 (forward-word -1) 1921 (if (setq string (symbol-under-point))
1973 ;; add to database 1922 ;; (push string foo)
1974 (if (setq string (symbol-under-point)) 1923 (add-completion-to-tail-if-new string)
1975 ;; (push string foo) 1924 ;; Local TMC hack (useful for parsing paris.h)
1976 (add-completion-to-tail-if-new string) 1925 (if (and (looking-at "_AP") ;; "ansi prototype"
1977 ;; Local TMC hack (useful for parsing paris.h) 1926 (progn
1978 (if (and (looking-at "_AP") ;; "ansi prototype" 1927 (forward-word -1)
1979 (progn 1928 (setq string
1980 (forward-word -1) 1929 (symbol-under-point))))
1981 (setq string 1930 (add-completion-to-tail-if-new string)))
1982 (symbol-under-point)))) 1931 ;; go to next
1983 (add-completion-to-tail-if-new string))) 1932 (goto-char next-point)
1984 ;; go to next 1933 ;; (push (format "%c" (following-char)) foo)
1985 (goto-char next-point) 1934 (if (= (char-syntax char) ?\()
1986 ;; (push (format "%c" (following-char)) foo) 1935 ;; if on an opening delimiter, go to end
1987 (if (= (char-syntax char) ?\() 1936 (while (= (char-syntax char) ?\()
1988 ;; if on an opening delimiter, go to end 1937 (setq next-point (scan-sexps next-point 1)
1989 (while (= (char-syntax char) ?\() 1938 char (char-after next-point)))
1990 (setq next-point (scan-sexps next-point 1) 1939 (or (= char ?,)
1991 char (char-after next-point))) 1940 ;; Current char is an end char.
1992 (or (= char ?,) 1941 (setq next-point nil)))))))
1993 ;; Current char is an end char. 1942 (search-failed ;;done
1994 (setq next-point nil))))))) 1943 (throw 'finish-add-completions t))
1995 (search-failed ;;done 1944 (error
1996 (throw 'finish-add-completions t)) 1945 ;; Check for failure in scan-sexps
1997 (error 1946 (if (or (string-equal (nth 1 e)
1998 ;; Check for failure in scan-sexps 1947 "Containing expression ends prematurely")
1999 (if (or (string-equal (nth 1 e) 1948 (string-equal (nth 1 e) "Unbalanced parentheses"))
2000 "Containing expression ends prematurely") 1949 ;; unbalanced paren., keep going
2001 (string-equal (nth 1 e) "Unbalanced parentheses")) 1950 ;;(ding)
2002 ;; unbalanced paren., keep going 1951 (forward-line 1)
2003 ;;(ding) 1952 (message "Error parsing C buffer for completions--please send bug report")
2004 (forward-line 1) 1953 (throw 'finish-add-completions t))))))))))
2005 (message "Error parsing C buffer for completions--please send bug report")
2006 (throw 'finish-add-completions t)))))
2007 (set-syntax-table saved-syntax))))))
2008 1954
2009 1955
2010;;--------------------------------------------------------------------------- 1956;;---------------------------------------------------------------------------
@@ -2018,7 +1964,8 @@ Prefix args ::
2018 ((not cmpl-completions-accepted-p) 1964 ((not cmpl-completions-accepted-p)
2019 (message "Completions database has not changed - not writing.")) 1965 (message "Completions database has not changed - not writing."))
2020 (t 1966 (t
2021 (save-completions-to-file))))) 1967 (save-completions-to-file))))
1968 (cmpl-statistics-block (record-cmpl-kill-emacs)))
2022 1969
2023;; There is no point bothering to change this again 1970;; There is no point bothering to change this again
2024;; unless the package changes so much that it matters 1971;; unless the package changes so much that it matters
@@ -2046,7 +1993,7 @@ If file name is not specified, use `save-completions-file-name'."
2046 (if (file-writable-p filename) 1993 (if (file-writable-p filename)
2047 (progn 1994 (progn
2048 (if (not cmpl-initialized-p) 1995 (if (not cmpl-initialized-p)
2049 (initialize-completions));; make sure everything's loaded 1996 (completion-initialize)) ;; make sure everything's loaded
2050 (message "Saving completions to file %s" filename) 1997 (message "Saving completions to file %s" filename)
2051 1998
2052 (let* ((delete-old-versions t) 1999 (let* ((delete-old-versions t)
@@ -2059,9 +2006,7 @@ If file name is not specified, use `save-completions-file-name'."
2059 (total-saved 0) 2006 (total-saved 0)
2060 (backup-filename (completion-backup-filename filename))) 2007 (backup-filename (completion-backup-filename filename)))
2061 2008
2062 (save-excursion 2009 (with-current-buffer (get-buffer-create " *completion-save-buffer*")
2063 (get-buffer-create " *completion-save-buffer*")
2064 (set-buffer " *completion-save-buffer*")
2065 (setq buffer-file-name filename) 2010 (setq buffer-file-name filename)
2066 2011
2067 (if (not (verify-visited-file-modtime (current-buffer))) 2012 (if (not (verify-visited-file-modtime (current-buffer)))
@@ -2151,9 +2096,7 @@ If file is not specified, then use `save-completions-file-name'."
2151 (if (not no-message-p) 2096 (if (not no-message-p)
2152 (message "Loading completions from %sfile %s . . ." 2097 (message "Loading completions from %sfile %s . . ."
2153 (if backup-readable-p "backup " "") filename)) 2098 (if backup-readable-p "backup " "") filename))
2154 (save-excursion 2099 (with-current-buffer (get-buffer-create " *completion-save-buffer*")
2155 (get-buffer-create " *completion-save-buffer*")
2156 (set-buffer " *completion-save-buffer*")
2157 (setq buffer-file-name filename) 2100 (setq buffer-file-name filename)
2158 ;; prepare the buffer to be modified 2101 ;; prepare the buffer to be modified
2159 (clear-visited-file-modtime) 2102 (clear-visited-file-modtime)
@@ -2161,8 +2104,7 @@ If file is not specified, then use `save-completions-file-name'."
2161 2104
2162 (let ((insert-okay-p nil) 2105 (let ((insert-okay-p nil)
2163 (buffer (current-buffer)) 2106 (buffer (current-buffer))
2164 (current-time (cmpl-hours-since-origin)) 2107 string entry last-use-time
2165 string num-uses entry last-use-time
2166 cmpl-entry cmpl-last-use-time 2108 cmpl-entry cmpl-last-use-time
2167 (current-completion-source cmpl-source-init-file) 2109 (current-completion-source cmpl-source-init-file)
2168 (start-num 2110 (start-num
@@ -2233,13 +2175,13 @@ If file is not specified, then use `save-completions-file-name'."
2233 start-num))) 2175 start-num)))
2234)))))) 2176))))))
2235 2177
2236(defun initialize-completions () 2178(defun completion-initialize ()
2237 "Load the default completions file. 2179 "Load the default completions file.
2238Also sets up so that exiting Emacs will automatically save the file." 2180Also sets up so that exiting Emacs will automatically save the file."
2239 (interactive) 2181 (interactive)
2240 (cond ((not cmpl-initialized-p) 2182 (unless cmpl-initialized-p
2241 (load-completions-from-file))) 2183 (load-completions-from-file)
2242 (setq cmpl-initialized-p t)) 2184 (setq cmpl-initialized-p t)))
2243 2185
2244;;----------------------------------------------- 2186;;-----------------------------------------------
2245;; Kill region patch 2187;; Kill region patch
@@ -2302,33 +2244,21 @@ Patched to remove the most recent completion."
2302;; Note that because of the way byte compiling works, none of 2244;; Note that because of the way byte compiling works, none of
2303;; the functions defined with this macro get byte compiled. 2245;; the functions defined with this macro get byte compiled.
2304 2246
2305(defmacro def-completion-wrapper (function-name type &optional new-name) 2247(defun completion-def-wrapper (function-name type)
2306 "Add a call to update the completion database before function execution. 2248 "Add a call to update the completion database before function execution.
2307TYPE is the type of the wrapper to be added. Can be :before or :under." 2249TYPE is the type of the wrapper to be added. Can be :before or :under."
2308 (cond ((eq type :separator) 2250 (put function-name 'completion-function
2309 (list 'put (list 'quote function-name) ''completion-function 2251 (cdr (assq type
2310 ''use-completion-before-separator)) 2252 '((:separator 'use-completion-before-separator)
2311 ((eq type :before) 2253 (:before 'use-completion-before-point)
2312 (list 'put (list 'quote function-name) ''completion-function 2254 (:backward-under 'use-completion-backward-under)
2313 ''use-completion-before-point)) 2255 (:backward 'use-completion-backward)
2314 ((eq type :backward-under) 2256 (:under 'use-completion-under-point)
2315 (list 'put (list 'quote function-name) ''completion-function 2257 (:under-or-before 'use-completion-under-or-before-point)
2316 ''use-completion-backward-under)) 2258 (:minibuffer-separator 'use-completion-minibuffer-separator))))))
2317 ((eq type :backward)
2318 (list 'put (list 'quote function-name) ''completion-function
2319 ''use-completion-backward))
2320 ((eq type :under)
2321 (list 'put (list 'quote function-name) ''completion-function
2322 ''use-completion-under-point))
2323 ((eq type :under-or-before)
2324 (list 'put (list 'quote function-name) ''completion-function
2325 ''use-completion-under-or-before-point))
2326 ((eq type :minibuffer-separator)
2327 (list 'put (list 'quote function-name) ''completion-function
2328 ''use-completion-minibuffer-separator))))
2329 2259
2330(defun use-completion-minibuffer-separator () 2260(defun use-completion-minibuffer-separator ()
2331 (let ((cmpl-syntax-table cmpl-standard-syntax-table)) 2261 (let ((completion-syntax-table completion-standard-syntax-table))
2332 (use-completion-before-separator))) 2262 (use-completion-before-separator)))
2333 2263
2334(defun use-completion-backward-under () 2264(defun use-completion-backward-under ()
@@ -2347,170 +2277,197 @@ TYPE is the type of the wrapper to be added. Can be :before or :under."
2347 (get this-command 'completion-function)) 2277 (get this-command 'completion-function))
2348 'use-completion-under-or-before-point))) 2278 'use-completion-under-or-before-point)))
2349 2279
2280;; Lisp mode diffs.
2281
2282(defconst completion-lisp-syntax-table
2283 (let ((table (copy-syntax-table completion-standard-syntax-table))
2284 (symbol-chars '(?! ?& ?? ?= ?^)))
2285 (dolist (char symbol-chars)
2286 (modify-syntax-entry char "_" table))
2287 table))
2288
2289(defun completion-lisp-mode-hook ()
2290 (setq completion-syntax-table completion-lisp-syntax-table)
2291 ;; Lisp Mode diffs
2292 (local-set-key "!" 'self-insert-command)
2293 (local-set-key "&" 'self-insert-command)
2294 (local-set-key "%" 'self-insert-command)
2295 (local-set-key "?" 'self-insert-command)
2296 (local-set-key "=" 'self-insert-command)
2297 (local-set-key "^" 'self-insert-command))
2298
2350;; C mode diffs. 2299;; C mode diffs.
2351 2300
2352(defvar c-mode-map) 2301(defconst completion-c-syntax-table
2302 (let ((table (copy-syntax-table completion-standard-syntax-table))
2303 (separator-chars '(?+ ?* ?/ ?: ?%)))
2304 (dolist (char separator-chars)
2305 (modify-syntax-entry char " " table))
2306 table))
2353 2307
2308(completion-def-wrapper 'electric-c-semi :separator)
2354(defun completion-c-mode-hook () 2309(defun completion-c-mode-hook ()
2355 (def-completion-wrapper electric-c-semi :separator) 2310 (setq completion-syntax-table completion-c-syntax-table)
2356 (define-key c-mode-map "+" 'completion-separator-self-insert-command) 2311 (local-set-key "+" 'completion-separator-self-insert-command)
2357 (define-key c-mode-map "*" 'completion-separator-self-insert-command) 2312 (local-set-key "*" 'completion-separator-self-insert-command)
2358 (define-key c-mode-map "/" 'completion-separator-self-insert-command)) 2313 (local-set-key "/" 'completion-separator-self-insert-command))
2359;; Do this either now or whenever C mode is loaded.
2360(if (featurep 'cc-mode)
2361 (completion-c-mode-hook)
2362 (add-hook 'c-mode-hook 'completion-c-mode-hook))
2363 2314
2364;; FORTRAN mode diffs. (these are defined when fortran is called) 2315;; FORTRAN mode diffs. (these are defined when fortran is called)
2365 2316
2366(defvar fortran-mode-map) 2317(defconst completion-fortran-syntax-table
2318 (let ((table (copy-syntax-table completion-standard-syntax-table))
2319 (separator-chars '(?+ ?- ?* ?/ ?:)))
2320 (dolist (char separator-chars)
2321 (modify-syntax-entry char " " table))
2322 table))
2367 2323
2368(defun completion-setup-fortran-mode () 2324(defun completion-setup-fortran-mode ()
2369 (define-key fortran-mode-map "+" 'completion-separator-self-insert-command) 2325 (setq completion-syntax-table completion-fortran-syntax-table)
2370 (define-key fortran-mode-map "-" 'completion-separator-self-insert-command) 2326 (local-set-key "+" 'completion-separator-self-insert-command)
2371 (define-key fortran-mode-map "*" 'completion-separator-self-insert-command) 2327 (local-set-key "-" 'completion-separator-self-insert-command)
2372 (define-key fortran-mode-map "/" 'completion-separator-self-insert-command)) 2328 (local-set-key "*" 'completion-separator-self-insert-command)
2329 (local-set-key "/" 'completion-separator-self-insert-command))
2373 2330
2374;;; Enable completion mode. 2331;; Enable completion mode.
2332
2333(defvar fortran-mode-hook)
2334
2335(defvar completion-saved-bindings nil)
2375 2336
2376;;;###autoload 2337;;;###autoload
2377(defun dynamic-completion-mode () 2338(define-minor-mode dynamic-completion-mode
2378 "Enable dynamic word-completion." 2339 "Enable dynamic word-completion."
2379 (interactive) 2340 :global t
2380 (add-hook 'find-file-hook 'cmpl-find-file-hook) 2341 ;; This is always good, not specific to dynamic-completion-mode.
2381 (add-hook 'pre-command-hook 'completion-before-command)
2382
2383 ;; Install the appropriate mode tables.
2384 (add-hook 'lisp-mode-hook
2385 (lambda ()
2386 (setq cmpl-syntax-table cmpl-lisp-syntax-table)))
2387 (add-hook 'c-mode-hook
2388 (lambda ()
2389 (setq cmpl-syntax-table cmpl-c-syntax-table)))
2390 (add-hook 'fortran-mode-hook
2391 (lambda ()
2392 (setq cmpl-syntax-table cmpl-fortran-syntax-table)
2393 (completion-setup-fortran-mode)))
2394
2395 ;; "Complete" Key Keybindings.
2396
2397 (global-set-key "\M-\r" 'complete)
2398 (global-set-key [?\C-\r] 'complete)
2399 (define-key function-key-map [C-return] [?\C-\r]) 2342 (define-key function-key-map [C-return] [?\C-\r])
2400 2343
2401 ;; Tests - 2344 (dolist (x '((find-file-hook . completion-find-file-hook)
2402 ;; (add-completion "cumberland") 2345 (pre-command-hook . completion-before-command)
2403 ;; (add-completion "cumberbund") 2346 ;; Save completions when killing Emacs.
2404 ;; cum 2347 (kill-emacs-hook . kill-emacs-save-completions)
2405 ;; Cumber 2348
2406 ;; cumbering 2349 ;; Install the appropriate mode tables.
2407 ;; cumb 2350 (lisp-mode-hook . completion-lisp-mode-hook)
2408 2351 (c-mode-hook . completion-c-mode-hook)
2409 ;; Save completions when killing Emacs. 2352 (fortran-mode-hook . completion-setup-fortran-mode)))
2410 2353 (if dynamic-completion-mode
2411 (add-hook 'kill-emacs-hook 2354 (add-hook (car x) (cdr x))
2412 (lambda () 2355 (remove-hook (car x) (cdr x))))
2413 (kill-emacs-save-completions) 2356
2414 (cmpl-statistics-block 2357 ;; "Complete" Key Keybindings. We don't want to use a minor-mode
2415 (record-cmpl-kill-emacs)))) 2358 ;; map because these have too high a priority. We could/should
2416 2359 ;; probably change the interpretation of minor-mode-map-alist such
2417 ;; Patches to standard keymaps insert completions 2360 ;; that a map has lower precedence if the symbol is not buffer-local.
2418 (substitute-key-definition 'kill-region 'completion-kill-region 2361 (while completion-saved-bindings
2419 global-map) 2362 (let ((binding (pop completion-saved-bindings)))
2420 2363 (global-set-key (car binding) (cdr binding))))
2421 ;; Separators 2364 (when dynamic-completion-mode
2422 ;; We've used the completion syntax table given as a guide. 2365 (dolist (binding
2423 ;; 2366 '(("\M-\r" . complete)
2424 ;; Global separator chars. 2367 ([?\C-\r] . complete)
2425 ;; We left out <tab> because there are too many special cases for it. Also, 2368
2426 ;; in normal coding it's rarely typed after a word. 2369 ;; Tests -
2427 (global-set-key " " 'completion-separator-self-insert-autofilling) 2370 ;; (add-completion "cumberland")
2428 (global-set-key "!" 'completion-separator-self-insert-command) 2371 ;; (add-completion "cumberbund")
2429 (global-set-key "%" 'completion-separator-self-insert-command) 2372 ;; cum
2430 (global-set-key "^" 'completion-separator-self-insert-command) 2373 ;; Cumber
2431 (global-set-key "&" 'completion-separator-self-insert-command) 2374 ;; cumbering
2432 (global-set-key "(" 'completion-separator-self-insert-command) 2375 ;; cumb
2433 (global-set-key ")" 'completion-separator-self-insert-command) 2376
2434 (global-set-key "=" 'completion-separator-self-insert-command) 2377 ;; Patches to standard keymaps insert completions
2435 (global-set-key "`" 'completion-separator-self-insert-command) 2378 ([remap kill-region] . completion-kill-region)
2436 (global-set-key "|" 'completion-separator-self-insert-command) 2379
2437 (global-set-key "{" 'completion-separator-self-insert-command) 2380 ;; Separators
2438 (global-set-key "}" 'completion-separator-self-insert-command) 2381 ;; We've used the completion syntax table given as a guide.
2439 (global-set-key "[" 'completion-separator-self-insert-command) 2382 ;;
2440 (global-set-key "]" 'completion-separator-self-insert-command) 2383 ;; Global separator chars.
2441 (global-set-key ";" 'completion-separator-self-insert-command) 2384 ;; We left out <tab> because there are too many special
2442 (global-set-key "\"" 'completion-separator-self-insert-command) 2385 ;; cases for it. Also, in normal coding it's rarely typed
2443 (global-set-key "'" 'completion-separator-self-insert-command) 2386 ;; after a word.
2444 (global-set-key "#" 'completion-separator-self-insert-command) 2387 (" " . completion-separator-self-insert-autofilling)
2445 (global-set-key "," 'completion-separator-self-insert-command) 2388 ("!" . completion-separator-self-insert-command)
2446 (global-set-key "?" 'completion-separator-self-insert-command) 2389 ("%" . completion-separator-self-insert-command)
2447 2390 ("^" . completion-separator-self-insert-command)
2448 ;; We include period and colon even though they are symbol chars because : 2391 ("&" . completion-separator-self-insert-command)
2449 ;; - in text we want to pick up the last word in a sentence. 2392 ("(" . completion-separator-self-insert-command)
2450 ;; - in C pointer refs. we want to pick up the first symbol 2393 (")" . completion-separator-self-insert-command)
2451 ;; - it won't make a difference for lisp mode (package names are short) 2394 ("=" . completion-separator-self-insert-command)
2452 (global-set-key "." 'completion-separator-self-insert-command) 2395 ("`" . completion-separator-self-insert-command)
2453 (global-set-key ":" 'completion-separator-self-insert-command) 2396 ("|" . completion-separator-self-insert-command)
2397 ("{" . completion-separator-self-insert-command)
2398 ("}" . completion-separator-self-insert-command)
2399 ("[" . completion-separator-self-insert-command)
2400 ("]" . completion-separator-self-insert-command)
2401 (";" . completion-separator-self-insert-command)
2402 ("\"". completion-separator-self-insert-command)
2403 ("'" . completion-separator-self-insert-command)
2404 ("#" . completion-separator-self-insert-command)
2405 ("," . completion-separator-self-insert-command)
2406 ("?" . completion-separator-self-insert-command)
2407
2408 ;; We include period and colon even though they are symbol
2409 ;; chars because :
2410 ;; - in text we want to pick up the last word in a sentence.
2411 ;; - in C pointer refs. we want to pick up the first symbol
2412 ;; - it won't make a difference for lisp mode (package names
2413 ;; are short)
2414 ("." . completion-separator-self-insert-command)
2415 (":" . completion-separator-self-insert-command)))
2416 (push (cons (car binding) (lookup-key global-map (car binding)))
2417 completion-saved-bindings)
2418 (global-set-key (car binding) (cdr binding)))
2419
2420 ;; Tests --
2421 ;; foobarbiz
2422 ;; foobar
2423 ;; fooquux
2424 ;; fooper
2454 2425
2455 ;; Lisp Mode diffs 2426 (cmpl-statistics-block
2456 (define-key lisp-mode-map "!" 'self-insert-command) 2427 (record-completion-file-loaded))
2457 (define-key lisp-mode-map "&" 'self-insert-command)
2458 (define-key lisp-mode-map "%" 'self-insert-command)
2459 (define-key lisp-mode-map "?" 'self-insert-command)
2460 (define-key lisp-mode-map "=" 'self-insert-command)
2461 (define-key lisp-mode-map "^" 'self-insert-command)
2462
2463 ;; Avoid warnings.
2464 (defvar c-mode-map)
2465 (defvar fortran-mode-map)
2466
2467 ;;-----------------------------------------------
2468 ;; End of line chars.
2469 ;;-----------------------------------------------
2470 (def-completion-wrapper newline :separator)
2471 (def-completion-wrapper newline-and-indent :separator)
2472 (def-completion-wrapper comint-send-input :separator)
2473 (def-completion-wrapper exit-minibuffer :minibuffer-separator)
2474 (def-completion-wrapper eval-print-last-sexp :separator)
2475 (def-completion-wrapper eval-last-sexp :separator)
2476 ;;(def-completion-wrapper minibuffer-complete-and-exit :minibuffer)
2477
2478 ;;-----------------------------------------------
2479 ;; Cursor movement
2480 ;;-----------------------------------------------
2481
2482 (def-completion-wrapper next-line :under-or-before)
2483 (def-completion-wrapper previous-line :under-or-before)
2484 (def-completion-wrapper beginning-of-buffer :under-or-before)
2485 (def-completion-wrapper end-of-buffer :under-or-before)
2486 (def-completion-wrapper beginning-of-line :under-or-before)
2487 (def-completion-wrapper end-of-line :under-or-before)
2488 (def-completion-wrapper forward-char :under-or-before)
2489 (def-completion-wrapper forward-word :under-or-before)
2490 (def-completion-wrapper forward-sexp :under-or-before)
2491 (def-completion-wrapper backward-char :backward-under)
2492 (def-completion-wrapper backward-word :backward-under)
2493 (def-completion-wrapper backward-sexp :backward-under)
2494
2495 (def-completion-wrapper delete-backward-char :backward)
2496 (def-completion-wrapper delete-backward-char-untabify :backward)
2497
2498 ;; Tests --
2499 ;; foobarbiz
2500 ;; foobar
2501 ;; fooquux
2502 ;; fooper
2503 2428
2504 (cmpl-statistics-block 2429 (completion-initialize)))
2505 (record-completion-file-loaded)) 2430
2431;;-----------------------------------------------
2432;; End of line chars.
2433;;-----------------------------------------------
2434(completion-def-wrapper 'newline :separator)
2435(completion-def-wrapper 'newline-and-indent :separator)
2436(completion-def-wrapper 'comint-send-input :separator)
2437(completion-def-wrapper 'exit-minibuffer :minibuffer-separator)
2438(completion-def-wrapper 'eval-print-last-sexp :separator)
2439(completion-def-wrapper 'eval-last-sexp :separator)
2440;;(completion-def-wrapper 'minibuffer-complete-and-exit :minibuffer)
2506 2441
2507 (initialize-completions)) 2442;;-----------------------------------------------
2443;; Cursor movement
2444;;-----------------------------------------------
2508 2445
2509(mapc (lambda (x) (add-to-list 'debug-ignored-errors x)) 2446(completion-def-wrapper 'next-line :under-or-before)
2510 '("^To complete, the point must be after a symbol at least [0-9]* character long\\.$" 2447(completion-def-wrapper 'previous-line :under-or-before)
2448(completion-def-wrapper 'beginning-of-buffer :under-or-before)
2449(completion-def-wrapper 'end-of-buffer :under-or-before)
2450(completion-def-wrapper 'beginning-of-line :under-or-before)
2451(completion-def-wrapper 'end-of-line :under-or-before)
2452(completion-def-wrapper 'forward-char :under-or-before)
2453(completion-def-wrapper 'forward-word :under-or-before)
2454(completion-def-wrapper 'forward-sexp :under-or-before)
2455(completion-def-wrapper 'backward-char :backward-under)
2456(completion-def-wrapper 'backward-word :backward-under)
2457(completion-def-wrapper 'backward-sexp :backward-under)
2458
2459(completion-def-wrapper 'delete-backward-char :backward)
2460(completion-def-wrapper 'delete-backward-char-untabify :backward)
2461
2462;; Old names, non-namespace-clean.
2463(defvaralias 'cmpl-syntax-table 'completion-syntax-table)
2464(defalias 'initialize-completions 'completion-initialize)
2465
2466(dolist (x '("^To complete, the point must be after a symbol at least [0-9]* character long\\.$"
2511 "^The string \".*\" is too short to be saved as a completion\\.$")) 2467 "^The string \".*\" is too short to be saved as a completion\\.$"))
2468 (add-to-list 'debug-ignored-errors x))
2512 2469
2513(provide 'completion) 2470(provide 'completion)
2514 2471
2515;;; arch-tag: 6990dafe-4abd-4a1f-8c42-ffb25e120f5e 2472;; arch-tag: 6990dafe-4abd-4a1f-8c42-ffb25e120f5e
2516;;; completion.el ends here 2473;;; completion.el ends here
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 59a8b341cad..b84568b7060 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -800,13 +800,18 @@ This operation eliminates any saved settings for the group members,
800making them as if they had never been customized at all." 800making them as if they had never been customized at all."
801 (interactive) 801 (interactive)
802 (let ((children custom-options)) 802 (let ((children custom-options))
803 (mapc (lambda (widget) 803 (when (or (and (= 1 (length children))
804 (and (widget-get widget :custom-standard-value) 804 (memq (widget-type (car children))
805 (widget-apply widget :custom-standard-value) 805 '(custom-variable custom-face)))
806 (if (memq (widget-get widget :custom-state) 806 (yes-or-no-p "Really erase all customizations in this buffer? "))
807 '(modified set changed saved rogue)) 807 (mapc (lambda (widget)
808 (widget-apply widget :custom-reset-standard)))) 808 (and (if (widget-get widget :custom-standard-value)
809 children))) 809 (widget-apply widget :custom-standard-value)
810 t)
811 (memq (widget-get widget :custom-state)
812 '(modified set changed saved rogue))
813 (widget-apply widget :custom-reset-standard)))
814 children))))
810 815
811;;; The Customize Commands 816;;; The Customize Commands
812 817
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index 449efa5fe66..3e4e32ecc97 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -323,13 +323,18 @@ FACE's list property `theme-face' \(using `custom-push-theme')."
323 (let ((face (nth 0 entry)) 323 (let ((face (nth 0 entry))
324 (spec (nth 1 entry)) 324 (spec (nth 1 entry))
325 (now (nth 2 entry)) 325 (now (nth 2 entry))
326 (comment (nth 3 entry))) 326 (comment (nth 3 entry))
327 oldspec)
327 ;; If FACE is actually an alias, customize the face it 328 ;; If FACE is actually an alias, customize the face it
328 ;; is aliased to. 329 ;; is aliased to.
329 (if (get face 'face-alias) 330 (if (get face 'face-alias)
330 (setq face (get face 'face-alias))) 331 (setq face (get face 'face-alias)))
331 (put face 'saved-face spec) 332
332 (put face 'saved-face-comment comment) 333 (setq oldspec (get face 'theme-face))
334 (when (not (and oldspec (eq 'user (caar oldspec))))
335 (put face 'saved-face spec)
336 (put face 'saved-face-comment comment))
337
333 (custom-push-theme 'theme-face face theme 'set spec) 338 (custom-push-theme 'theme-face face theme 'set spec)
334 (when (or now immediate) 339 (when (or now immediate)
335 (put face 'force-face (if now 'rogue 'immediate))) 340 (put face 'force-face (if now 'rogue 'immediate)))
diff --git a/lisp/custom.el b/lisp/custom.el
index 0c6085c714f..b2a9ba6443c 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -1120,9 +1120,14 @@ See `custom-theme-load-themes' for more information on BODY."
1120(defun enable-theme (theme) 1120(defun enable-theme (theme)
1121 "Reenable all variable and face settings defined by THEME. 1121 "Reenable all variable and face settings defined by THEME.
1122The newly enabled theme gets the highest precedence (after `user'). 1122The newly enabled theme gets the highest precedence (after `user').
1123If it is already enabled, just give it highest precedence (after `user')." 1123If it is already enabled, just give it highest precedence (after `user').
1124
1125This signals an error if THEME does not specify any theme
1126settings. Theme settings are set using `load-theme'."
1124 (interactive "SEnable Custom theme: ") 1127 (interactive "SEnable Custom theme: ")
1125 (let ((settings (get theme 'theme-settings))) 1128 (let ((settings (get theme 'theme-settings)))
1129 (if (and (not (eq theme 'user)) (null settings))
1130 (error "No theme settings defined in %s." (symbol-name theme)))
1126 (dolist (s settings) 1131 (dolist (s settings)
1127 (let* ((prop (car s)) 1132 (let* ((prop (car s))
1128 (symbol (cadr s)) 1133 (symbol (cadr s))
@@ -1130,7 +1135,8 @@ If it is already enabled, just give it highest precedence (after `user')."
1130 (put symbol prop (cons (cddr s) (assq-delete-all theme spec-list))) 1135 (put symbol prop (cons (cddr s) (assq-delete-all theme spec-list)))
1131 (if (eq prop 'theme-value) 1136 (if (eq prop 'theme-value)
1132 (custom-theme-recalc-variable symbol) 1137 (custom-theme-recalc-variable symbol)
1133 (custom-theme-recalc-face symbol))))) 1138 (if (facep symbol)
1139 (custom-theme-recalc-face symbol))))))
1134 (setq custom-enabled-themes 1140 (setq custom-enabled-themes
1135 (cons theme (delq theme custom-enabled-themes))) 1141 (cons theme (delq theme custom-enabled-themes)))
1136 ;; `user' must always be the highest-precedence enabled theme. 1142 ;; `user' must always be the highest-precedence enabled theme.
diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el
index b330f2b10d7..ea99030d943 100644
--- a/lisp/dabbrev.el
+++ b/lisp/dabbrev.el
@@ -373,11 +373,7 @@ function pointed out by `dabbrev-friend-buffer-function' to find the
373completions. 373completions.
374 374
375If the prefix argument is 16 (which comes from C-u C-u), 375If the prefix argument is 16 (which comes from C-u C-u),
376then it searches *all* buffers. 376then it searches *all* buffers."
377
378With no prefix argument, it reuses an old completion list
379if there is a suitable one already."
380
381 (interactive "*P") 377 (interactive "*P")
382 (dabbrev--reset-global-variables) 378 (dabbrev--reset-global-variables)
383 (let* ((dabbrev-check-other-buffers (and arg t)) 379 (let* ((dabbrev-check-other-buffers (and arg t))
@@ -392,57 +388,43 @@ if there is a suitable one already."
392 (my-obarray dabbrev--last-obarray) 388 (my-obarray dabbrev--last-obarray)
393 init) 389 init)
394 (save-excursion 390 (save-excursion
395 (if (and (null arg) 391 ;;--------------------------------
396 my-obarray 392 ;; New abbreviation to expand.
397 (or (eq dabbrev--last-completion-buffer (current-buffer)) 393 ;;--------------------------------
398 (and (window-minibuffer-p (selected-window)) 394 (setq dabbrev--last-abbreviation abbrev)
399 (eq dabbrev--last-completion-buffer 395 ;; Find all expansion
400 (dabbrev--minibuffer-origin)))) 396 (let ((completion-list
401 dabbrev--last-abbreviation 397 (dabbrev--find-all-expansions abbrev ignore-case-p))
402 (>= (length abbrev) (length dabbrev--last-abbreviation)) 398 (completion-ignore-case ignore-case-p))
403 (string= dabbrev--last-abbreviation 399 ;; Make an obarray with all expansions
404 (substring abbrev 0 400 (setq my-obarray (make-vector (length completion-list) 0))
405 (length dabbrev--last-abbreviation))) 401 (or (> (length my-obarray) 0)
406 (setq init (try-completion abbrev my-obarray))) 402 (error "No dynamic expansion for \"%s\" found%s"
407 ;; We can reuse the existing completion list. 403 abbrev
408 nil 404 (if dabbrev--check-other-buffers "" " in this-buffer")))
409 ;;-------------------------------- 405 (cond
410 ;; New abbreviation to expand. 406 ((or (not ignore-case-p)
411 ;;-------------------------------- 407 (not dabbrev-case-replace))
412 (setq dabbrev--last-abbreviation abbrev) 408 (mapc (function (lambda (string)
413 ;; Find all expansion 409 (intern string my-obarray)))
414 (let ((completion-list 410 completion-list))
415 (dabbrev--find-all-expansions abbrev ignore-case-p)) 411 ((string= abbrev (upcase abbrev))
416 (completion-ignore-case ignore-case-p)) 412 (mapc (function (lambda (string)
417 ;; Make an obarray with all expansions 413 (intern (upcase string) my-obarray)))
418 (setq my-obarray (make-vector (length completion-list) 0)) 414 completion-list))
419 (or (> (length my-obarray) 0) 415 ((string= (substring abbrev 0 1)
420 (error "No dynamic expansion for \"%s\" found%s" 416 (upcase (substring abbrev 0 1)))
421 abbrev 417 (mapc (function (lambda (string)
422 (if dabbrev--check-other-buffers "" " in this-buffer"))) 418 (intern (capitalize string) my-obarray)))
423 (cond 419 completion-list))
424 ((or (not ignore-case-p) 420 (t
425 (not dabbrev-case-replace)) 421 (mapc (function (lambda (string)
426 (mapc (function (lambda (string) 422 (intern (downcase string) my-obarray)))
427 (intern string my-obarray))) 423 completion-list)))
428 completion-list)) 424 (setq dabbrev--last-obarray my-obarray)
429 ((string= abbrev (upcase abbrev)) 425 (setq dabbrev--last-completion-buffer (current-buffer))
430 (mapc (function (lambda (string) 426 ;; Find the longest common string.
431 (intern (upcase string) my-obarray))) 427 (setq init (try-completion abbrev my-obarray))))
432 completion-list))
433 ((string= (substring abbrev 0 1)
434 (upcase (substring abbrev 0 1)))
435 (mapc (function (lambda (string)
436 (intern (capitalize string) my-obarray)))
437 completion-list))
438 (t
439 (mapc (function (lambda (string)
440 (intern (downcase string) my-obarray)))
441 completion-list)))
442 (setq dabbrev--last-obarray my-obarray)
443 (setq dabbrev--last-completion-buffer (current-buffer))
444 ;; Find the longest common string.
445 (setq init (try-completion abbrev my-obarray)))))
446 ;;-------------------------------- 428 ;;--------------------------------
447 ;; Let the user choose between the expansions 429 ;; Let the user choose between the expansions
448 ;;-------------------------------- 430 ;;--------------------------------
diff --git a/lisp/dframe.el b/lisp/dframe.el
index 4be0ee8f097..56bbdc36c01 100644
--- a/lisp/dframe.el
+++ b/lisp/dframe.el
@@ -1,6 +1,6 @@
1;;; dframe --- dedicate frame support modes 1;;; dframe --- dedicate frame support modes
2 2
3;;; Copyright (C) 1996, 97, 98, 99, 2000, 01, 02, 03, 04 Free Software Foundation 3;;; Copyright (C) 1996, 97, 98, 99, 2000, 01, 02, 03, 04, 05 Free Software Foundation
4 4
5;; Author: Eric M. Ludlam <zappo@gnu.org> 5;; Author: Eric M. Ludlam <zappo@gnu.org>
6;; Keywords: file, tags, tools 6;; Keywords: file, tags, tools
@@ -509,7 +509,7 @@ a cons cell indicationg a position of the form (LEFT . TOP)."
509 (setq newleft (+ pfx pfw 5) 509 (setq newleft (+ pfx pfw 5)
510 newtop pfy)) 510 newtop pfy))
511 ((eq location 'left) 511 ((eq location 'left)
512 (setq newleft (+ pfx 10 nfw) 512 (setq newleft (- pfx 10 nfw)
513 newtop pfy)) 513 newtop pfy))
514 ((eq location 'left-right) 514 ((eq location 'left-right)
515 (setq newleft 515 (setq newleft
diff --git a/lisp/ediff-wind.el b/lisp/ediff-wind.el
index e15c92d4bc9..9fd9f45ff03 100644
--- a/lisp/ediff-wind.el
+++ b/lisp/ediff-wind.el
@@ -955,8 +955,9 @@ into icons, regardless of the window manager."
955 (minibuffer-window 955 (minibuffer-window
956 designated-minibuffer-frame)) 956 designated-minibuffer-frame))
957 (cons 'width fwidth) 957 (cons 'width fwidth)
958 (cons 'height fheight)) 958 (cons 'height fheight)
959 ) 959 (cons 'user-position t)
960 ))
960 961
961 ;; adjust autoraise 962 ;; adjust autoraise
962 (setq adjusted-parameters 963 (setq adjusted-parameters
@@ -1135,9 +1136,8 @@ It assumes that it is called from within the control buffer."
1135 (list (cons 'left (max 0 (eval (cdr (assoc 'left frame-A-params))))) 1136 (list (cons 'left (max 0 (eval (cdr (assoc 'left frame-A-params)))))
1136 (cons 'width (cdr (assoc 'width frame-A-params)))) 1137 (cons 'width (cdr (assoc 'width frame-A-params))))
1137 ediff-wide-display-frame frame-A) 1138 ediff-wide-display-frame frame-A)
1138 (modify-frame-parameters frame-A (list (cons 'left cw) 1139 (modify-frame-parameters
1139 (cons 'width wd))))) 1140 frame-A `((left . ,cw) (width . ,wd) (user-position t)))))
1140
1141 1141
1142 1142
1143;; Revise the mode line to display which difference we have selected 1143;; Revise the mode line to display which difference we have selected
diff --git a/lisp/ediff.el b/lisp/ediff.el
index 696fc9668e6..32ca177388e 100644
--- a/lisp/ediff.el
+++ b/lisp/ediff.el
@@ -8,7 +8,7 @@
8;; Keywords: comparing, merging, patching, tools, unix 8;; Keywords: comparing, merging, patching, tools, unix
9 9
10(defconst ediff-version "2.80.1" "The current version of Ediff") 10(defconst ediff-version "2.80.1" "The current version of Ediff")
11(defconst ediff-date "October 5, 2005" "Date of last update") 11(defconst ediff-date "November 25, 2005" "Date of last update")
12 12
13 13
14;; This file is part of GNU Emacs. 14;; This file is part of GNU Emacs.
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index ff795e6de77..2356483b233 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -135,6 +135,15 @@ or macro definition or a defcustom)."
135 (if (equal setter ''custom-set-minor-mode) 135 (if (equal setter ''custom-set-minor-mode)
136 `(put ',varname 'custom-set 'custom-set-minor-mode)))))) 136 `(put ',varname 'custom-set 'custom-set-minor-mode))))))
137 137
138 ((eq car 'defgroup)
139 ;; In Emacs this is normally handled separately by cus-dep.el, but for
140 ;; third party packages, it can be convenient to explicitly autoload
141 ;; a group.
142 (let ((groupname (nth 1 form)))
143 `(let ((loads (get ',groupname 'custom-loads)))
144 (if (member ',file loads) nil
145 (put ',groupname 'custom-loads (cons ',file loads))))))
146
138 ;; nil here indicates that this is not a special autoload form. 147 ;; nil here indicates that this is not a special autoload form.
139 (t nil)))) 148 (t nil))))
140 149
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 74c77128059..244029491de 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2175,7 +2175,12 @@ copier, a `NAME-p' predicate, and setf-able `NAME-SLOT' accessors.
2175 (symbol-name (car args)) "")))) 2175 (symbol-name (car args)) ""))))
2176 ((eq opt :constructor) 2176 ((eq opt :constructor)
2177 (if (cdr args) 2177 (if (cdr args)
2178 (push args constrs) 2178 (progn
2179 ;; If this defines a constructor of the same name as
2180 ;; the default one, don't define the default.
2181 (if (eq (car args) constructor)
2182 (setq constructor nil))
2183 (push args constrs))
2179 (if args (setq constructor (car args))))) 2184 (if args (setq constructor (car args)))))
2180 ((eq opt :copier) 2185 ((eq opt :copier)
2181 (if args (setq copier (car args)))) 2186 (if args (setq copier (car args))))
diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el
index 426c79e51c3..569847a0ea1 100644
--- a/lisp/emacs-lisp/elp.el
+++ b/lisp/emacs-lisp/elp.el
@@ -206,18 +206,28 @@ This variable is set by the master function.")
206 "Master function symbol.") 206 "Master function symbol.")
207 207
208(defvar elp-not-profilable 208(defvar elp-not-profilable
209 '(elp-wrapper elp-elapsed-time error call-interactively apply current-time interactive-p) 209 ;; First, the functions used inside each instrumented function:
210 '(elp-wrapper called-interactively-p
211 ;; Then the functions used by the above functions. I used
212 ;; (delq nil (mapcar (lambda (x) (and (symbolp x) (fboundp x) x))
213 ;; (aref (symbol-function 'elp-wrapper) 2)))
214 ;; to help me find this list.
215 error call-interactively apply current-time)
210 "List of functions that cannot be profiled. 216 "List of functions that cannot be profiled.
211Those functions are used internally by the profiling code and profiling 217Those functions are used internally by the profiling code and profiling
212them would thus lead to infinite recursion.") 218them would thus lead to infinite recursion.")
213 219
214(defun elp-not-profilable-p (fun) 220(defun elp-profilable-p (fun)
215 (or (memq fun elp-not-profilable) 221 (and (symbolp fun)
216 (keymapp fun) 222 (fboundp fun)
217 (condition-case nil 223 (not (or (memq fun elp-not-profilable)
218 (when (subrp (symbol-function fun)) 224 (keymapp fun)
219 (eq 'unevalled (cdr (subr-arity (symbol-function fun))))) 225 (memq (car-safe (symbol-function fun)) '(autoload macro))
220 (error nil)))) 226 (condition-case nil
227 (when (subrp (indirect-function fun))
228 (eq 'unevalled
229 (cdr (subr-arity (indirect-function fun)))))
230 (error nil))))))
221 231
222 232
223;;;###autoload 233;;;###autoload
@@ -237,9 +247,6 @@ FUNSYM must be a symbol of a defined function."
237 (let* ((funguts (symbol-function funsym)) 247 (let* ((funguts (symbol-function funsym))
238 (infovec (vector 0 0 funguts)) 248 (infovec (vector 0 0 funguts))
239 (newguts '(lambda (&rest args)))) 249 (newguts '(lambda (&rest args))))
240 ;; We cannot profile functions used internally during profiling.
241 (when (elp-not-profilable-p funsym)
242 (error "ELP cannot profile the function: %s" funsym))
243 ;; we cannot profile macros 250 ;; we cannot profile macros
244 (and (eq (car-safe funguts) 'macro) 251 (and (eq (car-safe funguts) 'macro)
245 (error "ELP cannot profile macro: %s" funsym)) 252 (error "ELP cannot profile macro: %s" funsym))
@@ -252,6 +259,9 @@ FUNSYM must be a symbol of a defined function."
252 ;; type functionality (i.e. it shouldn't execute the function). 259 ;; type functionality (i.e. it shouldn't execute the function).
253 (and (eq (car-safe funguts) 'autoload) 260 (and (eq (car-safe funguts) 'autoload)
254 (error "ELP cannot profile autoloaded function: %s" funsym)) 261 (error "ELP cannot profile autoloaded function: %s" funsym))
262 ;; We cannot profile functions used internally during profiling.
263 (unless (elp-profilable-p funsym)
264 (error "ELP cannot profile the function: %s" funsym))
255 ;; put rest of newguts together 265 ;; put rest of newguts together
256 (if (commandp funsym) 266 (if (commandp funsym)
257 (setq newguts (append newguts '((interactive))))) 267 (setq newguts (append newguts '((interactive)))))
@@ -344,18 +354,15 @@ Use optional LIST if provided instead."
344For example, to instrument all ELP functions, do the following: 354For example, to instrument all ELP functions, do the following:
345 355
346 \\[elp-instrument-package] RET elp- RET" 356 \\[elp-instrument-package] RET elp- RET"
347 (interactive "sPrefix of package to instrument: ") 357 (interactive
358 (list (completing-read "Prefix of package to instrument: "
359 obarray 'elp-profilable-p)))
348 (if (zerop (length prefix)) 360 (if (zerop (length prefix))
349 (error "Instrumenting all Emacs functions would render Emacs unusable")) 361 (error "Instrumenting all Emacs functions would render Emacs unusable"))
350 (elp-instrument-list 362 (elp-instrument-list
351 (mapcar 363 (mapcar
352 'intern 364 'intern
353 (all-completions 365 (all-completions prefix obarray 'elp-profilable-p))))
354 prefix obarray
355 (lambda (sym)
356 (and (fboundp sym)
357 (not (or (memq (car-safe (symbol-function sym)) '(autoload macro))
358 (elp-not-profilable-p sym)))))))))
359 366
360(defun elp-restore-list (&optional list) 367(defun elp-restore-list (&optional list)
361 "Restore the original definitions for all functions in `elp-function-list'. 368 "Restore the original definitions for all functions in `elp-function-list'.
@@ -488,12 +495,12 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]."
488 ;; check for very large or small numbers 495 ;; check for very large or small numbers
489 (if (string-match "^\\(.*\\)\\(e[+-].*\\)$" number) 496 (if (string-match "^\\(.*\\)\\(e[+-].*\\)$" number)
490 (concat (substring 497 (concat (substring
491 (substring number (match-beginning 1) (match-end 1)) 498 (match-string 1 number)
492 0 499 0
493 (- width (match-end 2) (- (match-beginning 2)) 3)) 500 (- width (match-end 2) (- (match-beginning 2)) 3))
494 "..." 501 "..."
495 (substring number (match-beginning 2) (match-end 2))) 502 (match-string 2 number))
496 (concat (substring number 0 width))))) 503 (substring number 0 width))))
497 504
498(defun elp-output-result (resultvec) 505(defun elp-output-result (resultvec)
499 ;; output the RESULTVEC into the results buffer. RESULTVEC is a 4 or 506 ;; output the RESULTVEC into the results buffer. RESULTVEC is a 4 or
@@ -528,20 +535,15 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]."
528 535
529(defvar elp-results-symname-map 536(defvar elp-results-symname-map
530 (let ((map (make-sparse-keymap))) 537 (let ((map (make-sparse-keymap)))
531 (define-key map [mouse-2] 'elp-results-jump-to-definition-by-mouse) 538 (define-key map [mouse-2] 'elp-results-jump-to-definition)
532 (define-key map "\C-m" 'elp-results-jump-to-definition) 539 (define-key map "\C-m" 'elp-results-jump-to-definition)
533 map) 540 map)
534 "Keymap used on the function name column." ) 541 "Keymap used on the function name column." )
535 542
536(defun elp-results-jump-to-definition-by-mouse (event) 543(defun elp-results-jump-to-definition (&optional event)
537 "Jump to the definition of the function under the place specified by EVENT."
538 (interactive "e")
539 (posn-set-point (event-end event))
540 (elp-results-jump-to-definition))
541
542(defun elp-results-jump-to-definition ()
543 "Jump to the definition of the function under the point." 544 "Jump to the definition of the function under the point."
544 (interactive) 545 (interactive (list last-nonmenu-event))
546 (if event (posn-set-point (event-end event)))
545 (find-function (get-text-property (point) 'elp-symname))) 547 (find-function (get-text-property (point) 'elp-symname)))
546 548
547(defun elp-output-insert-symname (symname) 549(defun elp-output-insert-symname (symname)
@@ -550,7 +552,7 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]."
550 'elp-symname (intern symname) 552 'elp-symname (intern symname)
551 'keymap elp-results-symname-map 553 'keymap elp-results-symname-map
552 'mouse-face 'highlight 554 'mouse-face 'highlight
553 'help-echo (substitute-command-keys "\\{elp-results-symname-map}")))) 555 'help-echo "mouse-2 or RET jumps to definition")))
554 556
555;;;###autoload 557;;;###autoload
556(defun elp-results () 558(defun elp-results ()
@@ -630,5 +632,5 @@ displayed."
630 632
631(provide 'elp) 633(provide 'elp)
632 634
633;;; arch-tag: c4eef311-9b3e-4bb2-8a54-3485d41b4eb1 635;; arch-tag: c4eef311-9b3e-4bb2-8a54-3485d41b4eb1
634;;; elp.el ends here 636;;; elp.el ends here
diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el
index d83ebd543cd..0590af50249 100644
--- a/lisp/emulation/cua-rect.el
+++ b/lisp/emulation/cua-rect.el
@@ -65,6 +65,7 @@
65;; List of overlays used to display current rectangle. 65;; List of overlays used to display current rectangle.
66(defvar cua--rectangle-overlays nil) 66(defvar cua--rectangle-overlays nil)
67(make-variable-buffer-local 'cua--rectangle-overlays) 67(make-variable-buffer-local 'cua--rectangle-overlays)
68(put 'cua--rectangle-overlays 'permanent-local t)
68 69
69(defvar cua--overlay-keymap 70(defvar cua--overlay-keymap
70 (let ((map (make-sparse-keymap))) 71 (let ((map (make-sparse-keymap)))
@@ -781,7 +782,7 @@ If command is repeated at same position, delete the rectangle."
781 (make-string 782 (make-string
782 (- l cl0 (if (and (= le pl) (/= le lb)) 1 0)) 783 (- l cl0 (if (and (= le pl) (/= le lb)) 1 0))
783 (if cua--virtual-edges-debug ?. ?\s)) 784 (if cua--virtual-edges-debug ?. ?\s))
784 'face 'default)) 785 'face (or (get-text-property (1- s) 'face) 'default)))
785 (if (/= pl le) 786 (if (/= pl le)
786 (setq s (1- s)))) 787 (setq s (1- s))))
787 (cond 788 (cond
@@ -1393,7 +1394,12 @@ With prefix arg, indent to that column."
1393 (if (and mark-active 1394 (if (and mark-active
1394 (not deactivate-mark)) 1395 (not deactivate-mark))
1395 (cua--highlight-rectangle) 1396 (cua--highlight-rectangle)
1396 (cua--deactivate-rectangle))) 1397 (cua--deactivate-rectangle))
1398 (when cua--rectangle-overlays
1399 ;; clean-up after revert-buffer
1400 (mapcar (function delete-overlay) cua--rectangle-overlays)
1401 (setq cua--rectangle-overlays nil)
1402 (setq deactivate-mark t)))
1397 (when cua--rect-undo-set-point 1403 (when cua--rect-undo-set-point
1398 (goto-char cua--rect-undo-set-point) 1404 (goto-char cua--rect-undo-set-point)
1399 (setq cua--rect-undo-set-point nil))) 1405 (setq cua--rect-undo-set-point nil)))
diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el
index 2af0a9bbfa8..c8a5d53b504 100644
--- a/lisp/emulation/viper-keym.el
+++ b/lisp/emulation/viper-keym.el
@@ -200,9 +200,10 @@ Enter as a sexp. Examples: \"\\C-z\", [(control ?z)]."
200 :type 'string 200 :type 'string
201 :group 'viper) 201 :group 'viper)
202 202
203(defcustom viper-ESC-key [(escape)] ; "\e" 203(defcustom viper-ESC-key (if (viper-window-display-p) [(escape)] "\e")
204 "Key used to ESC. 204 "Key used to ESC.
205Enter as a sexp. Examples: \"\\e\", [(escape)]." 205Enter as a sexp. Examples: \"\\e\", [(escape)].
206If running in a terminal, [(escape)] is not understood, so must use \"\\e\"."
206 :type 'sexp 207 :type 'sexp
207 :group 'viper 208 :group 'viper
208 :set (lambda (symbol value) 209 :set (lambda (symbol value)
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index 7bcaf8be399..754eff3906d 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -9,7 +9,7 @@
9;; Author: Michael Kifer <kifer@cs.stonybrook.edu> 9;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
10;; Keywords: emulations 10;; Keywords: emulations
11 11
12(defconst viper-version "3.11.5 of October 5, 2005" 12(defconst viper-version "3.11.5 of November 25, 2005"
13 "The current version of Viper") 13 "The current version of Viper")
14 14
15;; This file is part of GNU Emacs. 15;; This file is part of GNU Emacs.
@@ -429,7 +429,6 @@ widget."
429 occur-mode 429 occur-mode
430 430
431 mh-folder-mode 431 mh-folder-mode
432 mail-mode
433 gnus-group-mode 432 gnus-group-mode
434 gnus-summary-mode 433 gnus-summary-mode
435 434
@@ -442,6 +441,8 @@ widget."
442 441
443 rcirc-mode 442 rcirc-mode
444 443
444 jde-javadoc-checker-report-mode
445
445 view-mode 446 view-mode
446 vm-mode 447 vm-mode
447 vm-summary-mode) 448 vm-summary-mode)
diff --git a/lisp/files.el b/lisp/files.el
index 7bd01f93841..6a049f8f0f1 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -3154,7 +3154,7 @@ Uses `backup-directory-alist' in the same way as does
3154This function returns a relative file name which is equivalent to FILENAME 3154This function returns a relative file name which is equivalent to FILENAME
3155when used with that default directory as the default. 3155when used with that default directory as the default.
3156If FILENAME and DIRECTORY lie on different machines or on different drives 3156If FILENAME and DIRECTORY lie on different machines or on different drives
3157on a DOS/Windows machine, it returns FILENAME on expanded form." 3157on a DOS/Windows machine, it returns FILENAME in expanded form."
3158 (save-match-data 3158 (save-match-data
3159 (setq directory 3159 (setq directory
3160 (file-name-as-directory (expand-file-name (or directory 3160 (file-name-as-directory (expand-file-name (or directory
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 1c9ccff2432..47bc5152501 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -1123,8 +1123,9 @@ delimit the region to fontify."
1123 (font-lock-fontify-region (point) (mark))) 1123 (font-lock-fontify-region (point) (mark)))
1124 ((error quit) (message "Fontifying block...%s" error-data))))))) 1124 ((error quit) (message "Fontifying block...%s" error-data)))))))
1125 1125
1126(if (boundp 'facemenu-keymap) 1126(unless (featurep 'facemenu)
1127 (define-key facemenu-keymap "\M-o" 'font-lock-fontify-block)) 1127 (error "facemenu must be loaded before font-lock"))
1128(define-key facemenu-keymap "\M-o" 'font-lock-fontify-block)
1128 1129
1129;;; End of Fontification functions. 1130;;; End of Fontification functions.
1130 1131
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index b6d62bf9b83..01babcddc86 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,9 @@
12005-11-30 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * gnus-delay.el (gnus-delay-group): Don't autoload.
4 It's useless and could trigger a bug in cus-dep.el causing ldefs-boot
5 to be re-loaded when customizing the `gnus-delay' group.
6
12005-11-19 Chong Yidong <cyd@stupidchicken.com> 72005-11-19 Chong Yidong <cyd@stupidchicken.com>
2 8
3 * message.el: Revert last changes. 9 * message.el: Revert last changes.
diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el
index a664ff8ba00..a427aaefab8 100644
--- a/lisp/gnus/gnus-delay.el
+++ b/lisp/gnus/gnus-delay.el
@@ -39,7 +39,6 @@
39(require 'gnus-draft) 39(require 'gnus-draft)
40(autoload 'parse-time-string "parse-time" nil nil) 40(autoload 'parse-time-string "parse-time" nil nil)
41 41
42;;;###autoload
43(defgroup gnus-delay nil 42(defgroup gnus-delay nil
44 "Arrange for sending postings later." 43 "Arrange for sending postings later."
45 :version "22.1" 44 :version "22.1"
@@ -195,5 +194,5 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil."
195;; coding: iso-8859-1 194;; coding: iso-8859-1
196;; End: 195;; End:
197 196
198;;; arch-tag: fb2ad634-a897-4142-a503-f5991ec2349d 197;; arch-tag: fb2ad634-a897-4142-a503-f5991ec2349d
199;;; gnus-delay.el ends here 198;;; gnus-delay.el ends here
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 6d95827c3e4..6bc41e7b947 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -223,7 +223,6 @@ KIND should be `var' for a variable or `subr' for a subroutine."
223 (concat "src/" file) 223 (concat "src/" file)
224 file))))) 224 file)))))
225 225
226;;;###autoload
227(defface help-argument-name '((((supports :slant italic)) :inherit italic)) 226(defface help-argument-name '((((supports :slant italic)) :inherit italic))
228 "Face to highlight argument names in *Help* buffers." 227 "Face to highlight argument names in *Help* buffers."
229 :group 'help) 228 :group 'help)
@@ -436,7 +435,9 @@ face (according to `face-differs-from-default-p')."
436 (format "\nMacro: %s" (format-kbd-macro def))) 435 (format "\nMacro: %s" (format-kbd-macro def)))
437 (t "[Missing arglist. Please make a bug report.]"))) 436 (t "[Missing arglist. Please make a bug report.]")))
438 (high (help-highlight-arguments use doc))) 437 (high (help-highlight-arguments use doc)))
439 (insert (car high) "\n") 438 (let ((fill-begin (point)))
439 (insert (car high) "\n")
440 (fill-region fill-begin (point)))
440 (setq doc (cdr high)))) 441 (setq doc (cdr high))))
441 (let ((obsolete (and 442 (let ((obsolete (and
442 ;; function might be a lambda construct. 443 ;; function might be a lambda construct.
diff --git a/lisp/help.el b/lisp/help.el
index 5141c06981a..cd95af0e866 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -38,7 +38,57 @@
38(add-hook 'temp-buffer-setup-hook 'help-mode-setup) 38(add-hook 'temp-buffer-setup-hook 'help-mode-setup)
39(add-hook 'temp-buffer-show-hook 'help-mode-finish) 39(add-hook 'temp-buffer-show-hook 'help-mode-finish)
40 40
41(defvar help-map (make-sparse-keymap) 41(defvar help-map
42 (let ((map (make-sparse-keymap)))
43 (define-key map (char-to-string help-char) 'help-for-help)
44 (define-key map [help] 'help-for-help)
45 (define-key map [f1] 'help-for-help)
46 (define-key map "." 'display-local-help)
47 (define-key map "?" 'help-for-help)
48
49 (define-key map "\C-c" 'describe-copying)
50 (define-key map "\C-d" 'describe-distribution)
51 (define-key map "\C-e" 'view-emacs-problems)
52 (define-key map "\C-f" 'view-emacs-FAQ)
53 (define-key map "\C-m" 'view-order-manuals)
54 (define-key map "\C-n" 'view-emacs-news)
55 (define-key map "\C-p" 'describe-project)
56 (define-key map "\C-t" 'view-todo)
57 (define-key map "\C-w" 'describe-no-warranty)
58
59 ;; This does not fit the pattern, but it is natural given the C-\ command.
60 (define-key map "\C-\\" 'describe-input-method)
61
62 (define-key map "C" 'describe-coding-system)
63 (define-key map "F" 'Info-goto-emacs-command-node)
64 (define-key map "I" 'describe-input-method)
65 (define-key map "K" 'Info-goto-emacs-key-command-node)
66 (define-key map "L" 'describe-language-environment)
67 (define-key map "S" 'info-lookup-symbol)
68
69 (define-key map "a" 'apropos-command)
70 (define-key map "b" 'describe-bindings)
71 (define-key map "c" 'describe-key-briefly)
72 (define-key map "d" 'apropos-documentation)
73 (define-key map "e" 'view-echo-area-messages)
74 (define-key map "f" 'describe-function)
75 (define-key map "h" 'view-hello-file)
76
77 (define-key map "i" 'info)
78 (define-key map "4i" 'info-other-window)
79
80 (define-key map "k" 'describe-key)
81 (define-key map "l" 'view-lossage)
82 (define-key map "m" 'describe-mode)
83 (define-key map "n" 'view-emacs-news)
84 (define-key map "p" 'finder-by-keyword)
85 (define-key map "r" 'info-emacs-manual)
86 (define-key map "s" 'describe-syntax)
87 (define-key map "t" 'help-with-tutorial)
88 (define-key map "w" 'where-is)
89 (define-key map "v" 'describe-variable)
90 (define-key map "q" 'help-quit)
91 map)
42 "Keymap for characters following the Help key.") 92 "Keymap for characters following the Help key.")
43 93
44(define-key global-map (char-to-string help-char) 'help-command) 94(define-key global-map (char-to-string help-char) 'help-command)
@@ -46,73 +96,9 @@
46(define-key global-map [f1] 'help-command) 96(define-key global-map [f1] 'help-command)
47(fset 'help-command help-map) 97(fset 'help-command help-map)
48 98
49(define-key help-map (char-to-string help-char) 'help-for-help)
50(define-key help-map [help] 'help-for-help)
51(define-key help-map [f1] 'help-for-help)
52(define-key help-map "." 'display-local-help)
53(define-key help-map "?" 'help-for-help)
54
55(define-key help-map "\C-c" 'describe-copying)
56(define-key help-map "\C-d" 'describe-distribution)
57(define-key help-map "\C-e" 'view-emacs-problems)
58(define-key help-map "\C-f" 'view-emacs-FAQ)
59(define-key help-map "\C-m" 'view-order-manuals)
60(define-key help-map "\C-n" 'view-emacs-news)
61(define-key help-map "\C-p" 'describe-project)
62(define-key help-map "\C-t" 'view-todo)
63(define-key help-map "\C-w" 'describe-no-warranty)
64
65;; This does not fit the pattern, but it is natural given the C-\ command.
66(define-key help-map "\C-\\" 'describe-input-method)
67
68(define-key help-map "C" 'describe-coding-system)
69(define-key help-map "F" 'Info-goto-emacs-command-node)
70(define-key help-map "I" 'describe-input-method)
71(define-key help-map "K" 'Info-goto-emacs-key-command-node)
72(define-key help-map "L" 'describe-language-environment)
73(define-key help-map "S" 'info-lookup-symbol)
74
75(define-key help-map "a" 'apropos-command)
76
77(define-key help-map "b" 'describe-bindings)
78
79(define-key help-map "c" 'describe-key-briefly)
80
81(define-key help-map "d" 'apropos-documentation)
82
83(define-key help-map "e" 'view-echo-area-messages)
84
85(define-key help-map "f" 'describe-function)
86
87(define-key help-map "h" 'view-hello-file)
88
89(define-key help-map "i" 'info)
90(define-key help-map "4i" 'info-other-window)
91
92(define-key help-map "k" 'describe-key)
93
94(define-key help-map "l" 'view-lossage)
95
96(define-key help-map "m" 'describe-mode)
97
98(define-key help-map "n" 'view-emacs-news)
99
100(define-key help-map "p" 'finder-by-keyword)
101(autoload 'finder-by-keyword "finder" 99(autoload 'finder-by-keyword "finder"
102 "Find packages matching a given keyword." t) 100 "Find packages matching a given keyword." t)
103 101
104(define-key help-map "r" 'info-emacs-manual)
105
106(define-key help-map "s" 'describe-syntax)
107
108(define-key help-map "t" 'help-with-tutorial)
109
110(define-key help-map "w" 'where-is)
111
112(define-key help-map "v" 'describe-variable)
113
114(define-key help-map "q" 'help-quit)
115
116;; insert-button makes the action nil if it is not store somewhere 102;; insert-button makes the action nil if it is not store somewhere
117(defvar help-button-cache nil) 103(defvar help-button-cache nil)
118 104
@@ -590,7 +576,7 @@ the last key hit are used."
590 (goto-char position))) 576 (goto-char position)))
591 ;; Ok, now look up the key and name the command. 577 ;; Ok, now look up the key and name the command.
592 (let ((defn (or (string-key-binding key) 578 (let ((defn (or (string-key-binding key)
593 (key-binding key))) 579 (key-binding key t)))
594 key-desc) 580 key-desc)
595 ;; Don't bother user with strings from (e.g.) the select-paste menu. 581 ;; Don't bother user with strings from (e.g.) the select-paste menu.
596 (if (stringp (aref key (1- (length key)))) 582 (if (stringp (aref key (1- (length key))))
@@ -615,7 +601,7 @@ KEY can be any kind of a key sequence; it can include keyboard events,
615mouse events, and/or menu events. When calling from a program, 601mouse events, and/or menu events. When calling from a program,
616pass KEY as a string or a vector. 602pass KEY as a string or a vector.
617 603
618If non-nil, UNTRANSLATED is a vector of the correspondinguntranslated events. 604If non-nil, UNTRANSLATED is a vector of the corresponding untranslated events.
619It can also be a number, in which case the untranslated events from 605It can also be a number, in which case the untranslated events from
620the last key sequence entered are used." 606the last key sequence entered are used."
621 ;; UP-EVENT is the up-event that was discarded by reading KEY, or nil. 607 ;; UP-EVENT is the up-event that was discarded by reading KEY, or nil.
@@ -635,7 +621,7 @@ the last key sequence entered are used."
635 (when (windowp window) 621 (when (windowp window)
636 (set-buffer (window-buffer window)) 622 (set-buffer (window-buffer window))
637 (goto-char position)) 623 (goto-char position))
638 (let ((defn (or (string-key-binding key) (key-binding key)))) 624 (let ((defn (or (string-key-binding key) (key-binding key t))))
639 (if (or (null defn) (integerp defn) (equal defn 'undefined)) 625 (if (or (null defn) (integerp defn) (equal defn 'undefined))
640 (message "%s is undefined" (help-key-description key untranslated)) 626 (message "%s is undefined" (help-key-description key untranslated))
641 (help-setup-xref (list #'describe-function defn) (interactive-p)) 627 (help-setup-xref (list #'describe-function defn) (interactive-p))
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index 8d565ab61a8..4c61be5529e 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -89,16 +89,6 @@
89 :link '(custom-manual "(emacs)Highlight Interactively") 89 :link '(custom-manual "(emacs)Highlight Interactively")
90 :group 'font-lock) 90 :group 'font-lock)
91 91
92;;;###autoload
93(defcustom hi-lock-mode nil
94 "Toggle hi-lock, for interactively adding font-lock text-highlighting patterns."
95 :set (lambda (symbol value)
96 (hi-lock-mode (or value 0)))
97 :initialize 'custom-initialize-default
98 :type 'boolean
99 :group 'hi-lock
100 :require 'hi-lock)
101
102(defcustom hi-lock-file-patterns-range 10000 92(defcustom hi-lock-file-patterns-range 10000
103 "Limit of search in a buffer for hi-lock patterns. 93 "Limit of search in a buffer for hi-lock patterns.
104When a file is visited and hi-lock mode is on patterns starting 94When a file is visited and hi-lock mode is on patterns starting
@@ -244,19 +234,11 @@ calls."
244(define-key hi-lock-map "\C-xwr" 'unhighlight-regexp) 234(define-key hi-lock-map "\C-xwr" 'unhighlight-regexp)
245(define-key hi-lock-map "\C-xwb" 'hi-lock-write-interactive-patterns) 235(define-key hi-lock-map "\C-xwb" 'hi-lock-write-interactive-patterns)
246 236
247(unless (assq 'hi-lock-mode minor-mode-map-alist)
248 (setq minor-mode-map-alist (cons (cons 'hi-lock-mode hi-lock-map)
249 minor-mode-map-alist)))
250
251(unless (assq 'hi-lock-mode minor-mode-alist)
252 (setq minor-mode-alist (cons '(hi-lock-mode " H") minor-mode-alist)))
253
254
255;; Visible Functions 237;; Visible Functions
256 238
257 239
258;;;###autoload 240;;;###autoload
259(defun hi-lock-mode (&optional arg) 241(define-minor-mode hi-lock-buffer-mode
260 "Toggle minor mode for interactively adding font-lock highlighting patterns. 242 "Toggle minor mode for interactively adding font-lock highlighting patterns.
261 243
262If ARG positive turn hi-lock on. Issuing a hi-lock command will also 244If ARG positive turn hi-lock on. Issuing a hi-lock command will also
@@ -297,43 +279,40 @@ of characters into buffer) `hi-lock-file-patterns-range'. Patterns
297will be read until 279will be read until
298 Hi-lock: end 280 Hi-lock: end
299is found. A mode is excluded if it's in the list `hi-lock-exclude-modes'." 281is found. A mode is excluded if it's in the list `hi-lock-exclude-modes'."
300 (interactive) 282 :group 'hi-lock
301 (let ((hi-lock-mode-prev hi-lock-mode)) 283 :lighter " H"
302 (setq hi-lock-mode 284 :global nil
303 (if (null arg) (not hi-lock-mode) 285 :keymap hi-lock-map
304 (> (prefix-numeric-value arg) 0))) 286 (if hi-lock-buffer-mode
305 ;; Turned on. 287 ;; Turned on.
306 (when (and (not hi-lock-mode-prev) hi-lock-mode) 288 (progn
307 (add-hook 'find-file-hook 'hi-lock-find-file-hook) 289 (unless font-lock-mode (font-lock-mode 1))
308 (add-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook) 290 (define-key-after menu-bar-edit-menu [hi-lock]
309 (if (null (default-value 'font-lock-defaults)) 291 (cons "Regexp Highlighting" hi-lock-menu))
310 (setq-default font-lock-defaults '(nil))) 292 (hi-lock-find-patterns)
311 (if (null font-lock-defaults) 293 (add-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook nil t))
312 (setq font-lock-defaults '(nil)))
313 (unless font-lock-mode
314 (font-lock-mode 1))
315 (define-key-after menu-bar-edit-menu [hi-lock]
316 (cons "Regexp Highlighting" hi-lock-menu))
317 (dolist (buffer (buffer-list))
318 (with-current-buffer buffer (hi-lock-find-patterns))))
319 ;; Turned off. 294 ;; Turned off.
320 (when (and hi-lock-mode-prev (not hi-lock-mode)) 295 (when (or hi-lock-interactive-patterns
321 (dolist (buffer (buffer-list)) 296 hi-lock-file-patterns)
322 (with-current-buffer buffer 297 (when hi-lock-interactive-patterns
323 (when (or hi-lock-interactive-patterns hi-lock-file-patterns) 298 (font-lock-remove-keywords nil hi-lock-interactive-patterns)
324 (font-lock-remove-keywords nil hi-lock-interactive-patterns) 299 (setq hi-lock-interactive-patterns nil))
325 (font-lock-remove-keywords nil hi-lock-file-patterns) 300 (when hi-lock-file-patterns
326 (setq hi-lock-interactive-patterns nil 301 (font-lock-remove-keywords nil hi-lock-file-patterns)
327 hi-lock-file-patterns nil) 302 (setq hi-lock-file-patterns nil))
328 (when font-lock-mode (hi-lock-refontify))))) 303 (if font-lock-mode
329 304 (font-lock-fontify-buffer)))
330 (let ((fld (default-value 'font-lock-defaults))) 305 (define-key-after menu-bar-edit-menu [hi-lock] nil)
331 (if (and fld (listp fld) (null (car fld))) 306 (remove-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook t)))
332 (setq-default font-lock-defaults (cdr fld))))
333 (define-key-after menu-bar-edit-menu [hi-lock] nil)
334 (remove-hook 'find-file-hook 'hi-lock-find-file-hook)
335 (remove-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook))))
336 307
308;;;###autoload
309(define-global-minor-mode hi-lock-mode
310 hi-lock-buffer-mode turn-on-hi-lock-if-enabled
311 :group 'hi-lock)
312
313(defun turn-on-hi-lock-if-enabled ()
314 (unless (memq major-mode hi-lock-exclude-modes)
315 (hi-lock-buffer-mode 1)))
337 316
338;;;###autoload 317;;;###autoload
339(defalias 'highlight-lines-matching-regexp 'hi-lock-line-face-buffer) 318(defalias 'highlight-lines-matching-regexp 'hi-lock-line-face-buffer)
@@ -352,12 +331,12 @@ list maintained for regexps, global history maintained for faces.
352 (cons (or (car hi-lock-regexp-history) "") 1 ) 331 (cons (or (car hi-lock-regexp-history) "") 1 )
353 nil nil 'hi-lock-regexp-history)) 332 nil nil 'hi-lock-regexp-history))
354 (hi-lock-read-face-name))) 333 (hi-lock-read-face-name)))
355 (unless hi-lock-mode (hi-lock-mode)) 334 (or (facep face) (setq face 'hi-yellow))
356 (or (facep face) (setq face 'rwl-yellow)) 335 (unless hi-lock-buffer-mode (hi-lock-buffer-mode 1))
357 (hi-lock-set-pattern 336 (hi-lock-set-pattern
358 ;; The \\(?:...\\) grouping construct ensures that a leading ^, +, * or ? 337 ;; The \\(?:...\\) grouping construct ensures that a leading ^, +, * or ?
359 ;; or a trailing $ in REGEXP will be interpreted correctly. 338 ;; or a trailing $ in REGEXP will be interpreted correctly.
360 (list (concat "^.*\\(?:" regexp "\\).*$") (list 0 (list 'quote face) t)))) 339 (concat "^.*\\(?:" regexp "\\).*$") face))
361 340
362 341
363;;;###autoload 342;;;###autoload
@@ -377,9 +356,9 @@ list maintained for regexps, global history maintained for faces.
377 (cons (or (car hi-lock-regexp-history) "") 1 ) 356 (cons (or (car hi-lock-regexp-history) "") 1 )
378 nil nil 'hi-lock-regexp-history)) 357 nil nil 'hi-lock-regexp-history))
379 (hi-lock-read-face-name))) 358 (hi-lock-read-face-name)))
380 (or (facep face) (setq face 'rwl-yellow)) 359 (or (facep face) (setq face 'hi-yellow))
381 (unless hi-lock-mode (hi-lock-mode)) 360 (unless hi-lock-buffer-mode (hi-lock-buffer-mode 1))
382 (hi-lock-set-pattern (list regexp (list 0 (list 'quote face) t)))) 361 (hi-lock-set-pattern regexp face))
383 362
384;;;###autoload 363;;;###autoload
385(defalias 'highlight-phrase 'hi-lock-face-phrase-buffer) 364(defalias 'highlight-phrase 'hi-lock-face-phrase-buffer)
@@ -397,9 +376,9 @@ lower-case letters made case insensitive."
397 (cons (or (car hi-lock-regexp-history) "") 1 ) 376 (cons (or (car hi-lock-regexp-history) "") 1 )
398 nil nil 'hi-lock-regexp-history))) 377 nil nil 'hi-lock-regexp-history)))
399 (hi-lock-read-face-name))) 378 (hi-lock-read-face-name)))
400 (or (facep face) (setq face 'rwl-yellow)) 379 (or (facep face) (setq face 'hi-yellow))
401 (unless hi-lock-mode (hi-lock-mode)) 380 (unless hi-lock-buffer-mode (hi-lock-buffer-mode 1))
402 (hi-lock-set-pattern (list regexp (list 0 (list 'quote face) t)))) 381 (hi-lock-set-pattern regexp face))
403 382
404;;;###autoload 383;;;###autoload
405(defalias 'unhighlight-regexp 'hi-lock-unface-buffer) 384(defalias 'unhighlight-regexp 'hi-lock-unface-buffer)
@@ -451,7 +430,7 @@ interactive functions. \(See `hi-lock-interactive-patterns'.\)
451 (font-lock-remove-keywords nil (list keyword)) 430 (font-lock-remove-keywords nil (list keyword))
452 (setq hi-lock-interactive-patterns 431 (setq hi-lock-interactive-patterns
453 (delq keyword hi-lock-interactive-patterns)) 432 (delq keyword hi-lock-interactive-patterns))
454 (hi-lock-refontify)))) 433 (font-lock-fontify-buffer))))
455 434
456;;;###autoload 435;;;###autoload
457(defun hi-lock-write-interactive-patterns () 436(defun hi-lock-write-interactive-patterns ()
@@ -461,17 +440,16 @@ Interactively added patterns are those normally specified using
461`highlight-regexp' and `highlight-lines-matching-regexp'; they can 440`highlight-regexp' and `highlight-lines-matching-regexp'; they can
462be found in variable `hi-lock-interactive-patterns'." 441be found in variable `hi-lock-interactive-patterns'."
463 (interactive) 442 (interactive)
464 (let ((prefix (format "%s %s:" (or comment-start "") "Hi-lock"))) 443 (if (null hi-lock-interactive-patterns)
465 (when (> (+ (point) (length prefix)) hi-lock-file-patterns-range) 444 (error "There are no interactive patterns"))
466 (beep) 445 (let ((beg (point)))
467 (message
468 "Warning, inserted keywords not close enough to top of file."))
469 (mapcar 446 (mapcar
470 (lambda (pattern) 447 (lambda (pattern)
471 (insert (format "%s (%s) %s\n" 448 (insert (format "Hi-lock: (%s)\n" (prin1-to-string pattern))))
472 prefix (prin1-to-string pattern) (or comment-end "")))) 449 hi-lock-interactive-patterns)
473 hi-lock-interactive-patterns))) 450 (comment-region beg (point)))
474 451 (when (> (point) hi-lock-file-patterns-range)
452 (warn "Inserted keywords not close enough to top of file")))
475 453
476;; Implementation Functions 454;; Implementation Functions
477 455
@@ -513,29 +491,22 @@ not suitable."
513 (length prefix) 0))) 491 (length prefix) 0)))
514 '(hi-lock-face-history . 0)))) 492 '(hi-lock-face-history . 0))))
515 493
516(defun hi-lock-find-file-hook () 494(defun hi-lock-set-pattern (regexp face)
517 "Add hi-lock patterns, if present." 495 "Highlight REGEXP with face FACE."
518 (hi-lock-find-patterns)) 496 (let ((pattern (list regexp (list 0 (list 'quote face) t))))
519
520(defun hi-lock-current-line (&optional end)
521 "Return line number of line at point.
522Optional argument END is maximum excursion."
523 (interactive)
524 (save-excursion
525 (beginning-of-line)
526 (1+ (count-lines 1 (or end (point))))))
527
528(defun hi-lock-set-pattern (pattern)
529 "Add PATTERN to list of interactively highlighted patterns and refontify."
530 (hi-lock-set-patterns (list pattern)))
531
532(defun hi-lock-set-patterns (patterns)
533 "Add PATTERNS to list of interactively highlighted patterns and refontify.."
534 (dolist (pattern patterns)
535 (unless (member pattern hi-lock-interactive-patterns) 497 (unless (member pattern hi-lock-interactive-patterns)
536 (font-lock-add-keywords nil (list pattern)) 498 (font-lock-add-keywords nil (list pattern))
537 (add-to-list 'hi-lock-interactive-patterns pattern))) 499 (push pattern hi-lock-interactive-patterns)
538 (hi-lock-refontify)) 500 (let ((buffer-undo-list t)
501 (inhibit-read-only t)
502 (mod (buffer-modified-p)))
503 (save-excursion
504 (goto-char (point-min))
505 (while (re-search-forward regexp (point-max) t)
506 (put-text-property
507 (match-beginning 0) (match-end 0) 'face face)
508 (goto-char (match-end 0))))
509 (set-buffer-modified-p mod)))))
539 510
540(defun hi-lock-set-file-patterns (patterns) 511(defun hi-lock-set-file-patterns (patterns)
541 "Replace file patterns list with PATTERNS and refontify." 512 "Replace file patterns list with PATTERNS and refontify."
@@ -543,13 +514,7 @@ Optional argument END is maximum excursion."
543 (font-lock-remove-keywords nil hi-lock-file-patterns) 514 (font-lock-remove-keywords nil hi-lock-file-patterns)
544 (setq hi-lock-file-patterns patterns) 515 (setq hi-lock-file-patterns patterns)
545 (font-lock-add-keywords nil hi-lock-file-patterns) 516 (font-lock-add-keywords nil hi-lock-file-patterns)
546 (hi-lock-refontify))) 517 (font-lock-fontify-buffer)))
547
548(defun hi-lock-refontify ()
549 "Unfontify then refontify buffer. Used when hi-lock patterns change."
550 (interactive)
551 (unless font-lock-mode (font-lock-mode 1))
552 (font-lock-fontify-buffer))
553 518
554(defun hi-lock-find-patterns () 519(defun hi-lock-find-patterns ()
555 "Find patterns in current buffer for hi-lock." 520 "Find patterns in current buffer for hi-lock."
@@ -569,16 +534,17 @@ Optional argument END is maximum excursion."
569 (condition-case nil 534 (condition-case nil
570 (setq all-patterns (append (read (current-buffer)) all-patterns)) 535 (setq all-patterns (append (read (current-buffer)) all-patterns))
571 (error (message "Invalid pattern list expression at %d" 536 (error (message "Invalid pattern list expression at %d"
572 (hi-lock-current-line))))))) 537 (line-number-at-pos)))))))
573 (when hi-lock-mode (hi-lock-set-file-patterns all-patterns)) 538 (when hi-lock-buffer-mode (hi-lock-set-file-patterns all-patterns))
574 (if (interactive-p) 539 (if (interactive-p)
575 (message "Hi-lock added %d patterns." (length all-patterns)))))) 540 (message "Hi-lock added %d patterns." (length all-patterns))))))
576 541
577(defun hi-lock-font-lock-hook () 542(defun hi-lock-font-lock-hook ()
578 "Add hi lock patterns to font-lock's." 543 "Add hi lock patterns to font-lock's."
579 (when hi-lock-mode 544 (if font-lock-mode
580 (font-lock-add-keywords nil hi-lock-file-patterns) 545 (progn (font-lock-add-keywords nil hi-lock-file-patterns)
581 (font-lock-add-keywords nil hi-lock-interactive-patterns))) 546 (font-lock-add-keywords nil hi-lock-interactive-patterns))
547 (hi-lock-buffer-mode -1)))
582 548
583(provide 'hi-lock) 549(provide 'hi-lock)
584 550
diff --git a/lisp/ido.el b/lisp/ido.el
index cc4eab4bb4d..a6bd99cdeea 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -899,7 +899,19 @@ The fallback command is passed as an argument to the functions."
899;; Persistent variables 899;; Persistent variables
900 900
901(defvar ido-mode-map nil 901(defvar ido-mode-map nil
902 "Keymap for `ido-find-file' and `ido-switch-buffer'.") 902 "Currently active keymap for ido commands.")
903
904(defvar ido-mode-common-map nil
905 "Keymap for all ido commands.")
906
907(defvar ido-mode-file-map nil
908 "Keymap for ido file commands.")
909
910(defvar ido-mode-file-dir-map nil
911 "Keymap for ido file and directory commands.")
912
913(defvar ido-mode-buffer-map nil
914 "Keymap for ido buffer commands.")
903 915
904(defvar ido-file-history nil 916(defvar ido-file-history nil
905 "History of files selected using `ido-find-file'.") 917 "History of files selected using `ido-find-file'.")
@@ -1301,8 +1313,7 @@ Removes badly formatted data and ignored directories."
1301 (while e 1313 (while e
1302 (setq d (car e) e (cdr e)) 1314 (setq d (car e) e (cdr e))
1303 (if (not (consp d)) 1315 (if (not (consp d))
1304 (set-text-properties 0 (length d) nil d)))))) 1316 (set-text-properties 0 (length d) nil d)))))))
1305)
1306 1317
1307 1318
1308(defun ido-kill-emacs-hook () 1319(defun ido-kill-emacs-hook ()
@@ -1333,6 +1344,8 @@ This function also adds a hook to the minibuffer."
1333 (t nil))) 1344 (t nil)))
1334 1345
1335 (ido-everywhere (if ido-everywhere 1 -1)) 1346 (ido-everywhere (if ido-everywhere 1 -1))
1347 (when ido-mode
1348 (ido-init-mode-maps))
1336 1349
1337 (when ido-mode 1350 (when ido-mode
1338 (add-hook 'minibuffer-setup-hook 'ido-minibuffer-setup) 1351 (add-hook 'minibuffer-setup-hook 'ido-minibuffer-setup)
@@ -1391,12 +1404,11 @@ With ARG, turn ido speed-up on if arg is positive, off otherwise."
1391 1404
1392 1405
1393;;; IDO KEYMAP 1406;;; IDO KEYMAP
1394(defun ido-define-mode-map () 1407(defun ido-init-mode-maps ()
1395 "Set up the keymap for `ido'." 1408 "Set up the keymaps used by `ido'."
1396 (let (map)
1397 ;; generated every time so that it can inherit new functions.
1398 1409
1399 (setq map (copy-keymap minibuffer-local-map)) 1410 ;; Common map
1411 (let ((map (make-sparse-keymap)))
1400 (define-key map "\C-a" 'ido-toggle-ignore) 1412 (define-key map "\C-a" 'ido-toggle-ignore)
1401 (define-key map "\C-c" 'ido-toggle-case) 1413 (define-key map "\C-c" 'ido-toggle-case)
1402 (define-key map "\C-e" 'ido-edit-input) 1414 (define-key map "\C-e" 'ido-edit-input)
@@ -1414,57 +1426,90 @@ With ARG, turn ido speed-up on if arg is positive, off otherwise."
1414 (define-key map [right] 'ido-next-match) 1426 (define-key map [right] 'ido-next-match)
1415 (define-key map [left] 'ido-prev-match) 1427 (define-key map [left] 'ido-prev-match)
1416 (define-key map "?" 'ido-completion-help) 1428 (define-key map "?" 'ido-completion-help)
1417
1418 ;; Magic commands. 1429 ;; Magic commands.
1419 (define-key map "\C-b" 'ido-magic-backward-char) 1430 (define-key map "\C-b" 'ido-magic-backward-char)
1420 (define-key map "\C-f" 'ido-magic-forward-char) 1431 (define-key map "\C-f" 'ido-magic-forward-char)
1421 (define-key map "\C-d" 'ido-magic-delete-char) 1432 (define-key map "\C-d" 'ido-magic-delete-char)
1433 (set-keymap-parent map minibuffer-local-map)
1434 (setq ido-mode-common-map map))
1435
1436 ;; File and directory map
1437 (let ((map (make-sparse-keymap)))
1438 (define-key map "\C-x\C-b" 'ido-enter-switch-buffer)
1439 (define-key map "\C-x\C-f" 'ido-fallback-command)
1440 (define-key map "\C-x\C-d" 'ido-enter-dired)
1441 (define-key map [down] 'ido-next-match-dir)
1442 (define-key map [up] 'ido-prev-match-dir)
1443 (define-key map [(meta up)] 'ido-prev-work-directory)
1444 (define-key map [(meta down)] 'ido-next-work-directory)
1445 (define-key map [backspace] 'ido-delete-backward-updir)
1446 (define-key map "\d" 'ido-delete-backward-updir)
1447 (define-key map [(meta backspace)] 'ido-delete-backward-word-updir)
1448 (define-key map [(control backspace)] 'ido-up-directory)
1449 (define-key map "\C-l" 'ido-reread-directory)
1450 (define-key map [(meta ?d)] 'ido-wide-find-dir-or-delete-dir)
1451 (define-key map [(meta ?b)] 'ido-push-dir)
1452 (define-key map [(meta ?f)] 'ido-wide-find-file-or-pop-dir)
1453 (define-key map [(meta ?k)] 'ido-forget-work-directory)
1454 (define-key map [(meta ?m)] 'ido-make-directory)
1455 (define-key map [(meta ?n)] 'ido-next-work-directory)
1456 (define-key map [(meta ?o)] 'ido-prev-work-file)
1457 (define-key map [(meta control ?o)] 'ido-next-work-file)
1458 (define-key map [(meta ?p)] 'ido-prev-work-directory)
1459 (define-key map [(meta ?s)] 'ido-merge-work-directories)
1460 (set-keymap-parent map ido-mode-common-map)
1461 (setq ido-mode-file-dir-map map))
1462
1463 ;; File only map
1464 (let ((map (make-sparse-keymap)))
1465 (define-key map "\C-k" 'ido-delete-file-at-head)
1466 (define-key map "\C-o" 'ido-copy-current-word)
1467 (define-key map "\C-w" 'ido-copy-current-file-name)
1468 (define-key map [(meta ?l)] 'ido-toggle-literal)
1469 (define-key map "\C-v" 'ido-toggle-vc)
1470 (set-keymap-parent map ido-mode-file-dir-map)
1471 (setq ido-mode-file-map map))
1472
1473 ;; Buffer map
1474 (let ((map (make-sparse-keymap)))
1475 (define-key map "\C-x\C-f" 'ido-enter-find-file)
1476 (define-key map "\C-x\C-b" 'ido-fallback-command)
1477 (define-key map "\C-k" 'ido-kill-buffer-at-head)
1478 (set-keymap-parent map ido-mode-common-map)
1479 (setq ido-mode-buffer-map map)))
1422 1480
1423 (when (memq ido-cur-item '(file dir))
1424 (define-key map "\C-x\C-b" (or ido-context-switch-command 'ido-enter-switch-buffer))
1425 (define-key map "\C-x\C-f" 'ido-fallback-command)
1426 (define-key map "\C-x\C-d" (or (and ido-context-switch-command 'ignore) 'ido-enter-dired))
1427 (define-key map [down] 'ido-next-match-dir)
1428 (define-key map [up] 'ido-prev-match-dir)
1429 (define-key map [(meta up)] 'ido-prev-work-directory)
1430 (define-key map [(meta down)] 'ido-next-work-directory)
1431 (define-key map [backspace] 'ido-delete-backward-updir)
1432 (define-key map "\d" 'ido-delete-backward-updir)
1433 (define-key map [(meta backspace)] 'ido-delete-backward-word-updir)
1434 (define-key map [(control backspace)] 'ido-up-directory)
1435 (define-key map "\C-l" 'ido-reread-directory)
1436 (define-key map [(meta ?d)] 'ido-wide-find-dir-or-delete-dir)
1437 (define-key map [(meta ?b)] 'ido-push-dir)
1438 (define-key map [(meta ?f)] 'ido-wide-find-file-or-pop-dir)
1439 (define-key map [(meta ?k)] 'ido-forget-work-directory)
1440 (define-key map [(meta ?m)] 'ido-make-directory)
1441 (define-key map [(meta ?n)] 'ido-next-work-directory)
1442 (define-key map [(meta ?o)] 'ido-prev-work-file)
1443 (define-key map [(meta control ?o)] 'ido-next-work-file)
1444 (define-key map [(meta ?p)] 'ido-prev-work-directory)
1445 (define-key map [(meta ?s)] 'ido-merge-work-directories)
1446 )
1447 1481
1448 (when (eq ido-cur-item 'file) 1482(defun ido-define-mode-map ()
1449 (define-key map "\C-k" 'ido-delete-file-at-head) 1483 "Set up the keymap for `ido'."
1450 (define-key map "\C-o" 'ido-copy-current-word)
1451 (define-key map "\C-w" 'ido-copy-current-file-name)
1452 (define-key map [(meta ?l)] 'ido-toggle-literal)
1453 (define-key map "\C-v" 'ido-toggle-vc)
1454 )
1455 1484
1456 (when (eq ido-cur-item 'buffer) 1485 ;; generated every time so that it can inherit new functions.
1457 (define-key map "\C-x\C-f" (or ido-context-switch-command 'ido-enter-find-file)) 1486 (let ((map (make-sparse-keymap))
1458 (define-key map "\C-x\C-b" 'ido-fallback-command) 1487 (viper-p (if (boundp 'viper-mode) viper-mode)))
1459 (define-key map "\C-k" 'ido-kill-buffer-at-head)
1460 )
1461 1488
1462 (when (if (boundp 'viper-mode) viper-mode) 1489 (when viper-p
1463 (define-key map [remap viper-intercept-ESC-key] 'ignore) 1490 (define-key map [remap viper-intercept-ESC-key] 'ignore))
1464 (when (memq ido-cur-item '(file dir)) 1491
1492 (cond
1493 ((memq ido-cur-item '(file dir))
1494 (when ido-context-switch-command
1495 (define-key map "\C-x\C-b" ido-context-switch-command)
1496 (define-key map "\C-x\C-d" 'ignore))
1497 (when viper-p
1465 (define-key map [remap viper-backward-char] 'ido-delete-backward-updir) 1498 (define-key map [remap viper-backward-char] 'ido-delete-backward-updir)
1466 (define-key map [remap viper-del-backward-char-in-insert] 'ido-delete-backward-updir) 1499 (define-key map [remap viper-del-backward-char-in-insert] 'ido-delete-backward-updir)
1467 (define-key map [remap viper-delete-backward-word] 'ido-delete-backward-word-updir))) 1500 (define-key map [remap viper-delete-backward-word] 'ido-delete-backward-word-updir))
1501 (set-keymap-parent map
1502 (if (eq ido-cur-item 'file)
1503 ido-mode-file-map
1504 ido-mode-file-dir-map)))
1505
1506 ((eq ido-cur-item 'buffer)
1507 (when ido-context-switch-command
1508 (define-key map "\C-x\C-f" ido-context-switch-command))
1509 (set-keymap-parent map ido-mode-buffer-map))
1510
1511 (t
1512 (set-keymap-parent map ido-mode-common-map)))
1468 1513
1469 (setq ido-mode-map map))) 1514 (setq ido-mode-map map)))
1470 1515
@@ -3625,7 +3670,7 @@ As you type in a string, all of the buffers matching the string are
3625displayed if substring-matching is used \(default). Look at 3670displayed if substring-matching is used \(default). Look at
3626`ido-enable-prefix' and `ido-toggle-prefix'. When you have found the 3671`ido-enable-prefix' and `ido-toggle-prefix'. When you have found the
3627buffer you want, it can then be selected. As you type, most keys have 3672buffer you want, it can then be selected. As you type, most keys have
3628their normal keybindings, except for the following: \\<ido-mode-map> 3673their normal keybindings, except for the following: \\<ido-mode-buffer-map>
3629 3674
3630RET Select the buffer at the front of the list of matches. If the 3675RET Select the buffer at the front of the list of matches. If the
3631list is empty, possibly prompt to create new buffer. 3676list is empty, possibly prompt to create new buffer.
@@ -3713,7 +3758,7 @@ type in a string, all of the filenames matching the string are displayed
3713if substring-matching is used \(default). Look at `ido-enable-prefix' and 3758if substring-matching is used \(default). Look at `ido-enable-prefix' and
3714`ido-toggle-prefix'. When you have found the filename you want, it can 3759`ido-toggle-prefix'. When you have found the filename you want, it can
3715then be selected. As you type, most keys have their normal keybindings, 3760then be selected. As you type, most keys have their normal keybindings,
3716except for the following: \\<ido-mode-map> 3761except for the following: \\<ido-mode-file-map>
3717 3762
3718RET Select the file at the front of the list of matches. If the 3763RET Select the file at the front of the list of matches. If the
3719list is empty, possibly prompt to create new file. 3764list is empty, possibly prompt to create new file.
@@ -3732,7 +3777,7 @@ in a separate window.
3732\\[ido-merge-work-directories] search for file in the work directory history. 3777\\[ido-merge-work-directories] search for file in the work directory history.
3733\\[ido-forget-work-directory] removes current directory from the work directory history. 3778\\[ido-forget-work-directory] removes current directory from the work directory history.
3734\\[ido-prev-work-file] or \\[ido-next-work-file] cycle through the work file history. 3779\\[ido-prev-work-file] or \\[ido-next-work-file] cycle through the work file history.
3735\\[ido-wide-find-file] and \\[ido-wide-find-dir] prompts and uses find to locate files or directories. 3780\\[ido-wide-find-file-or-pop-dir] and \\[ido-wide-find-dir-or-delete-dir] prompts and uses find to locate files or directories.
3736\\[ido-make-directory] prompts for a directory to create in current directory. 3781\\[ido-make-directory] prompts for a directory to create in current directory.
3737\\[ido-fallback-command] Fallback to non-ido version of current command. 3782\\[ido-fallback-command] Fallback to non-ido version of current command.
3738\\[ido-toggle-regexp] Toggle regexp searching. 3783\\[ido-toggle-regexp] Toggle regexp searching.
diff --git a/lisp/info.el b/lisp/info.el
index 84c83bd419b..a00afce7d0a 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -290,8 +290,7 @@ with wrapping around the current Info node."
290(defvar Info-current-file nil 290(defvar Info-current-file nil
291 "Info file that Info is now looking at, or nil. 291 "Info file that Info is now looking at, or nil.
292This is the name that was specified in Info, not the actual file name. 292This is the name that was specified in Info, not the actual file name.
293It doesn't contain directory names or file name extensions added by Info. 293It doesn't contain directory names or file name extensions added by Info.")
294Can also be t when using `Info-on-current-buffer'.")
295 294
296(defvar Info-current-subfile nil 295(defvar Info-current-subfile nil
297 "Info subfile that is actually in the *info* buffer now. 296 "Info subfile that is actually in the *info* buffer now.
@@ -691,12 +690,13 @@ it says do not attempt further (recursive) error recovery."
691 ;; Go into Info buffer. 690 ;; Go into Info buffer.
692 (or (eq major-mode 'Info-mode) (pop-to-buffer "*info*")) 691 (or (eq major-mode 'Info-mode) (pop-to-buffer "*info*"))
693 ;; Record the node we are leaving. 692 ;; Record the node we are leaving.
694 (if (and Info-current-file (not no-going-back)) 693 (if (not no-going-back)
695 (setq Info-history 694 (setq Info-history
696 (cons (list Info-current-file Info-current-node (point)) 695 (cons (list Info-current-file Info-current-node (point))
697 Info-history))) 696 Info-history)))
698 (Info-find-node-2 filename nodename no-going-back)) 697 (Info-find-node-2 filename nodename no-going-back))
699 698
699;;;###autoload
700(defun Info-on-current-buffer (&optional nodename) 700(defun Info-on-current-buffer (&optional nodename)
701 "Use the `Info-mode' to browse the current Info buffer. 701 "Use the `Info-mode' to browse the current Info buffer.
702If a prefix arg is provided, it queries for the NODENAME which 702If a prefix arg is provided, it queries for the NODENAME which
@@ -708,7 +708,10 @@ else defaults to \"Top\"."
708 (unless nodename (setq nodename "Top")) 708 (unless nodename (setq nodename "Top"))
709 (info-initialize) 709 (info-initialize)
710 (Info-mode) 710 (Info-mode)
711 (set (make-local-variable 'Info-current-file) t) 711 (set (make-local-variable 'Info-current-file)
712 (or buffer-file-name
713 ;; If called on a non-file buffer, make a fake file name.
714 (concat default-directory (buffer-name))))
712 (Info-find-node-2 nil nodename)) 715 (Info-find-node-2 nil nodename))
713 716
714;; It's perhaps a bit nasty to kill the *info* buffer to force a re-read, 717;; It's perhaps a bit nasty to kill the *info* buffer to force a re-read,
@@ -726,8 +729,7 @@ is preserved, if possible."
726 (pline (count-lines (point-min) (line-beginning-position))) 729 (pline (count-lines (point-min) (line-beginning-position)))
727 (wline (count-lines (point-min) (window-start))) 730 (wline (count-lines (point-min) (window-start)))
728 (old-history Info-history) 731 (old-history Info-history)
729 (new-history (and Info-current-file 732 (new-history (list Info-current-file Info-current-node (point))))
730 (list Info-current-file Info-current-node (point)))))
731 (kill-buffer (current-buffer)) 733 (kill-buffer (current-buffer))
732 (Info-find-node filename nodename) 734 (Info-find-node filename nodename)
733 (setq Info-history old-history) 735 (setq Info-history old-history)
@@ -1400,12 +1402,10 @@ any double quotes or backslashes must be escaped (\\\",\\\\)."
1400 (nconc (propertized-buffer-identification "%b") 1402 (nconc (propertized-buffer-identification "%b")
1401 (list 1403 (list
1402 (concat " (" 1404 (concat " ("
1403 (file-name-nondirectory 1405 (if Info-current-file
1404 (if (stringp Info-current-file) 1406 (file-name-nondirectory Info-current-file)
1405 Info-current-file 1407 " ")
1406 (or buffer-file-name ""))) 1408 ") " (or Info-current-node ""))))))
1407 ") "
1408 (or Info-current-node ""))))))
1409 1409
1410;; Go to an Info node specified with a filename-and-nodename string 1410;; Go to an Info node specified with a filename-and-nodename string
1411;; of the sort that is found in pointers in nodes. 1411;; of the sort that is found in pointers in nodes.
@@ -1884,7 +1884,7 @@ If SAME-FILE is non-nil, do not move to a different Info file."
1884 (let ((old-node Info-current-node) 1884 (let ((old-node Info-current-node)
1885 (old-file Info-current-file) 1885 (old-file Info-current-file)
1886 (node (Info-extract-pointer "up")) p) 1886 (node (Info-extract-pointer "up")) p)
1887 (and (or same-file (not (stringp Info-current-file))) 1887 (and same-file
1888 (string-match "^(" node) 1888 (string-match "^(" node)
1889 (error "Up node is in another Info file")) 1889 (error "Up node is in another Info file"))
1890 (Info-goto-node node) 1890 (Info-goto-node node)
@@ -3266,12 +3266,8 @@ With a zero prefix arg, put the name inside a function call to `info'."
3266 (interactive "P") 3266 (interactive "P")
3267 (unless Info-current-node 3267 (unless Info-current-node
3268 (error "No current Info node")) 3268 (error "No current Info node"))
3269 (let ((node (concat "(" (file-name-nondirectory 3269 (let ((node (concat "(" (file-name-nondirectory Info-current-file) ")"
3270 (or (and (stringp Info-current-file) 3270 Info-current-node)))
3271 Info-current-file)
3272 buffer-file-name
3273 ""))
3274 ")" Info-current-node)))
3275 (if (zerop (prefix-numeric-value arg)) 3271 (if (zerop (prefix-numeric-value arg))
3276 (setq node (concat "(info \"" node "\")"))) 3272 (setq node (concat "(info \"" node "\")")))
3277 (kill-new node) 3273 (kill-new node)
@@ -3804,23 +3800,19 @@ the variable `Info-file-list-for-emacs'."
3804 (and (not (equal (match-string 4) "")) 3800 (and (not (equal (match-string 4) ""))
3805 (match-string 4)) 3801 (match-string 4))
3806 (match-string 2))))) 3802 (match-string 2)))))
3807 (file (file-name-nondirectory 3803 (file Info-current-file)
3808 Info-current-file))
3809 (hl Info-history-list) 3804 (hl Info-history-list)
3810 res) 3805 res)
3811 (if (string-match "(\\([^)]+\\))\\([^)]*\\)" node) 3806 (if (string-match "(\\([^)]+\\))\\([^)]*\\)" node)
3812 (setq file (file-name-nondirectory 3807 (setq file (Info-find-file (match-string 1 node) t)
3813 (match-string 1 node))
3814 node (if (equal (match-string 2 node) "") 3808 node (if (equal (match-string 2 node) "")
3815 "Top" 3809 "Top"
3816 (match-string 2 node)))) 3810 (match-string 2 node))))
3817 (while hl 3811 (while hl
3818 (if (and (string-equal node (nth 1 (car hl))) 3812 (if (and (string-equal node (nth 1 (car hl)))
3819 (string-equal file 3813 (string-equal file (nth 0 (car hl))))
3820 (file-name-nondirectory 3814 (setq res (car hl) hl nil)
3821 (nth 0 (car hl))))) 3815 (setq hl (cdr hl))))
3822 (setq res (car hl) hl nil)
3823 (setq hl (cdr hl))))
3824 res))) 'info-xref-visited 'info-xref)) 3816 res))) 'info-xref-visited 'info-xref))
3825 ;; For multiline ref, unfontify newline and surrounding whitespace 3817 ;; For multiline ref, unfontify newline and surrounding whitespace
3826 (save-excursion 3818 (save-excursion
@@ -3913,22 +3905,19 @@ the variable `Info-file-list-for-emacs'."
3913 (let ((node (if (equal (match-string 3) "") 3905 (let ((node (if (equal (match-string 3) "")
3914 (match-string 1) 3906 (match-string 1)
3915 (match-string 3))) 3907 (match-string 3)))
3916 (file (file-name-nondirectory Info-current-file)) 3908 (file Info-current-file)
3917 (hl Info-history-list) 3909 (hl Info-history-list)
3918 res) 3910 res)
3919 (if (string-match "(\\([^)]+\\))\\([^)]*\\)" node) 3911 (if (string-match "(\\([^)]+\\))\\([^)]*\\)" node)
3920 (setq file (file-name-nondirectory 3912 (setq file (Info-find-file (match-string 1 node) t)
3921 (match-string 1 node))
3922 node (if (equal (match-string 2 node) "") 3913 node (if (equal (match-string 2 node) "")
3923 "Top" 3914 "Top"
3924 (match-string 2 node)))) 3915 (match-string 2 node))))
3925 (while hl 3916 (while hl
3926 (if (and (string-equal node (nth 1 (car hl))) 3917 (if (and (string-equal node (nth 1 (car hl)))
3927 (string-equal file 3918 (string-equal file (nth 0 (car hl))))
3928 (file-name-nondirectory 3919 (setq res (car hl) hl nil)
3929 (nth 0 (car hl))))) 3920 (setq hl (cdr hl))))
3930 (setq res (car hl) hl nil)
3931 (setq hl (cdr hl))))
3932 res))) 'info-xref-visited 'info-xref))) 3921 res))) 'info-xref-visited 'info-xref)))
3933 (when (and not-fontified-p (memq Info-hide-note-references '(t hide))) 3922 (when (and not-fontified-p (memq Info-hide-note-references '(t hide)))
3934 (put-text-property (match-beginning 2) (1- (match-end 6)) 3923 (put-text-property (match-beginning 2) (1- (match-end 6))
@@ -4121,7 +4110,7 @@ INDENT is the current indentation depth."
4121NODESPEC is a string of the form: (file)node." 4110NODESPEC is a string of the form: (file)node."
4122 (save-excursion 4111 (save-excursion
4123 ;; Set up a buffer we can use to fake-out Info. 4112 ;; Set up a buffer we can use to fake-out Info.
4124 (set-buffer (get-buffer-create "*info-browse-tmp*")) 4113 (set-buffer (get-buffer-create " *info-browse-tmp*"))
4125 (if (not (equal major-mode 'Info-mode)) 4114 (if (not (equal major-mode 'Info-mode))
4126 (Info-mode)) 4115 (Info-mode))
4127 ;; Get the node into this buffer 4116 ;; Get the node into this buffer
diff --git a/lisp/international/latexenc.el b/lisp/international/latexenc.el
index c2d24e1a190..15a0d1067e1 100644
--- a/lisp/international/latexenc.el
+++ b/lisp/international/latexenc.el
@@ -78,7 +78,8 @@
78 ("next" . next) ; The Next encoding 78 ("next" . next) ; The Next encoding
79 ("utf8" . utf-8) 79 ("utf8" . utf-8)
80 ("utf8x" . utf-8)) ; used by the Unicode LaTeX package 80 ("utf8x" . utf-8)) ; used by the Unicode LaTeX package
81 "Mapping from encoding names used by LaTeX's \"inputenc.sty\" to Emacs coding systems. 81 "Mapping from LaTeX encodings to Emacs coding systems.
82LaTeX encodings are specified with \"\\usepackage[encoding]{inputenc}\".
82Used by the function `latexenc-find-file-coding-system'." 83Used by the function `latexenc-find-file-coding-system'."
83 :group 'files 84 :group 'files
84 :group 'mule 85 :group 'mule
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 9d52ea1b05b..5ccf2bf92ba 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -386,6 +386,8 @@ A value of nil means highlight all matches."
386 (define-key map [iconify-frame] nil) 386 (define-key map [iconify-frame] nil)
387 (define-key map [make-frame-visible] nil) 387 (define-key map [make-frame-visible] nil)
388 (define-key map [mouse-movement] nil) 388 (define-key map [mouse-movement] nil)
389 (define-key map [language-change] nil)
390
389 ;; For searching multilingual text. 391 ;; For searching multilingual text.
390 (define-key map "\C-\\" 'isearch-toggle-input-method) 392 (define-key map "\C-\\" 'isearch-toggle-input-method)
391 (define-key map "\C-^" 'isearch-toggle-specified-input-method) 393 (define-key map "\C-^" 'isearch-toggle-specified-input-method)
@@ -1138,15 +1140,16 @@ Use `isearch-exit' to quit without signaling."
1138 ;; C-s in forward or C-r in reverse. 1140 ;; C-s in forward or C-r in reverse.
1139 (if (equal isearch-string "") 1141 (if (equal isearch-string "")
1140 ;; If search string is empty, use last one. 1142 ;; If search string is empty, use last one.
1141 (setq isearch-string 1143 (if (null (if isearch-regexp regexp-search-ring search-ring))
1142 (or (if isearch-regexp 1144 (setq isearch-error "No previous search string")
1143 (car regexp-search-ring) 1145 (setq isearch-string
1144 (car search-ring)) 1146 (if isearch-regexp
1145 (error "No previous search string")) 1147 (car regexp-search-ring)
1146 isearch-message 1148 (car search-ring))
1147 (mapconcat 'isearch-text-char-description 1149 isearch-message
1148 isearch-string "") 1150 (mapconcat 'isearch-text-char-description
1149 isearch-case-fold-search isearch-last-case-fold-search) 1151 isearch-string "")
1152 isearch-case-fold-search isearch-last-case-fold-search))
1150 ;; If already have what to search for, repeat it. 1153 ;; If already have what to search for, repeat it.
1151 (or isearch-success 1154 (or isearch-success
1152 (progn 1155 (progn
diff --git a/lisp/loadup.el b/lisp/loadup.el
index 370eeb8aa30..a8e23c41db7 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -134,11 +134,13 @@
134(load "frame") 134(load "frame")
135(load "term/tty-colors") 135(load "term/tty-colors")
136(load "font-core") 136(load "font-core")
137;; facemenu must be loaded before font-lock, because `facemenu-keymap'
138;; needs to be defined when font-lock is loaded.
139(load "facemenu")
137(load "emacs-lisp/syntax") 140(load "emacs-lisp/syntax")
138(load "font-lock") 141(load "font-lock")
139(load "jit-lock") 142(load "jit-lock")
140 143
141(load "facemenu")
142(if (fboundp 'track-mouse) 144(if (fboundp 'track-mouse)
143 (progn 145 (progn
144 (load "mouse") 146 (load "mouse")
diff --git a/lisp/log-edit.el b/lisp/log-edit.el
index 54249eb52e3..4c66f7f280b 100644
--- a/lisp/log-edit.el
+++ b/lisp/log-edit.el
@@ -120,8 +120,10 @@ If SETUP is 'force, this variable has no effect."
120 log-edit-insert-changelog) 120 log-edit-insert-changelog)
121 "*Hook run at the end of `log-edit'." 121 "*Hook run at the end of `log-edit'."
122 :group 'log-edit 122 :group 'log-edit
123 :type '(hook :options (log-edit-insert-cvs-template 123 :type '(hook :options (log-edit-insert-changelog
124 log-edit-insert-changelog))) 124 log-edit-insert-cvs-rcstemplate
125 log-edit-insert-cvs-template
126 log-edit-insert-filenames)))
125 127
126(defcustom log-edit-mode-hook (if (boundp 'vc-log-mode-hook) vc-log-mode-hook) 128(defcustom log-edit-mode-hook (if (boundp 'vc-log-mode-hook) vc-log-mode-hook)
127 "*Hook run when entering `log-edit-mode'." 129 "*Hook run when entering `log-edit-mode'."
@@ -281,20 +283,13 @@ automatically."
281 (insert "\n")))) 283 (insert "\n"))))
282 284
283;; Compatibility with old names. 285;; Compatibility with old names.
284(defvaralias 'vc-comment-ring 'log-edit-comment-ring) 286(define-obsolete-variable-alias 'vc-comment-ring 'log-edit-comment-ring "22.1")
285(make-obsolete-variable 'vc-comment-ring 'log-edit-comment-ring "22.1") 287(define-obsolete-variable-alias 'vc-comment-ring-index 'log-edit-comment-ring-index "22.1")
286(defvaralias 'vc-comment-ring-index 'log-edit-comment-ring-index) 288(define-obsolete-function-alias 'vc-previous-comment 'log-edit-previous-comment "22.1")
287(make-obsolete-variable 'vc-comment-ring-index 'log-edit-comment-ring-index "22.1") 289(define-obsolete-function-alias 'vc-next-comment 'log-edit-next-comment "22.1")
288(defalias 'vc-previous-comment 'log-edit-previous-comment) 290(define-obsolete-function-alias 'vc-comment-search-reverse 'log-edit-comment-search-backward "22.1")
289(make-obsolete 'vc-previous-comment 'log-edit-previous-comment "22.1") 291(define-obsolete-function-alias 'vc-comment-search-forward 'log-edit-comment-search-forward "22.1")
290(defalias 'vc-next-comment 'log-edit-next-comment) 292(define-obsolete-function-alias 'vc-comment-to-change-log 'log-edit-comment-to-change-log "22.1")
291(make-obsolete 'vc-next-comment 'log-edit-next-comment "22.1")
292(defalias 'vc-comment-search-reverse 'log-edit-comment-search-backward)
293(make-obsolete 'vc-comment-search-reverse 'log-edit-comment-search-backward "22.1")
294(defalias 'vc-comment-search-forward 'log-edit-comment-search-forward)
295(make-obsolete 'vc-comment-search-forward 'log-edit-comment-search-forward "22.1")
296(defalias 'vc-comment-to-change-log 'log-edit-comment-to-change-log)
297(make-obsolete 'vc-comment-to-change-log 'log-edit-comment-to-change-log "22.1")
298 293
299;;; 294;;;
300;;; Actual code 295;;; Actual code
@@ -396,31 +391,6 @@ If you want to abort the commit, simply delete the buffer."
396 "Return the list of files that are about to be committed." 391 "Return the list of files that are about to be committed."
397 (ignore-errors (funcall log-edit-listfun))) 392 (ignore-errors (funcall log-edit-listfun)))
398 393
399
400(defun log-edit-insert-changelog ()
401 "Insert a log message by looking at the ChangeLog.
402The idea is to write your ChangeLog entries first, and then use this
403command to commit your changes.
404
405To select default log text, we:
406- find the ChangeLog entries for the files to be checked in,
407- verify that the top entry in the ChangeLog is on the current date
408 and by the current user; if not, we don't provide any default text,
409- search the ChangeLog entry for paragraphs containing the names of
410 the files we're checking in, and finally
411- use those paragraphs as the log text."
412 (interactive)
413 (log-edit-insert-changelog-entries (log-edit-files))
414 (log-edit-set-common-indentation)
415 (goto-char (point-min))
416 (when (looking-at "\\*\\s-+")
417 (forward-line 1)
418 (when (not (re-search-forward "^\\*\\s-+" nil t))
419 (goto-char (point-min))
420 (skip-chars-forward "^():")
421 (skip-chars-forward ": ")
422 (delete-region (point-min) (point)))))
423
424(defun log-edit-mode-help () 394(defun log-edit-mode-help ()
425 "Provide help for the `log-edit-mode-map'." 395 "Provide help for the `log-edit-mode-map'."
426 (interactive) 396 (interactive)
@@ -465,11 +435,29 @@ To select default log text, we:
465 (selected-window))))) 435 (selected-window)))))
466 436
467(defun log-edit-insert-cvs-template () 437(defun log-edit-insert-cvs-template ()
468 "Insert the template specified by the CVS administrator, if any." 438 "Insert the template specified by the CVS administrator, if any.
439This simply uses the local CVS/Template file."
469 (interactive) 440 (interactive)
470 (when (file-readable-p "CVS/Template") 441 (when (or (interactive-p) (= (point-min) (point-max)))
471 (insert-file-contents "CVS/Template"))) 442 (when (file-readable-p "CVS/Template")
472 443 (insert-file-contents "CVS/Template"))))
444
445(defun log-edit-insert-cvs-rcstemplate ()
446 "Insert the rcstemplate from the CVS repository.
447This contacts the repository to get the rcstemplate file and
448can thus take some time."
449 (interactive)
450 (when (or (interactive-p) (= (point-min) (point-max)))
451 (when (file-readable-p "CVS/Root")
452 ;; Ignore the stderr stuff, even if it's an error.
453 (call-process "cvs" nil '(t nil) nil
454 "checkout" "-p" "CVSROOT/rcstemplate"))))
455
456(defun log-edit-insert-filenames ()
457 "Insert the list of files that are to be committed."
458 (interactive)
459 (insert "Affected files: \n"
460 (mapconcat 'identity (log-edit-files) " \n")))
473 461
474(defun log-edit-add-to-changelog () 462(defun log-edit-add-to-changelog ()
475 "Insert this log message into the appropriate ChangeLog file." 463 "Insert this log message into the appropriate ChangeLog file."
@@ -482,6 +470,37 @@ To select default log text, we:
482 (save-excursion 470 (save-excursion
483 (log-edit-comment-to-change-log))))) 471 (log-edit-comment-to-change-log)))))
484 472
473(defvar log-edit-changelog-use-first nil)
474(defun log-edit-insert-changelog (&optional use-first)
475 "Insert a log message by looking at the ChangeLog.
476The idea is to write your ChangeLog entries first, and then use this
477command to commit your changes.
478
479To select default log text, we:
480- find the ChangeLog entries for the files to be checked in,
481- verify that the top entry in the ChangeLog is on the current date
482 and by the current user; if not, we don't provide any default text,
483- search the ChangeLog entry for paragraphs containing the names of
484 the files we're checking in, and finally
485- use those paragraphs as the log text.
486
487If the optional prefix arg USE-FIRST is given (via \\[universal-argument]),
488or if the command is repeated a second time in a row, use the first log entry
489regardless of user name or time."
490 (interactive "P")
491 (let ((log-edit-changelog-use-first
492 (or use-first (eq last-command 'log-edit-insert-changelog))))
493 (log-edit-insert-changelog-entries (log-edit-files)))
494 (log-edit-set-common-indentation)
495 (goto-char (point-min))
496 (when (looking-at "\\*\\s-+")
497 (forward-line 1)
498 (when (not (re-search-forward "^\\*\\s-+" nil t))
499 (goto-char (point-min))
500 (skip-chars-forward "^():")
501 (skip-chars-forward ": ")
502 (delete-region (point-min) (point)))))
503
485;;;; 504;;;;
486;;;; functions for getting commit message from ChangeLog a file... 505;;;; functions for getting commit message from ChangeLog a file...
487;;;; Courtesy Jim Blandy 506;;;; Courtesy Jim Blandy
@@ -561,7 +580,9 @@ Return non-nil iff it is."
561 (functionp add-log-time-format) 580 (functionp add-log-time-format)
562 (funcall add-log-time-format)) 581 (funcall add-log-time-format))
563 (format-time-string "%Y-%m-%d")))) 582 (format-time-string "%Y-%m-%d"))))
564 (looking-at (regexp-quote (format "%s %s <%s>" time name mail))))) 583 (looking-at (if log-edit-changelog-use-first
584 "[^ \t]"
585 (regexp-quote (format "%s %s <%s>" time name mail))))))
565 586
566(defun log-edit-changelog-entries (file) 587(defun log-edit-changelog-entries (file)
567 "Return the ChangeLog entries for FILE, and the ChangeLog they came from. 588 "Return the ChangeLog entries for FILE, and the ChangeLog they came from.
diff --git a/lisp/longlines.el b/lisp/longlines.el
index 93f3daa4ee8..a3912a26ca7 100644
--- a/lisp/longlines.el
+++ b/lisp/longlines.el
@@ -136,6 +136,7 @@ are indicated with a symbol."
136 136
137 ;; Hacks to make longlines play nice with various modes. 137 ;; Hacks to make longlines play nice with various modes.
138 (cond ((eq major-mode 'mail-mode) 138 (cond ((eq major-mode 'mail-mode)
139 (add-hook 'mail-setup-hook 'longlines-decode-buffer nil t)
139 (or mail-citation-hook 140 (or mail-citation-hook
140 (add-hook 'mail-citation-hook 'mail-indent-citation nil t)) 141 (add-hook 'mail-citation-hook 'mail-indent-citation nil t))
141 (add-hook 'mail-citation-hook 'longlines-decode-region nil t)) 142 (add-hook 'mail-citation-hook 'longlines-decode-region nil t))
@@ -246,17 +247,21 @@ not need to be wrapped, move point to the next line and return t."
246 nil) 247 nil)
247 (if (longlines-merge-lines-p) 248 (if (longlines-merge-lines-p)
248 (progn (end-of-line) 249 (progn (end-of-line)
249 (delete-char 1)
250 ;; After certain commands (e.g. kill-line), there may be two 250 ;; After certain commands (e.g. kill-line), there may be two
251 ;; successive soft newlines in the buffer. In this case, we 251 ;; successive soft newlines in the buffer. In this case, we
252 ;; replace these two newlines by a single space. Unfortunately, 252 ;; replace these two newlines by a single space. Unfortunately,
253 ;; this breaks the conservation of (spaces + newlines), so we 253 ;; this breaks the conservation of (spaces + newlines), so we
254 ;; have to fiddle with longlines-wrap-point. 254 ;; have to fiddle with longlines-wrap-point.
255 (if (or (bolp) (eolp)) 255 (if (or (prog1 (bolp) (forward-char 1)) (eolp))
256 (if (> longlines-wrap-point (point)) 256 (progn
257 (setq longlines-wrap-point 257 (delete-char -1)
258 (1- longlines-wrap-point))) 258 (if (> longlines-wrap-point (point))
259 (insert-char ? 1)) 259 (setq longlines-wrap-point
260 (1- longlines-wrap-point))))
261 (insert-before-markers-and-inherit ?\ )
262 (backward-char 1)
263 (delete-char -1)
264 (forward-char 1))
260 nil) 265 nil)
261 (forward-line 1) 266 (forward-line 1)
262 t))) 267 t)))
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
index 5f5a53b0df0..0da64128118 100644
--- a/lisp/ls-lisp.el
+++ b/lisp/ls-lisp.el
@@ -45,8 +45,6 @@
45;; * A few obscure ls switches are still ignored: see the docstring of 45;; * A few obscure ls switches are still ignored: see the docstring of
46;; `insert-directory'. 46;; `insert-directory'.
47 47
48;; * Generally only numeric uid/gid.
49
50;; TO DO ============================================================= 48;; TO DO =============================================================
51 49
52;; Complete handling of F switch (if/when possible). 50;; Complete handling of F switch (if/when possible).
@@ -61,8 +59,8 @@
61;; Revised by Andrew Innes and Geoff Volker (and maybe others). 59;; Revised by Andrew Innes and Geoff Volker (and maybe others).
62 60
63;; Modified by Francis J. Wright <F.J.Wright@maths.qmw.ac.uk>, mainly 61;; Modified by Francis J. Wright <F.J.Wright@maths.qmw.ac.uk>, mainly
64;; to support many more ls options, "platform emulation", hooks for 62;; to support many more ls options, "platform emulation" and more
65;; external symbolic link support and more robust sorting. 63;; robust sorting.
66 64
67;;; Code: 65;;; Code:
68 66
@@ -175,14 +173,6 @@ current year. The OLD-TIME-FORMAT is used for older files. To use ISO
175(or (featurep 'ls-lisp) ; FJW: unless this file is being reloaded! 173(or (featurep 'ls-lisp) ; FJW: unless this file is being reloaded!
176 (setq original-insert-directory (symbol-function 'insert-directory))) 174 (setq original-insert-directory (symbol-function 'insert-directory)))
177 175
178;; This stub is to allow ls-lisp to parse symbolic links via another
179;; library such as w32-symlinks.el from
180;; http://centaur.maths.qmw.ac.uk/Emacs/:
181(defun ls-lisp-parse-symlink (file-name)
182 "This stub may be redefined to parse FILE-NAME as a symlink.
183It should return nil or the link target as a string."
184 nil)
185
186 176
187;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 177;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
188 178
@@ -429,7 +419,9 @@ SWITCHES is a list of characters. Default sorting is alphabetic."
429 ;; symbolic link, or nil. 419 ;; symbolic link, or nil.
430 (let (el dirs files) 420 (let (el dirs files)
431 (while file-alist 421 (while file-alist
432 (if (eq (cadr (setq el (car file-alist))) t) ; directory 422 (if (or (eq (cadr (setq el (car file-alist))) t) ; directory
423 (and (stringp (cadr el))
424 (file-directory-p (cadr el)))) ; symlink to a directory
433 (setq dirs (cons el dirs)) 425 (setq dirs (cons el dirs))
434 (setq files (cons el files))) 426 (setq files (cons el files)))
435 (setq file-alist (cdr file-alist))) 427 (setq file-alist (cdr file-alist)))
@@ -455,12 +447,11 @@ links, `|' for FIFOs, `=' for sockets, and nothing for regular files.
455\[But FIFOs and sockets are not recognized.] 447\[But FIFOs and sockets are not recognized.]
456FILEDATA has the form (filename . `file-attributes'). Its `cadr' is t 448FILEDATA has the form (filename . `file-attributes'). Its `cadr' is t
457for directory, string (name linked to) for symbolic link, or nil." 449for directory, string (name linked to) for symbolic link, or nil."
458 (let ((dir (cadr filedata)) (file-name (car filedata))) 450 (let ((file-name (car filedata))
459 (cond ((or dir 451 (type (cadr filedata)))
460 ;; Parsing .lnk files here is perhaps overkill! 452 (cond (type
461 (setq dir (ls-lisp-parse-symlink file-name)))
462 (cons 453 (cons
463 (concat file-name (if (eq dir t) "/" "@")) 454 (concat file-name (if (eq type t) "/" "@"))
464 (cdr filedata))) 455 (cdr filedata)))
465 ((string-match "x" (nth 9 filedata)) 456 ((string-match "x" (nth 9 filedata))
466 (cons 457 (cons
@@ -506,10 +497,6 @@ SWITCHES, TIME-INDEX and NOW give the full switch list and time data."
506 ;; t for directory, string (name linked to) 497 ;; t for directory, string (name linked to)
507 ;; for symbolic link, or nil. 498 ;; for symbolic link, or nil.
508 (drwxrwxrwx (nth 8 file-attr))) ; attribute string ("drwxrwxrwx") 499 (drwxrwxrwx (nth 8 file-attr))) ; attribute string ("drwxrwxrwx")
509 (and (null file-type)
510 ;; Maybe no kernel support for symlinks, so...
511 (setq file-type (ls-lisp-parse-symlink file-name))
512 (aset drwxrwxrwx 0 ?l)) ; symbolic link - update attribute string
513 (concat (if (memq ?i switches) ; inode number 500 (concat (if (memq ?i switches) ; inode number
514 (format " %6d" (nth 10 file-attr))) 501 (format " %6d" (nth 10 file-attr)))
515 ;; nil is treated like "" in concat 502 ;; nil is treated like "" in concat
diff --git a/lisp/mail/mailheader.el b/lisp/mail/mailheader.el
index aeed54a5ace..1e9a24da341 100644
--- a/lisp/mail/mailheader.el
+++ b/lisp/mail/mailheader.el
@@ -146,7 +146,7 @@ skip the header altogether if there are no other elements.
146 (insert (capitalize (symbol-name header)) 146 (insert (capitalize (symbol-name header))
147 ": " 147 ": "
148 (if (consp value) (car value) value) 148 (if (consp value) (car value) value)
149 hard-newline))) 149 "\n")))
150 150
151(defun mail-header-format (format-rules headers) 151(defun mail-header-format (format-rules headers)
152 "Use FORMAT-RULES to format HEADERS and insert into current buffer. 152 "Use FORMAT-RULES to format HEADERS and insert into current buffer.
@@ -187,7 +187,7 @@ A key of nil has as its value a list of defaulted headers to ignore."
187 (if (cdr rule) 187 (if (cdr rule)
188 (funcall (cdr rule) header value) 188 (funcall (cdr rule) header value)
189 (funcall mail-header-format-function header value)))))) 189 (funcall mail-header-format-function header value))))))
190 (insert hard-newline))) 190 (insert "\n")))
191 191
192(provide 'mailheader) 192(provide 'mailheader)
193 193
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index e87aebe7cc2..242fe788052 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -446,7 +446,7 @@ actually occur.")
446 ;; has been called and has done so. 446 ;; has been called and has done so.
447 (let ((fill-prefix "\t") 447 (let ((fill-prefix "\t")
448 (address-start (point))) 448 (address-start (point)))
449 (insert to hard-newline) 449 (insert to "\n")
450 (fill-region-as-paragraph address-start (point-max)) 450 (fill-region-as-paragraph address-start (point-max))
451 (goto-char (point-max)) 451 (goto-char (point-max))
452 (unless (bolp) 452 (unless (bolp)
@@ -455,7 +455,7 @@ actually occur.")
455 (if cc 455 (if cc
456 (let ((fill-prefix "\t") 456 (let ((fill-prefix "\t")
457 (address-start (progn (insert "CC: ") (point)))) 457 (address-start (progn (insert "CC: ") (point))))
458 (insert cc hard-newline) 458 (insert cc "\n")
459 (fill-region-as-paragraph address-start (point-max)) 459 (fill-region-as-paragraph address-start (point-max))
460 (goto-char (point-max)) 460 (goto-char (point-max))
461 (unless (bolp) 461 (unless (bolp)
@@ -464,23 +464,23 @@ actually occur.")
464 (let ((fill-prefix "\t") 464 (let ((fill-prefix "\t")
465 (fill-column 78) 465 (fill-column 78)
466 (address-start (point))) 466 (address-start (point)))
467 (insert "In-reply-to: " in-reply-to hard-newline) 467 (insert "In-reply-to: " in-reply-to "\n")
468 (fill-region-as-paragraph address-start (point-max)) 468 (fill-region-as-paragraph address-start (point-max))
469 (goto-char (point-max)) 469 (goto-char (point-max))
470 (unless (bolp) 470 (unless (bolp)
471 (newline)))) 471 (newline))))
472 (insert "Subject: " (or subject "") hard-newline) 472 (insert "Subject: " (or subject "") "\n")
473 (if mail-default-headers 473 (if mail-default-headers
474 (insert mail-default-headers)) 474 (insert mail-default-headers))
475 (if mail-default-reply-to 475 (if mail-default-reply-to
476 (insert "Reply-to: " mail-default-reply-to hard-newline)) 476 (insert "Reply-to: " mail-default-reply-to "\n"))
477 (if mail-self-blind 477 (if mail-self-blind
478 (insert "BCC: " user-mail-address hard-newline)) 478 (insert "BCC: " user-mail-address "\n"))
479 (if mail-archive-file-name 479 (if mail-archive-file-name
480 (insert "FCC: " mail-archive-file-name hard-newline)) 480 (insert "FCC: " mail-archive-file-name "\n"))
481 (put-text-property (point) 481 (put-text-property (point)
482 (progn 482 (progn
483 (insert mail-header-separator hard-newline) 483 (insert mail-header-separator "\n")
484 (1- (point))) 484 (1- (point)))
485 'category 'mail-header-separator) 485 'category 'mail-header-separator)
486 ;; Insert the signature. But remember the beginning of the message. 486 ;; Insert the signature. But remember the beginning of the message.
@@ -488,7 +488,7 @@ actually occur.")
488 (cond ((eq mail-signature t) 488 (cond ((eq mail-signature t)
489 (if (file-exists-p mail-signature-file) 489 (if (file-exists-p mail-signature-file)
490 (progn 490 (progn
491 (insert hard-newline hard-newline "-- " hard-newline) 491 (insert "\n\n-- \n")
492 (insert-file-contents mail-signature-file)))) 492 (insert-file-contents mail-signature-file))))
493 ((stringp mail-signature) 493 ((stringp mail-signature)
494 (insert mail-signature)) 494 (insert mail-signature))
@@ -835,14 +835,14 @@ the user from the mailer."
835 (split-string new-header-values 835 (split-string new-header-values
836 ",[[:space:]]+" t)) 836 ",[[:space:]]+" t))
837 (mapconcat 'identity l ", ")) 837 (mapconcat 'identity l ", "))
838 hard-newline)) 838 "\n"))
839 ;; Add Mail-Reply-To if none yet 839 ;; Add Mail-Reply-To if none yet
840 (unless (mail-fetch-field "mail-reply-to") 840 (unless (mail-fetch-field "mail-reply-to")
841 (goto-char (mail-header-end)) 841 (goto-char (mail-header-end))
842 (insert "Mail-Reply-To: " 842 (insert "Mail-Reply-To: "
843 (or (mail-fetch-field "reply-to") 843 (or (mail-fetch-field "reply-to")
844 user-mail-address) 844 user-mail-address)
845 hard-newline)))))) 845 "\n"))))))
846 (unless (memq mail-send-nonascii '(t mime)) 846 (unless (memq mail-send-nonascii '(t mime))
847 (goto-char (point-min)) 847 (goto-char (point-min))
848 (skip-chars-forward "\0-\177") 848 (skip-chars-forward "\0-\177")
@@ -931,7 +931,7 @@ See also the function `select-message-coding-system'.")
931 fullname-end 1) 931 fullname-end 1)
932 (replace-match "\\\\\\&" t)) 932 (replace-match "\\\\\\&" t))
933 (insert "\"")))) 933 (insert "\""))))
934 (insert " <" login ">" hard-newline)) 934 (insert " <" login ">\n"))
935 ((eq mail-from-style 'parens) 935 ((eq mail-from-style 'parens)
936 (insert "From: " login " (") 936 (insert "From: " login " (")
937 (let ((fullname-start (point))) 937 (let ((fullname-start (point)))
@@ -955,9 +955,9 @@ See also the function `select-message-coding-system'.")
955 fullname-end 1) 955 fullname-end 1)
956 (replace-match "\\1(\\3)" t) 956 (replace-match "\\1(\\3)" t)
957 (goto-char fullname-start)))) 957 (goto-char fullname-start))))
958 (insert ")" hard-newline)) 958 (insert ")\n"))
959 ((null mail-from-style) 959 ((null mail-from-style)
960 (insert "From: " login hard-newline)) 960 (insert "From: " login "\n"))
961 ((eq mail-from-style 'system-default) 961 ((eq mail-from-style 'system-default)
962 nil) 962 nil)
963 (t (error "Invalid value for `mail-from-style'"))))) 963 (t (error "Invalid value for `mail-from-style'")))))
@@ -996,7 +996,7 @@ external program defined by `sendmail-program'."
996 (goto-char (point-max)) 996 (goto-char (point-max))
997 ;; require one newline at the end. 997 ;; require one newline at the end.
998 (or (= (preceding-char) ?\n) 998 (or (= (preceding-char) ?\n)
999 (insert hard-newline)) 999 (insert ?\n))
1000 ;; Change header-delimiter to be what sendmail expects. 1000 ;; Change header-delimiter to be what sendmail expects.
1001 (goto-char (mail-header-end)) 1001 (goto-char (mail-header-end))
1002 (delete-region (point) (progn (end-of-line) (point))) 1002 (delete-region (point) (progn (end-of-line) (point)))
@@ -1008,7 +1008,7 @@ external program defined by `sendmail-program'."
1008 ;; Ignore any blank lines in the header 1008 ;; Ignore any blank lines in the header
1009 (while (and (re-search-forward "\n\n\n*" delimline t) 1009 (while (and (re-search-forward "\n\n\n*" delimline t)
1010 (< (point) delimline)) 1010 (< (point) delimline))
1011 (replace-match hard-newline)) 1011 (replace-match "\n"))
1012 (goto-char (point-min)) 1012 (goto-char (point-min))
1013 ;; Look for Resent- headers. They require sending 1013 ;; Look for Resent- headers. They require sending
1014 ;; the message specially. 1014 ;; the message specially.
@@ -1070,10 +1070,10 @@ external program defined by `sendmail-program'."
1070 (setq charset 1070 (setq charset
1071 (coding-system-get selected-coding 'mime-charset)) 1071 (coding-system-get selected-coding 'mime-charset))
1072 (goto-char delimline) 1072 (goto-char delimline)
1073 (insert "MIME-version: 1.0" hard-newline 1073 (insert "MIME-version: 1.0\n"
1074 "Content-type: text/plain; charset=" 1074 "Content-type: text/plain; charset="
1075 (symbol-name charset) hard-newline 1075 (symbol-name charset)
1076 "Content-Transfer-Encoding: 8bit" hard-newline))) 1076 "\nContent-Transfer-Encoding: 8bit\n")))
1077 ;; Insert an extra newline if we need it to work around 1077 ;; Insert an extra newline if we need it to work around
1078 ;; Sun's bug that swallows newlines. 1078 ;; Sun's bug that swallows newlines.
1079 (goto-char (1+ delimline)) 1079 (goto-char (1+ delimline))
@@ -1167,8 +1167,8 @@ external program defined by `sendmail-program'."
1167 (set-buffer tembuf) 1167 (set-buffer tembuf)
1168 (erase-buffer) 1168 (erase-buffer)
1169 ;; This initial newline is written out if the fcc file already exists. 1169 ;; This initial newline is written out if the fcc file already exists.
1170 (insert hard-newline "From " (user-login-name) " " 1170 (insert "\nFrom " (user-login-name) " "
1171 (current-time-string time) hard-newline) 1171 (current-time-string time) "\n")
1172 ;; Insert the time zone before the year. 1172 ;; Insert the time zone before the year.
1173 (forward-char -1) 1173 (forward-char -1)
1174 (forward-word -1) 1174 (forward-word -1)
@@ -1178,7 +1178,7 @@ external program defined by `sendmail-program'."
1178 (insert-buffer-substring rmailbuf) 1178 (insert-buffer-substring rmailbuf)
1179 ;; Make sure messages are separated. 1179 ;; Make sure messages are separated.
1180 (goto-char (point-max)) 1180 (goto-char (point-max))
1181 (insert hard-newline) 1181 (insert ?\n)
1182 (goto-char 2) 1182 (goto-char 2)
1183 ;; ``Quote'' "^From " as ">From " 1183 ;; ``Quote'' "^From " as ">From "
1184 ;; (note that this isn't really quoting, as there is no requirement 1184 ;; (note that this isn't really quoting, as there is no requirement
@@ -1220,11 +1220,10 @@ external program defined by `sendmail-program'."
1220 (rmail-maybe-set-message-counters) 1220 (rmail-maybe-set-message-counters)
1221 (widen) 1221 (widen)
1222 (narrow-to-region (point-max) (point-max)) 1222 (narrow-to-region (point-max) (point-max))
1223 (insert "\C-l" hard-newline "0, unseen,," 1223 (insert "\C-l\n0, unseen,,\n*** EOOH ***\n"
1224 hard-newline "*** EOOH ***" hard-newline 1224 "Date: " (mail-rfc822-date) "\n")
1225 "Date: " (mail-rfc822-date) hard-newline)
1226 (insert-buffer-substring curbuf beg2 end) 1225 (insert-buffer-substring curbuf beg2 end)
1227 (insert hard-newline "\C-_") 1226 (insert "\n\C-_")
1228 (goto-char (point-min)) 1227 (goto-char (point-min))
1229 (widen) 1228 (widen)
1230 (search-backward "\n\^_") 1229 (search-backward "\n\^_")
@@ -1262,11 +1261,10 @@ external program defined by `sendmail-program'."
1262 (set-buffer (get-buffer-create " mail-temp")) 1261 (set-buffer (get-buffer-create " mail-temp"))
1263 (setq buffer-read-only nil) 1262 (setq buffer-read-only nil)
1264 (erase-buffer) 1263 (erase-buffer)
1265 (insert "\C-l" hard-newline "0, unseen,," hard-newline 1264 (insert "\C-l\n0, unseen,,\n*** EOOH ***\nDate: "
1266 "*** EOOH ***" hard-newline "Date: " 1265 (mail-rfc822-date) "\n")
1267 (mail-rfc822-date) hard-newline)
1268 (insert-buffer-substring curbuf beg2 end) 1266 (insert-buffer-substring curbuf beg2 end)
1269 (insert hard-newline "\C-_") 1267 (insert "\n\C-_")
1270 (write-region (point-min) (point-max) (car fcc-list) t) 1268 (write-region (point-min) (point-max) (car fcc-list) t)
1271 (erase-buffer))) 1269 (erase-buffer)))
1272 (write-region 1270 (write-region
@@ -1318,7 +1316,7 @@ external program defined by `sendmail-program'."
1318 (expand-abbrev) 1316 (expand-abbrev)
1319 (or (mail-position-on-field "cc" t) 1317 (or (mail-position-on-field "cc" t)
1320 (progn (mail-position-on-field "to") 1318 (progn (mail-position-on-field "to")
1321 (insert hard-newline "CC: ")))) 1319 (insert "\nCC: "))))
1322 1320
1323(defun mail-bcc () 1321(defun mail-bcc ()
1324 "Move point to end of BCC-field. Create a BCC field if none." 1322 "Move point to end of BCC-field. Create a BCC field if none."
@@ -1326,7 +1324,7 @@ external program defined by `sendmail-program'."
1326 (expand-abbrev) 1324 (expand-abbrev)
1327 (or (mail-position-on-field "bcc" t) 1325 (or (mail-position-on-field "bcc" t)
1328 (progn (mail-position-on-field "to") 1326 (progn (mail-position-on-field "to")
1329 (insert hard-newline "BCC: ")))) 1327 (insert "\nBCC: "))))
1330 1328
1331(defun mail-fcc (folder) 1329(defun mail-fcc (folder)
1332 "Add a new FCC field, with file name completion." 1330 "Add a new FCC field, with file name completion."
@@ -1334,7 +1332,7 @@ external program defined by `sendmail-program'."
1334 (expand-abbrev) 1332 (expand-abbrev)
1335 (or (mail-position-on-field "fcc" t) ;Put new field after exiting FCC. 1333 (or (mail-position-on-field "fcc" t) ;Put new field after exiting FCC.
1336 (mail-position-on-field "to")) 1334 (mail-position-on-field "to"))
1337 (insert hard-newline "FCC: " folder)) 1335 (insert "\nFCC: " folder))
1338 1336
1339(defun mail-reply-to () 1337(defun mail-reply-to ()
1340 "Move point to end of Reply-To-field. Create a Reply-To field if none." 1338 "Move point to end of Reply-To-field. Create a Reply-To field if none."
@@ -1349,7 +1347,7 @@ Create a Mail-Reply-To field if none."
1349 (expand-abbrev) 1347 (expand-abbrev)
1350 (or (mail-position-on-field "mail-reply-to" t) 1348 (or (mail-position-on-field "mail-reply-to" t)
1351 (progn (mail-position-on-field "to") 1349 (progn (mail-position-on-field "to")
1352 (insert hard-newline "Mail-Reply-To: ")))) 1350 (insert "\nMail-Reply-To: "))))
1353 1351
1354(defun mail-mail-followup-to () 1352(defun mail-mail-followup-to ()
1355 "Move point to end of Mail-Followup-To field. 1353 "Move point to end of Mail-Followup-To field.
@@ -1358,7 +1356,7 @@ Create a Mail-Followup-To field if none."
1358 (expand-abbrev) 1356 (expand-abbrev)
1359 (or (mail-position-on-field "mail-followup-to" t) 1357 (or (mail-position-on-field "mail-followup-to" t)
1360 (progn (mail-position-on-field "to") 1358 (progn (mail-position-on-field "to")
1361 (insert hard-newline "Mail-Followup-To: ")))) 1359 (insert "\nMail-Followup-To: "))))
1362 1360
1363(defun mail-position-on-field (field &optional soft) 1361(defun mail-position-on-field (field &optional soft)
1364 (let (end 1362 (let (end
@@ -1373,7 +1371,7 @@ Create a Mail-Followup-To field if none."
1373 t) 1371 t)
1374 (or soft 1372 (or soft
1375 (progn (goto-char end) 1373 (progn (goto-char end)
1376 (insert field ": " hard-newline) 1374 (insert field ": \n")
1377 (skip-chars-backward "\n"))) 1375 (skip-chars-backward "\n")))
1378 nil))) 1376 nil)))
1379 1377
@@ -1396,7 +1394,7 @@ Prefix arg means put contents at point."
1396 (delete-region (point) (point-max))) 1394 (delete-region (point) (point-max)))
1397 (if (stringp mail-signature) 1395 (if (stringp mail-signature)
1398 (insert mail-signature) 1396 (insert mail-signature)
1399 (insert hard-newline hard-newline "-- " hard-newline) 1397 (insert "\n\n-- \n")
1400 (insert-file-contents (expand-file-name mail-signature-file))))) 1398 (insert-file-contents (expand-file-name mail-signature-file)))))
1401 1399
1402(defun mail-fill-yanked-message (&optional justifyp) 1400(defun mail-fill-yanked-message (&optional justifyp)
@@ -1482,7 +1480,7 @@ and don't delete any header fields."
1482 ;; loop would deactivate the mark because we inserted text. 1480 ;; loop would deactivate the mark because we inserted text.
1483 (goto-char (prog1 (mark t) 1481 (goto-char (prog1 (mark t)
1484 (set-marker (mark-marker) (point) (current-buffer)))) 1482 (set-marker (mark-marker) (point) (current-buffer))))
1485 (if (not (eolp)) (insert hard-newline))))) 1483 (if (not (eolp)) (insert ?\n)))))
1486 1484
1487(defun mail-yank-clear-headers (start end) 1485(defun mail-yank-clear-headers (start end)
1488 (if (< end start) 1486 (if (< end start)
@@ -1566,8 +1564,7 @@ If the current line has `mail-yank-prefix', insert it on the new line."
1566 (insert-char ?= (max 0 (- 60 (current-column)))) 1564 (insert-char ?= (max 0 (- 60 (current-column))))
1567 (newline) 1565 (newline)
1568 (setq middle (point)) 1566 (setq middle (point))
1569 (insert "============================================================" 1567 (insert "============================================================\n")
1570 hard-newline)
1571 (push-mark) 1568 (push-mark)
1572 (goto-char middle) 1569 (goto-char middle)
1573 (insert-file-contents file) 1570 (insert-file-contents file)
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 0aab1a99bb6..2c5d9cbddd6 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -371,16 +371,9 @@ That means one whose bottom edge is at the same height as WINDOW's top edge."
371Move it down if GROWTH is positive, or up if GROWTH is negative. 371Move it down if GROWTH is positive, or up if GROWTH is negative.
372If this would make WINDOW too short, 372If this would make WINDOW too short,
373shrink the window or windows above it to make room." 373shrink the window or windows above it to make room."
374 (let ((excess (- window-min-height (+ (window-height window) growth)))) 374 (condition-case nil
375 ;; EXCESS is the number of lines we need to take from windows above. 375 (adjust-window-trailing-edge window growth nil)
376 (if (> excess 0) 376 (error nil)))
377 ;; This can recursively shrink windows all the way up.
378 (let ((window-above (mouse-drag-window-above window)))
379 (if window-above
380 (mouse-drag-move-window-bottom window-above (- excess))))))
381 (save-selected-window
382 (select-window window)
383 (enlarge-window growth nil (> growth 0))))
384 377
385(defsubst mouse-drag-move-window-top (window growth) 378(defsubst mouse-drag-move-window-top (window growth)
386 "Move the top of WINDOW up or down by GROWTH lines. 379 "Move the top of WINDOW up or down by GROWTH lines.
diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el
index d86a8ecdf2d..9925227619f 100644
--- a/lisp/net/goto-addr.el
+++ b/lisp/net/goto-addr.el
@@ -174,6 +174,7 @@ and `goto-address-fontify-p'."
174 (overlay-put this-overlay 'evaporate t) 174 (overlay-put this-overlay 'evaporate t)
175 (overlay-put this-overlay 175 (overlay-put this-overlay
176 'mouse-face goto-address-url-mouse-face) 176 'mouse-face goto-address-url-mouse-face)
177 (overlay-put this-overlay 'follow-link t)
177 (overlay-put this-overlay 178 (overlay-put this-overlay
178 'help-echo "mouse-2, C-c RET: follow URL") 179 'help-echo "mouse-2, C-c RET: follow URL")
179 (overlay-put this-overlay 180 (overlay-put this-overlay
@@ -189,6 +190,7 @@ and `goto-address-fontify-p'."
189 (overlay-put this-overlay 'evaporate t) 190 (overlay-put this-overlay 'evaporate t)
190 (overlay-put this-overlay 'mouse-face 191 (overlay-put this-overlay 'mouse-face
191 goto-address-mail-mouse-face) 192 goto-address-mail-mouse-face)
193 (overlay-put this-overlay 'follow-link t)
192 (overlay-put this-overlay 194 (overlay-put this-overlay
193 'help-echo "mouse-2, C-c RET: mail this address") 195 'help-echo "mouse-2, C-c RET: mail this address")
194 (overlay-put this-overlay 196 (overlay-put this-overlay
@@ -210,7 +212,7 @@ Send mail to address at point. See documentation for
210there, then load the URL at or before point." 212there, then load the URL at or before point."
211 (interactive (list last-input-event)) 213 (interactive (list last-input-event))
212 (save-excursion 214 (save-excursion
213 (if event (mouse-set-point event)) 215 (if event (posn-set-point (event-end event)))
214 (let ((address (save-excursion (goto-address-find-address-at-point)))) 216 (let ((address (save-excursion (goto-address-find-address-at-point))))
215 (if (and address 217 (if (and address
216 (save-excursion 218 (save-excursion
diff --git a/lisp/paren.el b/lisp/paren.el
index ece3ed3c606..2164ac72d39 100644
--- a/lisp/paren.el
+++ b/lisp/paren.el
@@ -110,14 +110,7 @@ Returns the new status of Show Paren mode (non-nil means on).
110When Show Paren mode is enabled, any matching parenthesis is highlighted 110When Show Paren mode is enabled, any matching parenthesis is highlighted
111in `show-paren-style' after `show-paren-delay' seconds of Emacs idle time." 111in `show-paren-style' after `show-paren-delay' seconds of Emacs idle time."
112 :global t :group 'paren-showing 112 :global t :group 'paren-showing
113 ;; Turn off the usual paren-matching method 113 ;; Enable or disable the mechanism.
114 ;; when this one is turned on.
115 (if (local-variable-p 'show-paren-mode)
116 (make-local-variable 'blink-matching-paren-on-screen)
117 (kill-local-variable 'blink-matching-paren-on-screen))
118 (setq blink-matching-paren-on-screen (not show-paren-mode))
119
120 ;; Now enable or disable the mechanism.
121 ;; First get rid of the old idle timer. 114 ;; First get rid of the old idle timer.
122 (if show-paren-idle-timer 115 (if show-paren-idle-timer
123 (cancel-timer show-paren-idle-timer)) 116 (cancel-timer show-paren-idle-timer))
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index a158ad3f4e0..5faa21d75a2 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -1335,19 +1335,18 @@ Optional argument MINOR indicates this is called from
1335 ;; jit-lock might fontify some things too late. 1335 ;; jit-lock might fontify some things too late.
1336 (set (make-local-variable 'font-lock-support-mode) nil) 1336 (set (make-local-variable 'font-lock-support-mode) nil)
1337 (set (make-local-variable 'font-lock-maximum-size) nil) 1337 (set (make-local-variable 'font-lock-maximum-size) nil)
1338 (let ((fld font-lock-defaults)) 1338 (if minor
1339 (if (and minor fld) 1339 (let ((fld font-lock-defaults))
1340 (font-lock-add-keywords nil (compilation-mode-font-lock-keywords)) 1340 (font-lock-add-keywords nil (compilation-mode-font-lock-keywords))
1341 (setq font-lock-defaults '(compilation-mode-font-lock-keywords t)))
1342 (if minor
1343 (if font-lock-mode 1341 (if font-lock-mode
1344 (if fld 1342 (if fld
1345 (font-lock-fontify-buffer) 1343 (font-lock-fontify-buffer)
1346 (font-lock-change-mode) 1344 (font-lock-change-mode)
1347 (turn-on-font-lock)) 1345 (turn-on-font-lock))
1348 (turn-on-font-lock)) 1346 (turn-on-font-lock)))
1349 ;; maybe defer font-lock till after derived mode is set up 1347 (setq font-lock-defaults '(compilation-mode-font-lock-keywords t))
1350 (run-mode-hooks 'compilation-turn-on-font-lock)))) 1348 ;; maybe defer font-lock till after derived mode is set up
1349 (run-mode-hooks 'compilation-turn-on-font-lock)))
1351 1350
1352;;;###autoload 1351;;;###autoload
1353(define-minor-mode compilation-shell-minor-mode 1352(define-minor-mode compilation-shell-minor-mode
diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el
index 961ee0747ff..e714fa3d7fb 100644
--- a/lisp/progmodes/gdb-ui.el
+++ b/lisp/progmodes/gdb-ui.el
@@ -41,7 +41,7 @@
41;; You don't need to know about annotations to use this mode as a debugger, 41;; You don't need to know about annotations to use this mode as a debugger,
42;; but if you are interested developing the mode itself, then see the 42;; but if you are interested developing the mode itself, then see the
43;; Annotations section in the GDB info manual. 43;; Annotations section in the GDB info manual.
44;; 44
45;; GDB developers plan to make the annotation interface obsolete. A new 45;; GDB developers plan to make the annotation interface obsolete. A new
46;; interface called GDB/MI (machine interface) has been designed to replace 46;; interface called GDB/MI (machine interface) has been designed to replace
47;; it. Some GDB/MI commands are used in this file through the CLI command 47;; it. Some GDB/MI commands are used in this file through the CLI command
@@ -49,26 +49,32 @@
49;; GDB (6.2 onwards) that uses GDB/MI as the primary interface to GDB. It is 49;; GDB (6.2 onwards) that uses GDB/MI as the primary interface to GDB. It is
50;; still under development and is part of a process to migrate Emacs from 50;; still under development and is part of a process to migrate Emacs from
51;; annotations to GDB/MI. 51;; annotations to GDB/MI.
52;; 52
53;; This mode SHOULD WORK WITH GDB 5.0 ONWARDS but you will NEED GDB 6.0 53;; This mode SHOULD WORK WITH GDB 5.0 onwards but you will NEED GDB 6.0
54;; ONWARDS TO USE WATCH EXPRESSIONS. 54;; onwards to use watch expressions.
55;; 55
56;; Windows Platforms: 56;;; Windows Platforms:
57;; 57
58;; If you are using Emacs and GDB on Windows you will need to flush the buffer 58;; If you are using Emacs and GDB on Windows you will need to flush the buffer
59;; explicitly in your program if you want timely display of I/O in Emacs. 59;; explicitly in your program if you want timely display of I/O in Emacs.
60;; Alternatively you can make the output stream unbuffered, for example, by 60;; Alternatively you can make the output stream unbuffered, for example, by
61;; using a macro: 61;; using a macro:
62;; 62
63;; #ifdef UNBUFFERED 63;; #ifdef UNBUFFERED
64;; setvbuf (stdout, (char *) NULL, _IONBF, 0); 64;; setvbuf (stdout, (char *) NULL, _IONBF, 0);
65;; #endif 65;; #endif
66;; 66
67;; and compiling with -DUNBUFFERED while debugging. 67;; and compiling with -DUNBUFFERED while debugging.
68;; 68
69;; Known Bugs: 69;;; Known Bugs:
70;; 70
71;; TODO: 71;; 1) Strings that are watched don't update in the speedbar when their
72;; contents change.
73;; 2) Watch expressions go out of scope when the inferior is re-run.
74;; 3) Cannot handle multiple debug sessions.
75
76;;; TODO:
77
72;; 1) Use MI command -data-read-memory for memory window. 78;; 1) Use MI command -data-read-memory for memory window.
73;; 2) Highlight changed register values (use MI commands 79;; 2) Highlight changed register values (use MI commands
74;; -data-list-register-values and -data-list-changed-registers instead 80;; -data-list-register-values and -data-list-changed-registers instead
@@ -397,6 +403,8 @@ With arg, use separate IO iff arg is positive."
397 'gdb-mouse-until) 403 'gdb-mouse-until)
398 (define-key gud-minor-mode-map [left-fringe drag-mouse-1] 404 (define-key gud-minor-mode-map [left-fringe drag-mouse-1]
399 'gdb-mouse-until) 405 'gdb-mouse-until)
406 (define-key gud-minor-mode-map [left-margin mouse-2]
407 'gdb-mouse-until)
400 (define-key gud-minor-mode-map [left-margin mouse-3] 408 (define-key gud-minor-mode-map [left-margin mouse-3]
401 'gdb-mouse-toggle-breakpoint-margin) 409 'gdb-mouse-toggle-breakpoint-margin)
402 (define-key gud-minor-mode-map [left-fringe mouse-3] 410 (define-key gud-minor-mode-map [left-fringe mouse-3]
@@ -471,6 +479,21 @@ With arg, use separate IO iff arg is positive."
471 (forward-char 2) 479 (forward-char 2)
472 (gud-call (concat "until *%a"))))))))) 480 (gud-call (concat "until *%a")))))))))
473 481
482(defcustom gdb-speedbar-auto-raise t
483 "If non-nil raise speedbar every time display of watch expressions is\
484 updated."
485 :type 'boolean
486 :group 'gud
487 :version "22.1")
488
489(defun gdb-speedbar-auto-raise (arg)
490 "Toggle automatic raising of the speedbar for watch expressions."
491 (interactive "P")
492 (setq gdb-speedbar-auto-raise
493 (if (null arg)
494 (not gdb-speedbar-auto-raise)
495 (> (prefix-numeric-value arg) 0))))
496
474(defcustom gdb-use-colon-colon-notation nil 497(defcustom gdb-use-colon-colon-notation nil
475 "If non-nil use FUN::VAR format to display variables in the speedbar." 498 "If non-nil use FUN::VAR format to display variables in the speedbar."
476 :type 'boolean 499 :type 'boolean
@@ -514,19 +537,16 @@ With arg, use separate IO iff arg is positive."
514 (unless (string-equal 537 (unless (string-equal
515 speedbar-initial-expansion-list-name "GUD") 538 speedbar-initial-expansion-list-name "GUD")
516 (speedbar-change-initial-expansion-list "GUD")) 539 (speedbar-change-initial-expansion-list "GUD"))
517 (if (or (equal (nth 2 var) "0") 540 (gdb-enqueue-input
518 (and (equal (nth 2 var) "1") 541 (list
519 (string-match "char \\*" (nth 3 var)))) 542 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
520 (gdb-enqueue-input 543 'gdba)
521 (list 544 (concat "server interpreter mi \"-var-evaluate-expression "
522 (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) 545 (nth 1 var) "\"\n")
523 'gdba) 546 (concat "-var-evaluate-expression " (nth 1 var) "\n"))
524 (concat "server interpreter mi \"-var-evaluate-expression " 547 `(lambda () (gdb-var-evaluate-expression-handler
525 (nth 1 var) "\"\n") 548 ,(nth 1 var) nil))))
526 (concat "-var-evaluate-expression " (nth 1 var) "\n")) 549 (setq gdb-var-changed t))
527 `(lambda () (gdb-var-evaluate-expression-handler
528 ,(nth 1 var) nil))))
529 (setq gdb-var-changed t)))
530 (if (re-search-forward "Undefined command" nil t) 550 (if (re-search-forward "Undefined command" nil t)
531 (message-box "Watching expressions requires gdb 6.0 onwards") 551 (message-box "Watching expressions requires gdb 6.0 onwards")
532 (message "No symbol \"%s\" in current context." expr))))) 552 (message "No symbol \"%s\" in current context." expr)))))
@@ -575,16 +595,13 @@ type=\"\\(.*?\\)\"")
575 (if (string-equal (cadr var1) (cadr varchild)) 595 (if (string-equal (cadr var1) (cadr varchild))
576 (throw 'child-already-watched nil))) 596 (throw 'child-already-watched nil)))
577 (push varchild var-list) 597 (push varchild var-list)
578 (if (or (equal (nth 2 varchild) "0") 598 (gdb-enqueue-input
579 (and (equal (nth 2 varchild) "1") 599 (list
580 (string-match "char \\*" (nth 3 varchild)))) 600 (concat
581 (gdb-enqueue-input 601 "server interpreter mi \"-var-evaluate-expression "
582 (list 602 (nth 1 varchild) "\"\n")
583 (concat 603 `(lambda () (gdb-var-evaluate-expression-handler
584 "server interpreter mi \"-var-evaluate-expression " 604 ,(nth 1 varchild) nil)))))))
585 (nth 1 varchild) "\"\n")
586 `(lambda () (gdb-var-evaluate-expression-handler
587 ,(nth 1 varchild) nil))))))))
588 (push var var-list))) 605 (push var var-list)))
589 (setq gdb-var-list (nreverse var-list)))))) 606 (setq gdb-var-list (nreverse var-list))))))
590 607
@@ -604,16 +621,12 @@ type=\"\\(.*?\\)\"")
604 (catch 'var-found-1 621 (catch 'var-found-1
605 (let ((varnum (match-string 1))) 622 (let ((varnum (match-string 1)))
606 (dolist (var gdb-var-list) 623 (dolist (var gdb-var-list)
607 (when (and (string-equal varnum (cadr var)) 624 (gdb-enqueue-input
608 (or (equal (nth 2 var) "0") 625 (list
609 (and (equal (nth 2 var) "1") 626 (concat "server interpreter mi \"-var-evaluate-expression "
610 (string-match "char \\*" (nth 3 var))))) 627 varnum "\"\n")
611 (gdb-enqueue-input 628 `(lambda () (gdb-var-evaluate-expression-handler ,varnum t))))
612 (list 629 (throw 'var-found-1 nil))))))
613 (concat "server interpreter mi \"-var-evaluate-expression "
614 varnum "\"\n")
615 `(lambda () (gdb-var-evaluate-expression-handler ,varnum t))))
616 (throw 'var-found-1 nil)))))))
617 (setq gdb-pending-triggers 630 (setq gdb-pending-triggers
618 (delq 'gdb-var-update gdb-pending-triggers)) 631 (delq 'gdb-var-update gdb-pending-triggers))
619 (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) 632 (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
@@ -1005,6 +1018,7 @@ This filter may simply queue input for a later time."
1005 "An annotation handler for `pre-prompt'. 1018 "An annotation handler for `pre-prompt'.
1006This terminates the collection of output from a previous command if that 1019This terminates the collection of output from a previous command if that
1007happens to be in effect." 1020happens to be in effect."
1021 (setq gdb-error nil)
1008 (let ((sink gdb-output-sink)) 1022 (let ((sink gdb-output-sink))
1009 (cond 1023 (cond
1010 ((eq sink 'user) t) 1024 ((eq sink 'user) t)
@@ -1097,6 +1111,7 @@ directives."
1097It is just like `gdb-stopping', except that if we already set the output 1111It is just like `gdb-stopping', except that if we already set the output
1098sink to `user' in `gdb-stopping', that is fine." 1112sink to `user' in `gdb-stopping', that is fine."
1099 (setq gud-running nil) 1113 (setq gud-running nil)
1114 (setq gdb-active-process t)
1100 (let ((sink gdb-output-sink)) 1115 (let ((sink gdb-output-sink))
1101 (cond 1116 (cond
1102 ((eq sink 'inferior) 1117 ((eq sink 'inferior)
@@ -1458,11 +1473,11 @@ static char *magick[] = {
1458 (gdb-put-breakpoint-icon (eq flag ?y) bptno))) 1473 (gdb-put-breakpoint-icon (eq flag ?y) bptno)))
1459 (gdb-enqueue-input 1474 (gdb-enqueue-input
1460 (list 1475 (list
1461 (concat "list " 1476 (concat gdb-server-prefix "list "
1462 (match-string-no-properties 1) ":1\n") 1477 (match-string-no-properties 1) ":1\n")
1463 'ignore)) 1478 'ignore))
1464 (gdb-enqueue-input 1479 (gdb-enqueue-input
1465 (list "info source\n" 1480 (list (concat gdb-server-prefix "info source\n")
1466 `(lambda () (gdb-get-location 1481 `(lambda () (gdb-get-location
1467 ,bptno ,line ,flag)))))))))) 1482 ,bptno ,line ,flag))))))))))
1468 (end-of-line))))) 1483 (end-of-line)))))
@@ -1497,7 +1512,7 @@ static char *magick[] = {
1497 (list 1512 (list
1498 (let ((bptno (get-text-property 1513 (let ((bptno (get-text-property
1499 0 'gdb-bptno (car (posn-string posn))))) 1514 0 'gdb-bptno (car (posn-string posn)))))
1500 (concat 1515 (concat gdb-server-prefix
1501 (if (get-text-property 1516 (if (get-text-property
1502 0 'gdb-enabled (car (posn-string posn))) 1517 0 'gdb-enabled (car (posn-string posn)))
1503 "disable " 1518 "disable "
@@ -1523,7 +1538,7 @@ static char *magick[] = {
1523 (when (stringp obj) 1538 (when (stringp obj)
1524 (gdb-enqueue-input 1539 (gdb-enqueue-input
1525 (list 1540 (list
1526 (concat 1541 (concat gdb-server-prefix
1527 (if (get-text-property 0 'gdb-enabled obj) 1542 (if (get-text-property 0 'gdb-enabled obj)
1528 "disable " 1543 "disable "
1529 "enable ") 1544 "enable ")
@@ -1557,7 +1572,7 @@ static char *magick[] = {
1557 (suppress-keymap map) 1572 (suppress-keymap map)
1558 (define-key map [menu-bar breakpoints] (cons "Breakpoints" menu)) 1573 (define-key map [menu-bar breakpoints] (cons "Breakpoints" menu))
1559 (define-key map " " 'gdb-toggle-breakpoint) 1574 (define-key map " " 'gdb-toggle-breakpoint)
1560 (define-key map "d" 'gdb-delete-breakpoint) 1575 (define-key map "D" 'gdb-delete-breakpoint)
1561 (define-key map "q" 'kill-this-buffer) 1576 (define-key map "q" 'kill-this-buffer)
1562 (define-key map "\r" 'gdb-goto-breakpoint) 1577 (define-key map "\r" 'gdb-goto-breakpoint)
1563 (define-key map [mouse-2] 'gdb-goto-breakpoint) 1578 (define-key map [mouse-2] 'gdb-goto-breakpoint)
@@ -1612,7 +1627,7 @@ static char *magick[] = {
1612(defun gdb-goto-breakpoint (&optional event) 1627(defun gdb-goto-breakpoint (&optional event)
1613 "Display the breakpoint location specified at current line." 1628 "Display the breakpoint location specified at current line."
1614 (interactive (list last-input-event)) 1629 (interactive (list last-input-event))
1615 (if event (mouse-set-point event)) 1630 (if event (posn-set-point (event-end event)))
1616 ;; Hack to stop gdb-goto-breakpoint displaying in GUD buffer. 1631 ;; Hack to stop gdb-goto-breakpoint displaying in GUD buffer.
1617 (let ((window (get-buffer-window gud-comint-buffer))) 1632 (let ((window (get-buffer-window gud-comint-buffer)))
1618 (if window (save-selected-window (select-window window)))) 1633 (if window (save-selected-window (select-window window))))
@@ -1661,7 +1676,7 @@ static char *magick[] = {
1661 (while (< (point) (point-max)) 1676 (while (< (point) (point-max))
1662 (setq bl (line-beginning-position) 1677 (setq bl (line-beginning-position)
1663 el (line-end-position)) 1678 el (line-end-position))
1664 (unless (looking-at "No ") 1679 (when (looking-at "#")
1665 (add-text-properties bl el 1680 (add-text-properties bl el
1666 '(mouse-face highlight 1681 '(mouse-face highlight
1667 help-echo "mouse-2, RET: Select frame"))) 1682 help-echo "mouse-2, RET: Select frame")))
@@ -1730,14 +1745,15 @@ static char *magick[] = {
1730(defun gdb-get-frame-number () 1745(defun gdb-get-frame-number ()
1731 (save-excursion 1746 (save-excursion
1732 (end-of-line) 1747 (end-of-line)
1733 (let* ((pos (re-search-backward "^#*\\([0-9]*\\)" nil t)) 1748 (let* ((start (line-beginning-position))
1749 (pos (re-search-backward "^#*\\([0-9]+\\)" start t))
1734 (n (or (and pos (match-string-no-properties 1)) "0"))) 1750 (n (or (and pos (match-string-no-properties 1)) "0")))
1735 n))) 1751 n)))
1736 1752
1737(defun gdb-frames-select (&optional event) 1753(defun gdb-frames-select (&optional event)
1738 "Select the frame and display the relevant source." 1754 "Select the frame and display the relevant source."
1739 (interactive (list last-input-event)) 1755 (interactive (list last-input-event))
1740 (if event (mouse-set-point event)) 1756 (if event (posn-set-point (event-end event)))
1741 (gdb-enqueue-input 1757 (gdb-enqueue-input
1742 (list (concat gdb-server-prefix "frame " 1758 (list (concat gdb-server-prefix "frame "
1743 (gdb-get-frame-number) "\n") 'ignore)) 1759 (gdb-get-frame-number) "\n") 'ignore))
@@ -1790,6 +1806,7 @@ static char *magick[] = {
1790 (define-key map "q" 'kill-this-buffer) 1806 (define-key map "q" 'kill-this-buffer)
1791 (define-key map "\r" 'gdb-threads-select) 1807 (define-key map "\r" 'gdb-threads-select)
1792 (define-key map [mouse-2] 'gdb-threads-select) 1808 (define-key map [mouse-2] 'gdb-threads-select)
1809 (define-key map [follow-link] 'mouse-face)
1793 map)) 1810 map))
1794 1811
1795(defvar gdb-threads-font-lock-keywords 1812(defvar gdb-threads-font-lock-keywords
@@ -1822,9 +1839,10 @@ static char *magick[] = {
1822(defun gdb-threads-select (&optional event) 1839(defun gdb-threads-select (&optional event)
1823 "Select the thread and display the relevant source." 1840 "Select the thread and display the relevant source."
1824 (interactive (list last-input-event)) 1841 (interactive (list last-input-event))
1825 (if event (mouse-set-point event)) 1842 (if event (posn-set-point (event-end event)))
1826 (gdb-enqueue-input 1843 (gdb-enqueue-input
1827 (list (concat "thread " (gdb-get-thread-number) "\n") 'ignore)) 1844 (list (concat gdb-server-prefix "thread "
1845 (gdb-get-thread-number) "\n") 'ignore))
1828 (gud-display-frame)) 1846 (gud-display-frame))
1829 1847
1830 1848
@@ -1851,19 +1869,36 @@ static char *magick[] = {
1851 (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer) 1869 (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer)
1852 (save-excursion 1870 (save-excursion
1853 (let ((buffer-read-only nil) 1871 (let ((buffer-read-only nil)
1854 bl) 1872 start end)
1855 (goto-char (point-min)) 1873 (goto-char (point-min))
1856 (while (< (point) (point-max)) 1874 (while (< (point) (point-max))
1857 (setq bl (line-beginning-position)) 1875 (setq start (line-beginning-position))
1876 (setq end (line-end-position))
1858 (when (looking-at "^[^ ]+") 1877 (when (looking-at "^[^ ]+")
1859 (unless (string-equal (match-string 0) "The") 1878 (unless (string-equal (match-string 0) "The")
1860 (put-text-property bl (match-end 0) 1879 (put-text-property start (match-end 0)
1861 'face font-lock-variable-name-face))) 1880 'face font-lock-variable-name-face)
1881 (add-text-properties start end
1882 '(help-echo "mouse-2: edit value"
1883 mouse-face highlight))))
1862 (forward-line 1)))))) 1884 (forward-line 1))))))
1863 1885
1886(defun gdb-edit-register-value (&optional event)
1887 (interactive (list last-input-event))
1888 (save-excursion
1889 (if event (posn-set-point (event-end event)))
1890 (beginning-of-line)
1891 (let* ((register (current-word))
1892 (value (read-string (format "New value (%s): " register))))
1893 (gdb-enqueue-input
1894 (list (concat gdb-server-prefix "set $" register "=" value "\n")
1895 'ignore)))))
1896
1864(defvar gdb-registers-mode-map 1897(defvar gdb-registers-mode-map
1865 (let ((map (make-sparse-keymap))) 1898 (let ((map (make-sparse-keymap)))
1866 (suppress-keymap map) 1899 (suppress-keymap map)
1900 (define-key map "\r" 'gdb-edit-register-value)
1901 (define-key map [mouse-2] 'gdb-edit-register-value)
1867 (define-key map " " 'toggle-gdb-all-registers) 1902 (define-key map " " 'toggle-gdb-all-registers)
1868 (define-key map "q" 'kill-this-buffer) 1903 (define-key map "q" 'kill-this-buffer)
1869 map)) 1904 map))
@@ -1907,9 +1942,9 @@ static char *magick[] = {
1907 (setq gdb-all-registers nil) 1942 (setq gdb-all-registers nil)
1908 (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer) 1943 (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer)
1909 (setq mode-name "Registers:"))) 1944 (setq mode-name "Registers:")))
1910 (setq gdb-all-registers t) 1945 (setq gdb-all-registers t)
1911 (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer) 1946 (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer)
1912 (setq mode-name "Registers:All"))) 1947 (setq mode-name "Registers:All")))
1913 (gdb-invalidate-registers)) 1948 (gdb-invalidate-registers))
1914 1949
1915 1950
@@ -2245,13 +2280,13 @@ corresponding to the mode line clicked."
2245 "Keymap to create watch expression of a complex data type local variable.") 2280 "Keymap to create watch expression of a complex data type local variable.")
2246 2281
2247(defconst gdb-struct-string 2282(defconst gdb-struct-string
2248 (concat (propertize "[struct/union];" 2283 (concat (propertize "[struct/union]"
2249 'mouse-face 'highlight 2284 'mouse-face 'highlight
2250 'help-echo "mouse-2: create watch expression" 2285 'help-echo "mouse-2: create watch expression"
2251 'local-map gdb-locals-watch-keymap) "\n")) 2286 'local-map gdb-locals-watch-keymap) "\n"))
2252 2287
2253(defconst gdb-array-string 2288(defconst gdb-array-string
2254 (concat " " (propertize "[array];" 2289 (concat " " (propertize "[array]"
2255 'mouse-face 'highlight 2290 'mouse-face 'highlight
2256 'help-echo "mouse-2: create watch expression" 2291 'help-echo "mouse-2: create watch expression"
2257 'local-map gdb-locals-watch-keymap) "\n")) 2292 'local-map gdb-locals-watch-keymap) "\n"))
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index e045ae76a29..81ae4c3cd02 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -52,6 +52,7 @@
52(defvar gdb-show-changed-values) 52(defvar gdb-show-changed-values)
53(defvar gdb-var-changed) 53(defvar gdb-var-changed)
54(defvar gdb-var-list) 54(defvar gdb-var-list)
55(defvar gdb-speedbar-auto-raise)
55(defvar tool-bar-map) 56(defvar tool-bar-map)
56 57
57;; ====================================================================== 58;; ======================================================================
@@ -410,6 +411,10 @@ t means that there is no stack, and we are in display-file mode.")
410 (memq gud-minor-mode '(gdbmi gdba)))] 411 (memq gud-minor-mode '(gdbmi gdba)))]
411 ["Delete expression" gdb-var-delete 412 ["Delete expression" gdb-var-delete
412 (with-current-buffer gud-comint-buffer 413 (with-current-buffer gud-comint-buffer
414 (memq gud-minor-mode '(gdbmi gdba)))]
415 ["Auto raise frame" gdb-speedbar-auto-raise
416 :style toggle :selected gdb-speedbar-auto-raise
417 :visible (with-current-buffer gud-comint-buffer
413 (memq gud-minor-mode '(gdbmi gdba)))]) 418 (memq gud-minor-mode '(gdbmi gdba)))])
414 "Additional menu items to add to the speedbar frame.") 419 "Additional menu items to add to the speedbar frame.")
415 420
@@ -444,16 +449,18 @@ required by the caller."
444 (looking-at "Watch Expressions:"))))) 449 (looking-at "Watch Expressions:")))))
445 (erase-buffer) 450 (erase-buffer)
446 (insert "Watch Expressions:\n") 451 (insert "Watch Expressions:\n")
452 (if gdb-speedbar-auto-raise
453 (raise-frame speedbar-frame))
447 (let ((var-list gdb-var-list)) 454 (let ((var-list gdb-var-list))
448 (while var-list 455 (while var-list
449 (let* ((depth 0) (start 0) (char ?+) 456 (let* (char (depth 0) (start 0)
450 (var (car var-list)) (varnum (nth 1 var))) 457 (var (car var-list)) (varnum (nth 1 var)))
451 (while (string-match "\\." varnum start) 458 (while (string-match "\\." varnum start)
452 (setq depth (1+ depth) 459 (setq depth (1+ depth)
453 start (1+ (match-beginning 0)))) 460 start (1+ (match-beginning 0))))
454 (if (or (equal (nth 2 var) "0") 461 (if (or (equal (nth 2 var) "0")
455 (and (equal (nth 2 var) "1") 462 (and (equal (nth 2 var) "1")
456 (string-match "char \\*" (nth 3 var)))) 463 (string-match "char \\*$" (nth 3 var))))
457 (speedbar-make-tag-line 'bracket ?? nil nil 464 (speedbar-make-tag-line 'bracket ?? nil nil
458 (concat (car var) "\t" (nth 4 var)) 465 (concat (car var) "\t" (nth 4 var))
459 'gdb-edit-value 466 'gdb-edit-value
@@ -463,12 +470,25 @@ required by the caller."
463 'font-lock-warning-face 470 'font-lock-warning-face
464 nil) depth) 471 nil) depth)
465 (if (and (cadr var-list) 472 (if (and (cadr var-list)
466 (string-match varnum (cadr (cadr var-list)))) 473 (string-match (concat varnum "\\.")
467 (setq char ?-)) 474 (cadr (cadr var-list))))
475 (setq char ?-)
476 (setq char ?+))
477 (if (string-match "\\*$" (nth 3 var))
478 (speedbar-make-tag-line 'bracket char
479 'gdb-speedbar-expand-node varnum
480 (concat (car var) "\t"
481 (nth 3 var)"\t"
482 (nth 4 var))
483 'gdb-edit-value nil
484 (if (and (nth 5 var)
485 gdb-show-changed-values)
486 'font-lock-warning-face
487 nil) depth)
468 (speedbar-make-tag-line 'bracket char 488 (speedbar-make-tag-line 'bracket char
469 'gdb-speedbar-expand-node varnum 489 'gdb-speedbar-expand-node varnum
470 (concat (car var) "\t" (nth 3 var)) 490 (concat (car var) "\t" (nth 3 var))
471 nil nil nil depth))) 491 nil nil nil depth))))
472 (setq var-list (cdr var-list)))) 492 (setq var-list (cdr var-list))))
473 (setq gdb-var-changed nil))) 493 (setq gdb-var-changed nil)))
474 (t (if (and (save-excursion 494 (t (if (and (save-excursion
@@ -556,6 +576,11 @@ required by the caller."
556 ;; they are found. 576 ;; they are found.
557 (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc) 577 (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc)
558 (let ((match (match-string 1 gud-marker-acc))) 578 (let ((match (match-string 1 gud-marker-acc)))
579
580 ;; Pick up stopped annotation if attaching to process.
581 (if (string-equal match "stopped") (setq gdb-active-process t))
582
583 ;; Using annotations, switch to gud-gdba-marker-filter.
559 (when (string-equal match "prompt") 584 (when (string-equal match "prompt")
560 (require 'gdb-ui) 585 (require 'gdb-ui)
561 (gdb-prompt nil)) 586 (gdb-prompt nil))
@@ -569,6 +594,8 @@ required by the caller."
569 ;; Set the accumulator to the remaining text. 594 ;; Set the accumulator to the remaining text.
570 595
571 gud-marker-acc (substring gud-marker-acc (match-end 0))) 596 gud-marker-acc (substring gud-marker-acc (match-end 0)))
597
598 ;; Pick up any errors that occur before first prompt annotation.
572 (if (string-equal match "error-begin") 599 (if (string-equal match "error-begin")
573 (put-text-property 0 (length gud-marker-acc) 600 (put-text-property 0 (length gud-marker-acc)
574 'face font-lock-warning-face 601 'face font-lock-warning-face
@@ -3079,6 +3106,8 @@ class of the file (using s to separate nested class ids)."
3079 ("\\$\\(\\w+\\)" (1 font-lock-variable-name-face)) 3106 ("\\$\\(\\w+\\)" (1 font-lock-variable-name-face))
3080 ("^\\s-*\\([a-z]+\\)" (1 font-lock-keyword-face)))) 3107 ("^\\s-*\\([a-z]+\\)" (1 font-lock-keyword-face))))
3081 3108
3109;; FIXME: The keyword "end" associated with "document"
3110;; should have font-lock-keyword-face (currently font-lock-doc-face).
3082(defvar gdb-script-font-lock-syntactic-keywords 3111(defvar gdb-script-font-lock-syntactic-keywords
3083 '(("^document\\s-.*\\(\n\\)" (1 "< b")) 3112 '(("^document\\s-.*\\(\n\\)" (1 "< b"))
3084 ;; It would be best to change the \n in front, but it's more difficult. 3113 ;; It would be best to change the \n in front, but it's more difficult.
diff --git a/lisp/progmodes/octave-inf.el b/lisp/progmodes/octave-inf.el
index 4f0875bbf99..67b5b108fa5 100644
--- a/lisp/progmodes/octave-inf.el
+++ b/lisp/progmodes/octave-inf.el
@@ -220,6 +220,13 @@ startup file, `~/.emacs-octave'."
220 (concat (mapconcat 220 (concat (mapconcat
221 'identity inferior-octave-output-list "\n") 221 'identity inferior-octave-output-list "\n")
222 "\n")))) 222 "\n"))))
223
224 ;; An empty secondary prompt, as e.g. obtained by '--braindead',
225 ;; means trouble.
226 (inferior-octave-send-list-and-digest (list "PS2\n"))
227 (if (string-match "^PS2 = *$" (car inferior-octave-output-list))
228 (inferior-octave-send-list-and-digest (list "PS2 = \"> \"\n")))
229
223 ;; O.k., now we are ready for the Inferior Octave startup commands. 230 ;; O.k., now we are ready for the Inferior Octave startup commands.
224 (let* (commands 231 (let* (commands
225 (program (file-name-nondirectory inferior-octave-program)) 232 (program (file-name-nondirectory inferior-octave-program))
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index f6928a72554..5728499db43 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -1002,6 +1002,8 @@ Point is at the beginning of the next line."
1002 ;; The list of special chars is taken from the single-unix spec 1002 ;; The list of special chars is taken from the single-unix spec
1003 ;; of the shell command language (under `quoting') but with `$' removed. 1003 ;; of the shell command language (under `quoting') but with `$' removed.
1004 `(("[^|&;<>()`\\\"' \t\n]\\(#+\\)" 1 ,sh-st-symbol) 1004 `(("[^|&;<>()`\\\"' \t\n]\\(#+\\)" 1 ,sh-st-symbol)
1005 ;; In a '...' the backslash is not escaping.
1006 ("\\(\\\\\\)'" 1 ,sh-st-punc)
1005 ;; Make sure $@ and @? are correctly recognized as sexps. 1007 ;; Make sure $@ and @? are correctly recognized as sexps.
1006 ("\\$\\([?@]\\)" 1 ,sh-st-symbol) 1008 ("\\$\\([?@]\\)" 1 ,sh-st-symbol)
1007 ;; Find HEREDOC starters and add a corresponding rule for the ender. 1009 ;; Find HEREDOC starters and add a corresponding rule for the ender.
diff --git a/lisp/recentf.el b/lisp/recentf.el
index b14997d604f..287ab3014cb 100644
--- a/lisp/recentf.el
+++ b/lisp/recentf.el
@@ -813,39 +813,49 @@ See `recentf-arrange-rules' for details on MATCHER."
813Arrange them in sub-menus following rules in `recentf-arrange-rules'." 813Arrange them in sub-menus following rules in `recentf-arrange-rules'."
814 (if (not recentf-arrange-rules) 814 (if (not recentf-arrange-rules)
815 l 815 l
816 (let ((menus (mapcar #'(lambda (r) (list (car r))) 816 (let* ((strip (assq t recentf-arrange-rules))
817 recentf-arrange-rules)) 817 (rules (remq strip recentf-arrange-rules))
818 menu others min file rules elts count) 818 (menus (mapcar #'(lambda (r) (list (car r))) rules))
819 others l1 l2 menu file min count)
820 ;; Put menu items into sub-menus as defined by rules.
819 (dolist (elt l) 821 (dolist (elt l)
820 (setq file (recentf-menu-element-value elt) 822 (setq l1 menus ;; List of sub-menus
821 rules recentf-arrange-rules 823 l2 rules ;; List of corresponding matchers.
822 elts menus 824 file (recentf-menu-element-value elt)
823 menu nil) 825 menu nil)
824 (while (and (not menu) rules) 826 ;; Apply the strip suffix rule.
825 (when (recentf-match-rule-p (cdar rules) file) 827 (while (recentf-match-rule-p (cdr strip) file)
826 (setq menu (car elts)) 828 (setq file (substring file 0 (match-beginning 0))))
829 ;; Search which sub-menu to put the menu item into.
830 (while (and (not menu) l2)
831 (when (recentf-match-rule-p (cdar l2) file)
832 (setq menu (car l1))
827 (recentf-set-menu-element-value 833 (recentf-set-menu-element-value
828 menu (cons elt (recentf-menu-element-value menu)))) 834 menu (cons elt (recentf-menu-element-value menu))))
829 (setq rules (cdr rules) 835 (setq l1 (cdr l1)
830 elts (cdr elts))) 836 l2 (cdr l2)))
831 (unless menu 837 ;; Put unmatched menu items in the `others' bin.
832 (push elt others))) 838 (or menu (push elt others)))
833 839 ;; Finalize the sub-menus. That is, for each one:
834 (setq l nil 840 ;; - truncate it depending on the value of
835 min (if (natnump recentf-arrange-by-rules-min-items) 841 ;; `recentf-arrange-by-rules-min-items',
836 recentf-arrange-by-rules-min-items 0)) 842 ;; - replace %d by the number of menu items,
843 ;; - apply `recentf-arrange-by-rule-subfilter' to menu items.
844 (setq min (if (natnump recentf-arrange-by-rules-min-items)
845 recentf-arrange-by-rules-min-items 0)
846 l2 nil)
837 (dolist (menu menus) 847 (dolist (menu menus)
838 (when (setq elts (recentf-menu-element-value menu)) 848 (when (setq l1 (recentf-menu-element-value menu))
839 (setq count (length elts)) 849 (setq count (length l1))
840 (if (< count min) 850 (if (< count min)
841 (setq others (nconc elts others)) 851 (setq others (nconc l1 others))
842 (recentf-set-menu-element-item 852 (recentf-set-menu-element-item
843 menu (format (recentf-menu-element-item menu) count)) 853 menu (format (recentf-menu-element-item menu) count))
844 (recentf-set-menu-element-value 854 (recentf-set-menu-element-value
845 menu (recentf-apply-menu-filter 855 menu (recentf-apply-menu-filter
846 recentf-arrange-by-rule-subfilter (nreverse elts))) 856 recentf-arrange-by-rule-subfilter (nreverse l1)))
847 (push menu l)))) 857 (push menu l2))))
848 858 ;; Add the menu items remaining in the `others' bin.
849 (if (and (stringp recentf-arrange-by-rule-others) others) 859 (if (and (stringp recentf-arrange-by-rule-others) others)
850 (nreverse 860 (nreverse
851 (cons 861 (cons
@@ -853,12 +863,11 @@ Arrange them in sub-menus following rules in `recentf-arrange-rules'."
853 (format recentf-arrange-by-rule-others (length others)) 863 (format recentf-arrange-by-rule-others (length others))
854 (recentf-apply-menu-filter 864 (recentf-apply-menu-filter
855 recentf-arrange-by-rule-subfilter (nreverse others))) 865 recentf-arrange-by-rule-subfilter (nreverse others)))
856 l)) 866 l2))
857 (nconc 867 (nconc
858 (nreverse l) 868 (nreverse l2)
859 (recentf-apply-menu-filter 869 (recentf-apply-menu-filter
860 recentf-arrange-by-rule-subfilter (nreverse others))))) 870 recentf-arrange-by-rule-subfilter (nreverse others)))))))
861 ))
862 871
863;;; Predefined rule based menu filters 872;;; Predefined rule based menu filters
864;; 873;;
@@ -870,12 +879,20 @@ Rules obey `recentf-arrange-rules' format."
870 (dolist (mode auto-mode-alist) 879 (dolist (mode auto-mode-alist)
871 (setq regexp (car mode) 880 (setq regexp (car mode)
872 mode (cdr mode)) 881 mode (cdr mode))
873 (when (symbolp mode) 882 (when mode
874 (setq rule-name (symbol-name mode)) 883 (cond
875 (if (string-match "\\(.*\\)-mode$" rule-name) 884 ;; Build a special "strip suffix" rule from entries of the
876 (setq rule-name (match-string 1 rule-name))) 885 ;; form (REGEXP FUNCTION NON-NIL). Notice that FUNCTION is
877 (setq rule-name (concat rule-name " (%d)") 886 ;; ignored by the menu filter. So in some corner cases a
878 rule (assoc rule-name rules)) 887 ;; wrong mode could be guessed.
888 ((and (consp mode) (cadr mode))
889 (setq rule-name t))
890 ((and mode (symbolp mode))
891 (setq rule-name (symbol-name mode))
892 (if (string-match "\\(.*\\)-mode$" rule-name)
893 (setq rule-name (match-string 1 rule-name)))
894 (setq rule-name (concat rule-name " (%d)"))))
895 (setq rule (assoc rule-name rules))
879 (if rule 896 (if rule
880 (setcdr rule (cons regexp (cdr rule))) 897 (setcdr rule (cons regexp (cdr rule)))
881 (push (list rule-name regexp) rules)))) 898 (push (list rule-name regexp) rules))))
diff --git a/lisp/replace.el b/lisp/replace.el
index e74b8690c28..fbfa1be09c2 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -693,6 +693,7 @@ a previously found match."
693 693
694(defvar occur-mode-map 694(defvar occur-mode-map
695 (let ((map (make-sparse-keymap))) 695 (let ((map (make-sparse-keymap)))
696 ;; We use this alternative name, so we can use \\[occur-mode-mouse-goto].
696 (define-key map [mouse-2] 'occur-mode-mouse-goto) 697 (define-key map [mouse-2] 'occur-mode-mouse-goto)
697 (define-key map "\C-c\C-c" 'occur-mode-goto-occurrence) 698 (define-key map "\C-c\C-c" 'occur-mode-goto-occurrence)
698 (define-key map "\C-m" 'occur-mode-goto-occurrence) 699 (define-key map "\C-m" 'occur-mode-goto-occurrence)
@@ -746,18 +747,6 @@ Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it.
746 "Handle `revert-buffer' for Occur mode buffers." 747 "Handle `revert-buffer' for Occur mode buffers."
747 (apply 'occur-1 (append occur-revert-arguments (list (buffer-name))))) 748 (apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))))
748 749
749(defun occur-mode-mouse-goto (event)
750 "In Occur mode, go to the occurrence whose line you click on."
751 (interactive "e")
752 (let (pos)
753 (save-excursion
754 (set-buffer (window-buffer (posn-window (event-end event))))
755 (save-excursion
756 (goto-char (posn-point (event-end event)))
757 (setq pos (occur-mode-find-occurrence))))
758 (switch-to-buffer-other-window (marker-buffer pos))
759 (goto-char pos)))
760
761(defun occur-mode-find-occurrence () 750(defun occur-mode-find-occurrence ()
762 (let ((pos (get-text-property (point) 'occur-target))) 751 (let ((pos (get-text-property (point) 'occur-target)))
763 (unless pos 752 (unless pos
@@ -766,11 +755,23 @@ Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it.
766 (error "Buffer for this occurrence was killed")) 755 (error "Buffer for this occurrence was killed"))
767 pos)) 756 pos))
768 757
769(defun occur-mode-goto-occurrence () 758(defalias 'occur-mode-mouse-goto 'occur-mode-goto-occurrence)
759(defun occur-mode-goto-occurrence (&optional event)
770 "Go to the occurrence the current line describes." 760 "Go to the occurrence the current line describes."
771 (interactive) 761 (interactive (list last-nonmenu-event))
772 (let ((pos (occur-mode-find-occurrence))) 762 (let ((pos
773 (switch-to-buffer (marker-buffer pos)) 763 (if (null event)
764 ;; Actually `event-end' works correctly with a nil argument as
765 ;; well, so we could dispense with this test, but let's not
766 ;; rely on this undocumented behavior.
767 (occur-mode-find-occurrence)
768 (with-current-buffer (window-buffer (posn-window (event-end event)))
769 (save-excursion
770 (goto-char (posn-point (event-end event)))
771 (occur-mode-find-occurrence)))))
772 same-window-buffer-names
773 same-window-regexps)
774 (pop-to-buffer (marker-buffer pos))
774 (goto-char pos))) 775 (goto-char pos)))
775 776
776(defun occur-mode-goto-occurrence-other-window () 777(defun occur-mode-goto-occurrence-other-window ()
@@ -832,7 +833,8 @@ Compatibility function for \\[next-error] invocations."
832 833
833 (goto-char (cond (reset (point-min)) 834 (goto-char (cond (reset (point-min))
834 ((< argp 0) (line-beginning-position)) 835 ((< argp 0) (line-beginning-position))
835 ((line-end-position)))) 836 ((> argp 0) (line-end-position))
837 ((point))))
836 (occur-find-match 838 (occur-find-match
837 (abs argp) 839 (abs argp)
838 (if (> 0 argp) 840 (if (> 0 argp)
@@ -1089,8 +1091,7 @@ See also `multi-occur'."
1089 (marker nil) 1091 (marker nil)
1090 (curstring "") 1092 (curstring "")
1091 (headerpt (with-current-buffer out-buf (point)))) 1093 (headerpt (with-current-buffer out-buf (point))))
1092 (save-excursion 1094 (with-current-buffer buf
1093 (set-buffer buf)
1094 (or coding 1095 (or coding
1095 ;; Set CODING only if the current buffer locally 1096 ;; Set CODING only if the current buffer locally
1096 ;; binds buffer-file-coding-system. 1097 ;; binds buffer-file-coding-system.
@@ -1223,42 +1224,43 @@ C-l to clear the screen, redisplay, and offer same replacement again,
1223E to edit the replacement string" 1224E to edit the replacement string"
1224 "Help message while in `query-replace'.") 1225 "Help message while in `query-replace'.")
1225 1226
1226(defvar query-replace-map (make-sparse-keymap) 1227(defvar query-replace-map
1228 (let ((map (make-sparse-keymap)))
1229 (define-key map " " 'act)
1230 (define-key map "\d" 'skip)
1231 (define-key map [delete] 'skip)
1232 (define-key map [backspace] 'skip)
1233 (define-key map "y" 'act)
1234 (define-key map "n" 'skip)
1235 (define-key map "Y" 'act)
1236 (define-key map "N" 'skip)
1237 (define-key map "e" 'edit-replacement)
1238 (define-key map "E" 'edit-replacement)
1239 (define-key map "," 'act-and-show)
1240 (define-key map "q" 'exit)
1241 (define-key map "\r" 'exit)
1242 (define-key map [return] 'exit)
1243 (define-key map "." 'act-and-exit)
1244 (define-key map "\C-r" 'edit)
1245 (define-key map "\C-w" 'delete-and-edit)
1246 (define-key map "\C-l" 'recenter)
1247 (define-key map "!" 'automatic)
1248 (define-key map "^" 'backup)
1249 (define-key map "\C-h" 'help)
1250 (define-key map [f1] 'help)
1251 (define-key map [help] 'help)
1252 (define-key map "?" 'help)
1253 (define-key map "\C-g" 'quit)
1254 (define-key map "\C-]" 'quit)
1255 (define-key map "\e" 'exit-prefix)
1256 (define-key map [escape] 'exit-prefix)
1257 map)
1227 "Keymap that defines the responses to questions in `query-replace'. 1258 "Keymap that defines the responses to questions in `query-replace'.
1228The \"bindings\" in this map are not commands; they are answers. 1259The \"bindings\" in this map are not commands; they are answers.
1229The valid answers include `act', `skip', `act-and-show', 1260The valid answers include `act', `skip', `act-and-show',
1230`exit', `act-and-exit', `edit', `delete-and-edit', `recenter', 1261`exit', `act-and-exit', `edit', `delete-and-edit', `recenter',
1231`automatic', `backup', `exit-prefix', and `help'.") 1262`automatic', `backup', `exit-prefix', and `help'.")
1232 1263
1233(define-key query-replace-map " " 'act)
1234(define-key query-replace-map "\d" 'skip)
1235(define-key query-replace-map [delete] 'skip)
1236(define-key query-replace-map [backspace] 'skip)
1237(define-key query-replace-map "y" 'act)
1238(define-key query-replace-map "n" 'skip)
1239(define-key query-replace-map "Y" 'act)
1240(define-key query-replace-map "N" 'skip)
1241(define-key query-replace-map "e" 'edit-replacement)
1242(define-key query-replace-map "E" 'edit-replacement)
1243(define-key query-replace-map "," 'act-and-show)
1244(define-key query-replace-map "q" 'exit)
1245(define-key query-replace-map "\r" 'exit)
1246(define-key query-replace-map [return] 'exit)
1247(define-key query-replace-map "." 'act-and-exit)
1248(define-key query-replace-map "\C-r" 'edit)
1249(define-key query-replace-map "\C-w" 'delete-and-edit)
1250(define-key query-replace-map "\C-l" 'recenter)
1251(define-key query-replace-map "!" 'automatic)
1252(define-key query-replace-map "^" 'backup)
1253(define-key query-replace-map "\C-h" 'help)
1254(define-key query-replace-map [f1] 'help)
1255(define-key query-replace-map [help] 'help)
1256(define-key query-replace-map "?" 'help)
1257(define-key query-replace-map "\C-g" 'quit)
1258(define-key query-replace-map "\C-]" 'quit)
1259(define-key query-replace-map "\e" 'exit-prefix)
1260(define-key query-replace-map [escape] 'exit-prefix)
1261
1262(defun replace-match-string-symbols (n) 1264(defun replace-match-string-symbols (n)
1263 "Process a list (and any sub-lists), expanding certain symbols. 1265 "Process a list (and any sub-lists), expanding certain symbols.
1264Symbol Expands To 1266Symbol Expands To
diff --git a/lisp/simple.el b/lisp/simple.el
index a1be91f5abf..302354dff26 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -609,7 +609,7 @@ In binary overwrite mode, this function does overwrite, and octal
609digits are interpreted as a character code. This is intended to be 609digits are interpreted as a character code. This is intended to be
610useful for editing binary files." 610useful for editing binary files."
611 (interactive "*p") 611 (interactive "*p")
612 (let* ((char (let (translation-table-for-input) 612 (let* ((char (let (translation-table-for-input input-method-function)
613 (if (or (not overwrite-mode) 613 (if (or (not overwrite-mode)
614 (eq overwrite-mode 'overwrite-mode-binary)) 614 (eq overwrite-mode 'overwrite-mode-binary))
615 (read-quoted-char) 615 (read-quoted-char)
@@ -3330,7 +3330,7 @@ and more reliable (no dependence on goal column, etc.)."
3330 ;; When adding a newline, don't expand an abbrev. 3330 ;; When adding a newline, don't expand an abbrev.
3331 (let ((abbrev-mode nil)) 3331 (let ((abbrev-mode nil))
3332 (end-of-line) 3332 (end-of-line)
3333 (insert hard-newline)) 3333 (insert (if use-hard-newlines hard-newline "\n")))
3334 (line-move arg nil nil try-vscroll)) 3334 (line-move arg nil nil try-vscroll))
3335 (if (interactive-p) 3335 (if (interactive-p)
3336 (condition-case nil 3336 (condition-case nil
@@ -4263,7 +4263,11 @@ of the buffer appears in the mode line."
4263(defcustom blink-matching-paren-on-screen t 4263(defcustom blink-matching-paren-on-screen t
4264 "*Non-nil means show matching open-paren when it is on screen. 4264 "*Non-nil means show matching open-paren when it is on screen.
4265If nil, means don't show it (but the open-paren can still be shown 4265If nil, means don't show it (but the open-paren can still be shown
4266when it is off screen)." 4266when it is off screen).
4267
4268This variable has no effect if `blink-matching-paren' is nil.
4269\(In that case, the open-paren is never shown.)
4270It is also ignored if `show-paren-mode' is enabled."
4267 :type 'boolean 4271 :type 'boolean
4268 :group 'paren-blinking) 4272 :group 'paren-blinking)
4269 4273
@@ -4324,7 +4328,7 @@ If nil, search stops at the beginning of the accessible portion of the buffer."
4324 ;; The cdr might hold a new paren-class info rather than 4328 ;; The cdr might hold a new paren-class info rather than
4325 ;; a matching-char info, in which case the two CDRs 4329 ;; a matching-char info, in which case the two CDRs
4326 ;; should match. 4330 ;; should match.
4327 (eq matching-paren (cdr (syntax-after oldpos))))) 4331 (eq matching-paren (cdr (syntax-after (1- oldpos))))))
4328 (message "Mismatched parentheses")) 4332 (message "Mismatched parentheses"))
4329 ((not blinkpos) 4333 ((not blinkpos)
4330 (if (not blink-matching-paren-distance) 4334 (if (not blink-matching-paren-distance)
@@ -4332,10 +4336,11 @@ If nil, search stops at the beginning of the accessible portion of the buffer."
4332 ((pos-visible-in-window-p blinkpos) 4336 ((pos-visible-in-window-p blinkpos)
4333 ;; Matching open within window, temporarily move to blinkpos but only 4337 ;; Matching open within window, temporarily move to blinkpos but only
4334 ;; if `blink-matching-paren-on-screen' is non-nil. 4338 ;; if `blink-matching-paren-on-screen' is non-nil.
4335 (when blink-matching-paren-on-screen 4339 (and blink-matching-paren-on-screen
4336 (save-excursion 4340 (not show-paren-mode)
4337 (goto-char blinkpos) 4341 (save-excursion
4338 (sit-for blink-matching-delay)))) 4342 (goto-char blinkpos)
4343 (sit-for blink-matching-delay))))
4339 (t 4344 (t
4340 (save-excursion 4345 (save-excursion
4341 (goto-char blinkpos) 4346 (goto-char blinkpos)
@@ -4514,7 +4519,8 @@ See also `read-mail-command' concerning reading mail."
4514 (unless (member-ignore-case (car (car other-headers)) 4519 (unless (member-ignore-case (car (car other-headers))
4515 '("in-reply-to" "cc" "body")) 4520 '("in-reply-to" "cc" "body"))
4516 (insert (car (car other-headers)) ": " 4521 (insert (car (car other-headers)) ": "
4517 (cdr (car other-headers)) hard-newline)) 4522 (cdr (car other-headers))
4523 (if use-hard-newlines hard-newline "\n")))
4518 (setq other-headers (cdr other-headers))) 4524 (setq other-headers (cdr other-headers)))
4519 (when body 4525 (when body
4520 (forward-line 1) 4526 (forward-line 1)
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index e09c0d734cc..a48f480a756 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -331,6 +331,16 @@ display is used instead."
331 :group 'speedbar 331 :group 'speedbar
332 :type 'boolean) 332 :type 'boolean)
333 333
334(defcustom speedbar-default-position 'left-right
335 "*Default position of the speedbar frame.
336Possible values are 'left, 'right or 'left-right.
337If value is 'left-right, the most suitable location is
338determined automatically."
339 :group 'speedbar
340 :type '(radio (const :tag "Automatic" left-right)
341 (const :tag "Left" left)
342 (const :tag "Right" right)))
343
334(defcustom speedbar-sort-tags nil 344(defcustom speedbar-sort-tags nil
335 "*If non-nil, sort tags in the speedbar display. *Obsolete*. 345 "*If non-nil, sort tags in the speedbar display. *Obsolete*.
336Use `semantic-tag-hierarchy-method' instead." 346Use `semantic-tag-hierarchy-method' instead."
@@ -967,7 +977,7 @@ supported at a time.
967 (t 977 (t
968 (dframe-reposition-frame speedbar-frame 978 (dframe-reposition-frame speedbar-frame
969 (dframe-attached-frame speedbar-frame) 979 (dframe-attached-frame speedbar-frame)
970 'left-right)))) 980 speedbar-default-position))))
971 981
972(defun speedbar-detach () 982(defun speedbar-detach ()
973 "Detach the current Speedbar from auto-updating. 983 "Detach the current Speedbar from auto-updating.
diff --git a/lisp/term/mac-win.el b/lisp/term/mac-win.el
index 7912bb1a4d6..66a633d6f36 100644
--- a/lisp/term/mac-win.el
+++ b/lisp/term/mac-win.el
@@ -1085,6 +1085,9 @@ XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp")
1085(put 'return 'ascii-character ?\C-m) 1085(put 'return 'ascii-character ?\C-m)
1086(put 'escape 'ascii-character ?\e) 1086(put 'escape 'ascii-character ?\e)
1087 1087
1088;; Modifier name `ctrl' is an alias of `control'.
1089(put 'ctrl 'modifier-value (get 'control 'modifier-value))
1090
1088 1091
1089;;;; Script codes and coding systems 1092;;;; Script codes and coding systems
1090(defconst mac-script-code-coding-systems 1093(defconst mac-script-code-coding-systems
@@ -1962,10 +1965,10 @@ Switch to a buffer editing the last file dropped."
1962 user-login-name user-real-login-name user-full-name)) 1965 user-login-name user-real-login-name user-full-name))
1963 (set v (decode-coding-string (symbol-value v) mac-system-coding-system)))) 1966 (set v (decode-coding-string (symbol-value v) mac-system-coding-system))))
1964 1967
1965;; If Emacs is started from the Finder, change the default directory 1968;; Now the default directory is changed to the user's home directory
1966;; to the user's home directory. 1969;; in emacs.c if invoked from the WindowServer (with -psn_* option).
1967(if (string= default-directory "/") 1970;; (if (string= default-directory "/")
1968 (cd "~")) 1971;; (cd "~"))
1969 1972
1970;; Darwin 6- pty breakage is now controlled from the C code so that 1973;; Darwin 6- pty breakage is now controlled from the C code so that
1971;; it applies to all builds on darwin. See s/darwin.h PTY_ITERATION. 1974;; it applies to all builds on darwin. See s/darwin.h PTY_ITERATION.
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index ffa7d606a95..aff6d032f06 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -1039,6 +1039,8 @@ XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp")
1039(substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame 1039(substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame
1040 global-map) 1040 global-map)
1041 1041
1042(define-key function-key-map [S-tab] [backtab])
1043
1042 1044
1043;;; Do the actual Windows setup here; the above code just defines 1045;;; Do the actual Windows setup here; the above code just defines
1044;;; functions and variables that we use now. 1046;;; functions and variables that we use now.
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index dd718e21ed9..a0f36f5f794 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -501,23 +501,29 @@ in your .emacs file.
501;;*---------------------------------------------------------------------*/ 501;;*---------------------------------------------------------------------*/
502;;* flyspell-accept-buffer-local-defs ... */ 502;;* flyspell-accept-buffer-local-defs ... */
503;;*---------------------------------------------------------------------*/ 503;;*---------------------------------------------------------------------*/
504(defvar flyspell-last-buffer nil
505 "The buffer in which the last flyspell operation took place.")
506
504(defun flyspell-accept-buffer-local-defs () 507(defun flyspell-accept-buffer-local-defs ()
505 ;; strange problem. If buffer in current window has font-lock turned on, 508 ;; When flyspell-word is used inside a loop (e.g. when processing
506 ;; but SET-BUFFER was called to point to an invisible buffer, this ispell 509 ;; flyspell-changes), the calls to `ispell-accept-buffer-local-defs' end
507 ;; call will reset the buffer to the buffer in the current window. However, 510 ;; up dwarfing everything else, so only do it when the buffer has changed.
508 ;; it only happens at startup (fix by Albert L. Ting). 511 (unless (eq flyspell-last-buffer (current-buffer))
509 (save-current-buffer 512 (setq flyspell-last-buffer (current-buffer))
510 (ispell-accept-buffer-local-defs)) 513 ;; Strange problem: If buffer in current window has font-lock turned on,
511 (if (not (and (eq flyspell-dash-dictionary ispell-dictionary) 514 ;; but SET-BUFFER was called to point to an invisible buffer, this ispell
512 (eq flyspell-dash-local-dictionary ispell-local-dictionary))) 515 ;; call will reset the buffer to the buffer in the current window.
516 ;; However, it only happens at startup (fix by Albert L. Ting).
517 (save-current-buffer
518 (ispell-accept-buffer-local-defs))
519 (unless (and (eq flyspell-dash-dictionary ispell-dictionary)
520 (eq flyspell-dash-local-dictionary ispell-local-dictionary))
513 ;; The dictionary has changed 521 ;; The dictionary has changed
514 (progn 522 (setq flyspell-dash-dictionary ispell-dictionary)
515 (setq flyspell-dash-dictionary ispell-dictionary) 523 (setq flyspell-dash-local-dictionary ispell-local-dictionary)
516 (setq flyspell-dash-local-dictionary ispell-local-dictionary) 524 (setq flyspell-consider-dash-as-word-delimiter-flag
517 (if (member (or ispell-local-dictionary ispell-dictionary) 525 (member (or ispell-local-dictionary ispell-dictionary)
518 flyspell-dictionaries-that-consider-dash-as-word-delimiter) 526 flyspell-dictionaries-that-consider-dash-as-word-delimiter)))))
519 (setq flyspell-consider-dash-as-word-delimiter-flag t)
520 (setq flyspell-consider-dash-as-word-delimiter-flag nil)))))
521 527
522;;*---------------------------------------------------------------------*/ 528;;*---------------------------------------------------------------------*/
523;;* flyspell-mode-on ... */ 529;;* flyspell-mode-on ... */
@@ -543,9 +549,7 @@ in your .emacs file.
543 ;; we bound flyspell action to pre-command hook 549 ;; we bound flyspell action to pre-command hook
544 (add-hook 'pre-command-hook (function flyspell-pre-command-hook) t t) 550 (add-hook 'pre-command-hook (function flyspell-pre-command-hook) t t)
545 ;; we bound flyspell action to after-change hook 551 ;; we bound flyspell action to after-change hook
546 (make-local-variable 'after-change-functions) 552 (add-hook 'after-change-functions 'flyspell-after-change-function nil t)
547 (setq after-change-functions
548 (cons 'flyspell-after-change-function after-change-functions))
549 ;; set flyspell-generic-check-word-p based on the major mode 553 ;; set flyspell-generic-check-word-p based on the major mode
550 (let ((mode-predicate (get major-mode 'flyspell-mode-predicate))) 554 (let ((mode-predicate (get major-mode 'flyspell-mode-predicate)))
551 (if mode-predicate 555 (if mode-predicate
@@ -650,8 +654,7 @@ not the very same deplacement command."
650 ;; we remove the hooks 654 ;; we remove the hooks
651 (remove-hook 'post-command-hook (function flyspell-post-command-hook) t) 655 (remove-hook 'post-command-hook (function flyspell-post-command-hook) t)
652 (remove-hook 'pre-command-hook (function flyspell-pre-command-hook) t) 656 (remove-hook 'pre-command-hook (function flyspell-pre-command-hook) t)
653 (setq after-change-functions (delq 'flyspell-after-change-function 657 (remove-hook 'after-change-functions 'flyspell-after-change-function t)
654 after-change-functions))
655 ;; we remove all the flyspell hilightings 658 ;; we remove all the flyspell hilightings
656 (flyspell-delete-all-overlays) 659 (flyspell-delete-all-overlays)
657 ;; we have to erase pre cache variables 660 ;; we have to erase pre cache variables
@@ -704,14 +707,14 @@ before the current command."
704;;* position has to be spell checked. */ 707;;* position has to be spell checked. */
705;;*---------------------------------------------------------------------*/ 708;;*---------------------------------------------------------------------*/
706(defvar flyspell-changes nil) 709(defvar flyspell-changes nil)
710(make-variable-buffer-local 'flyspell-changes)
707 711
708;;*---------------------------------------------------------------------*/ 712;;*---------------------------------------------------------------------*/
709;;* flyspell-after-change-function ... */ 713;;* flyspell-after-change-function ... */
710;;*---------------------------------------------------------------------*/ 714;;*---------------------------------------------------------------------*/
711(defun flyspell-after-change-function (start stop len) 715(defun flyspell-after-change-function (start stop len)
712 "Save the current buffer and point for Flyspell's post-command hook." 716 "Save the current buffer and point for Flyspell's post-command hook."
713 (interactive) 717 (push (cons start stop) flyspell-changes))
714 (setq flyspell-changes (cons (cons start stop) flyspell-changes)))
715 718
716;;*---------------------------------------------------------------------*/ 719;;*---------------------------------------------------------------------*/
717;;* flyspell-check-changed-word-p ... */ 720;;* flyspell-check-changed-word-p ... */
@@ -899,7 +902,7 @@ Mostly we check word delimiters."
899 (progn 902 (progn
900 (setq flyspell-word-cache-end -1) 903 (setq flyspell-word-cache-end -1)
901 (setq flyspell-word-cache-result '_))))) 904 (setq flyspell-word-cache-result '_)))))
902 (while (consp flyspell-changes) 905 (while (and (not (input-pending-p)) (consp flyspell-changes))
903 (let ((start (car (car flyspell-changes))) 906 (let ((start (car (car flyspell-changes)))
904 (stop (cdr (car flyspell-changes)))) 907 (stop (cdr (car flyspell-changes))))
905 (if (flyspell-check-changed-word-p start stop) 908 (if (flyspell-check-changed-word-p start stop)
@@ -1011,7 +1014,7 @@ Mostly we check word delimiters."
1011 ;; when emacs is exited without query 1014 ;; when emacs is exited without query
1012 (set-process-query-on-exit-flag ispell-process nil) 1015 (set-process-query-on-exit-flag ispell-process nil)
1013 ;; Wait until ispell has processed word. Since this code is often 1016 ;; Wait until ispell has processed word. Since this code is often
1014 ;; executed rom post-command-hook but the ispell process may not 1017 ;; executed from post-command-hook but the ispell process may not
1015 ;; be responsive, it's important to make sure we re-enable C-g. 1018 ;; be responsive, it's important to make sure we re-enable C-g.
1016 (with-local-quit 1019 (with-local-quit
1017 (while (progn 1020 (while (progn
diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el
index 0dcde3d69d5..bec088e2a1d 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.20 8;; Version: 3.21
9;; 9;;
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11;; 11;;
@@ -76,10 +76,17 @@
76;; The documentation of Org-mode can be found in the TeXInfo file. The 76;; The documentation of Org-mode can be found in the TeXInfo file. The
77;; distribution also contains a PDF version of it. At the homepage of 77;; distribution also contains a PDF version of it. At the homepage of
78;; Org-mode, you can read the same text online as HTML. There is also an 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;; excellent reference card made by Philip Rooke. This card can be found
80;; in the etc/ directory of Emacs 22.
80;; 81;;
81;; Changes: 82;; Changes:
82;; ------- 83;; -------
84;; Version 3.21
85;; - Improved CSS support for the HTML export. Thanks to Christian Egli.
86;; - Editing support for hand-formatted lists
87;; - M-S-cursor keys handle plain list items
88;; - C-c C-c renumbers ordered plain lists
89;;
83;; Version 3.20 90;; Version 3.20
84;; - There is finally an option to make TAB jump over horizontal lines 91;; - There is finally an option to make TAB jump over horizontal lines
85;; in tables instead of creating a new line before that line. 92;; in tables instead of creating a new line before that line.
@@ -88,7 +95,7 @@
88;; - Changes to the HTML exporter 95;; - Changes to the HTML exporter
89;; - hand-formatted lists are exported correctly, similar to 96;; - hand-formatted lists are exported correctly, similar to
90;; markdown lists. Nested lists are possible. See the docstring 97;; markdown lists. Nested lists are possible. See the docstring
91;; of the variable `org-export-local-list-max-depth'. 98;; of the variable `org-export-plain-list-max-depth'.
92;; - cleaned up to produce valid HTML 4.0 (transitional). 99;; - cleaned up to produce valid HTML 4.0 (transitional).
93;; - support for cascading style sheets. 100;; - support for cascading style sheets.
94;; - New command to cycle through all agenda files, on C-, 101;; - New command to cycle through all agenda files, on C-,
@@ -234,7 +241,7 @@
234 241
235;;; Customization variables 242;;; Customization variables
236 243
237(defvar org-version "3.20" 244(defvar org-version "3.21"
238 "The version number of the file org.el.") 245 "The version number of the file org.el.")
239(defun org-version () 246(defun org-version ()
240 (interactive) 247 (interactive)
@@ -889,6 +896,25 @@ first line, so it is probably best to use this in combinations with
889 :group 'org-structure 896 :group 'org-structure
890 :type 'boolean) 897 :type 'boolean)
891 898
899(defcustom org-plain-list-ordered-item-terminator t
900 "The character that makes a line with leading number an ordered list item.
901Valid values are ?. and ?\). To get both terminators, use t. While
902?. may look nicer, it creates the danger that a line with leading
903number may be incorrectly interpreted as an item. ?\) therefore is
904the safe choice."
905 :group 'org-structure
906 :type '(choice (const :tag "dot like in \"2.\"" ?.)
907 (const :tag "paren like in \"2)\"" ?\))
908 (const :tab "both" t)))
909
910(defcustom org-auto-renumber-ordered-lists t
911 "Non-nil means, automatically renumber ordered plain lists.
912Renumbering happens when the sequence have been changed with
913\\[org-shiftmetaup] or \\[org-shiftmetadown]. After other editing commands,
914use \\[org-ctrl-c-ctrl-c] to trigger renumbering."
915 :group 'org-structure
916 :type 'boolean)
917
892(defgroup org-link nil 918(defgroup org-link nil
893 "Options concerning links in Org-mode." 919 "Options concerning links in Org-mode."
894 :tag "Org Link" 920 :tag "Org Link"
@@ -1342,24 +1368,48 @@ This should have an association in `org-export-language-setup'."
1342 :group 'org-export 1368 :group 'org-export
1343 :type 'string) 1369 :type 'string)
1344 1370
1345(defcustom org-export-html-style "" 1371(defcustom org-export-html-style
1372"<style type=\"text/css\">
1373 html {
1374 font-family: Times, serif;
1375 font-size: 12pt;
1376 }
1377 .title { text-align: center; }
1378 .todo, .deadline { color: red; }
1379 .done { color: green; }
1380 pre {
1381 border: 1pt solid #AEBDCC;
1382 background-color: #F3F5F7;
1383 padding: 5pt;
1384 font-family: courier, monospace;
1385 }
1386 table { border-collapse: collapse; }
1387 td, th {
1388 vertical-align: top;
1389 border: 1pt solid #ADB9CC;
1390 }
1391</style>"
1346 "The default style specification for exported HTML files. 1392 "The default style specification for exported HTML files.
1347Since there are different ways of setting style information, this variable 1393Since there are different ways of setting style information, this variable
1348needs to contain the full HTML structure to provide a style, including the 1394needs to contain the full HTML structure to provide a style, including the
1349surrounding HTML tags. For example, legal values would be 1395surrounding HTML tags. The style specifications should include definiitons
1396for new classes todo, done, title, and deadline. For example, legal values
1397would be.
1350 1398
1351 <style type=\"text/css\"> 1399 <style type=\"text/css\">
1352 p {font-weight: normal; color: gray; } 1400 p {font-weight: normal; color: gray; }
1353 h1 {color: black; } 1401 h1 {color: black; }
1402 .title { text-align: center; }
1403 .todo, .deadline { color: red; }
1404 .done { color: green; }
1354 </style> 1405 </style>
1355 1406
1356or 1407or, if you want to keep the style in a file,
1357 1408
1358 <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\"> 1409 <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\">
1359 1410
1360As the value of this option simply gets inserted into the HTML <head> header, 1411As the value of this option simply gets inserted into the HTML <head> header,
1361you can \"misuse\" it to add arbitrary text to the header. 1412you can \"misuse\" it to add arbitrary text to the header."
1362"
1363 :group 'org-export 1413 :group 'org-export
1364 :type 'string) 1414 :type 'string)
1365 1415
@@ -1393,18 +1443,16 @@ This option can also be set with the +OPTIONS line, e.g. \"toc:nil\"."
1393 :group 'org-export 1443 :group 'org-export
1394 :type 'boolean) 1444 :type 'boolean)
1395 1445
1396(defcustom org-export-local-list-max-depth 1 1446(defcustom org-export-plain-list-max-depth 3
1397 "Maximum depth of hand-formatted lists in HTML export. 1447 "Maximum depth of hand-formatted lists in HTML export.
1448
1398Org-mode parses hand-formatted enumeration and bullet lists and 1449Org-mode parses hand-formatted enumeration and bullet lists and
1399transforms them to HTML open export. Different indentation of the bullet 1450transforms them to HTML open export. Different indentation of the
1400or number indicates different list nesting levels. To avoid confusion, 1451bullet or number indicates different list nesting levels. To avoid
1401only a single level is allowed by default. This means that a list is started 1452confusion, only a single level is allowed by default. When this is
1402with an item, and that all further items are consitered as long as the 1453larger than 1, deeper indentation leads to deeper list nesting. For
1403indentation is larger or equal to the indentation of the first item. When this 1454example, the default value of 3 allows the following list to be
1404is larger than 1, deeper indentation leads to deeper list nesting. 1455formatted correctly in HTML:
1405If you are careful with hand formatting, you can increase this limit and
1406get lists of arbitrary depth. For example, by setting this option to 3, the
1407following list would look correct in HTML:
1408 1456
1409 * Fruit 1457 * Fruit
1410 - Apple 1458 - Apple
@@ -2757,6 +2805,234 @@ If optional TXT is given, check this string instead of the current kill."
2757 (throw 'exit nil))) 2805 (throw 'exit nil)))
2758 t)))) 2806 t))))
2759 2807
2808;;; Plain list item
2809
2810(defun org-at-item-p ()
2811 "Is point in a line starting a hand-formatted item?"
2812 (let ((llt org-plain-list-ordered-item-terminator))
2813 (save-excursion
2814 (goto-char (point-at-bol))
2815 (looking-at
2816 (cond
2817 ((eq llt t) "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
2818 ((= llt ?.) "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
2819 ((= llt ?\)) "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
2820 (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))))))
2821
2822(defun org-get-indentation ()
2823 "Get the indentation of the current line, ionterpreting tabs."
2824 (save-excursion
2825 (beginning-of-line 1)
2826 (skip-chars-forward " \t")
2827 (current-column)))
2828
2829(defun org-beginning-of-item ()
2830 "Go to the beginning of the current hand-formatted item.
2831If the cursor is not in an item, throw an error."
2832 (let ((pos (point))
2833 (limit (save-excursion (org-back-to-heading)
2834 (beginning-of-line 2) (point)))
2835 ind ind1)
2836 (if (org-at-item-p)
2837 (beginning-of-line 1)
2838 (beginning-of-line 1)
2839 (skip-chars-forward " \t")
2840 (setq ind (current-column))
2841 (if (catch 'exit
2842 (while t
2843 (beginning-of-line 0)
2844 (if (< (point) limit) (throw 'exit nil))
2845 (unless (looking-at " \t]*$")
2846 (skip-chars-forward " \t")
2847 (setq ind1 (current-column))
2848 (if (< ind1 ind)
2849 (throw 'exit (org-at-item-p))))))
2850 nil
2851 (goto-char pos)
2852 (error "Not in an item")))))
2853
2854(defun org-end-of-item ()
2855 "Go to the beginning of the current hand-formatted item.
2856If the cursor is not in an item, throw an error."
2857 (let ((pos (point))
2858 (limit (save-excursion (outline-next-heading) (point)))
2859 (ind (save-excursion
2860 (org-beginning-of-item)
2861 (skip-chars-forward " \t")
2862 (current-column)))
2863 ind1)
2864 (if (catch 'exit
2865 (while t
2866 (beginning-of-line 2)
2867 (if (>= (point) limit) (throw 'exit t))
2868 (unless (looking-at "[ \t]*$")
2869 (skip-chars-forward " \t")
2870 (setq ind1 (current-column))
2871 (if (<= ind1 ind) (throw 'exit t)))))
2872 (beginning-of-line 1)
2873 (goto-char pos)
2874 (error "Not in an item"))))
2875
2876(defun org-move-item-down (arg)
2877 "Move the plain list item at point down, i.e. swap with following item.
2878Subitems (items with larger indentation are considered part of the item,
2879so this really moves item trees."
2880 (interactive "p")
2881 (let (beg end ind ind1 (pos (point)) txt)
2882 (org-beginning-of-item)
2883 (setq beg (point))
2884 (setq ind (org-get-indentation))
2885 (org-end-of-item)
2886 (setq end (point))
2887 (setq ind1 (org-get-indentation))
2888 (if (and (org-at-item-p) (= ind ind1))
2889 (progn
2890 (org-end-of-item)
2891 (setq txt (buffer-substring beg end))
2892 (save-excursion
2893 (delete-region beg end))
2894 (setq pos (point))
2895 (insert txt)
2896 (goto-char pos)
2897 (org-maybe-renumber-ordered-list))
2898 (goto-char pos)
2899 (error "Cannot move this item further down"))))
2900
2901(defun org-move-item-up (arg)
2902 "Move the plain list item at point up, i.e. swap with previous item.
2903Subitems (items with larger indentation are considered part of the item,
2904so this really moves item trees."
2905 (interactive "p")
2906 (let (beg end ind ind1 (pos (point)) txt)
2907 (org-beginning-of-item)
2908 (setq beg (point))
2909 (setq ind (org-get-indentation))
2910 (org-end-of-item)
2911 (setq end (point))
2912 (goto-char beg)
2913 (catch 'exit
2914 (while t
2915 (beginning-of-line 0)
2916 (if (looking-at "[ \t]*$")
2917 nil
2918 (if (<= (setq ind1 (org-get-indentation)) ind)
2919 (throw 'exit t)))))
2920 (condition-case nil
2921 (org-beginning-of-item)
2922 (error (goto-char beg)
2923 (error "Cannot move this item further up")))
2924 (setq ind1 (org-get-indentation))
2925 (if (and (org-at-item-p) (= ind ind1))
2926 (progn
2927 (setq txt (buffer-substring beg end))
2928 (save-excursion
2929 (delete-region beg end))
2930 (setq pos (point))
2931 (insert txt)
2932 (goto-char pos)
2933 (org-maybe-renumber-ordered-list))
2934 (goto-char pos)
2935 (error "Cannot move this item further up"))))
2936
2937(defun org-maybe-renumber-ordered-list ()
2938 "Renumber the ordered list at point if setup allows it.
2939This tests the user option `org-auto-renumber-ordered-lists' before
2940doing the renumbering."
2941 (and org-auto-renumber-ordered-lists
2942 (org-at-item-p)
2943 (match-beginning 3)
2944 (org-renumber-ordered-list 1)))
2945
2946(defun org-get-string-indentation (s)
2947 "What indentation has S due to SPACE and TAB at the beginning of the string?"
2948 (let ((n -1) (i 0) (w tab-width) c)
2949 (catch 'exit
2950 (while (< (setq n (1+ n)) (length s))
2951 (setq c (aref s n))
2952 (cond ((= c ?\ ) (setq i (1+ i)))
2953 ((= c ?\t) (setq i (* (/ (+ w i) w) w)))
2954 (t (throw 'exit t)))))
2955 i))
2956
2957(defun org-renumber-ordered-list (arg)
2958 "Renumber an ordered plain list.
2959Cursor neext to be in the first line of an item, the line that starts
2960with something like \"1.\" or \"2)\"."
2961 (interactive "p")
2962 (unless (and (org-at-item-p)
2963 (match-beginning 3))
2964 (error "This is not an ordered list"))
2965 (let ((line (org-current-line))
2966 (col (current-column))
2967 (ind (org-get-string-indentation
2968 (buffer-substring (point-at-bol) (match-beginning 3))))
2969 (term (substring (match-string 3) -1))
2970 ind1 (n (1- arg)))
2971 ;; find where this list begins
2972 (catch 'exit
2973 (while t
2974 (catch 'next
2975 (beginning-of-line 0)
2976 (if (looking-at "[ \t]*$") (throw 'next t))
2977 (skip-chars-forward " \t") (setq ind1 (current-column))
2978 (if (and (<= ind1 ind)
2979 (not (org-at-item-p)))
2980 (throw 'exit t)))))
2981 ;; Walk forward and replace these numbers
2982 (catch 'exit
2983 (while t
2984 (catch 'next
2985 (beginning-of-line 2)
2986 (if (eobp) (throw 'exit nil))
2987 (if (looking-at "[ \t]*$") (throw 'next nil))
2988 (skip-chars-forward " \t") (setq ind1 (current-column))
2989 (if (> ind1 ind) (throw 'next t))
2990 (if (< ind1 ind) (throw 'exit t))
2991 (if (not (org-at-item-p)) (throw 'exit nil))
2992 (if (not (match-beginning 3))
2993 (error "unordered bullet in ordered list. Press \\[undo] to recover"))
2994 (delete-region (match-beginning 3) (1- (match-end 3)))
2995 (goto-char (match-beginning 3))
2996 (insert (format "%d" (setq n (1+ n)))))))
2997 (goto-line line)
2998 (move-to-column col)))
2999
3000(defvar org-last-indent-begin-marker (make-marker))
3001(defvar org-last-indent-end-marker (make-marker))
3002
3003
3004(defun org-outdent-item (arg)
3005 "Outdent a local list item."
3006 (interactive "p")
3007 (org-indent-item (- arg)))
3008
3009(defun org-indent-item (arg)
3010 "Indent a local list item."
3011 (interactive "p")
3012 (unless (org-at-item-p)
3013 (error "Not on an item"))
3014 (let (beg end ind ind1)
3015 (if (memq last-command '(org-shiftmetaright org-shiftmetaleft))
3016 (setq beg org-last-indent-begin-marker
3017 end org-last-indent-end-marker)
3018 (org-beginning-of-item)
3019 (setq beg (move-marker org-last-indent-begin-marker (point)))
3020 (org-end-of-item)
3021 (setq end (move-marker org-last-indent-end-marker (point))))
3022 (goto-char beg)
3023 (skip-chars-forward " \t") (setq ind (current-column))
3024 (if (< (+ arg ind) 0) (error "Cannot outdent beyond margin"))
3025 (while (< (point) end)
3026 (beginning-of-line 1)
3027 (skip-chars-forward " \t") (setq ind1 (current-column))
3028 (delete-region (point-at-bol) (point))
3029 (indent-to-column (+ ind1 arg))
3030 (beginning-of-line 2))
3031 (goto-char beg)))
3032
3033
3034;;; Archiving
3035
2760(defun org-archive-subtree () 3036(defun org-archive-subtree ()
2761 "Move the current subtree to the archive. 3037 "Move the current subtree to the archive.
2762The archive can be a certain top-level heading in the current file, or in 3038The archive can be a certain top-level heading in the current file, or in
@@ -8985,6 +9261,7 @@ headlines. The default is 3. Lower levels will become bulleted lists."
8985 (in-local-list nil) 9261 (in-local-list nil)
8986 (local-list-num nil) 9262 (local-list-num nil)
8987 (local-list-indent nil) 9263 (local-list-indent nil)
9264 (llt org-plain-list-ordered-item-terminator)
8988 (email user-mail-address) 9265 (email user-mail-address)
8989 (language org-export-default-language) 9266 (language org-export-default-language)
8990 (text nil) 9267 (text nil)
@@ -9039,7 +9316,7 @@ headlines. The default is 3. Lower levels will become bulleted lists."
9039" 9316"
9040 language (org-html-expand title) (or charset "iso-8859-1") 9317 language (org-html-expand title) (or charset "iso-8859-1")
9041 date time author style)) 9318 date time author style))
9042 (if title (insert (concat "<H1 align=\"center\">" 9319 (if title (insert (concat "<H1 class=\"title\">"
9043 (org-html-expand title) "</H1>\n"))) 9320 (org-html-expand title) "</H1>\n")))
9044 (if author (insert (concat (nth 1 lang-words) ": " author "\n"))) 9321 (if author (insert (concat (nth 1 lang-words) ": " author "\n")))
9045 (if email (insert (concat "<a href=\"mailto:" email "\">&lt;" 9322 (if email (insert (concat "<a href=\"mailto:" email "\">&lt;"
@@ -9089,7 +9366,7 @@ headlines. The default is 3. Lower levels will become bulleted lists."
9089 (insert 9366 (insert
9090 (format 9367 (format
9091 (if todo 9368 (if todo
9092 "<li><a href=\"#sec-%d\"><span style='color:red'>%s</span></a>\n" 9369 "<li><a href=\"#sec-%d\"><span class=\"todo\">%s</span></a>\n"
9093 "<li><a href=\"#sec-%d\">%s</a>\n") 9370 "<li><a href=\"#sec-%d\">%s</a>\n")
9094 head-count txt)) 9371 head-count txt))
9095 (setq org-last-level level)) 9372 (setq org-last-level level))
@@ -9122,7 +9399,7 @@ headlines. The default is 3. Lower levels will become bulleted lists."
9122 (insert "<pre>\n")) 9399 (insert "<pre>\n"))
9123 (insert (org-html-protect (match-string 1 line)) "\n") 9400 (insert (org-html-protect (match-string 1 line)) "\n")
9124 (when (and lines 9401 (when (and lines
9125 (not (string-match "^[ \t]+\\(:.*\\)" 9402 (not (string-match "^[ \t]*\\(:.*\\)"
9126 (car lines)))) 9403 (car lines))))
9127 (setq infixed nil) 9404 (setq infixed nil)
9128 (insert "</pre>\n")) 9405 (insert "</pre>\n"))
@@ -9180,9 +9457,9 @@ headlines. The default is 3. Lower levels will become bulleted lists."
9180 (match-beginning 2)) 9457 (match-beginning 2))
9181 (if (equal (match-string 2 line) org-done-string) 9458 (if (equal (match-string 2 line) org-done-string)
9182 (setq line (replace-match 9459 (setq line (replace-match
9183 "<span style='color:green'>\\2</span>" 9460 "<span class=\"done\">\\2</span>"
9184 nil nil line 2)) 9461 nil nil line 2))
9185 (setq line (replace-match "<span style='color:red'>\\2</span>" 9462 (setq line (replace-match "<span class=\"todo\">\\2</span>"
9186 nil nil line 2)))) 9463 nil nil line 2))))
9187 9464
9188 ;; DEADLINES 9465 ;; DEADLINES
@@ -9192,9 +9469,8 @@ headlines. The default is 3. Lower levels will become bulleted lists."
9192 (string-match "<a href" 9469 (string-match "<a href"
9193 (substring line 0 (match-beginning 0)))) 9470 (substring line 0 (match-beginning 0))))
9194 nil ; Don't do the replacement - it is inside a link 9471 nil ; Don't do the replacement - it is inside a link
9195 (setq line (replace-match "<span style='color:red'>\\&</span>" 9472 (setq line (replace-match "<span class=\"deadline\">\\&</span>"
9196 nil nil line 1))))) 9473 nil nil line 1)))))
9197
9198 (cond 9474 (cond
9199 ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line) 9475 ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line)
9200 ;; This is a headline 9476 ;; This is a headline
@@ -9233,13 +9509,21 @@ headlines. The default is 3. Lower levels will become bulleted lists."
9233 (insert (org-format-table-html table-buffer table-orig-buffer)))) 9509 (insert (org-format-table-html table-buffer table-orig-buffer))))
9234 (t 9510 (t
9235 ;; Normal lines 9511 ;; Normal lines
9236 (when (and (> org-export-local-list-max-depth 0) 9512 (when (and (> org-export-plain-list-max-depth 0)
9237 (string-match 9513 (string-match
9238 "^\\( *\\)\\(\\([-+*]\\)\\|\\([0-9]+\\.\\)\\)? *\\([^ \t\n\r]\\)" 9514 (cond
9515 ((eq llt t) "^\\([ \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+[.)]\\)\\)?\\( +[^ \t\n\r]\\|[ \t]*$\\)")
9516 ((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+\\.\\)\\)?\\( +[^ \t\n\r]\\|[ \t]*$\\)")
9517 ((= llt ?\)) "^\\( \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+)\\)\\)?\\( +[^ \t\n\r]\\|[ \t]*$\\)")
9518 (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))
9239 line)) 9519 line))
9240 (setq ind (- (match-end 1) (match-beginning 1)) 9520 (setq ind (org-get-string-indentation line)
9241 start-is-num (match-beginning 4) 9521 start-is-num (match-beginning 4)
9242 starter (if (match-beginning 2) (match-string 2 line))) 9522 starter (if (match-beginning 2) (match-string 2 line))
9523 line (substring line (match-beginning 5)))
9524 (unless (string-match "[^ \t]" line)
9525 ;; empty line. Pretend indentation is large.
9526 (setq ind (1+ (or (car local-list-indent) 1))))
9243 (while (and in-local-list 9527 (while (and in-local-list
9244 (or (and (= ind (car local-list-indent)) 9528 (or (and (= ind (car local-list-indent))
9245 (not starter)) 9529 (not starter))
@@ -9247,13 +9531,12 @@ headlines. The default is 3. Lower levels will become bulleted lists."
9247 (insert (if (car local-list-num) "</ol>\n" "</ul>")) 9531 (insert (if (car local-list-num) "</ol>\n" "</ul>"))
9248 (pop local-list-num) (pop local-list-indent) 9532 (pop local-list-num) (pop local-list-indent)
9249 (setq in-local-list local-list-indent)) 9533 (setq in-local-list local-list-indent))
9250
9251 (cond 9534 (cond
9252 ((and starter 9535 ((and starter
9253 (or (not in-local-list) 9536 (or (not in-local-list)
9254 (> ind (car local-list-indent))) 9537 (> ind (car local-list-indent)))
9255 (< (length local-list-indent) 9538 (< (length local-list-indent)
9256 org-export-local-list-max-depth)) 9539 org-export-plain-list-max-depth))
9257 ;; Start new (level of ) list 9540 ;; Start new (level of ) list
9258 (insert (if start-is-num "<ol>\n<li>\n" "<ul>\n<li>\n")) 9541 (insert (if start-is-num "<ol>\n<li>\n" "<ul>\n<li>\n"))
9259 (push start-is-num local-list-num) 9542 (push start-is-num local-list-num)
@@ -9261,8 +9544,7 @@ headlines. The default is 3. Lower levels will become bulleted lists."
9261 (setq in-local-list t)) 9544 (setq in-local-list t))
9262 (starter 9545 (starter
9263 ;; continue current list 9546 ;; continue current list
9264 (insert "<li>\n"))) 9547 (insert "<li>\n"))))
9265 (setq line (substring line (match-beginning 5))))
9266 ;; Empty lines start a new paragraph. If hand-formatted lists 9548 ;; Empty lines start a new paragraph. If hand-formatted lists
9267 ;; are not fully interpreted, lines starting with "-", "+", "*" 9549 ;; are not fully interpreted, lines starting with "-", "+", "*"
9268 ;; also start a new paragraph. 9550 ;; also start a new paragraph.
@@ -9327,7 +9609,7 @@ headlines. The default is 3. Lower levels will become bulleted lists."
9327 (mapconcat (lambda (x) 9609 (mapconcat (lambda (x)
9328 (if head 9610 (if head
9329 (concat "<th>" x "</th>") 9611 (concat "<th>" x "</th>")
9330 (concat "<td valign=\"top\">" x "</td>"))) 9612 (concat "<td>" x "</td>")))
9331 fields "") 9613 fields "")
9332 "</tr>\n")))) 9614 "</tr>\n"))))
9333 (setq html (concat html "</table>\n")) 9615 (setq html (concat html "</table>\n"))
@@ -9366,10 +9648,8 @@ But it has the disadvantage, that no cell- or row-spanning is allowed."
9366 (lambda (x) 9648 (lambda (x)
9367 (if (equal x "") (setq x empty)) 9649 (if (equal x "") (setq x empty))
9368 (if head 9650 (if head
9369 (concat "<th valign=\"top\">" x 9651 (concat "<th>" x "</th>\n")
9370 "</th>\n") 9652 (concat "<td>" x "</td>\n")))
9371 (concat "<td valign=\"top\">" x
9372 "</td>\n")))
9373 field-buffer "\n") 9653 field-buffer "\n")
9374 "</tr>\n")) 9654 "</tr>\n"))
9375 (setq head nil) 9655 (setq head nil)
@@ -10016,6 +10296,7 @@ See the individual commands for more information."
10016 (cond 10296 (cond
10017 ((org-at-table-p) (org-table-delete-column)) 10297 ((org-at-table-p) (org-table-delete-column))
10018 ((org-on-heading-p) (org-promote-subtree)) 10298 ((org-on-heading-p) (org-promote-subtree))
10299 ((org-at-item-p) (call-interactively 'org-outdent-item))
10019 (t (org-shiftcursor-error)))) 10300 (t (org-shiftcursor-error))))
10020 10301
10021(defun org-shiftmetaright () 10302(defun org-shiftmetaright ()
@@ -10026,30 +10307,36 @@ See the individual commands for more information."
10026 (cond 10307 (cond
10027 ((org-at-table-p) (org-table-insert-column)) 10308 ((org-at-table-p) (org-table-insert-column))
10028 ((org-on-heading-p) (org-demote-subtree)) 10309 ((org-on-heading-p) (org-demote-subtree))
10310 ((org-at-item-p) (call-interactively 'org-indent-item))
10029 (t (org-shiftcursor-error)))) 10311 (t (org-shiftcursor-error))))
10030 10312
10031(defun org-shiftmetaup (&optional arg) 10313(defun org-shiftmetaup (&optional arg)
10032 "Move subtree up or kill table row. 10314 "Move subtree up or kill table row.
10033Calls `org-move-subtree-up' or `org-table-kill-row', depending on context. 10315Calls `org-move-subtree-up' or `org-table-kill-row' or
10034See the individual commands for more information." 10316`org-move-item-up' depending on context. See the individual commands
10317for more information."
10035 (interactive "P") 10318 (interactive "P")
10036 (cond 10319 (cond
10037 ((org-at-table-p) (org-table-kill-row)) 10320 ((org-at-table-p) (org-table-kill-row))
10038 ((org-on-heading-p) (org-move-subtree-up arg)) 10321 ((org-on-heading-p) (org-move-subtree-up arg))
10322 ((org-at-item-p) (org-move-item-up arg))
10039 (t (org-shiftcursor-error)))) 10323 (t (org-shiftcursor-error))))
10040(defun org-shiftmetadown (&optional arg) 10324(defun org-shiftmetadown (&optional arg)
10041 "Move subtree down or insert table row. 10325 "Move subtree down or insert table row.
10042Calls `org-move-subtree-down' or `org-table-insert-row', depending on context. 10326Calls `org-move-subtree-down' or `org-table-insert-row' or
10043See the individual commands for more information." 10327`org-move-item-down', depending on context. See the individual
10328commands for more information."
10044 (interactive "P") 10329 (interactive "P")
10045 (cond 10330 (cond
10046 ((org-at-table-p) (org-table-insert-row arg)) 10331 ((org-at-table-p) (org-table-insert-row arg))
10047 ((org-on-heading-p) (org-move-subtree-down arg)) 10332 ((org-on-heading-p) (org-move-subtree-down arg))
10333 ((org-at-item-p) (org-move-item-down arg))
10048 (t (org-shiftcursor-error)))) 10334 (t (org-shiftcursor-error))))
10049 10335
10050(defun org-metaleft (&optional arg) 10336(defun org-metaleft (&optional arg)
10051 "Promote heading or move table column to left. 10337 "Promote heading or move table column to left.
10052Calls `org-do-promote' or `org-table-move-column', depending on context. 10338Calls `org-do-promote' or `org-table-move-column', depending on context.
10339With no specific context, calls the Emacs default `backward-word'.
10053See the individual commands for more information." 10340See the individual commands for more information."
10054 (interactive "P") 10341 (interactive "P")
10055 (cond 10342 (cond
@@ -10060,6 +10347,7 @@ See the individual commands for more information."
10060(defun org-metaright (&optional arg) 10347(defun org-metaright (&optional arg)
10061 "Demote subtree or move table column to right. 10348 "Demote subtree or move table column to right.
10062Calls `org-do-demote' or `org-table-move-column', depending on context. 10349Calls `org-do-demote' or `org-table-move-column', depending on context.
10350With no specific context, calls the Emacs default `forward-word'.
10063See the individual commands for more information." 10351See the individual commands for more information."
10064 (interactive "P") 10352 (interactive "P")
10065 (cond 10353 (cond
@@ -10069,22 +10357,26 @@ See the individual commands for more information."
10069 10357
10070(defun org-metaup (&optional arg) 10358(defun org-metaup (&optional arg)
10071 "Move subtree up or move table row up. 10359 "Move subtree up or move table row up.
10072Calls `org-move-subtree-up' or `org-table-move-row', depending on context. 10360Calls `org-move-subtree-up' or `org-table-move-row' or
10073See the individual commands for more information." 10361`org-move-item-up', depending on context. See the individual commands
10362for more information."
10074 (interactive "P") 10363 (interactive "P")
10075 (cond 10364 (cond
10076 ((org-at-table-p) (org-table-move-row 'up)) 10365 ((org-at-table-p) (org-table-move-row 'up))
10077 ((org-on-heading-p) (org-move-subtree-up arg)) 10366 ((org-on-heading-p) (org-move-subtree-up arg))
10367 ((org-at-item-p) (org-move-item-up arg))
10078 (t (org-shiftcursor-error)))) 10368 (t (org-shiftcursor-error))))
10079 10369
10080(defun org-metadown (&optional arg) 10370(defun org-metadown (&optional arg)
10081 "Move subtree down or move table row down. 10371 "Move subtree down or move table row down.
10082Calls `org-move-subtree-down' or `org-table-move-row', depending on context. 10372Calls `org-move-subtree-down' or `org-table-move-row' or
10083See the individual commands for more information." 10373`org-move-item-down', depending on context. See the individual
10374commands for more information."
10084 (interactive "P") 10375 (interactive "P")
10085 (cond 10376 (cond
10086 ((org-at-table-p) (org-table-move-row nil)) 10377 ((org-at-table-p) (org-table-move-row nil))
10087 ((org-on-heading-p) (org-move-subtree-down arg)) 10378 ((org-on-heading-p) (org-move-subtree-down arg))
10379 ((org-at-item-p) (org-move-item-down arg))
10088 (t (org-shiftcursor-error)))) 10380 (t (org-shiftcursor-error))))
10089 10381
10090(defun org-shiftup (&optional arg) 10382(defun org-shiftup (&optional arg)
@@ -10153,6 +10445,8 @@ If the cursor is on a #+TBLFM line, re-apply the formulae to the table."
10153 (org-table-recalculate t) 10445 (org-table-recalculate t)
10154 (org-table-maybe-recalculate-line)) 10446 (org-table-maybe-recalculate-line))
10155 (org-table-align)) 10447 (org-table-align))
10448 ((org-at-item-p)
10449 (org-renumber-ordered-list (prefix-numeric-value arg)))
10156 ((save-excursion (beginning-of-line 1) (looking-at "#\\+\\([A-Z]+\\)")) 10450 ((save-excursion (beginning-of-line 1) (looking-at "#\\+\\([A-Z]+\\)"))
10157 (cond 10451 (cond
10158 ((equal (match-string 1) "TBLFM") 10452 ((equal (match-string 1) "TBLFM")
@@ -10165,11 +10459,13 @@ If the cursor is on a #+TBLFM line, re-apply the formulae to the table."
10165 (org-mode-restart)))) 10459 (org-mode-restart))))
10166 ((org-region-active-p) 10460 ((org-region-active-p)
10167 (org-table-convert-region (region-beginning) (region-end) arg)) 10461 (org-table-convert-region (region-beginning) (region-end) arg))
10168 ((and (region-beginning) (region-end)) 10462 ((condition-case nil
10463 (and (region-beginning) (region-end))
10464 (error nil))
10169 (if (y-or-n-p "Convert inactive region to table? ") 10465 (if (y-or-n-p "Convert inactive region to table? ")
10170 (org-table-convert-region (region-beginning) (region-end) arg) 10466 (org-table-convert-region (region-beginning) (region-end) arg)
10171 (error "Abort"))) 10467 (error "Abort")))
10172 (t (error "No table at point, and no region to make one"))))) 10468 (t (error "C-c C-c can do nothing useful at this location.")))))
10173 10469
10174(defun org-mode-restart () 10470(defun org-mode-restart ()
10175 "Restart Org-mode, to scan again for special lines. 10471 "Restart Org-mode, to scan again for special lines.
@@ -10436,7 +10732,7 @@ With optional NODE, go directly to that node."
10436 (set (make-local-variable 'paragraph-separate) "\f\\|\\*\\|[ ]*$\\|[ \t]*[:|]") 10732 (set (make-local-variable 'paragraph-separate) "\f\\|\\*\\|[ ]*$\\|[ \t]*[:|]")
10437 ;; The paragraph starter includes hand-formatted lists. 10733 ;; The paragraph starter includes hand-formatted lists.
10438 (set (make-local-variable 'paragraph-start) 10734 (set (make-local-variable 'paragraph-start)
10439 "\f\\|[ ]*$\\|\\([*\f]+\\)\\|[ \t]*\\([-+*]\\|[0-9]+\\.[ \t]+\\)\\|[ \t]*[:|]") 10735 "\f\\|[ ]*$\\|\\([*\f]+\\)\\|[ \t]*\\([-+*]\\|[0-9]+[.)][ \t]+\\)\\|[ \t]*[:|]")
10440 ;; Inhibit auto-fill for headers, tables and fixed-width lines. 10736 ;; Inhibit auto-fill for headers, tables and fixed-width lines.
10441 ;; But only if the user has not turned off tables or fixed-width regions 10737 ;; But only if the user has not turned off tables or fixed-width regions
10442 (set (make-local-variable 'auto-fill-inhibit-regexp) 10738 (set (make-local-variable 'auto-fill-inhibit-regexp)
@@ -10472,7 +10768,7 @@ With optional NODE, go directly to that node."
10472 "Return a fill prefix for org-mode files. 10768 "Return a fill prefix for org-mode files.
10473In particular, this makes sure hanging paragraphs for hand-formatted lists 10769In particular, this makes sure hanging paragraphs for hand-formatted lists
10474work correctly." 10770work correctly."
10475 (if (looking-at " *\\([-*+] \\|[0-9]+\\. \\)?") 10771 (if (looking-at " *\\([-*+] \\|[0-9]+[.)] \\)?")
10476 (make-string (- (match-end 0) (match-beginning 0)) ?\ ))) 10772 (make-string (- (match-end 0) (match-beginning 0)) ?\ )))
10477 10773
10478;; Functions needed for Emacs/XEmacs region compatibility 10774;; Functions needed for Emacs/XEmacs region compatibility
@@ -10707,3 +11003,4 @@ Show the heading too, if it is currently invisible."
10707;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd 11003;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd
10708;;; org.el ends here 11004;;; org.el ends here
10709 11005
11006
diff --git a/lisp/view.el b/lisp/view.el
index 0d6b941a0ca..4cbc0fe9e4c 100644
--- a/lisp/view.el
+++ b/lisp/view.el
@@ -93,6 +93,12 @@ considered for restoring."
93 :type 'boolean 93 :type 'boolean
94 :group 'view) 94 :group 'view)
95 95
96(defcustom view-inhibit-help-message nil
97 "*Non-nil inhibits the help message showed upon entering View mode."
98 :type 'boolean
99 :group 'view
100 :version "22.1")
101
96;;;###autoload 102;;;###autoload
97(defvar view-mode nil 103(defvar view-mode nil
98 "Non-nil if View mode is enabled. 104 "Non-nil if View mode is enabled.
@@ -516,9 +522,10 @@ This function runs the normal hook `view-mode-hook'."
516 (unless view-mode ; Do nothing if already in view mode. 522 (unless view-mode ; Do nothing if already in view mode.
517 (view-mode-enable) 523 (view-mode-enable)
518 (force-mode-line-update) 524 (force-mode-line-update)
519 (message "%s" 525 (unless view-inhibit-help-message
520 (substitute-command-keys "\ 526 (message "%s"
521View mode: type \\[help-command] for help, \\[describe-mode] for commands, \\[View-quit] to quit.")))) 527 (substitute-command-keys "\
528View mode: type \\[help-command] for help, \\[describe-mode] for commands, \\[View-quit] to quit.")))))
522 529
523(defun view-mode-exit (&optional return-to-alist exit-action all-win) 530(defun view-mode-exit (&optional return-to-alist exit-action all-win)
524 "Exit View mode in various ways, depending on optional arguments. 531 "Exit View mode in various ways, depending on optional arguments.
diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el
index c3eb9519ab1..1268994ba89 100644
--- a/lisp/xt-mouse.el
+++ b/lisp/xt-mouse.el
@@ -151,10 +151,12 @@
151 151
152 (set-terminal-parameter nil 'xterm-mouse-x x) 152 (set-terminal-parameter nil 'xterm-mouse-x x)
153 (set-terminal-parameter nil 'xterm-mouse-y y) 153 (set-terminal-parameter nil 'xterm-mouse-y y)
154 (if w 154 (setq
155 (list mouse (posn-at-x-y (- x left) (- y top) w t)) 155 last-input-event
156 (list mouse 156 (if w
157 (append (list nil 'menu-bar) (nthcdr 2 (posn-at-x-y x y w t))))))) 157 (list mouse (posn-at-x-y (- x left) (- y top) w t))
158 (list mouse
159 (append (list nil 'menu-bar) (nthcdr 2 (posn-at-x-y x y w t))))))))
158 160
159;;;###autoload 161;;;###autoload
160(define-minor-mode xterm-mouse-mode 162(define-minor-mode xterm-mouse-mode