aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorKaroly Lorentey2005-06-15 12:57:51 +0000
committerKaroly Lorentey2005-06-15 12:57:51 +0000
commitef85512e51f043d73788f00a2aed13cccde0682c (patch)
treefc1fa1378533250f260ef8eaa9a84ae882d9df84 /lisp
parent8736257554f49445f7b4402ac7a9436b38ce6452 (diff)
parentef88a9999004e6c26148c8d280d6a41f623d7249 (diff)
downloademacs-ef85512e51f043d73788f00a2aed13cccde0682c.tar.gz
emacs-ef85512e51f043d73788f00a2aed13cccde0682c.zip
Merged from miles@gnu.org--gnu-2005 (patch 80-82, 350-422)
Patches applied: * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-350 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-351 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-352 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-353 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-354 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-355 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-356 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-357 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-358 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-359 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-360 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-361 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-362 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-363 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-364 Remove "-face" suffix from widget faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-365 Remove "-face" suffix from custom faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-366 Remove "-face" suffix from change-log faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-367 Remove "-face" suffix from compilation faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-368 Remove "-face" suffix from diff-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-369 lisp/longlines.el (longlines-visible-face): Face removed * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-370 Remove "-face" suffix from woman faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-371 Remove "-face" suffix from whitespace-highlight face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-372 Remove "-face" suffix from ruler-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-373 Remove "-face" suffix from show-paren faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-374 Remove "-face" suffix from log-view faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-375 Remove "-face" suffix from smerge faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-376 Remove "-face" suffix from show-tabs faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-377 Remove "-face" suffix from highlight-changes faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-378 Remove "-face" suffix from and downcase info faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-379 Remove "-face" suffix from pcvs faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-380 Update uses of renamed pcvs faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-381 Tweak ChangeLog * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-382 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-383 Remove "-face" suffix from strokes-char face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-384 Remove "-face" suffix from compare-windows face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-385 Remove "-face" suffix from calendar faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-386 Remove "-face" suffix from diary-button face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-387 Remove "-face" suffix from testcover faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-388 Remove "-face" suffix from viper faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-389 Remove "-face" suffix from org faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-390 Remove "-face" suffix from sgml-namespace face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-391 Remove "-face" suffix from table-cell face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-392 Remove "-face" suffix from tex-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-393 Remove "-face" suffix from texinfo-heading face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-394 Remove "-face" suffix from flyspell faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-395 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-396 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-397 Remove "-face" suffix from gomoku faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-398 Remove "-face" suffix from mpuz faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-399 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-400 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-401 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-402 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-403 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-404 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-405 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-406 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-407 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-408 Remove "-face" suffix from Buffer-menu-buffer face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-409 Remove "-face" suffix from antlr-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-410 Remove "-face" suffix from ebrowse faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-411 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-412 Remove "-face" suffix from flymake faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-413 Remove "-face" suffix from idlwave faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-414 Remove "-face" suffix from sh-script faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-415 Remove "-face" suffix from vhdl-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-416 Update from CVS * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-417 Remove "-face" suffix from which-func face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-418 Remove "-face" suffix from cperl-mode faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-419 Remove "-face" suffix from ld-script faces * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-420 Fix cperl-mode font-lock problem * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-421 Tweak which-func face * miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-422 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-80 Merge from emacs--cvs-trunk--0 * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-81 Update from CVS * miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-82 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-350
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog1127
-rw-r--r--lisp/Makefile.in18
-rw-r--r--lisp/abbrev.el4
-rw-r--r--lisp/add-log.el56
-rw-r--r--lisp/bindings.el25
-rw-r--r--lisp/buff-menu.el6
-rw-r--r--lisp/calendar/calendar.el32
-rw-r--r--lisp/calendar/diary-lib.el8
-rw-r--r--lisp/calendar/todo-mode.el2
-rw-r--r--lisp/comint.el20
-rw-r--r--lisp/compare-w.el10
-rw-r--r--lisp/cus-edit.el174
-rw-r--r--lisp/cus-start.el2
-rw-r--r--lisp/cvs-status.el6
-rw-r--r--lisp/diff-mode.el79
-rw-r--r--lisp/dired.el2
-rw-r--r--lisp/ediff-diff.el62
-rw-r--r--lisp/ediff-help.el2
-rw-r--r--lisp/ediff-mult.el13
-rw-r--r--lisp/ediff.el2
-rw-r--r--lisp/emacs-lisp/bindat.el7
-rw-r--r--lisp/emacs-lisp/byte-run.el46
-rw-r--r--lisp/emacs-lisp/debug.el82
-rw-r--r--lisp/emacs-lisp/derived.el10
-rw-r--r--lisp/emacs-lisp/easy-mmode.el81
-rw-r--r--lisp/emacs-lisp/edebug.el43
-rw-r--r--lisp/emacs-lisp/ewoc.el36
-rw-r--r--lisp/emacs-lisp/lisp-mode.el3
-rw-r--r--lisp/emacs-lisp/testcover.el18
-rw-r--r--lisp/emulation/cua-base.el24
-rw-r--r--lisp/emulation/cua-gmrk.el9
-rw-r--r--lisp/emulation/cua-rect.el2
-rw-r--r--lisp/emulation/pc-select.el6
-rw-r--r--lisp/emulation/vi.el2
-rw-r--r--lisp/emulation/vip.el2
-rw-r--r--lisp/emulation/viper-cmd.el6
-rw-r--r--lisp/emulation/viper-init.el42
-rw-r--r--lisp/emulation/viper-keym.el19
-rw-r--r--lisp/emulation/viper.el7
-rw-r--r--lisp/eshell/esh-var.el2
-rw-r--r--lisp/faces.el52
-rw-r--r--lisp/files.el23
-rw-r--r--lisp/filesets.el4
-rw-r--r--lisp/font-core.el16
-rw-r--r--lisp/font-lock.el62
-rw-r--r--lisp/forms.el6
-rw-r--r--lisp/frame.el4
-rw-r--r--lisp/generic-x.el16
-rw-r--r--lisp/gnus/ChangeLog57
-rw-r--r--lisp/gnus/gnus-art.el37
-rw-r--r--lisp/gnus/gnus-sieve.el2
-rw-r--r--lisp/gnus/gnus-sum.el2
-rw-r--r--lisp/gnus/legacy-gnus-agent.el8
-rw-r--r--lisp/gnus/message.el4
-rw-r--r--lisp/gnus/nnfolder.el2
-rw-r--r--lisp/gnus/spam-stat.el4
-rw-r--r--lisp/hexl.el2
-rw-r--r--lisp/hilit-chg.el69
-rw-r--r--lisp/ido.el260
-rw-r--r--lisp/ielm.el4
-rw-r--r--lisp/info.el90
-rw-r--r--lisp/international/iso-cvt.el1
-rw-r--r--lisp/international/latexenc.el58
-rw-r--r--lisp/international/mule-cmds.el6
-rw-r--r--lisp/international/mule-diag.el4
-rw-r--r--lisp/international/ucs-tables.el2
-rw-r--r--lisp/isearchb.el4
-rw-r--r--lisp/iswitchb.el172
-rw-r--r--lisp/kmacro.el2
-rw-r--r--lisp/ledit.el2
-rw-r--r--lisp/loadup.el2
-rw-r--r--lisp/log-edit.el4
-rw-r--r--lisp/log-view.el12
-rw-r--r--lisp/longlines.el5
-rw-r--r--lisp/mail/mspools.el2
-rw-r--r--lisp/mail/rmailedit.el2
-rw-r--r--lisp/mail/supercite.el1
-rw-r--r--lisp/mail/undigest.el2
-rw-r--r--lisp/makefile.w32-in20
-rw-r--r--lisp/man.el12
-rw-r--r--lisp/menu-bar.el2
-rw-r--r--lisp/mh-e/ChangeLog4
-rw-r--r--lisp/mh-e/mh-mime.el2
-rw-r--r--lisp/mouse.el2
-rw-r--r--lisp/net/ange-ftp.el53
-rw-r--r--lisp/net/browse-url.el2
-rw-r--r--lisp/net/eudc-hotlist.el3
-rw-r--r--lisp/net/tramp.el4
-rw-r--r--lisp/obsolete/lazy-lock.el2
-rw-r--r--lisp/paren.el12
-rw-r--r--lisp/pcvs-defs.el4
-rw-r--r--lisp/pcvs-info.el44
-rw-r--r--lisp/pcvs.el8
-rw-r--r--lisp/play/blackbox.el6
-rw-r--r--lisp/play/doctor.el17
-rw-r--r--lisp/play/dunnet.el22
-rw-r--r--lisp/play/gomoku.el18
-rw-r--r--lisp/play/mpuz.el24
-rw-r--r--lisp/printing.el363
-rw-r--r--lisp/progmodes/ada-mode.el6
-rw-r--r--lisp/progmodes/antlr-mode.el94
-rw-r--r--lisp/progmodes/compile.el25
-rw-r--r--lisp/progmodes/cperl-mode.el113
-rw-r--r--lisp/progmodes/cpp.el4
-rw-r--r--lisp/progmodes/delphi.el4
-rw-r--r--lisp/progmodes/ebrowse.el46
-rw-r--r--lisp/progmodes/flymake.el18
-rw-r--r--lisp/progmodes/gdb-ui.el66
-rw-r--r--lisp/progmodes/gud.el28
-rw-r--r--lisp/progmodes/idlw-help.el8
-rw-r--r--lisp/progmodes/idlw-shell.el46
-rw-r--r--lisp/progmodes/idlwave.el826
-rw-r--r--lisp/progmodes/ld-script.el8
-rw-r--r--lisp/progmodes/make-mode.el118
-rw-r--r--lisp/progmodes/octave-inf.el2
-rw-r--r--lisp/progmodes/sh-script.el6
-rw-r--r--lisp/progmodes/sql.el2
-rw-r--r--lisp/progmodes/vhdl-mode.el240
-rw-r--r--lisp/progmodes/which-func.el33
-rw-r--r--lisp/ps-print.el6
-rw-r--r--lisp/recentf.el10
-rw-r--r--lisp/replace.el19
-rw-r--r--lisp/rfn-eshadow.el5
-rw-r--r--lisp/ruler-mode.el110
-rw-r--r--lisp/ses.el2
-rw-r--r--lisp/simple.el43
-rw-r--r--lisp/skeleton.el2
-rw-r--r--lisp/smerge-mode.el24
-rw-r--r--lisp/strokes.el8
-rw-r--r--lisp/subr.el61
-rw-r--r--lisp/tempo.el2
-rw-r--r--lisp/term.el52
-rw-r--r--lisp/term/x-win.el10
-rw-r--r--lisp/terminal.el2
-rw-r--r--lisp/textmodes/fill.el96
-rw-r--r--lisp/textmodes/flyspell.el292
-rw-r--r--lisp/textmodes/ispell.el27
-rw-r--r--lisp/textmodes/org.el935
-rw-r--r--lisp/textmodes/reftex-toc.el50
-rw-r--r--lisp/textmodes/reftex.el178
-rw-r--r--lisp/textmodes/sgml-mode.el6
-rw-r--r--lisp/textmodes/table.el10
-rw-r--r--lisp/textmodes/tex-mode.el32
-rw-r--r--lisp/textmodes/texinfo.el8
-rw-r--r--lisp/thumbs.el114
-rw-r--r--lisp/time.el4
-rw-r--r--lisp/tmm.el109
-rw-r--r--lisp/toolbar/gud-break.xpm2
-rw-r--r--lisp/toolbar/gud-cont.xpm2
-rw-r--r--lisp/toolbar/gud-down.xpm2
-rw-r--r--lisp/toolbar/gud-finish.xpm2
-rw-r--r--lisp/toolbar/gud-n.xpm2
-rw-r--r--lisp/toolbar/gud-ni.xpm2
-rw-r--r--lisp/toolbar/gud-print.xpm2
-rw-r--r--lisp/toolbar/gud-pstar.pbmbin0 -> 81 bytes
-rw-r--r--lisp/toolbar/gud-pstar.xpm29
-rw-r--r--lisp/toolbar/gud-remove.xpm2
-rw-r--r--lisp/toolbar/gud-run.xpm2
-rw-r--r--lisp/toolbar/gud-s.xpm2
-rw-r--r--lisp/toolbar/gud-si.xpm2
-rw-r--r--lisp/toolbar/gud-until.xpm2
-rw-r--r--lisp/toolbar/gud-up.xpm2
-rw-r--r--lisp/toolbar/gud-watch.xpm2
-rw-r--r--lisp/tooltip.el19
-rw-r--r--lisp/url/ChangeLog24
-rw-r--r--lisp/url/url-cookie.el4
-rw-r--r--lisp/url/url-dav.el35
-rw-r--r--lisp/url/url-file.el8
-rw-r--r--lisp/url/url-handlers.el3
-rw-r--r--lisp/url/url-history.el4
-rw-r--r--lisp/url/url-http.el5
-rw-r--r--lisp/url/url.el31
-rw-r--r--lisp/vc-arch.el6
-rw-r--r--lisp/vc.el6
-rw-r--r--lisp/vcursor.el2
-rw-r--r--lisp/whitespace.el28
-rw-r--r--lisp/wid-edit.el108
-rw-r--r--lisp/window.el8
-rw-r--r--lisp/woman.el151
-rw-r--r--lisp/xml.el60
180 files changed, 5304 insertions, 2891 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index c9c4d26844b..13d14707284 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,1121 @@
12005-06-15 Miles Bader <miles@gnu.org>
2
3 * progmodes/which-func.el (which-func): Only inherit
4 `font-lock-function-name-face' when that makes sense against the
5 default mode-line face, otherwise set the face color explicitly.
6
7 * progmodes/cperl-mode.el (cperl-init-faces): Use literal cperl
8 faces instead of (non-existent) variables.
9
102005-06-14 Miles Bader <miles@gnu.org>
11
12 * progmodes/ld-script.el (ld-script-location-counter):
13 Remove "-face" suffix from face name.
14 (ld-script-location-counter-face):
15 New backward-compatibility alias for renamed face.
16 (ld-script-location-counter-face): Use renamed face.
17
18 * progmodes/cperl-mode.el (cperl-nonoverridable, cperl-array)
19 (cperl-hash): Remove "-face" suffix from face names.
20 (cperl-nonoverridable-face, cperl-array-face, cperl-hash-face):
21 New backward-compatibility aliases for renamed faces.
22 (cperl-find-pods-heres, cperl-init-faces, cperl-ps-print-init)
23 (cperl-ps-print-face-properties): Use renamed cperl-mode faces.
24
25 * progmodes/which-func.el (which-func): Remove "-face" suffix from face
26 name.
27 (which-func-face): New backward-compatibility alias for renamed face.
28 (which-func-format): Use renamed which-func face.
29
30 * progmodes/vhdl-mode.el (vhdl-prompt, vhdl-attribute, vhdl-enumvalue)
31 (vhdl-function, vhdl-directive, vhdl-reserved-word)
32 (vhdl-translate-off): Remove "-face" suffix and "font-lock-" from face
33 names.
34 (vhdl-speedbar-entity, vhdl-speedbar-architecture)
35 (vhdl-speedbar-configuration, vhdl-speedbar-package)
36 (vhdl-speedbar-library, vhdl-speedbar-instantiation)
37 (vhdl-speedbar-subprogram, vhdl-speedbar-entity-selected)
38 (vhdl-speedbar-architecture-selected)
39 (vhdl-speedbar-configuration-selected)
40 (vhdl-speedbar-package-selected)
41 (vhdl-speedbar-instantiation-selected): Remove "-face" suffix from face
42 names.
43 (vhdl-font-lock-keywords-2, vhdl-font-lock-keywords-5):
44 Use renamed faces.
45 (vhdl-prompt-face, vhdl-attribute-face, vhdl-enumvalue-face)
46 (vhdl-function-face, vhdl-directive-face, vhdl-reserved-words-face)
47 (vhdl-translate-off-face): Variables renamed to remove "font-lock-".
48 Use renamed faces.
49 (syntax-alist): Don't use "font-lock-" or "-face" in generated face
50 names.
51 (vhdl-font-lock-init, vhdl-ps-print-settings): Use renamed faces.
52 (vhdl-speedbar-insert-hierarchy, vhdl-speedbar-expand-entity)
53 (vhdl-speedbar-expand-package, vhdl-speedbar-update-current-unit)
54 (vhdl-speedbar-make-inst-line, vhdl-speedbar-make-pack-line)
55 (vhdl-speedbar-make-subpack-line, vhdl-speedbar-make-subprogram-line)
56 (vhdl-speedbar-item-info, vhdl-speedbar-check-unit): Use renamed faces.
57
58 * progmodes/sh-script.el (sh-heredoc): Remove "-face" suffix from
59 face name.
60 (sh-heredoc-face): New backward-compatibility alias for renamed face.
61 (sh-heredoc-face): Use renamed sh-heredoc face.
62
63 * progmodes/idlw-help.el (idlwave-help-link):
64 Remove "-face" suffix from face name.
65 (idlwave-help-link-face):
66 New backward-compatibility alias for renamed face.
67 (idlwave-highlight-linked-completions): Use renamed idlwave-help faces.
68
69 * progmodes/idlw-shell.el (idlwave-shell-bp-face)
70 (idlwave-shell-disabled-bp): Remove "-face" suffix from face names.
71 (idlwave-shell-bp-face, idlwave-shell-disabled-bp):
72 New backward-compatibility aliases for renamed faces.
73 (idlwave-shell-disabled-breakpoint-face)
74 (idlwave-shell-breakpoint-face): Use renamed idlwave-shell faces.
75
76 * progmodes/flymake.el (flymake-errline, flymake-warnline):
77 Remove "-face" suffix from face names.
78 (flymake-errline-face, flymake-warnline-face):
79 New backward-compatibility aliases for renamed faces.
80 (flymake-highlight-line): Use renamed flymake faces.
81
82 * progmodes/ebrowse.el (ebrowse-tree-mark, ebrowse-root-class)
83 (ebrowse-file-name, ebrowse-default, ebrowse-member-attribute)
84 (ebrowse-member-class, ebrowse-progress):
85 Remove "-face" suffix from face names.
86 (ebrowse-tree-mark-face, ebrowse-root-class-face)
87 (ebrowse-file-name-face, ebrowse-default-face)
88 (ebrowse-member-attribute-face, ebrowse-member-class-face)
89 (ebrowse-progress-face):
90 New backward-compatibility aliases for renamed faces.
91 (ebrowse-show-progress, ebrowse-show-file-name-at-point)
92 (ebrowse-set-mark-props, ebrowse-draw-tree-fn)
93 (ebrowse-draw-member-buffer-class-line, ebrowse-draw-member-long-fn)
94 (ebrowse-draw-member-short-fn): Use renamed ebrowse faces.
95
96 * progmodes/antlr-mode.el (antlr-default, antlr-keyword, antlr-syntax)
97 (antlr-ruledef, antlr-tokendef, antlr-ruleref, antlr-tokenref)
98 (antlr-literal): Remove "-face" suffix and "font-lock-" from face
99 names.
100 (antlr-font-lock-default-face, antlr-font-lock-keyword-face)
101 (antlr-font-lock-syntax-face, antlr-font-lock-ruledef-face)
102 (antlr-font-lock-tokendef-face, antlr-font-lock-ruleref-face)
103 (antlr-font-lock-tokenref-face, antlr-font-lock-literal-face):
104 New backward-compatibility aliases for renamed faces.
105 (antlr-default-face, antlr-keyword-face, antlr-syntax-face)
106 (antlr-ruledef-face, antlr-tokendef-face, antlr-ruleref-face)
107 (antlr-tokenref-face, antlr-literal-face): Variables renamed to remove
108 "font-lock-". Use renamed antlr-mode faces.
109 (antlr-font-lock-additional-keywords): Use renamed faces.
110 Replace literal face-names with face variable references.
111
112 * buff-menu.el (Buffer-menu-buffer): Remove "-face" suffix from
113 face name.
114 (Buffer-menu-buffer-face): New backward-compatibility alias for
115 renamed face.
116 (list-buffers-noselect): Use renamed Buffer-menu-buffer face.
117
1182005-06-15 Daniel Pfeiffer <occitan@esperanto.org>
119
120 * progmodes/make-mode.el (makefile-space, makefile-makepp-perl):
121 Eliminate "-face" suffix.
122 (makefile-targets): Inherit font-lock-variable-name-face and
123 eliminate "-face" suffix.
124 (makefile-shell): Remove attributes and eliminate "-face" suffix.
125 (makefile-*-font-lock-keywords): Append makefile-targets in rule
126 actions, instead of prepending, to make it less visible.
127 (makefile-previous-dependency, makefile-match-dependency): Don't
128 match a target on a continuation line.
129
130 * files.el (auto-mode-alist): Put Makefile in gmake mode.
131
1322005-06-15 Nick Roberts <nickrob@snap.net.nz>
133
134 * progmodes/gdb-ui.el (gdb-tooltip-print): Respect
135 tooltip-use-echo-area.
136 (menu): Re-order menu items.
137
138 * progmodes/gud.el (tooltip-use-echo-area): Remove alias.
139 Define in tooltip.el.
140 (gud-tooltip-process-output): Respect tooltip-use-echo-area.
141 (gud-tooltip-tips): Respect tooltip-use-echo-area and
142 gud-tooltip-echo-area.
143
144 * tooltip.el (tooltip-use-echo-area): Restore from gud.el for
145 backward compatibility and make obsolete.
146 (tooltip-help-tips): Use tooltip-use-echo-area.
147 (tooltip-show-help-function): Rename to...
148 (tooltip-show-help): ...this, because it is a function.
149 (tooltip-mode, tooltip-help-message): Call tooltip-show-help.
150
1512005-06-14 Luc Teirlinck <teirllm@auburn.edu>
152
153 * emacs-lisp/edebug.el (edebug-all-defs, edebug-initial-mode)
154 (edebug-print-length, edebug-print-level, edebug-print-circle)
155 (edebug-modify-breakpoint, edebug-eval-last-sexp)
156 (edebug-eval-print-last-sexp): Doc fixes.
157
1582005-06-14 Kim F. Storm <storm@cua.dk>
159
160 * ido.el (ido-mode): Make a new keymap every time we enable ido,
161 as the coverage buffer/file/both may change.
162
1632005-06-14 Lute Kamstra <lute@gnu.org>
164
165 * net/ange-ftp.el (internal-ange-ftp-mode): Use delay-mode-hooks
166 and run-mode-hooks. Simplify.
167
168 * mail/rmailedit.el (rmail-edit-mode):
169 * progmodes/octave-inf.el (inferior-octave-mode):
170 * progmodes/sql.el (sql-interactive-mode): Use delay-mode-hooks.
171
172 * recentf.el (recentf-dialog-mode): Use kill-all-local-variables
173 and run-mode-hooks.
174 (recentf-edit-list, recentf-open-files): Don't call
175 kill-all-local-variables directly.
176
177 * emacs-lisp/debug.el (debug-on-entry): Fix docstring.
178
1792005-06-14 Juanma Barranquero <lekktu@gmail.com>
180
181 * emacs-lisp/byte-run.el (make-obsolete)
182 (define-obsolete-function-alias): Rename arguments FUNCTION and
183 NEW to OBSOLETE-NAME and CURRENT-NAME respectively.
184 (make-obsolete-variable, define-obsolete-variable-alias): Rename
185 arguments VARIABLE and NEW to OBSOLETE-NAME and CURRENT-NAME
186 respectively.
187
188 * isearchb.el (isearchb-activate):
189 * pcvs.el (cvs-mode):
190 * ses.el (ses-load):
191 * vc-arch.el (vc-arch-checkin, vc-arch-diff):
192 * net/tramp.el (tramp-find-file-exists-command)
193 (tramp-find-shell):
194 * progmodes/ada-mode.el (ada-create-case-exception)
195 (ada-create-case-exception-substring, ada-make-subprogram-body):
196 * progmodes/idlw-shell.el (idlwave-shell-move-to-bp):
197 * progmodes/idlwave.el (idlwave-complete-class-structure-tag-help):
198 * progmodes/vhdl-mode.el (vhdl-speedbar-place-component):
199 * textmodes/org.el (org-promote, org-evaluate-time-range)
200 (org-agenda-next-date-line, org-agenda-previous-date-line)
201 (org-agenda-error, org-open-at-point, org-table-move-row)
202 (org-format-table-table-html-using-table-generate-source)
203 (org-shiftcursor-error, org-ctrl-c-ctrl-c):
204 * textmodes/reftex.el (reftex-access-scan-info):
205 * textmodes/reftex-toc.el (reftex-toc-dframe-p)
206 (reftex-toc-promote-prepare): Follow error conventions.
207
208 * diff-mode.el (diff-mode): Fix typo in docstring.
209
210 * forms.el (forms--intuit-from-file): Fix reference to
211 `forms-number-of-fields' in error message.
212 (forms-print): Fix quoting in error message.
213
214 * forms.el (forms-mode):
215 * emulation/vi.el (vi-goto-insert-state):
216 * progmodes/flymake.el (flymake-new-err-info)
217 (flymake-start-syntax-check-for-current-buffer)
218 (flymake-simple-cleanup):
219 * eshell/esh-var.el (eshell/export):
220 * progmodes/gud.el (xdb):
221 * textmodes/flyspell.el (flyspell-incorrect-hook)
222 (flyspell-maybe-correct-transposition)
223 (flyspell-maybe-correct-doubling): Fix quoting in docstring.
224
2252005-06-13 Luc Teirlinck <teirllm@auburn.edu>
226
227 * emacs-lisp/debug.el (cancel-debug-on-entry): Mention default in
228 minibuffer prompt.
229
2302005-06-13 Kim F. Storm <storm@cua.dk>
231
232 * subr.el (add-to-ordered-list): New defun.
233
234 * emulation/cua-base.el (cua-mode): Use add-to-ordered-list to
235 add cua--keymap-alist to emulation-mode-map-alists.
236
2372005-06-13 Stefan Monnier <monnier@iro.umontreal.ca>
238
239 * subr.el (complete-in-turn): New macro.
240 (dynamic-completion-table, lazy-completion-table): Add debug info.
241
242 * faces.el (read-face-name): Use complete-in-turn complete non-aliases
243 in preference to face aliases.
244
245 * textmodes/fill.el (fill-match-adaptive-prefix): New function.
246 (fill-context-prefix): Use it to avoid guessing absurdly long prefixes.
247 Remove unused vars `start' and `firstline'.
248 (fill-nobreak-p): Fix line-move-invisible -> line-move-invisible-p.
249 (justify-current-line, fill-individual-paragraphs): Remove unused vars.
250
2512005-06-13 Eli Zaretskii <eliz@gnu.org>
252
253 * cus-start.el (all): Don't complain about missing GTK-related
254 variables, unless either `gtk' is boundp or this isn't a
255 `windows-nt' build.
256
2572005-06-13 Lute Kamstra <lute@gnu.org>
258
259 * abbrev.el (edit-abbrevs-mode): Use kill-all-local-variables and
260 run-mode-hooks.
261
262 * ediff-mult.el (ediff-meta-mode):
263 * ediff-util.el (ediff-mode): Use run-mode-hooks.
264
265 * ledit.el (ledit-mode): Use delay-mode-hooks.
266
267 * woman.el (woman-mode-line-format): Delete constant.
268 (woman-mode-map): Initialize it properly.
269 (woman-mode): Set mode-class property to special.
270 Use delay-mode-hooks and run-mode-hooks. Use the right keymap.
271 Set major-mode and mode-name. Don't set mode-line-format directly.
272 (Man-getpage-in-background): Don't reference woman-mode-line-format.
273
274 * emacs-lisp/debug.el (cancel-debug-on-entry): Make the empty
275 string argument obsolete.
276
2772005-06-13 Carsten Dominik <dominik@science.uva.nl>
278
279 * textmodes/org.el (org-CUA-compatible): New option.
280 (org-disputed-keys): New variable.
281 (org-key): New function.
282 (orgtbl-make-binding): Add docstring to the created function.
283 (org-mode): Set paragraph start/separate regexps.
284 (orgtbl-mode): Don't start `orgtbl-mode' in `org-mode' buffers.
285 (org-archive-location, org-archive-mark-done)
286 (org-archive-stamp-time): New options.
287 (org-archive-subtree): New command.
288 (org-fill-paragraph): New function.
289 (org-mode): Set `fill-paragraph-function' to `org-fill-paragraph'.
290 (org-fake-empty-table-line): Function removed.
291 (org-format-org-table-html): Do not create empty table lines at
292 separator lines. Improved table header treatment.
293 (org-link-format): New option.
294 (org-make-link): New function.
295 (org-insert-link, org-store-link): Use org-make-link.
296 (org-open-file): Quote file name for shell command, to allow
297 spaces in file names.
298 (org-link-regexp): Fix bug with mailto link.
299 (org-link-maybe-angles-regexp, org-protected-link-regexp):
300 New constants.
301 (org-export-as-html): Deal with the optional angles around a link.
302 Better treatment of file: links.
303 (org-open-at-point): Replace @{ and @} with < and >.
304 (org-run-mode-hooks): Function removed.
305 (org-agenda-mode): No longer use `org-run-mode-hooks'.
306
3072005-06-13 Nick Roberts <nickrob@snap.net.nz>
308
309 * progmodes/gdb-ui.el (gdb-registers-mode): Let gdbmi use
310 MI command -data-list-register-values.
311 (gdb-post-prompt): Indent properly.
312
3132005-06-13 Juanma Barranquero <lekktu@gmail.com>
314
315 * hilit-chg.el (highlight-changes-colors): Rename from
316 `highlight-changes-colours'.
317 (highlight-changes-colours): Keep as obsolete alias.
318 (highlight-changes-face-list): Doc fix.
319 (hilit-chg-make-list): Use `highlight-changes-colors'.
320
3212005-06-12 Mark A. Hershberger <mah@everybody.org>
322
323 * progmodes/cperl-mode.el (cperl-mode): Remove stray paren in
324 defun-prompt-regexp.
325
3262005-06-12 Eli Zaretskii <eliz@gnu.org>
327
328 * loadup.el: Don't say we are dumping under 2 names on windows-nt
329 and cygwin.
330
331 * makefile.w32-in (bootstrap-clean-CMD, bootstrap-clean-SH):
332 Don't use an old loaddefs.el, as in Makefile.in.
333
3342005-06-12 Lute Kamstra <lute@gnu.org>
335
336 * Makefile.in (bootstrap-prepare): Don't use an old loaddefs.el.
337
338 * man.el (Man-mode-map): Initialize it properly.
339 (Man-mode): Set mode-class property to special.
340
341 * calendar/calendar.el (calendar-mode): Use run-mode-hooks.
342
3432005-06-11 Luc Teirlinck <teirllm@auburn.edu>
344
345 * menu-bar.el (menu-bar-make-toggle): Remove stray backslash.
346 A newline is needed in the docstring there.
347
348 * emacs-lisp/debug.el (debug-on-entry, cancel-debug-on-entry):
349 Doc fixes.
350
3512005-06-11 Vinicius Jose Latorre <viniciusjl@ig.com.br>
352
353 * printing.el: Doc fix. The menubar is no more changed when printing
354 is loaded, it only changes when pr-menu-bind or pr-update-menus is
355 called. Now, the menubar changing will work in Emacs 20, 21 and 22.
356 (pr-version): New version number (6.8.4).
357 (pr-menu-bind): New command.
358 (pr-update-menus): Docstring and code fix.
359 (pr-menu-print-item): Now is a global var in Emacs and XEmacs.
360 Docstring fix.
361 (pr-txt-printer-alist, pr-ps-printer-alist, pr-gv-command)
362 (pr-gs-command, pr-gs-switches, pr-ps-utility-alist): Docstring fix.
363
3642005-06-11 Thien-Thi Nguyen <ttn@gnu.org>
365
366 * emacs-lisp/ewoc.el: Doc fixes for public funcs:
367 "Returns" to "return", document useful return values, etc.
368
3692005-06-11 Alan Mackenzie <acm@muc.de>
370
371 * fill.el (fill-context-prefix): Try `adaptive-fill-function'
372 BEFORE `adaptive-fill-regexp' when determining a fill prefix.
373 (adaptive-file-function): Minor amendment to doc-string.
374
3752005-06-11 Frederik Fouvry <fouvry@CoLi.Uni-SB.DE>
376
377 * thumbs.el (thumbs-per-line, thumbs-thumbsdir-max-size)
378 (thumbs-relief, thumbs-margin, thumbs-image-resizing-step):
379 Fix :type--it is `integer', not `string'.
380
381 * faces.el (modeline-highlight): Rename from (the erroneous)
382 `modeline-higilight'.
383
3842005-06-11 Lute Kamstra <lute@gnu.org>
385
386 * emacs-lisp/edebug.el (edebug-eval-mode-map): Don't copy
387 lisp-interaction-mode-map but make it the parent.
388 (edebug-eval-mode): Use define-derived-mode.
389
3902005-06-11 Andreas Schwab <schwab@suse.de>
391
392 * bindings.el: Add binding of `ESC functionkey' for every
393 `M-functionkey'.
394 * hexl.el (hexl-mode-map): Likewise.
395
3962005-06-10 Michael Hotchin <michael@hotchin.net> (tiny change)
397
398 * progmodes/compile.el (compilation-error-regexp-alist-alist)
399 [msft]: update regexp for newer msft compilers.
400
4012005-06-10 Mark A. Hershberger <mah@everybody.org>
402
403 * xml.el (start-chars, xml-parse-dtd): Add the ability to skip
404 ATTLIST portions of included DTDs.
405 (xml-parse-dtd): Eliminate use of inefficient match-data.
406
4072005-06-10 Miles Bader <miles@gnu.org>
408
409 * play/mpuz.el (mpuz-unsolved, mpuz-solved, mpuz-trivial)
410 (mpuz-text): Remove "-face" suffix from face names.
411 (mpuz-unsolved-face, mpuz-solved-face, mpuz-trivial-face)
412 (mpuz-text-face): New backward-compatibility aliases for renamed faces.
413 (mpuz-create-buffer, mpuz-paint-digit): Use renamed mpuz faces.
414
415 * play/gomoku.el (gomoku-O, gomoku-X):
416 Remove "-face" suffix from face names.
417 (gomoku-font-lock-O-face, gomoku-font-lock-X-face):
418 New backward-compatibility aliases for renamed faces.
419 (gomoku-font-lock-keywords): Use renamed gomoku faces.
420
4212005-06-10 Juanma Barranquero <lekktu@gmail.com>
422
423 * thumbs.el: Fixes for changes of 2005-06-09.
424 (thumbs-thumbsdir): Force `thumbs-thumbsdir' to be interpretable
425 as a directory.
426 (thumbs-thumbname): Remove directory separator from format string;
427 `thumbs-thumbsdir' now returns a valid directory name.
428 (thumbs-temp-dir): New defsubst.
429 (thumbs-temp-file, thumbs-resize-image, thumbs-modify-image):
430 Use it.
431
432 * cus-edit.el (minibuffer):
433 * files.el (make-backup-file-name-function):
434 * filesets.el (filesets-external-viewers):
435 * hilit-chg.el (highlight-changes-colours)
436 (highlight-changes-face-list, highlight-changes-rotate-faces):
437 * ielm.el (ielm-dynamic-return, inferior-emacs-lisp-mode):
438 * kmacro.el (kmacro-call-macro):
439 * log-edit.el (log-edit-changelog-full-paragraphs):
440 * mouse.el (mouse-1-click-follows-link):
441 * skeleton.el (skeleton-autowrap):
442 * subr.el (insert-for-yank-1):
443 * tempo.el (tempo-insert-region):
444 * terminal.el (terminal-emulator):
445 * time.el (display-time-mail-face):
446 * vc.el (vc-annotate):
447 * vcursor.el (vcursor-copy-line):
448 * woman.el (woman-bold-headings, woman-ignore)
449 (woman-default-faces, woman-monochrome-faces):
450 * calendar/todo-mode.el (todo-insert-threshold):
451 * emulation/pc-select.el (pc-select-selection-keys-only)
452 (pc-selection-mode):
453 * emulation/vip.el (vip-find-char-forward):
454 * emulation/viper-cmd.el (viper-find-char-forward):
455 * international/mule-cmds.el (select-safe-coding-system-accept-default-p)
456 (input-method-exit-on-invalid-key):
457 * international/mule-diag.el (describe-coding-system):
458 * international/ucs-tables.el (unify-8859-on-encoding-mode):
459 * net/browse-url.el (browse-url-xterm-program):
460 * obsolete/lazy-lock.el (lazy-lock-mode):
461 * progmodes/cperl-mode.el (cperl-info-on-command-no-prompt)
462 (cperl-mode):
463 * progmodes/cpp.el (cpp-face-light-name-list)
464 (cpp-face-dark-name-list):
465 * progmodes/delphi.el (delphi-newline-always-indents):
466 Fix spellings in docstrings.
467
468 * ido.el (ido-mode, ido-file-extensions-order)
469 (ido-default-file-method, ido-default-buffer-method)
470 (ido-max-prospects, ido-slow-ftp-hosts, ido-setup-hook)
471 (ido-decorations, ido-read-file-name-as-directory-commands)
472 (ido-read-file-name-non-ido, ido-work-directory-list)
473 (ido-ignore-item-temp-list, ido-current-directory)
474 (ido-magic-forward-char, ido-enter-find-file)
475 (ido-enter-switch-buffer, ido-visit-buffer, ido-switch-buffer)
476 (ido-find-file, ido-read-buffer): Fix typos in docstrings.
477
4782005-06-10 Lute Kamstra <lute@gnu.org>
479
480 * play/dunnet.el (dun-mode): Use define-derived-mode.
481 (dungeon-mode-map): Rename to dun-mode-map. Keep old name as an
482 obsolete alias.
483
484 * play/doctor.el (doctor-mode-map): Remove defvar.
485 (doctor-mode): Use define-derived-mode.
486
487 * mail/mspools.el (mspools-mode):
488 * net/eudc-hotlist.el (eudc-hotlist-mode):
489 * play/blackbox.el (blackbox-mode): Use run-mode-hooks.
490
4912005-06-10 Miles Bader <miles@gnu.org>
492
493 * textmodes/flyspell.el (flyspell-incorrect, flyspell-duplicate):
494 Remove "-face" suffix from face names.
495 (flyspell-incorrect-face, flyspell-duplicate-face):
496 New backward-compatibility aliases for renamed faces.
497 (flyspell-mode-on, make-flyspell-overlay)
498 (flyspell-highlight-incorrect-region)
499 (flyspell-highlight-duplicate-region)
500 (flyspell-display-next-corrections)
501 (flyspell-auto-correct-previous-word): Use renamed flyspell faces.
502
503 * textmodes/texinfo.el (texinfo-heading): Remove "-face" suffix
504 from face name.
505 (texinfo-heading-face): New backward-compatibility alias for
506 renamed face.
507 (texinfo-heading-face): Use renamed texinfo-heading face.
508
509 * textmodes/tex-mode.el (tex-math, tex-verbatim): Remove "-face"
510 suffix from face names.
511 (tex-math-face, tex-verbatim-face):
512 New backward-compatibility aliases for renamed faces.
513 (tex-math-face, tex-verbatim-face): Use renamed tex-mode faces.
514 (tex-insert-quote): Use `tex-verbatim-face' variable instead of
515 literal face name.
516
517 * textmodes/table.el (table-cell): Remove "-face" suffix from face
518 name.
519 (table-cell-face): New backward-compatibility alias for renamed face.
520 (table--put-cell-face-property, table--update-cell-face):
521 Use renamed table-cell face.
522
523 * textmodes/sgml-mode.el (sgml-namespace): Remove "-face" suffix
524 from face name.
525 (sgml-namespace-face): New backward-compatibility alias for
526 renamed face.
527 (sgml-namespace-face): Use renamed sgml-namespace face.
528
529 * textmodes/org.el (org-level-1, org-level-2, org-level-3)
530 (org-level-4, org-level-5, org-level-6, org-level-7)
531 (org-level-8, org-warning, org-headline-done)
532 (org-deadline-announce, org-scheduled-today)
533 (org-scheduled-previously, org-link, org-done, org-table)
534 (org-time-grid): Remove "-face" suffix from face names.
535 (org-level-1-face, org-level-2-face, org-level-3-face)
536 (org-level-4-face, org-level-5-face, org-level-6-face)
537 (org-level-7-face, org-level-8-face, org-warning-face)
538 (org-headline-done-face, org-deadline-announce-face)
539 (org-scheduled-today-face, org-scheduled-previously-face)
540 (org-link-face, org-done-face, org-table-face)
541 (org-time-grid-face):
542 New backward-compatibility aliases for renamed faces.
543 (org-level-faces, org-set-font-lock-defaults, org-timeline)
544 (org-agenda, org-agenda-get-todos, org-agenda-get-deadlines)
545 (org-agenda-get-timestamps, org-agenda-get-scheduled)
546 (org-agenda-add-time-grid-maybe, org-table-p): Use renamed org faces.
547
548 * emulation/viper-init.el (viper-search, viper-replace-overlay)
549 (viper-minibuffer-emacs, viper-minibuffer-insert)
550 (viper-minibuffer-vi): Remove "-face" suffix from face names.
551 (viper-search-face, viper-replace-overlay-face)
552 (viper-minibuffer-emacs-face, viper-minibuffer-insert-face)
553 (viper-minibuffer-vi-face):
554 New backward-compatibility aliases for renamed faces.
555 (viper-search-face, viper-replace-overlay-face)
556 (viper-minibuffer-emacs-face, viper-minibuffer-insert-face)
557 (viper-minibuffer-vi-face): Use renamed viper faces.
558
559 * emacs-lisp/testcover.el (testcover-nohits, testcover-1value):
560 Remove "-face" suffix from face names.
561 (testcover-nohits-face, testcover-1value-face):
562 New backward-compatibility aliases for renamed faces.
563 (testcover-mark): Use renamed testcover faces.
564
565 * calendar/diary-lib.el (diary-button): Remove "-face" suffix from
566 face name.
567 (diary-button-face): New backward-compatibility alias for renamed face.
568 (diary-entry): Use renamed diary-button face.
569
570 * calendar/calendar.el (diary, calendar-today, holiday)
571 (mark-visible-calendar-date): Remove "-face" suffix from face names.
572 (diary-face, calendar-today-face, holiday-face):
573 New backward-compatibility aliases for renamed faces.
574 (eval-after-load "facemenu", diary-entry-marker)
575 (calendar-today-marker, calendar-holiday-marker, diary-face):
576 Use renamed calendar faces.
577
578 * compare-w.el (compare-windows): Remove "-face" suffix from face name.
579 (compare-windows-face): New backward-compatibility alias for
580 renamed face.
581 (compare-windows-highlight): Use renamed compare-windows face.
582
583 * strokes.el (strokes-char): Remove "-face" suffix from face name.
584 (strokes-char-face): New backward-compatibility alias for renamed face.
585 (strokes-encode-buffer): Use renamed strokes-char face.
586
587 * pcvs-info.el (cvs-header, cvs-filename, cvs-unknown)
588 (cvs-handled, cvs-need-action, cvs-marked, cvs-msg):
589 Remove "-face" suffix from face names.
590 (cvs-header-face, cvs-filename-face, cvs-unknown-face)
591 (cvs-handled-face, cvs-need-action-face, cvs-marked-face)
592 (cvs-msg-face): New backward-compatibility aliases for renamed faces.
593 (cvs-fi-up-to-date-face, cvs-fi-unknown-face, cvs-fileinfo-pp):
594 Use renamed pcvs faces.
595 * pcvs.el (cvs-mode-find-file): Use renamed pcvs faces.
596 * pcvs-defs.el (cvs-mode-map): Likewise.
597 * cvs-status.el (cvs-status-font-lock-keywords): Likewise.
598
599 * info.el (info-title-1, info-title-2, info-title-3)
600 (info-title-4): Remove "-face" suffix from and downcase face names.
601 (Info-title-1-face, Info-title-2-face, Info-title-3-face)
602 (Info-title-4-face):
603 New backward-compatibility aliases for renamed faces.
604 (Info-fontify-node): Use renamed info faces.
605
606 * hilit-chg.el (highlight-changes, highlight-changes-delete):
607 Remove "-face" suffix from face names.
608 (highlight-changes-face, highlight-changes-delete-face):
609 New backward-compatibility aliases for renamed faces.
610 (hilit-chg-cust-fix-changes-face-list, hilit-chg-make-ov)
611 (hilit-chg-make-list): Use renamed highlight-changes faces.
612
613 * generic-x.el (show-tabs-tab, show-tabs-space):
614 Remove "-face" suffix from face names.
615 (show-tabs-tab-face, show-tabs-space-face):
616 New backward-compatibility aliases for renamed faces.
617 (show-tabs-generic-mode-font-lock-defaults-1)
618 (show-tabs-generic-mode-font-lock-defaults-2):
619 Use renamed show-tabs faces.
620
621 * smerge-mode.el (smerge-mine, smerge-other, smerge-base)
622 (smerge-markers): Remove "-face" suffix from face names.
623 (smerge-mine-face, smerge-other-face, smerge-base-face)
624 (smerge-markers-face):
625 New backward-compatibility aliases for renamed faces.
626 (smerge-mine-face, smerge-other-face, smerge-base-face)
627 (smerge-markers-face): Use renamed smerge faces.
628
629 * log-view.el (log-view-file, log-view-message):
630 Remove "-face" suffix from face names.
631 (log-view-file-face, log-view-message-face):
632 New backward-compatibility aliases for renamed faces.
633 (log-view-file-face, log-view-message-face): Use renamed log-view faces.
634
635 * paren.el (show-paren-match, show-paren-mismatch):
636 Remove "-face" suffix from face names.
637 (show-paren-match-face, show-paren-mismatch-face):
638 New backward-compatibility aliases for renamed faces.
639 (show-paren-function): Use renamed show-paren faces.
640
641 * ruler-mode.el (ruler-mode-default, ruler-mode-pad)
642 (ruler-mode-margins, ruler-mode-fringes)
643 (ruler-mode-column-number, ruler-mode-fill-column)
644 (ruler-mode-comment-column, ruler-mode-goal-column)
645 (ruler-mode-tab-stop, ruler-mode-current-column):
646 Remove "-face" suffix from face names.
647 (ruler-mode-default-face, ruler-mode-pad-face)
648 (ruler-mode-margins-face, ruler-mode-fringes-face)
649 (ruler-mode-column-number-face, ruler-mode-fill-column-face)
650 (ruler-mode-comment-column-face, ruler-mode-goal-column-face)
651 (ruler-mode-tab-stop-face, ruler-mode-current-column-face):
652 New backward-compatibility aliases for renamed faces.
653 (ruler-mode-pad, ruler-mode-margins, ruler-mode-fringes)
654 (ruler-mode-column-number, ruler-mode-fill-column)
655 (ruler-mode-comment-column, ruler-mode-goal-column)
656 (ruler-mode-tab-stop, ruler-mode-current-column)
657 (ruler-mode-mouse-grab-any-column, ruler-mode-ruler): Use renamed faces.
658
659 * whitespace.el (whitespace-highlight): Remove "-face" suffix from
660 face name.
661 (whitespace-highlight-the-space): Use renamed face.
662 (whitespace-highlight-face): New backward-compatibility alias for
663 renamed face.
664
665 * woman.el (woman-italic, woman-bold, woman-unknown)
666 (woman-addition, woman-symbol-face):
667 Remove "-face" suffix from face names.
668 (woman-italic-face, woman-bold-face, woman-unknown-face)
669 (woman-addition-face):
670 New backward-compatibility aliases for renamed faces.
671 (woman-default-faces, woman-monochrome-faces, woman-man-buffer)
672 (woman-decode-region, woman-replace-match)
673 (woman-display-extended-fonts, woman-special-characters)
674 (woman-font-alist, woman-change-fonts, woman2-TH, woman2-SH):
675 Use renamed woman faces.
676
677 * longlines.el (longlines-visible-face): Face removed.
678
679 * diff-mode.el (diff-header, diff-file-header, diff-index)
680 (diff-hunk-header, diff-removed, diff-added, diff-changed)
681 (diff-function, diff-context, diff-nonexistent): Remove "-face"
682 suffix from face names.
683 (diff-header-face, diff-file-header-face, diff-index-face)
684 (diff-hunk-header-face, diff-removed-face, diff-added-face)
685 (diff-changed-face, diff-function-face, diff-context-face)
686 (diff-nonexistent-face): New backward-compatibility aliases for
687 renamed faces.
688 (diff-header-face, diff-file-header-face)
689 (diff-index, diff-index-face, diff-hunk-header)
690 (diff-hunk-header-face, diff-removed, diff-removed-face)
691 (diff-added, diff-added-face, diff-changed-face, diff-function)
692 (diff-function-face, diff-context-face, diff-nonexistent)
693 (diff-nonexistent-face): Use renamed diff-mode faces.
694
695 * progmodes/compile.el (compilation-warning-face)
696 (compilation-info-face): Remove "-face" suffix from face names.
697 (compilation-warning-face, compilation-info-face):
698 New backward-compatibility aliases for renamed faces.
699 (compilation-warning-face, compilation-info-face):
700 Use renamed compilation faces.
701
702 * add-log.el (change-log-date, change-log-name)
703 (change-log-email, change-log-file, change-log-list)
704 (change-log-conditionals, change-log-function)
705 (change-log-acknowledgement): Remove "-face" suffix from face names.
706 (change-log-date-face, change-log-name-face)
707 (change-log-email-face, change-log-file-face)
708 (change-log-list-face, change-log-conditionals-face)
709 (change-log-function-face, change-log-acknowledgement-face):
710 New backward-compatibility aliases for renamed faces.
711 (change-log-font-lock-keywords): Use renamed change-log faces.
712
713 * cus-edit.el (custom-invalid, custom-rogue, custom-modified)
714 (custom-set, custom-changed, custom-saved, custom-button)
715 (custom-button-pressed, custom-documentation, custom-state)
716 (custom-comment, custom-comment-tag, custom-variable-tag)
717 (custom-variable-button, custom-face-tag, custom-group-tag-1)
718 (custom-group-tag): Remove "-face" suffix from face names.
719 (custom-magic-alist, custom-magic-value-create)
720 (custom-group-sample-face-get, custom-mode): Use renamed custom faces.
721 (custom-invalid-face, custom-rogue-face, custom-modified-face)
722 (custom-set-face, custom-changed-face, custom-saved-face)
723 (custom-button-face, custom-button-pressed-face)
724 (custom-documentation-face, custom-state-face)
725 (custom-comment-face, custom-comment-tag-face)
726 (custom-variable-tag-face, custom-variable-button-face)
727 (custom-face-tag-face, custom-group-tag-face-1)
728 (custom-group-tag-face):
729 New backward-compatibility aliases for renamed faces.
730
731 * wid-edit.el (widget-documentation, widget-button)
732 (widget-field, widget-single-line-field, widget-inactive)
733 (widget-button-pressed): "-face" suffix removed from face names.
734 (widget-documentation-face, widget-button-face)
735 (widget-field-face, widget-single-line-field-face)
736 (widget-inactive-face, widget-button-pressed-face):
737 New backward-compatibility aliases for renamed faces.
738 (widget-documentation-face, widget-button-face)
739 (widget-button-pressed-face, widget-specify-field)
740 (widget-specify-inactive): Use renamed widget faces.
741
7422005-06-10 Kenichi Handa <handa@m17n.org>
743
744 * term/x-win.el (x-clipboard-yank): Remove condition-case
745 wrapping.
746
7472005-06-11 Kenichi Handa <handa@m17n.org>
748
749 * add-log.el (change-log-font-lock-keywords): Make the regexp for
750 date lines stricter.
751
7522005-06-10 Zhang Wei <id.brep@gmail.com> (tiny change)
753
754 * term/x-win.el (x-clipboard-yank): Use x-selection-value instead
755 of x-get-selection.
756
7572005-06-10 Juanma Barranquero <lekktu@gmail.com>
758
759 * comint.el (comint-mode, comint-snapshot-last-prompt):
760 * frame.el (frame-current-scroll-bars):
761 * term.el (term-mode, term-check-proc, term-input-sender)
762 (term-simple-send, term-extract-string, term-word)
763 (term-match-partial-filename):
764 * window.el (window-current-scroll-bars):
765 * emulation/cua-base.el (cua-normal-cursor-color)
766 (cua-read-only-cursor-color, cua-overwrite-cursor-color)
767 (cua-global-mark-cursor-color):
768 * mail/undigest.el (rmail-forward-separator-regex):
769 Fix typos in docstrings.
770
771 * comint.el (comint-check-proc, make-comint-in-buffer)
772 (comint-source-default): Doc fixes.
773
774 * term.el (term-send-string): Improve argument/docstring
775 consistency.
776
7772005-06-09 Luc Teirlinck <teirllm@auburn.edu>
778
779 * comint.el (comint-send-input): Bind `inhibit-read-only' around
780 call to `delete-region'.
781 (comint-mode-hook): Do not enable Font Lock by default.
782
7832005-06-09 Lute Kamstra <lute@gnu.org>
784
785 * textmodes/ispell.el (ispell-menu-map-needed): flyspell-mode
786 could be void.
787
7882005-06-09 Stefan Monnier <monnier@iro.umontreal.ca>
789
790 * emacs-lisp/debug.el (debugger-will-be-back): New var.
791 (debug): Use it.
792 (debugger-step-through, debugger-continue, debugger-jump)
793 (debugger-return-value): Set it when needed.
794 (debugger-make-xrefs, debugger-frame, debugger-frame-clear):
795 Use inhibit-read-only.
796
7972005-06-09 Juanma Barranquero <lekktu@gmail.com>
798
799 * window.el (shrink-window-if-larger-than-buffer)
800 (window-size-fixed): Fix typo in docstring.
801
802 * thumbs.el: Don't set `auto-image-file-mode'. Do not create the
803 thumbnails directory on loading.
804 (thumbs-conversion-program): Use `eq' to check the system type,
805 not `equal'.
806 (thumbs-temp-dir): Initialize to `temporary-file-directory',
807 not "/tmp". Fix docstring.
808 (thumbs-thumbsdir): New function to return the thumbnails
809 directory, creating it if needed.
810 (thumbs-cleanup-thumbsdir, thumbs-thumbname): Use it.
811 (thumbs-temp-file): Delete variable and make it into a function.
812 (thumbs-resize-image, thumbs-modify-image): Use it.
813 (thumbs-kill-buffer): Simplify.
814 (thumbs-gensym): Defalias or duplicate CL `gensym'.
815 (thumbs-resize-image, thumbs-resize-interactive): Fix typos in
816 docstrings.
817
8182005-06-09 Kim F. Storm <storm@cua.dk>
819
820 * subr.el (save-match-data): Add RESEAT arg `evaporate' to
821 set-match-data to free markers in match-data.
822
823 * replace.el (replace-match-data): Pass RESEAT arg `t' to
824 match-data to unchain markers in match-data.
825
8262005-06-08 Stefan Monnier <monnier@iro.umontreal.ca>
827
828 * emacs-lisp/debug.el (debug): Don't iconify if we know we'll re-enter
829 the debugger immediately anyway. Undo the 2005-06-06 change, rendered
830 unnecessary now.
831
8322005-06-08 Richard M. Stallman <rms@gnu.org>
833
834 * emacs-lisp/easy-mmode.el (define-minor-mode): If BODY is empty,
835 give the variable a doc string that doesn't say don't set it directly.
836
837 * textmodes/ispell.el (ispell-check-version):
838 Use match-string-no-properties.
839 (ispell-region, ispell-buffer-local-parsing, ispell-buffer-local-dict)
840 (ispell-buffer-local-words): Likewise.
841
842 * progmodes/make-mode.el (makefile-shell-face): Make this a no-op
843 except on terminals with enough colors to really display it.
844 (makefile-dependency-regex): Delete spurious `bb'.
845
846 * faces.el (escape-glyph): Use blue once again in last case.
847 (no-break-space): Redefine so that it isn't invisible on a tty.
848
8492005-06-08 Kim F. Storm <storm@cua.dk>
850
851 * ido.el (ido-read-file-name): Fallback to read-file-name on C-f
852 also when reading directory name.
853
8542005-06-08 Lute Kamstra <lute@gnu.org>
855
856 * textmodes/flyspell.el (flyspell-mode): Use define-minor-mode.
857 (flyspell-mode-line-string): Remove autoload cookie.
858 (flyspell-mode): Remove defvar.
859
8602005-06-07 Lute Kamstra <lute@gnu.org>
861
862 * textmodes/org.el (org-run-mode-hooks): New function.
863 (org-agenda-mode): Use it.
864
8652005-06-07 David McCabe <davemccabe@gmail.com> (tiny change)
866
867 * emacs-lisp/lisp-mode.el (defstruct): Set `doc-string-elt' property.
868
8692005-06-06 Stefan Monnier <monnier@iro.umontreal.ca>
870
871 * international/iso-cvt.el (iso-sgml2iso-trans-tab): Add NBSP.
872
8732005-06-06 Luc Teirlinck <teirllm@auburn.edu>
874
875 * font-lock.el (font-lock-add-keywords): Doc fix.
876
8772005-06-06 Stefan Monnier <monnier@iro.umontreal.ca>
878
879 * textmodes/tex-mode.el (tex-guess-mode): Add RequirePackage.
880 (tex-compile-default): In the absence of any history, use the order in
881 tex-compile-alist to choose the preferred command.
882 (tex-compile-commands): Reorder a bit.
883
884 * textmodes/flyspell.el (flyspell-auto-correct-binding)
885 (flyspell-incorrect-face, flyspell-duplicate-face):
886 Use (X)Emacs-agnostic code.
887 (flyspell-mode-map): Don't overwrite at each load. Remove code
888 redundant with the subsequent add-minor-mode. Merge Emacs and
889 XEmacs code.
890 (flyspell-word): Minor simplification.
891 (flyspell-math-tex-command-p): Quieten the byte-compiler.
892 (flyspell-external-point-words): Remove unused vars `size' and `start'.
893 (flyspell-do-correct): Rename from flyspell-xemacs-correct.
894 Merge the corresponding Emacs code.
895 (flyspell-correct-word, flyspell-xemacs-popup): Use flyspell-do-correct.
896
897 * emacs-lisp/debug.el (debug): Don't bury the buffer unless it's in
898 a dedicated window.
899
900 * international/latexenc.el (latexenc-find-file-coding-system):
901 Undo part of last patch, to turn off a compiler warning.
902
9032005-06-06 Juri Linkov <juri@jurta.org>
904
905 * tmm.el (tmm-inactive, tmm-remove-inactive-mouse-face):
906 Rename `tmm-inactive-face' to `tmm-inactive'.
907
9082005-06-06 Matt Hodges <MPHodges@member.fsf.org>
909
910 * iswitchb.el: Rename faces.
911
9122005-06-06 Kim F. Storm <storm@cua.dk>
913
914 * emulation/cua-base.el (cua-rectangle, cua-rectangle-noselect)
915 (cua-global-mark): Remove -face suffix from face names.
916
917 * emulation/cua-gmrk.el (cua--init-global-mark):
918 Remove cua-global-mark face setup.
919
9202005-06-06 Richard M. Stallman <rms@gnu.org>
921
922 * progmodes/make-mode.el (makefile-dependency-regex): Handle whitespace
923 just like other allowed characters.
924 (makefile-match-dependency): Exclude leading and training whitespace
925 from the range of regexp subexp 1.
926 (makefile-macroassign-regex): Don't try to match the body,
927 just the name of the macro being defined.
928
929 * info.el (Info-read-node-name-2): New function.
930 (Info-read-node-name-1): Use that.
931 Add a completion-base-size-function property.
932
933 * simple.el (completion-setup-function): Look for
934 completion-base-size-function property of
935 minibuffer-completion-table.
936
937 * files.el (locate-file-completion): Doc fix.
938
939 * printing.el: Don't call pr-update-menus; user must do that.
940
941 * emacs-lisp/debug.el (debugger-window): New variable.
942 (debug): Use debugger-window if it is set and still alive.
943 Record debugger-window for next entry.
944
945 * mail/supercite.el (sc-mail-glom-frame): Mark as risky.
946
9472005-06-06 Matthias F,Av(Brste <slashdevslashnull@gmx.net>
948
949 * files.el (hack-local-variables-confirm): New arg FLAG-TO-CHECK.
950 (hack-one-local-variable, hack-local-variables)
951 (hack-local-variables-prop-line): Pass that arg.
952
9532005-06-06 Kim F. Storm <storm@cua.dk>
954
955 * ido.el (ido-first-match, ido-only-match, ido-subdir)
956 (ido-indicator): Remove -face suffix from face names.
957
9582005-06-06 Juri Linkov <juri@jurta.org>
959
960 * font-lock.el (font-lock-regexp-backslash)
961 (font-lock-regexp-backslash-construct): New faces.
962 (lisp-font-lock-keywords-2): Use new faces. Match `?:' only
963 after `('. Add `while-no-input' to control structures.
964
965 * faces.el (no-break-space, shadow): New faces.
966 (escape-glyph): Use less loud colors pink2 and red4.
967
968 * diff-mode.el (diff-context-face)
969 * dired.el (dired-ignored)
970 * rfn-eshadow.el (file-name-shadow)
971 * tmm.el (tmm-inactive-face): Inherit from `shadow' face.
972
973 * info.el (Info-title-1-face): Use green instead of yellow because
974 bold yellow is not readable on light backgrounds.
975
976 * progmodes/compile.el (compilation-start): Move `erase-buffer' up
977 before selecting the desired mode to not spend time fontifying
978 old contents.
979
9802005-06-06 Juanma Barranquero <lekktu@gmail.com>
981
982 * thumbs.el (thumbs-thumbsdir-max-size, thumbs-image-resizing-step)
983 (thumbs-thumbsdir-auto-clean): Fix typos in docstrings.
984
985 * ps-print.el (ps-default-fg, ps-default-bg):
986 Fix typos in docstrings.
987
988 * isearchb.el (isearchb): Don't pass a spurious second argument to
989 `iswitchb-completions'.
990
9912005-06-05 Nick Roberts <nickrob@snap.net.nz>
992
993 * progmodes/gdb-ui.el (gdb-info-locals-handler): Use window point
994 to preserve point.
995 (gdb-find-file-hook): Add doc string.
996
997 * progmodes/gud.el (gdb, gud-menu-map): Add command to evaluate
998 C dereferenced pointer expression.
999 (gud-tool-bar-map): Put it on the tool bar. Re-order icons.
1000
1001 * toolbar/gud-pstar.xpm, toolbar/gud-pstar.pbm: New files.
1002
1003 * toolbar/gud-break.xpm, toolbar/gud-cont.xpm, toolbar/gud-down.xpm
1004 * toolbar/gud-finish.xpm, toolbar/gud-ni.xpm, toolbar/gud-n.xpm
1005 * toolbar/gud-print.xpm, toolbar/gud-remove.xpm, toolbar/gud-run.xpm
1006 * toolbar/gud-si.xpm, toolbar/gud-s.xpm, toolbar/gud-until.xpm
1007 * toolbar/gud-up.xpm, toolbar/gud-watch.xpm:
1008 Make background transparent.
1009
10102005-06-04 Luc Teirlinck <teirllm@auburn.edu>
1011
1012 * font-lock.el (font-lock-add-keywords): Doc fix. Comment change.
1013 (font-lock-remove-keywords): Doc fix.
1014 (font-lock-mode-major-mode): Compiler defvar.
1015 (font-lock-set-defaults): Use `font-lock-mode-major-mode'.
1016
1017 * font-core.el (font-lock-mode-major-mode): Compiler defvar.
1018 (font-lock-mode): Update `font-lock-mode-major-mode'.
1019 (font-lock-set-defaults): Compiler defvar.
1020 (font-lock-default-function): Take `font-lock-mode-major-mode'
1021 into account.
1022
1023 * emacs-lisp/easy-mmode.el (define-global-minor-mode): Make it
1024 keep track of which major mode it enabled the minor mode for.
1025 Use find-file-hook again. Update docstring.
1026
1027 * simple.el (eval-expression-print-level)
1028 (eval-expression-print-length, eval-expression-debug-on-error):
1029 Doc fixes.
1030
10312005-06-04 Matt Hodges <MPHodges@member.fsf.org>
1032
1033 * iswitchb.el (iswitchb-single-match-face)
1034 (iswitchb-current-match-face, iswitchb-virtual-matches-face)
1035 (iswitchb-invalid-regexp-face): New faces.
1036 (iswitchb-completions): Use them.
1037 (iswitchb-use-faces): Rename from iswitchb-use-fonts, which is
1038 now marked as an obsolete alias.
1039 (iswitchb-read-buffer): Remove check for bound font variables.
1040 (iswitchb-invalid-regexp): New free variable.
1041 (iswitchb-get-matched-buffers): Catch invalid-regexp errors and
1042 set iswitchb-invalid-regexp.
1043 (iswitchb, iswitchb-complete, iswitchb-completions): Deal with
1044 invalid regexps.
1045 (iswitchb-completions): Add check for complete match when entering
1046 a regexp.
1047 (iswitchb-completions): Remove require-match argument.
1048 (iswitchb-exhibit): Fix caller.
1049 (iswitchb-common-match-inserted): New variable.
1050 (iswitchb-complete, iswitchb-completion-help): Use it.
1051
10522005-06-04 David Reitter <david.reitter@gmail.com> (tiny change)
1053
1054 * url-http.el (url-http-chunked-encoding-after-change-function):
1055 Use `url-http-debug' instead of `message'.
1056
10572005-06-04 Thierry Emery <thierry.emery@free.fr> (tiny change)
1058
1059 * url-http.el (url-http-parse-headers): Pass redirected URL as a
1060 callback argument.
1061
10622005-06-04 Kim F. Storm <storm@cua.dk>
1063
1064 * simple.el (line-move): Only call sit-for when moving backwards.
1065
1066 * ido.el (ido-make-merged-file-list-1): New defun split from
1067 ido-make-merged-file-list.
1068 (ido-make-merged-file-list): Bind throw-on-input around call to
1069 ido-make-merged-file-list-1. Return input-pending-p if
1070 interrupted by more input available.
1071 (ido-read-internal): Handle input-pending-p return value from
1072 ido-make-merged-file-list.
1073
10742005-06-03 Stefan Monnier <monnier@iro.umontreal.ca>
1075
1076 * textmodes/flyspell.el (flyspell-check-word-p): Simplify silly
1077 compatibility code.
1078
1079 * international/latexenc.el (latexenc-find-file-coding-system):
1080 Don't inherit the EOL part of the coding-system from the
1081 tex-main buffer. Fit within 80 columns.
1082
10832005-06-03 Matt Hodges <MPHodges@member.fsf.org>
1084
1085 * tmm.el (tmm-inactive-face): New face.
1086 (tmm-remove-inactive-mouse-face): New function.
1087 (tmm-prompt, tmm-add-one-shortcut)
1088 (tmm-add-prompt, tmm-get-keymap): Make active menu items visible
1089 but not selectable.
1090
10912005-06-03 Juanma Barranquero <lekktu@gmail.com>
1092
1093 * faces.el (face-equal): Improve argument/docstring consistency.
1094
10952005-06-03 Daniel Pfeiffer <occitan@esperanto.org>
1096
1097 * progmodes/make-mode.el (makefile-targets-face)
1098 (makefile-shell-face, makefile-makepp-perl-face): Add :version.
1099 (makefile-bsdmake-dependency-regex)
1100 (makefile-makepp-rule-action-regex)
1101 (makefile-bsdmake-rule-action-regex): New constants.
1102 (makefile-makepp-mode, makefile-bsdmake-mode): Use them.
1103
1104 * progmodes/compile.el (compilation-error-regexp-alist-alist):
1105 Allow (...) within `...' for makepp messages.
1106
11072005-06-03 Michael Kifer <kifer@cs.stonybrook.edu>
1108
1109 * ediff-diff.el (ediff-same-contents): Eliminate CL-type functions.
1110
1111 * ediff-mult.el (ediff-intersect-directories): Make sure that ".." and
1112 "." files are deleted from all file lists before comparison.
1113
1114 * viper-keym.el (viper-toggle-key, viper-quoted-insert-key)
1115 (viper-ESC-key): Made them customizable.
1116
1117 * viper.el (viper-non-hook-settings): Fix the names of defadvices.
1118
12005-06-01 Luc Teirlinck <teirllm@auburn.edu> 11192005-06-01 Luc Teirlinck <teirllm@auburn.edu>
2 1120
3 * autorevert.el (auto-revert-buffers): Use save-match-data. 1121 * autorevert.el (auto-revert-buffers): Use save-match-data.
@@ -23,8 +1141,7 @@
23 (gdb-info-breakpoints-custom, gdb-delete-breakpoint) 1141 (gdb-info-breakpoints-custom, gdb-delete-breakpoint)
24 (gdb-goto-breakpoint, gdb-source-info, gdb-get-location) 1142 (gdb-goto-breakpoint, gdb-source-info, gdb-get-location)
25 (gdb-assembler-custom): Improve regexps. 1143 (gdb-assembler-custom): Improve regexps.
26 (def-gdb-auto-update-handler): Use window point to ensure it 1144 (def-gdb-auto-update-handler): Use window point to preserve point.
27 is preserved.
28 1145
292005-05-31 Stefan Monnier <monnier@iro.umontreal.ca> 11462005-05-31 Stefan Monnier <monnier@iro.umontreal.ca>
30 1147
@@ -9392,7 +10509,7 @@
9392 * toolbar/tool-bar.el (tool-bar-setup): Tool bar item dired uses 10509 * toolbar/tool-bar.el (tool-bar-setup): Tool bar item dired uses
9393 icon diropen. New tool bar item find-file-existing uses icon open. 10510 icon diropen. New tool bar item find-file-existing uses icon open.
9394 10511
9395 * dired.el (dired-read-dir-and-switches): Call read-driectory-name 10512 * dired.el (dired-read-dir-and-switches): Call read-directory-name
9396 instead of read-file-name. 10513 instead of read-file-name.
9397 10514
93982004-11-02 Ulf Jasper <ulf.jasper@web.de> 105152004-11-02 Ulf Jasper <ulf.jasper@web.de>
@@ -17516,8 +18633,8 @@
17516 18633
175172004-01-21 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> 186342004-01-21 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
17518 18635
17519 * term/x-win.el: Call menu-bar-enable-clipboard and make Paste 18636 * term/x-win.el (x-clipboard-yank, menu-bar-edit-menu): Call
17520 use clipboard first. 18637 menu-bar-enable-clipboard and make Paste use clipboard first.
17521 18638
175222004-01-20 Stefan Monnier <monnier@iro.umontreal.ca> 186392004-01-20 Stefan Monnier <monnier@iro.umontreal.ca>
17523 18640
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index 01dbc563bc0..593dcc7fc3f 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -215,21 +215,19 @@ $(lisp)/progmodes/cc-mode.elc: \
215 215
216# Prepare a bootstrap in the lisp subdirectory. 216# Prepare a bootstrap in the lisp subdirectory.
217# 217#
218# Build loaddefs.el, because it's not sure it's up-to-date, and if it's not, 218# Build loaddefs.el to make sure it's up-to-date. If it's not, that
219# that might lead to errors during the bootstrap because something fails to 219# might lead to errors during the bootstrap because something fails to
220# autoload as expected. However, if there is no emacs binary, then we can't 220# autoload as expected. If there is no emacs binary, then we can't
221# build autoloads yet, so just make sure there's some loaddefs.el file, as 221# build autoloads yet. In that case we have to use ldefs-boot.el;
222# it's necessary for generating the binary (because loaddefs.el is an 222# bootstrap should always work with ldefs-boot.el. (Because
223# automatically generated file, we don't want to store it in the source 223# loaddefs.el is an automatically generated file, we don't want to
224# repository). 224# store it in the source repository).
225 225
226bootstrap-prepare: 226bootstrap-prepare:
227 if test -x $(EMACS); then \ 227 if test -x $(EMACS); then \
228 $(MAKE) $(MFLAGS) autoloads; \ 228 $(MAKE) $(MFLAGS) autoloads; \
229 else \ 229 else \
230 if test ! -r $(lisp)/loaddefs.el; then \ 230 cp $(lisp)/ldefs-boot.el $(lisp)/loaddefs.el; \
231 cp $(lisp)/ldefs-boot.el $(lisp)/loaddefs.el; \
232 fi \
233 fi 231 fi
234 232
235maintainer-clean: distclean 233maintainer-clean: distclean
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index 711e8e2ebe9..0a40768af31 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -134,9 +134,11 @@ Otherwise display all abbrevs."
134 "Major mode for editing the list of abbrev definitions. 134 "Major mode for editing the list of abbrev definitions.
135\\{edit-abbrevs-map}" 135\\{edit-abbrevs-map}"
136 (interactive) 136 (interactive)
137 (kill-all-local-variables)
137 (setq major-mode 'edit-abbrevs-mode) 138 (setq major-mode 'edit-abbrevs-mode)
138 (setq mode-name "Edit-Abbrevs") 139 (setq mode-name "Edit-Abbrevs")
139 (use-local-map edit-abbrevs-map)) 140 (use-local-map edit-abbrevs-map)
141 (run-mode-hooks 'edit-abbrevs-mode-hook))
140 142
141(defun edit-abbrevs () 143(defun edit-abbrevs ()
142 "Alter abbrev definitions by editing a list of them. 144 "Alter abbrev definitions by editing a list of them.
diff --git a/lisp/add-log.el b/lisp/add-log.el
index 4131b237e5c..bde75db8ec7 100644
--- a/lisp/add-log.el
+++ b/lisp/add-log.el
@@ -166,86 +166,102 @@ Note: The search is conducted only within 10%, at the beginning of the file."
166 :type '(repeat regexp) 166 :type '(repeat regexp)
167 :group 'change-log) 167 :group 'change-log)
168 168
169(defface change-log-date-face 169(defface change-log-date
170 '((t (:inherit font-lock-string-face))) 170 '((t (:inherit font-lock-string-face)))
171 "Face used to highlight dates in date lines." 171 "Face used to highlight dates in date lines."
172 :version "21.1" 172 :version "21.1"
173 :group 'change-log) 173 :group 'change-log)
174;; backward-compatibility alias
175(put 'change-log-date-face 'face-alias 'change-log-date)
174 176
175(defface change-log-name-face 177(defface change-log-name
176 '((t (:inherit font-lock-constant-face))) 178 '((t (:inherit font-lock-constant-face)))
177 "Face for highlighting author names." 179 "Face for highlighting author names."
178 :version "21.1" 180 :version "21.1"
179 :group 'change-log) 181 :group 'change-log)
182;; backward-compatibility alias
183(put 'change-log-name-face 'face-alias 'change-log-name)
180 184
181(defface change-log-email-face 185(defface change-log-email
182 '((t (:inherit font-lock-variable-name-face))) 186 '((t (:inherit font-lock-variable-name-face)))
183 "Face for highlighting author email addresses." 187 "Face for highlighting author email addresses."
184 :version "21.1" 188 :version "21.1"
185 :group 'change-log) 189 :group 'change-log)
190;; backward-compatibility alias
191(put 'change-log-email-face 'face-alias 'change-log-email)
186 192
187(defface change-log-file-face 193(defface change-log-file
188 '((t (:inherit font-lock-function-name-face))) 194 '((t (:inherit font-lock-function-name-face)))
189 "Face for highlighting file names." 195 "Face for highlighting file names."
190 :version "21.1" 196 :version "21.1"
191 :group 'change-log) 197 :group 'change-log)
198;; backward-compatibility alias
199(put 'change-log-file-face 'face-alias 'change-log-file)
192 200
193(defface change-log-list-face 201(defface change-log-list
194 '((t (:inherit font-lock-keyword-face))) 202 '((t (:inherit font-lock-keyword-face)))
195 "Face for highlighting parenthesized lists of functions or variables." 203 "Face for highlighting parenthesized lists of functions or variables."
196 :version "21.1" 204 :version "21.1"
197 :group 'change-log) 205 :group 'change-log)
206;; backward-compatibility alias
207(put 'change-log-list-face 'face-alias 'change-log-list)
198 208
199(defface change-log-conditionals-face 209(defface change-log-conditionals
200 '((t (:inherit font-lock-variable-name-face))) 210 '((t (:inherit font-lock-variable-name-face)))
201 "Face for highlighting conditionals of the form `[...]'." 211 "Face for highlighting conditionals of the form `[...]'."
202 :version "21.1" 212 :version "21.1"
203 :group 'change-log) 213 :group 'change-log)
214;; backward-compatibility alias
215(put 'change-log-conditionals-face 'face-alias 'change-log-conditionals)
204 216
205(defface change-log-function-face 217(defface change-log-function
206 '((t (:inherit font-lock-variable-name-face))) 218 '((t (:inherit font-lock-variable-name-face)))
207 "Face for highlighting items of the form `<....>'." 219 "Face for highlighting items of the form `<....>'."
208 :version "21.1" 220 :version "21.1"
209 :group 'change-log) 221 :group 'change-log)
222;; backward-compatibility alias
223(put 'change-log-function-face 'face-alias 'change-log-function)
210 224
211(defface change-log-acknowledgement-face 225(defface change-log-acknowledgement
212 '((t (:inherit font-lock-comment-face))) 226 '((t (:inherit font-lock-comment-face)))
213 "Face for highlighting acknowledgments." 227 "Face for highlighting acknowledgments."
214 :version "21.1" 228 :version "21.1"
215 :group 'change-log) 229 :group 'change-log)
230;; backward-compatibility alias
231(put 'change-log-acknowledgement-face 'face-alias 'change-log-acknowledgement)
216 232
217(defvar change-log-font-lock-keywords 233(defvar change-log-font-lock-keywords
218 '(;; 234 '(;;
219 ;; Date lines, new and old styles. 235 ;; Date lines, new and old styles.
220 ("^\\sw.........[0-9:+ ]*" 236 ("^\\sw.........[0-9:+ ]*"
221 (0 'change-log-date-face) 237 (0 'change-log-date)
222 ;; Name and e-mail; some people put e-mail in parens, not angles. 238 ;; Name and e-mail; some people put e-mail in parens, not angles.
223 ("\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]" nil nil 239 ("\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]" nil nil
224 (1 'change-log-name-face) 240 (1 'change-log-name)
225 (2 'change-log-email-face))) 241 (2 'change-log-email)))
226 ;; 242 ;;
227 ;; File names. 243 ;; File names.
228 ("^\\( +\\|\t\\)\\* \\([^ ,:([\n]+\\)" 244 ("^\\( +\\|\t\\)\\* \\([^ ,:([\n]+\\)"
229 (2 'change-log-file-face) 245 (2 'change-log-file)
230 ;; Possibly further names in a list: 246 ;; Possibly further names in a list:
231 ("\\=, \\([^ ,:([\n]+\\)" nil nil (1 'change-log-file-face)) 247 ("\\=, \\([^ ,:([\n]+\\)" nil nil (1 'change-log-file))
232 ;; Possibly a parenthesized list of names: 248 ;; Possibly a parenthesized list of names:
233 ("\\= (\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" 249 ("\\= (\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)"
234 nil nil (1 'change-log-list-face)) 250 nil nil (1 'change-log-list))
235 ("\\=, *\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" 251 ("\\=, *\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)"
236 nil nil (1 'change-log-list-face))) 252 nil nil (1 'change-log-list)))
237 ;; 253 ;;
238 ;; Function or variable names. 254 ;; Function or variable names.
239 ("^\\( +\\|\t\\)(\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" 255 ("^\\( +\\|\t\\)(\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)"
240 (2 'change-log-list-face) 256 (2 'change-log-list)
241 ("\\=, *\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" nil nil 257 ("\\=, *\\([^(),\n]+\\|(\\(setf\\|SETF\\) [^() ,\n]+)\\)" nil nil
242 (1 'change-log-list-face))) 258 (1 'change-log-list)))
243 ;; 259 ;;
244 ;; Conditionals. 260 ;; Conditionals.
245 ("\\[!?\\([^]\n]+\\)\\]\\(:\\| (\\)" (1 'change-log-conditionals-face)) 261 ("\\[!?\\([^]\n]+\\)\\]\\(:\\| (\\)" (1 'change-log-conditionals))
246 ;; 262 ;;
247 ;; Function of change. 263 ;; Function of change.
248 ("<\\([^>\n]+\\)>\\(:\\| (\\)" (1 'change-log-function-face)) 264 ("<\\([^>\n]+\\)>\\(:\\| (\\)" (1 'change-log-function))
249 ;; 265 ;;
250 ;; Acknowledgements. 266 ;; Acknowledgements.
251 ;; Don't include plain "From" because that is vague; 267 ;; Don't include plain "From" because that is vague;
@@ -254,7 +270,7 @@ Note: The search is conducted only within 10%, at the beginning of the file."
254 ;; is to put the name of the author of the changes at the top 270 ;; is to put the name of the author of the changes at the top
255 ;; of the change log entry. 271 ;; of the change log entry.
256 ("\\(^\\( +\\|\t\\)\\| \\)\\(Patch\\(es\\)? by\\|Report\\(ed by\\| from\\)\\|Suggest\\(ed by\\|ion from\\)\\)" 272 ("\\(^\\( +\\|\t\\)\\| \\)\\(Patch\\(es\\)? by\\|Report\\(ed by\\| from\\)\\|Suggest\\(ed by\\|ion from\\)\\)"
257 3 'change-log-acknowledgement-face)) 273 3 'change-log-acknowledgement))
258 "Additional expressions to highlight in Change Log mode.") 274 "Additional expressions to highlight in Change Log mode.")
259 275
260(defvar change-log-mode-map 276(defvar change-log-mode-map
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 72f08057b34..31be3a1997f 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -751,6 +751,7 @@ language you are using."
751(define-key global-map [home] 'beginning-of-line) 751(define-key global-map [home] 'beginning-of-line)
752(define-key global-map [C-home] 'beginning-of-buffer) 752(define-key global-map [C-home] 'beginning-of-buffer)
753(define-key global-map [M-home] 'beginning-of-buffer-other-window) 753(define-key global-map [M-home] 'beginning-of-buffer-other-window)
754(define-key esc-map [home] 'beginning-of-buffer-other-window)
754(define-key global-map [left] 'backward-char) 755(define-key global-map [left] 'backward-char)
755(define-key global-map [up] 'previous-line) 756(define-key global-map [up] 'previous-line)
756(define-key global-map [right] 'forward-char) 757(define-key global-map [right] 'forward-char)
@@ -763,13 +764,17 @@ language you are using."
763(put 'scroll-left 'disabled t) 764(put 'scroll-left 'disabled t)
764(define-key global-map [C-next] 'scroll-left) 765(define-key global-map [C-next] 'scroll-left)
765(define-key global-map [M-next] 'scroll-other-window) 766(define-key global-map [M-next] 'scroll-other-window)
767(define-key esc-map [next] 'scroll-other-window)
766(define-key global-map [M-prior] 'scroll-other-window-down) 768(define-key global-map [M-prior] 'scroll-other-window-down)
769(define-key esc-map [prior] 'scroll-other-window-down)
767(define-key esc-map [?\C-\S-v] 'scroll-other-window-down) 770(define-key esc-map [?\C-\S-v] 'scroll-other-window-down)
768(define-key global-map [end] 'end-of-line) 771(define-key global-map [end] 'end-of-line)
769(define-key global-map [C-end] 'end-of-buffer) 772(define-key global-map [C-end] 'end-of-buffer)
770(define-key global-map [M-end] 'end-of-buffer-other-window) 773(define-key global-map [M-end] 'end-of-buffer-other-window)
774(define-key esc-map [end] 'end-of-buffer-other-window)
771(define-key global-map [begin] 'beginning-of-buffer) 775(define-key global-map [begin] 'beginning-of-buffer)
772(define-key global-map [M-begin] 'beginning-of-buffer-other-window) 776(define-key global-map [M-begin] 'beginning-of-buffer-other-window)
777(define-key esc-map [begin] 'beginning-of-buffer-other-window)
773;; (define-key global-map [select] 'function-key-error) 778;; (define-key global-map [select] 'function-key-error)
774;; (define-key global-map [print] 'function-key-error) 779;; (define-key global-map [print] 'function-key-error)
775(define-key global-map [execute] 'execute-extended-command) 780(define-key global-map [execute] 'execute-extended-command)
@@ -933,7 +938,9 @@ language you are using."
933(define-key global-map "\C-c" 'mode-specific-command-prefix) 938(define-key global-map "\C-c" 'mode-specific-command-prefix)
934 939
935(global-set-key [M-right] 'forward-word) 940(global-set-key [M-right] 'forward-word)
941(define-key esc-map [right] 'forward-word)
936(global-set-key [M-left] 'backward-word) 942(global-set-key [M-left] 'backward-word)
943(define-key esc-map [left] 'backward-word)
937;; ilya@math.ohio-state.edu says these bindings are standard on PC editors. 944;; ilya@math.ohio-state.edu says these bindings are standard on PC editors.
938(global-set-key [C-right] 'forward-word) 945(global-set-key [C-right] 'forward-word)
939(global-set-key [C-left] 'backward-word) 946(global-set-key [C-left] 'backward-word)
@@ -943,12 +950,18 @@ language you are using."
943;; This is "move to the clipboard", or as close as we come. 950;; This is "move to the clipboard", or as close as we come.
944(global-set-key [S-delete] 'kill-region) 951(global-set-key [S-delete] 'kill-region)
945 952
946(global-set-key [C-M-left] 'backward-sexp) 953(global-set-key [C-M-left] 'backward-sexp)
947(global-set-key [C-M-right] 'forward-sexp) 954(define-key esc-map [C-left] 'backward-sexp)
948(global-set-key [C-M-up] 'backward-up-list) 955(global-set-key [C-M-right] 'forward-sexp)
949(global-set-key [C-M-down] 'down-list) 956(define-key esc-map [C-right] 'forward-sexp)
950(global-set-key [C-M-home] 'beginning-of-defun) 957(global-set-key [C-M-up] 'backward-up-list)
951(global-set-key [C-M-end] 'end-of-defun) 958(define-key esc-map [C-up] 'backward-up-list)
959(global-set-key [C-M-down] 'down-list)
960(define-key esc-map [C-down] 'down-list)
961(global-set-key [C-M-home] 'beginning-of-defun)
962(define-key esc-map [C-home] 'beginning-of-defun)
963(global-set-key [C-M-end] 'end-of-defun)
964(define-key esc-map [C-end] 'end-of-defun)
952 965
953(define-key esc-map "\C-f" 'forward-sexp) 966(define-key esc-map "\C-f" 'forward-sexp)
954(define-key esc-map "\C-b" 'backward-sexp) 967(define-key esc-map "\C-b" 'backward-sexp)
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index 7e9115a79dc..79247ad30df 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -74,11 +74,13 @@
74 :type 'boolean 74 :type 'boolean
75 :group 'Buffer-menu) 75 :group 'Buffer-menu)
76 76
77(defface Buffer-menu-buffer-face 77(defface Buffer-menu-buffer
78 '((t (:weight bold))) 78 '((t (:weight bold)))
79 "Face used to highlight buffer name." 79 "Face used to highlight buffer name."
80 :group 'Buffer-menu 80 :group 'Buffer-menu
81 :group 'font-lock-highlighting-faces) 81 :group 'font-lock-highlighting-faces)
82;; backward-compatibility alias
83(put 'Buffer-menu-buffer-face 'face-alias 'Buffer-menu-buffer)
82 84
83(defcustom Buffer-menu-buffer+size-width 26 85(defcustom Buffer-menu-buffer+size-width 26
84 "*How wide to jointly make the buffer name and size columns." 86 "*How wide to jointly make the buffer name and size columns."
@@ -773,7 +775,7 @@ For more information, see the function `buffer-menu'."
773 (int-to-string (nth 3 buffer)) 775 (int-to-string (nth 3 buffer))
774 `(buffer-name ,(nth 2 buffer) 776 `(buffer-name ,(nth 2 buffer)
775 buffer ,(car buffer) 777 buffer ,(car buffer)
776 font-lock-face Buffer-menu-buffer-face 778 font-lock-face Buffer-menu-buffer
777 mouse-face highlight 779 mouse-face highlight
778 help-echo "mouse-2: select this buffer")) 780 help-echo "mouse-2: select this buffer"))
779 " " 781 " "
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index fdf565c7923..0dee0da67f8 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -206,9 +206,9 @@ If nil, make an icon of the frame. If non-nil, delete the frame."
206 :type 'boolean 206 :type 'boolean
207 :group 'view) 207 :group 'view)
208 208
209(defvar diary-face 'diary-face 209(defvar diary-face 'diary
210 "Face name to use for diary entries.") 210 "Face name to use for diary entries.")
211(defface diary-face 211(defface diary
212 '((((min-colors 88) (class color) (background light)) 212 '((((min-colors 88) (class color) (background light))
213 :foreground "red1") 213 :foreground "red1")
214 (((class color) (background light)) 214 (((class color) (background light))
@@ -221,13 +221,17 @@ If nil, make an icon of the frame. If non-nil, delete the frame."
221 :weight bold)) 221 :weight bold))
222 "Face for highlighting diary entries." 222 "Face for highlighting diary entries."
223 :group 'diary) 223 :group 'diary)
224;; backward-compatibility alias
225(put 'diary-face 'face-alias 'diary)
224 226
225(defface calendar-today-face 227(defface calendar-today
226 '((t (:underline t))) 228 '((t (:underline t)))
227 "Face for indicating today's date." 229 "Face for indicating today's date."
228 :group 'diary) 230 :group 'diary)
231;; backward-compatibility alias
232(put 'calendar-today-face 'face-alias 'calendar-today)
229 233
230(defface holiday-face 234(defface holiday
231 '((((class color) (background light)) 235 '((((class color) (background light))
232 :background "pink") 236 :background "pink")
233 (((class color) (background dark)) 237 (((class color) (background dark))
@@ -236,17 +240,19 @@ If nil, make an icon of the frame. If non-nil, delete the frame."
236 :inverse-video t)) 240 :inverse-video t))
237 "Face for indicating dates that have holidays." 241 "Face for indicating dates that have holidays."
238 :group 'diary) 242 :group 'diary)
243;; backward-compatibility alias
244(put 'holiday-face 'face-alias 'holiday)
239 245
240(eval-after-load "facemenu" 246(eval-after-load "facemenu"
241 '(progn 247 '(progn
242 (add-to-list 'facemenu-unlisted-faces 'diary-face) 248 (add-to-list 'facemenu-unlisted-faces 'diary)
243 (add-to-list 'facemenu-unlisted-faces 'calendar-today-face) 249 (add-to-list 'facemenu-unlisted-faces 'calendar-today)
244 (add-to-list 'facemenu-unlisted-faces 'holiday-face))) 250 (add-to-list 'facemenu-unlisted-faces 'holiday)))
245 251
246(defcustom diary-entry-marker 252(defcustom diary-entry-marker
247 (if (not (display-color-p)) 253 (if (not (display-color-p))
248 "+" 254 "+"
249 'diary-face) 255 'diary)
250 "*How to mark dates that have diary entries. 256 "*How to mark dates that have diary entries.
251The value can be either a single-character string or a face." 257The value can be either a single-character string or a face."
252 :type '(choice string face) 258 :type '(choice string face)
@@ -255,7 +261,7 @@ The value can be either a single-character string or a face."
255(defcustom calendar-today-marker 261(defcustom calendar-today-marker
256 (if (not (display-color-p)) 262 (if (not (display-color-p))
257 "=" 263 "="
258 'calendar-today-face) 264 'calendar-today)
259 "*How to mark today's date in the calendar. 265 "*How to mark today's date in the calendar.
260The value can be either a single-character string or a face. 266The value can be either a single-character string or a face.
261Marking today's date is done only if you set up `today-visible-calendar-hook' 267Marking today's date is done only if you set up `today-visible-calendar-hook'
@@ -266,7 +272,7 @@ to request that."
266(defcustom calendar-holiday-marker 272(defcustom calendar-holiday-marker
267 (if (not (display-color-p)) 273 (if (not (display-color-p))
268 "*" 274 "*"
269 'holiday-face) 275 'holiday)
270 "*How to mark notable dates in the calendar. 276 "*How to mark notable dates in the calendar.
271The value can be either a single-character string or a face." 277The value can be either a single-character string or a face."
272 :type '(choice string face) 278 :type '(choice string face)
@@ -2441,7 +2447,6 @@ For a complete description, type \
2441\\<calendar-mode-map>\\[calendar-goto-info-node] from within the calendar. 2447\\<calendar-mode-map>\\[calendar-goto-info-node] from within the calendar.
2442 2448
2443\\<calendar-mode-map>\\{calendar-mode-map}" 2449\\<calendar-mode-map>\\{calendar-mode-map}"
2444
2445 (kill-all-local-variables) 2450 (kill-all-local-variables)
2446 (setq major-mode 'calendar-mode) 2451 (setq major-mode 'calendar-mode)
2447 (setq mode-name "Calendar") 2452 (setq mode-name "Calendar")
@@ -2454,7 +2459,8 @@ For a complete description, type \
2454 (make-local-variable 'displayed-month);; Month in middle of window. 2459 (make-local-variable 'displayed-month);; Month in middle of window.
2455 (make-local-variable 'displayed-year) ;; Year in middle of window. 2460 (make-local-variable 'displayed-year) ;; Year in middle of window.
2456 (set (make-local-variable 'font-lock-defaults) 2461 (set (make-local-variable 'font-lock-defaults)
2457 '(calendar-font-lock-keywords t))) 2462 '(calendar-font-lock-keywords t))
2463 (run-mode-hooks 'calendar-mode-hook))
2458 2464
2459(defun calendar-string-spread (strings char length) 2465(defun calendar-string-spread (strings char length)
2460 "Concatenate list of STRINGS separated with copies of CHAR to fill LENGTH. 2466 "Concatenate list of STRINGS separated with copies of CHAR to fill LENGTH.
@@ -2943,7 +2949,7 @@ MARK defaults to `diary-entry-marker'."
2943 (forward-char -2)) 2949 (forward-char -2))
2944 (let ; attr list 2950 (let ; attr list
2945 ((temp-face 2951 ((temp-face
2946 (make-symbol (apply 'concat "temp-face-" 2952 (make-symbol (apply 'concat "temp-"
2947 (mapcar '(lambda (sym) 2953 (mapcar '(lambda (sym)
2948 (cond ((symbolp sym) (symbol-name sym)) 2954 (cond ((symbolp sym) (symbol-name sym))
2949 ((numberp sym) (int-to-string sym)) 2955 ((numberp sym) (int-to-string sym))
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index 6aec579c107..a0e9d1f90b7 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -543,15 +543,17 @@ changing the variable `diary-include-string'."
543 (set-window-start window (point-min)))) 543 (set-window-start window (point-min))))
544 (message "Preparing diary...done")))) 544 (message "Preparing diary...done"))))
545 545
546(defface diary-button-face '((((type pc) (class color)) 546(defface diary-button '((((type pc) (class color))
547 (:foreground "lightblue"))) 547 (:foreground "lightblue")))
548 "Default face used for buttons." 548 "Default face used for buttons."
549 :version "22.1" 549 :version "22.1"
550 :group 'diary) 550 :group 'diary)
551;; backward-compatibility alias
552(put 'diary-button-face 'face-alias 'diary-button)
551 553
552(define-button-type 'diary-entry 554(define-button-type 'diary-entry
553 'action #'diary-goto-entry 555 'action #'diary-goto-entry
554 'face #'diary-button-face) 556 'face 'diary-button)
555 557
556(defun diary-goto-entry (button) 558(defun diary-goto-entry (button)
557 (let ((marker (button-get button 'marker))) 559 (let ((marker (button-get button 'marker)))
diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el
index 132f42369c6..85d49ba38f7 100644
--- a/lisp/calendar/todo-mode.el
+++ b/lisp/calendar/todo-mode.el
@@ -311,7 +311,7 @@ which it will stop. If you set the threshhold to zero, the upper and
311lower bound will coincide at the end of the loop and you will insert 311lower bound will coincide at the end of the loop and you will insert
312your item just before that point. If you set the threshhold to, 312your item just before that point. If you set the threshhold to,
313e.g. 8, it will stop as soon as the window size drops below that 313e.g. 8, it will stop as soon as the window size drops below that
314amount and will insert the item in the approximate centre of that 314amount and will insert the item in the approximate center of that
315window." 315window."
316 :type 'integer 316 :type 'integer
317 :group 'todo) 317 :group 'todo)
diff --git a/lisp/comint.el b/lisp/comint.el
index 37550b7b6d9..14913c7ef11 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -423,7 +423,7 @@ field boundaries in a natural way)."
423(make-obsolete-variable 'comint-use-prompt-regexp-instead-of-fields 423(make-obsolete-variable 'comint-use-prompt-regexp-instead-of-fields
424 'comint-use-prompt-regexp "22.1") 424 'comint-use-prompt-regexp "22.1")
425 425
426(defcustom comint-mode-hook '(turn-on-font-lock) 426(defcustom comint-mode-hook nil
427 "Hook run upon entry to `comint-mode'. 427 "Hook run upon entry to `comint-mode'.
428This is run before the process is cranked up." 428This is run before the process is cranked up."
429 :type 'hook 429 :type 'hook
@@ -583,7 +583,7 @@ Return not at end copies rest of line to end and sends it.
583Setting variable `comint-eol-on-send' means jump to the end of the line 583Setting variable `comint-eol-on-send' means jump to the end of the line
584before submitting new input. 584before submitting new input.
585 585
586This mode is customised to create major modes such as Inferior Lisp 586This mode is customized to create major modes such as Inferior Lisp
587mode, Shell mode, etc. This can be done by setting the hooks 587mode, Shell mode, etc. This can be done by setting the hooks
588`comint-input-filter-functions', `comint-input-filter', `comint-input-sender' 588`comint-input-filter-functions', `comint-input-filter', `comint-input-sender'
589and `comint-get-old-input' to appropriate functions, and the variable 589and `comint-get-old-input' to appropriate functions, and the variable
@@ -654,7 +654,7 @@ Entry to this mode runs the hooks on `comint-mode-hook'."
654 (set (make-local-variable 'next-line-add-newlines) nil)) 654 (set (make-local-variable 'next-line-add-newlines) nil))
655 655
656(defun comint-check-proc (buffer) 656(defun comint-check-proc (buffer)
657 "Return t if there is a living process associated w/buffer BUFFER. 657 "Return non-nil if there is a living process associated w/buffer BUFFER.
658Living means the status is `open', `run', or `stop'. 658Living means the status is `open', `run', or `stop'.
659BUFFER can be either a buffer or the name of one." 659BUFFER can be either a buffer or the name of one."
660 (let ((proc (get-buffer-process buffer))) 660 (let ((proc (get-buffer-process buffer)))
@@ -667,7 +667,7 @@ If BUFFER is nil, it defaults to NAME surrounded by `*'s.
667PROGRAM should be either a string denoting an executable program to create 667PROGRAM should be either a string denoting an executable program to create
668via `start-process', or a cons pair of the form (HOST . SERVICE) denoting a TCP 668via `start-process', or a cons pair of the form (HOST . SERVICE) denoting a TCP
669connection to be opened via `open-network-stream'. If there is already a 669connection to be opened via `open-network-stream'. If there is already a
670running process in that buffer, it is not restarted. Optional third arg 670running process in that buffer, it is not restarted. Optional fourth arg
671STARTFILE is the name of a file to send the contents of to the process. 671STARTFILE is the name of a file to send the contents of to the process.
672 672
673If PROGRAM is a string, any more args are arguments to PROGRAM." 673If PROGRAM is a string, any more args are arguments to PROGRAM."
@@ -1547,8 +1547,12 @@ Similarly for Soar, Scheme, etc."
1547 nil comint-last-input-start comint-last-input-end 1547 nil comint-last-input-start comint-last-input-end
1548 nil comint-last-input-end 1548 nil comint-last-input-end
1549 (+ comint-last-input-end echo-len)))) 1549 (+ comint-last-input-end echo-len))))
1550 (delete-region comint-last-input-end 1550 ;; Certain parts of the text to be deleted may have
1551 (+ comint-last-input-end echo-len))))) 1551 ;; been mistaken for prompts. We have to prevent
1552 ;; problems when `comint-prompt-read-only' is non-nil.
1553 (let ((inhibit-read-only t))
1554 (delete-region comint-last-input-end
1555 (+ comint-last-input-end echo-len))))))
1552 1556
1553 ;; This used to call comint-output-filter-functions, 1557 ;; This used to call comint-output-filter-functions,
1554 ;; but that scrolled the buffer in undesirable ways. 1558 ;; but that scrolled the buffer in undesirable ways.
@@ -1579,7 +1583,7 @@ See `comint-carriage-motion' for details.")
1579 1583
1580(defun comint-snapshot-last-prompt () 1584(defun comint-snapshot-last-prompt ()
1581 "`snapshot' any current `comint-last-prompt-overlay'. 1585 "`snapshot' any current `comint-last-prompt-overlay'.
1582freeze its attributes in place, even when more input comes a long 1586Freeze its attributes in place, even when more input comes along
1583and moves the prompt overlay." 1587and moves the prompt overlay."
1584 (when comint-last-prompt-overlay 1588 (when comint-last-prompt-overlay
1585 (let ((inhibit-read-only t) 1589 (let ((inhibit-read-only t)
@@ -2385,7 +2389,7 @@ updated using `comint-update-fence', if necessary."
2385 "Compute the defaults for `load-file' and `compile-file' commands. 2389 "Compute the defaults for `load-file' and `compile-file' commands.
2386 2390
2387PREVIOUS-DIR/FILE is a pair (directory . filename) from the last 2391PREVIOUS-DIR/FILE is a pair (directory . filename) from the last
2388source-file processing command. nil if there hasn't been one yet. 2392source-file processing command, or nil if there hasn't been one yet.
2389SOURCE-MODES is a list used to determine what buffers contain source 2393SOURCE-MODES is a list used to determine what buffers contain source
2390files: if the major mode of the buffer is in SOURCE-MODES, it's source. 2394files: if the major mode of the buffer is in SOURCE-MODES, it's source.
2391Typically, (lisp-mode) or (scheme-mode). 2395Typically, (lisp-mode) or (scheme-mode).
diff --git a/lisp/compare-w.el b/lisp/compare-w.el
index c9b26a6eb5b..353c015c8af 100644
--- a/lisp/compare-w.el
+++ b/lisp/compare-w.el
@@ -1,6 +1,6 @@
1;;; compare-w.el --- compare text between windows for Emacs 1;;; compare-w.el --- compare text between windows for Emacs
2 2
3;; Copyright (C) 1986,1989,1993,1997,2003,2004 Free Software Foundation, Inc. 3;; Copyright (C) 1986,1989,1993,1997,2003,2004,2005 Free Software Foundation, Inc.
4 4
5;; Maintainer: FSF 5;; Maintainer: FSF
6;; Keywords: convenience files 6;; Keywords: convenience files
@@ -116,7 +116,7 @@ and the value `((4) (4))' for horizontally split windows."
116 :type 'boolean 116 :type 'boolean
117 :group 'compare-w) 117 :group 'compare-w)
118 118
119(defface compare-windows-face 119(defface compare-windows
120 '((((class color) (min-colors 88) (background light)) 120 '((((class color) (min-colors 88) (background light))
121 (:background "paleturquoise")) 121 (:background "paleturquoise"))
122 (((class color) (min-colors 88) (background dark)) 122 (((class color) (min-colors 88) (background dark))
@@ -126,6 +126,8 @@ and the value `((4) (4))' for horizontally split windows."
126 (t (:underline t))) 126 (t (:underline t)))
127 "Face for highlighting of compare-windows difference regions." 127 "Face for highlighting of compare-windows difference regions."
128 :group 'compare-w) 128 :group 'compare-w)
129;; backward-compatibility alias
130(put 'compare-windows-face 'face-alias 'compare-windows)
129 131
130(defvar compare-windows-overlay1 nil) 132(defvar compare-windows-overlay1 nil)
131(defvar compare-windows-overlay2 nil) 133(defvar compare-windows-overlay2 nil)
@@ -341,13 +343,13 @@ on third call it again advances points to the next difference and so on."
341 (if compare-windows-overlay1 343 (if compare-windows-overlay1
342 (move-overlay compare-windows-overlay1 beg1 end1 b1) 344 (move-overlay compare-windows-overlay1 beg1 end1 b1)
343 (setq compare-windows-overlay1 (make-overlay beg1 end1 b1)) 345 (setq compare-windows-overlay1 (make-overlay beg1 end1 b1))
344 (overlay-put compare-windows-overlay1 'face 'compare-windows-face) 346 (overlay-put compare-windows-overlay1 'face 'compare-windows)
345 (overlay-put compare-windows-overlay1 'priority 1)) 347 (overlay-put compare-windows-overlay1 'priority 1))
346 (overlay-put compare-windows-overlay1 'window w1) 348 (overlay-put compare-windows-overlay1 'window w1)
347 (if compare-windows-overlay2 349 (if compare-windows-overlay2
348 (move-overlay compare-windows-overlay2 beg2 end2 b2) 350 (move-overlay compare-windows-overlay2 beg2 end2 b2)
349 (setq compare-windows-overlay2 (make-overlay beg2 end2 b2)) 351 (setq compare-windows-overlay2 (make-overlay beg2 end2 b2))
350 (overlay-put compare-windows-overlay2 'face 'compare-windows-face) 352 (overlay-put compare-windows-overlay2 'face 'compare-windows)
351 (overlay-put compare-windows-overlay2 'priority 1)) 353 (overlay-put compare-windows-overlay2 'priority 1))
352 (overlay-put compare-windows-overlay2 'window w2) 354 (overlay-put compare-windows-overlay2 'window w2)
353 ;; Remove highlighting before next command is executed 355 ;; Remove highlighting before next command is executed
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 82a5e887bed..d2f89efb7f5 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -417,7 +417,7 @@
417 :group 'development) 417 :group 'development)
418 418
419(defgroup minibuffer nil 419(defgroup minibuffer nil
420 "Controling the behaviour of the minibuffer." 420 "Controling the behavior of the minibuffer."
421 :link '(custom-manual "(emacs)Minibuffer") 421 :link '(custom-manual "(emacs)Minibuffer")
422 :group 'environment) 422 :group 'environment)
423 423
@@ -1636,50 +1636,62 @@ item in another window.\n\n"))
1636 :group 'custom-faces 1636 :group 'custom-faces
1637 :group 'custom-buffer) 1637 :group 'custom-buffer)
1638 1638
1639(defface custom-invalid-face '((((class color)) 1639(defface custom-invalid '((((class color))
1640 (:foreground "yellow1" :background "red1")) 1640 (:foreground "yellow1" :background "red1"))
1641 (t 1641 (t
1642 (:weight bold :slant italic :underline t))) 1642 (:weight bold :slant italic :underline t)))
1643 "Face used when the customize item is invalid." 1643 "Face used when the customize item is invalid."
1644 :group 'custom-magic-faces) 1644 :group 'custom-magic-faces)
1645;; backward-compatibility alias
1646(put 'custom-invalid-face 'face-alias 'custom-invalid)
1645 1647
1646(defface custom-rogue-face '((((class color)) 1648(defface custom-rogue '((((class color))
1647 (:foreground "pink" :background "black")) 1649 (:foreground "pink" :background "black"))
1648 (t 1650 (t
1649 (:underline t))) 1651 (:underline t)))
1650 "Face used when the customize item is not defined for customization." 1652 "Face used when the customize item is not defined for customization."
1651 :group 'custom-magic-faces) 1653 :group 'custom-magic-faces)
1654;; backward-compatibility alias
1655(put 'custom-rogue-face 'face-alias 'custom-rogue)
1652 1656
1653(defface custom-modified-face '((((min-colors 88) (class color)) 1657(defface custom-modified '((((min-colors 88) (class color))
1654 (:foreground "white" :background "blue1")) 1658 (:foreground "white" :background "blue1"))
1655 (((class color))
1656 (:foreground "white" :background "blue"))
1657 (t
1658 (:slant italic :bold)))
1659 "Face used when the customize item has been modified."
1660 :group 'custom-magic-faces)
1661
1662(defface custom-set-face '((((min-colors 88) (class color))
1663 (:foreground "blue1" :background "white"))
1664 (((class color)) 1659 (((class color))
1665 (:foreground "blue" :background "white")) 1660 (:foreground "white" :background "blue"))
1666 (t 1661 (t
1667 (:slant italic))) 1662 (:slant italic :bold)))
1663 "Face used when the customize item has been modified."
1664 :group 'custom-magic-faces)
1665;; backward-compatibility alias
1666(put 'custom-modified-face 'face-alias 'custom-modified)
1667
1668(defface custom-set '((((min-colors 88) (class color))
1669 (:foreground "blue1" :background "white"))
1670 (((class color))
1671 (:foreground "blue" :background "white"))
1672 (t
1673 (:slant italic)))
1668 "Face used when the customize item has been set." 1674 "Face used when the customize item has been set."
1669 :group 'custom-magic-faces) 1675 :group 'custom-magic-faces)
1670 1676;; backward-compatibility alias
1671(defface custom-changed-face '((((min-colors 88) (class color)) 1677(put 'custom-set-face 'face-alias 'custom-set)
1672 (:foreground "white" :background "blue1")) 1678
1673 (((class color)) 1679(defface custom-changed '((((min-colors 88) (class color))
1674 (:foreground "white" :background "blue")) 1680 (:foreground "white" :background "blue1"))
1675 (t 1681 (((class color))
1676 (:slant italic))) 1682 (:foreground "white" :background "blue"))
1683 (t
1684 (:slant italic)))
1677 "Face used when the customize item has been changed." 1685 "Face used when the customize item has been changed."
1678 :group 'custom-magic-faces) 1686 :group 'custom-magic-faces)
1687;; backward-compatibility alias
1688(put 'custom-changed-face 'face-alias 'custom-changed)
1679 1689
1680(defface custom-saved-face '((t (:underline t))) 1690(defface custom-saved '((t (:underline t)))
1681 "Face used when the customize item has been saved." 1691 "Face used when the customize item has been saved."
1682 :group 'custom-magic-faces) 1692 :group 'custom-magic-faces)
1693;; backward-compatibility alias
1694(put 'custom-saved-face 'face-alias 'custom-saved)
1683 1695
1684(defconst custom-magic-alist 1696(defconst custom-magic-alist
1685 '((nil "#" underline "\ 1697 '((nil "#" underline "\
@@ -1689,21 +1701,21 @@ UNKNOWN, you should not see this.")
1689 (hidden "-" default "\ 1701 (hidden "-" default "\
1690HIDDEN, invoke \"Show\" in the previous line to show." "\ 1702HIDDEN, invoke \"Show\" in the previous line to show." "\
1691group now hidden, invoke \"Show\", above, to show contents.") 1703group now hidden, invoke \"Show\", above, to show contents.")
1692 (invalid "x" custom-invalid-face "\ 1704 (invalid "x" custom-invalid "\
1693INVALID, the displayed value cannot be set.") 1705INVALID, the displayed value cannot be set.")
1694 (modified "*" custom-modified-face "\ 1706 (modified "*" custom-modified "\
1695EDITED, shown value does not take effect until you set or save it." "\ 1707EDITED, shown value does not take effect until you set or save it." "\
1696something in this group has been edited but not set.") 1708something in this group has been edited but not set.")
1697 (set "+" custom-set-face "\ 1709 (set "+" custom-set "\
1698SET for current session only." "\ 1710SET for current session only." "\
1699something in this group has been set but not saved.") 1711something in this group has been set but not saved.")
1700 (changed ":" custom-changed-face "\ 1712 (changed ":" custom-changed "\
1701CHANGED outside Customize; operating on it here may be unreliable." "\ 1713CHANGED outside Customize; operating on it here may be unreliable." "\
1702something in this group has been changed outside customize.") 1714something in this group has been changed outside customize.")
1703 (saved "!" custom-saved-face "\ 1715 (saved "!" custom-saved "\
1704SAVED and set." "\ 1716SAVED and set." "\
1705something in this group has been set and saved.") 1717something in this group has been set and saved.")
1706 (rogue "@" custom-rogue-face "\ 1718 (rogue "@" custom-rogue "\
1707NO CUSTOMIZATION DATA; you should not see this." "\ 1719NO CUSTOMIZATION DATA; you should not see this." "\
1708something in this group is not prepared for customization.") 1720something in this group is not prepared for customization.")
1709 (standard " " nil "\ 1721 (standard " " nil "\
@@ -1830,7 +1842,7 @@ and `face'."
1830 (insert " (lisp)")) 1842 (insert " (lisp)"))
1831 ((eq form 'mismatch) 1843 ((eq form 'mismatch)
1832 (insert " (mismatch)"))) 1844 (insert " (mismatch)")))
1833 (put-text-property start (point) 'face 'custom-state-face)) 1845 (put-text-property start (point) 'face 'custom-state))
1834 (insert "\n")) 1846 (insert "\n"))
1835 (when (and (eq category 'group) 1847 (when (and (eq category 'group)
1836 (not (and (eq custom-buffer-style 'links) 1848 (not (and (eq custom-buffer-style 'links)
@@ -1864,7 +1876,7 @@ and `face'."
1864 1876
1865;;; The `custom' Widget. 1877;;; The `custom' Widget.
1866 1878
1867(defface custom-button-face 1879(defface custom-button
1868 '((((type x w32 mac) (class color)) ; Like default modeline 1880 '((((type x w32 mac) (class color)) ; Like default modeline
1869 (:box (:line-width 2 :style released-button) 1881 (:box (:line-width 2 :style released-button)
1870 :background "lightgrey" :foreground "black")) 1882 :background "lightgrey" :foreground "black"))
@@ -1873,8 +1885,10 @@ and `face'."
1873 "Face used for buttons in customization buffers." 1885 "Face used for buttons in customization buffers."
1874 :version "21.1" 1886 :version "21.1"
1875 :group 'custom-faces) 1887 :group 'custom-faces)
1888;; backward-compatibility alias
1889(put 'custom-button-face 'face-alias 'custom-button)
1876 1890
1877(defface custom-button-pressed-face 1891(defface custom-button-pressed
1878 '((((type x w32 mac) (class color)) 1892 '((((type x w32 mac) (class color))
1879 (:box (:line-width 2 :style pressed-button) 1893 (:box (:line-width 2 :style pressed-button)
1880 :background "lightgrey" :foreground "black")) 1894 :background "lightgrey" :foreground "black"))
@@ -1883,20 +1897,26 @@ and `face'."
1883 "Face used for buttons in customization buffers." 1897 "Face used for buttons in customization buffers."
1884 :version "21.1" 1898 :version "21.1"
1885 :group 'custom-faces) 1899 :group 'custom-faces)
1900;; backward-compatibility alias
1901(put 'custom-button-pressed-face 'face-alias 'custom-button-pressed)
1886 1902
1887(defface custom-documentation-face nil 1903(defface custom-documentation nil
1888 "Face used for documentation strings in customization buffers." 1904 "Face used for documentation strings in customization buffers."
1889 :group 'custom-faces) 1905 :group 'custom-faces)
1890 1906;; backward-compatibility alias
1891(defface custom-state-face '((((class color) 1907(put 'custom-documentation-face 'face-alias 'custom-documentation)
1892 (background dark)) 1908
1893 (:foreground "lime green")) 1909(defface custom-state '((((class color)
1894 (((class color) 1910 (background dark))
1895 (background light)) 1911 (:foreground "lime green"))
1896 (:foreground "dark green")) 1912 (((class color)
1897 (t nil)) 1913 (background light))
1914 (:foreground "dark green"))
1915 (t nil))
1898 "Face used for State descriptions in the customize buffer." 1916 "Face used for State descriptions in the customize buffer."
1899 :group 'custom-faces) 1917 :group 'custom-faces)
1918;; backward-compatibility alias
1919(put 'custom-state-face 'face-alias 'custom-state)
1900 1920
1901(define-widget 'custom 'default 1921(define-widget 'custom 'default
1902 "Customize a user option." 1922 "Customize a user option."
@@ -2092,20 +2112,22 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
2092;;; The `custom-comment' Widget. 2112;;; The `custom-comment' Widget.
2093 2113
2094;; like the editable field 2114;; like the editable field
2095(defface custom-comment-face '((((class grayscale color) 2115(defface custom-comment '((((class grayscale color)
2096 (background light)) 2116 (background light))
2097 (:background "gray85")) 2117 (:background "gray85"))
2098 (((class grayscale color) 2118 (((class grayscale color)
2099 (background dark)) 2119 (background dark))
2100 (:background "dim gray")) 2120 (:background "dim gray"))
2101 (t 2121 (t
2102 (:slant italic))) 2122 (:slant italic)))
2103 "Face used for comments on variables or faces" 2123 "Face used for comments on variables or faces"
2104 :version "21.1" 2124 :version "21.1"
2105 :group 'custom-faces) 2125 :group 'custom-faces)
2126;; backward-compatibility alias
2127(put 'custom-comment-face 'face-alias 'custom-comment)
2106 2128
2107;; like font-lock-comment-face 2129;; like font-lock-comment-face
2108(defface custom-comment-tag-face 2130(defface custom-comment-tag
2109 '((((class color) (background dark)) (:foreground "gray80")) 2131 '((((class color) (background dark)) (:foreground "gray80"))
2110 (((class color) (background light)) (:foreground "blue4")) 2132 (((class color) (background light)) (:foreground "blue4"))
2111 (((class grayscale) (background light)) 2133 (((class grayscale) (background light))
@@ -2115,6 +2137,8 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
2115 (t (:weight bold))) 2137 (t (:weight bold)))
2116 "Face used for variables or faces comment tags" 2138 "Face used for variables or faces comment tags"
2117 :group 'custom-faces) 2139 :group 'custom-faces)
2140;; backward-compatibility alias
2141(put 'custom-comment-tag-face 'face-alias 'custom-comment-tag)
2118 2142
2119(define-widget 'custom-comment 'string 2143(define-widget 'custom-comment 'string
2120 "User comment." 2144 "User comment."
@@ -2154,7 +2178,7 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
2154 2178
2155;; When this was underlined blue, users confused it with a 2179;; When this was underlined blue, users confused it with a
2156;; Mosaic-style hyperlink... 2180;; Mosaic-style hyperlink...
2157(defface custom-variable-tag-face 2181(defface custom-variable-tag
2158 `((((class color) 2182 `((((class color)
2159 (background dark)) 2183 (background dark))
2160 (:foreground "light blue" :weight bold :height 1.2 :inherit variable-pitch)) 2184 (:foreground "light blue" :weight bold :height 1.2 :inherit variable-pitch))
@@ -2163,14 +2187,18 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
2163 (:foreground "blue1" :weight bold :height 1.2 :inherit variable-pitch)) 2187 (:foreground "blue1" :weight bold :height 1.2 :inherit variable-pitch))
2164 (((class color) 2188 (((class color)
2165 (background light)) 2189 (background light))
2166 (:foreground "blue" :weight bold :height 1.2 :inherit variable-pitch)) 2190 (:foreground "blue" :weight bold :height 1.2 :inherit variable-pitch))
2167 (t (:weight bold))) 2191 (t (:weight bold)))
2168 "Face used for unpushable variable tags." 2192 "Face used for unpushable variable tags."
2169 :group 'custom-faces) 2193 :group 'custom-faces)
2194;; backward-compatibility alias
2195(put 'custom-variable-tag-face 'face-alias 'custom-variable-tag)
2170 2196
2171(defface custom-variable-button-face '((t (:underline t :weight bold))) 2197(defface custom-variable-button '((t (:underline t :weight bold)))
2172 "Face used for pushable variable tags." 2198 "Face used for pushable variable tags."
2173 :group 'custom-faces) 2199 :group 'custom-faces)
2200;; backward-compatibility alias
2201(put 'custom-variable-button-face 'face-alias 'custom-variable-button)
2174 2202
2175(defcustom custom-variable-default-form 'edit 2203(defcustom custom-variable-default-form 'edit
2176 "Default form of displaying variable values." 2204 "Default form of displaying variable values."
@@ -2874,10 +2902,12 @@ Only match frames that support the specified face attributes.")
2874 2902
2875;;; The `custom-face' Widget. 2903;;; The `custom-face' Widget.
2876 2904
2877(defface custom-face-tag-face 2905(defface custom-face-tag
2878 `((t (:weight bold :height 1.2 :inherit variable-pitch))) 2906 `((t (:weight bold :height 1.2 :inherit variable-pitch)))
2879 "Face used for face tags." 2907 "Face used for face tags."
2880 :group 'custom-faces) 2908 :group 'custom-faces)
2909;; backward-compatibility alias
2910(put 'custom-face-tag-face 'face-alias 'custom-face-tag)
2881 2911
2882(defcustom custom-face-default-form 'selected 2912(defcustom custom-face-default-form 'selected
2883 "Default form of displaying face definition." 2913 "Default form of displaying face definition."
@@ -3396,12 +3426,11 @@ restoring it to the state of a face that has never been customized."
3396 ;; Fixme: make it do so in Emacs. 3426 ;; Fixme: make it do so in Emacs.
3397 "Face used for group tags. 3427 "Face used for group tags.
3398The first member is used for level 1 groups, the second for level 2, 3428The first member is used for level 1 groups, the second for level 2,
3399and so forth. The remaining group tags are shown with 3429and so forth. The remaining group tags are shown with `custom-group-tag'."
3400`custom-group-tag-face'."
3401 :type '(repeat face) 3430 :type '(repeat face)
3402 :group 'custom-faces) 3431 :group 'custom-faces)
3403 3432
3404(defface custom-group-tag-face-1 3433(defface custom-group-tag-1
3405 `((((class color) 3434 `((((class color)
3406 (background dark)) 3435 (background dark))
3407 (:foreground "pink" :weight bold :height 1.2 :inherit variable-pitch)) 3436 (:foreground "pink" :weight bold :height 1.2 :inherit variable-pitch))
@@ -3414,8 +3443,10 @@ and so forth. The remaining group tags are shown with
3414 (t (:weight bold))) 3443 (t (:weight bold)))
3415 "Face used for group tags." 3444 "Face used for group tags."
3416 :group 'custom-faces) 3445 :group 'custom-faces)
3446;; backward-compatibility alias
3447(put 'custom-group-tag-face-1 'face-alias 'custom-group-tag-1)
3417 3448
3418(defface custom-group-tag-face 3449(defface custom-group-tag
3419 `((((class color) 3450 `((((class color)
3420 (background dark)) 3451 (background dark))
3421 (:foreground "light blue" :weight bold :height 1.2)) 3452 (:foreground "light blue" :weight bold :height 1.2))
@@ -3428,6 +3459,8 @@ and so forth. The remaining group tags are shown with
3428 (t (:weight bold))) 3459 (t (:weight bold)))
3429 "Face used for low level group tags." 3460 "Face used for low level group tags."
3430 :group 'custom-faces) 3461 :group 'custom-faces)
3462;; backward-compatibility alias
3463(put 'custom-group-tag-face 'face-alias 'custom-group-tag)
3431 3464
3432(define-widget 'custom-group 'custom 3465(define-widget 'custom-group 'custom
3433 "Customize group." 3466 "Customize group."
@@ -3448,7 +3481,7 @@ and so forth. The remaining group tags are shown with
3448(defun custom-group-sample-face-get (widget) 3481(defun custom-group-sample-face-get (widget)
3449 ;; Use :sample-face. 3482 ;; Use :sample-face.
3450 (or (nth (1- (widget-get widget :custom-level)) custom-group-tag-faces) 3483 (or (nth (1- (widget-get widget :custom-level)) custom-group-tag-faces)
3451 'custom-group-tag-face)) 3484 'custom-group-tag))
3452 3485
3453(define-widget 'custom-group-visibility 'visibility 3486(define-widget 'custom-group-visibility 'visibility
3454 "An indicator and manipulator for hidden group contents." 3487 "An indicator and manipulator for hidden group contents."
@@ -4261,13 +4294,12 @@ if that value is non-nil."
4261 (make-local-variable 'custom-options) 4294 (make-local-variable 'custom-options)
4262 (make-local-variable 'custom-local-buffer) 4295 (make-local-variable 'custom-local-buffer)
4263 (make-local-variable 'widget-documentation-face) 4296 (make-local-variable 'widget-documentation-face)
4264 (setq widget-documentation-face 'custom-documentation-face) 4297 (setq widget-documentation-face 'custom-documentation)
4265 (make-local-variable 'widget-button-face) 4298 (make-local-variable 'widget-button-face)
4266 (setq widget-button-face 'custom-button-face) 4299 (setq widget-button-face 'custom-button)
4267 (set (make-local-variable 'widget-button-pressed-face) 4300 (set (make-local-variable 'widget-button-pressed-face) 'custom-button-pressed)
4268 'custom-button-pressed-face)
4269 (set (make-local-variable 'widget-mouse-face) 4301 (set (make-local-variable 'widget-mouse-face)
4270 'custom-button-pressed-face) ; buttons `depress' when moused 4302 'custom-button-pressed) ; buttons `depress' when moused
4271 ;; When possible, use relief for buttons, not bracketing. This test 4303 ;; When possible, use relief for buttons, not bracketing. This test
4272 ;; may not be optimal. 4304 ;; may not be optimal.
4273 (when custom-raised-buttons 4305 (when custom-raised-buttons
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 36bebf68871..db14975a480 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -322,6 +322,8 @@ since it could result in memory overflow and make Emacs crash."
322 (eq system-type 'ms-dos)) 322 (eq system-type 'ms-dos))
323 ((string-match "\\`w32-" (symbol-name symbol)) 323 ((string-match "\\`w32-" (symbol-name symbol))
324 (eq system-type 'windows-nt)) 324 (eq system-type 'windows-nt))
325 ((string-match "\\`x-.*gtk" (symbol-name symbol))
326 (or (boundp 'gtk) (not (eq system-type 'windows-nt))))
325 ((string-match "\\`x-" (symbol-name symbol)) 327 ((string-match "\\`x-" (symbol-name symbol))
326 (fboundp 'x-create-frame)) 328 (fboundp 'x-create-frame))
327 (t t)))) 329 (t t))))
diff --git a/lisp/cvs-status.el b/lisp/cvs-status.el
index 324da8d3ce1..c8bd1e7e905 100644
--- a/lisp/cvs-status.el
+++ b/lisp/cvs-status.el
@@ -1,6 +1,6 @@
1;;; cvs-status.el --- major mode for browsing `cvs status' output -*- coding: utf-8 -*- 1;;; cvs-status.el --- major mode for browsing `cvs status' output -*- coding: utf-8 -*-
2 2
3;; Copyright (C) 1999, 2000, 2003, 2004 Free Software Foundation, Inc. 3;; Copyright (C) 1999, 2000, 2003, 2004, 2005 Free Software Foundation, Inc.
4 4
5;; Author: Stefan Monnier <monnier@cs.yale.edu> 5;; Author: Stefan Monnier <monnier@cs.yale.edu>
6;; Keywords: pcl-cvs cvs status tree tools 6;; Keywords: pcl-cvs cvs status tree tools
@@ -73,8 +73,8 @@
73 73
74(defconst cvs-status-font-lock-keywords 74(defconst cvs-status-font-lock-keywords
75 `((,cvs-status-entry-leader-re 75 `((,cvs-status-entry-leader-re
76 (1 'cvs-filename-face) 76 (1 'cvs-filename)
77 (2 'cvs-need-action-face)) 77 (2 'cvs-need-action))
78 (,cvs-status-tags-leader-re 78 (,cvs-status-tags-leader-re
79 (,cvs-status-rev-re 79 (,cvs-status-rev-re
80 (save-excursion (re-search-forward "^\n" nil 'move) (point)) 80 (save-excursion (re-search-forward "^\n" nil 'move) (point))
diff --git a/lisp/diff-mode.el b/lisp/diff-mode.el
index aabd09e98ee..1cb5111dcfb 100644
--- a/lisp/diff-mode.el
+++ b/lisp/diff-mode.el
@@ -175,7 +175,7 @@ when editing big diffs)."
175;;;; font-lock support 175;;;; font-lock support
176;;;; 176;;;;
177 177
178(defface diff-header-face 178(defface diff-header
179 '((((class color) (min-colors 88) (background light)) 179 '((((class color) (min-colors 88) (background light))
180 :background "grey85") 180 :background "grey85")
181 (((class color) (min-colors 88) (background dark)) 181 (((class color) (min-colors 88) (background dark))
@@ -187,9 +187,11 @@ when editing big diffs)."
187 (t :weight bold)) 187 (t :weight bold))
188 "`diff-mode' face inherited by hunk and index header faces." 188 "`diff-mode' face inherited by hunk and index header faces."
189 :group 'diff-mode) 189 :group 'diff-mode)
190(defvar diff-header-face 'diff-header-face) 190;; backward-compatibility alias
191(put 'diff-header-face 'face-alias 'diff-header)
192(defvar diff-header-face 'diff-header)
191 193
192(defface diff-file-header-face 194(defface diff-file-header
193 '((((class color) (min-colors 88) (background light)) 195 '((((class color) (min-colors 88) (background light))
194 :background "grey70" :weight bold) 196 :background "grey70" :weight bold)
195 (((class color) (min-colors 88) (background dark)) 197 (((class color) (min-colors 88) (background dark))
@@ -201,61 +203,76 @@ when editing big diffs)."
201 (t :weight bold)) ; :height 1.3 203 (t :weight bold)) ; :height 1.3
202 "`diff-mode' face used to highlight file header lines." 204 "`diff-mode' face used to highlight file header lines."
203 :group 'diff-mode) 205 :group 'diff-mode)
204(defvar diff-file-header-face 'diff-file-header-face) 206;; backward-compatibility alias
207(put 'diff-file-header-face 'face-alias 'diff-file-header)
208(defvar diff-file-header-face 'diff-file-header)
205 209
206(defface diff-index-face 210(defface diff-index
207 '((t :inherit diff-file-header-face)) 211 '((t :inherit diff-file-header))
208 "`diff-mode' face used to highlight index header lines." 212 "`diff-mode' face used to highlight index header lines."
209 :group 'diff-mode) 213 :group 'diff-mode)
210(defvar diff-index-face 'diff-index-face) 214;; backward-compatibility alias
215(put 'diff-index-face 'face-alias 'diff-index)
216(defvar diff-index-face 'diff-index)
211 217
212(defface diff-hunk-header-face 218(defface diff-hunk-header
213 '((t :inherit diff-header-face)) 219 '((t :inherit diff-header))
214 "`diff-mode' face used to highlight hunk header lines." 220 "`diff-mode' face used to highlight hunk header lines."
215 :group 'diff-mode) 221 :group 'diff-mode)
216(defvar diff-hunk-header-face 'diff-hunk-header-face) 222;; backward-compatibility alias
223(put 'diff-hunk-header-face 'face-alias 'diff-hunk-header)
224(defvar diff-hunk-header-face 'diff-hunk-header)
217 225
218(defface diff-removed-face 226(defface diff-removed
219 '((t :inherit diff-changed-face)) 227 '((t :inherit diff-changed))
220 "`diff-mode' face used to highlight removed lines." 228 "`diff-mode' face used to highlight removed lines."
221 :group 'diff-mode) 229 :group 'diff-mode)
222(defvar diff-removed-face 'diff-removed-face) 230;; backward-compatibility alias
231(put 'diff-removed-face 'face-alias 'diff-removed)
232(defvar diff-removed-face 'diff-removed)
223 233
224(defface diff-added-face 234(defface diff-added
225 '((t :inherit diff-changed-face)) 235 '((t :inherit diff-changed))
226 "`diff-mode' face used to highlight added lines." 236 "`diff-mode' face used to highlight added lines."
227 :group 'diff-mode) 237 :group 'diff-mode)
228(defvar diff-added-face 'diff-added-face) 238;; backward-compatibility alias
239(put 'diff-added-face 'face-alias 'diff-added)
240(defvar diff-added-face 'diff-added)
229 241
230(defface diff-changed-face 242(defface diff-changed
231 '((((type tty pc) (class color) (background light)) 243 '((((type tty pc) (class color) (background light))
232 :foreground "magenta" :weight bold :slant italic) 244 :foreground "magenta" :weight bold :slant italic)
233 (((type tty pc) (class color) (background dark)) 245 (((type tty pc) (class color) (background dark))
234 :foreground "yellow" :weight bold :slant italic)) 246 :foreground "yellow" :weight bold :slant italic))
235 "`diff-mode' face used to highlight changed lines." 247 "`diff-mode' face used to highlight changed lines."
236 :group 'diff-mode) 248 :group 'diff-mode)
237(defvar diff-changed-face 'diff-changed-face) 249;; backward-compatibility alias
250(put 'diff-changed-face 'face-alias 'diff-changed)
251(defvar diff-changed-face 'diff-changed)
238 252
239(defface diff-function-face 253(defface diff-function
240 '((t :inherit diff-context-face)) 254 '((t :inherit diff-context))
241 "`diff-mode' face used to highlight function names produced by \"diff -p\"." 255 "`diff-mode' face used to highlight function names produced by \"diff -p\"."
242 :group 'diff-mode) 256 :group 'diff-mode)
243(defvar diff-function-face 'diff-function-face) 257;; backward-compatibility alias
258(put 'diff-function-face 'face-alias 'diff-function)
259(defvar diff-function-face 'diff-function)
244 260
245(defface diff-context-face 261(defface diff-context
246 '((((class color) (background light)) 262 '((t :inherit shadow))
247 :foreground "grey50")
248 (((class color) (background dark))
249 :foreground "grey70"))
250 "`diff-mode' face used to highlight context and other side-information." 263 "`diff-mode' face used to highlight context and other side-information."
251 :group 'diff-mode) 264 :group 'diff-mode)
252(defvar diff-context-face 'diff-context-face) 265;; backward-compatibility alias
266(put 'diff-context-face 'face-alias 'diff-context)
267(defvar diff-context-face 'diff-context)
253 268
254(defface diff-nonexistent-face 269(defface diff-nonexistent
255 '((t :inherit diff-file-header-face)) 270 '((t :inherit diff-file-header))
256 "`diff-mode' face used to highlight nonexistent files in recursive diffs." 271 "`diff-mode' face used to highlight nonexistent files in recursive diffs."
257 :group 'diff-mode) 272 :group 'diff-mode)
258(defvar diff-nonexistent-face 'diff-nonexistent-face) 273;; backward-compatibility alias
274(put 'diff-nonexistent-face 'face-alias 'diff-nonexistent)
275(defvar diff-nonexistent-face 'diff-nonexistent)
259 276
260(defconst diff-yank-handler '(diff-yank-function)) 277(defconst diff-yank-handler '(diff-yank-function))
261(defun diff-yank-function (text) 278(defun diff-yank-function (text)
@@ -918,7 +935,7 @@ See `after-change-functions' for the meaning of BEG, END and LEN."
918Supports unified and context diffs as well as (to a lesser extent) 935Supports unified and context diffs as well as (to a lesser extent)
919normal diffs. 936normal diffs.
920When the buffer is read-only, the ESC prefix is not necessary. 937When the buffer is read-only, the ESC prefix is not necessary.
921IF you edit the buffer manually, diff-mode will try to update the hunk 938If you edit the buffer manually, diff-mode will try to update the hunk
922headers for you on-the-fly. 939headers for you on-the-fly.
923 940
924You can also switch between context diff and unified diff with \\[diff-context->unified], 941You can also switch between context diff and unified diff with \\[diff-context->unified],
diff --git a/lisp/dired.el b/lisp/dired.el
index b0d86297e71..61aca72db5b 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -356,7 +356,7 @@ Subexpression 2 must end right before the \\n or \\r.")
356 "Face name used for symbolic links.") 356 "Face name used for symbolic links.")
357 357
358(defface dired-ignored 358(defface dired-ignored
359 '((t (:inherit font-lock-string-face))) 359 '((t (:inherit shadow)))
360 "Face used for files suffixed with `completion-ignored-extensions'." 360 "Face used for files suffixed with `completion-ignored-extensions'."
361 :group 'dired-faces 361 :group 'dired-faces
362 :version "22.1") 362 :version "22.1")
diff --git a/lisp/ediff-diff.el b/lisp/ediff-diff.el
index 4c13e6fc0e1..ec496301405 100644
--- a/lisp/ediff-diff.el
+++ b/lisp/ediff-diff.el
@@ -1353,7 +1353,7 @@ Symlinks and the likes are not handled.
1353If FILTER-RE is non-nil, recursive checking in directories 1353If FILTER-RE is non-nil, recursive checking in directories
1354affects only files whose names match the expression." 1354affects only files whose names match the expression."
1355 ;; Normalize empty filter RE to nil. 1355 ;; Normalize empty filter RE to nil.
1356 (unless (length filter-re) (setq filter-re nil)) 1356 (unless (> (length filter-re) 0) (setq filter-re nil))
1357 ;; Indicate progress 1357 ;; Indicate progress
1358 (message "Comparing '%s' and '%s' modulo '%s'" d1 d2 filter-re) 1358 (message "Comparing '%s' and '%s' modulo '%s'" d1 d2 filter-re)
1359 (cond 1359 (cond
@@ -1367,27 +1367,11 @@ affects only files whose names match the expression."
1367 (if (eq ediff-recurse-to-subdirectories 'yes) 1367 (if (eq ediff-recurse-to-subdirectories 'yes)
1368 (let* ((all-entries-1 (directory-files d1 t filter-re)) 1368 (let* ((all-entries-1 (directory-files d1 t filter-re))
1369 (all-entries-2 (directory-files d2 t filter-re)) 1369 (all-entries-2 (directory-files d2 t filter-re))
1370 (entries-1 (remove-if (lambda (s) 1370 (entries-1 (ediff-delete-all-matches "^\\.\\.?$" all-entries-1))
1371 (string-match "^\\.\\.?$" 1371 (entries-2 (ediff-delete-all-matches "^\\.\\.?$" all-entries-2))
1372 (file-name-nondirectory s)))
1373 all-entries-1))
1374 (entries-2 (remove-if (lambda (s)
1375 (string-match "^\\.\\.?$"
1376 (file-name-nondirectory s)))
1377 all-entries-2))
1378 ) 1372 )
1379 ;; First, check only the names (works quickly and ensures a 1373
1380 ;; precondition for subsequent code) 1374 (ediff-same-file-contents-lists entries-1 entries-2 filter-re)
1381 (if (and (= (length entries-1) (length entries-2))
1382 (every (lambda (a b) (equal (file-name-nondirectory a)
1383 (file-name-nondirectory b)))
1384 entries-1 entries-2))
1385 ;; With name equality established, compare the entries
1386 ;; through recursion.
1387 (every (lambda (a b)
1388 (ediff-same-contents a b filter-re))
1389 entries-1 entries-2)
1390 )
1391 )) 1375 ))
1392 ) ; end of the directories case 1376 ) ; end of the directories case
1393 ;; D1 & D2 are both files => compare directly 1377 ;; D1 & D2 are both files => compare directly
@@ -1398,6 +1382,42 @@ affects only files whose names match the expression."
1398 ) 1382 )
1399 ) 1383 )
1400 1384
1385;; If lists have the same length and names of files are pairwise equal
1386;; (removing the directories) then compare contents pairwise.
1387;; True if all contents are the same; false otherwise
1388(defun ediff-same-file-contents-lists (entries-1 entries-2 filter-re)
1389 ;; First, check only the names (works quickly and ensures a
1390 ;; precondition for subsequent code)
1391 (if (and (= (length entries-1) (length entries-2))
1392 (equal (mapcar 'file-name-nondirectory entries-1)
1393 (mapcar 'file-name-nondirectory entries-2)))
1394 ;; With name equality established, compare the entries
1395 ;; through recursion.
1396 (let ((continue t))
1397 (while (and entries-1 continue)
1398 (if (ediff-same-contents
1399 (car entries-1) (car entries-2) filter-re)
1400 (setq entries-1 (cdr entries-1)
1401 entries-2 (cdr entries-2))
1402 (setq continue nil))
1403 )
1404 ;; if reached the end then lists are equal
1405 (null entries-1))
1406 )
1407 )
1408
1409
1410;; ARG1 is a regexp, ARG2 is a list of full-filenames
1411;; Delete all entries that match the regexp
1412(defun ediff-delete-all-matches (regex file-list-list)
1413 (let (result elt)
1414 (while file-list-list
1415 (setq elt (car file-list-list))
1416 (or (string-match regex (file-name-nondirectory elt))
1417 (setq result (cons elt result)))
1418 (setq file-list-list (cdr file-list-list)))
1419 (reverse result)))
1420
1401 1421
1402;;; Local Variables: 1422;;; Local Variables:
1403;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun) 1423;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun)
diff --git a/lisp/ediff-help.el b/lisp/ediff-help.el
index bdd92f5c12d..69d170faedf 100644
--- a/lisp/ediff-help.el
+++ b/lisp/ediff-help.el
@@ -132,7 +132,7 @@ Normally, not a user option. See `ediff-help-message' for details.")
132 "Normally, not a user option. See `ediff-help-message' for details.") 132 "Normally, not a user option. See `ediff-help-message' for details.")
133 133
134(defconst ediff-brief-message-string 134(defconst ediff-brief-message-string
135 " ? -quick help " 135 " Type ? for help"
136 "Contents of the brief help message.") 136 "Contents of the brief help message.")
137;; The actual brief help message 137;; The actual brief help message
138(ediff-defvar-local ediff-brief-help-message "" 138(ediff-defvar-local ediff-brief-help-message ""
diff --git a/lisp/ediff-mult.el b/lisp/ediff-mult.el
index 41a7699cfdc..d3710258d24 100644
--- a/lisp/ediff-mult.el
+++ b/lisp/ediff-mult.el
@@ -410,7 +410,8 @@ Commands:
410\\{ediff-meta-buffer-map}" 410\\{ediff-meta-buffer-map}"
411 (kill-all-local-variables) 411 (kill-all-local-variables)
412 (setq major-mode 'ediff-meta-mode) 412 (setq major-mode 'ediff-meta-mode)
413 (setq mode-name "MetaEdiff")) 413 (setq mode-name "MetaEdiff")
414 (run-mode-hooks 'ediff-meta-mode-hook))
414 415
415 416
416;; the keymap for the buffer showing directory differences 417;; the keymap for the buffer showing directory differences
@@ -560,17 +561,23 @@ behavior."
560 (ediff-add-slash-if-directory auxdir1 elt)) 561 (ediff-add-slash-if-directory auxdir1 elt))
561 lis1) 562 lis1)
562 auxdir2 (file-name-as-directory dir2) 563 auxdir2 (file-name-as-directory dir2)
564 lis2 (directory-files auxdir2 nil regexp)
565 lis2 (delete "." lis2)
566 lis2 (delete ".." lis2)
563 lis2 (mapcar 567 lis2 (mapcar
564 (lambda (elt) 568 (lambda (elt)
565 (ediff-add-slash-if-directory auxdir2 elt)) 569 (ediff-add-slash-if-directory auxdir2 elt))
566 (directory-files auxdir2 nil regexp))) 570 lis2))
567 571
568 (if (stringp dir3) 572 (if (stringp dir3)
569 (setq auxdir3 (file-name-as-directory dir3) 573 (setq auxdir3 (file-name-as-directory dir3)
574 lis3 (directory-files auxdir3 nil regexp)
575 lis3 (delete "." lis3)
576 lis3 (delete ".." lis3)
570 lis3 (mapcar 577 lis3 (mapcar
571 (lambda (elt) 578 (lambda (elt)
572 (ediff-add-slash-if-directory auxdir3 elt)) 579 (ediff-add-slash-if-directory auxdir3 elt))
573 (directory-files auxdir3 nil regexp)))) 580 lis3)))
574 581
575 (if (ediff-nonempty-string-p merge-autostore-dir) 582 (if (ediff-nonempty-string-p merge-autostore-dir)
576 (setq merge-autostore-dir 583 (setq merge-autostore-dir
diff --git a/lisp/ediff.el b/lisp/ediff.el
index 2a2b481ec59..00a7e2f512a 100644
--- a/lisp/ediff.el
+++ b/lisp/ediff.el
@@ -7,7 +7,7 @@
7;; Keywords: comparing, merging, patching, tools, unix 7;; Keywords: comparing, merging, patching, tools, unix
8 8
9(defconst ediff-version "2.80" "The current version of Ediff") 9(defconst ediff-version "2.80" "The current version of Ediff")
10(defconst ediff-date "February 19, 2005" "Date of last update") 10(defconst ediff-date "June 3, 2005" "Date of last update")
11 11
12 12
13;; This file is part of GNU Emacs. 13;; This file is part of GNU Emacs.
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index d8b4b4f6c19..7ed01e4bdea 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -85,7 +85,7 @@
85;; (items u8) 85;; (items u8)
86;; (fill 3) 86;; (fill 3)
87;; (item repeat (items) 87;; (item repeat (items)
88;; ((struct data-spec))))) 88;; (struct data-spec))))
89;; 89;;
90;; 90;;
91;; A binary data representation may look like 91;; A binary data representation may look like
@@ -131,7 +131,7 @@
131;; | ( [FIELD] align LEN ) -- skip to next multiple of LEN bytes 131;; | ( [FIELD] align LEN ) -- skip to next multiple of LEN bytes
132;; | ( [FIELD] struct SPEC_NAME ) 132;; | ( [FIELD] struct SPEC_NAME )
133;; | ( [FIELD] union TAG_VAL (TAG SPEC)... [(t SPEC)] ) 133;; | ( [FIELD] union TAG_VAL (TAG SPEC)... [(t SPEC)] )
134;; | ( [FIELD] repeat COUNT SPEC ) 134;; | ( [FIELD] repeat COUNT ITEM... )
135 135
136;; -- In (eval EXPR), the value of the last field is available in 136;; -- In (eval EXPR), the value of the last field is available in
137;; the dynamically bound variable `last'. 137;; the dynamically bound variable `last'.
@@ -151,7 +151,8 @@
151;; -- Note: 32 bit values may be limited by emacs' INTEGER 151;; -- Note: 32 bit values may be limited by emacs' INTEGER
152;; implementation limits. 152;; implementation limits.
153;; 153;;
154;; -- Example: bits 2 will map bytes 0x1c 0x28 to list (2 3 7 11 13) 154;; -- Example: `bits 2' will unpack 0x28 0x1c to (2 3 4 11 13)
155;; and 0x1c 0x28 to (3 5 10 11 12).
155 156
156;; FIELD ::= ( eval EXPR ) -- use result as NAME 157;; FIELD ::= ( eval EXPR ) -- use result as NAME
157;; | NAME 158;; | NAME
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 7fc01901cfe..d3def79c8fb 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -100,23 +100,23 @@ The return value of this function is not used."
100 (eval-and-compile 100 (eval-and-compile
101 (put ',name 'byte-optimizer 'byte-compile-inline-expand)))) 101 (put ',name 'byte-optimizer 'byte-compile-inline-expand))))
102 102
103(defun make-obsolete (function new &optional when) 103(defun make-obsolete (obsolete-name current-name &optional when)
104 "Make the byte-compiler warn that FUNCTION is obsolete. 104 "Make the byte-compiler warn that OBSOLETE-NAME is obsolete.
105The warning will say that NEW should be used instead. 105The warning will say that CURRENT-NAME should be used instead.
106If NEW is a string, that is the `use instead' message. 106If CURRENT-NAME is a string, that is the `use instead' message.
107If provided, WHEN should be a string indicating when the function 107If provided, WHEN should be a string indicating when the function
108was first made obsolete, for example a date or a release number." 108was first made obsolete, for example a date or a release number."
109 (interactive "aMake function obsolete: \nxObsoletion replacement: ") 109 (interactive "aMake function obsolete: \nxObsoletion replacement: ")
110 (let ((handler (get function 'byte-compile))) 110 (let ((handler (get obsolete-name 'byte-compile)))
111 (if (eq 'byte-compile-obsolete handler) 111 (if (eq 'byte-compile-obsolete handler)
112 (setq handler (nth 1 (get function 'byte-obsolete-info))) 112 (setq handler (nth 1 (get obsolete-name 'byte-obsolete-info)))
113 (put function 'byte-compile 'byte-compile-obsolete)) 113 (put obsolete-name 'byte-compile 'byte-compile-obsolete))
114 (put function 'byte-obsolete-info (list new handler when))) 114 (put obsolete-name 'byte-obsolete-info (list current-name handler when)))
115 function) 115 obsolete-name)
116 116
117(defmacro define-obsolete-function-alias (function new 117(defmacro define-obsolete-function-alias (obsolete-name current-name
118 &optional when docstring) 118 &optional when docstring)
119 "Set FUNCTION's function definition to NEW and mark it obsolete. 119 "Set OBSOLETE-NAME's function definition to CURRENT-NAME and mark it obsolete.
120 120
121\(define-obsolete-function-alias 'old-fun 'new-fun \"22.1\" \"old-fun's doc.\") 121\(define-obsolete-function-alias 'old-fun 'new-fun \"22.1\" \"old-fun's doc.\")
122 122
@@ -127,13 +127,13 @@ is equivalent to the following two lines of code:
127 127
128See the docstrings of `defalias' and `make-obsolete' for more details." 128See the docstrings of `defalias' and `make-obsolete' for more details."
129 `(progn 129 `(progn
130 (defalias ,function ,new ,docstring) 130 (defalias ,obsolete-name ,current-name ,docstring)
131 (make-obsolete ,function ,new ,when))) 131 (make-obsolete ,obsolete-name ,current-name ,when)))
132 132
133(defun make-obsolete-variable (variable new &optional when) 133(defun make-obsolete-variable (obsolete-name current-name &optional when)
134 "Make the byte-compiler warn that VARIABLE is obsolete. 134 "Make the byte-compiler warn that OBSOLETE-NAME is obsolete.
135The warning will say that NEW should be used instead. 135The warning will say that CURRENT-NAME should be used instead.
136If NEW is a string, that is the `use instead' message. 136If CURRENT-NAME is a string, that is the `use instead' message.
137If provided, WHEN should be a string indicating when the variable 137If provided, WHEN should be a string indicating when the variable
138was first made obsolete, for example a date or a release number." 138was first made obsolete, for example a date or a release number."
139 (interactive 139 (interactive
@@ -142,12 +142,12 @@ was first made obsolete, for example a date or a release number."
142 (if (equal str "") (error "")) 142 (if (equal str "") (error ""))
143 (intern str)) 143 (intern str))
144 (car (read-from-string (read-string "Obsoletion replacement: "))))) 144 (car (read-from-string (read-string "Obsoletion replacement: ")))))
145 (put variable 'byte-obsolete-variable (cons new when)) 145 (put obsolete-name 'byte-obsolete-variable (cons current-name when))
146 variable) 146 obsolete-name)
147 147
148(defmacro define-obsolete-variable-alias (variable new 148(defmacro define-obsolete-variable-alias (obsolete-name current-name
149 &optional when docstring) 149 &optional when docstring)
150 "Make VARIABLE a variable alias for NEW and mark it obsolete. 150 "Make OBSOLETE-NAME a variable alias for CURRENT-NAME and mark it obsolete.
151 151
152\(define-obsolete-variable-alias 'old-var 'new-var \"22.1\" \"old-var's doc.\") 152\(define-obsolete-variable-alias 'old-var 'new-var \"22.1\" \"old-var's doc.\")
153 153
@@ -159,8 +159,8 @@ is equivalent to the following two lines of code:
159See the docstrings of `defvaralias' and `make-obsolete-variable' or 159See the docstrings of `defvaralias' and `make-obsolete-variable' or
160Info node `(elisp)Variable Aliases' for more details." 160Info node `(elisp)Variable Aliases' for more details."
161 `(progn 161 `(progn
162 (defvaralias ,variable ,new ,docstring) 162 (defvaralias ,obsolete-name ,current-name ,docstring)
163 (make-obsolete-variable ,variable ,new ,when))) 163 (make-obsolete-variable ,obsolete-name ,current-name ,when)))
164 164
165(defmacro dont-compile (&rest body) 165(defmacro dont-compile (&rest body)
166 "Like `progn', but the body always runs interpreted (not compiled). 166 "Like `progn', but the body always runs interpreted (not compiled).
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 2149cba8720..0ee67355bf4 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -88,6 +88,8 @@ This is to optimize `debugger-make-xrefs'.")
88(defvar debugger-outer-standard-output) 88(defvar debugger-outer-standard-output)
89(defvar debugger-outer-inhibit-redisplay) 89(defvar debugger-outer-inhibit-redisplay)
90(defvar debugger-outer-cursor-in-echo-area) 90(defvar debugger-outer-cursor-in-echo-area)
91(defvar debugger-will-be-back nil
92 "Non-nil if we expect to get back in the debugger soon.")
91 93
92(defvar inhibit-debug-on-entry nil 94(defvar inhibit-debug-on-entry nil
93 "Non-nil means that debug-on-entry is disabled.") 95 "Non-nil means that debug-on-entry is disabled.")
@@ -97,6 +99,8 @@ This is to optimize `debugger-make-xrefs'.")
97This variable is used by `debugger-jump', `debugger-step-through', 99This variable is used by `debugger-jump', `debugger-step-through',
98and `debugger-reenable' to temporarily disable debug-on-entry.") 100and `debugger-reenable' to temporarily disable debug-on-entry.")
99 101
102(defvar inhibit-trace) ;Not yet implemented.
103
100;;;###autoload 104;;;###autoload
101(setq debugger 'debug) 105(setq debugger 'debug)
102;;;###autoload 106;;;###autoload
@@ -121,6 +125,7 @@ first will be printed into the backtrace buffer."
121 (get-buffer-create "*Backtrace*"))) 125 (get-buffer-create "*Backtrace*")))
122 (debugger-old-buffer (current-buffer)) 126 (debugger-old-buffer (current-buffer))
123 (debugger-step-after-exit nil) 127 (debugger-step-after-exit nil)
128 (debugger-will-be-back nil)
124 ;; Don't keep reading from an executing kbd macro! 129 ;; Don't keep reading from an executing kbd macro!
125 (executing-kbd-macro nil) 130 (executing-kbd-macro nil)
126 ;; Save the outer values of these vars for the `e' command 131 ;; Save the outer values of these vars for the `e' command
@@ -178,7 +183,7 @@ first will be printed into the backtrace buffer."
178 ;; Place an extra debug-on-exit for macro's. 183 ;; Place an extra debug-on-exit for macro's.
179 (when (eq 'lambda (car-safe (cadr (backtrace-frame 4)))) 184 (when (eq 'lambda (car-safe (cadr (backtrace-frame 4))))
180 (backtrace-debug 5 t))) 185 (backtrace-debug 5 t)))
181 (pop-to-buffer debugger-buffer) 186 (pop-to-buffer debugger-buffer)
182 (debugger-mode) 187 (debugger-mode)
183 (debugger-setup-buffer debugger-args) 188 (debugger-setup-buffer debugger-args)
184 (when noninteractive 189 (when noninteractive
@@ -210,12 +215,23 @@ first will be printed into the backtrace buffer."
210 ;; Still visible despite the save-window-excursion? Maybe it 215 ;; Still visible despite the save-window-excursion? Maybe it
211 ;; it's in a pop-up frame. It would be annoying to delete and 216 ;; it's in a pop-up frame. It would be annoying to delete and
212 ;; recreate it every time the debugger stops, so instead we'll 217 ;; recreate it every time the debugger stops, so instead we'll
213 ;; erase it and hide it but keep it alive. 218 ;; erase it (and maybe hide it) but keep it alive.
214 (with-current-buffer debugger-buffer 219 (with-current-buffer debugger-buffer
215 (erase-buffer) 220 (erase-buffer)
216 (fundamental-mode) 221 (fundamental-mode)
217 (with-selected-window (get-buffer-window debugger-buffer 0) 222 (with-selected-window (get-buffer-window debugger-buffer 0)
218 (bury-buffer))) 223 (when (and (window-dedicated-p (selected-window))
224 (not debugger-will-be-back))
225 ;; If the window is not dedicated, burying the buffer
226 ;; will mean that the frame created for it is left
227 ;; around showing some random buffer, and next time we
228 ;; pop to the debugger buffer we'll create yet
229 ;; another frame.
230 ;; If debugger-will-be-back is non-nil, the frame
231 ;; would need to be de-iconified anyway immediately
232 ;; after when we re-enter the debugger, so iconifying it
233 ;; here would cause flashing.
234 (bury-buffer))))
219 (kill-buffer debugger-buffer)) 235 (kill-buffer debugger-buffer))
220 (set-match-data debugger-outer-match-data))) 236 (set-match-data debugger-outer-match-data)))
221 ;; Put into effect the modified values of these variables 237 ;; Put into effect the modified values of these variables
@@ -307,7 +323,7 @@ That buffer should be current already."
307 (save-excursion 323 (save-excursion
308 (set-buffer (or buffer (current-buffer))) 324 (set-buffer (or buffer (current-buffer)))
309 (setq buffer (current-buffer)) 325 (setq buffer (current-buffer))
310 (let ((buffer-read-only nil) 326 (let ((inhibit-read-only t)
311 (old-end (point-min)) (new-end (point-min))) 327 (old-end (point-min)) (new-end (point-min)))
312 ;; If we saved an old backtrace, find the common part 328 ;; If we saved an old backtrace, find the common part
313 ;; between the new and the old. 329 ;; between the new and the old.
@@ -377,6 +393,7 @@ Enter another debugger on next entry to eval, apply or funcall."
377 (interactive) 393 (interactive)
378 (setq debugger-step-after-exit t) 394 (setq debugger-step-after-exit t)
379 (setq debugger-jumping-flag t) 395 (setq debugger-jumping-flag t)
396 (setq debugger-will-be-back t)
380 (add-hook 'post-command-hook 'debugger-reenable) 397 (add-hook 'post-command-hook 'debugger-reenable)
381 (message "Proceeding, will debug on next eval or call.") 398 (message "Proceeding, will debug on next eval or call.")
382 (exit-recursive-edit)) 399 (exit-recursive-edit))
@@ -387,6 +404,12 @@ Enter another debugger on next entry to eval, apply or funcall."
387 (unless debugger-may-continue 404 (unless debugger-may-continue
388 (error "Cannot continue")) 405 (error "Cannot continue"))
389 (message "Continuing.") 406 (message "Continuing.")
407 (save-excursion
408 ;; Check to see if we've flagged some frame for debug-on-exit, in which
409 ;; case we'll probably come back to the debugger soon.
410 (goto-char (point-min))
411 (if (re-search-forward "^\\* " nil t)
412 (setq debugger-will-be-back t)))
390 (exit-recursive-edit)) 413 (exit-recursive-edit))
391 414
392(defun debugger-return-value (val) 415(defun debugger-return-value (val)
@@ -397,6 +420,12 @@ will be used, such as in a debug on exit from a frame."
397 (setq debugger-value val) 420 (setq debugger-value val)
398 (princ "Returning " t) 421 (princ "Returning " t)
399 (prin1 debugger-value) 422 (prin1 debugger-value)
423 (save-excursion
424 ;; Check to see if we've flagged some frame for debug-on-exit, in which
425 ;; case we'll probably come back to the debugger soon.
426 (goto-char (point-min))
427 (if (re-search-forward "^\\* " nil t)
428 (setq debugger-will-be-back t)))
400 (exit-recursive-edit)) 429 (exit-recursive-edit))
401 430
402(defun debugger-jump () 431(defun debugger-jump ()
@@ -406,6 +435,7 @@ will be used, such as in a debug on exit from a frame."
406 (setq debugger-jumping-flag t) 435 (setq debugger-jumping-flag t)
407 (add-hook 'post-command-hook 'debugger-reenable) 436 (add-hook 'post-command-hook 'debugger-reenable)
408 (message "Continuing through this frame") 437 (message "Continuing through this frame")
438 (setq debugger-will-be-back t)
409 (exit-recursive-edit)) 439 (exit-recursive-edit))
410 440
411(defun debugger-reenable () 441(defun debugger-reenable ()
@@ -454,7 +484,7 @@ Applies to the frame whose line point is on in the backtrace."
454 (beginning-of-line) 484 (beginning-of-line)
455 (backtrace-debug (debugger-frame-number) t) 485 (backtrace-debug (debugger-frame-number) t)
456 (if (= (following-char) ? ) 486 (if (= (following-char) ? )
457 (let ((buffer-read-only nil)) 487 (let ((inhibit-read-only t))
458 (delete-char 1) 488 (delete-char 1)
459 (insert ?*))) 489 (insert ?*)))
460 (beginning-of-line)) 490 (beginning-of-line))
@@ -470,7 +500,7 @@ Applies to the frame whose line point is on in the backtrace."
470 (beginning-of-line) 500 (beginning-of-line)
471 (backtrace-debug (debugger-frame-number) nil) 501 (backtrace-debug (debugger-frame-number) nil)
472 (if (= (following-char) ?*) 502 (if (= (following-char) ?*)
473 (let ((buffer-read-only nil)) 503 (let ((inhibit-read-only t))
474 (delete-char 1) 504 (delete-char 1)
475 (insert ? ))) 505 (insert ? )))
476 (beginning-of-line)) 506 (beginning-of-line))
@@ -584,7 +614,7 @@ Applies to the frame whose line point is on in the backtrace."
584 (terpri)) 614 (terpri))
585 615
586 (with-current-buffer (get-buffer debugger-record-buffer) 616 (with-current-buffer (get-buffer debugger-record-buffer)
587 (message "%s" 617 (message "%s"
588 (buffer-substring (line-beginning-position 0) 618 (buffer-substring (line-beginning-position 0)
589 (line-end-position 0))))) 619 (line-end-position 0)))))
590 620
@@ -626,22 +656,29 @@ functions to break on entry."
626;;;###autoload 656;;;###autoload
627(defun debug-on-entry (function) 657(defun debug-on-entry (function)
628 "Request FUNCTION to invoke debugger each time it is called. 658 "Request FUNCTION to invoke debugger each time it is called.
629If you tell the debugger to continue, FUNCTION's execution proceeds. 659
630This works by modifying the definition of FUNCTION, 660When called interactively, prompt for FUNCTION in the minibuffer.
631which must be written in Lisp, not predefined. 661
662This works by modifying the definition of FUNCTION. If you tell the
663debugger to continue, FUNCTION's execution proceeds. If FUNCTION is a
664normal function or a macro written in Lisp, you can also step through
665its execution. FUNCTION can also be a primitive that is not a special
666form, in which case stepping is not possible. Break-on-entry for
667primitive functions only works when that function is called from Lisp.
668
632Use \\[cancel-debug-on-entry] to cancel the effect of this command. 669Use \\[cancel-debug-on-entry] to cancel the effect of this command.
633Redefining FUNCTION also cancels it." 670Redefining FUNCTION also cancels it."
634 (interactive "aDebug on entry (to function): ") 671 (interactive "aDebug on entry (to function): ")
635 (when (and (subrp (symbol-function function)) 672 (when (and (subrp (symbol-function function))
636 (eq (cdr (subr-arity (symbol-function function))) 'unevalled)) 673 (eq (cdr (subr-arity (symbol-function function))) 'unevalled))
637 (error "Function %s is a special form" function)) 674 (error "Function %s is a special form" function))
638 (if (or (symbolp (symbol-function function)) 675 (if (or (symbolp (symbol-function function))
639 (subrp (symbol-function function))) 676 (subrp (symbol-function function)))
640 ;; The function is built-in or aliased to another function. 677 ;; The function is built-in or aliased to another function.
641 ;; Create a wrapper in which we can add the debug call. 678 ;; Create a wrapper in which we can add the debug call.
642 (fset function `(lambda (&rest debug-on-entry-args) 679 (fset function `(lambda (&rest debug-on-entry-args)
643 ,(interactive-form (symbol-function function)) 680 ,(interactive-form (symbol-function function))
644 (apply ',(symbol-function function) 681 (apply ',(symbol-function function)
645 debug-on-entry-args))) 682 debug-on-entry-args)))
646 (when (eq (car-safe (symbol-function function)) 'autoload) 683 (when (eq (car-safe (symbol-function function)) 'autoload)
647 ;; The function is autoloaded. Load its real definition. 684 ;; The function is autoloaded. Load its real definition.
@@ -662,14 +699,19 @@ Redefining FUNCTION also cancels it."
662;;;###autoload 699;;;###autoload
663(defun cancel-debug-on-entry (&optional function) 700(defun cancel-debug-on-entry (&optional function)
664 "Undo effect of \\[debug-on-entry] on FUNCTION. 701 "Undo effect of \\[debug-on-entry] on FUNCTION.
665If argument is nil or an empty string, cancel for all functions." 702If FUNCTION is nil, cancel debug-on-entry for all functions.
703When called interactively, prompt for FUNCTION in the minibuffer.
704To specify a nil argument interactively, exit with an empty minibuffer."
666 (interactive 705 (interactive
667 (list (let ((name 706 (list (let ((name
668 (completing-read "Cancel debug on entry (to function): " 707 (completing-read
669 (mapcar 'symbol-name debug-function-list) 708 "Cancel debug on entry to function (default: all functions): "
670 nil t nil))) 709 (mapcar 'symbol-name debug-function-list) nil t)))
671 (if name (intern name))))) 710 (when name
672 (if (and function (not (string= function ""))) 711 (unless (string= name "")
712 (intern name))))))
713 (if (and function
714 (not (string= function ""))) ; Pre 22.1 compatibility test.
673 (progn 715 (progn
674 (let ((defn (debug-on-entry-1 function nil))) 716 (let ((defn (debug-on-entry-1 function nil)))
675 (condition-case nil 717 (condition-case nil
@@ -709,7 +751,7 @@ If argument is nil or an empty string, cancel for all functions."
709(defun debug-on-entry-1 (function flag) 751(defun debug-on-entry-1 (function flag)
710 (let* ((defn (symbol-function function)) 752 (let* ((defn (symbol-function function))
711 (tail defn)) 753 (tail defn))
712 (when (eq (car-safe tail) 'macro) 754 (when (eq (car-safe tail) 'macro)
713 (setq tail (cdr tail))) 755 (setq tail (cdr tail)))
714 (if (not (eq (car-safe tail) 'lambda)) 756 (if (not (eq (car-safe tail) 'lambda))
715 ;; Only signal an error when we try to set debug-on-entry. 757 ;; Only signal an error when we try to set debug-on-entry.
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index 5ba9c094355..943f052fc6d 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -1,5 +1,5 @@
1;;; derived.el --- allow inheritance of major modes 1;;; derived.el --- allow inheritance of major modes
2;;; (formerly mode-clone.el) 2;; (formerly mode-clone.el)
3 3
4;; Copyright (C) 1993, 1994, 1999, 2003 Free Software Foundation, Inc. 4;; Copyright (C) 1993, 1994, 1999, 2003 Free Software Foundation, Inc.
5 5
@@ -221,6 +221,12 @@ See Info node `(elisp)Derived Modes' for more details."
221 (get (quote ,parent) 'mode-class))) 221 (get (quote ,parent) 'mode-class)))
222 ; Set up maps and tables. 222 ; Set up maps and tables.
223 (unless (keymap-parent ,map) 223 (unless (keymap-parent ,map)
224 ;; It would probably be better to set the keymap's parent
225 ;; at the toplevel rather than inside the mode function,
226 ;; but this is not easy for at least the following reasons:
227 ;; - the parent (and its keymap) may not yet be loaded.
228 ;; - the parent's keymap name may be called something else
229 ;; than <parent>-mode-map.
224 (set-keymap-parent ,map (current-local-map))) 230 (set-keymap-parent ,map (current-local-map)))
225 ,(when declare-syntax 231 ,(when declare-syntax
226 `(let ((parent (char-table-parent ,syntax))) 232 `(let ((parent (char-table-parent ,syntax)))
@@ -440,5 +446,5 @@ Where the new table already has an entry, nothing is copied from the old one."
440 446
441(provide 'derived) 447(provide 'derived)
442 448
443;;; arch-tag: 630be248-47d1-4f02-afa0-8207de0ebea0 449;; arch-tag: 630be248-47d1-4f02-afa0-8207de0ebea0
444;;; derived.el ends here 450;;; derived.el ends here
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 188dc172e07..a342f8a5530 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -183,13 +183,18 @@ Use the command `%s' to change this variable." pretty-name mode))
183 183
184 (let ((curfile (or (and (boundp 'byte-compile-current-file) 184 (let ((curfile (or (and (boundp 'byte-compile-current-file)
185 byte-compile-current-file) 185 byte-compile-current-file)
186 load-file-name))) 186 load-file-name))
187 `(defcustom ,mode ,init-value 187 base-doc-string)
188 ,(format "Non-nil if %s is enabled. 188 (setq base-doc-string "Non-nil if %s is enabled.
189See the command `%s' for a description of this minor-mode. 189See the command `%s' for a description of this minor-mode.
190Setting this variable directly does not take effect; 190Setting this variable directly does not take effect;
191use either \\[customize] or the function `%s'." 191use either \\[customize] or the function `%s'.")
192 pretty-name mode mode) 192 (if (null body)
193 (setq base-doc-string "Non-nil if %s is enabled.
194See the command `%s' for a description of this minor-mode."))
195
196 `(defcustom ,mode ,init-value
197 ,(format base-doc-string pretty-name mode mode)
193 :set 'custom-set-minor-mode 198 :set 'custom-set-minor-mode
194 :initialize 'custom-initialize-default 199 :initialize 'custom-initialize-default
195 ,@group 200 ,@group
@@ -271,14 +276,26 @@ With zero or negative ARG turn mode off.
271TURN-ON is a function that will be called with no args in every buffer 276TURN-ON is a function that will be called with no args in every buffer
272 and that should try to turn MODE on if applicable for that buffer. 277 and that should try to turn MODE on if applicable for that buffer.
273KEYS is a list of CL-style keyword arguments: 278KEYS is a list of CL-style keyword arguments:
274:group to specify the custom group." 279:group to specify the custom group.
280
281If MODE's set-up depends on the major mode in effect when it was
282enabled, then disabling and reenabling MODE should make MODE work
283correctly with the current major mode. This is important to
284prevent problems with derived modes, that is, major modes that
285call another major mode in their body."
286
275 (let* ((global-mode-name (symbol-name global-mode)) 287 (let* ((global-mode-name (symbol-name global-mode))
276 (pretty-name (easy-mmode-pretty-mode-name mode)) 288 (pretty-name (easy-mmode-pretty-mode-name mode))
277 (pretty-global-name (easy-mmode-pretty-mode-name global-mode)) 289 (pretty-global-name (easy-mmode-pretty-mode-name global-mode))
278 (group nil) 290 (group nil)
279 (extra-args nil) 291 (extra-args nil)
280 (buffers (intern (concat global-mode-name "-buffers"))) 292 (MODE-buffers (intern (concat global-mode-name "-buffers")))
281 (cmmh (intern (concat global-mode-name "-cmmh")))) 293 (MODE-enable-in-buffers
294 (intern (concat global-mode-name "-enable-in-buffers")))
295 (MODE-check-buffers
296 (intern (concat global-mode-name "-check-buffers")))
297 (MODE-cmhh (intern (concat global-mode-name "-cmhh")))
298 (MODE-major-mode (intern (concat (symbol-name mode) "-major-mode"))))
282 299
283 ;; Check keys. 300 ;; Check keys.
284 (while (keywordp (car keys)) 301 (while (keywordp (car keys))
@@ -294,6 +311,8 @@ KEYS is a list of CL-style keyword arguments:
294 "-mode\\'" "" (symbol-name mode)))))) 311 "-mode\\'" "" (symbol-name mode))))))
295 312
296 `(progn 313 `(progn
314 (defvar ,MODE-major-mode nil)
315 (make-variable-buffer-local ',MODE-major-mode)
297 ;; The actual global minor-mode 316 ;; The actual global minor-mode
298 (define-minor-mode ,global-mode 317 (define-minor-mode ,global-mode
299 ,(format "Toggle %s in every buffer. 318 ,(format "Toggle %s in every buffer.
@@ -306,10 +325,13 @@ in which `%s' turns it on."
306 ;; Setup hook to handle future mode changes and new buffers. 325 ;; Setup hook to handle future mode changes and new buffers.
307 (if ,global-mode 326 (if ,global-mode
308 (progn 327 (progn
309 (add-hook 'after-change-major-mode-hook ',buffers) 328 (add-hook 'after-change-major-mode-hook
310 (add-hook 'change-major-mode-hook ',cmmh)) 329 ',MODE-enable-in-buffers)
311 (remove-hook 'after-change-major-mode-hook ',buffers) 330 (add-hook 'find-file-hook ',MODE-check-buffers)
312 (remove-hook 'change-major-mode-hook ',cmmh)) 331 (add-hook 'change-major-mode-hook ',MODE-cmhh))
332 (remove-hook 'after-change-major-mode-hook ',MODE-enable-in-buffers)
333 (remove-hook 'find-file-hook ',MODE-check-buffers)
334 (remove-hook 'change-major-mode-hook ',MODE-cmhh))
313 335
314 ;; Go through existing buffers. 336 ;; Go through existing buffers.
315 (dolist (buf (buffer-list)) 337 (dolist (buf (buffer-list))
@@ -321,22 +343,33 @@ in which `%s' turns it on."
321 :autoload-end 343 :autoload-end
322 344
323 ;; List of buffers left to process. 345 ;; List of buffers left to process.
324 (defvar ,buffers nil) 346 (defvar ,MODE-buffers nil)
325 347
326 ;; The function that calls TURN-ON in each buffer. 348 ;; The function that calls TURN-ON in each buffer.
327 (defun ,buffers () 349 (defun ,MODE-enable-in-buffers ()
328 (remove-hook 'post-command-hook ',buffers) 350 (dolist (buf ,MODE-buffers)
329 (while ,buffers 351 (when (buffer-live-p buf)
330 (let ((buf (pop ,buffers))) 352 (with-current-buffer buf
331 (when (buffer-live-p buf) 353 (if ,mode
332 (with-current-buffer buf (,turn-on)))))) 354 (unless (eq ,MODE-major-mode major-mode)
333 (put ',buffers 'definition-name ',global-mode) 355 (,mode -1)
356 (,turn-on)
357 (setq ,MODE-major-mode major-mode))
358 (,turn-on)
359 (setq ,MODE-major-mode major-mode))))))
360 (put ',MODE-enable-in-buffers 'definition-name ',global-mode)
361
362 (defun ,MODE-check-buffers ()
363 (,MODE-enable-in-buffers)
364 (setq ,MODE-buffers nil)
365 (remove-hook 'post-command-hook ',MODE-check-buffers))
366 (put ',MODE-check-buffers 'definition-name ',global-mode)
334 367
335 ;; The function that catches kill-all-local-variables. 368 ;; The function that catches kill-all-local-variables.
336 (defun ,cmmh () 369 (defun ,MODE-cmhh ()
337 (add-to-list ',buffers (current-buffer)) 370 (add-to-list ',MODE-buffers (current-buffer))
338 (add-hook 'post-command-hook ',buffers)) 371 (add-hook 'post-command-hook ',MODE-check-buffers))
339 (put ',cmmh 'definition-name ',global-mode)))) 372 (put ',MODE-cmhh 'definition-name ',global-mode))))
340 373
341;;; 374;;;
342;;; easy-mmode-defmap 375;;; easy-mmode-defmap
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 91ebda57001..54325c87b6d 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -80,7 +80,7 @@ using but only when you also use Edebug."
80 80
81;;;###autoload 81;;;###autoload
82(defcustom edebug-all-defs nil 82(defcustom edebug-all-defs nil
83 "*If non-nil, evaluation of any defining forms will instrument for Edebug. 83 "*If non-nil, evaluating defining forms instruments for Edebug.
84This applies to `eval-defun', `eval-region', `eval-buffer', and 84This applies to `eval-defun', `eval-region', `eval-buffer', and
85`eval-current-buffer'. `eval-region' is also called by 85`eval-current-buffer'. `eval-region' is also called by
86`eval-last-sexp', and `eval-print-last-sexp'. 86`eval-last-sexp', and `eval-print-last-sexp'.
@@ -141,10 +141,10 @@ it."
141 :group 'edebug) 141 :group 'edebug)
142 142
143(defcustom edebug-initial-mode 'step 143(defcustom edebug-initial-mode 'step
144 "*Initial execution mode for Edebug, if non-nil. If this variable 144 "*Initial execution mode for Edebug, if non-nil.
145is non-@code{nil}, it specifies the initial execution mode for Edebug 145If this variable is non-nil, it specifies the initial execution mode
146when it is first activated. Possible values are step, next, go, 146for Edebug when it is first activated. Possible values are step, next,
147Go-nonstop, trace, Trace-fast, continue, and Continue-fast." 147go, Go-nonstop, trace, Trace-fast, continue, and Continue-fast."
148 :type '(choice (const step) (const next) (const go) 148 :type '(choice (const step) (const next) (const go)
149 (const Go-nonstop) (const trace) 149 (const Go-nonstop) (const trace)
150 (const Trace-fast) (const continue) 150 (const Trace-fast) (const continue)
@@ -180,15 +180,15 @@ Use this with caution since it is not debugged."
180 180
181 181
182(defcustom edebug-print-length 50 182(defcustom edebug-print-length 50
183 "*Default value of `print-length' to use while printing results in Edebug." 183 "*Default value of `print-length' for printing results in Edebug."
184 :type 'integer 184 :type 'integer
185 :group 'edebug) 185 :group 'edebug)
186(defcustom edebug-print-level 50 186(defcustom edebug-print-level 50
187 "*Default value of `print-level' to use while printing results in Edebug." 187 "*Default value of `print-level' for printing results in Edebug."
188 :type 'integer 188 :type 'integer
189 :group 'edebug) 189 :group 'edebug)
190(defcustom edebug-print-circle t 190(defcustom edebug-print-circle t
191 "*Default value of `print-circle' to use while printing results in Edebug." 191 "*Default value of `print-circle' for printing results in Edebug."
192 :type 'boolean 192 :type 'boolean
193 :group 'edebug) 193 :group 'edebug)
194 194
@@ -3189,8 +3189,8 @@ The default is one second."
3189 3189
3190 3190
3191(defun edebug-modify-breakpoint (flag &optional condition temporary) 3191(defun edebug-modify-breakpoint (flag &optional condition temporary)
3192 "Modify the breakpoint for the form at point or after it according 3192 "Modify the breakpoint for the form at point or after it.
3193to FLAG: set if t, clear if nil. Then move to that point. 3193Set it if FLAG is non-nil, clear it otherwise. Then move to that point.
3194If CONDITION or TEMPORARY are non-nil, add those attributes to 3194If CONDITION or TEMPORARY are non-nil, add those attributes to
3195the breakpoint. " 3195the breakpoint. "
3196 (let ((edebug-stop-point (edebug-find-stop-point))) 3196 (let ((edebug-stop-point (edebug-find-stop-point)))
@@ -3729,12 +3729,13 @@ Print result in minibuffer."
3729 (eval-expression-print-format (car values)))))) 3729 (eval-expression-print-format (car values))))))
3730 3730
3731(defun edebug-eval-last-sexp () 3731(defun edebug-eval-last-sexp ()
3732 "Evaluate sexp before point in the outside environment; value in minibuffer." 3732 "Evaluate sexp before point in the outside environment.
3733Print value in minibuffer."
3733 (interactive) 3734 (interactive)
3734 (edebug-eval-expression (edebug-last-sexp))) 3735 (edebug-eval-expression (edebug-last-sexp)))
3735 3736
3736(defun edebug-eval-print-last-sexp () 3737(defun edebug-eval-print-last-sexp ()
3737 "Evaluate sexp before point in the outside environment; insert the value. 3738 "Evaluate sexp before point in outside environment; insert value.
3738This prints the value into current buffer." 3739This prints the value into current buffer."
3739 (interactive) 3740 (interactive)
3740 (let* ((edebug-form (edebug-last-sexp)) 3741 (let* ((edebug-form (edebug-last-sexp))
@@ -4014,20 +4015,19 @@ May only be called from within edebug-recursive-edit."
4014(defvar edebug-eval-mode-map nil 4015(defvar edebug-eval-mode-map nil
4015 "Keymap for Edebug Eval mode. Superset of Lisp Interaction mode.") 4016 "Keymap for Edebug Eval mode. Superset of Lisp Interaction mode.")
4016 4017
4017(if edebug-eval-mode-map 4018(unless edebug-eval-mode-map
4018 nil 4019 (setq edebug-eval-mode-map (make-sparse-keymap))
4019 (setq edebug-eval-mode-map (copy-keymap lisp-interaction-mode-map)) 4020 (set-keymap-parent edebug-eval-mode-map lisp-interaction-mode-map)
4020 4021
4021 (define-key edebug-eval-mode-map "\C-c\C-w" 'edebug-where) 4022 (define-key edebug-eval-mode-map "\C-c\C-w" 'edebug-where)
4022 (define-key edebug-eval-mode-map "\C-c\C-d" 'edebug-delete-eval-item) 4023 (define-key edebug-eval-mode-map "\C-c\C-d" 'edebug-delete-eval-item)
4023 (define-key edebug-eval-mode-map "\C-c\C-u" 'edebug-update-eval-list) 4024 (define-key edebug-eval-mode-map "\C-c\C-u" 'edebug-update-eval-list)
4024 (define-key edebug-eval-mode-map "\C-x\C-e" 'edebug-eval-last-sexp) 4025 (define-key edebug-eval-mode-map "\C-x\C-e" 'edebug-eval-last-sexp)
4025 (define-key edebug-eval-mode-map "\C-j" 'edebug-eval-print-last-sexp) 4026 (define-key edebug-eval-mode-map "\C-j" 'edebug-eval-print-last-sexp))
4026 )
4027 4027
4028(put 'edebug-eval-mode 'mode-class 'special) 4028(put 'edebug-eval-mode 'mode-class 'special)
4029 4029
4030(defun edebug-eval-mode () 4030(define-derived-mode edebug-eval-mode lisp-interaction-mode "Edebug Eval"
4031 "Mode for evaluation list buffer while in Edebug. 4031 "Mode for evaluation list buffer while in Edebug.
4032 4032
4033In addition to all Interactive Emacs Lisp commands there are local and 4033In addition to all Interactive Emacs Lisp commands there are local and
@@ -4039,12 +4039,7 @@ Eval list buffer commands:
4039\\{edebug-eval-mode-map} 4039\\{edebug-eval-mode-map}
4040 4040
4041Global commands prefixed by global-edebug-prefix: 4041Global commands prefixed by global-edebug-prefix:
4042\\{global-edebug-map} 4042\\{global-edebug-map}")
4043"
4044 (lisp-interaction-mode)
4045 (setq major-mode 'edebug-eval-mode)
4046 (setq mode-name "Edebug Eval")
4047 (use-local-map edebug-eval-mode-map))
4048 4043
4049;;; Interface with standard debugger. 4044;;; Interface with standard debugger.
4050 4045
diff --git a/lisp/emacs-lisp/ewoc.el b/lisp/emacs-lisp/ewoc.el
index a2cb4e9fe46..9f91dbab0e9 100644
--- a/lisp/emacs-lisp/ewoc.el
+++ b/lisp/emacs-lisp/ewoc.el
@@ -264,7 +264,7 @@ start position and the element DATA."
264 264
265(defun ewoc--delete-node-internal (ewoc node) 265(defun ewoc--delete-node-internal (ewoc node)
266 "Delete a data string from EWOC. 266 "Delete a data string from EWOC.
267Can not be used on the footer. Returns the wrapper that is deleted. 267Can not be used on the footer. Return the wrapper that is deleted.
268The start-marker in the wrapper is set to nil, so that it doesn't 268The start-marker in the wrapper is set to nil, so that it doesn't
269consume any more resources." 269consume any more resources."
270 (let ((dll (ewoc--dll ewoc)) 270 (let ((dll (ewoc--dll ewoc))
@@ -334,25 +334,27 @@ be inserted at the bottom of the ewoc."
334(defalias 'ewoc-data 'ewoc--node-data) 334(defalias 'ewoc-data 'ewoc--node-data)
335 335
336(defun ewoc-enter-first (ewoc data) 336(defun ewoc-enter-first (ewoc data)
337 "Enter DATA first in EWOC." 337 "Enter DATA first in EWOC.
338Return the new node."
338 (ewoc--set-buffer-bind-dll ewoc 339 (ewoc--set-buffer-bind-dll ewoc
339 (ewoc-enter-after ewoc (ewoc--node-nth dll 0) data))) 340 (ewoc-enter-after ewoc (ewoc--node-nth dll 0) data)))
340 341
341(defun ewoc-enter-last (ewoc data) 342(defun ewoc-enter-last (ewoc data)
342 "Enter DATA last in EWOC." 343 "Enter DATA last in EWOC.
344Return the new node."
343 (ewoc--set-buffer-bind-dll ewoc 345 (ewoc--set-buffer-bind-dll ewoc
344 (ewoc-enter-before ewoc (ewoc--node-nth dll -1) data))) 346 (ewoc-enter-before ewoc (ewoc--node-nth dll -1) data)))
345 347
346 348
347(defun ewoc-enter-after (ewoc node data) 349(defun ewoc-enter-after (ewoc node data)
348 "Enter a new element DATA after NODE in EWOC. 350 "Enter a new element DATA after NODE in EWOC.
349Returns the new NODE." 351Return the new node."
350 (ewoc--set-buffer-bind-dll ewoc 352 (ewoc--set-buffer-bind-dll ewoc
351 (ewoc-enter-before ewoc (ewoc--node-next dll node) data))) 353 (ewoc-enter-before ewoc (ewoc--node-next dll node) data)))
352 354
353(defun ewoc-enter-before (ewoc node data) 355(defun ewoc-enter-before (ewoc node data)
354 "Enter a new element DATA before NODE in EWOC. 356 "Enter a new element DATA before NODE in EWOC.
355Returns the new NODE." 357Return the new node."
356 (ewoc--set-buffer-bind-dll ewoc 358 (ewoc--set-buffer-bind-dll ewoc
357 (ewoc--node-enter-before 359 (ewoc--node-enter-before
358 node 360 node
@@ -362,15 +364,15 @@ Returns the new NODE."
362 (ewoc--node-start-marker node))))) 364 (ewoc--node-start-marker node)))))
363 365
364(defun ewoc-next (ewoc node) 366(defun ewoc-next (ewoc node)
365 "Get the next node. 367 "Return the node in EWOC that follows NODE.
366Returns nil if NODE is nil or the last element." 368Return nil if NODE is nil or the last element."
367 (when node 369 (when node
368 (ewoc--filter-hf-nodes 370 (ewoc--filter-hf-nodes
369 ewoc (ewoc--node-next (ewoc--dll ewoc) node)))) 371 ewoc (ewoc--node-next (ewoc--dll ewoc) node))))
370 372
371(defun ewoc-prev (ewoc node) 373(defun ewoc-prev (ewoc node)
372 "Get the previous node. 374 "Return the node in EWOC that precedes NODE.
373Returns nil if NODE is nil or the first element." 375Return nil if NODE is nil or the first element."
374 (when node 376 (when node
375 (ewoc--filter-hf-nodes 377 (ewoc--filter-hf-nodes
376 ewoc 378 ewoc
@@ -497,16 +499,16 @@ If the EWOC is empty, nil is returned."
497 best-guess))))))) 499 best-guess)))))))
498 500
499(defun ewoc-invalidate (ewoc &rest nodes) 501(defun ewoc-invalidate (ewoc &rest nodes)
500 "Refresh some elements. 502 "Call EWOC's pretty-printer for each element in NODES.
501The pretty-printer set for EWOC will be called for all NODES." 503Delete current text first, thus effecting a \"refresh\"."
502 (ewoc--set-buffer-bind-dll ewoc 504 (ewoc--set-buffer-bind-dll ewoc
503 (dolist (node nodes) 505 (dolist (node nodes)
504 (ewoc--refresh-node (ewoc--pretty-printer ewoc) node)))) 506 (ewoc--refresh-node (ewoc--pretty-printer ewoc) node))))
505 507
506(defun ewoc-goto-prev (ewoc arg) 508(defun ewoc-goto-prev (ewoc arg)
507 "Move point to the ARGth previous element. 509 "Move point to the ARGth previous element in EWOC.
508Don't move if we are at the first element, or if EWOC is empty. 510Don't move if we are at the first element, or if EWOC is empty.
509Returns the node we moved to." 511Return the node we moved to."
510 (ewoc--set-buffer-bind-dll-let* ewoc 512 (ewoc--set-buffer-bind-dll-let* ewoc
511 ((node (ewoc-locate ewoc (point)))) 513 ((node (ewoc-locate ewoc (point))))
512 (when node 514 (when node
@@ -522,8 +524,8 @@ Returns the node we moved to."
522 (ewoc-goto-node ewoc node)))) 524 (ewoc-goto-node ewoc node))))
523 525
524(defun ewoc-goto-next (ewoc arg) 526(defun ewoc-goto-next (ewoc arg)
525 "Move point to the ARGth next element. 527 "Move point to the ARGth next element in EWOC.
526Returns the node (or nil if we just passed the last node)." 528Return the node (or nil if we just passed the last node)."
527 (ewoc--set-buffer-bind-dll-let* ewoc 529 (ewoc--set-buffer-bind-dll-let* ewoc
528 ((node (ewoc-locate ewoc (point)))) 530 ((node (ewoc-locate ewoc (point))))
529 (while (and node (> arg 0)) 531 (while (and node (> arg 0))
@@ -535,7 +537,7 @@ Returns the node (or nil if we just passed the last node)."
535 (ewoc-goto-node ewoc node))) 537 (ewoc-goto-node ewoc node)))
536 538
537(defun ewoc-goto-node (ewoc node) 539(defun ewoc-goto-node (ewoc node)
538 "Move point to NODE." 540 "Move point to NODE in EWOC."
539 (ewoc--set-buffer-bind-dll ewoc 541 (ewoc--set-buffer-bind-dll ewoc
540 (goto-char (ewoc--node-start-marker node)) 542 (goto-char (ewoc--node-start-marker node))
541 (if goal-column (move-to-column goal-column)) 543 (if goal-column (move-to-column goal-column))
@@ -586,7 +588,7 @@ remaining arguments will be passed to PREDICATE."
586 588
587(defun ewoc-buffer (ewoc) 589(defun ewoc-buffer (ewoc)
588 "Return the buffer that is associated with EWOC. 590 "Return the buffer that is associated with EWOC.
589Returns nil if the buffer has been deleted." 591Return nil if the buffer has been deleted."
590 (let ((buf (ewoc--buffer ewoc))) 592 (let ((buf (ewoc--buffer ewoc)))
591 (when (buffer-name buf) buf))) 593 (when (buffer-name buf) buf)))
592 594
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index bb815481bf0..72924417109 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -129,6 +129,7 @@
129(put 'defmacro 'doc-string-elt 3) 129(put 'defmacro 'doc-string-elt 3)
130(put 'defmacro* 'doc-string-elt 3) 130(put 'defmacro* 'doc-string-elt 3)
131(put 'defsubst 'doc-string-elt 3) 131(put 'defsubst 'doc-string-elt 3)
132(put 'defstruct 'doc-string-elt 2)
132(put 'define-skeleton 'doc-string-elt 2) 133(put 'define-skeleton 'doc-string-elt 2)
133(put 'define-derived-mode 'doc-string-elt 4) 134(put 'define-derived-mode 'doc-string-elt 4)
134(put 'define-compilation-mode 'doc-string-elt 3) 135(put 'define-compilation-mode 'doc-string-elt 3)
@@ -194,7 +195,7 @@
194 (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *") 195 (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
195 (make-local-variable 'font-lock-comment-start-skip) 196 (make-local-variable 'font-lock-comment-start-skip)
196 ;; Font lock mode uses this only when it KNOWS a comment is starting. 197 ;; Font lock mode uses this only when it KNOWS a comment is starting.
197 (setq font-lock-comment-start-skip ";+ *") 198 (setq font-lock-comment-start-skip ";+ *")
198 (make-local-variable 'comment-add) 199 (make-local-variable 'comment-add)
199 (setq comment-add 1) ;default to `;;' in comment-region 200 (setq comment-add 1) ;default to `;;' in comment-region
200 (make-local-variable 'comment-column) 201 (make-local-variable 'comment-column)
diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el
index f77b1a00e2c..6b87d06cb0e 100644
--- a/lisp/emacs-lisp/testcover.el
+++ b/lisp/emacs-lisp/testcover.el
@@ -1,6 +1,6 @@
1;;;; testcover.el -- Visual code-coverage tool 1;;;; testcover.el -- Visual code-coverage tool
2 2
3;; Copyright (C) 2002 Free Software Foundation, Inc. 3;; Copyright (C) 2002, 2005 Free Software Foundation, Inc.
4 4
5;; Author: Jonathan Yavner <jyavner@member.fsf.org> 5;; Author: Jonathan Yavner <jyavner@member.fsf.org>
6;; Maintainer: Jonathan Yavner <jyavner@member.fsf.org> 6;; Maintainer: Jonathan Yavner <jyavner@member.fsf.org>
@@ -150,15 +150,19 @@ call to one of the `testcover-1value-functions'."
1501-valued, no error if actually multi-valued." 1501-valued, no error if actually multi-valued."
151 :group 'testcover) 151 :group 'testcover)
152 152
153(defface testcover-nohits-face 153(defface testcover-nohits
154 '((t (:background "DeepPink2"))) 154 '((t (:background "DeepPink2")))
155 "Face for forms that had no hits during coverage test" 155 "Face for forms that had no hits during coverage test"
156 :group 'testcover) 156 :group 'testcover)
157;; backward-compatibility alias
158(put 'testcover-nohits-face 'face-alias 'testcover-nohits)
157 159
158(defface testcover-1value-face 160(defface testcover-1value
159 '((t (:background "Wheat2"))) 161 '((t (:background "Wheat2")))
160 "Face for forms that always produced the same value during coverage test" 162 "Face for forms that always produced the same value during coverage test"
161 :group 'testcover) 163 :group 'testcover)
164;; backward-compatibility alias
165(put 'testcover-1value-face 'face-alias 'testcover-1value)
162 166
163 167
164;;;========================================================================= 168;;;=========================================================================
@@ -477,8 +481,8 @@ same value during coverage testing."
477(defun testcover-mark (def) 481(defun testcover-mark (def)
478 "Marks one DEF (a function or macro symbol) to highlight its contained forms 482 "Marks one DEF (a function or macro symbol) to highlight its contained forms
479that did not get completely tested during coverage tests. 483that did not get completely tested during coverage tests.
480 A marking of testcover-nohits-face (default = red) indicates that the 484 A marking with the face `testcover-nohits' (default = red) indicates that the
481form was never evaluated. A marking of testcover-1value-face 485form was never evaluated. A marking using the `testcover-1value' face
482\(default = tan) indicates that the form always evaluated to the same value. 486\(default = tan) indicates that the form always evaluated to the same value.
483 The forms throw, error, and signal are not marked. They do not return and 487 The forms throw, error, and signal are not marked. They do not return and
484would always get a red mark. Some forms that always return the same 488would always get a red mark. Some forms that always return the same
@@ -506,8 +510,8 @@ eliminated by adding more test cases."
506 (setq ov (make-overlay (1- j) j)) 510 (setq ov (make-overlay (1- j) j))
507 (overlay-put ov 'face 511 (overlay-put ov 'face
508 (if (memq data '(unknown 1value)) 512 (if (memq data '(unknown 1value))
509 'testcover-nohits-face 513 'testcover-nohits
510 'testcover-1value-face)))) 514 'testcover-1value))))
511 (set-buffer-modified-p changed)))) 515 (set-buffer-modified-p changed))))
512 516
513(defun testcover-mark-all (&optional buffer) 517(defun testcover-mark-all (&optional buffer)
diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el
index 6ea6bfb7f3d..c6d479b173f 100644
--- a/lisp/emulation/cua-base.el
+++ b/lisp/emulation/cua-base.el
@@ -384,13 +384,13 @@ and after the region marked by the rectangle to search."
384 :type 'boolean 384 :type 'boolean
385 :group 'cua) 385 :group 'cua)
386 386
387(defface cua-rectangle-face 387(defface cua-rectangle
388 '((default :inherit region) 388 '((default :inherit region)
389 (((class color)) :foreground "white" :background "maroon")) 389 (((class color)) :foreground "white" :background "maroon"))
390 "*Font used by CUA for highlighting the rectangle." 390 "*Font used by CUA for highlighting the rectangle."
391 :group 'cua) 391 :group 'cua)
392 392
393(defface cua-rectangle-noselect-face 393(defface cua-rectangle-noselect
394 '((default :inherit region) 394 '((default :inherit region)
395 (((class color)) :foreground "white" :background "dimgray")) 395 (((class color)) :foreground "white" :background "dimgray"))
396 "*Font used by CUA for highlighting the non-selected rectangle lines." 396 "*Font used by CUA for highlighting the non-selected rectangle lines."
@@ -404,7 +404,7 @@ and after the region marked by the rectangle to search."
404 :type 'boolean 404 :type 'boolean
405 :group 'cua) 405 :group 'cua)
406 406
407(defface cua-global-mark-face 407(defface cua-global-mark
408 '((((min-colors 88)(class color)) :foreground "black" :background "yellow1") 408 '((((min-colors 88)(class color)) :foreground "black" :background "yellow1")
409 (((class color)) :foreground "black" :background "yellow") 409 (((class color)) :foreground "black" :background "yellow")
410 (t :bold t)) 410 (t :bold t))
@@ -447,13 +447,13 @@ a cons (TYPE . COLOR), then both properties are affected."
447 (choice :tag "Type" 447 (choice :tag "Type"
448 (const :tag "Filled box" box) 448 (const :tag "Filled box" box)
449 (const :tag "Vertical bar" bar) 449 (const :tag "Vertical bar" bar)
450 (const :tag "Horisontal bar" hbar) 450 (const :tag "Horizontal bar" hbar)
451 (const :tag "Hollow box" hollow)) 451 (const :tag "Hollow box" hollow))
452 (cons :tag "Color and Type" 452 (cons :tag "Color and Type"
453 (choice :tag "Type" 453 (choice :tag "Type"
454 (const :tag "Filled box" box) 454 (const :tag "Filled box" box)
455 (const :tag "Vertical bar" bar) 455 (const :tag "Vertical bar" bar)
456 (const :tag "Horisontal bar" hbar) 456 (const :tag "Horizontal bar" hbar)
457 (const :tag "Hollow box" hollow)) 457 (const :tag "Hollow box" hollow))
458 (color :tag "Color"))) 458 (color :tag "Color")))
459 :group 'cua) 459 :group 'cua)
@@ -471,13 +471,13 @@ a cons (TYPE . COLOR), then both properties are affected."
471 (choice :tag "Type" 471 (choice :tag "Type"
472 (const :tag "Filled box" box) 472 (const :tag "Filled box" box)
473 (const :tag "Vertical bar" bar) 473 (const :tag "Vertical bar" bar)
474 (const :tag "Horisontal bar" hbar) 474 (const :tag "Horizontal bar" hbar)
475 (const :tag "Hollow box" hollow)) 475 (const :tag "Hollow box" hollow))
476 (cons :tag "Color and Type" 476 (cons :tag "Color and Type"
477 (choice :tag "Type" 477 (choice :tag "Type"
478 (const :tag "Filled box" box) 478 (const :tag "Filled box" box)
479 (const :tag "Vertical bar" bar) 479 (const :tag "Vertical bar" bar)
480 (const :tag "Horisontal bar" hbar) 480 (const :tag "Horizontal bar" hbar)
481 (const :tag "Hollow box" hollow)) 481 (const :tag "Hollow box" hollow))
482 (color :tag "Color"))) 482 (color :tag "Color")))
483 :group 'cua) 483 :group 'cua)
@@ -495,13 +495,13 @@ a cons (TYPE . COLOR), then both properties are affected."
495 (choice :tag "Type" 495 (choice :tag "Type"
496 (const :tag "Filled box" box) 496 (const :tag "Filled box" box)
497 (const :tag "Vertical bar" bar) 497 (const :tag "Vertical bar" bar)
498 (const :tag "Horisontal bar" hbar) 498 (const :tag "Horizontal bar" hbar)
499 (const :tag "Hollow box" hollow)) 499 (const :tag "Hollow box" hollow))
500 (cons :tag "Color and Type" 500 (cons :tag "Color and Type"
501 (choice :tag "Type" 501 (choice :tag "Type"
502 (const :tag "Filled box" box) 502 (const :tag "Filled box" box)
503 (const :tag "Vertical bar" bar) 503 (const :tag "Vertical bar" bar)
504 (const :tag "Horisontal bar" hbar) 504 (const :tag "Horizontal bar" hbar)
505 (const :tag "Hollow box" hollow)) 505 (const :tag "Hollow box" hollow))
506 (color :tag "Color"))) 506 (color :tag "Color")))
507 :group 'cua) 507 :group 'cua)
@@ -520,13 +520,13 @@ a cons (TYPE . COLOR), then both properties are affected."
520 (choice :tag "Type" 520 (choice :tag "Type"
521 (const :tag "Filled box" box) 521 (const :tag "Filled box" box)
522 (const :tag "Vertical bar" bar) 522 (const :tag "Vertical bar" bar)
523 (const :tag "Horisontal bar" hbar) 523 (const :tag "Horizontal bar" hbar)
524 (const :tag "Hollow box" hollow)) 524 (const :tag "Hollow box" hollow))
525 (cons :tag "Color and Type" 525 (cons :tag "Color and Type"
526 (choice :tag "Type" 526 (choice :tag "Type"
527 (const :tag "Filled box" box) 527 (const :tag "Filled box" box)
528 (const :tag "Vertical bar" bar) 528 (const :tag "Vertical bar" bar)
529 (const :tag "Horisontal bar" hbar) 529 (const :tag "Horizontal bar" hbar)
530 (const :tag "Hollow box" hollow)) 530 (const :tag "Hollow box" hollow))
531 (color :tag "Color"))) 531 (color :tag "Color")))
532 :group 'cua) 532 :group 'cua)
@@ -1360,7 +1360,7 @@ paste (in addition to the normal emacs bindings)."
1360 1360
1361 (if (not cua-mode) 1361 (if (not cua-mode)
1362 (setq emulation-mode-map-alists (delq 'cua--keymap-alist emulation-mode-map-alists)) 1362 (setq emulation-mode-map-alists (delq 'cua--keymap-alist emulation-mode-map-alists))
1363 (add-to-list 'emulation-mode-map-alists 'cua--keymap-alist) 1363 (add-to-ordered-list 'emulation-mode-map-alists 'cua--keymap-alist 400)
1364 (cua--select-keymaps)) 1364 (cua--select-keymaps))
1365 1365
1366 (cond 1366 (cond
diff --git a/lisp/emulation/cua-gmrk.el b/lisp/emulation/cua-gmrk.el
index 8280691ae18..b8874df0f34 100644
--- a/lisp/emulation/cua-gmrk.el
+++ b/lisp/emulation/cua-gmrk.el
@@ -74,7 +74,7 @@
74 (move-overlay cua--global-mark-overlay (point) (1+ (point))) 74 (move-overlay cua--global-mark-overlay (point) (1+ (point)))
75 (setq cua--global-mark-overlay 75 (setq cua--global-mark-overlay
76 (make-overlay (point) (1+ (point)))) 76 (make-overlay (point) (1+ (point))))
77 (overlay-put cua--global-mark-overlay 'face 'cua-global-mark-face)) 77 (overlay-put cua--global-mark-overlay 'face 'cua-global-mark))
78 (if (and cua-global-mark-blink-cursor-interval 78 (if (and cua-global-mark-blink-cursor-interval
79 (not cua--orig-blink-cursor-interval)) 79 (not cua--orig-blink-cursor-interval))
80 (setq cua--orig-blink-cursor-interval blink-cursor-interval 80 (setq cua--orig-blink-cursor-interval blink-cursor-interval
@@ -218,7 +218,7 @@ With prefix argument, don't jump to global mark when cancelling it."
218 (let ((olist (overlays-at (marker-position cua--global-mark-marker))) 218 (let ((olist (overlays-at (marker-position cua--global-mark-marker)))
219 in-rect) 219 in-rect)
220 (while olist 220 (while olist
221 (if (eq (overlay-get (car olist) 'face) 'cua-rectangle-face) 221 (if (eq (overlay-get (car olist) 'face) 'cua-rectangle)
222 (setq in-rect t olist nil) 222 (setq in-rect t olist nil)
223 (setq olist (cdr olist)))) 223 (setq olist (cdr olist))))
224 (if in-rect 224 (if in-rect
@@ -358,11 +358,6 @@ With prefix argument, don't jump to global mark when cancelling it."
358;;; Initialization 358;;; Initialization
359 359
360(defun cua--init-global-mark () 360(defun cua--init-global-mark ()
361 (unless (face-background 'cua-global-mark-face)
362 (copy-face 'region 'cua-global-mark-face)
363 (set-face-foreground 'cua-global-mark-face "black")
364 (set-face-background 'cua-global-mark-face "cyan"))
365
366 (define-key cua--global-mark-keymap [remap copy-region-as-kill] 'cua-copy-to-global-mark) 361 (define-key cua--global-mark-keymap [remap copy-region-as-kill] 'cua-copy-to-global-mark)
367 (define-key cua--global-mark-keymap [remap kill-ring-save] 'cua-copy-to-global-mark) 362 (define-key cua--global-mark-keymap [remap kill-ring-save] 'cua-copy-to-global-mark)
368 (define-key cua--global-mark-keymap [remap kill-region] 'cua-cut-to-global-mark) 363 (define-key cua--global-mark-keymap [remap kill-region] 'cua-cut-to-global-mark)
diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el
index 932448079dd..72fd9195850 100644
--- a/lisp/emulation/cua-rect.el
+++ b/lisp/emulation/cua-rect.el
@@ -755,7 +755,7 @@ If command is repeated at same position, delete the rectangle."
755 (sit-for 0) ; make window top/bottom reliable 755 (sit-for 0) ; make window top/bottom reliable
756 (cua--rectangle-operation nil t nil nil nil ; do not tabify 756 (cua--rectangle-operation nil t nil nil nil ; do not tabify
757 '(lambda (s e l r v) 757 '(lambda (s e l r v)
758 (let ((rface (if v 'cua-rectangle-face 'cua-rectangle-noselect-face)) 758 (let ((rface (if v 'cua-rectangle 'cua-rectangle-noselect))
759 overlay bs ms as) 759 overlay bs ms as)
760 (when (cua--rectangle-virtual-edges) 760 (when (cua--rectangle-virtual-edges)
761 (let ((lb (line-beginning-position)) 761 (let ((lb (line-beginning-position))
diff --git a/lisp/emulation/pc-select.el b/lisp/emulation/pc-select.el
index 1221fca5199..5231abb588a 100644
--- a/lisp/emulation/pc-select.el
+++ b/lisp/emulation/pc-select.el
@@ -99,7 +99,7 @@ errors are suppressed."
99(defcustom pc-select-selection-keys-only nil 99(defcustom pc-select-selection-keys-only nil
100 "*Non-nil means only bind the basic selection keys when started. 100 "*Non-nil means only bind the basic selection keys when started.
101Other keys that emulate pc-behavior will be untouched. 101Other keys that emulate pc-behavior will be untouched.
102This gives mostly Emacs-like behaviour with only the selection keys enabled." 102This gives mostly Emacs-like behavior with only the selection keys enabled."
103 :type 'boolean 103 :type 'boolean
104 :group 'pc-select) 104 :group 'pc-select)
105 105
@@ -825,7 +825,7 @@ If the value is non-nil, call the function MODE with an argument of
825 825
826;;;###autoload 826;;;###autoload
827(define-minor-mode pc-selection-mode 827(define-minor-mode pc-selection-mode
828 "Change mark behaviour to emulate Motif, MAC or MS-Windows cut and paste style. 828 "Change mark behavior to emulate Motif, MAC or MS-Windows cut and paste style.
829 829
830This mode enables Delete Selection mode and Transient Mark mode. 830This mode enables Delete Selection mode and Transient Mark mode.
831 831
@@ -971,7 +971,7 @@ but before calling PC Selection mode):
971;;;###autoload 971;;;###autoload
972(defcustom pc-selection-mode nil 972(defcustom pc-selection-mode nil
973 "Toggle PC Selection mode. 973 "Toggle PC Selection mode.
974Change mark behaviour to emulate Motif, MAC or MS-Windows cut and paste style, 974Change mark behavior to emulate Motif, MAC or MS-Windows cut and paste style,
975and cursor movement commands. 975and cursor movement commands.
976This mode enables Delete Selection mode and Transient Mark mode. 976This mode enables Delete Selection mode and Transient Mark mode.
977Setting this variable directly does not take effect; 977Setting this variable directly does not take effect;
diff --git a/lisp/emulation/vi.el b/lisp/emulation/vi.el
index cd0092e5e87..d6b7c2728b2 100644
--- a/lisp/emulation/vi.el
+++ b/lisp/emulation/vi.el
@@ -520,7 +520,7 @@ set sw=n M-x set-variable vi-shift-width n "
520 "Go into insert state, the text entered will be repeated if REPETITION > 1. 520 "Go into insert state, the text entered will be repeated if REPETITION > 1.
521If PREFIX-CODE is given, do it before insertion begins if DO-IT-NOW-P is T. 521If PREFIX-CODE is given, do it before insertion begins if DO-IT-NOW-P is T.
522In any case, the prefix-code will be done before each 'redo-insert'. 522In any case, the prefix-code will be done before each 'redo-insert'.
523This function expects 'overwrite-mode' being set properly beforehand." 523This function expects `overwrite-mode' being set properly beforehand."
524 (if do-it-now-p (apply (car prefix-code) (cdr prefix-code))) 524 (if do-it-now-p (apply (car prefix-code) (cdr prefix-code)))
525 (setq vi-ins-point (point)) 525 (setq vi-ins-point (point))
526 (setq vi-ins-repetition repetition) 526 (setq vi-ins-repetition repetition)
diff --git a/lisp/emulation/vip.el b/lisp/emulation/vip.el
index 19f08d54989..dace12d4c8f 100644
--- a/lisp/emulation/vip.el
+++ b/lisp/emulation/vip.el
@@ -1342,7 +1342,7 @@ after search."
1342(defun vip-find-char-forward (arg) 1342(defun vip-find-char-forward (arg)
1343 "Find char on the line. If called interactively read the char to find 1343 "Find char on the line. If called interactively read the char to find
1344from the terminal, and if called from vip-repeat, the char last used is 1344from the terminal, and if called from vip-repeat, the char last used is
1345used. This behaviour is controlled by the sign of prefix numeric value." 1345used. This behavior is controlled by the sign of prefix numeric value."
1346 (interactive "P") 1346 (interactive "P")
1347 (let ((val (vip-p-val arg)) (com (vip-getcom arg))) 1347 (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1348 (if (> val 0) 1348 (if (> val 0)
diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el
index 4593d84c6fc..3f9a425987e 100644
--- a/lisp/emulation/viper-cmd.el
+++ b/lisp/emulation/viper-cmd.el
@@ -3131,7 +3131,7 @@ On reaching beginning of line, stop and signal error."
3131(defun viper-find-char-forward (arg) 3131(defun viper-find-char-forward (arg)
3132 "Find char on the line. 3132 "Find char on the line.
3133If called interactively read the char to find from the terminal, and if 3133If called interactively read the char to find from the terminal, and if
3134called from viper-repeat, the char last used is used. This behaviour is 3134called from viper-repeat, the char last used is used. This behavior is
3135controlled by the sign of prefix numeric value." 3135controlled by the sign of prefix numeric value."
3136 (interactive "P") 3136 (interactive "P")
3137 (let ((val (viper-p-val arg)) 3137 (let ((val (viper-p-val arg))
@@ -3672,8 +3672,8 @@ If MAJOR-MODE is set, set the macros only in that major mode."
3672 (sit-for 2) 3672 (sit-for 2)
3673 (viper-unrecord-kbd-macro "///" 'vi-state))) 3673 (viper-unrecord-kbd-macro "///" 'vi-state)))
3674 )) 3674 ))
3675 3675
3676 3676
3677(defun viper-set-parsing-style-toggling-macro (unset) 3677(defun viper-set-parsing-style-toggling-macro (unset)
3678 "Set `%%%' to be a macro that toggles whether comment fields should be parsed for matching parentheses. 3678 "Set `%%%' to be a macro that toggles whether comment fields should be parsed for matching parentheses.
3679This is used in conjunction with the `%' command. 3679This is used in conjunction with the `%' command.
diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el
index 4f08f1b6cc1..ab9212cb95f 100644
--- a/lisp/emulation/viper-init.el
+++ b/lisp/emulation/viper-init.el
@@ -1,6 +1,6 @@
1;;; viper-init.el --- some common definitions for Viper 1;;; viper-init.el --- some common definitions for Viper
2 2
3;; Copyright (C) 1997, 98, 99, 2000, 01, 02 Free Software Foundation, Inc. 3;; Copyright (C) 1997, 98, 99, 2000, 01, 02, 05 Free Software Foundation, Inc.
4 4
5;; Author: Michael Kifer <kifer@cs.stonybrook.edu> 5;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
6 6
@@ -850,74 +850,84 @@ Related buffers can be cycled through via :R and :P commands."
850 :group 'viper) 850 :group 'viper)
851 851
852 852
853(defface viper-search-face 853(defface viper-search
854 '((((class color)) (:foreground "Black" :background "khaki")) 854 '((((class color)) (:foreground "Black" :background "khaki"))
855 (t (:underline t :stipple "gray3"))) 855 (t (:underline t :stipple "gray3")))
856 "*Face used to flash out the search pattern." 856 "*Face used to flash out the search pattern."
857 :group 'viper-highlighting) 857 :group 'viper-highlighting)
858;; backward-compatibility alias
859(put 'viper-search-face 'face-alias 'viper-search)
858;; An internal variable. Viper takes the face from here. 860;; An internal variable. Viper takes the face from here.
859(defvar viper-search-face 'viper-search-face 861(defvar viper-search-face 'viper-search
860 "Face used to flash out the search pattern. 862 "Face used to flash out the search pattern.
861DO NOT CHANGE this variable. Instead, use the customization widget 863DO NOT CHANGE this variable. Instead, use the customization widget
862to customize the actual face object `viper-search-face' 864to customize the actual face object `viper-search-face'
863this variable represents.") 865this variable represents.")
864(viper-hide-face 'viper-search-face) 866(viper-hide-face 'viper-search)
865 867
866 868
867(defface viper-replace-overlay-face 869(defface viper-replace-overlay
868 '((((class color)) (:foreground "Black" :background "darkseagreen2")) 870 '((((class color)) (:foreground "Black" :background "darkseagreen2"))
869 (t (:underline t :stipple "gray3"))) 871 (t (:underline t :stipple "gray3")))
870 "*Face for highlighting replace regions on a window display." 872 "*Face for highlighting replace regions on a window display."
871 :group 'viper-highlighting) 873 :group 'viper-highlighting)
874;; backward-compatibility alias
875(put 'viper-replace-overlay-face 'face-alias 'viper-replace-overlay)
872;; An internal variable. Viper takes the face from here. 876;; An internal variable. Viper takes the face from here.
873(defvar viper-replace-overlay-face 'viper-replace-overlay-face 877(defvar viper-replace-overlay-face 'viper-replace-overlay
874 "Face for highlighting replace regions on a window display. 878 "Face for highlighting replace regions on a window display.
875DO NOT CHANGE this variable. Instead, use the customization widget 879DO NOT CHANGE this variable. Instead, use the customization widget
876to customize the actual face object `viper-replace-overlay-face' 880to customize the actual face object `viper-replace-overlay-face'
877this variable represents.") 881this variable represents.")
878(viper-hide-face 'viper-replace-overlay-face) 882(viper-hide-face 'viper-replace-overlay)
879 883
880 884
881(defface viper-minibuffer-emacs-face 885(defface viper-minibuffer-emacs
882 '((((class color)) (:foreground "Black" :background "darkseagreen2")) 886 '((((class color)) (:foreground "Black" :background "darkseagreen2"))
883 (t (:weight bold))) 887 (t (:weight bold)))
884 "Face used in the Minibuffer when it is in Emacs state." 888 "Face used in the Minibuffer when it is in Emacs state."
885 :group 'viper-highlighting) 889 :group 'viper-highlighting)
890;; backward-compatibility alias
891(put 'viper-minibuffer-emacs-face 'face-alias 'viper-minibuffer-emacs)
886;; An internal variable. Viper takes the face from here. 892;; An internal variable. Viper takes the face from here.
887(defvar viper-minibuffer-emacs-face 'viper-minibuffer-emacs-face 893(defvar viper-minibuffer-emacs-face 'viper-minibuffer-emacs
888 "Face used in the Minibuffer when it is in Emacs state. 894 "Face used in the Minibuffer when it is in Emacs state.
889DO NOT CHANGE this variable. Instead, use the customization widget 895DO NOT CHANGE this variable. Instead, use the customization widget
890to customize the actual face object `viper-minibuffer-emacs-face' 896to customize the actual face object `viper-minibuffer-emacs-face'
891this variable represents.") 897this variable represents.")
892(viper-hide-face 'viper-minibuffer-emacs-face) 898(viper-hide-face 'viper-minibuffer-emacs)
893 899
894 900
895(defface viper-minibuffer-insert-face 901(defface viper-minibuffer-insert
896 '((((class color)) (:foreground "Black" :background "pink")) 902 '((((class color)) (:foreground "Black" :background "pink"))
897 (t (:slant italic))) 903 (t (:slant italic)))
898 "Face used in the Minibuffer when it is in Insert state." 904 "Face used in the Minibuffer when it is in Insert state."
899 :group 'viper-highlighting) 905 :group 'viper-highlighting)
906;; backward-compatibility alias
907(put 'viper-minibuffer-insert-face 'face-alias 'viper-minibuffer-insert)
900;; An internal variable. Viper takes the face from here. 908;; An internal variable. Viper takes the face from here.
901(defvar viper-minibuffer-insert-face 'viper-minibuffer-insert-face 909(defvar viper-minibuffer-insert-face 'viper-minibuffer-insert
902 "Face used in the Minibuffer when it is in Insert state. 910 "Face used in the Minibuffer when it is in Insert state.
903DO NOT CHANGE this variable. Instead, use the customization widget 911DO NOT CHANGE this variable. Instead, use the customization widget
904to customize the actual face object `viper-minibuffer-insert-face' 912to customize the actual face object `viper-minibuffer-insert-face'
905this variable represents.") 913this variable represents.")
906(viper-hide-face 'viper-minibuffer-insert-face) 914(viper-hide-face 'viper-minibuffer-insert)
907 915
908 916
909(defface viper-minibuffer-vi-face 917(defface viper-minibuffer-vi
910 '((((class color)) (:foreground "DarkGreen" :background "grey")) 918 '((((class color)) (:foreground "DarkGreen" :background "grey"))
911 (t (:inverse-video t))) 919 (t (:inverse-video t)))
912 "Face used in the Minibuffer when it is in Vi state." 920 "Face used in the Minibuffer when it is in Vi state."
913 :group 'viper-highlighting) 921 :group 'viper-highlighting)
922;; backward-compatibility alias
923(put 'viper-minibuffer-vi-face 'face-alias 'viper-minibuffer-vi)
914;; An internal variable. Viper takes the face from here. 924;; An internal variable. Viper takes the face from here.
915(defvar viper-minibuffer-vi-face 'viper-minibuffer-vi-face 925(defvar viper-minibuffer-vi-face 'viper-minibuffer-vi
916 "Face used in the Minibuffer when it is in Vi state. 926 "Face used in the Minibuffer when it is in Vi state.
917DO NOT CHANGE this variable. Instead, use the customization widget 927DO NOT CHANGE this variable. Instead, use the customization widget
918to customize the actual face object `viper-minibuffer-vi-face' 928to customize the actual face object `viper-minibuffer-vi-face'
919this variable represents.") 929this variable represents.")
920(viper-hide-face 'viper-minibuffer-vi-face) 930(viper-hide-face 'viper-minibuffer-vi)
921 931
922;; the current face to be used in the minibuffer 932;; the current face to be used in the minibuffer
923(viper-deflocalvar 933(viper-deflocalvar
diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el
index a74ca05b3df..f14f67d94c8 100644
--- a/lisp/emulation/viper-keym.el
+++ b/lisp/emulation/viper-keym.el
@@ -50,16 +50,25 @@
50 50
51;;; Variables 51;;; Variables
52 52
53(defvar viper-toggle-key "\C-z" 53(defcustom viper-toggle-key "\C-z"
54 "The key used to change states from emacs to Vi and back. 54 "The key used to change states from emacs to Vi and back.
55In insert mode, this key also functions as Meta. 55In insert mode, this key also functions as Meta.
56Must be set in .viper file or prior to loading Viper. 56Must be set in .viper file or prior to loading Viper.
57This setting cannot be changed interactively.") 57This setting cannot be changed interactively."
58 :type 'string
59 :group 'viper)
60
61(defcustom viper-quoted-insert-key "\C-v"
62 "The key used to quote special characters when inserting them in Insert state."
63 :type 'string
64 :group 'viper)
58 65
59(defvar viper-ESC-key "\e" 66(defcustom viper-ESC-key "\e"
60 "Key used to ESC. 67 "Key used to ESC.
61Must be set in .viper file or prior to loading Viper. 68Must be set in .viper file or prior to loading Viper.
62This setting cannot be changed interactively.") 69This setting cannot be changed interactively."
70 :type 'string
71 :group 'viper)
63 72
64;;; Emacs keys in other states. 73;;; Emacs keys in other states.
65 74
@@ -242,7 +251,7 @@ viper-insert-basic-map. Not recommended, except for novice users.")
242(define-key viper-insert-basic-map "\C-t" 'viper-forward-indent) 251(define-key viper-insert-basic-map "\C-t" 'viper-forward-indent)
243(define-key viper-insert-basic-map 252(define-key viper-insert-basic-map
244 (if viper-xemacs-p [(shift tab)] [S-tab]) 'viper-insert-tab) 253 (if viper-xemacs-p [(shift tab)] [S-tab]) 'viper-insert-tab)
245(define-key viper-insert-basic-map "\C-v" 'quoted-insert) 254(define-key viper-insert-basic-map viper-quoted-insert-key 'quoted-insert)
246(define-key viper-insert-basic-map "\C-?" 'viper-del-backward-char-in-insert) 255(define-key viper-insert-basic-map "\C-?" 'viper-del-backward-char-in-insert)
247(define-key viper-insert-basic-map [backspace] 'viper-del-backward-char-in-insert) 256(define-key viper-insert-basic-map [backspace] 'viper-del-backward-char-in-insert)
248(define-key viper-insert-basic-map "\C-\\" 'viper-alternate-Meta-key) 257(define-key viper-insert-basic-map "\C-\\" 'viper-alternate-Meta-key)
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index e3582f2165a..3fdbccc2957 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -990,12 +990,13 @@ remains buffer-local."
990 (setq global-mode-string 990 (setq global-mode-string
991 (append '("" viper-mode-string) (cdr global-mode-string)))) 991 (append '("" viper-mode-string) (cdr global-mode-string))))
992 992
993 (defadvice describe-key (before viper-read-keyseq-ad protect activate) 993 (defadvice describe-key (before viper-describe-key-ad protect activate)
994 "Force to read key via `viper-read-key-sequence'." 994 "Force to read key via `viper-read-key-sequence'."
995 (interactive (list (viper-read-key-sequence "Describe key: ")))) 995 (interactive (list (viper-read-key-sequence "Describe key: "))
996 ))
996 997
997 (defadvice describe-key-briefly 998 (defadvice describe-key-briefly
998 (before viper-read-keyseq-ad protect activate) 999 (before viper-describe-key-briefly-ad protect activate)
999 "Force to read key via `viper-read-key-sequence'." 1000 "Force to read key via `viper-read-key-sequence'."
1000 (interactive (list (viper-read-key-sequence "Describe key briefly: ")))) 1001 (interactive (list (viper-read-key-sequence "Describe key briefly: "))))
1001 1002
diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el
index a0294273985..f1bd94baabf 100644
--- a/lisp/eshell/esh-var.el
+++ b/lisp/eshell/esh-var.el
@@ -297,7 +297,7 @@ This function is explicit for adding to `eshell-parse-argument-hook'."
297 nil) 297 nil)
298 298
299(defun eshell/export (&rest sets) 299(defun eshell/export (&rest sets)
300 "This alias allows the 'export' command to act as bash users expect." 300 "This alias allows the `export' command to act as bash users expect."
301 (while sets 301 (while sets
302 (if (and (stringp (car sets)) 302 (if (and (stringp (car sets))
303 (string-match "^\\([^=]+\\)=\\(.*\\)" (car sets))) 303 (string-match "^\\([^=]+\\)=\\(.*\\)" (car sets)))
diff --git a/lisp/faces.el b/lisp/faces.el
index c54e76a4d44..1791a5a2dca 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -1,6 +1,6 @@
1;;; faces.el --- Lisp faces 1;;; faces.el --- Lisp faces
2 2
3;; Copyright (C) 1992,1993,1994,1995,1996,1998,1999,2000,2001,2002,2004 3;; Copyright (C) 1992,1993,1994,1995,1996,1998,1999,2000,2001,2002,2004,2005
4;; Free Software Foundation, Inc. 4;; Free Software Foundation, Inc.
5 5
6;; Maintainer: FSF 6;; Maintainer: FSF
@@ -231,8 +231,8 @@ of a face name is the same for all frames."
231(defun face-equal (face1 face2 &optional frame) 231(defun face-equal (face1 face2 &optional frame)
232 "Non-nil if faces FACE1 and FACE2 are equal. 232 "Non-nil if faces FACE1 and FACE2 are equal.
233Faces are considered equal if all their attributes are equal. 233Faces are considered equal if all their attributes are equal.
234If the optional argument FRAME is given, report on face FACE in that frame. 234If the optional argument FRAME is given, report on FACE1 and FACE2 in that frame.
235If FRAME is t, report on the defaults for face FACE (for new frames). 235If FRAME is t, report on the defaults for FACE1 and FACE2 (for new frames).
236If FRAME is omitted or nil, use the selected frame." 236If FRAME is omitted or nil, use the selected frame."
237 (internal-lisp-face-equal-p face1 face2 frame)) 237 (internal-lisp-face-equal-p face1 face2 frame))
238 238
@@ -854,6 +854,8 @@ If MULTIPLE is non-nil, return a list of faces (possibly only one).
854Otherwise, return a single face." 854Otherwise, return a single face."
855 (let ((faceprop (or (get-char-property (point) 'read-face-name) 855 (let ((faceprop (or (get-char-property (point) 'read-face-name)
856 (get-char-property (point) 'face))) 856 (get-char-property (point) 'face)))
857 (aliasfaces nil)
858 (nonaliasfaces nil)
857 faces) 859 faces)
858 ;; Make a list of the named faces that the `face' property uses. 860 ;; Make a list of the named faces that the `face' property uses.
859 (if (and (listp faceprop) 861 (if (and (listp faceprop)
@@ -870,6 +872,13 @@ Otherwise, return a single face."
870 (memq (intern-soft (thing-at-point 'symbol)) (face-list))) 872 (memq (intern-soft (thing-at-point 'symbol)) (face-list)))
871 (setq faces (list (intern-soft (thing-at-point 'symbol))))) 873 (setq faces (list (intern-soft (thing-at-point 'symbol)))))
872 874
875 ;; Build up the completion tables.
876 (mapatoms (lambda (s)
877 (if (custom-facep s)
878 (if (get s 'face-alias)
879 (push (symbol-name s) aliasfaces)
880 (push (symbol-name s) nonaliasfaces)))))
881
873 ;; If we only want one, and the default is more than one, 882 ;; If we only want one, and the default is more than one,
874 ;; discard the unwanted ones now. 883 ;; discard the unwanted ones now.
875 (unless multiple 884 (unless multiple
@@ -883,7 +892,7 @@ Otherwise, return a single face."
883 (if faces (mapconcat 'symbol-name faces ", ") 892 (if faces (mapconcat 'symbol-name faces ", ")
884 string-describing-default)) 893 string-describing-default))
885 (format "%s: " prompt)) 894 (format "%s: " prompt))
886 obarray 'custom-facep t)) 895 (complete-in-turn nonaliasfaces aliasfaces) nil t))
887 ;; Canonicalize the output. 896 ;; Canonicalize the output.
888 (output 897 (output
889 (if (equal input "") 898 (if (equal input "")
@@ -1894,7 +1903,7 @@ created."
1894;; Make `modeline' an alias for `mode-line', for compatibility. 1903;; Make `modeline' an alias for `mode-line', for compatibility.
1895(put 'modeline 'face-alias 'mode-line) 1904(put 'modeline 'face-alias 'mode-line)
1896(put 'modeline-inactive 'face-alias 'mode-line-inactive) 1905(put 'modeline-inactive 'face-alias 'mode-line-inactive)
1897(put 'modeline-higilight 'face-alias 'mode-line-highlight) 1906(put 'modeline-highlight 'face-alias 'mode-line-highlight)
1898 1907
1899(defface header-line 1908(defface header-line
1900 '((default 1909 '((default
@@ -2115,13 +2124,32 @@ Note: Other faces cannot inherit from the cursor face."
2115 :group 'whitespace ; like `show-trailing-whitespace' 2124 :group 'whitespace ; like `show-trailing-whitespace'
2116 :group 'basic-faces) 2125 :group 'basic-faces)
2117 2126
2118(defface escape-glyph '((((background dark)) :foreground "cyan") 2127(defface escape-glyph
2119 ;; See the comment in minibuffer-prompt for 2128 '((((background dark)) :foreground "pink2")
2120 ;; the reason not to use blue on MS-DOS. 2129 ;; See the comment in minibuffer-prompt for
2121 (((type pc)) :foreground "magenta") 2130 ;; the reason not to use blue on MS-DOS.
2122 (t :foreground "blue")) 2131 (((type pc)) :foreground "magenta")
2132 ;; red4 is too light -- rms.
2133 (t :foreground "blue"))
2123 "Face for characters displayed as ^-sequences or \-sequences." 2134 "Face for characters displayed as ^-sequences or \-sequences."
2124 :group 'basic-faces) 2135 :group 'basic-faces
2136 :version "22.1")
2137
2138(defface no-break-space
2139 '((((class color) (min-colors 88)) :inherit escape-glyph :underline t)
2140 (((class color) (min-colors 8)) :background "magenta" :foreground )
2141 (t :inverse-video t))
2142 "Face for non-breaking space."
2143 :group 'basic-faces
2144 :version "22.1")
2145
2146(defface shadow
2147 '((((background dark)) :foreground "grey70")
2148 (((background light)) :foreground "grey50"))
2149 "Basic face for shadowed text."
2150 :group 'basic-faces
2151 :version "22.1")
2152
2125 2153
2126;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2154;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2127;;; Manipulating font names. 2155;;; Manipulating font names.
@@ -2301,5 +2329,5 @@ If that can't be done, return nil."
2301 2329
2302(provide 'faces) 2330(provide 'faces)
2303 2331
2304;;; arch-tag: 19a4759f-2963-445f-b004-425b9aadd7d6 2332;; arch-tag: 19a4759f-2963-445f-b004-425b9aadd7d6
2305;;; faces.el ends here 2333;;; faces.el ends here
diff --git a/lisp/files.el b/lisp/files.el
index e5c2358b1d0..ee986e5cece 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -658,7 +658,7 @@ one or more of those symbols."
658 658
659(defun locate-file-completion (string path-and-suffixes action) 659(defun locate-file-completion (string path-and-suffixes action)
660 "Do completion for file names passed to `locate-file'. 660 "Do completion for file names passed to `locate-file'.
661PATH-AND-SUFFIXES is a pair of lists (DIRECTORIES . SUFFIXES)." 661PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
662 (if (file-name-absolute-p string) 662 (if (file-name-absolute-p string)
663 (read-file-name-internal string nil action) 663 (read-file-name-internal string nil action)
664 (let ((names nil) 664 (let ((names nil)
@@ -1766,12 +1766,12 @@ in that case, this function acts as if `enable-local-variables' were t."
1766 ("\\.ad[abs]\\'" . ada-mode) 1766 ("\\.ad[abs]\\'" . ada-mode)
1767 ("\\.ad[bs].dg\\'" . ada-mode) 1767 ("\\.ad[bs].dg\\'" . ada-mode)
1768 ("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode) 1768 ("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode)
1769 ("GNUmakefile\\'" . makefile-gmake-mode)
1770 ,@(if (memq system-type '(berkeley-unix next-mach darwin)) 1769 ,@(if (memq system-type '(berkeley-unix next-mach darwin))
1771 '(("\\.mk\\'" . makefile-bsdmake-mode) 1770 '(("\\.mk\\'" . makefile-bsdmake-mode)
1771 ("GNUmakefile\\'" . makefile-gmake-mode)
1772 ("[Mm]akefile\\'" . makefile-bsdmake-mode)) 1772 ("[Mm]akefile\\'" . makefile-bsdmake-mode))
1773 '(("\\.mk\\'" . makefile-gmake-mode) ; Might be any make, give Gnu the host advantage 1773 '(("\\.mk\\'" . makefile-gmake-mode) ; Might be any make, give Gnu the host advantage
1774 ("[Mm]akefile\\'" . makefile-mode))) 1774 ("[Mm]akefile\\'" . makefile-gmake-mode)))
1775 ("Makeppfile\\'" . makefile-makepp-mode) 1775 ("Makeppfile\\'" . makefile-makepp-mode)
1776 ("\\.am\\'" . makefile-automake-mode) 1776 ("\\.am\\'" . makefile-automake-mode)
1777 ;; Less common extensions come here 1777 ;; Less common extensions come here
@@ -2159,9 +2159,9 @@ Otherwise, return nil; point may be changed."
2159 (goto-char beg) 2159 (goto-char beg)
2160 end)))) 2160 end))))
2161 2161
2162(defun hack-local-variables-confirm (string) 2162(defun hack-local-variables-confirm (string flag-to-check)
2163 (or (eq enable-local-variables t) 2163 (or (eq flag-to-check t)
2164 (and enable-local-variables 2164 (and flag-to-check
2165 (save-window-excursion 2165 (save-window-excursion
2166 (condition-case nil 2166 (condition-case nil
2167 (switch-to-buffer (current-buffer)) 2167 (switch-to-buffer (current-buffer))
@@ -2236,7 +2236,8 @@ is specified, returning t if it is specified."
2236 (if (and result 2236 (if (and result
2237 (or mode-only 2237 (or mode-only
2238 (hack-local-variables-confirm 2238 (hack-local-variables-confirm
2239 "Set local variables as specified in -*- line of %s? "))) 2239 "Set local variables as specified in -*- line of %s? "
2240 enable-local-variables)))
2240 (let ((enable-local-eval enable-local-eval)) 2241 (let ((enable-local-eval enable-local-eval))
2241 (while result 2242 (while result
2242 (hack-one-local-variable (car (car result)) (cdr (car result))) 2243 (hack-one-local-variable (car (car result)) (cdr (car result)))
@@ -2267,7 +2268,8 @@ is specified, returning t if it is specified."
2267 (and (search-forward "Local Variables:" nil t) 2268 (and (search-forward "Local Variables:" nil t)
2268 (or mode-only 2269 (or mode-only
2269 (hack-local-variables-confirm 2270 (hack-local-variables-confirm
2270 "Set local variables as specified at end of %s? ")))) 2271 "Set local variables as specified at end of %s? "
2272 enable-local-variables))))
2271 (skip-chars-forward " \t") 2273 (skip-chars-forward " \t")
2272 (let ((enable-local-eval enable-local-eval) 2274 (let ((enable-local-eval enable-local-eval)
2273 ;; suffix is what comes after "local variables:" in its line. 2275 ;; suffix is what comes after "local variables:" in its line.
@@ -2489,7 +2491,8 @@ is considered risky."
2489 ;; Permit eval if not root and user says ok. 2491 ;; Permit eval if not root and user says ok.
2490 (and (not (zerop (user-uid))) 2492 (and (not (zerop (user-uid)))
2491 (hack-local-variables-confirm 2493 (hack-local-variables-confirm
2492 "Process `eval' or hook local variables in %s? "))) 2494 "Process `eval' or hook local variables in %s? "
2495 enable-local-eval)))
2493 (if (eq var 'eval) 2496 (if (eq var 'eval)
2494 (save-excursion (eval val)) 2497 (save-excursion (eval val))
2495 (make-local-variable var) 2498 (make-local-variable var)
@@ -2851,7 +2854,7 @@ the value is \"\"."
2851 2854
2852(defcustom make-backup-file-name-function nil 2855(defcustom make-backup-file-name-function nil
2853 "A function to use instead of the default `make-backup-file-name'. 2856 "A function to use instead of the default `make-backup-file-name'.
2854A value of nil gives the default `make-backup-file-name' behaviour. 2857A value of nil gives the default `make-backup-file-name' behavior.
2855 2858
2856This could be buffer-local to do something special for specific 2859This could be buffer-local to do something special for specific
2857files. If you define it, you may need to change `backup-file-name-p' 2860files. If you define it, you may need to change `backup-file-name-p'
diff --git a/lisp/filesets.el b/lisp/filesets.el
index 7bbf55d9823..569207e27c5 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -650,8 +650,8 @@ the filename."
650Has the form ((FILE-PATTERN VIEWER PROPERTIES) ...), VIEWER being either a 650Has the form ((FILE-PATTERN VIEWER PROPERTIES) ...), VIEWER being either a
651function or a command name as string. 651function or a command name as string.
652 652
653Properties is an association list determining filesets' behaviour in 653Properties is an association list determining filesets' behavior in
654several conditions. Choose one from this list: 654several conditions. Choose one from this list:
655 655
656:ignore-on-open-all ... Don't open files of this type automatically -- 656:ignore-on-open-all ... Don't open files of this type automatically --
657i.e. on open-all-files-events or when running commands 657i.e. on open-all-files-events or when running commands
diff --git a/lisp/font-core.el b/lisp/font-core.el
index 056c1b3515b..a78e21a762f 100644
--- a/lisp/font-core.el
+++ b/lisp/font-core.el
@@ -88,6 +88,8 @@ settings. See the variable `font-lock-defaults', which takes precedence.")
88It will be passed one argument, which is the current value of 88It will be passed one argument, which is the current value of
89`font-lock-mode'.") 89`font-lock-mode'.")
90 90
91;; The mode for which font-lock was initialized, or nil if none.
92(defvar font-lock-mode-major-mode)
91(define-minor-mode font-lock-mode 93(define-minor-mode font-lock-mode
92 "Toggle Font Lock mode. 94 "Toggle Font Lock mode.
93With arg, turn Font Lock mode off if and only if arg is a non-positive 95With arg, turn Font Lock mode off if and only if arg is a non-positive
@@ -156,7 +158,9 @@ your own function which is called when `font-lock-mode' is toggled via
156 ;; Arrange to unfontify this buffer if we change major mode later. 158 ;; Arrange to unfontify this buffer if we change major mode later.
157 (if font-lock-mode 159 (if font-lock-mode
158 (add-hook 'change-major-mode-hook 'font-lock-change-mode nil t) 160 (add-hook 'change-major-mode-hook 'font-lock-change-mode nil t)
159 (remove-hook 'change-major-mode-hook 'font-lock-change-mode t))) 161 (remove-hook 'change-major-mode-hook 'font-lock-change-mode t))
162 (when font-lock-mode
163 (setq font-lock-mode-major-mode major-mode)))
160 164
161;; Get rid of fontification for the old major mode. 165;; Get rid of fontification for the old major mode.
162;; We do this when changing major modes. 166;; We do this when changing major modes.
@@ -175,6 +179,7 @@ this function onto `change-major-mode-hook'."
175 '(font-lock-face))) 179 '(font-lock-face)))
176 (restore-buffer-modified-p modp))) 180 (restore-buffer-modified-p modp)))
177 181
182(defvar font-lock-set-defaults)
178(defun font-lock-default-function (mode) 183(defun font-lock-default-function (mode)
179 ;; Turn on Font Lock mode. 184 ;; Turn on Font Lock mode.
180 (when mode 185 (when mode
@@ -201,9 +206,14 @@ this function onto `change-major-mode-hook'."
201 ;; Only do hard work if the mode has specified stuff in 206 ;; Only do hard work if the mode has specified stuff in
202 ;; `font-lock-defaults'. 207 ;; `font-lock-defaults'.
203 (when (or font-lock-defaults 208 (when (or font-lock-defaults
204 (and (boundp 'font-lock-keywords) font-lock-keywords) 209 (if (boundp 'font-lock-keywords) font-lock-keywords)
205 (with-no-warnings 210 (with-no-warnings
206 (cdr (assq major-mode font-lock-defaults-alist)))) 211 (cdr (assq major-mode font-lock-defaults-alist)))
212 (and mode
213 (boundp 'font-lock-set-defaults)
214 font-lock-set-defaults
215 font-lock-mode-major-mode
216 (not (eq font-lock-mode-major-mode major-mode))))
207 (font-lock-mode-internal mode))) 217 (font-lock-mode-internal mode)))
208 218
209(defun turn-on-font-lock () 219(defun turn-on-font-lock ()
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 10b4d67aabe..06afd1017e7 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -683,9 +683,22 @@ For example:
683adds two fontification patterns for C mode, to fontify `FIXME:' words, even in 683adds two fontification patterns for C mode, to fontify `FIXME:' words, even in
684comments, and to fontify `and', `or' and `not' words as keywords. 684comments, and to fontify `and', `or' and `not' words as keywords.
685 685
686When used from a Lisp program (such as a minor mode), it is recommended to 686The above procedure will only add the keywords for C mode, not
687use nil for MODE (and place the call on a hook) to avoid subtle problems 687for modes derived from C mode. To add them for derived modes too,
688due to details of the implementation. 688pass nil for MODE and add the call to c-mode-hook.
689
690For example:
691
692 (add-hook 'c-mode-hook
693 (lambda ()
694 (font-lock-add-keywords nil
695 '((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 font-lock-warning-face prepend)
696 (\"\\\\\\=<\\\\(and\\\\|or\\\\|not\\\\)\\\\\\=>\" .
697 font-lock-keyword-face)))))
698
699The above procedure may fail to add keywords to derived modes if
700some involved major mode does not follow the standard conventions.
701File a bug report if this happens, so the major mode can be corrected.
689 702
690Note that some modes have specialized support for additional patterns, e.g., 703Note that some modes have specialized support for additional patterns, e.g.,
691see the variables `c-font-lock-extra-types', `c++-font-lock-extra-types', 704see the variables `c-font-lock-extra-types', `c++-font-lock-extra-types',
@@ -704,7 +717,8 @@ see the variables `c-font-lock-extra-types', `c++-font-lock-extra-types',
704 (font-lock-update-removed-keyword-alist mode keywords append)) 717 (font-lock-update-removed-keyword-alist mode keywords append))
705 (t 718 (t
706 ;; Otherwise set or add the keywords now. 719 ;; Otherwise set or add the keywords now.
707 ;; This is a no-op if it has been done already in this buffer. 720 ;; This is a no-op if it has been done already in this buffer
721 ;; for the correct major mode.
708 (font-lock-set-defaults) 722 (font-lock-set-defaults)
709 (let ((was-compiled (eq (car font-lock-keywords) t))) 723 (let ((was-compiled (eq (car font-lock-keywords) t)))
710 ;; Bring back the user-level (uncompiled) keywords. 724 ;; Bring back the user-level (uncompiled) keywords.
@@ -774,9 +788,11 @@ see the variables `c-font-lock-extra-types', `c++-font-lock-extra-types',
774MODE should be a symbol, the major mode command name, such as `c-mode' 788MODE should be a symbol, the major mode command name, such as `c-mode'
775or nil. If nil, highlighting keywords are removed for the current buffer. 789or nil. If nil, highlighting keywords are removed for the current buffer.
776 790
777When used from a Lisp program (such as a minor mode), it is recommended to 791To make the removal apply to modes derived from MODE as well,
778use nil for MODE (and place the call on a hook) to avoid subtle problems 792pass nil for MODE and add the call to MODE-hook. This may fail
779due to details of the implementation." 793for some derived modes if some involved major mode does not
794follow the standard conventions. File a bug report if this
795happens, so the major mode can be corrected."
780 (cond (mode 796 (cond (mode
781 ;; Remove one keyword at the time. 797 ;; Remove one keyword at the time.
782 (dolist (keyword keywords) 798 (dolist (keyword keywords)
@@ -889,7 +905,7 @@ The value of this variable is used when Font Lock mode is turned on."
889 'font-lock-after-change-function t) 905 'font-lock-after-change-function t)
890 (set (make-local-variable 'font-lock-fontify-buffer-function) 906 (set (make-local-variable 'font-lock-fontify-buffer-function)
891 'jit-lock-refontify) 907 'jit-lock-refontify)
892 ;; Don't fontify eagerly (and don't abort is the buffer is large). 908 ;; Don't fontify eagerly (and don't abort if the buffer is large).
893 (set (make-local-variable 'font-lock-fontified) t) 909 (set (make-local-variable 'font-lock-fontified) t)
894 ;; Use jit-lock. 910 ;; Use jit-lock.
895 (jit-lock-register 'font-lock-fontify-region 911 (jit-lock-register 'font-lock-fontify-region
@@ -1571,12 +1587,15 @@ A LEVEL of nil is equal to a LEVEL of 0, a LEVEL of t is equal to
1571 1587
1572(defvar font-lock-set-defaults nil) ; Whether we have set up defaults. 1588(defvar font-lock-set-defaults nil) ; Whether we have set up defaults.
1573 1589
1590(defvar font-lock-mode-major-mode)
1574(defun font-lock-set-defaults () 1591(defun font-lock-set-defaults ()
1575 "Set fontification defaults appropriately for this mode. 1592 "Set fontification defaults appropriately for this mode.
1576Sets various variables using `font-lock-defaults' (or, if nil, using 1593Sets various variables using `font-lock-defaults' (or, if nil, using
1577`font-lock-defaults-alist') and `font-lock-maximum-decoration'." 1594`font-lock-defaults-alist') and `font-lock-maximum-decoration'."
1578 ;; Set fontification defaults iff not previously set. 1595 ;; Set fontification defaults iff not previously set for correct major mode.
1579 (unless font-lock-set-defaults 1596 (unless (and font-lock-set-defaults
1597 (eq font-lock-mode-major-mode major-mode))
1598 (setq font-lock-mode-major-mode major-mode)
1580 (set (make-local-variable 'font-lock-set-defaults) t) 1599 (set (make-local-variable 'font-lock-set-defaults) t)
1581 (make-local-variable 'font-lock-fontified) 1600 (make-local-variable 'font-lock-fontified)
1582 (make-local-variable 'font-lock-multiline) 1601 (make-local-variable 'font-lock-multiline)
@@ -1807,6 +1826,17 @@ Sets various variables using `font-lock-defaults' (or, if nil, using
1807 "Font Lock mode face used to highlight preprocessor directives." 1826 "Font Lock mode face used to highlight preprocessor directives."
1808 :group 'font-lock-highlighting-faces) 1827 :group 'font-lock-highlighting-faces)
1809 1828
1829(defface font-lock-regexp-backslash
1830 '((((class color) (min-colors 16)) :inherit escape-glyph)
1831 (t :inherit bold))
1832 "Font Lock mode face used to highlight a backslash in Lisp regexps."
1833 :group 'font-lock-highlighting-faces)
1834
1835(defface font-lock-regexp-backslash-construct
1836 '((t :inherit bold))
1837 "Font Lock mode face used to highlight `\' constructs in Lisp regexps."
1838 :group 'font-lock-highlighting-faces)
1839
1810;;; End of Colour etc. support. 1840;;; End of Colour etc. support.
1811 1841
1812;;; Menu support. 1842;;; Menu support.
@@ -2000,7 +2030,7 @@ This function could be MATCHER in a MATCH-ANCHORED `font-lock-keywords' item."
2000 `(;; Control structures. Emacs Lisp forms. 2030 `(;; Control structures. Emacs Lisp forms.
2001 (,(concat 2031 (,(concat
2002 "(" (regexp-opt 2032 "(" (regexp-opt
2003 '("cond" "if" "while" "let" "let*" 2033 '("cond" "if" "while" "while-no-input" "let" "let*"
2004 "prog" "progn" "progv" "prog1" "prog2" "prog*" 2034 "prog" "progn" "progv" "prog1" "prog2" "prog*"
2005 "inline" "lambda" "save-restriction" "save-excursion" 2035 "inline" "lambda" "save-restriction" "save-excursion"
2006 "save-window-excursion" "save-selected-window" 2036 "save-window-excursion" "save-selected-window"
@@ -2056,16 +2086,14 @@ This function could be MATCHER in a MATCH-ANCHORED `font-lock-keywords' item."
2056 ;; Make regexp grouping constructs bold, so they stand out, but only 2086 ;; Make regexp grouping constructs bold, so they stand out, but only
2057 ;; in strings. 2087 ;; in strings.
2058 ((lambda (bound) 2088 ((lambda (bound)
2059 (if (re-search-forward "\\(\\\\\\\\\\)\\([(|)]\\)\\(\\?:\\)?" bound t) 2089 (if (re-search-forward "\\(\\\\\\\\\\)\\((\\(?:?:\\)?\\|[|)]\\)" bound t)
2060 (let ((face (get-text-property (1- (point)) 'face))) 2090 (let ((face (get-text-property (1- (point)) 'face)))
2061 (if (listp face) 2091 (if (listp face)
2062 (memq 'font-lock-string-face face) 2092 (memq 'font-lock-string-face face)
2063 (eq 'font-lock-string-face face))))) 2093 (eq 'font-lock-string-face face)))))
2064 ;; Should we introduce a lowlight face for this? 2094 (1 'font-lock-regexp-backslash prepend)
2065 ;; Ideally that would retain the color, dimmed. 2095 (2 'font-lock-regexp-backslash-construct prepend))
2066 (1 font-lock-comment-face prepend) 2096
2067 (2 'bold prepend)
2068 (3 font-lock-type-face prepend t))
2069 ;; Underline innermost grouping, so that you can more easily see what 2097 ;; Underline innermost grouping, so that you can more easily see what
2070 ;; belongs together. 2005-05-12: Font-lock can go into an 2098 ;; belongs together. 2005-05-12: Font-lock can go into an
2071 ;; unbreakable endless loop on this -- something's broken. 2099 ;; unbreakable endless loop on this -- something's broken.
diff --git a/lisp/forms.el b/lisp/forms.el
index 57985a7297f..d1c5b0c5fd9 100644
--- a/lisp/forms.el
+++ b/lisp/forms.el
@@ -550,7 +550,7 @@ Commands: Equivalent keys in read-only mode:
550 (eq (length forms-multi-line) 1)) 550 (eq (length forms-multi-line) 1))
551 (if (string= forms-multi-line forms-field-sep) 551 (if (string= forms-multi-line forms-field-sep)
552 (error (concat "Forms control file error: " 552 (error (concat "Forms control file error: "
553 "`forms-multi-line' is equal to 'forms-field-sep'"))) 553 "`forms-multi-line' is equal to `forms-field-sep'")))
554 (error (concat "Forms control file error: " 554 (error (concat "Forms control file error: "
555 "`forms-multi-line' must be nil or a one-character string")))) 555 "`forms-multi-line' must be nil or a one-character string"))))
556 (or (fboundp 'set-text-properties) 556 (or (fboundp 'set-text-properties)
@@ -1207,7 +1207,7 @@ Commands: Equivalent keys in read-only mode:
1207 1207
1208 ;; Need a file to do this. 1208 ;; Need a file to do this.
1209 (if (not (file-exists-p forms-file)) 1209 (if (not (file-exists-p forms-file))
1210 (error "Need existing file or explicit 'forms-number-of-records'") 1210 (error "Need existing file or explicit `forms-number-of-fields'")
1211 1211
1212 ;; Visit the file and extract the first record. 1212 ;; Visit the file and extract the first record.
1213 (setq forms--file-buffer (find-file-noselect forms-file)) 1213 (setq forms--file-buffer (find-file-noselect forms-file))
@@ -1983,7 +1983,7 @@ after writing out the data."
1983 (goto-char (aref forms--markers (1- (length forms--markers))))))) 1983 (goto-char (aref forms--markers (1- (length forms--markers)))))))
1984 1984
1985(defun forms-print () 1985(defun forms-print ()
1986 "Send the records to the printer with 'print-buffer', one record per page." 1986 "Send the records to the printer with `print-buffer', one record per page."
1987 (interactive) 1987 (interactive)
1988 (let ((inhibit-read-only t) 1988 (let ((inhibit-read-only t)
1989 (save-record forms--current-record) 1989 (save-record forms--current-record)
diff --git a/lisp/frame.el b/lisp/frame.el
index ec98089cc0e..e7084bb6a33 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -1036,9 +1036,9 @@ one frame, otherwise the name is displayed on the frame's caption bar."
1036 1036
1037(defun frame-current-scroll-bars (&optional frame) 1037(defun frame-current-scroll-bars (&optional frame)
1038 "Return the current scroll-bar settings in frame FRAME. 1038 "Return the current scroll-bar settings in frame FRAME.
1039Value is a cons (VERTICAL . HORISONTAL) where VERTICAL specifies the 1039Value is a cons (VERTICAL . HORIZ0NTAL) where VERTICAL specifies the
1040current location of the vertical scroll-bars (left, right, or nil), 1040current location of the vertical scroll-bars (left, right, or nil),
1041and HORISONTAL specifies the current location of the horisontal scroll 1041and HORIZONTAL specifies the current location of the horizontal scroll
1042bars (top, bottom, or nil)." 1042bars (top, bottom, or nil)."
1043 (let ((vert (frame-parameter frame 'vertical-scroll-bars)) 1043 (let ((vert (frame-parameter frame 'vertical-scroll-bars))
1044 (hor nil)) 1044 (hor nil))
diff --git a/lisp/generic-x.el b/lisp/generic-x.el
index 9ba06d42397..fcf5b6c0e1d 100644
--- a/lisp/generic-x.el
+++ b/lisp/generic-x.el
@@ -1733,17 +1733,17 @@ like an INI file. You can add this hook to `find-file-hook'."
1733 1733
1734(defconst show-tabs-generic-mode-font-lock-defaults-1 1734(defconst show-tabs-generic-mode-font-lock-defaults-1
1735 '(;; trailing spaces must come before... 1735 '(;; trailing spaces must come before...
1736 ("[ \t]+$" . 'show-tabs-space-face) 1736 ("[ \t]+$" . 'show-tabs-space)
1737 ;; ...embedded tabs 1737 ;; ...embedded tabs
1738 ("[^\n\t]\\(\t+\\)" (1 'show-tabs-tab-face)))) 1738 ("[^\n\t]\\(\t+\\)" (1 'show-tabs-tab))))
1739 1739
1740(defconst show-tabs-generic-mode-font-lock-defaults-2 1740(defconst show-tabs-generic-mode-font-lock-defaults-2
1741 '(;; trailing spaces must come before... 1741 '(;; trailing spaces must come before...
1742 ("[ \t]+$" . 'show-tabs-space-face) 1742 ("[ \t]+$" . 'show-tabs-space)
1743 ;; ...tabs 1743 ;; ...tabs
1744 ("\t+" . 'show-tabs-tab-face)))) 1744 ("\t+" . 'show-tabs-tab))))
1745 1745
1746(defface show-tabs-tab-face 1746(defface show-tabs-tab
1747 '((((class grayscale) (background light)) (:background "DimGray" :weight bold)) 1747 '((((class grayscale) (background light)) (:background "DimGray" :weight bold))
1748 (((class grayscale) (background dark)) (:background "LightGray" :weight bold)) 1748 (((class grayscale) (background dark)) (:background "LightGray" :weight bold))
1749 (((class color) (min-colors 88)) (:background "red1")) 1749 (((class color) (min-colors 88)) (:background "red1"))
@@ -1751,8 +1751,10 @@ like an INI file. You can add this hook to `find-file-hook'."
1751 (t (:weight bold))) 1751 (t (:weight bold)))
1752 "Font Lock mode face used to highlight TABs." 1752 "Font Lock mode face used to highlight TABs."
1753 :group 'generic-x) 1753 :group 'generic-x)
1754;; backward-compatibility alias
1755(put 'show-tabs-tab-face 'face-alias 'show-tabs-tab)
1754 1756
1755(defface show-tabs-space-face 1757(defface show-tabs-space
1756 '((((class grayscale) (background light)) (:background "DimGray" :weight bold)) 1758 '((((class grayscale) (background light)) (:background "DimGray" :weight bold))
1757 (((class grayscale) (background dark)) (:background "LightGray" :weight bold)) 1759 (((class grayscale) (background dark)) (:background "LightGray" :weight bold))
1758 (((class color) (min-colors 88)) (:background "yellow1")) 1760 (((class color) (min-colors 88)) (:background "yellow1"))
@@ -1760,6 +1762,8 @@ like an INI file. You can add this hook to `find-file-hook'."
1760 (t (:weight bold))) 1762 (t (:weight bold)))
1761 "Font Lock mode face used to highlight spaces." 1763 "Font Lock mode face used to highlight spaces."
1762 :group 'generic-x) 1764 :group 'generic-x)
1765;; backward-compatibility alias
1766(put 'show-tabs-space-face 'face-alias 'show-tabs-space)
1763 1767
1764(define-generic-mode show-tabs-generic-mode 1768(define-generic-mode show-tabs-generic-mode
1765 nil ;; no comment char 1769 nil ;; no comment char
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 83b5e3820e6..e210b4def7c 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,10 +1,42 @@
12005-06-14 Juanma Barranquero <lekktu@gmail.com>
2
3 * gnus-sieve.el (gnus-sieve-article-add-rule):
4 * legacy-gnus-agent.el (gnus-agent-unlist-expire-days):
5 * spam-stat.el (spam-stat-buffer-change-to-spam)
6 (spam-stat-buffer-change-to-non-spam): Follow error conventions.
7
8 * message.el (message-is-yours-p):
9 * gnus-sum.el (gnus-auto-select-subject): Fix quoting in docstring.
10
112005-06-14 Katsumi Yamaoka <yamaoka@jpl.org>
12
13 * mm-view.el (mm-inline-text): Withdraw the last change.
14
152005-06-09 Katsumi Yamaoka <yamaoka@jpl.org>
16
17 * mm-view.el (mm-inline-text): Turn off adaptive-fill-mode while
18 executing enriched-decode.
19
202005-06-04 Luc Teirlinck <teirllm@auburn.edu>
21
22 * gnus-art.el (article-update-date-lapsed): Use `save-match-data'.
23
242005-06-04 Lute Kamstra <lute@gnu.org>
25
26 * nnfolder.el (nnfolder-read-folder): Make sure that undo
27 information is never recorded.
28
292005-06-03 Stefan Monnier <monnier@iro.umontreal.ca>
30
31 * gnus-art.el (gnus-emphasis-alist): Disable the strikethru thingy.
32
12005-06-02 Katsumi Yamaoka <yamaoka@jpl.org> 332005-06-02 Katsumi Yamaoka <yamaoka@jpl.org>
2 34
3 * pop3.el (pop3-md5): Run md5 in the binary mode. 35 * pop3.el (pop3-md5): Run md5 in the binary mode.
4 (pop3-md5-program-args): New variable. 36 (pop3-md5-program-args): New variable.
5 37
6 * starttls.el (starttls-set-process-query-on-exit-flag): Use 38 * starttls.el (starttls-set-process-query-on-exit-flag):
7 eval-and-compile. 39 Use eval-and-compile.
8 40
92005-05-31 Katsumi Yamaoka <yamaoka@jpl.org> 412005-05-31 Katsumi Yamaoka <yamaoka@jpl.org>
10 42
@@ -29,8 +61,8 @@
29 61
30 * mml2015.el: Bind pgg-default-user-id when compiling. 62 * mml2015.el: Bind pgg-default-user-id when compiling.
31 63
32 * nndraft.el (nndraft-request-associate-buffer): Use 64 * nndraft.el (nndraft-request-associate-buffer):
33 write-contents-functions instead of write-contents-hooks if it is 65 Use write-contents-functions instead of write-contents-hooks if it is
34 available. 66 available.
35 67
36 * nnheader.el (nnheader-find-file-noselect): Bind find-file-hook 68 * nnheader.el (nnheader-find-file-noselect): Bind find-file-hook
@@ -58,7 +90,7 @@
58 90
592005-05-31 Kevin Greiner <kgreiner@xpediantsolutions.com> 912005-05-31 Kevin Greiner <kgreiner@xpediantsolutions.com>
60 92
61 * gnus-group.el (): Require gnus-sum and autoload functions to 93 * gnus-group.el: Require gnus-sum and autoload functions to
62 resolve warnings when gnus-group.el compiled alone. 94 resolve warnings when gnus-group.el compiled alone.
63 95
642005-05-30 Reiner Steib <Reiner.Steib@gmx.de> 962005-05-30 Reiner Steib <Reiner.Steib@gmx.de>
@@ -195,7 +227,7 @@
195 (gnus-summary-high-unread-face): Ditto. 227 (gnus-summary-high-unread-face): Ditto.
196 (gnus-summary-low-unread-face): Ditto. 228 (gnus-summary-low-unread-face): Ditto.
197 (gnus-summary-normal-unread-face): Ditto. 229 (gnus-summary-normal-unread-face): Ditto.
198 (gnus-summary-high-read-face, gnus-summary-low-read-face): Diito 230 (gnus-summary-high-read-face, gnus-summary-low-read-face): Ditto.
199 (gnus-summary-normal-read-face, gnus-splash-face): Ditto. 231 (gnus-summary-normal-read-face, gnus-splash-face): Ditto.
200 232
201 * message.el (message-minibuffer-local-map): Add :group. 233 * message.el (message-minibuffer-local-map): Add :group.
@@ -205,7 +237,7 @@
205 (sieve-manage-server-eol, sieve-manage-client-eol): Ditto. 237 (sieve-manage-server-eol, sieve-manage-client-eol): Ditto.
206 (sieve-manage-streams, sieve-manage-stream-alist): Ditto. 238 (sieve-manage-streams, sieve-manage-stream-alist): Ditto.
207 (sieve-manage-authenticators): Ditto. 239 (sieve-manage-authenticators): Ditto.
208 (sieve-manage-authenticator-alist): Ditto 240 (sieve-manage-authenticator-alist): Ditto.
209 (sieve-manage-default-port): Ditto. 241 (sieve-manage-default-port): Ditto.
210 242
211 * sieve-mode.el (sieve-control-commands-face): Add :group. 243 * sieve-mode.el (sieve-control-commands-face): Add :group.
@@ -438,11 +470,11 @@
438 470
439 * nnimap.el (nnimap-date-days-ago): Ditto. 471 * nnimap.el (nnimap-date-days-ago): Ditto.
440 472
441 * gnus-demon.el (parse-time-string): Added autoload. 473 * gnus-demon.el (parse-time-string): Add autoload.
442 474
443 * gnus-delay.el (parse-time-string): Added autoload. 475 * gnus-delay.el (parse-time-string): Add autoload.
444 476
445 * gnus-art.el (parse-time-string): Added autoload. 477 * gnus-art.el (parse-time-string): Add autoload.
446 478
447 * nnultimate.el (parse-time): Require for `parse-time-string'. 479 * nnultimate.el (parse-time): Require for `parse-time-string'.
448 480
@@ -496,14 +528,13 @@
496 (rfc2047-encoded-word-regexp): Don't use shy group. 528 (rfc2047-encoded-word-regexp): Don't use shy group.
497 (rfc2047-decode-region): Follow rfc2047-encoded-word-regexp change. 529 (rfc2047-decode-region): Follow rfc2047-encoded-word-regexp change.
498 (rfc2047-parse-and-decode): Ditto. 530 (rfc2047-parse-and-decode): Ditto.
499 (rfc2047-decode): Treat the ascii coding-system as raw-text by 531 (rfc2047-decode): Treat the ascii coding-system as raw-text by default.
500 default.
501 532
5022005-03-25 Lars Magne Ingebrigtsen <larsi@gnus.org> 5332005-03-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
503 534
504 * rfc2047.el (rfc2047-encode-encoded-words): New variable. 535 * rfc2047.el (rfc2047-encode-encoded-words): New variable.
505 (rfc2047-field-value): Strip props. 536 (rfc2047-field-value): Strip props.
506 (rfc2047-encode-message-header): Disabled header folding -- not 537 (rfc2047-encode-message-header): Disable header folding -- not
507 all headers can be folded, and this should be done by the message 538 all headers can be folded, and this should be done by the message
508 composition mode. Probably. I think. 539 composition mode. Probably. I think.
509 (rfc2047-encodable-p): Say that =? needs encoding. 540 (rfc2047-encodable-p): Say that =? needs encoding.
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 4af363c6b2e..498596dd63c 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -367,8 +367,12 @@ advertisements. For example:
367 (or (nth 4 spec) 3) 367 (or (nth 4 spec) 3)
368 (intern (format "gnus-emphasis-%s" (nth 2 spec))))) 368 (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
369 types)) 369 types))
370 '(("\\(\\s-\\|^\\)\\(-\\(\\(\\w\\|-[^-]\\)+\\)-\\)\\(\\s-\\|[?!.,;]\\)" 370 '(;; I've never seen anyone use this strikethru convention whereas I've
371 2 3 gnus-emphasis-strikethru) 371 ;; several times seen it triggered by normal text. --Stef
372 ;; Miles suggests that this form is sometimes used but for italics,
373 ;; so maybe we should map it to `italic'.
374 ;; ("\\(\\s-\\|^\\)\\(-\\(\\(\\w\\|-[^-]\\)+\\)-\\)\\(\\s-\\|[?!.,;]\\)"
375 ;; 2 3 gnus-emphasis-strikethru)
372 ("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)" 376 ("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
373 2 3 gnus-emphasis-underline)))) 377 2 3 gnus-emphasis-underline))))
374 "*Alist that says how to fontify certain phrases. 378 "*Alist that says how to fontify certain phrases.
@@ -3034,20 +3038,21 @@ function and want to see what the date was before converting."
3034 3038
3035(defun article-update-date-lapsed () 3039(defun article-update-date-lapsed ()
3036 "Function to be run from a timer to update the lapsed time line." 3040 "Function to be run from a timer to update the lapsed time line."
3037 (let (deactivate-mark) 3041 (save-match-data
3038 (save-excursion 3042 (let (deactivate-mark)
3039 (ignore-errors 3043 (save-excursion
3040 (walk-windows 3044 (ignore-errors
3041 (lambda (w) 3045 (walk-windows
3042 (set-buffer (window-buffer w)) 3046 (lambda (w)
3043 (when (eq major-mode 'gnus-article-mode) 3047 (set-buffer (window-buffer w))
3044 (let ((mark (point-marker))) 3048 (when (eq major-mode 'gnus-article-mode)
3045 (goto-char (point-min)) 3049 (let ((mark (point-marker)))
3046 (when (re-search-forward "^X-Sent:" nil t) 3050 (goto-char (point-min))
3047 (article-date-lapsed t)) 3051 (when (re-search-forward "^X-Sent:" nil t)
3048 (goto-char (marker-position mark)) 3052 (article-date-lapsed t))
3049 (move-marker mark nil)))) 3053 (goto-char (marker-position mark))
3050 nil 'visible))))) 3054 (move-marker mark nil))))
3055 nil 'visible))))))
3051 3056
3052(defun gnus-start-date-timer (&optional n) 3057(defun gnus-start-date-timer (&optional n)
3053 "Start a timer to update the X-Sent header in the article buffers. 3058 "Start a timer to update the X-Sent header in the article buffers.
diff --git a/lisp/gnus/gnus-sieve.el b/lisp/gnus/gnus-sieve.el
index e7409c39df0..db9c8c91f5d 100644
--- a/lisp/gnus/gnus-sieve.el
+++ b/lisp/gnus/gnus-sieve.el
@@ -129,7 +129,7 @@ Return nil if no rule could be guessed."
129 (let ((rule (gnus-sieve-guess-rule-for-article)) 129 (let ((rule (gnus-sieve-guess-rule-for-article))
130 (info (gnus-get-info gnus-newsgroup-name))) 130 (info (gnus-get-info gnus-newsgroup-name)))
131 (if (null rule) 131 (if (null rule)
132 (error "Could not guess rule for article.") 132 (error "Could not guess rule for article")
133 (gnus-info-set-params info (cons rule (gnus-info-params info))) 133 (gnus-info-set-params info (cons rule (gnus-info-params info)))
134 (message "Added rule in group %s for article: %s" gnus-newsgroup-name 134 (message "Added rule in group %s for article: %s" gnus-newsgroup-name
135 rule))))) 135 rule)))))
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 8d4c536229b..5447da73fde 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -320,7 +320,7 @@ This variable can either be the symbols `first' (place point on the
320first subject), `unread' (place point on the subject line of the first 320first subject), `unread' (place point on the subject line of the first
321unread article), `best' (place point on the subject line of the 321unread article), `best' (place point on the subject line of the
322higest-scored article), `unseen' (place point on the subject line of 322higest-scored article), `unseen' (place point on the subject line of
323the first unseen article), 'unseen-or-unread' (place point on the subject 323the first unseen article), `unseen-or-unread' (place point on the subject
324line of the first unseen article or, if all article have been seen, on the 324line of the first unseen article or, if all article have been seen, on the
325subject line of the first unread article), or a function to be called to 325subject line of the first unread article), or a function to be called to
326place point on some subject line." 326place point on some subject line."
diff --git a/lisp/gnus/legacy-gnus-agent.el b/lisp/gnus/legacy-gnus-agent.el
index 16b0cf6c89f..50675b0ba27 100644
--- a/lisp/gnus/legacy-gnus-agent.el
+++ b/lisp/gnus/legacy-gnus-agent.el
@@ -25,7 +25,7 @@ converted to the compressed format."
25 ((file-directory-p member) 25 ((file-directory-p member)
26 (push member search-in)) 26 (push member search-in))
27 ((equal (file-name-nondirectory member) ".agentview") 27 ((equal (file-name-nondirectory member) ".agentview")
28 (setq converted-something 28 (setq converted-something
29 (or (gnus-agent-convert-agentview member) 29 (or (gnus-agent-convert-agentview member)
30 converted-something)))))) 30 converted-something))))))
31 31
@@ -175,7 +175,7 @@ converted to the compressed format."
175 (t 175 (t
176 t)))))) 176 t))))))
177 (kill-buffer buffer)) 177 (kill-buffer buffer))
178 (error "Change gnus-agent-expire-days to an integer for gnus to start.")))) 178 (error "Change gnus-agent-expire-days to an integer for gnus to start"))))
179 179
180;; The gnus-agent-unlist-expire-days has its own conversion prompt. 180;; The gnus-agent-unlist-expire-days has its own conversion prompt.
181;; Therefore, hide the default prompt. 181;; Therefore, hide the default prompt.
@@ -198,8 +198,8 @@ possible that the hook was persistently saved."
198 198
199 (when (cond ((eq (type-of func) 'compiled-function) 199 (when (cond ((eq (type-of func) 'compiled-function)
200 ;; Search def. of compiled function for gnus-agent-do-once string 200 ;; Search def. of compiled function for gnus-agent-do-once string
201 (let* (definition 201 (let* (definition
202 print-level 202 print-level
203 print-length 203 print-length
204 (standard-output 204 (standard-output
205 (lambda (char) 205 (lambda (char)
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index eaac4e390a9..b65eec7ec12 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -5912,9 +5912,9 @@ want to get rid of this query permanently."))
5912 5912
5913(defun message-is-yours-p () 5913(defun message-is-yours-p ()
5914 "Non-nil means current article is yours. 5914 "Non-nil means current article is yours.
5915If you have added 'cancel-messages to 'message-shoot-gnksa-feet', all articles 5915If you have added 'cancel-messages to `message-shoot-gnksa-feet', all articles
5916are yours except those that have Cancel-Lock header not belonging to you. 5916are yours except those that have Cancel-Lock header not belonging to you.
5917Instead of shooting GNKSA feet, you should modify 'message-alternative-emails' 5917Instead of shooting GNKSA feet, you should modify `message-alternative-emails'
5918regexp to match all of yours addresses." 5918regexp to match all of yours addresses."
5919 ;; Canlock-logic as suggested by Per Abrahamsen 5919 ;; Canlock-logic as suggested by Per Abrahamsen
5920 ;; <abraham@dina.kvl.dk> 5920 ;; <abraham@dina.kvl.dk>
diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el
index 961f124a614..20cdb3da273 100644
--- a/lisp/gnus/nnfolder.el
+++ b/lisp/gnus/nnfolder.el
@@ -875,6 +875,7 @@ deleted. Point is left where the deleted region was."
875 nnfolder-file-coding-system)) 875 nnfolder-file-coding-system))
876 (nnheader-find-file-noselect file t))))) 876 (nnheader-find-file-noselect file t)))))
877 (mm-enable-multibyte) ;; Use multibyte buffer for future copying. 877 (mm-enable-multibyte) ;; Use multibyte buffer for future copying.
878 (buffer-disable-undo)
878 (if (equal (cadr (assoc group nnfolder-scantime-alist)) 879 (if (equal (cadr (assoc group nnfolder-scantime-alist))
879 (nth 5 (file-attributes file))) 880 (nth 5 (file-attributes file)))
880 ;; This looks up-to-date, so we don't do any scanning. 881 ;; This looks up-to-date, so we don't do any scanning.
@@ -901,7 +902,6 @@ deleted. Point is left where the deleted region was."
901 maxid start end newscantime 902 maxid start end newscantime
902 novbuf articles newnum 903 novbuf articles newnum
903 buffer-read-only) 904 buffer-read-only)
904 (buffer-disable-undo)
905 (setq maxid (cdr active)) 905 (setq maxid (cdr active))
906 906
907 (unless (or gnus-nov-is-evil nnfolder-nov-is-evil 907 (unless (or gnus-nov-is-evil nnfolder-nov-is-evil
diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el
index ca1cdc6ce60..6af9b2e2b3f 100644
--- a/lisp/gnus/spam-stat.el
+++ b/lisp/gnus/spam-stat.el
@@ -370,7 +370,7 @@ Use `spam-stat-ngood', `spam-stat-nbad', `spam-stat-good',
370 (lambda (word count) 370 (lambda (word count)
371 (let ((entry (gethash word spam-stat))) 371 (let ((entry (gethash word spam-stat)))
372 (if (not entry) 372 (if (not entry)
373 (error "This buffer has unknown words in it.") 373 (error "This buffer has unknown words in it")
374 (spam-stat-set-good entry (- (spam-stat-good entry) count)) 374 (spam-stat-set-good entry (- (spam-stat-good entry) count))
375 (spam-stat-set-bad entry (+ (spam-stat-bad entry) count)) 375 (spam-stat-set-bad entry (+ (spam-stat-bad entry) count))
376 (spam-stat-set-score entry (spam-stat-compute-score entry)) 376 (spam-stat-set-score entry (spam-stat-compute-score entry))
@@ -386,7 +386,7 @@ Use `spam-stat-ngood', `spam-stat-nbad', `spam-stat-good',
386 (lambda (word count) 386 (lambda (word count)
387 (let ((entry (gethash word spam-stat))) 387 (let ((entry (gethash word spam-stat)))
388 (if (not entry) 388 (if (not entry)
389 (error "This buffer has unknown words in it.") 389 (error "This buffer has unknown words in it")
390 (spam-stat-set-good entry (+ (spam-stat-good entry) count)) 390 (spam-stat-set-good entry (+ (spam-stat-good entry) count))
391 (spam-stat-set-bad entry (- (spam-stat-bad entry) count)) 391 (spam-stat-set-bad entry (- (spam-stat-bad entry) count))
392 (spam-stat-set-score entry (spam-stat-compute-score entry)) 392 (spam-stat-set-score entry (spam-stat-compute-score entry))
diff --git a/lisp/hexl.el b/lisp/hexl.el
index b67ab7876b4..e24f6b7f72b 100644
--- a/lisp/hexl.el
+++ b/lisp/hexl.el
@@ -988,7 +988,9 @@ This function is assumed to be used as call back function for `hl-line-mode'."
988 (define-key hexl-mode-map [up] 'hexl-previous-line) 988 (define-key hexl-mode-map [up] 'hexl-previous-line)
989 (define-key hexl-mode-map [down] 'hexl-next-line) 989 (define-key hexl-mode-map [down] 'hexl-next-line)
990 (define-key hexl-mode-map [M-left] 'hexl-backward-short) 990 (define-key hexl-mode-map [M-left] 'hexl-backward-short)
991 (define-key hexl-mode-map [?\e left] 'hexl-backward-short)
991 (define-key hexl-mode-map [M-right] 'hexl-forward-short) 992 (define-key hexl-mode-map [M-right] 'hexl-forward-short)
993 (define-key hexl-mode-map [?\e right] 'hexl-forward-short)
992 (define-key hexl-mode-map [next] 'hexl-scroll-up) 994 (define-key hexl-mode-map [next] 'hexl-scroll-up)
993 (define-key hexl-mode-map [prior] 'hexl-scroll-down) 995 (define-key hexl-mode-map [prior] 'hexl-scroll-down)
994 (define-key hexl-mode-map [home] 'hexl-beginning-of-line) 996 (define-key hexl-mode-map [home] 'hexl-beginning-of-line)
diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el
index a6db060ce0f..b6bfb297313 100644
--- a/lisp/hilit-chg.el
+++ b/lisp/hilit-chg.el
@@ -37,9 +37,9 @@
37;; it on to active mode to see them, then toggle it back off to avoid 37;; it on to active mode to see them, then toggle it back off to avoid
38;; distraction. 38;; distraction.
39;; 39;;
40;; When active, changes are displayed in `highlight-changes-face'. When 40;; When active, changes are displayed in the `highlight-changes' face.
41;; text is deleted, the following character is displayed in 41;; When text is deleted, the following character is displayed in the
42;; `highlight-changes-delete-face' face. 42;; `highlight-changes-delete' face.
43;; 43;;
44;; 44;;
45;; You can "age" different sets of changes by using 45;; You can "age" different sets of changes by using
@@ -48,10 +48,10 @@
48;; changes. You can customize these "rotated" faces in two ways. You can 48;; changes. You can customize these "rotated" faces in two ways. You can
49;; either explicitly define each face by customizing 49;; either explicitly define each face by customizing
50;; `highlight-changes-face-list'. If, however, the faces differ from 50;; `highlight-changes-face-list'. If, however, the faces differ from
51;; `highlight-changes-face' only in the foreground color, you can simply set 51;; the `highlight-changes' face only in the foreground color, you can simply set
52;; `highlight-changes-colours'. If `highlight-changes-face-list' is nil when 52;; `highlight-changes-colors'. If `highlight-changes-face-list' is nil when
53;; the faces are required they will be constructed from 53;; the faces are required they will be constructed from
54;; `highlight-changes-colours'. 54;; `highlight-changes-colors'.
55;; 55;;
56;; 56;;
57;; When a Highlight Changes mode is on (either active or passive) you can go 57;; When a Highlight Changes mode is on (either active or passive) you can go
@@ -212,42 +212,49 @@
212;; However, having it set for non-delete changes can be annoying because all 212;; However, having it set for non-delete changes can be annoying because all
213;; indentation on inserts gets underlined (which can look pretty ugly!). 213;; indentation on inserts gets underlined (which can look pretty ugly!).
214 214
215(defface highlight-changes-face 215(defface highlight-changes
216 '((((min-colors 88) (class color)) (:foreground "red1" )) 216 '((((min-colors 88) (class color)) (:foreground "red1" ))
217 (((class color)) (:foreground "red" )) 217 (((class color)) (:foreground "red" ))
218 (t (:inverse-video t))) 218 (t (:inverse-video t)))
219 "Face used for highlighting changes." 219 "Face used for highlighting changes."
220 :group 'highlight-changes) 220 :group 'highlight-changes)
221;; backward-compatibility alias
222(put 'highlight-changes-face 'face-alias 'highlight-changes)
221 223
222;; This looks pretty ugly, actually. Maybe the underline should be removed. 224;; This looks pretty ugly, actually. Maybe the underline should be removed.
223(defface highlight-changes-delete-face 225(defface highlight-changes-delete
224 '((((min-colors 88) (class color)) (:foreground "red1" :underline t)) 226 '((((min-colors 88) (class color)) (:foreground "red1" :underline t))
225 (((class color)) (:foreground "red" :underline t)) 227 (((class color)) (:foreground "red" :underline t))
226 (t (:inverse-video t))) 228 (t (:inverse-video t)))
227 "Face used for highlighting deletions." 229 "Face used for highlighting deletions."
228 :group 'highlight-changes) 230 :group 'highlight-changes)
231;; backward-compatibility alias
232(put 'highlight-changes-delete-face 'face-alias 'highlight-changes-delete)
229 233
230 234
231 235
232;; A (not very good) default list of colours to rotate through. 236;; A (not very good) default list of colors to rotate through.
233;; 237;;
234(defcustom highlight-changes-colours 238(defcustom highlight-changes-colors
235 (if (eq (frame-parameter nil 'background-mode) 'light) 239 (if (eq (frame-parameter nil 'background-mode) 'light)
236 ;; defaults for light background: 240 ;; defaults for light background:
237 '( "magenta" "blue" "darkgreen" "chocolate" "sienna4" "NavyBlue") 241 '( "magenta" "blue" "darkgreen" "chocolate" "sienna4" "NavyBlue")
238 ;; defaults for dark background: 242 ;; defaults for dark background:
239 '("yellow" "magenta" "blue" "maroon" "firebrick" "green4" "DarkOrchid")) 243 '("yellow" "magenta" "blue" "maroon" "firebrick" "green4" "DarkOrchid"))
240 "*Colours used by `highlight-changes-rotate-faces'. 244 "*Colors used by `highlight-changes-rotate-faces'.
241The newest rotated change will be displayed in the first element of this list, 245The newest rotated change will be displayed in the first element of this list,
242the next older will be in the second element etc. 246the next older will be in the second element etc.
243 247
244This list is used if `highlight-changes-face-list' is nil, otherwise that 248This list is used if `highlight-changes-face-list' is nil, otherwise that
245variable overrides this list. If you only care about foreground 249variable overrides this list. If you only care about foreground
246colours then use this, if you want fancier faces then set 250colors then use this, if you want fancier faces then set
247`highlight-changes-face-list'." 251`highlight-changes-face-list'."
248 :type '(repeat color) 252 :type '(repeat color)
249 :group 'highlight-changes) 253 :group 'highlight-changes)
250 254
255(define-obsolete-variable-alias 'highlight-changes-colours
256 'highlight-changes-colors "22.1")
257
251 258
252;; If you invoke highlight-changes-mode with no argument, should it start in 259;; If you invoke highlight-changes-mode with no argument, should it start in
253;; active or passive mode? 260;; active or passive mode?
@@ -347,15 +354,15 @@ remove it from existing buffers."
347 ) 354 )
348 (while p 355 (while p
349 (setq old-name (car p)) 356 (setq old-name (car p))
350 (setq new-name (intern (format "highlight-changes-face-%d" n))) 357 (setq new-name (intern (format "highlight-changes-%d" n)))
351 (if (eq old-name new-name) 358 (if (eq old-name new-name)
352 nil 359 nil
353 ;; A new face has been inserted: we don't want to modify the 360 ;; A new face has been inserted: we don't want to modify the
354 ;; default face so copy it. Better, though, (I think) is to 361 ;; default face so copy it. Better, though, (I think) is to
355 ;; make a new face have the same attributes as 362 ;; make a new face have the same attributes as
356 ;; highlight-changes-face . 363 ;; the `highlight-changes' face.
357 (if (eq old-name 'default) 364 (if (eq old-name 'default)
358 (copy-face 'highlight-changes-face new-name) 365 (copy-face 'highlight-changes new-name)
359 (copy-face old-name new-name) 366 (copy-face old-name new-name)
360 )) 367 ))
361 (setq new-list (append (list new-name) new-list)) 368 (setq new-list (append (list new-name) new-list))
@@ -377,16 +384,16 @@ remove it from existing buffers."
377(defcustom highlight-changes-face-list nil 384(defcustom highlight-changes-face-list nil
378 "*A list of faces used when rotating changes. 385 "*A list of faces used when rotating changes.
379Normally the variable is initialized to nil and the list is created from 386Normally the variable is initialized to nil and the list is created from
380`highlight-changes-colours' when needed. However, you can set this variable 387`highlight-changes-colors' when needed. However, you can set this variable
381to any list of faces. You will have to do this if you want faces which 388to any list of faces. You will have to do this if you want faces which
382don't just differ from `highlight-changes-face' by the foreground colour. 389don't just differ from the `highlight-changes' face by the foreground color.
383Otherwise, this list will be constructed when needed from 390Otherwise, this list will be constructed when needed from
384`highlight-changes-colours'." 391`highlight-changes-colors'."
385 :type '(choice 392 :type '(choice
386 (repeat 393 (repeat
387 :notify hilit-chg-cust-fix-changes-face-list 394 :notify hilit-chg-cust-fix-changes-face-list
388 face ) 395 face )
389 (const :tag "Derive from highlight-changes-colours" nil) 396 (const :tag "Derive from highlight-changes-colors" nil)
390 ) 397 )
391 :group 'highlight-changes) 398 :group 'highlight-changes)
392 399
@@ -445,7 +452,7 @@ This is the opposite of `hilit-chg-hide-changes'."
445 (let ((ov (make-overlay start end)) 452 (let ((ov (make-overlay start end))
446 face) 453 face)
447 (if (eq prop 'hilit-chg-delete) 454 (if (eq prop 'hilit-chg-delete)
448 (setq face 'highlight-changes-delete-face) 455 (setq face 'highlight-changes-delete)
449 (setq face (nth 1 (member prop hilit-chg-list)))) 456 (setq face (nth 1 (member prop hilit-chg-list))))
450 (if face 457 (if face
451 (progn 458 (progn
@@ -727,24 +734,24 @@ Hook variables:
727 ;; so we pick up any changes? 734 ;; so we pick up any changes?
728 (if (or (null highlight-changes-face-list) ; Don't do it if it 735 (if (or (null highlight-changes-face-list) ; Don't do it if it
729 force) ; already exists unless FORCE non-nil. 736 force) ; already exists unless FORCE non-nil.
730 (let ((p highlight-changes-colours) 737 (let ((p highlight-changes-colors)
731 (n 1) name) 738 (n 1) name)
732 (setq highlight-changes-face-list nil) 739 (setq highlight-changes-face-list nil)
733 (while p 740 (while p
734 (setq name (intern (format "highlight-changes-face-%d" n))) 741 (setq name (intern (format "highlight-changes-%d" n)))
735 (copy-face 'highlight-changes-face name) 742 (copy-face 'highlight-changes name)
736 (set-face-foreground name (car p)) 743 (set-face-foreground name (car p))
737 (setq highlight-changes-face-list 744 (setq highlight-changes-face-list
738 (append highlight-changes-face-list (list name))) 745 (append highlight-changes-face-list (list name)))
739 (setq p (cdr p)) 746 (setq p (cdr p))
740 (setq n (1+ n))))) 747 (setq n (1+ n)))))
741 (setq hilit-chg-list (list 'hilit-chg 'highlight-changes-face)) 748 (setq hilit-chg-list (list 'hilit-chg 'highlight-changes))
742 (let ((p highlight-changes-face-list) 749 (let ((p highlight-changes-face-list)
743 (n 1) 750 (n 1)
744 last-category last-face) 751 last-category last-face)
745 (while p 752 (while p
746 (setq last-category (intern (format "change-%d" n))) 753 (setq last-category (intern (format "change-%d" n)))
747 ;; (setq last-face (intern (format "highlight-changes-face-%d" n))) 754 ;; (setq last-face (intern (format "highlight-changes-%d" n)))
748 (setq last-face (car p)) 755 (setq last-face (car p))
749 (setq hilit-chg-list 756 (setq hilit-chg-list
750 (append hilit-chg-list 757 (append hilit-chg-list
@@ -774,7 +781,7 @@ of `highlight-changes-face-list', one level older changes are shown in
774face described by the second element, and so on. Very old changes remain 781face described by the second element, and so on. Very old changes remain
775shown in the last face in the list. 782shown in the last face in the list.
776 783
777You can automatically rotate colours when the buffer is saved 784You can automatically rotate colors when the buffer is saved
778by adding the following to `local-write-file-hooks', by evaling it in the 785by adding the following to `local-write-file-hooks', by evaling it in the
779buffer to be saved): 786buffer to be saved):
780 787
@@ -842,7 +849,7 @@ is non-nil."
842 849
843 (setq change-a (car change-info)) 850 (setq change-a (car change-info))
844 (setq change-b (car (cdr change-info))) 851 (setq change-b (car (cdr change-info)))
845 852
846 (hilit-chg-make-list) 853 (hilit-chg-make-list)
847 (while change-a 854 (while change-a
848 (setq a-start (nth 0 (car change-a))) 855 (setq a-start (nth 0 (car change-a)))
@@ -886,11 +893,11 @@ If a buffer is read-only, differences will be highlighted but no property
886changes are made, so \\[highlight-changes-next-change] and 893changes are made, so \\[highlight-changes-next-change] and
887\\[highlight-changes-previous-change] will not work." 894\\[highlight-changes-previous-change] will not work."
888 (interactive 895 (interactive
889 (list 896 (list
890 (get-buffer (read-buffer "buffer-a " (current-buffer) t)) 897 (get-buffer (read-buffer "buffer-a " (current-buffer) t))
891 (get-buffer 898 (get-buffer
892 (read-buffer "buffer-b " 899 (read-buffer "buffer-b "
893 (window-buffer (next-window (selected-window))) t)))) 900 (window-buffer (next-window (selected-window))) t))))
894 (let ((file-a (buffer-file-name buf-a)) 901 (let ((file-a (buffer-file-name buf-a))
895 (file-b (buffer-file-name buf-b))) 902 (file-b (buffer-file-name buf-b)))
896 (highlight-markup-buffers buf-a file-a buf-b file-b) 903 (highlight-markup-buffers buf-a file-a buf-b file-b)
@@ -917,10 +924,10 @@ changes are made, so \\[highlight-changes-next-change] and
917 nil ;; default 924 nil ;; default
918 'yes ;; must exist 925 'yes ;; must exist
919 (let ((f (buffer-file-name (current-buffer)))) 926 (let ((f (buffer-file-name (current-buffer))))
920 (if f 927 (if f
921 (progn 928 (progn
922 (setq f (make-backup-file-name f)) 929 (setq f (make-backup-file-name f))
923 (or (file-exists-p f) 930 (or (file-exists-p f)
924 (setq f nil))) 931 (setq f nil)))
925 ) 932 )
926 f)))) 933 f))))
diff --git a/lisp/ido.el b/lisp/ido.el
index 24b8ba34b75..2d9313bb0ea 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -299,8 +299,8 @@
299;; ------------ 299;; ------------
300 300
301;; The highlighting of matching items is controlled via ido-use-faces. 301;; The highlighting of matching items is controlled via ido-use-faces.
302;; The faces used are ido-first-match-face, ido-only-match-face and 302;; The faces used are ido-first-match, ido-only-match and
303;; ido-subdir-face. 303;; ido-subdir.
304;; Colouring of the matching item was suggested by 304;; Colouring of the matching item was suggested by
305;; Carsten Dominik (dominik@strw.leidenuniv.nl). 305;; Carsten Dominik (dominik@strw.leidenuniv.nl).
306 306
@@ -345,7 +345,7 @@
345;;;###autoload 345;;;###autoload
346(defcustom ido-mode nil 346(defcustom ido-mode nil
347 "Determines for which functional group \(buffer and files) ido behavior 347 "Determines for which functional group \(buffer and files) ido behavior
348should be enabled. The following values are possible: 348should be enabled. The following values are possible:
349- `buffer': Turn only on ido buffer behavior \(switching, killing, 349- `buffer': Turn only on ido buffer behavior \(switching, killing,
350 displaying...) 350 displaying...)
351- `file': Turn only on ido file behavior \(finding, writing, inserting...) 351- `file': Turn only on ido file behavior \(finding, writing, inserting...)
@@ -414,7 +414,7 @@ This allows the current directory to be opened immediate with `dired'."
414 "*List of file extensions specifying preferred order of file selections. 414 "*List of file extensions specifying preferred order of file selections.
415Each element is either a string with `.' as the first char, an empty 415Each element is either a string with `.' as the first char, an empty
416string matching files without extension, or t which is the default order 416string matching files without extension, or t which is the default order
417of for files with an unlisted file extension." 417for files with an unlisted file extension."
418 :type '(repeat (choice string 418 :type '(repeat (choice string
419 (const :tag "Default order" t))) 419 (const :tag "Default order" t)))
420 :group 'ido) 420 :group 'ido)
@@ -453,9 +453,9 @@ Possible values:
453`otherframe' Show new file in another frame 453`otherframe' Show new file in another frame
454`maybe-frame' If a file is visible in another frame, prompt to ask if you 454`maybe-frame' If a file is visible in another frame, prompt to ask if you
455 you want to see the file in the same window of the current 455 you want to see the file in the same window of the current
456 frame or in the other frame. 456 frame or in the other frame
457`always-frame' If a file is visible in another frame, raise that 457`always-frame' If a file is visible in another frame, raise that
458 frame. Otherwise, visit the file in the same window." 458 frame; otherwise, visit the file in the same window"
459 :type '(choice (const samewindow) 459 :type '(choice (const samewindow)
460 (const otherwindow) 460 (const otherwindow)
461 (const display) 461 (const display)
@@ -466,7 +466,7 @@ Possible values:
466 466
467(defcustom ido-default-buffer-method 'always-frame 467(defcustom ido-default-buffer-method 'always-frame
468 "*How to switch to new buffer when using `ido-switch-buffer'. 468 "*How to switch to new buffer when using `ido-switch-buffer'.
469See ido-default-file-method for details." 469See `ido-default-file-method' for details."
470 :type '(choice (const samewindow) 470 :type '(choice (const samewindow)
471 (const otherwindow) 471 (const otherwindow)
472 (const display) 472 (const display)
@@ -530,7 +530,7 @@ Note that the non-ido equivalent command is recorded."
530(defcustom ido-max-prospects 12 530(defcustom ido-max-prospects 12
531 "*Non-zero means that the prospect list will be limited to than number of items. 531 "*Non-zero means that the prospect list will be limited to than number of items.
532For a long list of prospects, building the full list for the minibuffer can take a 532For a long list of prospects, building the full list for the minibuffer can take a
533non-negletable amount of time; setting this variable reduces that time." 533non-negligible amount of time; setting this variable reduces that time."
534 :type 'integer 534 :type 'integer
535 :group 'ido) 535 :group 'ido)
536 536
@@ -615,7 +615,7 @@ If zero, ftp directories are not cached."
615(defcustom ido-slow-ftp-hosts nil 615(defcustom ido-slow-ftp-hosts nil
616 "*List of slow ftp hosts where ido prompting should not be used. 616 "*List of slow ftp hosts where ido prompting should not be used.
617If an ftp host is on this list, ido automatically switches to the non-ido 617If an ftp host is on this list, ido automatically switches to the non-ido
618equivalent function, e.g. find-file rather than ido-find-file." 618equivalent function, e.g. `find-file' rather than `ido-find-file'."
619 :type '(repeat string) 619 :type '(repeat string)
620 :group 'ido) 620 :group 'ido)
621 621
@@ -706,7 +706,7 @@ ask user whether to create buffer, or 'never to never create new buffer."
706 :group 'ido) 706 :group 'ido)
707 707
708(defcustom ido-setup-hook nil 708(defcustom ido-setup-hook nil
709 "*Hook run after the ido variables and keymap has been setup. 709 "*Hook run after the ido variables and keymap have been setup.
710The dynamic variable `ido-cur-item' contains the current type of item that 710The dynamic variable `ido-cur-item' contains the current type of item that
711is read by ido, possible values are file, dir, buffer, and list. 711is read by ido, possible values are file, dir, buffer, and list.
712Additional keys can be defined in `ido-mode-map'." 712Additional keys can be defined in `ido-mode-map'."
@@ -727,9 +727,9 @@ There are 10 elements in this list:
7274th element is the string inserted at the end of a truncated list of prospects, 7274th element is the string inserted at the end of a truncated list of prospects,
7285th and 6th elements are used as brackets around the common match string which 7285th and 6th elements are used as brackets around the common match string which
729can be completed using TAB, 729can be completed using TAB,
7307th element is the string displayed when there are a no matches, and 7307th element is the string displayed when there are no matches, and
7318th element is displayed if there is a single match (and faces are not used). 7318th element is displayed if there is a single match (and faces are not used),
7329th element is displayed when the current directory is non-readable. 7329th element is displayed when the current directory is non-readable,
73310th element is displayed when directory exceeds `ido-max-directory-size'." 73310th element is displayed when directory exceeds `ido-max-directory-size'."
734 :type '(repeat string) 734 :type '(repeat string)
735 :group 'ido) 735 :group 'ido)
@@ -740,17 +740,17 @@ subdirs in the alternatives."
740 :type 'boolean 740 :type 'boolean
741 :group 'ido) 741 :group 'ido)
742 742
743(defface ido-first-match-face '((t (:bold t))) 743(defface ido-first-match '((t (:bold t)))
744 "*Font used by ido for highlighting first match." 744 "*Font used by ido for highlighting first match."
745 :group 'ido) 745 :group 'ido)
746 746
747(defface ido-only-match-face '((((class color)) 747(defface ido-only-match '((((class color))
748 (:foreground "ForestGreen")) 748 (:foreground "ForestGreen"))
749 (t (:italic t))) 749 (t (:italic t)))
750 "*Font used by ido for highlighting only match." 750 "*Font used by ido for highlighting only match."
751 :group 'ido) 751 :group 'ido)
752 752
753(defface ido-subdir-face '((((min-colors 88) (class color)) 753(defface ido-subdir '((((min-colors 88) (class color))
754 (:foreground "red1")) 754 (:foreground "red1"))
755 (((class color)) 755 (((class color))
756 (:foreground "red")) 756 (:foreground "red"))
@@ -758,7 +758,7 @@ subdirs in the alternatives."
758 "*Font used by ido for highlighting subdirs in the alternatives." 758 "*Font used by ido for highlighting subdirs in the alternatives."
759 :group 'ido) 759 :group 'ido)
760 760
761(defface ido-indicator-face '((((min-colors 88) (class color)) 761(defface ido-indicator '((((min-colors 88) (class color))
762 (:foreground "yellow1" 762 (:foreground "yellow1"
763 :background "red1" 763 :background "red1"
764 :width condensed)) 764 :width condensed))
@@ -864,14 +864,14 @@ Must be set before enabling ido mode."
864(defcustom ido-read-file-name-as-directory-commands '() 864(defcustom ido-read-file-name-as-directory-commands '()
865 "List of commands which uses read-file-name to read a directory name. 865 "List of commands which uses read-file-name to read a directory name.
866When `ido-everywhere' is non-nil, the commands in this list will read 866When `ido-everywhere' is non-nil, the commands in this list will read
867the directory using ido-read-directory-name." 867the directory using `ido-read-directory-name'."
868 :type '(repeat symbol) 868 :type '(repeat symbol)
869 :group 'ido) 869 :group 'ido)
870 870
871(defcustom ido-read-file-name-non-ido '() 871(defcustom ido-read-file-name-non-ido '()
872 "List of commands which shall not read file names the ido way. 872 "List of commands which shall not read file names the ido way.
873When `ido-everywhere' is non-nil, the commands in this list will read 873When `ido-everywhere' is non-nil, the commands in this list will read
874the file name using normal read-file-name style." 874the file name using normal `read-file-name' style."
875 :type '(repeat symbol) 875 :type '(repeat symbol)
876 :group 'ido) 876 :group 'ido)
877 877
@@ -895,7 +895,7 @@ See `ido-enable-last-directory-history' for details.")
895(defvar ido-work-directory-list nil 895(defvar ido-work-directory-list nil
896 "List of actual working directory names. 896 "List of actual working directory names.
897The current directory is inserted at the front of this list whenever a 897The current directory is inserted at the front of this list whenever a
898file is opened with ido-find-file and family.") 898file is opened with `ido-find-file' and family.")
899 899
900(defvar ido-work-file-list nil 900(defvar ido-work-file-list nil
901 "List of actual work file names. 901 "List of actual work file names.
@@ -909,7 +909,7 @@ Each element in the list is of the form (DIR (MTIME) FILE...).")
909 909
910(defvar ido-ignore-item-temp-list nil 910(defvar ido-ignore-item-temp-list nil
911 "List of items to ignore in current ido invocation. 911 "List of items to ignore in current ido invocation.
912Intended to be let-bound by functions which calls ido repeatedly. 912Intended to be let-bound by functions which call ido repeatedly.
913Should never be set permanently.") 913Should never be set permanently.")
914 914
915;; Temporary storage 915;; Temporary storage
@@ -949,7 +949,7 @@ If equal to `takeprompt', we use the prompt as the file name to be
949selected.") 949selected.")
950 950
951(defvar ido-current-directory nil 951(defvar ido-current-directory nil
952 "Current directory for ido-find-file.") 952 "Current directory for `ido-find-file'.")
953 953
954(defvar ido-auto-merge-timer nil 954(defvar ido-auto-merge-timer nil
955 "Delay timer for auto merge.") 955 "Delay timer for auto merge.")
@@ -1320,7 +1320,8 @@ This function also adds a hook to the minibuffer."
1320 1320
1321 (add-hook 'kill-emacs-hook 'ido-kill-emacs-hook) 1321 (add-hook 'kill-emacs-hook 'ido-kill-emacs-hook)
1322 1322
1323 (unless ido-minor-mode-map-entry 1323 (if ido-minor-mode-map-entry
1324 (setcdr ido-minor-mode-map-entry (make-sparse-keymap))
1324 (setq ido-minor-mode-map-entry (cons 'ido-mode (make-sparse-keymap))) 1325 (setq ido-minor-mode-map-entry (cons 'ido-mode (make-sparse-keymap)))
1325 (add-to-list 'minor-mode-map-alist ido-minor-mode-map-entry)) 1326 (add-to-list 'minor-mode-map-alist ido-minor-mode-map-entry))
1326 1327
@@ -1646,6 +1647,7 @@ If INITIAL is non-nil, it specifies the initial input string."
1646 (l (ido-make-merged-file-list ido-text-init 1647 (l (ido-make-merged-file-list ido-text-init
1647 (eq ido-use-merged-list 'auto) 1648 (eq ido-use-merged-list 'auto)
1648 (eq ido-try-merged-list 'wide)))) 1649 (eq ido-try-merged-list 'wide))))
1650 (ido-trace "merged" l)
1649 (cond 1651 (cond
1650 ((not l) 1652 ((not l)
1651 (if (eq ido-try-merged-list 'wide) 1653 (if (eq ido-try-merged-list 'wide)
@@ -1665,6 +1667,9 @@ If INITIAL is non-nil, it specifies the initial input string."
1665 ido-use-merged-list nil))) 1667 ido-use-merged-list nil)))
1666 ((eq l t) 1668 ((eq l t)
1667 (setq ido-use-merged-list nil)) 1669 (setq ido-use-merged-list nil))
1670 ((eq l 'input-pending-p)
1671 (setq ido-try-merged-list t
1672 ido-use-merged-list nil))
1668 (t 1673 (t
1669 (setq ido-pre-merge-state 1674 (setq ido-pre-merge-state
1670 (list ido-text-init ido-current-directory olist oign omat)) 1675 (list ido-text-init ido-current-directory olist oign omat))
@@ -2267,7 +2272,7 @@ If no merge has yet taken place, toggle automatic merging option."
2267 2272
2268(defun ido-magic-forward-char () 2273(defun ido-magic-forward-char ()
2269 "Move forward in user input or perform magic action. 2274 "Move forward in user input or perform magic action.
2270If no user input is present or at end of input, perform magic actions: 2275If no user input is present, or at end of input, perform magic actions:
2271C-x C-b ... C-f switch to ido-find-file. 2276C-x C-b ... C-f switch to ido-find-file.
2272C-x C-f ... C-f fallback to non-ido find-file. 2277C-x C-f ... C-f fallback to non-ido find-file.
2273C-x C-d ... C-f fallback to non-ido brief dired. 2278C-x C-d ... C-f fallback to non-ido brief dired.
@@ -2410,13 +2415,13 @@ If no buffer or file exactly matching the prompt exists, maybe create a new one.
2410 (exit-minibuffer)) 2415 (exit-minibuffer))
2411 2416
2412(defun ido-enter-find-file () 2417(defun ido-enter-find-file ()
2413 "Drop into find-file from buffer switching." 2418 "Drop into `find-file' from buffer switching."
2414 (interactive) 2419 (interactive)
2415 (setq ido-exit 'find-file) 2420 (setq ido-exit 'find-file)
2416 (exit-minibuffer)) 2421 (exit-minibuffer))
2417 2422
2418(defun ido-enter-switch-buffer () 2423(defun ido-enter-switch-buffer ()
2419 "Drop into ido-switch-buffer from file switching." 2424 "Drop into `ido-switch-buffer' from file switching."
2420 (interactive) 2425 (interactive)
2421 (setq ido-exit 'switch-to-buffer) 2426 (setq ido-exit 'switch-to-buffer)
2422 (exit-minibuffer)) 2427 (exit-minibuffer))
@@ -2493,10 +2498,10 @@ If no buffer or file exactly matching the prompt exists, maybe create a new one.
2493 (file-directory-p dir) 2498 (file-directory-p dir)
2494 (or (not must-match) 2499 (or (not must-match)
2495 ;; TODO. check for nonreadable and too-big. 2500 ;; TODO. check for nonreadable and too-big.
2496 (ido-set-matches1 2501 (ido-set-matches-1
2497 (if (eq ido-cur-item 'file) 2502 (if (eq ido-cur-item 'file)
2498 (ido-make-file-list1 dir) 2503 (ido-make-file-list-1 dir)
2499 (ido-make-dir-list1 dir))))) 2504 (ido-make-dir-list-1 dir)))))
2500 (setq j n) 2505 (setq j n)
2501 (setq dir nil))) 2506 (setq dir nil)))
2502 (if dir 2507 (if dir
@@ -2786,11 +2791,11 @@ for first matching file."
2786 (ido-directory-too-big nil)) 2791 (ido-directory-too-big nil))
2787 (cond 2792 (cond
2788 ((eq ido-cur-item 'file) 2793 ((eq ido-cur-item 'file)
2789 (ido-make-file-list1 ido-current-directory)) 2794 (ido-make-file-list-1 ido-current-directory))
2790 ((eq ido-cur-item 'dir) 2795 ((eq ido-cur-item 'dir)
2791 (ido-make-dir-list1 ido-current-directory)) 2796 (ido-make-dir-list-1 ido-current-directory))
2792 ((eq ido-cur-item 'buffer) 2797 ((eq ido-cur-item 'buffer)
2793 (ido-make-buffer-list1)) 2798 (ido-make-buffer-list-1))
2794 ((eq ido-cur-item 'list) 2799 ((eq ido-cur-item 'list)
2795 ido-choice-list) 2800 ido-choice-list)
2796 (t nil)))) 2801 (t nil))))
@@ -2908,74 +2913,87 @@ for first matching file."
2908 (setq items (cdr items))) 2913 (setq items (cdr items)))
2909 res)) 2914 res))
2910 2915
2911(defun ido-make-merged-file-list (text auto wide) 2916
2917(defun ido-make-merged-file-list-1 (text auto wide)
2912 (let (res) 2918 (let (res)
2913 (message "Searching for `%s'...." text) 2919 (if (and (ido-final-slash text) ido-dir-file-cache)
2914 (condition-case nil 2920 (if wide
2915 (if (and (ido-final-slash text) ido-dir-file-cache) 2921 (setq res (ido-wide-find-dirs-or-files
2916 (if wide 2922 ido-current-directory (substring text 0 -1) ido-enable-prefix t))
2917 (setq res (ido-wide-find-dirs-or-files 2923 ;; Use list of cached directories
2918 ido-current-directory (substring text 0 -1) ido-enable-prefix t)) 2924 (let ((re (concat (regexp-quote (substring text 0 -1)) "[^/:]*/\\'"))
2919 ;; Use list of cached directories 2925 (dirs ido-dir-file-cache)
2920 (let ((re (concat (regexp-quote (substring text 0 -1)) "[^/:]*/\\'")) 2926 dir b d f)
2921 (dirs ido-dir-file-cache) 2927 (if nil ;; simple
2922 dir b d f) 2928 (while dirs
2923 (if nil ;; simple 2929 (setq dir (car (car dirs))
2924 (while dirs 2930 dirs (cdr dirs))
2925 (setq dir (car (car dirs)) 2931 (when (and (string-match re dir)
2926 dirs (cdr dirs)) 2932 (not (ido-ignore-item-p dir ido-ignore-directories-merge))
2927 (when (and (string-match re dir) 2933 (file-directory-p dir))
2928 (not (ido-ignore-item-p dir ido-ignore-directories-merge)) 2934 (setq b (substring dir 0 -1)
2929 (file-directory-p dir)) 2935 f (concat (file-name-nondirectory b) "/")
2930 (setq b (substring dir 0 -1) 2936 d (file-name-directory b)
2931 f (concat (file-name-nondirectory b) "/") 2937 res (cons (cons f d) res))))
2932 d (file-name-directory b)
2933 res (cons (cons f d) res))))
2934 (while dirs
2935 (setq dir (car dirs)
2936 d (car dir)
2937 dirs (cdr dirs))
2938 (when (not (ido-ignore-item-p d ido-ignore-directories-merge))
2939 (setq dir (cdr (cdr dir)))
2940 (while dir
2941 (setq f (car dir)
2942 dir (cdr dir))
2943 (if (and (string-match re f)
2944 (not (ido-ignore-item-p f ido-ignore-directories)))
2945 (setq res (cons (cons f d) res)))))
2946 (if (and auto (input-pending-p))
2947 (setq dirs nil
2948 res t))))))
2949 (if wide
2950 (setq res (ido-wide-find-dirs-or-files
2951 ido-current-directory text ido-enable-prefix nil))
2952 (let ((ido-text text)
2953 (dirs ido-work-directory-list)
2954 (must-match (and text (> (length text) 0)))
2955 dir fl)
2956 (if (and auto (not (member ido-current-directory dirs)))
2957 (setq dirs (cons ido-current-directory dirs)))
2958 (while dirs 2938 (while dirs
2959 (setq dir (car dirs) 2939 (setq dir (car dirs)
2940 d (car dir)
2960 dirs (cdr dirs)) 2941 dirs (cdr dirs))
2961 (when (and dir (stringp dir) 2942 (when (not (ido-ignore-item-p d ido-ignore-directories-merge))
2962 (or ido-merge-ftp-work-directories 2943 (setq dir (cdr (cdr dir)))
2963 (not (ido-is-ftp-directory dir))) 2944 (while dir
2964 (file-directory-p dir) 2945 (setq f (car dir)
2965 ;; TODO. check for nonreadable and too-big. 2946 dir (cdr dir))
2966 (setq fl (if (eq ido-cur-item 'file) 2947 (if (and (string-match re f)
2967 (ido-make-file-list1 dir t) 2948 (not (ido-ignore-item-p f ido-ignore-directories)))
2968 (ido-make-dir-list1 dir t)))) 2949 (setq res (cons (cons f d) res)))))
2969 (if must-match
2970 (setq fl (ido-set-matches1 fl)))
2971 (if fl
2972 (setq res (nconc fl res))))
2973 (if (and auto (input-pending-p)) 2950 (if (and auto (input-pending-p))
2974 (setq dirs nil 2951 (setq dirs nil
2975 res t)))))) 2952 res t))))))
2976 (quit (setq res t))) 2953 (if wide
2977 (if (and res (not (eq res t))) 2954 (setq res (ido-wide-find-dirs-or-files
2978 (setq res (ido-sort-merged-list res auto))) 2955 ido-current-directory text ido-enable-prefix nil))
2956 (let ((ido-text text)
2957 (dirs ido-work-directory-list)
2958 (must-match (and text (> (length text) 0)))
2959 dir fl)
2960 (if (and auto (not (member ido-current-directory dirs)))
2961 (setq dirs (cons ido-current-directory dirs)))
2962 (while dirs
2963 (setq dir (car dirs)
2964 dirs (cdr dirs))
2965 (when (and dir (stringp dir)
2966 (or ido-merge-ftp-work-directories
2967 (not (ido-is-ftp-directory dir)))
2968 (file-directory-p dir)
2969 ;; TODO. check for nonreadable and too-big.
2970 (setq fl (if (eq ido-cur-item 'file)
2971 (ido-make-file-list-1 dir t)
2972 (ido-make-dir-list-1 dir t))))
2973 (if must-match
2974 (setq fl (ido-set-matches-1 fl)))
2975 (if fl
2976 (setq res (nconc fl res))))
2977 (if (and auto (input-pending-p))
2978 (setq dirs nil
2979 res t))))))
2980 res))
2981
2982(defun ido-make-merged-file-list (text auto wide)
2983 (let (res)
2984 (message "Searching for `%s'...." text)
2985 (condition-case nil
2986 (unless (catch 'input-pending-p
2987 (let ((throw-on-input 'input-pending-p))
2988 (setq res (ido-make-merged-file-list-1 text auto wide))
2989 t))
2990 (setq res 'input-pending-p))
2991 (quit
2992 (setq res t
2993 ido-try-merged-list nil
2994 ido-use-merged-list nil)))
2995 (when (and res (listp res))
2996 (setq res (ido-sort-merged-list res auto)))
2979 (when (and (or ido-rotate-temp ido-rotate-file-list-default) 2997 (when (and (or ido-rotate-temp ido-rotate-file-list-default)
2980 (listp res) 2998 (listp res)
2981 (> (length text) 0)) 2999 (> (length text) 0))
@@ -2986,7 +3004,7 @@ for first matching file."
2986 (message nil) 3004 (message nil)
2987 res)) 3005 res))
2988 3006
2989(defun ido-make-buffer-list1 (&optional frame visible) 3007(defun ido-make-buffer-list-1 (&optional frame visible)
2990 ;; Return list of non-ignored buffer names 3008 ;; Return list of non-ignored buffer names
2991 (delq nil 3009 (delq nil
2992 (mapcar 3010 (mapcar
@@ -2999,12 +3017,12 @@ for first matching file."
2999(defun ido-make-buffer-list (default) 3017(defun ido-make-buffer-list (default)
3000 ;; Return the current list of buffers. 3018 ;; Return the current list of buffers.
3001 ;; Currently visible buffers are put at the end of the list. 3019 ;; Currently visible buffers are put at the end of the list.
3002 ;; The hook `ido-make-buflist-hook' is run after the list has been 3020 ;; The hook `ido-make-buffer-list-hook' is run after the list has been
3003 ;; created to allow the user to further modify the order of the buffer names 3021 ;; created to allow the user to further modify the order of the buffer names
3004 ;; in this list. If DEFAULT is non-nil, and corresponds to an existing buffer, 3022 ;; in this list. If DEFAULT is non-nil, and corresponds to an existing buffer,
3005 ;; it is put to the start of the list. 3023 ;; it is put to the start of the list.
3006 (let* ((ido-current-buffers (ido-get-buffers-in-frames 'current)) 3024 (let* ((ido-current-buffers (ido-get-buffers-in-frames 'current))
3007 (ido-temp-list (ido-make-buffer-list1 (selected-frame) ido-current-buffers))) 3025 (ido-temp-list (ido-make-buffer-list-1 (selected-frame) ido-current-buffers)))
3008 (if ido-temp-list 3026 (if ido-temp-list
3009 (nconc ido-temp-list ido-current-buffers) 3027 (nconc ido-temp-list ido-current-buffers)
3010 (setq ido-temp-list ido-current-buffers)) 3028 (setq ido-temp-list ido-current-buffers))
@@ -3041,7 +3059,7 @@ for first matching file."
3041 (nconc ido-temp-list items) 3059 (nconc ido-temp-list items)
3042 (setq ido-temp-list items))) 3060 (setq ido-temp-list items)))
3043 3061
3044(defun ido-file-name-all-completions1 (dir) 3062(defun ido-file-name-all-completions-1 (dir)
3045 (cond 3063 (cond
3046 ((ido-nonreadable-directory-p dir) '()) 3064 ((ido-nonreadable-directory-p dir) '())
3047 ;; do not check (ido-directory-too-big-p dir) here. 3065 ;; do not check (ido-directory-too-big-p dir) here.
@@ -3098,13 +3116,13 @@ for first matching file."
3098 (if (and ftp (file-readable-p dir)) 3116 (if (and ftp (file-readable-p dir))
3099 (setq mtime (cons 'ftp (ido-time-stamp)))) 3117 (setq mtime (cons 'ftp (ido-time-stamp))))
3100 (if mtime 3118 (if mtime
3101 (setq cached (cons dir (cons mtime (ido-file-name-all-completions1 dir))) 3119 (setq cached (cons dir (cons mtime (ido-file-name-all-completions-1 dir)))
3102 ido-dir-file-cache (cons cached ido-dir-file-cache))) 3120 ido-dir-file-cache (cons cached ido-dir-file-cache)))
3103 (if (> (length ido-dir-file-cache) ido-max-dir-file-cache) 3121 (if (> (length ido-dir-file-cache) ido-max-dir-file-cache)
3104 (setcdr (nthcdr (1- ido-max-dir-file-cache) ido-dir-file-cache) nil))) 3122 (setcdr (nthcdr (1- ido-max-dir-file-cache) ido-dir-file-cache) nil)))
3105 (and cached 3123 (and cached
3106 (cdr (cdr cached)))) 3124 (cdr (cdr cached))))
3107 (ido-file-name-all-completions1 dir))) 3125 (ido-file-name-all-completions-1 dir)))
3108 3126
3109(defun ido-remove-cached-dir (dir) 3127(defun ido-remove-cached-dir (dir)
3110 ;; Remove dir from ido-dir-file-cache 3128 ;; Remove dir from ido-dir-file-cache
@@ -3115,7 +3133,7 @@ for first matching file."
3115 (setq ido-dir-file-cache (delq cached ido-dir-file-cache)))))) 3133 (setq ido-dir-file-cache (delq cached ido-dir-file-cache))))))
3116 3134
3117 3135
3118(defun ido-make-file-list1 (dir &optional merged) 3136(defun ido-make-file-list-1 (dir &optional merged)
3119 ;; Return list of non-ignored files in DIR 3137 ;; Return list of non-ignored files in DIR
3120 ;; If MERGED is non-nil, each file is cons'ed with DIR 3138 ;; If MERGED is non-nil, each file is cons'ed with DIR
3121 (and (or (ido-is-tramp-root dir) (file-directory-p dir)) 3139 (and (or (ido-is-tramp-root dir) (file-directory-p dir))
@@ -3132,7 +3150,7 @@ for first matching file."
3132 ;; The hook `ido-make-file-list-hook' is run after the list has been 3150 ;; The hook `ido-make-file-list-hook' is run after the list has been
3133 ;; created to allow the user to further modify the order of the file names 3151 ;; created to allow the user to further modify the order of the file names
3134 ;; in this list. 3152 ;; in this list.
3135 (let ((ido-temp-list (ido-make-file-list1 ido-current-directory))) 3153 (let ((ido-temp-list (ido-make-file-list-1 ido-current-directory)))
3136 (setq ido-temp-list (sort ido-temp-list 3154 (setq ido-temp-list (sort ido-temp-list
3137 (if ido-file-extensions-order 3155 (if ido-file-extensions-order
3138 #'ido-file-extension-lessp 3156 #'ido-file-extension-lessp
@@ -3168,7 +3186,7 @@ for first matching file."
3168 (run-hooks 'ido-make-file-list-hook) 3186 (run-hooks 'ido-make-file-list-hook)
3169 ido-temp-list)) 3187 ido-temp-list))
3170 3188
3171(defun ido-make-dir-list1 (dir &optional merged) 3189(defun ido-make-dir-list-1 (dir &optional merged)
3172 ;; Return list of non-ignored subdirs in DIR 3190 ;; Return list of non-ignored subdirs in DIR
3173 ;; If MERGED is non-nil, each subdir is cons'ed with DIR 3191 ;; If MERGED is non-nil, each subdir is cons'ed with DIR
3174 (and (or (ido-is-tramp-root dir) (file-directory-p dir)) 3192 (and (or (ido-is-tramp-root dir) (file-directory-p dir))
@@ -3184,7 +3202,7 @@ for first matching file."
3184 ;; The hook `ido-make-dir-list-hook' is run after the list has been 3202 ;; The hook `ido-make-dir-list-hook' is run after the list has been
3185 ;; created to allow the user to further modify the order of the 3203 ;; created to allow the user to further modify the order of the
3186 ;; directory names in this list. 3204 ;; directory names in this list.
3187 (let ((ido-temp-list (ido-make-dir-list1 ido-current-directory))) 3205 (let ((ido-temp-list (ido-make-dir-list-1 ido-current-directory)))
3188 (setq ido-temp-list (sort ido-temp-list #'ido-file-lessp)) 3206 (setq ido-temp-list (sort ido-temp-list #'ido-file-lessp))
3189 (ido-to-end ;; move . files to end 3207 (ido-to-end ;; move . files to end
3190 (delq nil (mapcar 3208 (delq nil (mapcar
@@ -3238,7 +3256,7 @@ for first matching file."
3238 3256
3239;;; FIND MATCHING ITEMS 3257;;; FIND MATCHING ITEMS
3240 3258
3241(defun ido-set-matches1 (items &optional do-full) 3259(defun ido-set-matches-1 (items &optional do-full)
3242 ;; Return list of matches in items 3260 ;; Return list of matches in items
3243 (let* ((case-fold-search ido-case-fold) 3261 (let* ((case-fold-search ido-case-fold)
3244 (slash (and (not ido-enable-prefix) (ido-final-slash ido-text))) 3262 (slash (and (not ido-enable-prefix) (ido-final-slash ido-text)))
@@ -3296,7 +3314,7 @@ for first matching file."
3296(defun ido-set-matches () 3314(defun ido-set-matches ()
3297 ;; Set `ido-matches' to the list of items matching prompt 3315 ;; Set `ido-matches' to the list of items matching prompt
3298 (when ido-rescan 3316 (when ido-rescan
3299 (setq ido-matches (ido-set-matches1 (reverse ido-cur-list) (not ido-rotate)) 3317 (setq ido-matches (ido-set-matches-1 (reverse ido-cur-list) (not ido-rotate))
3300 ido-rotate nil))) 3318 ido-rotate nil)))
3301 3319
3302(defun ido-ignore-item-p (name re-list &optional ignore-ext) 3320(defun ido-ignore-item-p (name re-list &optional ignore-ext)
@@ -3479,7 +3497,7 @@ for first matching file."
3479;;; VISIT CHOSEN BUFFER 3497;;; VISIT CHOSEN BUFFER
3480(defun ido-visit-buffer (buffer method &optional record) 3498(defun ido-visit-buffer (buffer method &optional record)
3481 "Visit file named FILE according to METHOD. 3499 "Visit file named FILE according to METHOD.
3482Record command in command-history if optional RECORD is non-nil." 3500Record command in `command-history' if optional RECORD is non-nil."
3483 3501
3484 (let (win newframe) 3502 (let (win newframe)
3485 (cond 3503 (cond
@@ -3552,9 +3570,9 @@ in another frame.
3552 3570
3553As you type in a string, all of the buffers matching the string are 3571As you type in a string, all of the buffers matching the string are
3554displayed if substring-matching is used \(default). Look at 3572displayed if substring-matching is used \(default). Look at
3555`ido-enable-prefix' and `ido-toggle-prefix'. When you have found the 3573`ido-enable-prefix' and `ido-toggle-prefix'. When you have found the
3556buffer you want, it can then be selected. As you type, most keys have their 3574buffer you want, it can then be selected. As you type, most keys have
3557normal keybindings, except for the following: \\<ido-mode-map> 3575their normal keybindings, except for the following: \\<ido-mode-map>
3558 3576
3559RET Select the buffer at the front of the list of matches. If the 3577RET Select the buffer at the front of the list of matches. If the
3560list is empty, possibly prompt to create new buffer. 3578list is empty, possibly prompt to create new buffer.
@@ -3637,11 +3655,11 @@ The file is displayed according to `ido-default-file-method' -- the
3637default is to show it in the same window, unless it is already 3655default is to show it in the same window, unless it is already
3638visible in another frame. 3656visible in another frame.
3639 3657
3640The file name is selected interactively by typing a substring. As you type 3658The file name is selected interactively by typing a substring. As you
3641in a string, all of the filenames matching the string are displayed if 3659type in a string, all of the filenames matching the string are displayed
3642substring-matching is used \(default). Look at `ido-enable-prefix' and 3660if substring-matching is used \(default). Look at `ido-enable-prefix' and
3643`ido-toggle-prefix'. When you have found the filename you want, it can 3661`ido-toggle-prefix'. When you have found the filename you want, it can
3644then be selected. As you type, most keys have their normal keybindings, 3662then be selected. As you type, most keys have their normal keybindings,
3645except for the following: \\<ido-mode-map> 3663except for the following: \\<ido-mode-map>
3646 3664
3647RET Select the file at the front of the list of matches. If the 3665RET Select the file at the front of the list of matches. If the
@@ -4022,7 +4040,7 @@ For details of keybindings, do `\\[describe-function] ido-find-file'."
4022 first) 4040 first)
4023 4041
4024 (if (and ind ido-use-faces) 4042 (if (and ind ido-use-faces)
4025 (put-text-property 0 1 'face 'ido-indicator-face ind)) 4043 (put-text-property 0 1 'face 'ido-indicator ind))
4026 4044
4027 (if (and ido-use-faces comps) 4045 (if (and ido-use-faces comps)
4028 (let* ((fn (ido-name (car comps))) 4046 (let* ((fn (ido-name (car comps)))
@@ -4030,8 +4048,8 @@ For details of keybindings, do `\\[describe-function] ido-find-file'."
4030 (setq first (format "%s" fn)) 4048 (setq first (format "%s" fn))
4031 (put-text-property 0 ln 'face 4049 (put-text-property 0 ln 'face
4032 (if (= (length comps) 1) 4050 (if (= (length comps) 1)
4033 'ido-only-match-face 4051 'ido-only-match
4034 'ido-first-match-face) 4052 'ido-first-match)
4035 first) 4053 first)
4036 (if ind (setq first (concat first ind))) 4054 (if ind (setq first (concat first ind)))
4037 (setq comps (cons first (cdr comps))))) 4055 (setq comps (cons first (cdr comps)))))
@@ -4074,7 +4092,7 @@ For details of keybindings, do `\\[describe-function] ido-find-file'."
4074 (if (and ido-use-faces 4092 (if (and ido-use-faces
4075 (not (string= str first)) 4093 (not (string= str first))
4076 (ido-final-slash str)) 4094 (ido-final-slash str))
4077 (put-text-property 0 (length str) 'face 'ido-subdir-face str)) 4095 (put-text-property 0 (length str) 'face 'ido-subdir str))
4078 str))))) 4096 str)))))
4079 comps)))))) 4097 comps))))))
4080 4098
@@ -4154,7 +4172,7 @@ For details of keybindings, do `\\[describe-function] ido-find-file'."
4154Return the name of a buffer selected. 4172Return the name of a buffer selected.
4155PROMPT is the prompt to give to the user. DEFAULT if given is the default 4173PROMPT is the prompt to give to the user. DEFAULT if given is the default
4156buffer to be selected, which will go to the front of the list. 4174buffer to be selected, which will go to the front of the list.
4157If REQUIRE-MATCH is non-nil, an existing-buffer must be selected." 4175If REQUIRE-MATCH is non-nil, an existing buffer must be selected."
4158 (let* ((ido-current-directory nil) 4176 (let* ((ido-current-directory nil)
4159 (ido-directory-nonreadable nil) 4177 (ido-directory-nonreadable nil)
4160 (ido-directory-too-big nil) 4178 (ido-directory-too-big nil)
@@ -4176,7 +4194,9 @@ See `read-file-name' for additional parameters."
4176 (eq (get this-command 'ido) 'dir) 4194 (eq (get this-command 'ido) 'dir)
4177 (memq this-command ido-read-file-name-as-directory-commands)) 4195 (memq this-command ido-read-file-name-as-directory-commands))
4178 (setq filename 4196 (setq filename
4179 (ido-read-directory-name prompt dir default-filename mustmatch initial))) 4197 (ido-read-directory-name prompt dir default-filename mustmatch initial))
4198 (if (eq ido-exit 'fallback)
4199 (setq filename 'fallback)))
4180 ((and (not (eq (get this-command 'ido) 'ignore)) 4200 ((and (not (eq (get this-command 'ido) 'ignore))
4181 (not (memq this-command ido-read-file-name-non-ido)) 4201 (not (memq this-command ido-read-file-name-non-ido))
4182 (or (null predicate) (eq predicate 'file-exists-p))) 4202 (or (null predicate) (eq predicate 'file-exists-p)))
diff --git a/lisp/ielm.el b/lisp/ielm.el
index 5a91361f2d2..727face3695 100644
--- a/lisp/ielm.el
+++ b/lisp/ielm.el
@@ -102,7 +102,7 @@ prevent a running IELM process from being messed up when the user
102customizes `ielm-prompt'.") 102customizes `ielm-prompt'.")
103 103
104(defcustom ielm-dynamic-return t 104(defcustom ielm-dynamic-return t
105 "*Controls whether \\<ielm-map>\\[ielm-return] has intelligent behaviour in IELM. 105 "*Controls whether \\<ielm-map>\\[ielm-return] has intelligent behavior in IELM.
106If non-nil, \\[ielm-return] evaluates input for complete sexps, or inserts a newline 106If non-nil, \\[ielm-return] evaluates input for complete sexps, or inserts a newline
107and indents for incomplete sexps. If nil, always inserts newlines." 107and indents for incomplete sexps. If nil, always inserts newlines."
108 :type 'boolean 108 :type 'boolean
@@ -468,7 +468,7 @@ buffer, then the values in the working buffer are used. The variables
468Expressions evaluated by IELM are not subject to `debug-on-quit' or 468Expressions evaluated by IELM are not subject to `debug-on-quit' or
469`debug-on-error'. 469`debug-on-error'.
470 470
471The behaviour of IELM may be customized with the following variables: 471The behavior of IELM may be customized with the following variables:
472* To stop beeping on error, set `ielm-noisy' to nil. 472* To stop beeping on error, set `ielm-noisy' to nil.
473* If you don't like the prompt, you can change it by setting `ielm-prompt'. 473* If you don't like the prompt, you can change it by setting `ielm-prompt'.
474* If you do not like that the prompt is (by default) read-only, set 474* If you do not like that the prompt is (by default) read-only, set
diff --git a/lisp/info.el b/lisp/info.el
index c36554e6a7a..b34fd013df3 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -1379,6 +1379,43 @@ If FORK is a string, it is the name to use for the new buffer."
1379 1379
1380(defvar Info-read-node-completion-table) 1380(defvar Info-read-node-completion-table)
1381 1381
1382(defun Info-read-node-name-2 (string path-and-suffixes action)
1383 "Virtual completion table for file names input in Info node names.
1384PATH-AND-SUFFIXES is a pair of lists, (DIRECTORIES . SUFFIXES)."
1385 (let* ((names nil)
1386 (suffixes (remove "" (cdr path-and-suffixes)))
1387 (suffix (concat (regexp-opt suffixes t) "\\'"))
1388 (string-dir (file-name-directory string))
1389 (dirs
1390 (if (file-name-absolute-p string)
1391 (list (file-name-directory string))
1392 (car path-and-suffixes))))
1393 (dolist (dir dirs)
1394 (unless dir
1395 (setq dir default-directory))
1396 (if string-dir (setq dir (expand-file-name string-dir dir)))
1397 (when (file-directory-p dir)
1398 (dolist (file (file-name-all-completions
1399 (file-name-nondirectory string) dir))
1400 ;; If the file name has no suffix or a standard suffix,
1401 ;; include it.
1402 (and (or (null (file-name-extension file))
1403 (string-match suffix file))
1404 ;; But exclude subfiles of split info files.
1405 (not (string-match "-[0-9]+\\'" file))
1406 ;; And exclude backup files.
1407 (not (string-match "~\\'" file))
1408 (push (if string-dir (concat string-dir file) file) names))
1409 ;; If the file name ends in a standard suffix,
1410 ;; add the unsuffixed name as a completion option.
1411 (when (string-match suffix file)
1412 (setq file (substring file 0 (match-beginning 0)))
1413 (push (if string-dir (concat string-dir file) file) names)))))
1414 (cond
1415 ((eq action t) (all-completions string names))
1416 ((null action) (try-completion string names))
1417 (t (test-completion string names)))))
1418
1382;; This function is used as the "completion table" while reading a node name. 1419;; This function is used as the "completion table" while reading a node name.
1383;; It does completion using the alist in Info-read-node-completion-table 1420;; It does completion using the alist in Info-read-node-completion-table
1384;; unless STRING starts with an open-paren. 1421;; unless STRING starts with an open-paren.
@@ -1389,15 +1426,16 @@ If FORK is a string, it is the name to use for the new buffer."
1389 (let ((file (substring string 1))) 1426 (let ((file (substring string 1)))
1390 (cond 1427 (cond
1391 ((eq code nil) 1428 ((eq code nil)
1392 (let ((comp (try-completion file 'locate-file-completion 1429 (let ((comp (try-completion file 'Info-read-node-name-2
1393 (cons Info-directory-list 1430 (cons Info-directory-list
1394 (mapcar 'car Info-suffix-list))))) 1431 (mapcar 'car Info-suffix-list)))))
1395 (cond 1432 (cond
1396 ((eq comp t) (concat string ")")) 1433 ((eq comp t) (concat string ")"))
1397 (comp (concat "(" comp))))) 1434 (comp (concat "(" comp)))))
1398 ((eq code t) (all-completions file 'locate-file-completion 1435 ((eq code t)
1399 (cons Info-directory-list 1436 (all-completions file 'Info-read-node-name-2
1400 (mapcar 'car Info-suffix-list)))) 1437 (cons Info-directory-list
1438 (mapcar 'car Info-suffix-list))))
1401 (t nil)))) 1439 (t nil))))
1402 ;; If a file name was given, then any node is fair game. 1440 ;; If a file name was given, then any node is fair game.
1403 ((string-match "\\`(" string) 1441 ((string-match "\\`(" string)
@@ -1413,6 +1451,10 @@ If FORK is a string, it is the name to use for the new buffer."
1413 (t 1451 (t
1414 (test-completion string Info-read-node-completion-table predicate)))) 1452 (test-completion string Info-read-node-completion-table predicate))))
1415 1453
1454;; Arrange to highlight the proper letters in the completion list buffer.
1455(put 'Info-read-node-name-1 'completion-base-size-function
1456 (lambda () 1))
1457
1416(defun Info-read-node-name (prompt &optional default) 1458(defun Info-read-node-name (prompt &optional default)
1417 (let* ((completion-ignore-case t) 1459 (let* ((completion-ignore-case t)
1418 (Info-read-node-completion-table (Info-build-node-completions)) 1460 (Info-read-node-completion-table (Info-build-node-completions))
@@ -3482,29 +3524,37 @@ the variable `Info-file-list-for-emacs'."
3482 (t 3524 (t
3483 (Info-goto-emacs-command-node command))))) 3525 (Info-goto-emacs-command-node command)))))
3484 3526
3485(defface Info-title-1-face 3527(defface info-title-1
3486 '((((type tty pc) (class color)) :foreground "yellow" :weight bold) 3528 '((((type tty pc) (class color)) :foreground "green" :weight bold)
3487 (t :height 1.2 :inherit Info-title-2-face)) 3529 (t :height 1.2 :inherit info-title-2))
3488 "Face for Info titles at level 1." 3530 "Face for info titles at level 1."
3489 :group 'info) 3531 :group 'info)
3532;; backward-compatibility alias
3533(put 'Info-title-1-face 'face-alias 'info-title-1)
3490 3534
3491(defface Info-title-2-face 3535(defface info-title-2
3492 '((((type tty pc) (class color)) :foreground "lightblue" :weight bold) 3536 '((((type tty pc) (class color)) :foreground "lightblue" :weight bold)
3493 (t :height 1.2 :inherit Info-title-3-face)) 3537 (t :height 1.2 :inherit info-title-3))
3494 "Face for Info titles at level 2." 3538 "Face for info titles at level 2."
3495 :group 'info) 3539 :group 'info)
3540;; backward-compatibility alias
3541(put 'Info-title-2-face 'face-alias 'info-title-2)
3496 3542
3497(defface Info-title-3-face 3543(defface info-title-3
3498 '((((type tty pc) (class color)) :weight bold) 3544 '((((type tty pc) (class color)) :weight bold)
3499 (t :height 1.2 :inherit Info-title-4-face)) 3545 (t :height 1.2 :inherit info-title-4))
3500 "Face for Info titles at level 3." 3546 "Face for info titles at level 3."
3501 :group 'info) 3547 :group 'info)
3548;; backward-compatibility alias
3549(put 'Info-title-3-face 'face-alias 'info-title-3)
3502 3550
3503(defface Info-title-4-face 3551(defface info-title-4
3504 '((((type tty pc) (class color)) :weight bold) 3552 '((((type tty pc) (class color)) :weight bold)
3505 (t :weight bold :inherit variable-pitch)) 3553 (t :weight bold :inherit variable-pitch))
3506 "Face for Info titles at level 4." 3554 "Face for info titles at level 4."
3507 :group 'info) 3555 :group 'info)
3556;; backward-compatibility alias
3557(put 'Info-title-4-face 'face-alias 'info-title-4)
3508 3558
3509(defface info-menu-header 3559(defface info-menu-header
3510 '((((type tty pc)) 3560 '((((type tty pc))
@@ -3644,10 +3694,10 @@ Preserve text properties."
3644 nil t) 3694 nil t)
3645 (let* ((c (preceding-char)) 3695 (let* ((c (preceding-char))
3646 (face 3696 (face
3647 (cond ((= c ?*) 'Info-title-1-face) 3697 (cond ((= c ?*) 'info-title-1)
3648 ((= c ?=) 'Info-title-2-face) 3698 ((= c ?=) 'info-title-2)
3649 ((= c ?-) 'Info-title-3-face) 3699 ((= c ?-) 'info-title-3)
3650 (t 'Info-title-4-face)))) 3700 (t 'info-title-4))))
3651 (put-text-property (match-beginning 1) (match-end 1) 3701 (put-text-property (match-beginning 1) (match-end 1)
3652 'font-lock-face face)) 3702 'font-lock-face face))
3653 ;; This is a serious problem for trying to handle multiple 3703 ;; This is a serious problem for trying to handle multiple
diff --git a/lisp/international/iso-cvt.el b/lisp/international/iso-cvt.el
index f7e325b0ca3..f896773e53c 100644
--- a/lisp/international/iso-cvt.el
+++ b/lisp/international/iso-cvt.el
@@ -791,6 +791,7 @@ Optional arg BUFFER is ignored (for use in `format-alist')."
791 ("&iuml;" "ï") 791 ("&iuml;" "ï")
792 ("&eth;" "ð") 792 ("&eth;" "ð")
793 ("&ntilde;" "ñ") 793 ("&ntilde;" "ñ")
794 ("&nbsp;" " ")
794 ("&ograve;" "ò") 795 ("&ograve;" "ò")
795 ("&oacute;" "ó") 796 ("&oacute;" "ó")
796 ("&ocirc;" "ô") 797 ("&ocirc;" "ô")
diff --git a/lisp/international/latexenc.el b/lisp/international/latexenc.el
index 88da8ffed79..6ce21a5328a 100644
--- a/lisp/international/latexenc.el
+++ b/lisp/international/latexenc.el
@@ -47,7 +47,7 @@
47;; like this 47;; like this
48 48
49;; (add-to-list 'file-coding-system-alist 49;; (add-to-list 'file-coding-system-alist
50;; '("\\.tex\\|\\.ltx\\|\\.dtx\\|\\.drv\\'" . latexenc-find-file-coding-system)) 50;; '("\\.\\(tex\\|ltx\\|dtx\\|drv\\)\\'" . latexenc-find-file-coding-system))
51 51
52;;; Code: 52;;; Code:
53 53
@@ -130,46 +130,50 @@ coding system names is determined from `latex-inputenc-coding-alist'."
130 (throw 'cs t) 130 (throw 'cs t)
131 (goto-char (match-end 0)))))) 131 (goto-char (match-end 0))))))
132 (let* ((match (match-string 1)) 132 (let* ((match (match-string 1))
133 (sym (intern match))) 133 (sym (or (latexenc-inputenc-to-coding-system match)
134 (when (latexenc-inputenc-to-coding-system match) 134 (intern match))))
135 (setq sym (latexenc-inputenc-to-coding-system match))) 135 (cond
136 (when (coding-system-p sym) 136 ((coding-system-p sym) sym)
137 sym 137 ((and (require 'code-pages nil t) (coding-system-p sym)) sym)
138 (if (and (require 'code-pages nil t) (coding-system-p sym)) 138 (t 'undecided)))
139 sym
140 'undecided)))
141 ;; else try to find it in the master/main file 139 ;; else try to find it in the master/main file
142 (let (latexenc-main-file) 140 (let ((default-directory (file-name-directory (nth 1 arg-list)))
143 ;; is there a TeX-master or tex-main-file in the local variable section 141 latexenc-main-file)
142 ;; Is there a TeX-master or tex-main-file in the local variables
143 ;; section?
144 (unless latexenc-dont-use-TeX-master-flag 144 (unless latexenc-dont-use-TeX-master-flag
145 (goto-char (point-max)) 145 (goto-char (point-max))
146 (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move) 146 (search-backward "\n\^L" (max (- (point-max) 3000) (point-min))
147 'move)
147 (search-forward "Local Variables:" nil t) 148 (search-forward "Local Variables:" nil t)
148 (when (re-search-forward "^%+ *\\(TeX-master\\|tex-main-file\\): *\"\\(.+\\)\"" nil t) 149 (when (re-search-forward
149 (let ((file (concat (file-name-directory (nth 1 arg-list)) (match-string 2)))) 150 "^%+ *\\(TeX-master\\|tex-main-file\\): *\"\\(.+\\)\""
150 (if (file-exists-p file) 151 nil t)
151 (setq latexenc-main-file file) 152 (let ((file (match-string 2)))
152 (if (boundp 'TeX-default-extension) 153 (dolist (ext `("" ,(if (boundp 'TeX-default-extension)
153 (when (file-exists-p (concat file "." TeX-default-extension)) 154 (concat "." TeX-default-extension)
154 (setq latexenc-main-file (concat file "." TeX-default-extension))) 155 "")
155 (dolist (ext '("drv" "dtx" "ltx" "tex")) 156 ".tex" ".ltx" ".dtx" ".drv"))
156 (if (file-exists-p (concat file "." ext)) 157 (if (and (null latexenc-main-file) ;Stop at first.
157 (setq latexenc-main-file (concat file "." ext))))))))) 158 (file-exists-p (concat file ext)))
159 (setq latexenc-main-file (concat file ext)))))))
158 ;; try tex-modes tex-guess-main-file 160 ;; try tex-modes tex-guess-main-file
159 (when (and (not latexenc-dont-use-tex-guess-main-file-flag) 161 (when (and (not latexenc-dont-use-tex-guess-main-file-flag)
160 (not latexenc-main-file)) 162 (not latexenc-main-file))
163 ;; Use a separate `when' so the byte-compiler sees the fboundp.
161 (when (fboundp 'tex-guess-main-file) 164 (when (fboundp 'tex-guess-main-file)
162 (let ((tex-start-of-header "\\\\document\\(style\\|class\\)") 165 (let ((tex-start-of-header "\\\\document\\(style\\|class\\)"))
163 (default-directory (file-name-directory (nth 1 arg-list))))
164 (setq latexenc-main-file (tex-guess-main-file))))) 166 (setq latexenc-main-file (tex-guess-main-file)))))
165 ;; if we found a master/main file get the coding system from it 167 ;; if we found a master/main file get the coding system from it
166 (if (and latexenc-main-file 168 (if (and latexenc-main-file
167 (file-readable-p latexenc-main-file)) 169 (file-readable-p latexenc-main-file))
168 (let* ((latexenc-dont-use-tex-guess-main-file-flag t) 170 (let* ((latexenc-dont-use-tex-guess-main-file-flag t)
169 (latexenc-dont-use-TeX-master-flag t) 171 (latexenc-dont-use-TeX-master-flag t)
170 (latexenc-main-buffer (find-file-noselect latexenc-main-file t))) 172 (latexenc-main-buffer
171 (or (buffer-local-value 'coding-system-for-write latexenc-main-buffer) 173 (find-file-noselect latexenc-main-file t)))
172 (buffer-local-value 'buffer-file-coding-system latexenc-main-buffer))) 174 (coding-system-base ;Disregard the EOL part of the CS.
175 (with-current-buffer latexenc-main-buffer
176 (or coding-system-for-write buffer-file-coding-system))))
173 'undecided)))) 177 'undecided))))
174 'undecided)) 178 'undecided))
175 179
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index d00aaf3cadc..bcabbc23e6c 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -624,7 +624,7 @@ then call `write-region', then afterward this variable will be non-nil
624only if the user was explicitly asked and specified a coding system.") 624only if the user was explicitly asked and specified a coding system.")
625 625
626(defvar select-safe-coding-system-accept-default-p nil 626(defvar select-safe-coding-system-accept-default-p nil
627 "If non-nil, a function to control the behaviour of coding system selection. 627 "If non-nil, a function to control the behavior of coding system selection.
628The meaning is the same as the argument ACCEPT-DEFAULT-P of the 628The meaning is the same as the argument ACCEPT-DEFAULT-P of the
629function `select-safe-coding-system' (which see). This variable 629function `select-safe-coding-system' (which see). This variable
630overrides that argument.") 630overrides that argument.")
@@ -1569,7 +1569,7 @@ at point in the current buffer.
1569But, if this flag is non-nil, it displays them in echo area instead.") 1569But, if this flag is non-nil, it displays them in echo area instead.")
1570 1570
1571(defvar input-method-exit-on-invalid-key nil 1571(defvar input-method-exit-on-invalid-key nil
1572 "This flag controls the behaviour of an input method on invalid key input. 1572 "This flag controls the behavior of an input method on invalid key input.
1573Usually, when a user types a key which doesn't start any character 1573Usually, when a user types a key which doesn't start any character
1574handled by the input method, the key is handled by turning off the 1574handled by the input method, the key is handled by turning off the
1575input method temporarily. After that key, the input method is re-enabled. 1575input method temporarily. After that key, the input method is re-enabled.
@@ -1846,7 +1846,7 @@ specifies the character set for the major languages of Western Europe."
1846 ;; Don't invoke fontset-related functions if fontsets aren't 1846 ;; Don't invoke fontset-related functions if fontsets aren't
1847 ;; supported in this build of Emacs. 1847 ;; supported in this build of Emacs.
1848 (when (fboundp 'fontset-list) 1848 (when (fboundp 'fontset-list)
1849 (let ((overriding-fontspec (get-language-info language-name 1849 (let ((overriding-fontspec (get-language-info language-name
1850 'overriding-fontspec))) 1850 'overriding-fontspec)))
1851 (if overriding-fontspec 1851 (if overriding-fontspec
1852 (set-overriding-fontspec-internal overriding-fontspec)))) 1852 (set-overriding-fontspec-internal overriding-fontspec))))
diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index 0dc8b3d8ca8..65d79076acb 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -64,7 +64,7 @@
64 'help-echo "mouse-2, RET: show table of characters for this character set") 64 'help-echo "mouse-2, RET: show table of characters for this character set")
65 65
66;;;###autoload 66;;;###autoload
67(defvar non-iso-charset-alist 67(defvar non-iso-charset-alist
68 `((mac-roman 68 `((mac-roman
69 (ascii latin-iso8859-1 mule-unicode-2500-33ff 69 (ascii latin-iso8859-1 mule-unicode-2500-33ff
70 mule-unicode-0100-24ff mule-unicode-e000-ffff) 70 mule-unicode-0100-24ff mule-unicode-e000-ffff)
@@ -609,7 +609,7 @@ PC `codepages' and other coded character sets. See `non-iso-charset-alist'."
609 (let ((vars (coding-system-get coding-system 'dependency))) 609 (let ((vars (coding-system-get coding-system 'dependency)))
610 (when vars 610 (when vars
611 (princ "See also the documentation of these customizable variables 611 (princ "See also the documentation of these customizable variables
612which alter the behaviour of this coding system.\n") 612which alter the behavior of this coding system.\n")
613 (dolist (v vars) 613 (dolist (v vars)
614 (princ " `") 614 (princ " `")
615 (princ v) 615 (princ v)
diff --git a/lisp/international/ucs-tables.el b/lisp/international/ucs-tables.el
index f952b7817a4..417304a5c76 100644
--- a/lisp/international/ucs-tables.el
+++ b/lisp/international/ucs-tables.el
@@ -2439,7 +2439,7 @@ Interactively, prompts for a hex string giving the code."
2439The ISO 8859 characters sets overlap, e.g. 8859-1 (Latin-1) and 2439The ISO 8859 characters sets overlap, e.g. 8859-1 (Latin-1) and
24408859-15 (Latin-9) differ only in a few characters. Emacs normally 24408859-15 (Latin-9) differ only in a few characters. Emacs normally
2441distinguishes equivalent characters from those ISO-8859 character sets 2441distinguishes equivalent characters from those ISO-8859 character sets
2442which are built in to Emacs. This behaviour is essentially inherited 2442which are built in to Emacs. This behavior is essentially inherited
2443from the European-originated international standards. Treating them 2443from the European-originated international standards. Treating them
2444equivalently, by translating to and from a single representation is 2444equivalently, by translating to and from a single representation is
2445called `unification'. (The `utf-8' coding system treats the 2445called `unification'. (The `utf-8' coding system treats the
diff --git a/lisp/isearchb.el b/lisp/isearchb.el
index 9714701944f..dbcbb1b7af2 100644
--- a/lisp/isearchb.el
+++ b/lisp/isearchb.el
@@ -151,7 +151,7 @@ It's purpose is to pass different call arguments to
151 (switch-to-buffer buf) 151 (switch-to-buffer buf)
152 (if isearchb-show-completions 152 (if isearchb-show-completions
153 (message "isearchb: %s%s" iswitchb-text 153 (message "isearchb: %s%s" iswitchb-text
154 (iswitchb-completions iswitchb-text nil)) 154 (iswitchb-completions iswitchb-text))
155 (if (= 1 (length iswitchb-matches)) 155 (if (= 1 (length iswitchb-matches))
156 (message "isearchb: %s (only match)" iswitchb-text) 156 (message "isearchb: %s (only match)" iswitchb-text)
157 (message "isearchb: %s" iswitchb-text)))))) 157 (message "isearchb: %s" iswitchb-text))))))
@@ -213,7 +213,7 @@ accessed via isearchb."
213 ((eq last-command 'isearchb-activate) 213 ((eq last-command 'isearchb-activate)
214 (if isearchb-last-buffer 214 (if isearchb-last-buffer
215 (switch-to-buffer isearchb-last-buffer) 215 (switch-to-buffer isearchb-last-buffer)
216 (error "isearchb: There is no previous buffer to toggle to.")) 216 (error "isearchb: There is no previous buffer to toggle to"))
217 (isearchb-stop nil t)) 217 (isearchb-stop nil t))
218 (t 218 (t
219 (message "isearchb: ") 219 (message "isearchb: ")
diff --git a/lisp/iswitchb.el b/lisp/iswitchb.el
index 52915c46950..d705faf9708 100644
--- a/lisp/iswitchb.el
+++ b/lisp/iswitchb.el
@@ -1,6 +1,7 @@
1;;; iswitchb.el --- switch between buffers using substrings 1;;; iswitchb.el --- switch between buffers using substrings
2 2
3;; Copyright (C) 1996, 1997, 2000, 2001, 2003 Free Software Foundation, Inc. 3;; Copyright (C) 1996, 1997, 2000, 2001, 2003, 2005
4;; Free Software Foundation, Inc.
4 5
5;; Author: Stephen Eglen <stephen@gnu.org> 6;; Author: Stephen Eglen <stephen@gnu.org>
6;; Maintainer: Stephen Eglen <stephen@gnu.org> 7;; Maintainer: Stephen Eglen <stephen@gnu.org>
@@ -165,11 +166,10 @@
165 166
166;; Font-Lock 167;; Font-Lock
167 168
168;; If you have font-lock loaded, the first matching buffer is 169;; font-lock is used to highlight the first matching buffer. To
169;; highlighted. To switch this off, set (setq iswitchb-use-fonts nil) 170;; switch this off, set (setq iswitchb-use-faces nil). Colouring of
170;; I don't use font-lock that much, so I've hardcoded the faces. If 171;; the matching buffer name was suggested by Carsten Dominik
171;; this is too harsh, let me know. Colouring of the matching buffer 172;; (dominik@strw.leidenuniv.nl)
172;; name was suggested by Carsten Dominik (dominik@strw.leidenuniv.nl)
173 173
174;; Replacement for read-buffer 174;; Replacement for read-buffer
175 175
@@ -230,16 +230,10 @@
230 230
231;; Regexp matching 231;; Regexp matching
232 232
233;; There is limited provision for regexp matching within iswitchb, 233;; There is provision for regexp matching within iswitchb, enabled
234;; enabled through `iswitchb-regexp'. This allows you to type `c$' 234;; through `iswitchb-regexp'. This allows you to type `c$' for
235;; for example and see all buffer names ending in `c'. This facility 235;; example and see all buffer names ending in `c'. No completion
236;; is quite limited though in two respects. First, you can't 236;; mechanism is currently offered when regexp searching.
237;; currently type in expressions like `[0-9]' directly -- you have to
238;; type them in when iswitchb-regexp is nil and then toggle on the
239;; regexp functionality. Likewise, don't enter an expression
240;; containing `\' in regexp mode. If you try, iswitchb gets confused,
241;; so just hit C-g and try again. Secondly, no completion mechanism
242;; is currently offered when regexp searching.
243 237
244;;; TODO 238;;; TODO
245 239
@@ -256,6 +250,8 @@
256 (fboundp 'last))) 250 (fboundp 'last)))
257 (require 'cl)) 251 (require 'cl))
258 252
253(require 'font-lock)
254
259;; Set up the custom library. 255;; Set up the custom library.
260;; taken from http://www.dina.kvl.dk/~abraham/custom/ 256;; taken from http://www.dina.kvl.dk/~abraham/custom/
261(eval-and-compile 257(eval-and-compile
@@ -377,10 +373,11 @@ See also `iswitchb-newbuffer'."
377 :type 'boolean 373 :type 'boolean
378 :group 'iswitchb) 374 :group 'iswitchb)
379 375
380(defcustom iswitchb-use-fonts t 376(defcustom iswitchb-use-faces t
381 "*Non-nil means use font-lock fonts for showing first match." 377 "*Non-nil means use font-lock fonts for showing first match."
382 :type 'boolean 378 :type 'boolean
383 :group 'iswitchb) 379 :group 'iswitchb)
380(define-obsolete-variable-alias 'iswitchb-use-fonts 'iswitchb-use-faces "22.1")
384 381
385(defcustom iswitchb-use-frame-buffer-list nil 382(defcustom iswitchb-use-frame-buffer-list nil
386 "*Non-nil means use the currently selected frame's buffer list." 383 "*Non-nil means use the currently selected frame's buffer list."
@@ -408,6 +405,35 @@ iswitchb is running."
408 :type 'hook 405 :type 'hook
409 :group 'iswitchb) 406 :group 'iswitchb)
410 407
408(defface iswitchb-single-match
409 '((t
410 (:inherit font-lock-comment-face)))
411 "Iswitchb face for single matching buffer name."
412 :version "22.1"
413 :group 'iswitchb)
414
415(defface iswitchb-current-match
416 '((t
417 (:inherit font-lock-function-name-face)))
418 "Iswitchb face for current matching buffer name."
419 :version "22.1"
420 :group 'iswitchb)
421
422(defface iswitchb-virtual-matches
423 '((t
424 (:inherit font-lock-builtin-face)))
425 "Iswitchb face for matching virtual buffer names.
426See also `iswitchb-use-virtual-buffers'."
427 :version "22.1"
428 :group 'iswitchb)
429
430(defface iswitchb-invalid-regexp
431 '((t
432 (:inherit font-lock-warning-face)))
433 "Iswitchb face for indicating invalid regexp. "
434 :version "22.1"
435 :group 'iswitchb)
436
411;; Do we need the variable iswitchb-use-mycompletion? 437;; Do we need the variable iswitchb-use-mycompletion?
412 438
413;;; Internal Variables 439;;; Internal Variables
@@ -507,6 +533,11 @@ selected.")
507(defvar iswitchb-minibuf-depth nil 533(defvar iswitchb-minibuf-depth nil
508 "Value we expect to be returned by `minibuffer-depth' in the minibuffer.") 534 "Value we expect to be returned by `minibuffer-depth' in the minibuffer.")
509 535
536(defvar iswitchb-common-match-inserted nil
537 "Non-nil if we have just inserted a common match in the minibuffer.")
538
539(defvar iswitchb-invalid-regexp)
540
510;;; FUNCTIONS 541;;; FUNCTIONS
511 542
512;;; ISWITCHB KEYMAP 543;;; ISWITCHB KEYMAP
@@ -564,6 +595,7 @@ in a separate window.
564 ;;`iswitchb-buffer-ignore') 595 ;;`iswitchb-buffer-ignore')
565 596
566 (let* ((prompt "iswitch ") 597 (let* ((prompt "iswitch ")
598 iswitchb-invalid-regexp
567 (buf (iswitchb-read-buffer prompt))) 599 (buf (iswitchb-read-buffer prompt)))
568 600
569 ;;(message "chosen text %s" iswitchb-final-text) 601 ;;(message "chosen text %s" iswitchb-final-text)
@@ -572,7 +604,8 @@ in a separate window.
572 604
573 (cond ( (eq iswitchb-exit 'findfile) 605 (cond ( (eq iswitchb-exit 'findfile)
574 (call-interactively 'find-file)) 606 (call-interactively 'find-file))
575 607 (iswitchb-invalid-regexp
608 (message "Won't make invalid regexp named buffer"))
576 (t 609 (t
577 ;; View the buffer 610 ;; View the buffer
578 ;;(message "go to buf %s" buf) 611 ;;(message "go to buf %s" buf)
@@ -602,10 +635,7 @@ the selection process begins. Used by isearchb.el."
602 buf-sel 635 buf-sel
603 iswitchb-final-text 636 iswitchb-final-text
604 (icomplete-mode nil) ;; prevent icomplete starting up 637 (icomplete-mode nil) ;; prevent icomplete starting up
605 ;; can only use fonts if they have been bound. 638 )
606 (iswitchb-use-fonts (and iswitchb-use-fonts
607 (boundp 'font-lock-comment-face)
608 (boundp 'font-lock-function-name-face))))
609 639
610 (iswitchb-define-mode-map) 640 (iswitchb-define-mode-map)
611 (setq iswitchb-exit nil) 641 (setq iswitchb-exit nil)
@@ -691,7 +721,9 @@ The result is stored in `iswitchb-common-match-string'."
691 (let (res) 721 (let (res)
692 (cond ((not iswitchb-matches) 722 (cond ((not iswitchb-matches)
693 (run-hooks 'iswitchb-cannot-complete-hook)) 723 (run-hooks 'iswitchb-cannot-complete-hook))
694 724 (iswitchb-invalid-regexp
725 ;; Do nothing
726 )
695 ((= 1 (length iswitchb-matches)) 727 ((= 1 (length iswitchb-matches))
696 ;; only one choice, so select it. 728 ;; only one choice, so select it.
697 (exit-minibuffer)) 729 (exit-minibuffer))
@@ -703,7 +735,8 @@ The result is stored in `iswitchb-common-match-string'."
703 (not (equal res iswitchb-text))) 735 (not (equal res iswitchb-text)))
704 ;; found something to complete, so put it in the minibuffer. 736 ;; found something to complete, so put it in the minibuffer.
705 (progn 737 (progn
706 (setq iswitchb-rescan nil) 738 (setq iswitchb-rescan nil
739 iswitchb-common-match-inserted t)
707 (delete-region (minibuffer-prompt-end) (point)) 740 (delete-region (minibuffer-prompt-end) (point))
708 (insert res)) 741 (insert res))
709 ;; else nothing to complete 742 ;; else nothing to complete
@@ -839,10 +872,8 @@ it is put to the start of the list."
839 872
840(defun iswitchb-to-end (lst) 873(defun iswitchb-to-end (lst)
841 "Move the elements from LST to the end of `iswitchb-temp-buflist'." 874 "Move the elements from LST to the end of `iswitchb-temp-buflist'."
842 (mapcar 875 (dolist (elem lst)
843 (lambda (elem) 876 (setq iswitchb-temp-buflist (delq elem iswitchb-temp-buflist)))
844 (setq iswitchb-temp-buflist (delq elem iswitchb-temp-buflist)))
845 lst)
846 (setq iswitchb-temp-buflist (nconc iswitchb-temp-buflist lst))) 877 (setq iswitchb-temp-buflist (nconc iswitchb-temp-buflist lst)))
847 878
848(defun iswitchb-get-buffers-in-frames (&optional current) 879(defun iswitchb-get-buffers-in-frames (&optional current)
@@ -883,29 +914,19 @@ current frame, rather than all frames, regardless of value of
883 "Return buffers matching REGEXP. 914 "Return buffers matching REGEXP.
884If STRING-FORMAT is nil, consider REGEXP as just a string. 915If STRING-FORMAT is nil, consider REGEXP as just a string.
885BUFFER-LIST can be list of buffers or list of strings." 916BUFFER-LIST can be list of buffers or list of strings."
886 (let* ((case-fold-search (iswitchb-case)) 917 (let* ((case-fold-search (iswitchb-case))
887 ;; need reverse since we are building up list backwards 918 name ret)
888 (list (reverse buffer-list)) 919 (if (null string-format) (setq regexp (regexp-quote regexp)))
889 (do-string (stringp (car list))) 920 (setq iswitchb-invalid-regexp nil)
890 name 921 (condition-case error
891 ret) 922 (dolist (x buffer-list (nreverse ret))
892 (mapcar 923 (setq name (if (stringp x) x (buffer-name x)))
893 (lambda (x) 924 (when (and (string-match regexp name)
894 925 (not (iswitchb-ignore-buffername-p name)))
895 (if do-string 926 (push name ret)))
896 (setq name x) ;We already have the name 927 (invalid-regexp
897 (setq name (buffer-name x))) 928 (setq iswitchb-invalid-regexp t)
898 929 (cdr error)))))
899 (cond
900 ((and (or (and string-format (string-match regexp name))
901 (and (null string-format)
902 (string-match (regexp-quote regexp) name)))
903
904 (not (iswitchb-ignore-buffername-p name)))
905 (setq ret (cons name ret))
906 )))
907 list)
908 ret))
909 930
910(defun iswitchb-ignore-buffername-p (bufname) 931(defun iswitchb-ignore-buffername-p (bufname)
911 "Return t if the buffer BUFNAME should be ignored." 932 "Return t if the buffer BUFNAME should be ignored."
@@ -989,7 +1010,8 @@ Return the modified list with the last element prepended to it."
989 (temp-buf "*Completions*") 1010 (temp-buf "*Completions*")
990 (win)) 1011 (win))
991 1012
992 (if (eq last-command this-command) 1013 (if (and (eq last-command this-command)
1014 (not iswitchb-common-match-inserted))
993 ;; scroll buffer 1015 ;; scroll buffer
994 (progn 1016 (progn
995 (set-buffer temp-buf) 1017 (set-buffer temp-buf)
@@ -1016,8 +1038,8 @@ Return the modified list with the last element prepended to it."
1016 (fundamental-mode)) 1038 (fundamental-mode))
1017 (display-completion-list (if iswitchb-matches 1039 (display-completion-list (if iswitchb-matches
1018 iswitchb-matches 1040 iswitchb-matches
1019 iswitchb-buflist)) 1041 iswitchb-buflist))))
1020 ))))) 1042 (setq iswitchb-common-match-inserted nil))))
1021 1043
1022;;; KILL CURRENT BUFFER 1044;;; KILL CURRENT BUFFER
1023 1045
@@ -1227,8 +1249,7 @@ Copied from `icomplete-exhibit' with two changes:
1227 1249
1228 ;; Insert the match-status information: 1250 ;; Insert the match-status information:
1229 (insert (iswitchb-completions 1251 (insert (iswitchb-completions
1230 contents 1252 contents))))))
1231 (not minibuffer-completion-confirm)))))))
1232 1253
1233(eval-when-compile 1254(eval-when-compile
1234 (defvar most-len) 1255 (defvar most-len)
@@ -1243,27 +1264,29 @@ Copied from `icomplete-exhibit' with two changes:
1243 (setq most-is-exact t)) 1264 (setq most-is-exact t))
1244 (substring com most-len))) 1265 (substring com most-len)))
1245 1266
1246(defun iswitchb-completions (name require-match) 1267(defun iswitchb-completions (name)
1247 "Return the string that is displayed after the user's text. 1268 "Return the string that is displayed after the user's text.
1248Modified from `icomplete-completions'." 1269Modified from `icomplete-completions'."
1249 1270
1250 (let ((comps iswitchb-matches) 1271 (let ((comps iswitchb-matches)
1251 ; "-determined" - only one candidate 1272 ; "-determined" - only one candidate
1252 (open-bracket-determined (if require-match "(" "[")) 1273 (open-bracket-determined "[")
1253 (close-bracket-determined (if require-match ")" "]")) 1274 (close-bracket-determined "]")
1254 ;"-prospects" - more than one candidate 1275 ;"-prospects" - more than one candidate
1255 (open-bracket-prospects "{") 1276 (open-bracket-prospects "{")
1256 (close-bracket-prospects "}") 1277 (close-bracket-prospects "}")
1257 first) 1278 first)
1258 1279
1259 (if (and iswitchb-use-fonts comps) 1280 (if (and iswitchb-use-faces comps)
1260 (progn 1281 (progn
1261 (setq first (car comps)) 1282 (setq first (car comps))
1262 (setq first (format "%s" first)) 1283 (setq first (format "%s" first))
1263 (put-text-property 0 (length first) 'face 1284 (put-text-property 0 (length first) 'face
1264 (if (= (length comps) 1) 1285 (if (= (length comps) 1)
1265 'font-lock-comment-face 1286 (if iswitchb-invalid-regexp
1266 'font-lock-function-name-face) 1287 'iswitchb-invalid-regexp
1288 'iswitchb-single-match)
1289 'iswitchb-current-match)
1267 first) 1290 first)
1268 (setq comps (cons first (cdr comps))))) 1291 (setq comps (cons first (cdr comps)))))
1269 1292
@@ -1292,7 +1315,7 @@ Modified from `icomplete-completions'."
1292 (let ((comp comps)) 1315 (let ((comp comps))
1293 (while comp 1316 (while comp
1294 (put-text-property 0 (length (car comp)) 1317 (put-text-property 0 (length (car comp))
1295 'face 'font-lock-builtin-face 1318 'face 'iswitchb-virtual-matches
1296 (car comp)) 1319 (car comp))
1297 (setq comp (cdr comp)))))) 1320 (setq comp (cdr comp))))))
1298 1321
@@ -1300,16 +1323,23 @@ Modified from `icomplete-completions'."
1300 open-bracket-determined 1323 open-bracket-determined
1301 close-bracket-determined)) 1324 close-bracket-determined))
1302 1325
1303 ((null (cdr comps)) ;one match 1326 (iswitchb-invalid-regexp
1304 (concat (if (and (> (length (car comps)) 1327 (concat " " (car comps)))
1305 (length name))) 1328 ((null (cdr comps)) ;one match
1306 (concat open-bracket-determined 1329 (concat
1330 (if (if (not iswitchb-regexp)
1331 (= (length name)
1332 (length (car comps)))
1333 (string-match name (car comps))
1334 (string-equal (match-string 0 (car comps))
1335 (car comps)))
1336 ""
1337 (concat open-bracket-determined
1307 ;; when there is one match, show the 1338 ;; when there is one match, show the
1308 ;; matching buffer name in full 1339 ;; matching buffer name in full
1309 (car comps) 1340 (car comps)
1310 close-bracket-determined) 1341 close-bracket-determined))
1311 "") 1342 (if (not iswitchb-use-faces) " [Matched]")))
1312 (if (not iswitchb-use-fonts) " [Matched]")))
1313 (t ;multiple matches 1343 (t ;multiple matches
1314 (if (and iswitchb-max-to-show 1344 (if (and iswitchb-max-to-show
1315 (> (length comps) iswitchb-max-to-show)) 1345 (> (length comps) iswitchb-max-to-show))
@@ -1431,5 +1461,5 @@ This mode enables switching between buffers using substrings. See
1431 1461
1432(provide 'iswitchb) 1462(provide 'iswitchb)
1433 1463
1434;;; arch-tag: d74198ae-753f-44f2-b34f-0c515398d90a 1464;; arch-tag: d74198ae-753f-44f2-b34f-0c515398d90a
1435;;; iswitchb.el ends here 1465;;; iswitchb.el ends here
diff --git a/lisp/kmacro.el b/lisp/kmacro.el
index 7224786c50d..6aaa8c8f224 100644
--- a/lisp/kmacro.el
+++ b/lisp/kmacro.el
@@ -631,7 +631,7 @@ A prefix argument serves as a repeat count. Zero means repeat until error.
631When you call the macro, you can call the macro again by repeating 631When you call the macro, you can call the macro again by repeating
632just the last key in the key sequence that you used to call this 632just the last key in the key sequence that you used to call this
633command. See `kmacro-call-repeat-key' and `kmacro-call-repeat-with-arg' 633command. See `kmacro-call-repeat-key' and `kmacro-call-repeat-with-arg'
634for details on how to adjust or disable this behaviour. 634for details on how to adjust or disable this behavior.
635 635
636To make a macro permanent so you can call it even after defining 636To make a macro permanent so you can call it even after defining
637others, use \\[kmacro-name-last-macro]." 637others, use \\[kmacro-name-last-macro]."
diff --git a/lisp/ledit.el b/lisp/ledit.el
index 38e03ca60cc..565550efe47 100644
--- a/lisp/ledit.el
+++ b/lisp/ledit.el
@@ -144,7 +144,7 @@ Like Lisp mode, plus these special commands:
144To make Lisp mode automatically change to Ledit mode, 144To make Lisp mode automatically change to Ledit mode,
145do (setq lisp-mode-hook 'ledit-from-lisp-mode)" 145do (setq lisp-mode-hook 'ledit-from-lisp-mode)"
146 (interactive) 146 (interactive)
147 (lisp-mode) 147 (delay-mode-hooks (lisp-mode))
148 (ledit-from-lisp-mode)) 148 (ledit-from-lisp-mode))
149 149
150;;;###autoload 150;;;###autoload
diff --git a/lisp/loadup.el b/lisp/loadup.el
index d5f97e49245..81009facce2 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -332,7 +332,7 @@
332 (setq name (concat (downcase (substring name 0 (match-beginning 0))) 332 (setq name (concat (downcase (substring name 0 (match-beginning 0)))
333 "-" 333 "-"
334 (substring name (match-end 0))))) 334 (substring name (match-end 0)))))
335 (if (eq system-type 'ms-dos) 335 (if (memq system-type '(ms-dos windows-nt cygwin))
336 (message "Dumping under the name emacs") 336 (message "Dumping under the name emacs")
337 (message "Dumping under names emacs and %s" name))) 337 (message "Dumping under names emacs and %s" name)))
338 (condition-case () 338 (condition-case ()
diff --git a/lisp/log-edit.el b/lisp/log-edit.el
index 09116e0584f..0d84ecd0504 100644
--- a/lisp/log-edit.el
+++ b/lisp/log-edit.el
@@ -154,12 +154,12 @@ different paragraphs are unrelated.
154You could argue that the log entry for a file should contain the 154You could argue that the log entry for a file should contain the
155full ChangeLog paragraph mentioning the change to the file, even though 155full ChangeLog paragraph mentioning the change to the file, even though
156it may mention other files, because that gives you the full context you 156it may mention other files, because that gives you the full context you
157need to understand the change. This is the behaviour you get when this 157need to understand the change. This is the behavior you get when this
158variable is set to t. 158variable is set to t.
159 159
160On the other hand, you could argue that the log entry for a change 160On the other hand, you could argue that the log entry for a change
161should contain only the text for the changes which occurred in that 161should contain only the text for the changes which occurred in that
162file, because the log is per-file. This is the behaviour you get 162file, because the log is per-file. This is the behavior you get
163when this variable is set to nil.") 163when this variable is set to nil.")
164 164
165;;;; Internal global or buffer-local vars 165;;;; Internal global or buffer-local vars
diff --git a/lisp/log-view.el b/lisp/log-view.el
index c153cbdbb60..302246e2f4c 100644
--- a/lisp/log-view.el
+++ b/lisp/log-view.el
@@ -63,21 +63,25 @@
63(defvar log-view-mode-hook nil 63(defvar log-view-mode-hook nil
64 "Hook run at the end of `log-view-mode'.") 64 "Hook run at the end of `log-view-mode'.")
65 65
66(defface log-view-file-face 66(defface log-view-file
67 '((((class color) (background light)) 67 '((((class color) (background light))
68 (:background "grey70" :weight bold)) 68 (:background "grey70" :weight bold))
69 (t (:weight bold))) 69 (t (:weight bold)))
70 "Face for the file header line in `log-view-mode'." 70 "Face for the file header line in `log-view-mode'."
71 :group 'log-view) 71 :group 'log-view)
72(defvar log-view-file-face 'log-view-file-face) 72;; backward-compatibility alias
73(put 'log-view-file-face 'face-alias 'log-view-file)
74(defvar log-view-file-face 'log-view-file)
73 75
74(defface log-view-message-face 76(defface log-view-message
75 '((((class color) (background light)) 77 '((((class color) (background light))
76 (:background "grey85")) 78 (:background "grey85"))
77 (t (:weight bold))) 79 (t (:weight bold)))
78 "Face for the message header line in `log-view-mode'." 80 "Face for the message header line in `log-view-mode'."
79 :group 'log-view) 81 :group 'log-view)
80(defvar log-view-message-face 'log-view-message-face) 82;; backward-compatibility alias
83(put 'log-view-message-face 'face-alias 'log-view-message)
84(defvar log-view-message-face 'log-view-message)
81 85
82(defconst log-view-file-re 86(defconst log-view-file-re
83 (concat "^\\(" 87 (concat "^\\("
diff --git a/lisp/longlines.el b/lisp/longlines.el
index e9c300fdbec..7583e03b4b0 100644
--- a/lisp/longlines.el
+++ b/lisp/longlines.el
@@ -153,11 +153,6 @@ major mode changes."
153 153
154;; Showing the effect of hard newlines in the buffer 154;; Showing the effect of hard newlines in the buffer
155 155
156(defface longlines-visible-face
157 '((t (:background "red")))
158 "Face used to make hard newlines visible in `longlines-mode'."
159 :group 'longlines)
160
161(defun longlines-show-hard-newlines (&optional arg) 156(defun longlines-show-hard-newlines (&optional arg)
162 "Make hard newlines visible by adding a face. 157 "Make hard newlines visible by adding a face.
163With optional argument ARG, make the hard newlines invisible again." 158With optional argument ARG, make the hard newlines invisible again."
diff --git a/lisp/mail/mspools.el b/lisp/mail/mspools.el
index 8dc165dcc5e..fc60a3a56eb 100644
--- a/lisp/mail/mspools.el
+++ b/lisp/mail/mspools.el
@@ -357,7 +357,7 @@ nil."
357 (use-local-map mspools-mode-map) 357 (use-local-map mspools-mode-map)
358 (setq major-mode 'mspools-mode) 358 (setq major-mode 'mspools-mode)
359 (setq mode-name "MSpools") 359 (setq mode-name "MSpools")
360 ) 360 (run-mode-hooks 'mspools-mode-hook))
361 361
362(defun mspools-get-spool-files () 362(defun mspools-get-spool-files ()
363 "Find the list of spool files and display them in *spools* buffer." 363 "Find the list of spool files and display them in *spools* buffer."
diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el
index ceea389cea1..2fbc9290635 100644
--- a/lisp/mail/rmailedit.el
+++ b/lisp/mail/rmailedit.el
@@ -57,7 +57,7 @@ to return to regular RMAIL:
57 * \\[rmail-cease-edit] makes them permanent. 57 * \\[rmail-cease-edit] makes them permanent.
58This functions runs the normal hook `rmail-edit-mode-hook'. 58This functions runs the normal hook `rmail-edit-mode-hook'.
59\\{rmail-edit-map}" 59\\{rmail-edit-map}"
60 (text-mode) 60 (delay-mode-hooks (text-mode))
61 (use-local-map rmail-edit-map) 61 (use-local-map rmail-edit-map)
62 (setq major-mode 'rmail-edit-mode) 62 (setq major-mode 'rmail-edit-mode)
63 (setq mode-name "RMAIL Edit") 63 (setq mode-name "RMAIL Edit")
diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el
index ba4aca881ef..593f46cad40 100644
--- a/lisp/mail/supercite.el
+++ b/lisp/mail/supercite.el
@@ -720,6 +720,7 @@ the list should be unique."
720 (sc-mail-warn-if-non-rfc822-p (sc-mail-error-in-mail-field)) 720 (sc-mail-warn-if-non-rfc822-p (sc-mail-error-in-mail-field))
721 (end (setq sc-mail-headers-end (point)))) 721 (end (setq sc-mail-headers-end (point))))
722 "Regi frame for glomming mail header information.") 722 "Regi frame for glomming mail header information.")
723(put 'sc-mail-glom-frame 'risky-local-variable t)
723 724
724(defvar curline) ; dynamic bondage 725(defvar curline) ; dynamic bondage
725 726
diff --git a/lisp/mail/undigest.el b/lisp/mail/undigest.el
index 2c447065643..f8856243194 100644
--- a/lisp/mail/undigest.el
+++ b/lisp/mail/undigest.el
@@ -40,7 +40,7 @@
40 "^----.*\\([Ff]orwarded\\|[Oo]riginal\\).*[Mm]essage" 40 "^----.*\\([Ff]orwarded\\|[Oo]riginal\\).*[Mm]essage"
41 "*Regexp to match the string that introduces forwarded messages. 41 "*Regexp to match the string that introduces forwarded messages.
42This is not a header, but a string contained in the body of the message. 42This is not a header, but a string contained in the body of the message.
43You may need to customise it for local needs." 43You may need to customize it for local needs."
44 :type 'regexp 44 :type 'regexp
45 :group 'rmail-headers) 45 :group 'rmail-headers)
46 46
diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in
index 54be26a1675..b4569c26140 100644
--- a/lisp/makefile.w32-in
+++ b/lisp/makefile.w32-in
@@ -286,13 +286,13 @@ recompile: doit
286 286
287# Prepare a bootstrap in the lisp subdirectory. 287# Prepare a bootstrap in the lisp subdirectory.
288# 288#
289# Build loaddefs.el, because it's not sure it's up-to-date, and if it's not, 289# Build loaddefs.el to make sure it's up-to-date. If it's not, that
290# that might lead to errors during the bootstrap because something fails to 290# might lead to errors during the bootstrap because something fails to
291# autoload as expected. However, if there is no emacs binary, then we can't 291# autoload as expected. If there is no emacs binary, then we can't
292# build autoloads yet, so just make sure there's some loaddefs.el file, as 292# build autoloads yet. In that case we have to use ldefs-boot.el;
293# it's necessary for generating the binary (because loaddefs.el is an 293# bootstrap should always work with ldefs-boot.el. (Because
294# automatically generated file, we don't want to store it in the source 294# loaddefs.el is an automatically generated file, we don't want to
295# repository). 295# store it in the source repository).
296# 296#
297# Remove compiled Lisp files so that bootstrap-emacs will be built from 297# Remove compiled Lisp files so that bootstrap-emacs will be built from
298# sources only. 298# sources only.
@@ -302,15 +302,13 @@ bootstrap-clean: bootstrap-clean-$(SHELLTYPE) loaddefs.el
302 302
303bootstrap-clean-CMD: 303bootstrap-clean-CMD:
304# if exist $(EMACS) $(MAKE) $(MFLAGS) autoloads 304# if exist $(EMACS) $(MAKE) $(MFLAGS) autoloads
305 if not exist $(lisp)\loaddefs.el cp $(lisp)/ldefs-boot.el $(lisp)/loaddefs.el 305 cp $(lisp)/ldefs-boot.el $(lisp)/loaddefs.el
306 -for %%f in (. $(WINS)) do for %%g in (%%f\*.elc) do @$(DEL) %%g 306 -for %%f in (. $(WINS)) do for %%g in (%%f\*.elc) do @$(DEL) %%g
307 307
308bootstrap-clean-SH: 308bootstrap-clean-SH:
309# if test -f $(EMACS); then $(MAKE) $(MFLAGS) autoloads; fi 309# if test -f $(EMACS); then $(MAKE) $(MFLAGS) autoloads; fi
310# -rm -f $(lisp)/*.elc $(lisp)/*/*.elc 310# -rm -f $(lisp)/*.elc $(lisp)/*/*.elc
311 if ! test -r $(lisp)/loaddefs.el; then \ 311 cp $(lisp)/ldefs-boot.el $(lisp)/loaddefs.el
312 cp $(lisp)/ldefs-boot.el $(lisp)/loaddefs.el; \
313 fi
314 -for dir in . $(WINS); do rm -f $$dir/*.elc; done 312 -for dir in . $(WINS); do rm -f $$dir/*.elc; done
315 313
316# Generate/update files for the bootstrap process. 314# Generate/update files for the bootstrap process.
diff --git a/lisp/man.el b/lisp/man.el
index d7344ed2f7a..0037d132624 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -391,10 +391,11 @@ Otherwise, the value is whatever the function
391 table) 391 table)
392 "Syntax table used in Man mode buffers.") 392 "Syntax table used in Man mode buffers.")
393 393
394(if Man-mode-map 394(unless Man-mode-map
395 nil 395 (setq Man-mode-map (make-sparse-keymap))
396 (setq Man-mode-map (copy-keymap button-buffer-map))
397 (suppress-keymap Man-mode-map) 396 (suppress-keymap Man-mode-map)
397 (set-keymap-parent Man-mode-map button-buffer-map)
398
398 (define-key Man-mode-map " " 'scroll-up) 399 (define-key Man-mode-map " " 'scroll-up)
399 (define-key Man-mode-map "\177" 'scroll-down) 400 (define-key Man-mode-map "\177" 'scroll-down)
400 (define-key Man-mode-map "n" 'Man-next-section) 401 (define-key Man-mode-map "n" 'Man-next-section)
@@ -410,8 +411,7 @@ Otherwise, the value is whatever the function
410 (define-key Man-mode-map "k" 'Man-kill) 411 (define-key Man-mode-map "k" 'Man-kill)
411 (define-key Man-mode-map "q" 'Man-quit) 412 (define-key Man-mode-map "q" 'Man-quit)
412 (define-key Man-mode-map "m" 'man) 413 (define-key Man-mode-map "m" 'man)
413 (define-key Man-mode-map "?" 'describe-mode) 414 (define-key Man-mode-map "?" 'describe-mode))
414 )
415 415
416;; buttons 416;; buttons
417(define-button-type 'Man-xref-man-page 417(define-button-type 'Man-xref-man-page
@@ -1023,6 +1023,8 @@ manpage command."
1023;; ====================================================================== 1023;; ======================================================================
1024;; set up manual mode in buffer and build alists 1024;; set up manual mode in buffer and build alists
1025 1025
1026(put 'Man-mode 'mode-class 'special)
1027
1026(defun Man-mode () 1028(defun Man-mode ()
1027 "A mode for browsing Un*x manual pages. 1029 "A mode for browsing Un*x manual pages.
1028 1030
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index ee51e8c349a..a4552d8f771 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -606,7 +606,7 @@ PROPS are additional properties."
606 `(progn 606 `(progn
607 (defun ,name (&optional interactively) 607 (defun ,name (&optional interactively)
608 ,(concat "Toggle whether to " (downcase (substring help 0 1)) 608 ,(concat "Toggle whether to " (downcase (substring help 0 1))
609 (substring help 1) ".\ 609 (substring help 1) ".
610In an interactive call, record this option as a candidate for saving 610In an interactive call, record this option as a candidate for saving
611by \"Save Options\" in Custom buffers.") 611by \"Save Options\" in Custom buffers.")
612 (interactive "p") 612 (interactive "p")
diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog
index 23e7c6d44cb..f37202a159d 100644
--- a/lisp/mh-e/ChangeLog
+++ b/lisp/mh-e/ChangeLog
@@ -1,3 +1,7 @@
12005-06-14 Juanma Barranquero <lekktu@gmail.com>
2
3 * mh-mime.el (mh-secure-message): Follow error conventions.
4
12005-05-28 Bill Wohler <wohler@newt.com> 52005-05-28 Bill Wohler <wohler@newt.com>
2 6
3 Released MH-E version 7.84. 7 Released MH-E version 7.84.
diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el
index dcd8f67a0f3..9bc8f7d74a9 100644
--- a/lisp/mh-e/mh-mime.el
+++ b/lisp/mh-e/mh-mime.el
@@ -597,7 +597,7 @@ IDENTITY is optionally the default-user-id to use."
597 (let ((valid-methods (list "pgpmime" "pgp" "smime")) 597 (let ((valid-methods (list "pgpmime" "pgp" "smime"))
598 (valid-modes (list "sign" "encrypt" "signencrypt" "none"))) 598 (valid-modes (list "sign" "encrypt" "signencrypt" "none")))
599 (if (not (member method valid-methods)) 599 (if (not (member method valid-methods))
600 (error (format "Sorry. METHOD \"%s\" is invalid." method))) 600 (error (format "Sorry. METHOD \"%s\" is invalid" method)))
601 (if (not (member mode valid-modes)) 601 (if (not (member mode valid-modes))
602 (error (format "Sorry. MODE \"%s\" is invalid" mode))) 602 (error (format "Sorry. MODE \"%s\" is invalid" mode)))
603 (mml-unsecure-message) 603 (mml-unsecure-message)
diff --git a/lisp/mouse.el b/lisp/mouse.el
index f4f531959b7..07e593a70c1 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -64,7 +64,7 @@ or perform the normal Mouse-1 action (typically set point).
64The absolute numeric value specifices the maximum duration of a 64The absolute numeric value specifices the maximum duration of a
65\"short click\" in milliseconds. A positive value means that a 65\"short click\" in milliseconds. A positive value means that a
66short click follows the link, and a longer click performs the 66short click follows the link, and a longer click performs the
67normal action. A negative value gives the opposite behaviour. 67normal action. A negative value gives the opposite behavior.
68 68
69If value is `double', a double click follows the link. 69If value is `double', a double click follows the link.
70 70
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 7fd07ebccfb..277da044c44 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -1964,35 +1964,34 @@ on the gateway machine to do the ftp instead."
1964 1964
1965\\{comint-mode-map}" 1965\\{comint-mode-map}"
1966 (interactive) 1966 (interactive)
1967 (comint-mode) 1967 (delay-mode-hooks (comint-mode))
1968 (setq major-mode 'internal-ange-ftp-mode) 1968 (setq major-mode 'internal-ange-ftp-mode)
1969 (setq mode-name "Internal Ange-ftp") 1969 (setq mode-name "Internal Ange-ftp")
1970 (let ((proc (get-buffer-process (current-buffer)))) 1970 (make-local-variable 'ange-ftp-process-string)
1971 (make-local-variable 'ange-ftp-process-string) 1971 (setq ange-ftp-process-string "")
1972 (setq ange-ftp-process-string "") 1972 (make-local-variable 'ange-ftp-process-busy)
1973 (make-local-variable 'ange-ftp-process-busy) 1973 (make-local-variable 'ange-ftp-process-result)
1974 (make-local-variable 'ange-ftp-process-result) 1974 (make-local-variable 'ange-ftp-process-msg)
1975 (make-local-variable 'ange-ftp-process-msg) 1975 (make-local-variable 'ange-ftp-process-multi-skip)
1976 (make-local-variable 'ange-ftp-process-multi-skip) 1976 (make-local-variable 'ange-ftp-process-result-line)
1977 (make-local-variable 'ange-ftp-process-result-line) 1977 (make-local-variable 'ange-ftp-process-continue)
1978 (make-local-variable 'ange-ftp-process-continue) 1978 (make-local-variable 'ange-ftp-hash-mark-count)
1979 (make-local-variable 'ange-ftp-hash-mark-count) 1979 (make-local-variable 'ange-ftp-binary-hash-mark-size)
1980 (make-local-variable 'ange-ftp-binary-hash-mark-size) 1980 (make-local-variable 'ange-ftp-ascii-hash-mark-size)
1981 (make-local-variable 'ange-ftp-ascii-hash-mark-size) 1981 (make-local-variable 'ange-ftp-hash-mark-unit)
1982 (make-local-variable 'ange-ftp-hash-mark-unit) 1982 (make-local-variable 'ange-ftp-xfer-size)
1983 (make-local-variable 'ange-ftp-xfer-size) 1983 (make-local-variable 'ange-ftp-last-percent)
1984 (make-local-variable 'ange-ftp-last-percent) 1984 (setq ange-ftp-hash-mark-count 0)
1985 (setq ange-ftp-hash-mark-count 0) 1985 (setq ange-ftp-xfer-size 0)
1986 (setq ange-ftp-xfer-size 0) 1986 (setq ange-ftp-process-result-line "")
1987 (setq ange-ftp-process-result-line "") 1987 (setq comint-prompt-regexp "^ftp> ")
1988 1988 (make-local-variable 'comint-password-prompt-regexp)
1989 (setq comint-prompt-regexp "^ftp> ") 1989 ;; This is a regexp that can't match anything.
1990 (make-local-variable 'comint-password-prompt-regexp) 1990 ;; ange-ftp has its own ways of handling passwords.
1991 ;; This is a regexp that can't match anything. 1991 (setq comint-password-prompt-regexp "^a\\'z")
1992 ;; ange-ftp has its own ways of handling passwords. 1992 (make-local-variable 'paragraph-start)
1993 (setq comint-password-prompt-regexp "^a\\'z") 1993 (setq paragraph-start comint-prompt-regexp)
1994 (make-local-variable 'paragraph-start) 1994 (run-mode-hooks 'internal-ange-ftp-mode-hook))
1995 (setq paragraph-start comint-prompt-regexp)))
1996 1995
1997(defcustom ange-ftp-raw-login nil 1996(defcustom ange-ftp-raw-login nil
1998 "*Use raw ftp commands for login, if account password is not nil. 1997 "*Use raw ftp commands for login, if account password is not nil.
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 5cd8701d1a5..d846234133d 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -487,7 +487,7 @@ enabled. The port number should be set in `browse-url-CCI-port'."
487 487
488(defcustom browse-url-xterm-program "xterm" 488(defcustom browse-url-xterm-program "xterm"
489 "*The name of the terminal emulator used by `browse-url-lynx-xterm'. 489 "*The name of the terminal emulator used by `browse-url-lynx-xterm'.
490This might, for instance, be a separate colour version of xterm." 490This might, for instance, be a separate color version of xterm."
491 :type 'string 491 :type 'string
492 :group 'browse-url) 492 :group 'browse-url)
493 493
diff --git a/lisp/net/eudc-hotlist.el b/lisp/net/eudc-hotlist.el
index 9dc81ce2bc9..bede338b364 100644
--- a/lisp/net/eudc-hotlist.el
+++ b/lisp/net/eudc-hotlist.el
@@ -56,7 +56,8 @@ These are the special commands of this mode:
56 (featurep 'menubar)) 56 (featurep 'menubar))
57 (set-buffer-menubar current-menubar) 57 (set-buffer-menubar current-menubar)
58 (add-submenu nil (cons "EUDC-Hotlist" (cdr (cdr eudc-hotlist-menu))))) 58 (add-submenu nil (cons "EUDC-Hotlist" (cdr (cdr eudc-hotlist-menu)))))
59 (setq buffer-read-only t)) 59 (setq buffer-read-only t)
60 (run-mode-hooks 'eudc-hotlist-mode-hook))
60 61
61;;;###autoload 62;;;###autoload
62(defun eudc-edit-hotlist () 63(defun eudc-edit-hotlist ()
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index a5ee3c9bc04..5873efcb98a 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -5095,7 +5095,7 @@ file exists and nonzero exit status otherwise."
5095 (and (setq tramp-file-exists-command "ls -d %s") 5095 (and (setq tramp-file-exists-command "ls -d %s")
5096 (file-exists-p existing) 5096 (file-exists-p existing)
5097 (not (file-exists-p nonexisting)))) 5097 (not (file-exists-p nonexisting))))
5098 (error "Couldn't find command to check if file exists.")))) 5098 (error "Couldn't find command to check if file exists"))))
5099 5099
5100 5100
5101;; CCC test ksh or bash found for tilde expansion? 5101;; CCC test ksh or bash found for tilde expansion?
@@ -5131,7 +5131,7 @@ file exists and nonzero exit status otherwise."
5131 60 (format "\\(\\(%s\\)\\|\\(%s\\)\\)\\'" 5131 60 (format "\\(\\(%s\\)\\|\\(%s\\)\\)\\'"
5132 tramp-shell-prompt-pattern shell-prompt-pattern)) 5132 tramp-shell-prompt-pattern shell-prompt-pattern))
5133 (pop-to-buffer (buffer-name)) 5133 (pop-to-buffer (buffer-name))
5134 (error "Couldn't find remote `%s' prompt." shell)) 5134 (error "Couldn't find remote `%s' prompt" shell))
5135 (tramp-message 5135 (tramp-message
5136 9 "Setting remote shell prompt...") 5136 9 "Setting remote shell prompt...")
5137 ;; Douglas Gray Stephens <DGrayStephens@slb.com> says that we 5137 ;; Douglas Gray Stephens <DGrayStephens@slb.com> says that we
diff --git a/lisp/obsolete/lazy-lock.el b/lisp/obsolete/lazy-lock.el
index 3547674bf36..f618037c753 100644
--- a/lisp/obsolete/lazy-lock.el
+++ b/lisp/obsolete/lazy-lock.el
@@ -506,7 +506,7 @@ When Lazy Lock mode is enabled, fontification can be lazy in a number of ways:
506 been idle for `lazy-lock-stealth-time' seconds, while Emacs remains idle. 506 been idle for `lazy-lock-stealth-time' seconds, while Emacs remains idle.
507 This is useful if any buffer has any deferred fontification. 507 This is useful if any buffer has any deferred fontification.
508 508
509Basic Font Lock mode on-the-fly fontification behaviour fontifies modified 509Basic Font Lock mode on-the-fly fontification behavior fontifies modified
510lines only. Thus, if `lazy-lock-defer-contextually' is non-nil, Lazy Lock mode 510lines only. Thus, if `lazy-lock-defer-contextually' is non-nil, Lazy Lock mode
511on-the-fly fontification may fontify differently, albeit correctly. In any 511on-the-fly fontification may fontify differently, albeit correctly. In any
512event, to refontify some lines you can use \\[font-lock-fontify-block]. 512event, to refontify some lines you can use \\[font-lock-fontify-block].
diff --git a/lisp/paren.el b/lisp/paren.el
index fe2beae4edd..7c6abe087b9 100644
--- a/lisp/paren.el
+++ b/lisp/paren.el
@@ -71,7 +71,7 @@ otherwise)."
71 :group 'paren-showing 71 :group 'paren-showing
72 :version "20.3") 72 :version "20.3")
73 73
74(defface show-paren-match-face 74(defface show-paren-match
75 '((((class color) (background light)) 75 '((((class color) (background light))
76 :background "turquoise") ; looks OK on tty (becomes cyan) 76 :background "turquoise") ; looks OK on tty (becomes cyan)
77 (((class color) (background dark)) 77 (((class color) (background dark))
@@ -83,13 +83,17 @@ otherwise)."
83 "Show Paren mode face used for a matching paren." 83 "Show Paren mode face used for a matching paren."
84 :group 'faces 84 :group 'faces
85 :group 'paren-showing) 85 :group 'paren-showing)
86;; backward-compatibility alias
87(put 'show-paren-match-face 'face-alias 'show-paren-match)
86 88
87(defface show-paren-mismatch-face 89(defface show-paren-mismatch
88 '((((class color)) (:foreground "white" :background "purple")) 90 '((((class color)) (:foreground "white" :background "purple"))
89 (t (:inverse-video t))) 91 (t (:inverse-video t)))
90 "Show Paren mode face used for a mismatching paren." 92 "Show Paren mode face used for a mismatching paren."
91 :group 'faces 93 :group 'faces
92 :group 'paren-showing) 94 :group 'paren-showing)
95;; backward-compatibility alias
96(put 'show-paren-mismatch-face 'face-alias 'show-paren-mismatch)
93 97
94(defvar show-paren-highlight-openparen t 98(defvar show-paren-highlight-openparen t
95 "*Non-nil turns on openparen highlighting when matching forward.") 99 "*Non-nil turns on openparen highlighting when matching forward.")
@@ -193,8 +197,8 @@ in `show-paren-style' after `show-paren-delay' seconds of Emacs idle time."
193 (progn 197 (progn
194 (if show-paren-ring-bell-on-mismatch 198 (if show-paren-ring-bell-on-mismatch
195 (beep)) 199 (beep))
196 (setq face 'show-paren-mismatch-face)) 200 (setq face 'show-paren-mismatch))
197 (setq face 'show-paren-match-face)) 201 (setq face 'show-paren-match))
198 ;; 202 ;;
199 ;; If matching backwards, highlight the closeparen 203 ;; If matching backwards, highlight the closeparen
200 ;; before point as well as its matching open. 204 ;; before point as well as its matching open.
diff --git a/lisp/pcvs-defs.el b/lisp/pcvs-defs.el
index 27629c5ddc6..62c0d62d161 100644
--- a/lisp/pcvs-defs.el
+++ b/lisp/pcvs-defs.el
@@ -1,7 +1,7 @@
1;;; pcvs-defs.el --- variable definitions for PCL-CVS 1;;; pcvs-defs.el --- variable definitions for PCL-CVS
2 2
3;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 3;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
4;; 2000, 2003, 2004 Free Software Foundation, Inc. 4;; 2000, 2003, 2004, 2005 Free Software Foundation, Inc.
5 5
6;; Author: Stefan Monnier <monnier@cs.yale.edu> 6;; Author: Stefan Monnier <monnier@cs.yale.edu>
7;; Keywords: pcl-cvs 7;; Keywords: pcl-cvs
@@ -381,7 +381,7 @@ This variable is buffer local and only used in the *cvs* buffer.")
381 ;; mouse bindings 381 ;; mouse bindings
382 ([mouse-2] . cvs-mode-find-file) 382 ([mouse-2] . cvs-mode-find-file)
383 ([follow-link] . (lambda (pos) 383 ([follow-link] . (lambda (pos)
384 (if (eq (get-char-property pos 'face) 'cvs-filename-face) t))) 384 (if (eq (get-char-property pos 'face) 'cvs-filename) t)))
385 ([(down-mouse-3)] . cvs-menu) 385 ([(down-mouse-3)] . cvs-menu)
386 ;; dired-like bindings 386 ;; dired-like bindings
387 ("\C-o" . cvs-mode-display-file) 387 ("\C-o" . cvs-mode-display-file)
diff --git a/lisp/pcvs-info.el b/lisp/pcvs-info.el
index cf367072838..d56fa19fd32 100644
--- a/lisp/pcvs-info.el
+++ b/lisp/pcvs-info.el
@@ -61,7 +61,7 @@ to confuse some users sometimes."
61;;;; Faces for fontification 61;;;; Faces for fontification
62;;;; 62;;;;
63 63
64(defface cvs-header-face 64(defface cvs-header
65 '((((class color) (background dark)) 65 '((((class color) (background dark))
66 (:foreground "lightyellow" :weight bold)) 66 (:foreground "lightyellow" :weight bold))
67 (((class color) (background light)) 67 (((class color) (background light))
@@ -69,8 +69,10 @@ to confuse some users sometimes."
69 (t (:weight bold))) 69 (t (:weight bold)))
70 "PCL-CVS face used to highlight directory changes." 70 "PCL-CVS face used to highlight directory changes."
71 :group 'pcl-cvs) 71 :group 'pcl-cvs)
72;; backward-compatibility alias
73(put 'cvs-header-face 'face-alias 'cvs-header)
72 74
73(defface cvs-filename-face 75(defface cvs-filename
74 '((((class color) (background dark)) 76 '((((class color) (background dark))
75 (:foreground "lightblue")) 77 (:foreground "lightblue"))
76 (((class color) (background light)) 78 (((class color) (background light))
@@ -78,8 +80,10 @@ to confuse some users sometimes."
78 (t ())) 80 (t ()))
79 "PCL-CVS face used to highlight file names." 81 "PCL-CVS face used to highlight file names."
80 :group 'pcl-cvs) 82 :group 'pcl-cvs)
83;; backward-compatibility alias
84(put 'cvs-filename-face 'face-alias 'cvs-filename)
81 85
82(defface cvs-unknown-face 86(defface cvs-unknown
83 '((((class color) (background dark)) 87 '((((class color) (background dark))
84 (:foreground "red")) 88 (:foreground "red"))
85 (((class color) (background light)) 89 (((class color) (background light))
@@ -87,8 +91,10 @@ to confuse some users sometimes."
87 (t (:slant italic))) 91 (t (:slant italic)))
88 "PCL-CVS face used to highlight unknown file status." 92 "PCL-CVS face used to highlight unknown file status."
89 :group 'pcl-cvs) 93 :group 'pcl-cvs)
94;; backward-compatibility alias
95(put 'cvs-unknown-face 'face-alias 'cvs-unknown)
90 96
91(defface cvs-handled-face 97(defface cvs-handled
92 '((((class color) (background dark)) 98 '((((class color) (background dark))
93 (:foreground "pink")) 99 (:foreground "pink"))
94 (((class color) (background light)) 100 (((class color) (background light))
@@ -96,8 +102,10 @@ to confuse some users sometimes."
96 (t ())) 102 (t ()))
97 "PCL-CVS face used to highlight handled file status." 103 "PCL-CVS face used to highlight handled file status."
98 :group 'pcl-cvs) 104 :group 'pcl-cvs)
105;; backward-compatibility alias
106(put 'cvs-handled-face 'face-alias 'cvs-handled)
99 107
100(defface cvs-need-action-face 108(defface cvs-need-action
101 '((((class color) (background dark)) 109 '((((class color) (background dark))
102 (:foreground "orange")) 110 (:foreground "orange"))
103 (((class color) (background light)) 111 (((class color) (background light))
@@ -105,8 +113,10 @@ to confuse some users sometimes."
105 (t (:slant italic))) 113 (t (:slant italic)))
106 "PCL-CVS face used to highlight status of files needing action." 114 "PCL-CVS face used to highlight status of files needing action."
107 :group 'pcl-cvs) 115 :group 'pcl-cvs)
116;; backward-compatibility alias
117(put 'cvs-need-action-face 'face-alias 'cvs-need-action)
108 118
109(defface cvs-marked-face 119(defface cvs-marked
110 '((((min-colors 88) (class color) (background dark)) 120 '((((min-colors 88) (class color) (background dark))
111 (:foreground "green1" :weight bold)) 121 (:foreground "green1" :weight bold))
112 (((class color) (background dark)) 122 (((class color) (background dark))
@@ -116,14 +126,18 @@ to confuse some users sometimes."
116 (t (:weight bold))) 126 (t (:weight bold)))
117 "PCL-CVS face used to highlight marked file indicator." 127 "PCL-CVS face used to highlight marked file indicator."
118 :group 'pcl-cvs) 128 :group 'pcl-cvs)
129;; backward-compatibility alias
130(put 'cvs-marked-face 'face-alias 'cvs-marked)
119 131
120(defface cvs-msg-face 132(defface cvs-msg
121 '((t (:slant italic))) 133 '((t (:slant italic)))
122 "PCL-CVS face used to highlight CVS messages." 134 "PCL-CVS face used to highlight CVS messages."
123 :group 'pcl-cvs) 135 :group 'pcl-cvs)
136;; backward-compatibility alias
137(put 'cvs-msg-face 'face-alias 'cvs-msg)
124 138
125(defvar cvs-fi-up-to-date-face 'cvs-handled-face) 139(defvar cvs-fi-up-to-date-face 'cvs-handled)
126(defvar cvs-fi-unknown-face 'cvs-unknown-face) 140(defvar cvs-fi-unknown-face 'cvs-unknown)
127(defvar cvs-fi-conflict-face 'font-lock-warning-face) 141(defvar cvs-fi-conflict-face 'font-lock-warning-face)
128 142
129;; There is normally no need to alter the following variable, but if 143;; There is normally no need to alter the following variable, but if
@@ -332,19 +346,17 @@ For use by the cookie package."
332 (case type 346 (case type
333 (DIRCHANGE (concat "In directory " 347 (DIRCHANGE (concat "In directory "
334 (cvs-add-face (cvs-fileinfo->full-name fileinfo) 348 (cvs-add-face (cvs-fileinfo->full-name fileinfo)
335 'cvs-header-face t 349 'cvs-header t 'cvs-goal-column t)
336 'cvs-goal-column t)
337 ":")) 350 ":"))
338 (MESSAGE 351 (MESSAGE
339 (cvs-add-face (format "Message: %s" (cvs-fileinfo->full-log fileinfo)) 352 (cvs-add-face (format "Message: %s" (cvs-fileinfo->full-log fileinfo))
340 'cvs-msg-face)) 353 'cvs-msg))
341 (t 354 (t
342 (let* ((status (if (cvs-fileinfo->marked fileinfo) 355 (let* ((status (if (cvs-fileinfo->marked fileinfo)
343 (cvs-add-face "*" 'cvs-marked-face) 356 (cvs-add-face "*" 'cvs-marked)
344 " ")) 357 " "))
345 (file (cvs-add-face (cvs-fileinfo->pp-name fileinfo) 358 (file (cvs-add-face (cvs-fileinfo->pp-name fileinfo)
346 'cvs-filename-face t 359 'cvs-filename t 'cvs-goal-column t))
347 'cvs-goal-column t))
348 (base (or (cvs-fileinfo->base-rev fileinfo) "")) 360 (base (or (cvs-fileinfo->base-rev fileinfo) ""))
349 (head (cvs-fileinfo->head-rev fileinfo)) 361 (head (cvs-fileinfo->head-rev fileinfo))
350 (type 362 (type
@@ -357,7 +369,7 @@ For use by the cookie package."
357 (downcase (symbol-name type)) 369 (downcase (symbol-name type))
358 "-face")))) 370 "-face"))))
359 (or (and (boundp sym) (symbol-value sym)) 371 (or (and (boundp sym) (symbol-value sym))
360 'cvs-need-action-face)))) 372 'cvs-need-action))))
361 (cvs-add-face str face cvs-status-map))) 373 (cvs-add-face str face cvs-status-map)))
362 (side (or 374 (side (or
363 ;; maybe a subtype 375 ;; maybe a subtype
diff --git a/lisp/pcvs.el b/lisp/pcvs.el
index 7c96a080c54..be93104a33f 100644
--- a/lisp/pcvs.el
+++ b/lisp/pcvs.el
@@ -944,9 +944,9 @@ With a prefix argument, prompt for cvs FLAGS to use."
944(defun-cvs-mode (cvs-mode-checkout . NOARGS) (dir) 944(defun-cvs-mode (cvs-mode-checkout . NOARGS) (dir)
945 "Run cvs checkout against the current branch. 945 "Run cvs checkout against the current branch.
946The files are stored to DIR." 946The files are stored to DIR."
947 (interactive 947 (interactive
948 (let* ((branch (cvs-prefix-get 'cvs-branch-prefix)) 948 (let* ((branch (cvs-prefix-get 'cvs-branch-prefix))
949 (prompt (format "CVS Checkout Directory for `%s%s': " 949 (prompt (format "CVS Checkout Directory for `%s%s': "
950 (cvs-get-module) 950 (cvs-get-module)
951 (if branch (format " (branch: %s)" branch) 951 (if branch (format " (branch: %s)" branch)
952 "")))) 952 ""))))
@@ -1123,7 +1123,7 @@ Full documentation is in the Texinfo file."
1123 ("->" cvs-secondary-branch-prefix)))) 1123 ("->" cvs-secondary-branch-prefix))))
1124 " " cvs-mode-line-process)) 1124 " " cvs-mode-line-process))
1125 (if buffer-file-name 1125 (if buffer-file-name
1126 (error "Use M-x cvs-quickdir to get a *cvs* buffer.")) 1126 (error "Use M-x cvs-quickdir to get a *cvs* buffer"))
1127 (buffer-disable-undo) 1127 (buffer-disable-undo)
1128 ;;(set (make-local-variable 'goal-column) cvs-cursor-column) 1128 ;;(set (make-local-variable 'goal-column) cvs-cursor-column)
1129 (set (make-local-variable 'revert-buffer-function) 'cvs-mode-revert-buffer) 1129 (set (make-local-variable 'revert-buffer-function) 'cvs-mode-revert-buffer)
@@ -1980,7 +1980,7 @@ With a prefix, opens the buffer in an OTHER window."
1980 (when (and (/= (point) (progn (posn-set-point (event-end e)) (point))) 1980 (when (and (/= (point) (progn (posn-set-point (event-end e)) (point)))
1981 (not (memq (get-text-property (1- (line-end-position)) 1981 (not (memq (get-text-property (1- (line-end-position))
1982 'font-lock-face) 1982 'font-lock-face)
1983 '(cvs-header-face cvs-filename-face)))) 1983 '(cvs-header cvs-filename))))
1984 (error "Not a file name")) 1984 (error "Not a file name"))
1985 (cvs-mode! 1985 (cvs-mode!
1986 (lambda (&optional rev) 1986 (lambda (&optional rev)
diff --git a/lisp/play/blackbox.el b/lisp/play/blackbox.el
index 6fad15b8155..02f8cb5eeb0 100644
--- a/lisp/play/blackbox.el
+++ b/lisp/play/blackbox.el
@@ -117,14 +117,14 @@ The usual mnemonic keys move the cursor around the box.
117\\<blackbox-mode-map>\\[bb-bol] and \\[bb-eol] move to the beginning and end of line, respectively. 117\\<blackbox-mode-map>\\[bb-bol] and \\[bb-eol] move to the beginning and end of line, respectively.
118 118
119\\[bb-romp] -- send in a ray from point, or toggle a ball at point 119\\[bb-romp] -- send in a ray from point, or toggle a ball at point
120\\[bb-done] -- end game and get score 120\\[bb-done] -- end game and get score"
121"
122 (interactive) 121 (interactive)
123 (kill-all-local-variables) 122 (kill-all-local-variables)
124 (use-local-map blackbox-mode-map) 123 (use-local-map blackbox-mode-map)
125 (setq truncate-lines t) 124 (setq truncate-lines t)
126 (setq major-mode 'blackbox-mode) 125 (setq major-mode 'blackbox-mode)
127 (setq mode-name "Blackbox")) 126 (setq mode-name "Blackbox")
127 (run-mode-hooks 'blackbox-mode-hook))
128 128
129;;;###autoload 129;;;###autoload
130(defun blackbox (num) 130(defun blackbox (num)
diff --git a/lisp/play/doctor.el b/lisp/play/doctor.el
index 798abbc790a..7b81daa7782 100644
--- a/lisp/play/doctor.el
+++ b/lisp/play/doctor.el
@@ -59,30 +59,21 @@
59 (set what ww) 59 (set what ww)
60 first)) 60 first))
61 61
62(defvar doctor-mode-map nil) 62(define-derived-mode doctor-mode text-mode "Doctor"
63(if doctor-mode-map
64 nil
65 (setq doctor-mode-map (make-sparse-keymap))
66 (define-key doctor-mode-map "\n" 'doctor-read-print)
67 (define-key doctor-mode-map "\r" 'doctor-ret-or-read))
68
69(defun doctor-mode ()
70 "Major mode for running the Doctor (Eliza) program. 63 "Major mode for running the Doctor (Eliza) program.
71Like Text mode with Auto Fill mode 64Like Text mode with Auto Fill mode
72except that RET when point is after a newline, or LFD at any time, 65except that RET when point is after a newline, or LFD at any time,
73reads the sentence before point, and prints the Doctor's answer." 66reads the sentence before point, and prints the Doctor's answer."
74 (interactive)
75 (text-mode)
76 (make-doctor-variables) 67 (make-doctor-variables)
77 (use-local-map doctor-mode-map)
78 (setq major-mode 'doctor-mode)
79 (setq mode-name "Doctor")
80 (turn-on-auto-fill) 68 (turn-on-auto-fill)
81 (doctor-type '(i am the psychotherapist \. 69 (doctor-type '(i am the psychotherapist \.
82 (doc$ please) (doc$ describe) your (doc$ problems) \. 70 (doc$ please) (doc$ describe) your (doc$ problems) \.
83 each time you are finished talking, type \R\E\T twice \.)) 71 each time you are finished talking, type \R\E\T twice \.))
84 (insert "\n")) 72 (insert "\n"))
85 73
74(define-key doctor-mode-map "\n" 'doctor-read-print)
75(define-key doctor-mode-map "\r" 'doctor-ret-or-read)
76
86(defun make-doctor-variables () 77(defun make-doctor-variables ()
87 (make-local-variable 'typos) 78 (make-local-variable 'typos)
88 (setq typos 79 (setq typos
diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el
index 50b8bce5f74..290ee6ebf5d 100644
--- a/lisp/play/dunnet.el
+++ b/lisp/play/dunnet.el
@@ -53,15 +53,10 @@
53 53
54;;;; Mode definitions for interactive mode 54;;;; Mode definitions for interactive mode
55 55
56(defun dun-mode () 56(define-derived-mode dun-mode text-mode "Dungeon"
57 "Major mode for running dunnet." 57 "Major mode for running dunnet."
58 (interactive)
59 (text-mode)
60 (make-local-variable 'scroll-step) 58 (make-local-variable 'scroll-step)
61 (setq scroll-step 2) 59 (setq scroll-step 2))
62 (use-local-map dungeon-mode-map)
63 (setq major-mode 'dun-mode)
64 (setq mode-name "Dungeon"))
65 60
66(defun dun-parse (arg) 61(defun dun-parse (arg)
67 "Function called when return is pressed in interactive mode to parse line." 62 "Function called when return is pressed in interactive mode to parse line."
@@ -1366,9 +1361,8 @@ for a moment, then straighten yourself up.
1366(setq dun-current-room 1) 1361(setq dun-current-room 1)
1367(setq dun-exitf nil) 1362(setq dun-exitf nil)
1368(setq dun-badcd nil) 1363(setq dun-badcd nil)
1369(defvar dungeon-mode-map nil) 1364(define-obsolete-variable-alias 'dungeon-mode-map 'dun-mode-map "22.1")
1370(setq dungeon-mode-map (make-sparse-keymap)) 1365(define-key dun-mode-map "\r" 'dun-parse)
1371(define-key dungeon-mode-map "\r" 'dun-parse)
1372(defvar dungeon-batch-map (make-keymap)) 1366(defvar dungeon-batch-map (make-keymap))
1373(if (string= (substring emacs-version 0 2) "18") 1367(if (string= (substring emacs-version 0 2) "18")
1374 (let (n) 1368 (let (n)
@@ -2594,7 +2588,7 @@ treasures for points?" "4" "four")
2594 (if dun-logged-in 2588 (if dun-logged-in
2595 (progn 2589 (progn
2596 (setq dungeon-mode 'unix) 2590 (setq dungeon-mode 'unix)
2597 (define-key dungeon-mode-map "\r" 'dun-unix-parse) 2591 (define-key dun-mode-map "\r" 'dun-unix-parse)
2598 (dun-mprinc "$ ")))) 2592 (dun-mprinc "$ "))))
2599 2593
2600(defun dun-login () 2594(defun dun-login ()
@@ -2860,7 +2854,7 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..")
2860(defun dun-uexit (args) 2854(defun dun-uexit (args)
2861 (setq dungeon-mode 'dungeon) 2855 (setq dungeon-mode 'dungeon)
2862 (dun-mprincl "\nYou step back from the console.") 2856 (dun-mprincl "\nYou step back from the console.")
2863 (define-key dungeon-mode-map "\r" 'dun-parse) 2857 (define-key dun-mode-map "\r" 'dun-parse)
2864 (if (not dun-batch-mode) 2858 (if (not dun-batch-mode)
2865 (dun-messages))) 2859 (dun-messages)))
2866 2860
@@ -3059,7 +3053,7 @@ drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..")
3059(defun dun-dos-interface () 3053(defun dun-dos-interface ()
3060 (dun-dos-boot-msg) 3054 (dun-dos-boot-msg)
3061 (setq dungeon-mode 'dos) 3055 (setq dungeon-mode 'dos)
3062 (define-key dungeon-mode-map "\r" 'dun-dos-parse) 3056 (define-key dun-mode-map "\r" 'dun-dos-parse)
3063 (dun-dos-prompt)) 3057 (dun-dos-prompt))
3064 3058
3065(defun dun-dos-type (args) 3059(defun dun-dos-type (args)
@@ -3117,7 +3111,7 @@ File not found")))
3117(defun dun-dos-exit (args) 3111(defun dun-dos-exit (args)
3118 (setq dungeon-mode 'dungeon) 3112 (setq dungeon-mode 'dungeon)
3119 (dun-mprincl "\nYou power down the machine and step back.") 3113 (dun-mprincl "\nYou power down the machine and step back.")
3120 (define-key dungeon-mode-map "\r" 'dun-parse) 3114 (define-key dun-mode-map "\r" 'dun-parse)
3121 (if (not dun-batch-mode) 3115 (if (not dun-batch-mode)
3122 (dun-messages))) 3116 (dun-messages)))
3123 3117
diff --git a/lisp/play/gomoku.el b/lisp/play/gomoku.el
index 69ec07496d5..611c095fbd1 100644
--- a/lisp/play/gomoku.el
+++ b/lisp/play/gomoku.el
@@ -1,6 +1,6 @@
1;;; gomoku.el --- Gomoku game between you and Emacs 1;;; gomoku.el --- Gomoku game between you and Emacs
2 2
3;; Copyright (C) 1988, 1994, 1996, 2001, 2003 Free Software Foundation, Inc. 3;; Copyright (C) 1988, 1994, 1996, 2001, 2003, 2005 Free Software Foundation, Inc.
4 4
5;; Author: Philippe Schnoebelen <phs@lsv.ens-cachan.fr> 5;; Author: Philippe Schnoebelen <phs@lsv.ens-cachan.fr>
6;; Maintainer: FSF 6;; Maintainer: FSF
@@ -160,22 +160,24 @@ One useful value to include is `turn-on-font-lock' to highlight the pieces."
160(defvar gomoku-emacs-won () 160(defvar gomoku-emacs-won ()
161 "For making font-lock use the winner's face for the line.") 161 "For making font-lock use the winner's face for the line.")
162 162
163(defface gomoku-font-lock-O-face 163(defface gomoku-O
164 '((((class color)) (:foreground "red" :weight bold))) 164 '((((class color)) (:foreground "red" :weight bold)))
165 "Face to use for Emacs' O." 165 "Face to use for Emacs' O."
166 :group 'gomoku) 166 :group 'gomoku)
167;; backward-compatibility alias
168(put 'gomoku-font-lock-O-face 'face-alias 'gomoku-O)
167 169
168(defface gomoku-font-lock-X-face 170(defface gomoku-X
169 '((((class color)) (:foreground "green" :weight bold))) 171 '((((class color)) (:foreground "green" :weight bold)))
170 "Face to use for your X." 172 "Face to use for your X."
171 :group 'gomoku) 173 :group 'gomoku)
174;; backward-compatibility alias
175(put 'gomoku-font-lock-X-face 'face-alias 'gomoku-X)
172 176
173(defvar gomoku-font-lock-keywords 177(defvar gomoku-font-lock-keywords
174 '(("O" . 'gomoku-font-lock-O-face) 178 '(("O" . 'gomoku-O)
175 ("X" . 'gomoku-font-lock-X-face) 179 ("X" . 'gomoku-X)
176 ("[-|/\\]" 0 (if gomoku-emacs-won 180 ("[-|/\\]" 0 (if gomoku-emacs-won 'gomoku-O 'gomoku-X)))
177 'gomoku-font-lock-O-face
178 'gomoku-font-lock-X-face)))
179 "*Font lock rules for Gomoku.") 181 "*Font lock rules for Gomoku.")
180 182
181(put 'gomoku-mode 'front-sticky 183(put 'gomoku-mode 'front-sticky
diff --git a/lisp/play/mpuz.el b/lisp/play/mpuz.el
index 849e87a28b0..e354da6a04b 100644
--- a/lisp/play/mpuz.el
+++ b/lisp/play/mpuz.el
@@ -57,28 +57,36 @@ t means never ding, and `error' means only ding on wrong input."
57 :type 'boolean 57 :type 'boolean
58 :group 'mpuz) 58 :group 'mpuz)
59 59
60(defface mpuz-unsolved-face 60(defface mpuz-unsolved
61 '((((class color)) (:foreground "red1" :bold t)) 61 '((((class color)) (:foreground "red1" :bold t))
62 (t (:bold t))) 62 (t (:bold t)))
63 "*Face to use for letters to be solved." 63 "*Face to use for letters to be solved."
64 :group 'mpuz) 64 :group 'mpuz)
65;; backward-compatibility alias
66(put 'mpuz-unsolved-face 'face-alias 'mpuz-unsolved)
65 67
66(defface mpuz-solved-face 68(defface mpuz-solved
67 '((((class color)) (:foreground "green1" :bold t)) 69 '((((class color)) (:foreground "green1" :bold t))
68 (t (:bold t))) 70 (t (:bold t)))
69 "*Face to use for solved digits." 71 "*Face to use for solved digits."
70 :group 'mpuz) 72 :group 'mpuz)
73;; backward-compatibility alias
74(put 'mpuz-solved-face 'face-alias 'mpuz-solved)
71 75
72(defface mpuz-trivial-face 76(defface mpuz-trivial
73 '((((class color)) (:foreground "blue" :bold t)) 77 '((((class color)) (:foreground "blue" :bold t))
74 (t (:bold t))) 78 (t (:bold t)))
75 "*Face to use for trivial digits solved for you." 79 "*Face to use for trivial digits solved for you."
76 :group 'mpuz) 80 :group 'mpuz)
81;; backward-compatibility alias
82(put 'mpuz-trivial-face 'face-alias 'mpuz-trivial)
77 83
78(defface mpuz-text-face 84(defface mpuz-text
79 '((t (:inherit variable-pitch))) 85 '((t (:inherit variable-pitch)))
80 "*Face to use for text on right." 86 "*Face to use for text on right."
81 :group 'mpuz) 87 :group 'mpuz)
88;; backward-compatibility alias
89(put 'mpuz-text-face 'face-alias 'mpuz-text)
82 90
83 91
84;; Mpuz mode and keymaps 92;; Mpuz mode and keymaps
@@ -296,7 +304,7 @@ You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]."
296(defun mpuz-create-buffer () 304(defun mpuz-create-buffer ()
297 "Create (or recreate) the puzzle buffer. Return it." 305 "Create (or recreate) the puzzle buffer. Return it."
298 (let ((buf (get-buffer-create "*Mult Puzzle*")) 306 (let ((buf (get-buffer-create "*Mult Puzzle*"))
299 (face '(face mpuz-text-face)) 307 (face '(face mpuz-text))
300 buffer-read-only) 308 buffer-read-only)
301 (save-excursion 309 (save-excursion
302 (set-buffer buf) 310 (set-buffer buf)
@@ -347,9 +355,9 @@ You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]."
347 (+ digit ?0) 355 (+ digit ?0)
348 (+ (mpuz-to-letter digit) ?A))) 356 (+ (mpuz-to-letter digit) ?A)))
349 (face `(face 357 (face `(face
350 ,(cond ((aref mpuz-trivial-digits digit) 'mpuz-trivial-face) 358 ,(cond ((aref mpuz-trivial-digits digit) 'mpuz-trivial)
351 ((aref mpuz-found-digits digit) 'mpuz-solved-face) 359 ((aref mpuz-found-digits digit) 'mpuz-solved)
352 ('mpuz-unsolved-face)))) 360 ('mpuz-unsolved))))
353 buffer-read-only) 361 buffer-read-only)
354 (mapc (lambda (square) 362 (mapc (lambda (square)
355 (goto-line (car square)) ; line before column! 363 (goto-line (car square)) ; line before column!
diff --git a/lisp/printing.el b/lisp/printing.el
index ddfe6fd5cc0..868ea3fddf3 100644
--- a/lisp/printing.el
+++ b/lisp/printing.el
@@ -1,17 +1,17 @@
1;;; printing.el --- printing utilities 1;;; printing.el --- printing utilities
2 2
3;; Copyright (C) 2000, 2001, 2002, 2003, 2004 3;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005
4;; Free Software Foundation, Inc. 4;; Free Software Foundation, Inc.
5 5
6;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> 6;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
7;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> 7;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
8;; Time-stamp: <2004/11/21 20:56:53 vinicius> 8;; Time-stamp: <2005/06/11 19:51:32 vinicius>
9;; Keywords: wp, print, PostScript 9;; Keywords: wp, print, PostScript
10;; Version: 6.8.3 10;; Version: 6.8.4
11;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/ 11;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
12 12
13(defconst pr-version "6.8.3" 13(defconst pr-version "6.8.4"
14 "printing.el, v 6.8.3 <2004/11/17 vinicius> 14 "printing.el, v 6.8.4 <2005/06/11 vinicius>
15 15
16Please send all bug fixes and enhancements to 16Please send all bug fixes and enhancements to
17 Vinicius Jose Latorre <viniciusjl@ig.com.br> 17 Vinicius Jose Latorre <viniciusjl@ig.com.br>
@@ -143,7 +143,7 @@ Please send all bug fixes and enhancements to
143;; One way to set variables is by calling `pr-customize', customize all 143;; One way to set variables is by calling `pr-customize', customize all
144;; variables and save the customization by future sessions (see Options 144;; variables and save the customization by future sessions (see Options
145;; section). Other way is by coding your settings on Emacs init file (that is, 145;; section). Other way is by coding your settings on Emacs init file (that is,
146;; .emacs file), see below for a first setting template that it should be 146;; ~/.emacs file), see below for a first setting template that it should be
147;; inserted on your ~/.emacs file (or c:/_emacs, if you're using Windows 9x/NT 147;; inserted on your ~/.emacs file (or c:/_emacs, if you're using Windows 9x/NT
148;; or MS-DOS): 148;; or MS-DOS):
149;; 149;;
@@ -259,9 +259,9 @@ Please send all bug fixes and enhancements to
259;; PostScript printer. So, please, don't include this printer in 259;; PostScript printer. So, please, don't include this printer in
260;; `pr-txt-printer-alist' (which see). 260;; `pr-txt-printer-alist' (which see).
261;; 261;;
262;; 5. Use gsprint instead of ghostscript to print monochrome PostScript files 262;; 5. You can use gsprint instead of ghostscript to print monochrome PostScript
263;; in Windows. The gsprint utility is faster than ghostscript to print 263;; files in Windows. The gsprint utility documentation says that it is more
264;; monochrome PostScript. 264;; efficient than ghostscript to print monochrome PostScript.
265;; 265;;
266;; To print non-monochrome PostScript file, the efficiency of ghostscript 266;; To print non-monochrome PostScript file, the efficiency of ghostscript
267;; is similar to gsprint. 267;; is similar to gsprint.
@@ -271,6 +271,31 @@ Please send all bug fixes and enhancements to
271;; For more information about gsprint see 271;; For more information about gsprint see
272;; `http://www.cs.wisc.edu/~ghost/gsview/gsprint.htm'. 272;; `http://www.cs.wisc.edu/~ghost/gsview/gsprint.htm'.
273;; 273;;
274;; As an example of gsprint declaration:
275;;
276;; (setq pr-ps-printer-alist
277;; '((A "gsprint" ("-all" "-twoup") "-printer " "my-b/w-printer-name")
278;; (B "gsprint" ("-all" "-twoup") nil "-printer my-b/w-printer-name")
279;; ;; some other printer declaration
280;; ))
281;;
282;; The example above declares that printer A prints all pages (-all) and two
283;; pages per sheet (-twoup). The printer B declaration does the same as the
284;; printer A declaration, the only difference is the printer name selection.
285;;
286;; There are other command line options like:
287;;
288;; -mono Render in monochrome as 1bit/pixel (only black and white).
289;; -grey Render in greyscale as 8bits/pixel.
290;; -color Render in color as 24bits/pixel.
291;;
292;; The default is `-mono'. So, printer A and B in the example above are
293;; using implicitly the `-mono' option. Note that in `-mono' no gray tone
294;; or color is printed, this includes the zebra stripes, that is, in `-mono'
295;; the zebra stripes are not printed.
296;;
297;; See also documentation for `pr-ps-printer-alist'.
298;;
274;; 299;;
275;; Using `printing' 300;; Using `printing'
276;; ---------------- 301;; ----------------
@@ -279,8 +304,10 @@ Please send all bug fixes and enhancements to
279;; using Windows 9x/NT or MS-DOS): 304;; using Windows 9x/NT or MS-DOS):
280;; 305;;
281;; (require 'printing) 306;; (require 'printing)
307;; ;; ...some user settings...
308;; (pr-update-menus t)
282;; 309;;
283;; When `printing' is loaded: 310;; During `pr-update-menus' evaluation:
284;; * On Emacs 20: 311;; * On Emacs 20:
285;; it replaces the Tools/Print menu by Tools/Printing menu. 312;; it replaces the Tools/Print menu by Tools/Printing menu.
286;; * On Emacs 21: 313;; * On Emacs 21:
@@ -885,6 +912,7 @@ Please send all bug fixes and enhancements to
885;; (lps_06b "print" nil nil "\\\\printers\\lps_06b") 912;; (lps_06b "print" nil nil "\\\\printers\\lps_06b")
886;; (lps_07c "print" nil "" "/D:\\\\printers\\lps_07c") 913;; (lps_07c "print" nil "" "/D:\\\\printers\\lps_07c")
887;; (lps_08c nil nil nil "\\\\printers\\lps_08c") 914;; (lps_08c nil nil nil "\\\\printers\\lps_08c")
915;; (b/w "gsprint" ("-all" "-twoup") "-printer " "b/w-pr-name")
888;; (LPT1 "" nil "" "LPT1:") 916;; (LPT1 "" nil "" "LPT1:")
889;; (PRN "" nil "" "PRN") 917;; (PRN "" nil "" "PRN")
890;; (standard "redpr.exe" nil "" "") 918;; (standard "redpr.exe" nil "" "")
@@ -923,6 +951,9 @@ Please send all bug fixes and enhancements to
923;; 951;;
924;; `pr-update-menus' Update utility, PostScript and text printer menus. 952;; `pr-update-menus' Update utility, PostScript and text printer menus.
925;; 953;;
954;; `pr-menu-bind' Install `printing' menu in the menubar.
955;;
956;;
926;; Below are some URL where you can find good utilities. 957;; Below are some URL where you can find good utilities.
927;; 958;;
928;; * For `printing' package: 959;; * For `printing' package:
@@ -934,7 +965,7 @@ Please send all bug fixes and enhancements to
934;; 965;;
935;; gs, gv `http://www.gnu.org/software/ghostscript/ghostscript.html' 966;; gs, gv `http://www.gnu.org/software/ghostscript/ghostscript.html'
936;; enscript `http://people.ssh.fi/mtr/genscript/' 967;; enscript `http://people.ssh.fi/mtr/genscript/'
937;; psnup `http://www.dcs.ed.ac.uk/home/ajcd/psutils/index.html' 968;; psnup `http://www.knackered.org/angus/psutils/'
938;; mpage `http://www.mesa.nl/pub/mpage/' 969;; mpage `http://www.mesa.nl/pub/mpage/'
939;; 970;;
940;; * For Windows system: 971;; * For Windows system:
@@ -943,7 +974,7 @@ Please send all bug fixes and enhancements to
943;; `http://www.gnu.org/software/ghostscript/ghostscript.html' 974;; `http://www.gnu.org/software/ghostscript/ghostscript.html'
944;; gsprint `http://www.cs.wisc.edu/~ghost/gsview/gsprint.htm'. 975;; gsprint `http://www.cs.wisc.edu/~ghost/gsview/gsprint.htm'.
945;; enscript `http://people.ssh.fi/mtr/genscript/' 976;; enscript `http://people.ssh.fi/mtr/genscript/'
946;; psnup `http://www.dcs.ed.ac.uk/home/ajcd/psutils/index.html' 977;; psnup `http://gnuwin32.sourceforge.net/packages/psutils.htm'
947;; redmon `http://www.cs.wisc.edu/~ghost/redmon/' 978;; redmon `http://www.cs.wisc.edu/~ghost/redmon/'
948;; 979;;
949;; 980;;
@@ -1400,7 +1431,27 @@ Examples:
1400 (prt_07c nil nil \"/D:\\\\\\\\printers\\\\prt_07c\") 1431 (prt_07c nil nil \"/D:\\\\\\\\printers\\\\prt_07c\")
1401 (PRN \"\" nil \"PRN\") 1432 (PRN \"\" nil \"PRN\")
1402 (standard \"redpr.exe\" nil \"\") 1433 (standard \"redpr.exe\" nil \"\")
1403 )" 1434 )
1435
1436Useful links:
1437
1438* Information about the print command (print.exe)
1439 `http://www.computerhope.com/printhlp.htm'
1440
1441* RedMon - Redirection Port Monitor (redpr.exe)
1442 `http://www.cs.wisc.edu/~ghost/redmon/index.htm'
1443
1444* Redirection Port Monitor (redpr.exe on-line help)
1445 `http://www.cs.wisc.edu/~ghost/redmon/en/redmon.htm'
1446
1447* UNIX man pages: lpr (or type `man lpr')
1448 `http://bama.ua.edu/cgi-bin/man-cgi?lpr'
1449 `http://www.mediacollege.com/cgi-bin/man/page.cgi?section=all&topic=lpr'
1450
1451* UNIX man pages: lp (or type `man lp')
1452 `http://bama.ua.edu/cgi-bin/man-cgi?lp'
1453 `http://www.mediacollege.com/cgi-bin/man/page.cgi?section=all&topic=lp'
1454"
1404 :type '(repeat 1455 :type '(repeat
1405 (list :tag "Text Printer" 1456 (list :tag "Text Printer"
1406 (symbol :tag "Printer Symbol Name") 1457 (symbol :tag "Printer Symbol Name")
@@ -1448,6 +1499,7 @@ function (see it for documentation) to update PostScript printer menu."
1448 ;; (lps_06b "print" nil nil "\\\\printers\\lps_06b") 1499 ;; (lps_06b "print" nil nil "\\\\printers\\lps_06b")
1449 ;; (lps_07c "print" nil "" "/D:\\\\printers\\lps_07c") 1500 ;; (lps_07c "print" nil "" "/D:\\\\printers\\lps_07c")
1450 ;; (lps_08c nil nil nil "\\\\printers\\lps_08c") 1501 ;; (lps_08c nil nil nil "\\\\printers\\lps_08c")
1502 ;; (b/w "gsprint" ("-all" "-twoup") "-printer " "b/w-pr-name")
1451 ;; (LPT1 "" nil "" "LPT1:") 1503 ;; (LPT1 "" nil "" "LPT1:")
1452 ;; (PRN "" nil "" "PRN") 1504 ;; (PRN "" nil "" "PRN")
1453 ;; (standard "redpr.exe" nil "" "") 1505 ;; (standard "redpr.exe" nil "" "")
@@ -1486,6 +1538,7 @@ COMMAND Name of the program for printing a PostScript file. On MS-DOS
1486 \"lpr\" 1538 \"lpr\"
1487 \"lp\" 1539 \"lp\"
1488 \"cp\" 1540 \"cp\"
1541 \"gsprint\"
1489 1542
1490SWITCHES List of sexp's to pass as extra options for PostScript printer 1543SWITCHES List of sexp's to pass as extra options for PostScript printer
1491 program. It is recommended to set NAME (see text below) 1544 program. It is recommended to set NAME (see text below)
@@ -1495,6 +1548,9 @@ SWITCHES List of sexp's to pass as extra options for PostScript printer
1495 '(\"-#3\" \"-l\") 1548 '(\"-#3\" \"-l\")
1496 nil 1549 nil
1497 1550
1551 . for gsprint.exe
1552 '(\"-all\" \"-twoup\")
1553
1498PRINTER-SWITCH A string that specifies PostScript printer name switch. If 1554PRINTER-SWITCH A string that specifies PostScript printer name switch. If
1499 it's necessary to have a space between PRINTER-SWITCH and NAME, 1555 it's necessary to have a space between PRINTER-SWITCH and NAME,
1500 it should be inserted at the end of PRINTER-SWITCH string. 1556 it should be inserted at the end of PRINTER-SWITCH string.
@@ -1511,6 +1567,9 @@ PRINTER-SWITCH A string that specifies PostScript printer name switch. If
1511 . for print.exe 1567 . for print.exe
1512 \"/D:\" 1568 \"/D:\"
1513 1569
1570 . for gsprint.exe
1571 \"-printer \"
1572
1514NAME A string that specifies a PostScript printer name. 1573NAME A string that specifies a PostScript printer name.
1515 On Unix-like systems, a string value should be a name 1574 On Unix-like systems, a string value should be a name
1516 understood by lpr's -P option (or lp's -d option). 1575 understood by lpr's -P option (or lp's -d option).
@@ -1526,7 +1585,7 @@ NAME A string that specifies a PostScript printer name.
1526 . for cp.exe 1585 . for cp.exe
1527 \"\\\\\\\\host\\\\share-name\" 1586 \"\\\\\\\\host\\\\share-name\"
1528 1587
1529 . for print.exe 1588 . for print.exe or gsprint.exe
1530 \"/D:\\\\\\\\host\\\\share-name\" 1589 \"/D:\\\\\\\\host\\\\share-name\"
1531 \"\\\\\\\\host\\\\share-name\" 1590 \"\\\\\\\\host\\\\share-name\"
1532 \"LPT1:\" 1591 \"LPT1:\"
@@ -1575,10 +1634,80 @@ Examples:
1575 (lps_06b \"print\" nil nil \"\\\\\\\\printers\\\\lps_06b\") 1634 (lps_06b \"print\" nil nil \"\\\\\\\\printers\\\\lps_06b\")
1576 (lps_07c \"print\" nil \"\" \"/D:\\\\\\\\printers\\\\lps_07c\") 1635 (lps_07c \"print\" nil \"\" \"/D:\\\\\\\\printers\\\\lps_07c\")
1577 (lps_08c nil nil nil \"\\\\\\\\printers\\\\lps_08c\") 1636 (lps_08c nil nil nil \"\\\\\\\\printers\\\\lps_08c\")
1637 (b/w1 \"gsprint\" (\"-all\" \"-twoup\") \"-printer \" \"b/w-pr-name\")
1638 (b/w2 \"gsprint\" (\"-all\" \"-twoup\") nil \"-printer \\\\\\\\printers\\\\lps_06a\")
1578 (LPT1 \"\" nil \"\" \"LPT1:\") 1639 (LPT1 \"\" nil \"\" \"LPT1:\")
1579 (PRN \"\" nil \"\" \"PRN\") 1640 (PRN \"\" nil \"\" \"PRN\")
1580 (standard \"redpr.exe\" nil \"\" \"\") 1641 (standard \"redpr.exe\" nil \"\" \"\")
1581 )" 1642 )
1643
1644
1645gsprint:
1646
1647You can use gsprint instead of ghostscript to print monochrome PostScript files
1648in Windows. The gsprint utility documentation says that it is more efficient
1649than ghostscript to print monochrome PostScript.
1650
1651To print non-monochrome PostScript file, the efficiency of ghostscript is
1652similar to gsprint.
1653
1654Also the gsprint utility comes together with gsview distribution.
1655
1656As an example of gsprint declaration:
1657
1658 (setq pr-ps-printer-alist
1659 '((A \"gsprint\" (\"-all\" \"-twoup\") \"-printer \" \"lps_015\")
1660 (B \"gsprint\" (\"-all\" \"-twoup\") nil \"-printer lps_015\")
1661 ;; some other printer declaration
1662 ))
1663
1664The example above declares that printer A prints all pages (-all) and two pages
1665per sheet (-twoup). The printer B declaration does the same as the printer A
1666declaration, the only difference is the printer name selection.
1667
1668There are other command line options like:
1669
1670 -mono Render in monochrome as 1bit/pixel (only black and white).
1671 -grey Render in greyscale as 8bits/pixel.
1672 -color Render in color as 24bits/pixel.
1673
1674The default is `-mono'. So, printer A and B in the example above are using
1675implicitly the `-mono' option. Note that in `-mono' no gray tone or color is
1676printed, this includes the zebra stripes, that is, in `-mono' the zebra stripes
1677are not printed.
1678
1679
1680Useful links:
1681
1682* GSPRINT - Ghostscript print to Windows printer
1683 `http://www.cs.wisc.edu/~ghost/gsview/gsprint.htm'
1684
1685* Introduction to Ghostscript
1686 `http://www.cs.wisc.edu/~ghost/doc/intro.htm'
1687
1688* How to use Ghostscript
1689 `http://www.cs.wisc.edu/~ghost/doc/cvs/Use.htm'
1690
1691* Information about the print command (print.exe)
1692 `http://www.computerhope.com/printhlp.htm'
1693
1694* RedMon - Redirection Port Monitor (redpr.exe)
1695 `http://www.cs.wisc.edu/~ghost/redmon/index.htm'
1696
1697* Redirection Port Monitor (redpr.exe on-line help)
1698 `http://www.cs.wisc.edu/~ghost/redmon/en/redmon.htm'
1699
1700* UNIX man pages: lpr (or type `man lpr')
1701 `http://bama.ua.edu/cgi-bin/man-cgi?lpr'
1702 `http://www.mediacollege.com/cgi-bin/man/page.cgi?section=all&topic=lpr'
1703
1704* UNIX man pages: lp (or type `man lp')
1705 `http://bama.ua.edu/cgi-bin/man-cgi?lp'
1706 `http://www.mediacollege.com/cgi-bin/man/page.cgi?section=all&topic=lp'
1707
1708* GNU utilities for Win32 (cp.exe)
1709 `http://unxutils.sourceforge.net/'
1710"
1582 :type '(repeat 1711 :type '(repeat
1583 (list 1712 (list
1584 :tag "PostScript Printer" 1713 :tag "PostScript Printer"
@@ -1674,7 +1803,37 @@ See also `pr-temp-dir' and `pr-ps-temp-file'."
1674 "gv") 1803 "gv")
1675 "*Specify path and name of the gsview/gv utility. 1804 "*Specify path and name of the gsview/gv utility.
1676 1805
1677See also `pr-path-alist'." 1806See also `pr-path-alist'.
1807
1808Useful links:
1809
1810* GNU gv manual
1811 `http://www.gnu.org/software/gv/manual/gv.html'
1812
1813* GSview Help
1814 `http://www.cs.wisc.edu/~ghost/gsview/gsviewen.htm'
1815
1816* GSview Help - Common Problems
1817 `http://www.cs.wisc.edu/~ghost/gsview/gsviewen.htm#Common_Problems'
1818
1819* GSview Readme (compilation & installation)
1820 `http://www.cs.wisc.edu/~ghost/gsview/Readme.htm'
1821
1822* GSview (main site)
1823 `http://www.cs.wisc.edu/~ghost/gsview/index.htm'
1824
1825* Ghostscript, Ghostview and GSview
1826 `http://www.cs.wisc.edu/~ghost/'
1827
1828* Ghostview
1829 `http://www.cs.wisc.edu/~ghost/gv/index.htm'
1830
1831* gv 3.5, June 1997
1832 `http://www.cs.wisc.edu/~ghost/gv/gv_doc/gv.html'
1833
1834* MacGSView (MacOS)
1835 `http://www.cs.wisc.edu/~ghost/macos/index.htm'
1836"
1678 :type '(string :tag "Ghostview Utility") 1837 :type '(string :tag "Ghostview Utility")
1679 :version "20" 1838 :version "20"
1680 :group 'printing) 1839 :group 'printing)
@@ -1686,7 +1845,22 @@ See also `pr-path-alist'."
1686 "gs") 1845 "gs")
1687 "*Specify path and name of the ghostscript utility. 1846 "*Specify path and name of the ghostscript utility.
1688 1847
1689See also `pr-path-alist'." 1848See also `pr-path-alist'.
1849
1850Useful links:
1851
1852* Ghostscript, Ghostview and GSview
1853 `http://www.cs.wisc.edu/~ghost/'
1854
1855* Introduction to Ghostscript
1856 `http://www.cs.wisc.edu/~ghost/doc/intro.htm'
1857
1858* How to use Ghostscript
1859 `http://www.cs.wisc.edu/~ghost/doc/cvs/Use.htm'
1860
1861* Printer compatibility
1862 `http://www.cs.wisc.edu/~ghost/doc/printer.htm'
1863"
1690 :type '(string :tag "Ghostscript Utility") 1864 :type '(string :tag "Ghostscript Utility")
1691 :version "20" 1865 :version "20"
1692 :group 'printing) 1866 :group 'printing)
@@ -1717,7 +1891,19 @@ To see ghostscript documentation for more information:
1717 - for full documentation, see in a browser the file 1891 - for full documentation, see in a browser the file
1718 c:/gstools/gs5.50/index.html, that is, the file index.html which is 1892 c:/gstools/gs5.50/index.html, that is, the file index.html which is
1719 located in the same directory as gswin32.exe. 1893 located in the same directory as gswin32.exe.
1720 - for brief documentation, type: gswin32.exe -h" 1894 - for brief documentation, type: gswin32.exe -h
1895
1896Useful links:
1897
1898* Introduction to Ghostscript
1899 `http://www.cs.wisc.edu/~ghost/doc/intro.htm'
1900
1901* How to use Ghostscript
1902 `http://www.cs.wisc.edu/~ghost/doc/cvs/Use.htm'
1903
1904* Printer compatibility
1905 `http://www.cs.wisc.edu/~ghost/doc/printer.htm'
1906"
1721 :type '(repeat (string :tag "Ghostscript Switch")) 1907 :type '(repeat (string :tag "Ghostscript Switch"))
1722 :version "20" 1908 :version "20"
1723 :group 'printing) 1909 :group 'printing)
@@ -2184,7 +2370,35 @@ Examples:
2184 2370
2185 '((psnup \"c:/psutils/psnup\" (\"-q\") \"-P%s\" \"-%d\" \"-l\" nil nil \" \" 2371 '((psnup \"c:/psutils/psnup\" (\"-q\") \"-P%s\" \"-%d\" \"-l\" nil nil \" \"
2186 nil (pr-file-duplex . nil) (pr-file-tumble . nil)) 2372 nil (pr-file-duplex . nil) (pr-file-tumble . nil))
2187 )" 2373 )
2374
2375Useful links:
2376
2377* mpage download (GNU or Unix)
2378 `http://www.mesa.nl/pub/mpage/'
2379
2380* mpage documentation (GNU or Unix - or type `man mpage')
2381 `http://www.cs.umd.edu/faq/guides/manual_unix/node48.html'
2382 `http://www.rt.com/man/mpage.1.html'
2383
2384* psnup (Windows, GNU or Unix)
2385 `http://www.knackered.org/angus/psutils/'
2386 `http://gershwin.ens.fr/vdaniel/Doc-Locale/Outils-Gnu-Linux/PsUtils/'
2387
2388* psnup (PsUtils for Windows)
2389 `http://gnuwin32.sourceforge.net/packages/psutils.htm'
2390
2391* psnup documentation (GNU or Unix - or type `man psnup')
2392 `http://linux.about.com/library/cmd/blcmdl1_psnup.htm'
2393 `http://amath.colorado.edu/computing/software/man/psnup.html'
2394
2395* GNU Enscript (Windows, GNU or Unix)
2396 `http://people.ssh.com/mtr/genscript/'
2397
2398* GNU Enscript documentation (Windows, GNU or Unix)
2399 `http://people.ssh.com/mtr/genscript/enscript.man.html'
2400 (on GNU or Unix, type `man enscript')
2401"
2188 :type '(repeat 2402 :type '(repeat
2189 (list :tag "PS File Utility" 2403 (list :tag "PS File Utility"
2190 (symbol :tag "Utility Symbol") 2404 (symbol :tag "Utility Symbol")
@@ -2845,43 +3059,65 @@ See `pr-ps-printer-alist'.")
2845 ))) 3059 )))
2846 3060
2847 3061
2848(cond 3062(defvar pr-menu-print-item "print"
2849 ((featurep 'xemacs) ; XEmacs 3063 "Non-nil means that menu binding was not done.
2850 ;; Menu binding
2851 (pr-xemacs-global-menubar
2852 (pr-x-add-submenu nil (cons "Printing" pr-menu-spec) "Apps")))
2853 3064
3065Used by `pr-menu-bind' and `pr-update-menus'.")
2854 3066
2855 (t ; GNU Emacs 3067
2856 ;; Menu binding 3068(defun pr-menu-bind ()
2857 (require 'easymenu) 3069 "Install `printing' menu in the menubar.
2858 ;; Replace existing "print" item by "Printing" item. 3070
2859 ;; If you're changing this file, you'll load it a second, 3071On Emacs 20, it replaces the Tools/Print menu by Tools/Printing menu.
2860 ;; third... time, but "print" item exists only in the first load. 3072
2861 (defvar pr-menu-print-item "print") 3073On Emacs 21 and 22, it replaces the File/Print* menu entries by File/Print
3074menu.
3075
3076Calls `pr-update-menus' to adjust menus."
3077 (interactive)
2862 (cond 3078 (cond
2863 ;; Emacs 20 3079 ((featurep 'xemacs) ; XEmacs
2864 ((string< emacs-version "21.") 3080 ;; Menu binding
2865 (easy-menu-change '("tools") "Printing" pr-menu-spec pr-menu-print-item) 3081 (pr-xemacs-global-menubar
2866 (when pr-menu-print-item 3082 (pr-x-add-submenu nil (cons "Printing" pr-menu-spec) "Apps"))
2867 (easy-menu-remove-item nil '("tools") pr-menu-print-item) 3083 (setq pr-menu-print-item nil))
2868 (setq pr-menu-print-item nil 3084
2869 pr-menu-bar (vector 'menu-bar 'tools 3085
2870 (pr-get-symbol "Printing"))))) 3086 (t ; GNU Emacs
2871 ;; Emacs 21 3087 ;; Menu binding
2872 (pr-menu-print-item 3088 (require 'easymenu)
2873 (easy-menu-change '("file") "Print" pr-menu-spec "print-buffer") 3089 ;; Replace existing "print" item by "Printing" item.
2874 (let ((items '("print-buffer" "print-region" 3090 ;; If you're changing this file, you'll load it a second,
2875 "ps-print-buffer-faces" "ps-print-region-faces" 3091 ;; third... time, but "print" item exists only in the first load.
2876 "ps-print-buffer" "ps-print-region"))) 3092 (cond
2877 (while items 3093 ;; Emacs 20
2878 (easy-menu-remove-item nil '("file") (car items)) 3094 ((string< emacs-version "21.")
2879 (setq items (cdr items))) 3095 (easy-menu-change '("tools") "Printing" pr-menu-spec pr-menu-print-item)
2880 (setq pr-menu-print-item nil 3096 (when pr-menu-print-item
2881 pr-menu-bar (vector 'menu-bar 'file 3097 (easy-menu-remove-item nil '("tools") pr-menu-print-item)
2882 (pr-get-symbol "Print"))))) 3098 (setq pr-menu-print-item nil
2883 (t 3099 pr-menu-bar (vector 'menu-bar 'tools
2884 (easy-menu-change '("file") "Print" pr-menu-spec))))) 3100 (pr-get-symbol "Printing")))))
3101 ;; Emacs 21 & 22
3102 (t
3103 (let* ((has-file (lookup-key global-map (vector 'menu-bar 'file)))
3104 (item-file (if has-file '("file") '("files"))))
3105 (cond
3106 (pr-menu-print-item
3107 (easy-menu-change item-file "Print" pr-menu-spec "print-buffer")
3108 (let ((items '("print-buffer" "print-region"
3109 "ps-print-buffer-faces" "ps-print-region-faces"
3110 "ps-print-buffer" "ps-print-region")))
3111 (while items
3112 (easy-menu-remove-item nil item-file (car items))
3113 (setq items (cdr items)))
3114 (setq pr-menu-print-item nil
3115 pr-menu-bar (vector 'menu-bar
3116 (if has-file 'file 'files)
3117 (pr-get-symbol "Print")))))
3118 (t
3119 (easy-menu-change item-file "Print" pr-menu-spec))))))))
3120 (pr-update-menus t))
2885 3121
2886 3122
2887;; Key binding 3123;; Key binding
@@ -4712,12 +4948,20 @@ If FORCE is non-nil, update menus doesn't matter if `pr-ps-printer-alist',
4712otherwise, update PostScript printer menu iff `pr-ps-printer-menu-modified' is 4948otherwise, update PostScript printer menu iff `pr-ps-printer-menu-modified' is
4713non-nil, update text printer menu iff `pr-txt-printer-menu-modified' is 4949non-nil, update text printer menu iff `pr-txt-printer-menu-modified' is
4714non-nil, and update PostScript File menus iff `pr-ps-utility-menu-modified' is 4950non-nil, and update PostScript File menus iff `pr-ps-utility-menu-modified' is
4715non-nil." 4951non-nil.
4952
4953If menu binding was not done, calls `pr-menu-bind'."
4716 (interactive "P") 4954 (interactive "P")
4717 (pr-update-var 'pr-ps-name pr-ps-printer-alist) 4955 (if pr-menu-print-item ; since v6.8.4
4718 (pr-update-var 'pr-txt-name pr-txt-printer-alist) 4956 ;; There was no menu binding yet, so do it now!
4719 (pr-update-var 'pr-ps-utility pr-ps-utility-alist) 4957 ;; This is a hack to be compatible with old versions of printing.
4720 (pr-do-update-menus force)) 4958 ;; So, user does not need to change printing calling in init files.
4959 (pr-menu-bind)
4960 ;; Here menu binding is ok.
4961 (pr-update-var 'pr-ps-name pr-ps-printer-alist)
4962 (pr-update-var 'pr-txt-name pr-txt-printer-alist)
4963 (pr-update-var 'pr-ps-utility pr-ps-utility-alist)
4964 (pr-do-update-menus force)))
4721 4965
4722 4966
4723(defvar pr-ps-printer-menu-modified t 4967(defvar pr-ps-printer-menu-modified t
@@ -6434,9 +6678,6 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
6434;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 6678;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6435 6679
6436 6680
6437(pr-update-menus t)
6438
6439
6440(provide 'printing) 6681(provide 'printing)
6441 6682
6442 6683
diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el
index bc0edb1f047..ba4702d90a4 100644
--- a/lisp/progmodes/ada-mode.el
+++ b/lisp/progmodes/ada-mode.el
@@ -1462,7 +1462,7 @@ The standard casing rules will no longer apply to this word."
1462 (setq file-name (car ada-case-exception-file))) 1462 (setq file-name (car ada-case-exception-file)))
1463 (t 1463 (t
1464 (error (concat "No exception file specified. " 1464 (error (concat "No exception file specified. "
1465 "See variable ada-case-exception-file.")))) 1465 "See variable ada-case-exception-file"))))
1466 1466
1467 (set-syntax-table ada-mode-symbol-syntax-table) 1467 (set-syntax-table ada-mode-symbol-syntax-table)
1468 (unless word 1468 (unless word
@@ -1501,7 +1501,7 @@ word itself has a special casing."
1501 (car ada-case-exception-file)) 1501 (car ada-case-exception-file))
1502 (t 1502 (t
1503 (error (concat "No exception file specified. " 1503 (error (concat "No exception file specified. "
1504 "See variable ada-case-exception-file.")))))) 1504 "See variable ada-case-exception-file"))))))
1505 1505
1506 ;; Find the substring to define as an exception. Order is: the parameter, 1506 ;; Find the substring to define as an exception. Order is: the parameter,
1507 ;; if any, or the selected region, or the word under the cursor 1507 ;; if any, or the selected region, or the word under the cursor
@@ -5398,7 +5398,7 @@ This function typically is to be hooked into `ff-file-created-hooks'."
5398 (setq body-file (ada-get-body-name)) 5398 (setq body-file (ada-get-body-name))
5399 (if body-file 5399 (if body-file
5400 (find-file body-file) 5400 (find-file body-file)
5401 (error "No body found for the package. Create it first.")) 5401 (error "No body found for the package. Create it first"))
5402 5402
5403 (save-restriction 5403 (save-restriction
5404 (widen) 5404 (widen)
diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el
index bdf376bfab7..89d167de25d 100644
--- a/lisp/progmodes/antlr-mode.el
+++ b/lisp/progmodes/antlr-mode.el
@@ -1,6 +1,6 @@
1;;; antlr-mode.el --- major mode for ANTLR grammar files 1;;; antlr-mode.el --- major mode for ANTLR grammar files
2 2
3;; Copyright (C) 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc. 3;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2005 Free Software Foundation, Inc.
4;; 4;;
5;; Author: Christoph.Wedler@sap.com 5;; Author: Christoph.Wedler@sap.com
6;; Keywords: languages, ANTLR, code generator 6;; Keywords: languages, ANTLR, code generator
@@ -827,58 +827,72 @@ font-lock keywords according to `font-lock-defaults' used for the code
827in the grammar's actions and semantic predicates, see 827in the grammar's actions and semantic predicates, see
828`antlr-font-lock-maximum-decoration'.") 828`antlr-font-lock-maximum-decoration'.")
829 829
830(defvar antlr-font-lock-default-face 'antlr-font-lock-default-face) 830(defvar antlr-default-face 'antlr-default)
831(defface antlr-font-lock-default-face nil 831(defface antlr-default
832 "Face to prevent strings from language dependent highlighting. 832 "Face to prevent strings from language dependent highlighting.
833Do not change." 833Do not change."
834 :group 'antlr) 834 :group 'antlr)
835;; backward-compatibility alias
836(put 'antlr-font-lock-default-face 'face-alias 'antlr-default)
835 837
836(defvar antlr-font-lock-keyword-face 'antlr-font-lock-keyword-face) 838(defvar antlr-keyword-face 'antlr-keyword)
837(defface antlr-font-lock-keyword-face 839(defface antlr-keyword
838 (cond-emacs-xemacs 840 (cond-emacs-xemacs
839 '((((class color) (background light)) 841 '((((class color) (background light))
840 (:foreground "black" :EMACS :weight bold :XEMACS :bold t)))) 842 (:foreground "black" :EMACS :weight bold :XEMACS :bold t))))
841 "ANTLR keywords." 843 "ANTLR keywords."
842 :group 'antlr) 844 :group 'antlr)
845;; backward-compatibility alias
846(put 'antlr-font-lock-keyword-face 'face-alias 'antlr-keyword)
843 847
844(defvar antlr-font-lock-syntax-face 'antlr-font-lock-keyword-face) 848(defvar antlr-syntax-face 'antlr-keyword)
845(defface antlr-font-lock-syntax-face 849(defface antlr-syntax
846 (cond-emacs-xemacs 850 (cond-emacs-xemacs
847 '((((class color) (background light)) 851 '((((class color) (background light))
848 (:foreground "black" :EMACS :weight bold :XEMACS :bold t)))) 852 (:foreground "black" :EMACS :weight bold :XEMACS :bold t))))
849 "ANTLR syntax symbols like :, |, (, ), ...." 853 "ANTLR syntax symbols like :, |, (, ), ...."
850 :group 'antlr) 854 :group 'antlr)
855;; backward-compatibility alias
856(put 'antlr-font-lock-syntax-face 'face-alias 'antlr-syntax)
851 857
852(defvar antlr-font-lock-ruledef-face 'antlr-font-lock-ruledef-face) 858(defvar antlr-ruledef-face 'antlr-ruledef)
853(defface antlr-font-lock-ruledef-face 859(defface antlr-ruledef
854 (cond-emacs-xemacs 860 (cond-emacs-xemacs
855 '((((class color) (background light)) 861 '((((class color) (background light))
856 (:foreground "blue" :EMACS :weight bold :XEMACS :bold t)))) 862 (:foreground "blue" :EMACS :weight bold :XEMACS :bold t))))
857 "ANTLR rule references (definition)." 863 "ANTLR rule references (definition)."
858 :group 'antlr) 864 :group 'antlr)
865;; backward-compatibility alias
866(put 'antlr-font-lock-ruledef-face 'face-alias 'antlr-ruledef)
859 867
860(defvar antlr-font-lock-tokendef-face 'antlr-font-lock-tokendef-face) 868(defvar antlr-tokendef-face 'antlr-tokendef)
861(defface antlr-font-lock-tokendef-face 869(defface antlr-tokendef
862 (cond-emacs-xemacs 870 (cond-emacs-xemacs
863 '((((class color) (background light)) 871 '((((class color) (background light))
864 (:foreground "blue" :EMACS :weight bold :XEMACS :bold t)))) 872 (:foreground "blue" :EMACS :weight bold :XEMACS :bold t))))
865 "ANTLR token references (definition)." 873 "ANTLR token references (definition)."
866 :group 'antlr) 874 :group 'antlr)
875;; backward-compatibility alias
876(put 'antlr-font-lock-tokendef-face 'face-alias 'antlr-tokendef)
867 877
868(defvar antlr-font-lock-ruleref-face 'antlr-font-lock-ruleref-face) 878(defvar antlr-ruleref-face 'antlr-ruleref)
869(defface antlr-font-lock-ruleref-face 879(defface antlr-ruleref
870 '((((class color) (background light)) (:foreground "blue4"))) 880 '((((class color) (background light)) (:foreground "blue4")))
871 "ANTLR rule references (usage)." 881 "ANTLR rule references (usage)."
872 :group 'antlr) 882 :group 'antlr)
883;; backward-compatibility alias
884(put 'antlr-font-lock-ruleref-face 'face-alias 'antlr-ruleref)
873 885
874(defvar antlr-font-lock-tokenref-face 'antlr-font-lock-tokenref-face) 886(defvar antlr-tokenref-face 'antlr-tokenref)
875(defface antlr-font-lock-tokenref-face 887(defface antlr-tokenref
876 '((((class color) (background light)) (:foreground "orange4"))) 888 '((((class color) (background light)) (:foreground "orange4")))
877 "ANTLR token references (usage)." 889 "ANTLR token references (usage)."
878 :group 'antlr) 890 :group 'antlr)
891;; backward-compatibility alias
892(put 'antlr-font-lock-tokenref-face 'face-alias 'antlr-tokenref)
879 893
880(defvar antlr-font-lock-literal-face 'antlr-font-lock-literal-face) 894(defvar antlr-literal-face 'antlr-literal)
881(defface antlr-font-lock-literal-face 895(defface antlr-literal
882 (cond-emacs-xemacs 896 (cond-emacs-xemacs
883 '((((class color) (background light)) 897 '((((class color) (background light))
884 (:foreground "brown4" :EMACS :weight bold :XEMACS :bold t)))) 898 (:foreground "brown4" :EMACS :weight bold :XEMACS :bold t))))
@@ -886,6 +900,8 @@ Do not change."
886It is used to highlight strings matched by the first regexp group of 900It is used to highlight strings matched by the first regexp group of
887`antlr-font-lock-literal-regexp'." 901`antlr-font-lock-literal-regexp'."
888 :group 'antlr) 902 :group 'antlr)
903;; backward-compatibility alias
904(put 'antlr-font-lock-literal-face 'face-alias 'antlr-literal)
889 905
890(defcustom antlr-font-lock-literal-regexp "\"\\(\\sw\\(\\sw\\|-\\)*\\)\"" 906(defcustom antlr-font-lock-literal-regexp "\"\\(\\sw\\(\\sw\\|-\\)*\\)\""
891 "Regexp matching literals with special syntax highlighting, or nil. 907 "Regexp matching literals with special syntax highlighting, or nil.
@@ -904,56 +920,56 @@ group. The string matched by the first group is highlighted with
904 (cond-emacs-xemacs 920 (cond-emacs-xemacs
905 `((antlr-invalidate-context-cache) 921 `((antlr-invalidate-context-cache)
906 ("\\$setType[ \t]*(\\([A-Za-z\300-\326\330-\337]\\sw*\\))" 922 ("\\$setType[ \t]*(\\([A-Za-z\300-\326\330-\337]\\sw*\\))"
907 (1 antlr-font-lock-tokendef-face)) 923 (1 antlr-tokendef-face))
908 ("\\$\\sw+" (0 font-lock-keyword-face)) 924 ("\\$\\sw+" (0 keyword-face))
909 ;; the tokens are already fontified as string/docstrings: 925 ;; the tokens are already fontified as string/docstrings:
910 (,(lambda (limit) 926 (,(lambda (limit)
911 (if antlr-font-lock-literal-regexp 927 (if antlr-literal-regexp
912 (antlr-re-search-forward antlr-font-lock-literal-regexp limit))) 928 (antlr-re-search-forward antlr-font-lock-literal-regexp limit)))
913 (1 antlr-font-lock-literal-face t) 929 (1 antlr-literal-face t)
914 :XEMACS (0 nil)) ; XEmacs bug workaround 930 :XEMACS (0 nil)) ; XEmacs bug workaround
915 (,(lambda (limit) 931 (,(lambda (limit)
916 (antlr-re-search-forward antlr-class-header-regexp limit)) 932 (antlr-re-search-forward antlr-class-header-regexp limit))
917 (1 antlr-font-lock-keyword-face) 933 (1 antlr-keyword-face)
918 (2 antlr-font-lock-ruledef-face) 934 (2 antlr-ruledef-face)
919 (3 antlr-font-lock-keyword-face) 935 (3 antlr-keyword-face)
920 (4 (if (member (match-string 4) '("Lexer" "Parser" "TreeParser")) 936 (4 (if (member (match-string 4) '("Lexer" "Parser" "TreeParser"))
921 'antlr-font-lock-keyword-face 937 antlr-keyword-face
922 'font-lock-type-face))) 938 type-face)))
923 (,(lambda (limit) 939 (,(lambda (limit)
924 (antlr-re-search-forward 940 (antlr-re-search-forward
925 "\\<\\(header\\|options\\|tokens\\|exception\\|catch\\|returns\\)\\>" 941 "\\<\\(header\\|options\\|tokens\\|exception\\|catch\\|returns\\)\\>"
926 limit)) 942 limit))
927 (1 antlr-font-lock-keyword-face)) 943 (1 antlr-keyword-face))
928 (,(lambda (limit) 944 (,(lambda (limit)
929 (antlr-re-search-forward 945 (antlr-re-search-forward
930 "^\\(private\\|public\\|protected\\)\\>[ \t]*\\(\\(\\sw+[ \t]*\\(:\\)?\\)\\)?" 946 "^\\(private\\|public\\|protected\\)\\>[ \t]*\\(\\(\\sw+[ \t]*\\(:\\)?\\)\\)?"
931 limit)) 947 limit))
932 (1 font-lock-type-face) ; not XEmacs' java level-3 fruit salad 948 (1 font-lock-type-face) ; not XEmacs' java level-3 fruit salad
933 (3 (if (antlr-upcase-p (char-after (match-beginning 3))) 949 (3 (if (antlr-upcase-p (char-after (match-beginning 3)))
934 'antlr-font-lock-tokendef-face 950 antlr-tokendef-face
935 'antlr-font-lock-ruledef-face) nil t) 951 antlr-ruledef-face) nil t)
936 (4 antlr-font-lock-syntax-face nil t)) 952 (4 antlr-syntax-face nil t))
937 (,(lambda (limit) 953 (,(lambda (limit)
938 (antlr-re-search-forward "^\\(\\sw+\\)[ \t]*\\(:\\)?" limit)) 954 (antlr-re-search-forward "^\\(\\sw+\\)[ \t]*\\(:\\)?" limit))
939 (1 (if (antlr-upcase-p (char-after (match-beginning 0))) 955 (1 (if (antlr-upcase-p (char-after (match-beginning 0)))
940 'antlr-font-lock-tokendef-face 956 antlr-tokendef-face
941 'antlr-font-lock-ruledef-face) nil t) 957 antlr-ruledef-face) nil t)
942 (2 antlr-font-lock-syntax-face nil t)) 958 (2 antlr-syntax-face nil t))
943 (,(lambda (limit) 959 (,(lambda (limit)
944 ;; v:ruleref and v:"literal" is allowed... 960 ;; v:ruleref and v:"literal" is allowed...
945 (antlr-re-search-forward "\\(\\sw+\\)[ \t]*\\([=:]\\)?" limit)) 961 (antlr-re-search-forward "\\(\\sw+\\)[ \t]*\\([=:]\\)?" limit))
946 (1 (if (match-beginning 2) 962 (1 (if (match-beginning 2)
947 (if (eq (char-after (match-beginning 2)) ?=) 963 (if (eq (char-after (match-beginning 2)) ?=)
948 'antlr-font-lock-default-face 964 antlr-default-face
949 'font-lock-variable-name-face) 965 font-lock-variable-name-face)
950 (if (antlr-upcase-p (char-after (match-beginning 1))) 966 (if (antlr-upcase-p (char-after (match-beginning 1)))
951 'antlr-font-lock-tokenref-face 967 antlr-tokenref-face
952 'antlr-font-lock-ruleref-face))) 968 antlr-ruleref-face)))
953 (2 antlr-font-lock-default-face nil t)) 969 (2 antlr-default-face nil t))
954 (,(lambda (limit) 970 (,(lambda (limit)
955 (antlr-re-search-forward "[|&:;(~]\\|)\\([*+?]\\|=>\\)?" limit)) 971 (antlr-re-search-forward "[|&:;(~]\\|)\\([*+?]\\|=>\\)?" limit))
956 (0 'antlr-font-lock-syntax-face)))) 972 (0 antlr-syntax-face))))
957 "Font-lock keywords for ANTLR's normal grammar code. 973 "Font-lock keywords for ANTLR's normal grammar code.
958See `antlr-font-lock-keywords-alist' for the keywords of actions.") 974See `antlr-font-lock-keywords-alist' for the keywords of actions.")
959 975
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 0cb87a5b17a..3f3b385c5ed 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -231,9 +231,9 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
231 231
232 (makepp 232 (makepp
233 "^makepp: \\(?:\\(?:warning\\(:\\).*?\\|\\(Scanning\\|[LR]e?l?oading makefile\\) \\|.*?\\)\ 233 "^makepp: \\(?:\\(?:warning\\(:\\).*?\\|\\(Scanning\\|[LR]e?l?oading makefile\\) \\|.*?\\)\
234`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)'\\)" 234`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)['(]\\)"
235 4 5 nil (1 . 2) 3 235 4 5 nil (1 . 2) 3
236 ("`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)'" nil nil 236 ("`\\(\\(\\S +?\\)\\(?::\\([0-9]+\\)\\)?\\)['(]" nil nil
237 (2 compilation-info-face) 237 (2 compilation-info-face)
238 (3 compilation-line-face nil t) 238 (3 compilation-line-face nil t)
239 (1 (compilation-error-properties 2 3 nil nil nil 0 nil) 239 (1 (compilation-error-properties 2 3 nil nil nil 0 nil)
@@ -246,8 +246,8 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
246 " in \\([^()\n ]+\\)(\\([0-9]+\\))$" 1 2) 246 " in \\([^()\n ]+\\)(\\([0-9]+\\))$" 1 2)
247 247
248 (msft 248 (msft
249 "^\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \ 249 "^\\([0-9]+>\\)?\\(\\(?:[a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) \
250: \\(?:error\\|warnin\\(g\\)\\) C[0-9]+:" 1 2 nil (3)) 250: \\(?:error\\|warnin\\(g\\)\\) C[0-9]+:" 2 3 nil (4))
251 251
252 (oracle 252 (oracle
253 "^\\(?:Semantic error\\|Error\\|PCC-[0-9]+:\\).* line \\([0-9]+\\)\ 253 "^\\(?:Semantic error\\|Error\\|PCC-[0-9]+:\\).* line \\([0-9]+\\)\
@@ -468,15 +468,17 @@ starting the compilation process.")
468;; History of compile commands. 468;; History of compile commands.
469(defvar compile-history nil) 469(defvar compile-history nil)
470 470
471(defface compilation-warning-face 471(defface compilation-warning
472 '((((class color) (min-colors 16)) (:foreground "Orange" :weight bold)) 472 '((((class color) (min-colors 16)) (:foreground "Orange" :weight bold))
473 (((class color)) (:foreground "cyan" :weight bold)) 473 (((class color)) (:foreground "cyan" :weight bold))
474 (t (:weight bold))) 474 (t (:weight bold)))
475 "Face used to highlight compiler warnings." 475 "Face used to highlight compiler warnings."
476 :group 'font-lock-highlighting-faces 476 :group 'font-lock-highlighting-faces
477 :version "22.1") 477 :version "22.1")
478;; backward-compatibility alias
479(put 'compilation-warning-face 'face-alias 'compilation-warning)
478 480
479(defface compilation-info-face 481(defface compilation-info
480 '((((class color) (min-colors 16) (background light)) 482 '((((class color) (min-colors 16) (background light))
481 (:foreground "Green3" :weight bold)) 483 (:foreground "Green3" :weight bold))
482 (((class color) (min-colors 88) (background dark)) 484 (((class color) (min-colors 88) (background dark))
@@ -488,6 +490,8 @@ starting the compilation process.")
488 "Face used to highlight compiler warnings." 490 "Face used to highlight compiler warnings."
489 :group 'font-lock-highlighting-faces 491 :group 'font-lock-highlighting-faces
490 :version "22.1") 492 :version "22.1")
493;; backward-compatibility alias
494(put 'compilation-info-face 'face-alias 'compilation-info)
491 495
492(defvar compilation-message-face nil 496(defvar compilation-message-face nil
493 "Face name to use for whole messages. 497 "Face name to use for whole messages.
@@ -498,10 +502,10 @@ Faces `compilation-error-face', `compilation-warning-face',
498(defvar compilation-error-face 'font-lock-warning-face 502(defvar compilation-error-face 'font-lock-warning-face
499 "Face name to use for file name in error messages.") 503 "Face name to use for file name in error messages.")
500 504
501(defvar compilation-warning-face 'compilation-warning-face 505(defvar compilation-warning-face 'compilation-warning
502 "Face name to use for file name in warning messages.") 506 "Face name to use for file name in warning messages.")
503 507
504(defvar compilation-info-face 'compilation-info-face 508(defvar compilation-info-face 'compilation-info
505 "Face name to use for file name in informational messages.") 509 "Face name to use for file name in informational messages.")
506 510
507(defvar compilation-line-face 'font-lock-variable-name-face 511(defvar compilation-line-face 'font-lock-variable-name-face
@@ -935,6 +939,7 @@ Returns the compilation buffer created."
935 (substitute-env-vars (match-string 1 command)) 939 (substitute-env-vars (match-string 1 command))
936 "~") 940 "~")
937 default-directory)) 941 default-directory))
942 (erase-buffer)
938 ;; Select the desired mode. 943 ;; Select the desired mode.
939 (if (not (eq mode t)) 944 (if (not (eq mode t))
940 (funcall mode) 945 (funcall mode)
@@ -944,11 +949,11 @@ Returns the compilation buffer created."
944 (if highlight-regexp 949 (if highlight-regexp
945 (set (make-local-variable 'compilation-highlight-regexp) 950 (set (make-local-variable 'compilation-highlight-regexp)
946 highlight-regexp)) 951 highlight-regexp))
947 (erase-buffer)
948 ;; Output a mode setter, for saving and later reloading this buffer. 952 ;; Output a mode setter, for saving and later reloading this buffer.
949 (insert "-*- mode: " name-of-mode 953 (insert "-*- mode: " name-of-mode
950 "; default-directory: " (prin1-to-string default-directory) 954 "; default-directory: " (prin1-to-string default-directory)
951 " -*-\n" command "\n") (setq thisdir default-directory)) 955 " -*-\n" command "\n")
956 (setq thisdir default-directory))
952 (set-buffer-modified-p nil)) 957 (set-buffer-modified-p nil))
953 ;; If we're already in the compilation buffer, go to the end 958 ;; If we're already in the compilation buffer, go to the end
954 ;; of the buffer, so point will track the compilation output. 959 ;; of the buffer, so point will track the compilation output.
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 4abd8123e6a..9826c995b97 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -343,7 +343,7 @@ Affects: `cperl-font-lock', `cperl-electric-lbrace-space',
343 :group 'cperl-indentation-details) 343 :group 'cperl-indentation-details)
344 344
345(defvar cperl-vc-header-alist nil) 345(defvar cperl-vc-header-alist nil)
346(make-obsolete-variable 346(make-obsolete-variable
347 'cperl-vc-header-alist 347 'cperl-vc-header-alist
348 "use cperl-vc-rcs-header or cperl-vc-sccs-header instead.") 348 "use cperl-vc-rcs-header or cperl-vc-sccs-header instead.")
349 349
@@ -369,7 +369,7 @@ Affects: `cperl-font-lock', `cperl-electric-lbrace-space',
369 369
370(defcustom cperl-info-on-command-no-prompt nil 370(defcustom cperl-info-on-command-no-prompt nil
371 "*Not-nil (and non-null) means not to prompt on C-h f. 371 "*Not-nil (and non-null) means not to prompt on C-h f.
372The opposite behaviour is always available if prefixed with C-c. 372The opposite behavior is always available if prefixed with C-c.
373Can be overwritten by `cperl-hairy' if nil." 373Can be overwritten by `cperl-hairy' if nil."
374 :type '(choice (const null) boolean) 374 :type '(choice (const null) boolean)
375 :group 'cperl-affected-by-hairy) 375 :group 'cperl-affected-by-hairy)
@@ -564,11 +564,11 @@ when syntaxifying a chunk of buffer."
564 (font-lock-variable-name-face nil nil bold) 564 (font-lock-variable-name-face nil nil bold)
565 (font-lock-function-name-face nil nil bold italic box) 565 (font-lock-function-name-face nil nil bold italic box)
566 (font-lock-constant-face nil "LightGray" bold) 566 (font-lock-constant-face nil "LightGray" bold)
567 (cperl-array-face nil "LightGray" bold underline) 567 (cperl-array nil "LightGray" bold underline)
568 (cperl-hash-face nil "LightGray" bold italic underline) 568 (cperl-hash nil "LightGray" bold italic underline)
569 (font-lock-comment-face nil "LightGray" italic) 569 (font-lock-comment-face nil "LightGray" italic)
570 (font-lock-string-face nil nil italic underline) 570 (font-lock-string-face nil nil italic underline)
571 (cperl-nonoverridable-face nil nil italic underline) 571 (cperl-nonoverridable nil nil italic underline)
572 (font-lock-type-face nil nil underline) 572 (font-lock-type-face nil nil underline)
573 (underline nil "LightGray" strikeout)) 573 (underline nil "LightGray" strikeout))
574 "List given as an argument to `ps-extend-face-list' in `cperl-ps-print'." 574 "List given as an argument to `ps-extend-face-list' in `cperl-ps-print'."
@@ -583,7 +583,7 @@ when syntaxifying a chunk of buffer."
583(defvar cperl-dark-foreground 583(defvar cperl-dark-foreground
584 (cperl-choose-color "orchid1" "orange")) 584 (cperl-choose-color "orchid1" "orange"))
585 585
586(defface cperl-nonoverridable-face 586(defface cperl-nonoverridable
587 `((((class grayscale) (background light)) 587 `((((class grayscale) (background light))
588 (:background "Gray90" :slant italic :underline t)) 588 (:background "Gray90" :slant italic :underline t))
589 (((class grayscale) (background dark)) 589 (((class grayscale) (background dark))
@@ -595,8 +595,10 @@ when syntaxifying a chunk of buffer."
595 (t (:weight bold :underline t))) 595 (t (:weight bold :underline t)))
596 "Font Lock mode face used non-overridable keywords and modifiers of regexps." 596 "Font Lock mode face used non-overridable keywords and modifiers of regexps."
597 :group 'cperl-faces) 597 :group 'cperl-faces)
598;; backward-compatibility alias
599(put 'cperl-nonoverridable-face 'face-alias 'cperl-nonoverridable)
598 600
599(defface cperl-array-face 601(defface cperl-array
600 `((((class grayscale) (background light)) 602 `((((class grayscale) (background light))
601 (:background "Gray90" :weight bold)) 603 (:background "Gray90" :weight bold))
602 (((class grayscale) (background dark)) 604 (((class grayscale) (background dark))
@@ -608,8 +610,10 @@ when syntaxifying a chunk of buffer."
608 (t (:weight bold))) 610 (t (:weight bold)))
609 "Font Lock mode face used to highlight array names." 611 "Font Lock mode face used to highlight array names."
610 :group 'cperl-faces) 612 :group 'cperl-faces)
613;; backward-compatibility alias
614(put 'cperl-array-face 'face-alias 'cperl-array)
611 615
612(defface cperl-hash-face 616(defface cperl-hash
613 `((((class grayscale) (background light)) 617 `((((class grayscale) (background light))
614 (:background "Gray90" :weight bold :slant italic)) 618 (:background "Gray90" :weight bold :slant italic))
615 (((class grayscale) (background dark)) 619 (((class grayscale) (background dark))
@@ -621,6 +625,8 @@ when syntaxifying a chunk of buffer."
621 (t (:weight bold :slant italic))) 625 (t (:weight bold :slant italic)))
622 "Font Lock mode face used to highlight hash names." 626 "Font Lock mode face used to highlight hash names."
623 :group 'cperl-faces) 627 :group 'cperl-faces)
628;; backward-compatibility alias
629(put 'cperl-hash-face 'face-alias 'cperl-hash)
624 630
625 631
626 632
@@ -867,8 +873,8 @@ B) Speed of editing operations.
867(defvar cperl-tips-faces 'please-ignore-this-line 873(defvar cperl-tips-faces 'please-ignore-this-line
868 "CPerl mode uses following faces for highlighting: 874 "CPerl mode uses following faces for highlighting:
869 875
870 `cperl-array-face' Array names 876 `cperl-array' Array names
871 `cperl-hash-face' Hash names 877 `cperl-hash' Hash names
872 `font-lock-comment-face' Comments, PODs and whatever is considered 878 `font-lock-comment-face' Comments, PODs and whatever is considered
873 syntaxically to be not code 879 syntaxically to be not code
874 `font-lock-constant-face' HERE-doc delimiters, labels, delimiters of 880 `font-lock-constant-face' HERE-doc delimiters, labels, delimiters of
@@ -879,7 +885,7 @@ B) Speed of editing operations.
879 (except those conflicting with Perl operators), 885 (except those conflicting with Perl operators),
880 package names (when recognized), format names 886 package names (when recognized), format names
881 `font-lock-keyword-face' Control flow switch constructs, declarators 887 `font-lock-keyword-face' Control flow switch constructs, declarators
882 `cperl-nonoverridable-face' Non-overridable keywords, modifiers of RExen 888 `cperl-nonoverridable' Non-overridable keywords, modifiers of RExen
883 `font-lock-string-face' Strings, qw() constructs, RExen, POD sections, 889 `font-lock-string-face' Strings, qw() constructs, RExen, POD sections,
884 literal parts and the terminator of formats 890 literal parts and the terminator of formats
885 and whatever is syntaxically considered 891 and whatever is syntaxically considered
@@ -887,7 +893,7 @@ B) Speed of editing operations.
887 `font-lock-type-face' Overridable keywords 893 `font-lock-type-face' Overridable keywords
888 `font-lock-variable-name-face' Variable declarations, indirect array and 894 `font-lock-variable-name-face' Variable declarations, indirect array and
889 hash names, POD headers/item names 895 hash names, POD headers/item names
890 `cperl-invalid-face' Trailing whitespace 896 `cperl-invalid' Trailing whitespace
891 897
892Note that in several situations the highlighting tries to inform about 898Note that in several situations the highlighting tries to inform about
893possible confusion, such as different colors for function names in 899possible confusion, such as different colors for function names in
@@ -1303,7 +1309,7 @@ you type it inside the inline block of control construct, like
1303and you are on a boundary of a statement inside braces, it will 1309and you are on a boundary of a statement inside braces, it will
1304transform the construct into a multiline and will place you into an 1310transform the construct into a multiline and will place you into an
1305appropriately indented blank line. If you need a usual 1311appropriately indented blank line. If you need a usual
1306`newline-and-indent' behaviour, it is on \\[newline-and-indent], 1312`newline-and-indent' behavior, it is on \\[newline-and-indent],
1307see documentation on `cperl-electric-linefeed'. 1313see documentation on `cperl-electric-linefeed'.
1308 1314
1309Use \\[cperl-invert-if-unless] to change a construction of the form 1315Use \\[cperl-invert-if-unless] to change a construction of the form
@@ -1481,7 +1487,7 @@ or as help on variables `cperl-tips', `cperl-problems',
1481 (make-local-variable 'comment-start-skip) 1487 (make-local-variable 'comment-start-skip)
1482 (setq comment-start-skip "#+ *") 1488 (setq comment-start-skip "#+ *")
1483 (make-local-variable 'defun-prompt-regexp) 1489 (make-local-variable 'defun-prompt-regexp)
1484 (setq defun-prompt-regexp "^[ \t]*sub[ \t\n]+\\([^ \t\n{(;]+\\)\\([ \t\n]*([^()]*)[ \t\n]*\\)?[ \t\n]*)") 1490 (setq defun-prompt-regexp "^[ \t]*sub[ \t\n]+\\([^ \t\n{(;]+\\)\\([ \t\n]*([^()]*)[ \t\n]*\\)?[ \t\n]*")
1485 (make-local-variable 'comment-indent-function) 1491 (make-local-variable 'comment-indent-function)
1486 (setq comment-indent-function 'cperl-comment-indent) 1492 (setq comment-indent-function 'cperl-comment-indent)
1487 (make-local-variable 'parse-sexp-ignore-comments) 1493 (make-local-variable 'parse-sexp-ignore-comments)
@@ -3167,7 +3173,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
3167 (cperl-nonoverridable-face 3173 (cperl-nonoverridable-face
3168 (if (boundp 'cperl-nonoverridable-face) 3174 (if (boundp 'cperl-nonoverridable-face)
3169 cperl-nonoverridable-face 3175 cperl-nonoverridable-face
3170 'cperl-nonoverridable-face)) 3176 'cperl-nonoverridable))
3171 (stop-point (if ignore-max 3177 (stop-point (if ignore-max
3172 (point-max) 3178 (point-max)
3173 max)) 3179 max))
@@ -3661,7 +3667,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
3661 (forward-word 1) ; skip modifiers s///s 3667 (forward-word 1) ; skip modifiers s///s
3662 (if tail (cperl-commentify tail (point) t)) 3668 (if tail (cperl-commentify tail (point) t))
3663 (cperl-postpone-fontification 3669 (cperl-postpone-fontification
3664 e1 (point) 'face 'cperl-nonoverridable-face))) 3670 e1 (point) 'face 'cperl-nonoverridable)))
3665 ;; Check whether it is m// which means "previous match" 3671 ;; Check whether it is m// which means "previous match"
3666 ;; and highlight differently 3672 ;; and highlight differently
3667 (setq is-REx 3673 (setq is-REx
@@ -4710,7 +4716,7 @@ indentation and initial hashes. Behaves usually outside of comment."
4710 "u\\(se\\|n\\(shift\\|ti\\(l\\|e\\)\\|def\\|less\\)\\)\\|" 4716 "u\\(se\\|n\\(shift\\|ti\\(l\\|e\\)\\|def\\|less\\)\\)\\|"
4711 "while\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually 4717 "while\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually
4712 "\\|[sm]" ; Added manually 4718 "\\|[sm]" ; Added manually
4713 "\\)\\>") 2 'cperl-nonoverridable-face) 4719 "\\)\\>") 2 'cperl-nonoverridable)
4714 ;; (mapconcat 'identity 4720 ;; (mapconcat 'identity
4715 ;; '("#endif" "#else" "#ifdef" "#ifndef" "#if" 4721 ;; '("#endif" "#else" "#ifdef" "#ifndef" "#if"
4716 ;; "#include" "#define" "#undef") 4722 ;; "#include" "#define" "#undef")
@@ -4773,15 +4779,15 @@ indentation and initial hashes. Behaves usually outside of comment."
4773 '( 4779 '(
4774 ("\\(\\([@%]\\|\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1 4780 ("\\(\\([@%]\\|\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1
4775 (if (eq (char-after (match-beginning 2)) ?%) 4781 (if (eq (char-after (match-beginning 2)) ?%)
4776 cperl-hash-face 4782 'cperl-hash
4777 cperl-array-face) 4783 'cperl-array)
4778 t) ; arrays and hashes 4784 t) ; arrays and hashes
4779 ("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)" 4785 ("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)"
4780 1 4786 1
4781 (if (= (- (match-end 2) (match-beginning 2)) 1) 4787 (if (= (- (match-end 2) (match-beginning 2)) 1)
4782 (if (eq (char-after (match-beginning 3)) ?{) 4788 (if (eq (char-after (match-beginning 3)) ?{)
4783 cperl-hash-face 4789 'cperl-hash
4784 cperl-array-face) ; arrays and hashes 4790 'cperl-array) ; arrays and hashes
4785 font-lock-variable-name-face) ; Just to put something 4791 font-lock-variable-name-face) ; Just to put something
4786 t) 4792 t)
4787 ;;("\\([smy]\\|tr\\)\\([^a-z_A-Z0-9]\\)\\(\\([^\n\\]*||\\)\\)\\2") 4793 ;;("\\([smy]\\|tr\\)\\([^a-z_A-Z0-9]\\)\\(\\([^\n\\]*||\\)\\)\\2")
@@ -4854,21 +4860,21 @@ indentation and initial hashes. Behaves usually outside of comment."
4854 [nil nil t t t] 4860 [nil nil t t t]
4855 nil 4861 nil
4856 [nil nil t t t]) 4862 [nil nil t t t])
4857 (list 'cperl-nonoverridable-face 4863 (list 'cperl-nonoverridable
4858 ["chartreuse3" ("orchid1" "orange") 4864 ["chartreuse3" ("orchid1" "orange")
4859 nil "Gray80"] 4865 nil "Gray80"]
4860 [nil nil "gray90"] 4866 [nil nil "gray90"]
4861 [nil nil nil t t] 4867 [nil nil nil t t]
4862 [nil nil t t] 4868 [nil nil t t]
4863 [nil nil t t t]) 4869 [nil nil t t t])
4864 (list 'cperl-array-face 4870 (list 'cperl-array
4865 ["blue" "yellow" nil "Gray80"] 4871 ["blue" "yellow" nil "Gray80"]
4866 ["lightyellow2" ("navy" "os2blue" "darkgreen") 4872 ["lightyellow2" ("navy" "os2blue" "darkgreen")
4867 "gray90"] 4873 "gray90"]
4868 t 4874 t
4869 nil 4875 nil
4870 nil) 4876 nil)
4871 (list 'cperl-hash-face 4877 (list 'cperl-hash
4872 ["red" "red" nil "Gray80"] 4878 ["red" "red" nil "Gray80"]
4873 ["lightyellow2" ("navy" "os2blue" "darkgreen") 4879 ["lightyellow2" ("navy" "os2blue" "darkgreen")
4874 "gray90"] 4880 "gray90"]
@@ -4891,15 +4897,15 @@ indentation and initial hashes. Behaves usually outside of comment."
4891 "Face for variable names") 4897 "Face for variable names")
4892 (cperl-force-face font-lock-type-face 4898 (cperl-force-face font-lock-type-face
4893 "Face for data types") 4899 "Face for data types")
4894 (cperl-force-face cperl-nonoverridable-face 4900 (cperl-force-face cperl-nonoverridable
4895 "Face for data types from another group") 4901 "Face for data types from another group")
4896 (cperl-force-face font-lock-comment-face 4902 (cperl-force-face font-lock-comment-face
4897 "Face for comments") 4903 "Face for comments")
4898 (cperl-force-face font-lock-function-name-face 4904 (cperl-force-face font-lock-function-name-face
4899 "Face for function names") 4905 "Face for function names")
4900 (cperl-force-face cperl-hash-face 4906 (cperl-force-face cperl-hash
4901 "Face for hashes") 4907 "Face for hashes")
4902 (cperl-force-face cperl-array-face 4908 (cperl-force-face cperl-array
4903 "Face for arrays") 4909 "Face for arrays")
4904 ;;(defvar font-lock-constant-face 'font-lock-constant-face) 4910 ;;(defvar font-lock-constant-face 'font-lock-constant-face)
4905 ;;(defvar font-lock-variable-name-face 'font-lock-variable-name-face) 4911 ;;(defvar font-lock-variable-name-face 'font-lock-variable-name-face)
@@ -4909,7 +4915,7 @@ indentation and initial hashes. Behaves usually outside of comment."
4909 ;; "Face to use for data types.")) 4915 ;; "Face to use for data types."))
4910 ;;(or (boundp 'cperl-nonoverridable-face) 4916 ;;(or (boundp 'cperl-nonoverridable-face)
4911 ;; (defconst cperl-nonoverridable-face 4917 ;; (defconst cperl-nonoverridable-face
4912 ;; 'cperl-nonoverridable-face 4918 ;; 'cperl-nonoverridable
4913 ;; "Face to use for data types from another group.")) 4919 ;; "Face to use for data types from another group."))
4914 ;;(if (not cperl-xemacs-p) nil 4920 ;;(if (not cperl-xemacs-p) nil
4915 ;; (or (boundp 'font-lock-comment-face) 4921 ;; (or (boundp 'font-lock-comment-face)
@@ -4925,26 +4931,24 @@ indentation and initial hashes. Behaves usually outside of comment."
4925 ;; 'font-lock-function-name-face 4931 ;; 'font-lock-function-name-face
4926 ;; "Face to use for function names."))) 4932 ;; "Face to use for function names.")))
4927 (if (and 4933 (if (and
4928 (not (cperl-is-face 'cperl-array-face)) 4934 (not (cperl-is-face 'cperl-array))
4929 (cperl-is-face 'font-lock-emphasized-face)) 4935 (cperl-is-face 'font-lock-emphasized-face))
4930 (copy-face 'font-lock-emphasized-face 'cperl-array-face)) 4936 (copy-face 'font-lock-emphasized-face 'cperl-array))
4931 (if (and 4937 (if (and
4932 (not (cperl-is-face 'cperl-hash-face)) 4938 (not (cperl-is-face 'cperl-hash))
4933 (cperl-is-face 'font-lock-other-emphasized-face)) 4939 (cperl-is-face 'font-lock-other-emphasized-face))
4934 (copy-face 'font-lock-other-emphasized-face 4940 (copy-face 'font-lock-other-emphasized-face 'cperl-hash))
4935 'cperl-hash-face))
4936 (if (and 4941 (if (and
4937 (not (cperl-is-face 'cperl-nonoverridable-face)) 4942 (not (cperl-is-face 'cperl-nonoverridable))
4938 (cperl-is-face 'font-lock-other-type-face)) 4943 (cperl-is-face 'font-lock-other-type-face))
4939 (copy-face 'font-lock-other-type-face 4944 (copy-face 'font-lock-other-type-face 'cperl-nonoverridable))
4940 'cperl-nonoverridable-face))
4941 ;;(or (boundp 'cperl-hash-face) 4945 ;;(or (boundp 'cperl-hash-face)
4942 ;; (defconst cperl-hash-face 4946 ;; (defconst cperl-hash-face
4943 ;; 'cperl-hash-face 4947 ;; 'cperl-hash
4944 ;; "Face to use for hashes.")) 4948 ;; "Face to use for hashes."))
4945 ;;(or (boundp 'cperl-array-face) 4949 ;;(or (boundp 'cperl-array-face)
4946 ;; (defconst cperl-array-face 4950 ;; (defconst cperl-array-face
4947 ;; 'cperl-array-face 4951 ;; 'cperl-array
4948 ;; "Face to use for arrays.")) 4952 ;; "Face to use for arrays."))
4949 ;; Here we try to guess background 4953 ;; Here we try to guess background
4950 (let ((background 4954 (let ((background
@@ -4983,17 +4987,17 @@ indentation and initial hashes. Behaves usually outside of comment."
4983 "pink"))) 4987 "pink")))
4984 (t 4988 (t
4985 (set-face-background 'font-lock-type-face "gray90")))) 4989 (set-face-background 'font-lock-type-face "gray90"))))
4986 (if (cperl-is-face 'cperl-nonoverridable-face) 4990 (if (cperl-is-face 'cperl-nonoverridable)
4987 nil 4991 nil
4988 (copy-face 'font-lock-type-face 'cperl-nonoverridable-face) 4992 (copy-face 'font-lock-type-face 'cperl-nonoverridable)
4989 (cond 4993 (cond
4990 ((eq background 'light) 4994 ((eq background 'light)
4991 (set-face-foreground 'cperl-nonoverridable-face 4995 (set-face-foreground 'cperl-nonoverridable
4992 (if (x-color-defined-p "chartreuse3") 4996 (if (x-color-defined-p "chartreuse3")
4993 "chartreuse3" 4997 "chartreuse3"
4994 "chartreuse"))) 4998 "chartreuse")))
4995 ((eq background 'dark) 4999 ((eq background 'dark)
4996 (set-face-foreground 'cperl-nonoverridable-face 5000 (set-face-foreground 'cperl-nonoverridable
4997 (if (x-color-defined-p "orchid1") 5001 (if (x-color-defined-p "orchid1")
4998 "orchid1" 5002 "orchid1"
4999 "orange"))))) 5003 "orange")))))
@@ -5045,20 +5049,15 @@ indentation and initial hashes. Behaves usually outside of comment."
5045 '(setq ps-bold-faces 5049 '(setq ps-bold-faces
5046 ;; font-lock-variable-name-face 5050 ;; font-lock-variable-name-face
5047 ;; font-lock-constant-face 5051 ;; font-lock-constant-face
5048 (append '(cperl-array-face 5052 (append '(cperl-array cperl-hash)
5049 cperl-hash-face)
5050 ps-bold-faces) 5053 ps-bold-faces)
5051 ps-italic-faces 5054 ps-italic-faces
5052 ;; font-lock-constant-face 5055 ;; font-lock-constant-face
5053 (append '(cperl-nonoverridable-face 5056 (append '(cperl-nonoverridable cperl-hash)
5054 cperl-hash-face)
5055 ps-italic-faces) 5057 ps-italic-faces)
5056 ps-underlined-faces 5058 ps-underlined-faces
5057 ;; font-lock-type-face 5059 ;; font-lock-type-face
5058 (append '(cperl-array-face 5060 (append '(cperl-array cperl-hash underline cperl-nonoverridable)
5059 cperl-hash-face
5060 underline
5061 cperl-nonoverridable-face)
5062 ps-underlined-faces)))) 5061 ps-underlined-faces))))
5063 5062
5064(defvar ps-print-face-extension-alist) 5063(defvar ps-print-face-extension-alist)
@@ -5091,27 +5090,27 @@ Style of printout regulated by the variable `cperl-ps-print-face-properties'."
5091;;; (defvar ps-italic-faces nil) 5090;;; (defvar ps-italic-faces nil)
5092;;; (setq ps-bold-faces 5091;;; (setq ps-bold-faces
5093;;; (append '(font-lock-emphasized-face 5092;;; (append '(font-lock-emphasized-face
5094;;; cperl-array-face 5093;;; cperl-array
5095;;; font-lock-keyword-face 5094;;; font-lock-keyword-face
5096;;; font-lock-variable-name-face 5095;;; font-lock-variable-name-face
5097;;; font-lock-constant-face 5096;;; font-lock-constant-face
5098;;; font-lock-reference-face 5097;;; font-lock-reference-face
5099;;; font-lock-other-emphasized-face 5098;;; font-lock-other-emphasized-face
5100;;; cperl-hash-face) 5099;;; cperl-hash)
5101;;; ps-bold-faces)) 5100;;; ps-bold-faces))
5102;;; (setq ps-italic-faces 5101;;; (setq ps-italic-faces
5103;;; (append '(cperl-nonoverridable-face 5102;;; (append '(cperl-nonoverridable
5104;;; font-lock-constant-face 5103;;; font-lock-constant-face
5105;;; font-lock-reference-face 5104;;; font-lock-reference-face
5106;;; font-lock-other-emphasized-face 5105;;; font-lock-other-emphasized-face
5107;;; cperl-hash-face) 5106;;; cperl-hash)
5108;;; ps-italic-faces)) 5107;;; ps-italic-faces))
5109;;; (setq ps-underlined-faces 5108;;; (setq ps-underlined-faces
5110;;; (append '(font-lock-emphasized-face 5109;;; (append '(font-lock-emphasized-face
5111;;; cperl-array-face 5110;;; cperl-array
5112;;; font-lock-other-emphasized-face 5111;;; font-lock-other-emphasized-face
5113;;; cperl-hash-face 5112;;; cperl-hash
5114;;; cperl-nonoverridable-face font-lock-type-face) 5113;;; cperl-nonoverridable font-lock-type-face)
5115;;; ps-underlined-faces)) 5114;;; ps-underlined-faces))
5116;;; (cons 'font-lock-type-face ps-underlined-faces)) 5115;;; (cons 'font-lock-type-face ps-underlined-faces))
5117 5116
diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el
index 0d9a9f62a60..9910f1f548f 100644
--- a/lisp/progmodes/cpp.el
+++ b/lisp/progmodes/cpp.el
@@ -144,7 +144,7 @@ or a cons cell (background-color . COLOR)."
144 '("light gray" "light blue" "light cyan" "light yellow" "light pink" 144 '("light gray" "light blue" "light cyan" "light yellow" "light pink"
145 "pale green" "beige" "orange" "magenta" "violet" "medium purple" 145 "pale green" "beige" "orange" "magenta" "violet" "medium purple"
146 "turquoise") 146 "turquoise")
147 "Background colours useful with dark foreground colors." 147 "Background colors useful with dark foreground colors."
148 :type '(repeat string) 148 :type '(repeat string)
149 :group 'cpp) 149 :group 'cpp)
150 150
@@ -152,7 +152,7 @@ or a cons cell (background-color . COLOR)."
152 '("dim gray" "blue" "cyan" "yellow" "red" 152 '("dim gray" "blue" "cyan" "yellow" "red"
153 "dark green" "brown" "dark orange" "dark khaki" "dark violet" "purple" 153 "dark green" "brown" "dark orange" "dark khaki" "dark violet" "purple"
154 "dark turquoise") 154 "dark turquoise")
155 "Background colours useful with light foreground colors." 155 "Background colors useful with light foreground colors."
156 :type '(repeat string) 156 :type '(repeat string)
157 :group 'cpp) 157 :group 'cpp)
158 158
diff --git a/lisp/progmodes/delphi.el b/lisp/progmodes/delphi.el
index 3d86f15c175..166e5b8984e 100644
--- a/lisp/progmodes/delphi.el
+++ b/lisp/progmodes/delphi.el
@@ -152,8 +152,8 @@ regardless of where in the line point is when the TAB command is used."
152(defcustom delphi-newline-always-indents t 152(defcustom delphi-newline-always-indents t
153 "*Non-nil means NEWLINE in Delphi mode should always reindent the current 153 "*Non-nil means NEWLINE in Delphi mode should always reindent the current
154line, insert a blank line and move to the default indent column of the blank 154line, insert a blank line and move to the default indent column of the blank
155line. If nil, then no indentation occurs, and NEWLINE does the usual 155line. If nil, then no indentation occurs, and NEWLINE does the usual
156behaviour. This is useful when one needs to do customized indentation that 156behavior. This is useful when one needs to do customized indentation that
157differs from the default." 157differs from the default."
158 :type 'boolean 158 :type 'boolean
159 :group 'delphi) 159 :group 'delphi)
diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el
index 953ecd79f7f..5f8ea5ae70a 100644
--- a/lisp/progmodes/ebrowse.el
+++ b/lisp/progmodes/ebrowse.el
@@ -157,50 +157,64 @@ This space is used to display markers."
157 :group 'ebrowse) 157 :group 'ebrowse)
158 158
159 159
160(defface ebrowse-tree-mark-face 160(defface ebrowse-tree-mark
161 '((((min-colors 88)) (:foreground "red1")) 161 '((((min-colors 88)) (:foreground "red1"))
162 (t (:foreground "red"))) 162 (t (:foreground "red")))
163 "*The face used for the mark character in the tree." 163 "*The face used for the mark character in the tree."
164 :group 'ebrowse-faces) 164 :group 'ebrowse-faces)
165;; backward-compatibility alias
166(put 'ebrowse-tree-mark-face 'face-alias 'ebrowse-tree-mark)
165 167
166 168
167(defface ebrowse-root-class-face 169(defface ebrowse-root-class
168 '((((min-colors 88)) (:weight bold :foreground "blue1")) 170 '((((min-colors 88)) (:weight bold :foreground "blue1"))
169 (t (:weight bold :foreground "blue"))) 171 (t (:weight bold :foreground "blue")))
170 "*The face used for root classes in the tree." 172 "*The face used for root classes in the tree."
171 :group 'ebrowse-faces) 173 :group 'ebrowse-faces)
174;; backward-compatibility alias
175(put 'ebrowse-root-class-face 'face-alias 'ebrowse-root-class)
172 176
173 177
174(defface ebrowse-file-name-face 178(defface ebrowse-file-name
175 '((t (:italic t))) 179 '((t (:italic t)))
176 "*The face for filenames displayed in the tree." 180 "*The face for filenames displayed in the tree."
177 :group 'ebrowse-faces) 181 :group 'ebrowse-faces)
182;; backward-compatibility alias
183(put 'ebrowse-file-name-face 'face-alias 'ebrowse-file-name)
178 184
179 185
180(defface ebrowse-default-face 186(defface ebrowse-default
181 '((t nil)) 187 '((t nil))
182 "*Face for everything else in the tree not having other faces." 188 "*Face for everything else in the tree not having other faces."
183 :group 'ebrowse-faces) 189 :group 'ebrowse-faces)
190;; backward-compatibility alias
191(put 'ebrowse-default-face 'face-alias 'ebrowse-default)
184 192
185 193
186(defface ebrowse-member-attribute-face 194(defface ebrowse-member-attribute
187 '((((min-colors 88)) (:foreground "red1")) 195 '((((min-colors 88)) (:foreground "red1"))
188 (t (:foreground "red"))) 196 (t (:foreground "red")))
189 "*Face used to display member attributes." 197 "*Face used to display member attributes."
190 :group 'ebrowse-faces) 198 :group 'ebrowse-faces)
199;; backward-compatibility alias
200(put 'ebrowse-member-attribute-face 'face-alias 'ebrowse-member-attribute)
191 201
192 202
193(defface ebrowse-member-class-face 203(defface ebrowse-member-class
194 '((t (:foreground "purple"))) 204 '((t (:foreground "purple")))
195 "*Face used to display the class title in member buffers." 205 "*Face used to display the class title in member buffers."
196 :group 'ebrowse-faces) 206 :group 'ebrowse-faces)
207;; backward-compatibility alias
208(put 'ebrowse-member-class-face 'face-alias 'ebrowse-member-class)
197 209
198 210
199(defface ebrowse-progress-face 211(defface ebrowse-progress
200 '((((min-colors 88)) (:background "blue1")) 212 '((((min-colors 88)) (:background "blue1"))
201 (t (:background "blue"))) 213 (t (:background "blue")))
202 "*Face for progress indicator." 214 "*Face for progress indicator."
203 :group 'ebrowse-faces) 215 :group 'ebrowse-faces)
216;; backward-compatibility alias
217(put 'ebrowse-progress-face 'face-alias 'ebrowse-progress)
204 218
205 219
206 220
@@ -883,7 +897,7 @@ this is the first progress message displayed."
883 (message (concat title ": " 897 (message (concat title ": "
884 (propertize (make-string ebrowse-n-boxes 898 (propertize (make-string ebrowse-n-boxes
885 (if (display-color-p) ?\ ?+)) 899 (if (display-color-p) ?\ ?+))
886 'face 'ebrowse-progress-face))))) 900 'face 'ebrowse-progress)))))
887 901
888 902
889;;; Reading a tree from disk 903;;; Reading a tree from disk
@@ -1310,7 +1324,7 @@ With PREFIX, insert that many filenames."
1310 (ebrowse-ts-class tree)) 1324 (ebrowse-ts-class tree))
1311 "unknown") 1325 "unknown")
1312 ")")) 1326 ")"))
1313 (ebrowse-set-face start (point) 'ebrowse-file-name-face) 1327 (ebrowse-set-face start (point) 'ebrowse-file-name)
1314 (beginning-of-line) 1328 (beginning-of-line)
1315 (forward-line 1)))))) 1329 (forward-line 1))))))
1316 1330
@@ -1828,7 +1842,7 @@ TREE denotes the class shown."
1828 start end 1842 start end
1829 `(mouse-face highlight ebrowse-what mark ebrowse-tree ,tree 1843 `(mouse-face highlight ebrowse-what mark ebrowse-tree ,tree
1830 help-echo "double-mouse-1: mark/unmark")) 1844 help-echo "double-mouse-1: mark/unmark"))
1831 (ebrowse-set-face start end 'ebrowse-tree-mark-face)) 1845 (ebrowse-set-face start end 'ebrowse-tree-mark))
1832 1846
1833 1847
1834(defun* ebrowse-draw-tree-fn (&aux stack1 stack2 start) 1848(defun* ebrowse-draw-tree-fn (&aux stack1 stack2 start)
@@ -1855,8 +1869,8 @@ This function may look weird, but this is faster than recursion."
1855 (when (ebrowse-template-p class) 1869 (when (ebrowse-template-p class)
1856 (insert "<>")) 1870 (insert "<>"))
1857 (ebrowse-set-face start (point) (if (zerop level) 1871 (ebrowse-set-face start (point) (if (zerop level)
1858 'ebrowse-root-class-face 1872 'ebrowse-root-class
1859 'ebrowse-default-face)) 1873 'ebrowse-default))
1860 (setf start-of-class-name start 1874 (setf start-of-class-name start
1861 end-of-class-name (point)) 1875 end-of-class-name (point))
1862 ;; If filenames are to be displayed... 1876 ;; If filenames are to be displayed...
@@ -1867,7 +1881,7 @@ This function may look weird, but this is faster than recursion."
1867 (or (ebrowse-cs-file class) 1881 (or (ebrowse-cs-file class)
1868 "unknown") 1882 "unknown")
1869 ")") 1883 ")")
1870 (ebrowse-set-face start (point) 'ebrowse-file-name-face)) 1884 (ebrowse-set-face start (point) 'ebrowse-file-name))
1871 (ebrowse-set-mark-props start-of-line (1+ start-of-line) tree) 1885 (ebrowse-set-mark-props start-of-line (1+ start-of-line) tree)
1872 (add-text-properties 1886 (add-text-properties
1873 start-of-class-name end-of-class-name 1887 start-of-class-name end-of-class-name
@@ -2694,7 +2708,7 @@ the class cursor is on."
2694 (insert "<>")) 2708 (insert "<>"))
2695 (setq class-name-end (point)) 2709 (setq class-name-end (point))
2696 (insert ":\n\n") 2710 (insert ":\n\n")
2697 (ebrowse-set-face start (point) 'ebrowse-member-class-face) 2711 (ebrowse-set-face start (point) 'ebrowse-member-class)
2698 (add-text-properties 2712 (add-text-properties
2699 class-name-start class-name-end 2713 class-name-start class-name-end
2700 '(ebrowse-what class-name 2714 '(ebrowse-what class-name
@@ -2810,7 +2824,7 @@ TREE is the class tree of MEMBER-LIST."
2810 (ebrowse-draw-member-attributes member-struc) 2824 (ebrowse-draw-member-attributes member-struc)
2811 (insert ">") 2825 (insert ">")
2812 (ebrowse-set-face start (point) 2826 (ebrowse-set-face start (point)
2813 'ebrowse-member-attribute-face))) 2827 'ebrowse-member-attribute)))
2814 (insert " ") 2828 (insert " ")
2815 (ebrowse-draw-member-regexp member-struc)))) 2829 (ebrowse-draw-member-regexp member-struc))))
2816 (insert "\n") 2830 (insert "\n")
@@ -2841,7 +2855,7 @@ TREE is the class tree in which the members are found."
2841 (ebrowse-draw-member-attributes member) 2855 (ebrowse-draw-member-attributes member)
2842 (insert "> ") 2856 (insert "> ")
2843 (ebrowse-set-face start-of-entry (point) 2857 (ebrowse-set-face start-of-entry (point)
2844 'ebrowse-member-attribute-face)) 2858 'ebrowse-member-attribute))
2845 ;; insert member name truncated to column width 2859 ;; insert member name truncated to column width
2846 (setq start-of-name (point)) 2860 (setq start-of-name (point))
2847 (insert (substring name 0 2861 (insert (substring name 0
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 28a6aae2435..c47f2e34cd2 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -704,7 +704,7 @@ It's flymake process filter."
704 (nth 1 err-info)) 704 (nth 1 err-info))
705 705
706(defvar flymake-new-err-info nil 706(defvar flymake-new-err-info nil
707 "Same as 'flymake-err-info', effective when a syntax check is in progress.") 707 "Same as `flymake-err-info', effective when a syntax check is in progress.")
708 708
709(make-variable-buffer-local 'flymake-new-err-info) 709(make-variable-buffer-local 'flymake-new-err-info)
710 710
@@ -839,19 +839,23 @@ Return t if it has at least one flymake overlay, nil if no overlay."
839 (setq ov (cdr ov))) 839 (setq ov (cdr ov)))
840 has-flymake-overlays)) 840 has-flymake-overlays))
841 841
842(defface flymake-errline-face 842(defface flymake-errline
843 ;;+ '((((class color)) (:foreground "OrangeRed" :bold t :underline t)) 843 ;;+ '((((class color)) (:foreground "OrangeRed" :bold t :underline t))
844 ;;+ '((((class color)) (:underline "OrangeRed")) 844 ;;+ '((((class color)) (:underline "OrangeRed"))
845 '((((class color)) (:background "LightPink")) 845 '((((class color)) (:background "LightPink"))
846 (t (:bold t))) 846 (t (:bold t)))
847 "Face used for marking error lines." 847 "Face used for marking error lines."
848 :group 'flymake) 848 :group 'flymake)
849;; backward-compatibility alias
850(put 'flymake-errline-face 'face-alias 'flymake-errline)
849 851
850(defface flymake-warnline-face 852(defface flymake-warnline
851 '((((class color)) (:background "LightBlue2")) 853 '((((class color)) (:background "LightBlue2"))
852 (t (:bold t))) 854 (t (:bold t)))
853 "Face used for marking warning lines." 855 "Face used for marking warning lines."
854 :group 'flymake) 856 :group 'flymake)
857;; backward-compatibility alias
858(put 'flymake-warnline-face 'face-alias 'flymake-warnline)
855 859
856(defun flymake-highlight-line (line-no line-err-info-list) 860(defun flymake-highlight-line (line-no line-err-info-list)
857 "Highlight line LINE-NO in current buffer. 861 "Highlight line LINE-NO in current buffer.
@@ -886,8 +890,8 @@ Perhaps use text from LINE-ERR-INFO-ILST to enhance highlighting."
886 (setq end (point))) 890 (setq end (point)))
887 891
888 (if (> (flymake-get-line-err-count line-err-info-list "e") 0) 892 (if (> (flymake-get-line-err-count line-err-info-list "e") 0)
889 (setq face 'flymake-errline-face) 893 (setq face 'flymake-errline)
890 (setq face 'flymake-warnline-face)) 894 (setq face 'flymake-warnline))
891 895
892 (flymake-make-overlay beg end tooltip-text face nil))) 896 (flymake-make-overlay beg end tooltip-text face nil)))
893 897
@@ -1312,7 +1316,7 @@ Return first 'INCLUDE-DIRS/REL-FILE-NAME' that exists, or just REL-FILE-NAME if
1312 (flymake-start-syntax-check buffer))))) 1316 (flymake-start-syntax-check buffer)))))
1313 1317
1314(defun flymake-start-syntax-check-for-current-buffer () 1318(defun flymake-start-syntax-check-for-current-buffer ()
1315 "Run 'flymake-start-syntax-check' for current buffer if it isn't already running." 1319 "Run `flymake-start-syntax-check' for current buffer if it isn't already running."
1316 (interactive) 1320 (interactive)
1317 (flymake-start-syntax-check (current-buffer))) 1321 (flymake-start-syntax-check (current-buffer)))
1318 1322
@@ -1655,7 +1659,7 @@ With arg, turn Flymake mode on if and only if arg is positive."
1655 temp-source-file-name)) 1659 temp-source-file-name))
1656 1660
1657(defun flymake-simple-cleanup (buffer) 1661(defun flymake-simple-cleanup (buffer)
1658 "Do cleanup after 'flymake-init-create-temp-buffer-copy'. 1662 "Do cleanup after `flymake-init-create-temp-buffer-copy'.
1659Delete temp file." 1663Delete temp file."
1660 (let* ((temp-source-file-name (flymake-get-buffer-value buffer "temp-source-file-name"))) 1664 (let* ((temp-source-file-name (flymake-get-buffer-value buffer "temp-source-file-name")))
1661 (flymake-safe-delete-file temp-source-file-name) 1665 (flymake-safe-delete-file temp-source-file-name)
diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el
index a9274cfcae7..3a34a621fc6 100644
--- a/lisp/progmodes/gdb-ui.el
+++ b/lisp/progmodes/gdb-ui.el
@@ -250,7 +250,7 @@ Also display the main routine in the disassembly buffer if present."
250 (let ((string (buffer-string))) 250 (let ((string (buffer-string)))
251 ;; remove newline for gud-tooltip-echo-area 251 ;; remove newline for gud-tooltip-echo-area
252 (substring string 0 (- (length string) 1)))) 252 (substring string 0 (- (length string) 1))))
253 gud-tooltip-echo-area)) 253 (or gud-tooltip-echo-area tooltip-use-echo-area)))
254 254
255;; If expr is a macro for a function don't print because of possible dangerous 255;; If expr is a macro for a function don't print because of possible dangerous
256;; side-effects. Also printing a function within a tooltip generates an 256;; side-effects. Also printing a function within a tooltip generates an
@@ -994,24 +994,24 @@ sink to `user' in `gdb-stopping', that is fine."
994This begins the collection of output from the current command if that 994This begins the collection of output from the current command if that
995happens to be appropriate." 995happens to be appropriate."
996 (unless gdb-pending-triggers 996 (unless gdb-pending-triggers
997 (gdb-get-selected-frame) 997 (gdb-get-selected-frame)
998 (gdb-invalidate-frames) 998 (gdb-invalidate-frames)
999 (gdb-invalidate-breakpoints) 999 (gdb-invalidate-breakpoints)
1000 ;; Do this through gdb-get-selected-frame -> gdb-frame-handler 1000 ;; Do this through gdb-get-selected-frame -> gdb-frame-handler
1001 ;; so gdb-frame-address is updated. 1001 ;; so gdb-frame-address is updated.
1002 ;; (gdb-invalidate-assembler) 1002 ;; (gdb-invalidate-assembler)
1003 (gdb-invalidate-registers) 1003 (gdb-invalidate-registers)
1004 (gdb-invalidate-memory) 1004 (gdb-invalidate-memory)
1005 (gdb-invalidate-locals) 1005 (gdb-invalidate-locals)
1006 (gdb-invalidate-threads) 1006 (gdb-invalidate-threads)
1007 (unless (eq system-type 'darwin) ;Breaks on Darwin's GDB-5.3. 1007 (unless (eq system-type 'darwin) ;Breaks on Darwin's GDB-5.3.
1008 ;; FIXME: with GDB-6 on Darwin, this might very well work. 1008 ;; FIXME: with GDB-6 on Darwin, this might very well work.
1009 ;; only needed/used with speedbar/watch expressions 1009 ;; only needed/used with speedbar/watch expressions
1010 (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) 1010 (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
1011 (setq gdb-var-changed t) ; force update 1011 (setq gdb-var-changed t) ; force update
1012 (dolist (var gdb-var-list) 1012 (dolist (var gdb-var-list)
1013 (setcar (nthcdr 5 var) nil)) 1013 (setcar (nthcdr 5 var) nil))
1014 (gdb-var-update)))) 1014 (gdb-var-update))))
1015 (let ((sink gdb-output-sink)) 1015 (let ((sink gdb-output-sink))
1016 (cond 1016 (cond
1017 ((eq sink 'user) t) 1017 ((eq sink 'user) t)
@@ -1695,7 +1695,9 @@ static char *magick[] = {
1695 (setq buffer-read-only t) 1695 (setq buffer-read-only t)
1696 (use-local-map gdb-registers-mode-map) 1696 (use-local-map gdb-registers-mode-map)
1697 (run-mode-hooks 'gdb-registers-mode-hook) 1697 (run-mode-hooks 'gdb-registers-mode-hook)
1698 'gdb-invalidate-registers) 1698 (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba))
1699 'gdb-invalidate-registers
1700 'gdbmi-invalidate-registers))
1699 1701
1700(defun gdb-registers-buffer-name () 1702(defun gdb-registers-buffer-name ()
1701 (with-current-buffer gud-comint-buffer 1703 (with-current-buffer gud-comint-buffer
@@ -2058,12 +2060,12 @@ corresponding to the mode line clicked."
2058 (replace-match " (array);\n" nil nil)))) 2060 (replace-match " (array);\n" nil nil))))
2059 (let ((buf (gdb-get-buffer 'gdb-locals-buffer))) 2061 (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
2060 (and buf (with-current-buffer buf 2062 (and buf (with-current-buffer buf
2061 (let ((p (point)) 2063 (let ((p (window-point (get-buffer-window buf 0)))
2062 (buffer-read-only nil)) 2064 (buffer-read-only nil))
2063 (delete-region (point-min) (point-max)) 2065 (erase-buffer)
2064 (insert-buffer-substring (gdb-get-create-buffer 2066 (insert-buffer-substring (gdb-get-create-buffer
2065 'gdb-partial-output-buffer)) 2067 'gdb-partial-output-buffer))
2066 (goto-char p))))) 2068 (set-window-point (get-buffer-window buf 0) p)))))
2067 (run-hooks 'gdb-info-locals-hook)) 2069 (run-hooks 'gdb-info-locals-hook))
2068 2070
2069(defun gdb-info-locals-custom () 2071(defun gdb-info-locals-custom ()
@@ -2172,18 +2174,18 @@ corresponding to the mode line clicked."
2172(let ((menu (make-sparse-keymap "GDB-UI"))) 2174(let ((menu (make-sparse-keymap "GDB-UI")))
2173 (define-key gud-menu-map [ui] 2175 (define-key gud-menu-map [ui]
2174 `(menu-item "GDB-UI" ,menu :visible (eq gud-minor-mode 'gdba))) 2176 `(menu-item "GDB-UI" ,menu :visible (eq gud-minor-mode 'gdba)))
2175 (define-key menu [gdb-restore-windows]
2176 '(menu-item "Restore Window Layout" gdb-restore-windows
2177 :help "Restore standard layout for debug session."))
2178 (define-key menu [gdb-many-windows]
2179 '(menu-item "Display Other Windows" gdb-many-windows
2180 :help "Toggle display of locals, stack and breakpoint information"
2181 :button (:toggle . gdb-many-windows)))
2182 (define-key menu [gdb-use-inferior-io] 2177 (define-key menu [gdb-use-inferior-io]
2183 (menu-bar-make-toggle toggle-gdb-use-inferior-io-buffer 2178 (menu-bar-make-toggle toggle-gdb-use-inferior-io-buffer
2184 gdb-use-inferior-io-buffer 2179 gdb-use-inferior-io-buffer
2185 "Separate inferior IO" "Use separate IO %s" 2180 "Separate inferior IO" "Use separate IO %s"
2186 "Toggle separate IO for inferior."))) 2181 "Toggle separate IO for inferior."))
2182 (define-key menu [gdb-many-windows]
2183 '(menu-item "Display Other Windows" gdb-many-windows
2184 :help "Toggle display of locals, stack and breakpoint information"
2185 :button (:toggle . gdb-many-windows)))
2186 (define-key menu [gdb-restore-windows]
2187 '(menu-item "Restore Window Layout" gdb-restore-windows
2188 :help "Restore standard layout for debug session.")))
2187 2189
2188(defadvice toggle-gdb-use-inferior-io-buffer (after gdb-kill-io-buffer activate) 2190(defadvice toggle-gdb-use-inferior-io-buffer (after gdb-kill-io-buffer activate)
2189 (unless gdb-use-inferior-io-buffer 2191 (unless gdb-use-inferior-io-buffer
@@ -2341,6 +2343,8 @@ Add directory to search path for source files using the GDB command, dir."))
2341(add-hook 'find-file-hook 'gdb-find-file-hook) 2343(add-hook 'find-file-hook 'gdb-find-file-hook)
2342 2344
2343(defun gdb-find-file-hook () 2345(defun gdb-find-file-hook ()
2346"Set up buffer for debugging if file is part of the source code
2347of the current session."
2344 (if (and (not gdb-find-file-unhook) 2348 (if (and (not gdb-find-file-unhook)
2345 ;; in case gud or gdb-ui is just loaded 2349 ;; in case gud or gdb-ui is just loaded
2346 gud-comint-buffer 2350 gud-comint-buffer
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 31b9e7d7204..7d4fc00cd56 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -140,6 +140,9 @@ Used to grey out relevant togolbar icons.")
140 :enable (and (not gud-running) 140 :enable (and (not gud-running)
141 (memq gud-minor-mode 141 (memq gud-minor-mode
142 '(gdbmi gdba gdb dbx xdb jdb pdb bashdb)))) 142 '(gdbmi gdba gdb dbx xdb jdb pdb bashdb))))
143 ([print*] menu-item "Print Dereference" gud-pstar
144 :enable (and (not gud-running)
145 (memq gud-minor-mode '(gdbmi gdba gdb))))
143 ([print] menu-item "Print Expression" gud-print 146 ([print] menu-item "Print Expression" gud-print
144 :enable (not gud-running)) 147 :enable (not gud-running))
145 ([watch] menu-item "Watch Expression" gud-watch 148 ([watch] menu-item "Watch Expression" gud-watch
@@ -183,18 +186,19 @@ Used to grey out relevant togolbar icons.")
183 (dolist (x '((gud-break . "gud-break") 186 (dolist (x '((gud-break . "gud-break")
184 (gud-remove . "gud-remove") 187 (gud-remove . "gud-remove")
185 (gud-print . "gud-print") 188 (gud-print . "gud-print")
189 (gud-pstar . "gud-pstar")
186 (gud-watch . "gud-watch") 190 (gud-watch . "gud-watch")
187 (gud-run . "gud-run")
188 (gud-until . "gud-until")
189 (gud-cont . "gud-cont") 191 (gud-cont . "gud-cont")
192 (gud-until . "gud-until")
193 (gud-finish . "gud-finish")
194 (gud-run . "gud-run")
190 ;; gud-s, gud-si etc. instead of gud-step, 195 ;; gud-s, gud-si etc. instead of gud-step,
191 ;; gud-stepi, to avoid file-name clashes on DOS 196 ;; gud-stepi, to avoid file-name clashes on DOS
192 ;; 8+3 filesystems. 197 ;; 8+3 filesystems.
193 (gud-step . "gud-s")
194 (gud-next . "gud-n") 198 (gud-next . "gud-n")
195 (gud-finish . "gud-finish") 199 (gud-step . "gud-s")
196 (gud-stepi . "gud-si")
197 (gud-nexti . "gud-ni") 200 (gud-nexti . "gud-ni")
201 (gud-stepi . "gud-si")
198 (gud-up . "gud-up") 202 (gud-up . "gud-up")
199 (gud-down . "gud-down") 203 (gud-down . "gud-down")
200 (gud-goto-info . "info")) 204 (gud-goto-info . "info"))
@@ -580,6 +584,8 @@ and source-file directory for your debugger."
580 (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).") 584 (gud-def gud-up "up %p" "<" "Up N stack frames (numeric arg).")
581 (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).") 585 (gud-def gud-down "down %p" ">" "Down N stack frames (numeric arg).")
582 (gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.") 586 (gud-def gud-print "print %e" "\C-p" "Evaluate C expression at point.")
587 (gud-def gud-pstar "print* %e" nil
588 "Evaluate C dereferenced pointer expression at point.")
583 (gud-def gud-until "until %l" "\C-u" "Continue to current line.") 589 (gud-def gud-until "until %l" "\C-u" "Continue to current line.")
584 (gud-def gud-run "run" nil "Run the program.") 590 (gud-def gud-run "run" nil "Run the program.")
585 591
@@ -1214,7 +1220,7 @@ containing the executable being debugged."
1214The directory containing FILE becomes the initial working directory 1220The directory containing FILE becomes the initial working directory
1215and source-file directory for your debugger. 1221and source-file directory for your debugger.
1216 1222
1217You can set the variable 'gud-xdb-directories' to a list of program source 1223You can set the variable `gud-xdb-directories' to a list of program source
1218directories if your program contains sources from more than one directory." 1224directories if your program contains sources from more than one directory."
1219 (interactive (list (gud-query-cmdline 'xdb))) 1225 (interactive (list (gud-query-cmdline 'xdb)))
1220 1226
@@ -3133,8 +3139,6 @@ only tooltips in the buffer containing the overlay arrow."
3133 'gud-tooltip-modes "22.1") 3139 'gud-tooltip-modes "22.1")
3134(define-obsolete-variable-alias 'tooltip-gud-display 3140(define-obsolete-variable-alias 'tooltip-gud-display
3135 'gud-tooltip-display "22.1") 3141 'gud-tooltip-display "22.1")
3136(define-obsolete-variable-alias 'tooltip-use-echo-area
3137 'gud-tooltip-echo-area "22.1")
3138 3142
3139;;; Reacting on mouse movements 3143;;; Reacting on mouse movements
3140 3144
@@ -3236,7 +3240,7 @@ This event can be examined by forms in GUD-TOOLTIP-DISPLAY.")
3236 3240
3237; This will only display data that comes in one chunk. 3241; This will only display data that comes in one chunk.
3238; Larger arrays (say 400 elements) are displayed in 3242; Larger arrays (say 400 elements) are displayed in
3239; the tootip incompletely and spill over into the gud buffer. 3243; the tooltip incompletely and spill over into the gud buffer.
3240; Switching the process-filter creates timing problems and 3244; Switching the process-filter creates timing problems and
3241; it may be difficult to do better. Using annotations as in 3245; it may be difficult to do better. Using annotations as in
3242; gdb-ui.el gets round this problem. 3246; gdb-ui.el gets round this problem.
@@ -3244,7 +3248,7 @@ This event can be examined by forms in GUD-TOOLTIP-DISPLAY.")
3244 "Process debugger output and show it in a tooltip window." 3248 "Process debugger output and show it in a tooltip window."
3245 (set-process-filter process gud-tooltip-original-filter) 3249 (set-process-filter process gud-tooltip-original-filter)
3246 (tooltip-show (tooltip-strip-prompt process output) 3250 (tooltip-show (tooltip-strip-prompt process output)
3247 gud-tooltip-echo-area)) 3251 (or gud-tooltip-echo-area tooltip-use-echo-area)))
3248 3252
3249(defun gud-tooltip-print-command (expr) 3253(defun gud-tooltip-print-command (expr)
3250 "Return a suitable command to print the expression EXPR. 3254 "Return a suitable command to print the expression EXPR.
@@ -3289,7 +3293,9 @@ This function must return nil if it doesn't handle EVENT."
3289 (cddr mouse)))) 3293 (cddr mouse))))
3290 (let ((define-elt (assoc expr gdb-define-alist))) 3294 (let ((define-elt (assoc expr gdb-define-alist)))
3291 (unless (null define-elt) 3295 (unless (null define-elt)
3292 (tooltip-show (cdr define-elt)) 3296 (tooltip-show
3297 (cdr define-elt)
3298 (or gud-tooltip-echo-area tooltip-use-echo-area))
3293 expr)))) 3299 expr))))
3294 (let ((cmd (gud-tooltip-print-command expr))) 3300 (let ((cmd (gud-tooltip-print-command expr)))
3295 (when (and gud-tooltip-mode (eq gud-minor-mode 'gdb)) 3301 (when (and gud-tooltip-mode (eq gud-minor-mode 'gdb))
diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el
index 6c2cb00bbde..ba31e6e0ef8 100644
--- a/lisp/progmodes/idlw-help.el
+++ b/lisp/progmodes/idlw-help.el
@@ -182,12 +182,14 @@ support."
182 :group 'idlwave-online-help 182 :group 'idlwave-online-help
183 :type 'string) 183 :type 'string)
184 184
185(defface idlwave-help-link-face 185(defface idlwave-help-link
186 '((((min-colors 88) (class color)) (:foreground "Blue1")) 186 '((((min-colors 88) (class color)) (:foreground "Blue1"))
187 (((class color)) (:foreground "Blue")) 187 (((class color)) (:foreground "Blue"))
188 (t (:weight bold))) 188 (t (:weight bold)))
189 "Face for highlighting links into IDLWAVE online help." 189 "Face for highlighting links into IDLWAVE online help."
190 :group 'idlwave-online-help) 190 :group 'idlwave-online-help)
191;; backward-compatibility alias
192(put 'idlwave-help-link-face 'face-alias 'idlwave-help-link)
191 193
192(defvar idlwave-help-activate-links-aggressively nil 194(defvar idlwave-help-activate-links-aggressively nil
193 "Obsolete variable.") 195 "Obsolete variable.")
@@ -586,12 +588,12 @@ Needs additional info stored in global `idlwave-completion-help-info'."
586(defun idlwave-highlight-linked-completions () 588(defun idlwave-highlight-linked-completions ()
587 "Highlight all completions for which help is available and attach link. 589 "Highlight all completions for which help is available and attach link.
588Those words in `idlwave-completion-help-links' have links. The 590Those words in `idlwave-completion-help-links' have links. The
589`idlwave-help-link-face' face is used for this." 591`idlwave-help-link' face is used for this."
590 (if idlwave-highlight-help-links-in-completion 592 (if idlwave-highlight-help-links-in-completion
591 (with-current-buffer (get-buffer "*Completions*") 593 (with-current-buffer (get-buffer "*Completions*")
592 (save-excursion 594 (save-excursion
593 (let* ((case-fold-search t) 595 (let* ((case-fold-search t)
594 (props (list 'face 'idlwave-help-link-face)) 596 (props (list 'face 'idlwave-help-link))
595 (info idlwave-completion-help-info) ; global passed in 597 (info idlwave-completion-help-info) ; global passed in
596 (what (nth 0 info)) ; what was completed, or a func 598 (what (nth 0 info)) ; what was completed, or a func
597 (class (nth 3 info)) ; any class 599 (class (nth 3 info)) ; any class
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el
index e804b9f8d50..04e6a28ee40 100644
--- a/lisp/progmodes/idlw-shell.el
+++ b/lisp/progmodes/idlw-shell.el
@@ -510,40 +510,44 @@ t Glyph when possible, otherwise face (same effect as 'glyph)."
510(defvar idlwave-shell-use-breakpoint-glyph t 510(defvar idlwave-shell-use-breakpoint-glyph t
511 "Obsolete variable. See `idlwave-shell-mark-breakpoints.") 511 "Obsolete variable. See `idlwave-shell-mark-breakpoints.")
512 512
513(defcustom idlwave-shell-breakpoint-face 'idlwave-shell-bp-face 513(defcustom idlwave-shell-breakpoint-face 'idlwave-shell-bp
514 "*The face for breakpoint lines in the source code. 514 "*The face for breakpoint lines in the source code.
515Allows you to choose the font, color and other properties for 515Allows you to choose the font, color and other properties for
516lines which have a breakpoint. See also `idlwave-shell-mark-breakpoints'." 516lines which have a breakpoint. See also `idlwave-shell-mark-breakpoints'."
517 :group 'idlwave-shell-highlighting-and-faces 517 :group 'idlwave-shell-highlighting-and-faces
518 :type 'symbol) 518 :type 'symbol)
519 519
520(if idlwave-shell-have-new-custom 520(if (not idlwave-shell-have-new-custom)
521 ;; We have the new customize - use it to define a customizable face 521 ;; Just copy the underline face to be on the safe side.
522 (defface idlwave-shell-bp-face 522 (copy-face 'underline 'idlwave-shell-bp)
523 '((((class color)) (:foreground "Black" :background "Pink")) 523 ;; We have the new customize - use it to define a customizable face
524 (t (:underline t))) 524 (defface idlwave-shell-bp
525 "Face for highlighting lines with breakpoints." 525 '((((class color)) (:foreground "Black" :background "Pink"))
526 :group 'idlwave-shell-highlighting-and-faces) 526 (t (:underline t)))
527 ;; Just copy the underline face to be on the safe side. 527 "Face for highlighting lines with breakpoints."
528 (copy-face 'underline 'idlwave-shell-bp-face)) 528 :group 'idlwave-shell-highlighting-and-faces)
529 ;; backward-compatibility alias
530 (put 'idlwave-shell-bp-face 'face-alias 'idlwave-shell-bp))
529 531
530(defcustom idlwave-shell-disabled-breakpoint-face 532(defcustom idlwave-shell-disabled-breakpoint-face
531 'idlwave-shell-disabled-bp-face 533 'idlwave-shell-disabled-bp
532 "*The face for disabled breakpoint lines in the source code. 534 "*The face for disabled breakpoint lines in the source code.
533Allows you to choose the font, color and other properties for 535Allows you to choose the font, color and other properties for
534lines which have a breakpoint. See also `idlwave-shell-mark-breakpoints'." 536lines which have a breakpoint. See also `idlwave-shell-mark-breakpoints'."
535 :group 'idlwave-shell-highlighting-and-faces 537 :group 'idlwave-shell-highlighting-and-faces
536 :type 'symbol) 538 :type 'symbol)
537 539
538(if idlwave-shell-have-new-custom 540(if (not idlwave-shell-have-new-custom)
539 ;; We have the new customize - use it to define a customizable face 541 ;; Just copy the underline face to be on the safe side.
540 (defface idlwave-shell-disabled-bp-face 542 (copy-face 'underline 'idlwave-shell-disabled-bp)
541 '((((class color)) (:foreground "Black" :background "gray")) 543 ;; We have the new customize - use it to define a customizable face
542 (t (:underline t))) 544 (defface idlwave-shell-disabled-bp
543 "Face for highlighting lines with breakpoints." 545 '((((class color)) (:foreground "Black" :background "gray"))
544 :group 'idlwave-shell-highlighting-and-faces) 546 (t (:underline t)))
545 ;; Just copy the underline face to be on the safe side. 547 "Face for highlighting lines with breakpoints."
546 (copy-face 'underline 'idlwave-shell-disabled-bp-face)) 548 :group 'idlwave-shell-highlighting-and-faces)
549 ;; backward-compatibility alias
550 (put 'idlwave-shell-disabled-bp-face 'face-alias 'idlwave-shell-disabled-bp))
547 551
548 552
549(defcustom idlwave-shell-expression-face 'secondary-selection 553(defcustom idlwave-shell-expression-face 'secondary-selection
@@ -2734,7 +2738,7 @@ Runs to the last statement and then steps 1 statement. Use the .out command."
2734 (funcall orig-func cur-line orig-bp-line) 2738 (funcall orig-func cur-line orig-bp-line)
2735 (or (not bp-line) (funcall closer-func cur-line bp-line))) 2739 (or (not bp-line) (funcall closer-func cur-line bp-line)))
2736 (setq bp-line cur-line)))) 2740 (setq bp-line cur-line))))
2737 (unless bp-line (error "No further breakpoints.")) 2741 (unless bp-line (error "No further breakpoints"))
2738 (goto-line bp-line))) 2742 (goto-line bp-line)))
2739 2743
2740;; Examine Commands ------------------------------------------------------ 2744;; Examine Commands ------------------------------------------------------
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index 6bd7e0eaced..820e619f331 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -70,7 +70,7 @@
70;; of the documentation is available from the maintainers webpage (see 70;; of the documentation is available from the maintainers webpage (see
71;; SOURCE). 71;; SOURCE).
72;; 72;;
73;; 73;;
74;; ACKNOWLEDGMENTS 74;; ACKNOWLEDGMENTS
75;; =============== 75;; ===============
76;; 76;;
@@ -120,7 +120,7 @@
120;; up inserting the character that expanded the abbrev after moving 120;; up inserting the character that expanded the abbrev after moving
121;; point backward, e.g., "\cl" expanded with a space becomes 121;; point backward, e.g., "\cl" expanded with a space becomes
122;; "LONG( )" with point before the close paren. This is solved by 122;; "LONG( )" with point before the close paren. This is solved by
123;; using a temporary function in `post-command-hook' - not pretty, 123;; using a temporary function in `post-command-hook' - not pretty,
124;; but it works. 124;; but it works.
125;; 125;;
126;; Tabs and spaces are treated equally as whitespace when filling a 126;; Tabs and spaces are treated equally as whitespace when filling a
@@ -166,13 +166,13 @@
166 nil ;; We've got what we needed 166 nil ;; We've got what we needed
167 ;; We have the old or no custom-library, hack around it! 167 ;; We have the old or no custom-library, hack around it!
168 (defmacro defgroup (&rest args) nil) 168 (defmacro defgroup (&rest args) nil)
169 (defmacro defcustom (var value doc &rest args) 169 (defmacro defcustom (var value doc &rest args)
170 `(defvar ,var ,value ,doc)))) 170 `(defvar ,var ,value ,doc))))
171 171
172(defgroup idlwave nil 172(defgroup idlwave nil
173 "Major mode for editing IDL .pro files" 173 "Major mode for editing IDL .pro files"
174 :tag "IDLWAVE" 174 :tag "IDLWAVE"
175 :link '(url-link :tag "Home Page" 175 :link '(url-link :tag "Home Page"
176 "http://idlwave.org") 176 "http://idlwave.org")
177 :link '(emacs-commentary-link :tag "Commentary in idlw-shell.el" 177 :link '(emacs-commentary-link :tag "Commentary in idlw-shell.el"
178 "idlw-shell.el") 178 "idlw-shell.el")
@@ -286,8 +286,8 @@ extends to the end of the match for the regular expression."
286 286
287(defcustom idlwave-auto-fill-split-string t 287(defcustom idlwave-auto-fill-split-string t
288 "*If non-nil then auto fill will split strings with the IDL `+' operator. 288 "*If non-nil then auto fill will split strings with the IDL `+' operator.
289When the line end falls within a string, string concatenation with the 289When the line end falls within a string, string concatenation with the
290'+' operator will be used to distribute a long string over lines. 290'+' operator will be used to distribute a long string over lines.
291If nil and a string is split then a terminal beep and warning are issued. 291If nil and a string is split then a terminal beep and warning are issued.
292 292
293This variable is ignored when `idlwave-fill-comment-line-only' is 293This variable is ignored when `idlwave-fill-comment-line-only' is
@@ -351,7 +351,7 @@ usually a good idea.."
351Initializing the routine info can take long, in particular if a large 351Initializing the routine info can take long, in particular if a large
352library catalog is involved. When Emacs is idle for more than the number 352library catalog is involved. When Emacs is idle for more than the number
353of seconds specified by this variable, it starts the initialization. 353of seconds specified by this variable, it starts the initialization.
354The process is split into five steps, in order to keep possible work 354The process is split into five steps, in order to keep possible work
355interruption as short as possible. If one of the steps finishes, and no 355interruption as short as possible. If one of the steps finishes, and no
356user input has arrived in the mean time, initialization proceeds immediately 356user input has arrived in the mean time, initialization proceeds immediately
357to the next step. 357to the next step.
@@ -403,7 +403,7 @@ t All available
403 (const :tag "When saving a buffer" save-buffer) 403 (const :tag "When saving a buffer" save-buffer)
404 (const :tag "After a buffer was killed" kill-buffer) 404 (const :tag "After a buffer was killed" kill-buffer)
405 (const :tag "After a buffer was compiled successfully, update shell info" compile-buffer)))) 405 (const :tag "After a buffer was compiled successfully, update shell info" compile-buffer))))
406 406
407(defcustom idlwave-rinfo-max-source-lines 5 407(defcustom idlwave-rinfo-max-source-lines 5
408 "*Maximum number of source files displayed in the Routine Info window. 408 "*Maximum number of source files displayed in the Routine Info window.
409When an integer, it is the maximum number of source files displayed. 409When an integer, it is the maximum number of source files displayed.
@@ -436,7 +436,7 @@ value of `!DIR'. See also `idlwave-library-path'."
436 :group 'idlwave-routine-info 436 :group 'idlwave-routine-info
437 :type 'directory) 437 :type 'directory)
438 438
439(defcustom idlwave-config-directory 439(defcustom idlwave-config-directory
440 (convert-standard-filename "~/.idlwave") 440 (convert-standard-filename "~/.idlwave")
441 "*Directory for configuration files and user-library catalog." 441 "*Directory for configuration files and user-library catalog."
442 :group 'idlwave-routine-info 442 :group 'idlwave-routine-info
@@ -451,7 +451,7 @@ value of `!DIR'. See also `idlwave-library-path'."
451(defcustom idlwave-special-lib-alist nil 451(defcustom idlwave-special-lib-alist nil
452 "Alist of regular expressions matching special library directories. 452 "Alist of regular expressions matching special library directories.
453When listing routine source locations, IDLWAVE gives a short hint where 453When listing routine source locations, IDLWAVE gives a short hint where
454the file defining the routine is located. By default it lists `SystemLib' 454the file defining the routine is located. By default it lists `SystemLib'
455for routines in the system library `!DIR/lib' and `Library' for anything 455for routines in the system library `!DIR/lib' and `Library' for anything
456else. This variable can define additional types. The car of each entry 456else. This variable can define additional types. The car of each entry
457is a regular expression matching the file name (they normally will match 457is a regular expression matching the file name (they normally will match
@@ -462,7 +462,7 @@ chars are allowed."
462 (cons regexp string))) 462 (cons regexp string)))
463 463
464(defcustom idlwave-auto-write-paths t 464(defcustom idlwave-auto-write-paths t
465 "Write out path (!PATH) and system directory (!DIR) info automatically. 465 "Write out path (!PATH) and system directory (!DIR) info automatically.
466Path info is needed to locate library catalog files. If non-nil, 466Path info is needed to locate library catalog files. If non-nil,
467whenever the path-list changes as a result of shell-query, etc., it is 467whenever the path-list changes as a result of shell-query, etc., it is
468written to file. Otherwise, the menu option \"Write Paths\" can be 468written to file. Otherwise, the menu option \"Write Paths\" can be
@@ -493,7 +493,7 @@ used to force a write."
493This variable determines the case (UPPER/lower/Capitalized...) of 493This variable determines the case (UPPER/lower/Capitalized...) of
494words inserted into the buffer by completion. The preferred case can 494words inserted into the buffer by completion. The preferred case can
495be specified separately for routine names, keywords, classes and 495be specified separately for routine names, keywords, classes and
496methods. 496methods.
497This alist should therefore have entries for `routine' (normal 497This alist should therefore have entries for `routine' (normal
498functions and procedures, i.e. non-methods), `keyword', `class', and 498functions and procedures, i.e. non-methods), `keyword', `class', and
499`method'. Plausible values are 499`method'. Plausible values are
@@ -580,7 +580,7 @@ certain methods this assumption is almost always true. The methods
580for which to assume this can be set here." 580for which to assume this can be set here."
581 :group 'idlwave-routine-info 581 :group 'idlwave-routine-info
582 :type '(repeat (regexp :tag "Match method:"))) 582 :type '(repeat (regexp :tag "Match method:")))
583 583
584 584
585(defcustom idlwave-completion-show-classes 1 585(defcustom idlwave-completion-show-classes 1
586 "*Number of classes to show when completing object methods and keywords. 586 "*Number of classes to show when completing object methods and keywords.
@@ -645,7 +645,7 @@ should contain at least two elements: (method-default . VALUE) and
645specify if the class should be found during method and keyword 645specify if the class should be found during method and keyword
646completion, respectively. 646completion, respectively.
647 647
648The alist may have additional entries specifying exceptions from the 648The alist may have additional entries specifying exceptions from the
649keyword completion rule for specific methods, like INIT or 649keyword completion rule for specific methods, like INIT or
650GETPROPERTY. In order to turn on class specification for the INIT 650GETPROPERTY. In order to turn on class specification for the INIT
651method, add an entry (\"INIT\" . t). The method name must be ALL-CAPS." 651method, add an entry (\"INIT\" . t). The method name must be ALL-CAPS."
@@ -669,7 +669,7 @@ particular object method call. This happens during the commands
669value of the variable `idlwave-query-class'. 669value of the variable `idlwave-query-class'.
670 670
671When you specify a class, this information can be stored as a text 671When you specify a class, this information can be stored as a text
672property on the `->' arrow in the source code, so that during the same 672property on the `->' arrow in the source code, so that during the same
673editing session, IDLWAVE will not have to ask again. When this 673editing session, IDLWAVE will not have to ask again. When this
674variable is non-nil, IDLWAVE will store and reuse the class information. 674variable is non-nil, IDLWAVE will store and reuse the class information.
675The class stored can be checked and removed with `\\[idlwave-routine-info]' 675The class stored can be checked and removed with `\\[idlwave-routine-info]'
@@ -1049,7 +1049,7 @@ IDL process is made."
1049 :group 'idlwave-misc 1049 :group 'idlwave-misc
1050 :type 'boolean) 1050 :type 'boolean)
1051 1051
1052(defcustom idlwave-default-font-lock-items 1052(defcustom idlwave-default-font-lock-items
1053 '(pros-and-functions batch-files idlwave-idl-keywords label goto 1053 '(pros-and-functions batch-files idlwave-idl-keywords label goto
1054 common-blocks class-arrows) 1054 common-blocks class-arrows)
1055 "Items which should be fontified on the default fontification level 2. 1055 "Items which should be fontified on the default fontification level 2.
@@ -1111,25 +1111,25 @@ As a user, you should not set this to t.")
1111;;; and Carsten Dominik... 1111;;; and Carsten Dominik...
1112 1112
1113;; The following are the reserved words in IDL. Maybe we should 1113;; The following are the reserved words in IDL. Maybe we should
1114;; highlight some more stuff as well? 1114;; highlight some more stuff as well?
1115;; Procedure declarations. Fontify keyword plus procedure name. 1115;; Procedure declarations. Fontify keyword plus procedure name.
1116(defvar idlwave-idl-keywords 1116(defvar idlwave-idl-keywords
1117 ;; To update this regexp, update the list of keywords and 1117 ;; To update this regexp, update the list of keywords and
1118 ;; evaluate the form. 1118 ;; evaluate the form.
1119 ;; (insert 1119 ;; (insert
1120 ;; (prin1-to-string 1120 ;; (prin1-to-string
1121 ;; (concat 1121 ;; (concat
1122 ;; "\\<\\(" 1122 ;; "\\<\\("
1123 ;; (regexp-opt 1123 ;; (regexp-opt
1124 ;; '("||" "&&" "and" "or" "xor" "not" 1124 ;; '("||" "&&" "and" "or" "xor" "not"
1125 ;; "eq" "ge" "gt" "le" "lt" "ne" 1125 ;; "eq" "ge" "gt" "le" "lt" "ne"
1126 ;; "for" "do" "endfor" 1126 ;; "for" "do" "endfor"
1127 ;; "if" "then" "endif" "else" "endelse" 1127 ;; "if" "then" "endif" "else" "endelse"
1128 ;; "case" "of" "endcase" 1128 ;; "case" "of" "endcase"
1129 ;; "switch" "break" "continue" "endswitch" 1129 ;; "switch" "break" "continue" "endswitch"
1130 ;; "begin" "end" 1130 ;; "begin" "end"
1131 ;; "repeat" "until" "endrep" 1131 ;; "repeat" "until" "endrep"
1132 ;; "while" "endwhile" 1132 ;; "while" "endwhile"
1133 ;; "goto" "return" 1133 ;; "goto" "return"
1134 ;; "inherits" "mod" 1134 ;; "inherits" "mod"
1135 ;; "compile_opt" "forward_function" 1135 ;; "compile_opt" "forward_function"
@@ -1152,7 +1152,7 @@ As a user, you should not set this to t.")
1152 (2 font-lock-reference-face nil t) ; block name 1152 (2 font-lock-reference-face nil t) ; block name
1153 (font-lock-match-c++-style-declaration-item-and-skip-to-next 1153 (font-lock-match-c++-style-declaration-item-and-skip-to-next
1154 ;; Start with point after block name and comma 1154 ;; Start with point after block name and comma
1155 (goto-char (match-end 0)) ; needed for XEmacs, could be nil 1155 (goto-char (match-end 0)) ; needed for XEmacs, could be nil
1156 nil 1156 nil
1157 (1 font-lock-variable-name-face) ; variable names 1157 (1 font-lock-variable-name-face) ; variable names
1158 ))) 1158 )))
@@ -1207,7 +1207,7 @@ As a user, you should not set this to t.")
1207 ;; All operators (not used because too noisy) 1207 ;; All operators (not used because too noisy)
1208 (all-operators 1208 (all-operators
1209 '("[-*^#+<>/]" (0 font-lock-keyword-face))) 1209 '("[-*^#+<>/]" (0 font-lock-keyword-face)))
1210 1210
1211 ;; Arrows with text property `idlwave-class' 1211 ;; Arrows with text property `idlwave-class'
1212 (class-arrows 1212 (class-arrows
1213 '(idlwave-match-class-arrows (0 idlwave-class-arrow-face)))) 1213 '(idlwave-match-class-arrows (0 idlwave-class-arrow-face))))
@@ -1244,14 +1244,14 @@ As a user, you should not set this to t.")
1244 1244
1245(defvar idlwave-font-lock-defaults 1245(defvar idlwave-font-lock-defaults
1246 '((idlwave-font-lock-keywords 1246 '((idlwave-font-lock-keywords
1247 idlwave-font-lock-keywords-1 1247 idlwave-font-lock-keywords-1
1248 idlwave-font-lock-keywords-2 1248 idlwave-font-lock-keywords-2
1249 idlwave-font-lock-keywords-3) 1249 idlwave-font-lock-keywords-3)
1250 nil t 1250 nil t
1251 ((?$ . "w") (?_ . "w") (?. . "w") (?| . "w") (?& . "w")) 1251 ((?$ . "w") (?_ . "w") (?. . "w") (?| . "w") (?& . "w"))
1252 beginning-of-line)) 1252 beginning-of-line))
1253 1253
1254(put 'idlwave-mode 'font-lock-defaults 1254(put 'idlwave-mode 'font-lock-defaults
1255 idlwave-font-lock-defaults) ; XEmacs 1255 idlwave-font-lock-defaults) ; XEmacs
1256 1256
1257(defconst idlwave-comment-line-start-skip "^[ \t]*;" 1257(defconst idlwave-comment-line-start-skip "^[ \t]*;"
@@ -1259,7 +1259,7 @@ As a user, you should not set this to t.")
1259That is the _beginning_ of a line containing a comment delimiter `;' preceded 1259That is the _beginning_ of a line containing a comment delimiter `;' preceded
1260only by whitespace.") 1260only by whitespace.")
1261 1261
1262(defconst idlwave-begin-block-reg 1262(defconst idlwave-begin-block-reg
1263 "\\<\\(pro\\|function\\|begin\\|case\\|switch\\)\\>" 1263 "\\<\\(pro\\|function\\|begin\\|case\\|switch\\)\\>"
1264 "Regular expression to find the beginning of a block. The case does 1264 "Regular expression to find the beginning of a block. The case does
1265not matter. The search skips matches in comments.") 1265not matter. The search skips matches in comments.")
@@ -1336,17 +1336,17 @@ blocks starting with a BEGIN statement. The matches must have associations
1336 '(goto . ("goto\\>" nil)) 1336 '(goto . ("goto\\>" nil))
1337 '(case . ("case\\>" nil)) 1337 '(case . ("case\\>" nil))
1338 '(switch . ("switch\\>" nil)) 1338 '(switch . ("switch\\>" nil))
1339 (cons 'call (list (concat "\\(" idlwave-variable "\\) *= *" 1339 (cons 'call (list (concat "\\(" idlwave-variable "\\) *= *"
1340 "\\(" idlwave-method-call "\\s *\\)?" 1340 "\\(" idlwave-method-call "\\s *\\)?"
1341 idlwave-identifier 1341 idlwave-identifier
1342 "\\s *(") nil)) 1342 "\\s *(") nil))
1343 (cons 'call (list (concat 1343 (cons 'call (list (concat
1344 "\\(" idlwave-method-call "\\s *\\)?" 1344 "\\(" idlwave-method-call "\\s *\\)?"
1345 idlwave-identifier 1345 idlwave-identifier
1346 "\\( *\\($\\|\\$\\)\\|\\s *,\\)") nil)) 1346 "\\( *\\($\\|\\$\\)\\|\\s *,\\)") nil))
1347 (cons 'assign (list (concat 1347 (cons 'assign (list (concat
1348 "\\(" idlwave-variable "\\) *=") nil))) 1348 "\\(" idlwave-variable "\\) *=") nil)))
1349 1349
1350 "Associated list of statement matching regular expressions. 1350 "Associated list of statement matching regular expressions.
1351Each regular expression matches the start of an IDL statement. The 1351Each regular expression matches the start of an IDL statement. The
1352first element of each association is a symbol giving the statement 1352first element of each association is a symbol giving the statement
@@ -1540,15 +1540,15 @@ Capitalize system variables - action only
1540 (not (equal idlwave-shell-debug-modifiers '()))) 1540 (not (equal idlwave-shell-debug-modifiers '())))
1541 ;; Bind the debug commands also with the special modifiers. 1541 ;; Bind the debug commands also with the special modifiers.
1542 (let ((shift (memq 'shift idlwave-shell-debug-modifiers)) 1542 (let ((shift (memq 'shift idlwave-shell-debug-modifiers))
1543 (mods-noshift (delq 'shift 1543 (mods-noshift (delq 'shift
1544 (copy-sequence idlwave-shell-debug-modifiers)))) 1544 (copy-sequence idlwave-shell-debug-modifiers))))
1545 (define-key idlwave-mode-map 1545 (define-key idlwave-mode-map
1546 (vector (append mods-noshift (list (if shift ?C ?c)))) 1546 (vector (append mods-noshift (list (if shift ?C ?c))))
1547 'idlwave-shell-save-and-run) 1547 'idlwave-shell-save-and-run)
1548 (define-key idlwave-mode-map 1548 (define-key idlwave-mode-map
1549 (vector (append mods-noshift (list (if shift ?B ?b)))) 1549 (vector (append mods-noshift (list (if shift ?B ?b))))
1550 'idlwave-shell-break-here) 1550 'idlwave-shell-break-here)
1551 (define-key idlwave-mode-map 1551 (define-key idlwave-mode-map
1552 (vector (append mods-noshift (list (if shift ?E ?e)))) 1552 (vector (append mods-noshift (list (if shift ?E ?e))))
1553 'idlwave-shell-run-region))) 1553 'idlwave-shell-run-region)))
1554(define-key idlwave-mode-map "\C-c\C-d\C-c" 'idlwave-shell-save-and-run) 1554(define-key idlwave-mode-map "\C-c\C-d\C-c" 'idlwave-shell-save-and-run)
@@ -1584,7 +1584,7 @@ Capitalize system variables - action only
1584(define-key idlwave-mode-map "\M-\C-i" 'idlwave-complete) 1584(define-key idlwave-mode-map "\M-\C-i" 'idlwave-complete)
1585(define-key idlwave-mode-map "\C-c\C-i" 'idlwave-update-routine-info) 1585(define-key idlwave-mode-map "\C-c\C-i" 'idlwave-update-routine-info)
1586(define-key idlwave-mode-map "\C-c=" 'idlwave-resolve) 1586(define-key idlwave-mode-map "\C-c=" 'idlwave-resolve)
1587(define-key idlwave-mode-map 1587(define-key idlwave-mode-map
1588 (if (featurep 'xemacs) [(shift button3)] [(shift mouse-3)]) 1588 (if (featurep 'xemacs) [(shift button3)] [(shift mouse-3)])
1589 'idlwave-mouse-context-help) 1589 'idlwave-mouse-context-help)
1590 1590
@@ -1595,7 +1595,7 @@ Capitalize system variables - action only
1595; (lambda (char) 0))) 1595; (lambda (char) 0)))
1596(idlwave-action-and-binding "<" '(idlwave-surround -1 -1)) 1596(idlwave-action-and-binding "<" '(idlwave-surround -1 -1))
1597;; Binding works for both > and ->, by changing the length of the token. 1597;; Binding works for both > and ->, by changing the length of the token.
1598(idlwave-action-and-binding ">" '(idlwave-surround -1 -1 '(?-) 1 1598(idlwave-action-and-binding ">" '(idlwave-surround -1 -1 '(?-) 1
1599 'idlwave-gtr-pad-hook)) 1599 'idlwave-gtr-pad-hook))
1600(idlwave-action-and-binding "->" '(idlwave-surround -1 -1 nil 2) t) 1600(idlwave-action-and-binding "->" '(idlwave-surround -1 -1 nil 2) t)
1601(idlwave-action-and-binding "," '(idlwave-surround 0 -1)) 1601(idlwave-action-and-binding "," '(idlwave-surround 0 -1))
@@ -1629,7 +1629,7 @@ idlwave-mode-abbrev-table unless TABLE is non-nil."
1629 (error (apply 'define-abbrev args))))) 1629 (error (apply 'define-abbrev args)))))
1630 1630
1631(condition-case nil 1631(condition-case nil
1632 (modify-syntax-entry (string-to-char idlwave-abbrev-start-char) 1632 (modify-syntax-entry (string-to-char idlwave-abbrev-start-char)
1633 "w" idlwave-mode-syntax-table) 1633 "w" idlwave-mode-syntax-table)
1634 (error nil)) 1634 (error nil))
1635 1635
@@ -1702,7 +1702,7 @@ idlwave-mode-abbrev-table unless TABLE is non-nil."
1702(idlwave-define-abbrev "s" "size()" (idlwave-keyword-abbrev 1)) 1702(idlwave-define-abbrev "s" "size()" (idlwave-keyword-abbrev 1))
1703(idlwave-define-abbrev "wi" "widget_info()" (idlwave-keyword-abbrev 1)) 1703(idlwave-define-abbrev "wi" "widget_info()" (idlwave-keyword-abbrev 1))
1704(idlwave-define-abbrev "wc" "widget_control," (idlwave-keyword-abbrev 0)) 1704(idlwave-define-abbrev "wc" "widget_control," (idlwave-keyword-abbrev 0))
1705 1705
1706;; This section is reserved words only. (From IDL user manual) 1706;; This section is reserved words only. (From IDL user manual)
1707;; 1707;;
1708(idlwave-define-abbrev "and" "and" (idlwave-keyword-abbrev 0 t) t) 1708(idlwave-define-abbrev "and" "and" (idlwave-keyword-abbrev 0 t) t)
@@ -1751,7 +1751,7 @@ idlwave-mode-abbrev-table unless TABLE is non-nil."
1751(defvar imenu-extract-index-name-function) 1751(defvar imenu-extract-index-name-function)
1752(defvar imenu-prev-index-position-function) 1752(defvar imenu-prev-index-position-function)
1753;; defined later - so just make the compiler hush 1753;; defined later - so just make the compiler hush
1754(defvar idlwave-mode-menu) 1754(defvar idlwave-mode-menu)
1755(defvar idlwave-mode-debug-menu) 1755(defvar idlwave-mode-debug-menu)
1756 1756
1757;;;###autoload 1757;;;###autoload
@@ -1836,7 +1836,7 @@ The main features of this mode are
1836 \\i IF statement template 1836 \\i IF statement template
1837 \\elif IF-ELSE statement template 1837 \\elif IF-ELSE statement template
1838 \\b BEGIN 1838 \\b BEGIN
1839 1839
1840 For a full list, use \\[idlwave-list-abbrevs]. Some templates also 1840 For a full list, use \\[idlwave-list-abbrevs]. Some templates also
1841 have direct keybindings - see the list of keybindings below. 1841 have direct keybindings - see the list of keybindings below.
1842 1842
@@ -1878,26 +1878,26 @@ The main features of this mode are
1878 1878
1879 (interactive) 1879 (interactive)
1880 (kill-all-local-variables) 1880 (kill-all-local-variables)
1881 1881
1882 (if idlwave-startup-message 1882 (if idlwave-startup-message
1883 (message "Emacs IDLWAVE mode version %s." idlwave-mode-version)) 1883 (message "Emacs IDLWAVE mode version %s." idlwave-mode-version))
1884 (setq idlwave-startup-message nil) 1884 (setq idlwave-startup-message nil)
1885 1885
1886 (setq local-abbrev-table idlwave-mode-abbrev-table) 1886 (setq local-abbrev-table idlwave-mode-abbrev-table)
1887 (set-syntax-table idlwave-mode-syntax-table) 1887 (set-syntax-table idlwave-mode-syntax-table)
1888 1888
1889 (set (make-local-variable 'indent-line-function) 'idlwave-indent-and-action) 1889 (set (make-local-variable 'indent-line-function) 'idlwave-indent-and-action)
1890 1890
1891 (make-local-variable idlwave-comment-indent-function) 1891 (make-local-variable idlwave-comment-indent-function)
1892 (set idlwave-comment-indent-function 'idlwave-comment-hook) 1892 (set idlwave-comment-indent-function 'idlwave-comment-hook)
1893 1893
1894 (set (make-local-variable 'comment-start-skip) ";+[ \t]*") 1894 (set (make-local-variable 'comment-start-skip) ";+[ \t]*")
1895 (set (make-local-variable 'comment-start) ";") 1895 (set (make-local-variable 'comment-start) ";")
1896 (set (make-local-variable 'require-final-newline) mode-require-final-newline) 1896 (set (make-local-variable 'require-final-newline) mode-require-final-newline)
1897 (set (make-local-variable 'abbrev-all-caps) t) 1897 (set (make-local-variable 'abbrev-all-caps) t)
1898 (set (make-local-variable 'indent-tabs-mode) nil) 1898 (set (make-local-variable 'indent-tabs-mode) nil)
1899 (set (make-local-variable 'completion-ignore-case) t) 1899 (set (make-local-variable 'completion-ignore-case) t)
1900 1900
1901 (use-local-map idlwave-mode-map) 1901 (use-local-map idlwave-mode-map)
1902 1902
1903 (when (featurep 'easymenu) 1903 (when (featurep 'easymenu)
@@ -1907,11 +1907,11 @@ The main features of this mode are
1907 (setq mode-name "IDLWAVE") 1907 (setq mode-name "IDLWAVE")
1908 (setq major-mode 'idlwave-mode) 1908 (setq major-mode 'idlwave-mode)
1909 (setq abbrev-mode t) 1909 (setq abbrev-mode t)
1910 1910
1911 (set (make-local-variable idlwave-fill-function) 'idlwave-auto-fill) 1911 (set (make-local-variable idlwave-fill-function) 'idlwave-auto-fill)
1912 (setq comment-end "") 1912 (setq comment-end "")
1913 (set (make-local-variable 'comment-multi-line) nil) 1913 (set (make-local-variable 'comment-multi-line) nil)
1914 (set (make-local-variable 'paragraph-separate) 1914 (set (make-local-variable 'paragraph-separate)
1915 "[ \t\f]*$\\|[ \t]*;+[ \t]*$\\|;+[+=-_*]+$") 1915 "[ \t\f]*$\\|[ \t]*;+[ \t]*$\\|;+[+=-_*]+$")
1916 (set (make-local-variable 'paragraph-start) "[ \t\f]\\|[ \t]*;+[ \t]") 1916 (set (make-local-variable 'paragraph-start) "[ \t\f]\\|[ \t]*;+[ \t]")
1917 (set (make-local-variable 'paragraph-ignore-fill-prefix) nil) 1917 (set (make-local-variable 'paragraph-ignore-fill-prefix) nil)
@@ -1920,7 +1920,7 @@ The main features of this mode are
1920 ;; Set tag table list to use IDLTAGS as file name. 1920 ;; Set tag table list to use IDLTAGS as file name.
1921 (if (boundp 'tag-table-alist) 1921 (if (boundp 'tag-table-alist)
1922 (add-to-list 'tag-table-alist '("\\.pro$" . "IDLTAGS"))) 1922 (add-to-list 'tag-table-alist '("\\.pro$" . "IDLTAGS")))
1923 1923
1924 ;; Font-lock additions - originally Phil Williams, then Ulrik Dickow 1924 ;; Font-lock additions - originally Phil Williams, then Ulrik Dickow
1925 ;; Following line is for Emacs - XEmacs uses the corresponding property 1925 ;; Following line is for Emacs - XEmacs uses the corresponding property
1926 ;; on the `idlwave-mode' symbol. 1926 ;; on the `idlwave-mode' symbol.
@@ -1961,18 +1961,18 @@ The main features of this mode are
1961 (unless idlwave-setup-done 1961 (unless idlwave-setup-done
1962 (if (not (file-directory-p idlwave-config-directory)) 1962 (if (not (file-directory-p idlwave-config-directory))
1963 (make-directory idlwave-config-directory)) 1963 (make-directory idlwave-config-directory))
1964 (setq idlwave-user-catalog-file (expand-file-name 1964 (setq idlwave-user-catalog-file (expand-file-name
1965 idlwave-user-catalog-file 1965 idlwave-user-catalog-file
1966 idlwave-config-directory) 1966 idlwave-config-directory)
1967 idlwave-path-file (expand-file-name 1967 idlwave-path-file (expand-file-name
1968 idlwave-path-file 1968 idlwave-path-file
1969 idlwave-config-directory)) 1969 idlwave-config-directory))
1970 (idlwave-read-paths) ; we may need these early 1970 (idlwave-read-paths) ; we may need these early
1971 (setq idlwave-setup-done t))) 1971 (setq idlwave-setup-done t)))
1972 1972
1973;; 1973;;
1974;; Code Formatting ---------------------------------------------------- 1974;; Code Formatting ----------------------------------------------------
1975;; 1975;;
1976 1976
1977(defun idlwave-push-mark (&rest rest) 1977(defun idlwave-push-mark (&rest rest)
1978 "Push mark for compatibility with Emacs 18/19." 1978 "Push mark for compatibility with Emacs 18/19."
@@ -2121,7 +2121,7 @@ Also checks if the correct end statement has been used."
2121 (if (> end-pos eol-pos) 2121 (if (> end-pos eol-pos)
2122 (setq end-pos pos)) 2122 (setq end-pos pos))
2123 (goto-char end-pos) 2123 (goto-char end-pos)
2124 (setq end (buffer-substring 2124 (setq end (buffer-substring
2125 (progn 2125 (progn
2126 (skip-chars-backward "a-zA-Z") 2126 (skip-chars-backward "a-zA-Z")
2127 (point)) 2127 (point))
@@ -2143,7 +2143,7 @@ Also checks if the correct end statement has been used."
2143 (sit-for 1)) 2143 (sit-for 1))
2144 (t 2144 (t
2145 (beep) 2145 (beep)
2146 (message "Warning: Shouldn't this be \"%s\" instead of \"%s\"?" 2146 (message "Warning: Shouldn't this be \"%s\" instead of \"%s\"?"
2147 end1 end) 2147 end1 end)
2148 (sit-for 1)))))))) 2148 (sit-for 1))))))))
2149 ;;(delete-char 1)) 2149 ;;(delete-char 1))
@@ -2155,8 +2155,8 @@ Also checks if the correct end statement has been used."
2155 ((looking-at "pro\\|case\\|switch\\|function\\>") 2155 ((looking-at "pro\\|case\\|switch\\|function\\>")
2156 (assoc (downcase (match-string 0)) idlwave-block-matches)) 2156 (assoc (downcase (match-string 0)) idlwave-block-matches))
2157 ((looking-at "begin\\>") 2157 ((looking-at "begin\\>")
2158 (let ((limit (save-excursion 2158 (let ((limit (save-excursion
2159 (idlwave-beginning-of-statement) 2159 (idlwave-beginning-of-statement)
2160 (point)))) 2160 (point))))
2161 (cond 2161 (cond
2162 ((re-search-backward ":[ \t]*\\=" limit t) 2162 ((re-search-backward ":[ \t]*\\=" limit t)
@@ -2184,9 +2184,9 @@ Also checks if the correct end statement has been used."
2184 (insert "end") 2184 (insert "end")
2185 (idlwave-show-begin))) 2185 (idlwave-show-begin)))
2186 2186
2187(defun idlwave-gtr-pad-hook (char) 2187(defun idlwave-gtr-pad-hook (char)
2188 "Let the > symbol expand around -> if present. The new token length 2188 "Let the > symbol expand around -> if present. The new token length
2189is returned." 2189is returned."
2190 2) 2190 2)
2191 2191
2192(defun idlwave-surround (&optional before after escape-chars length ec-hook) 2192(defun idlwave-surround (&optional before after escape-chars length ec-hook)
@@ -2216,8 +2216,8 @@ return value."
2216 (let* ((length (or length 1)) ; establish a default for LENGTH 2216 (let* ((length (or length 1)) ; establish a default for LENGTH
2217 (prev-char (char-after (- (point) (1+ length))))) 2217 (prev-char (char-after (- (point) (1+ length)))))
2218 (when (or (not (memq prev-char escape-chars)) 2218 (when (or (not (memq prev-char escape-chars))
2219 (and (fboundp ec-hook) 2219 (and (fboundp ec-hook)
2220 (setq length 2220 (setq length
2221 (save-excursion (funcall ec-hook prev-char))))) 2221 (save-excursion (funcall ec-hook prev-char)))))
2222 (backward-char length) 2222 (backward-char length)
2223 (save-restriction 2223 (save-restriction
@@ -2439,7 +2439,7 @@ Returns non-nil if successfull."
2439 (let ((eos (save-excursion 2439 (let ((eos (save-excursion
2440 (idlwave-block-jump-out -1 'nomark) 2440 (idlwave-block-jump-out -1 'nomark)
2441 (point)))) 2441 (point))))
2442 (if (setq status (idlwave-find-key 2442 (if (setq status (idlwave-find-key
2443 idlwave-end-block-reg -1 'nomark eos)) 2443 idlwave-end-block-reg -1 'nomark eos))
2444 (idlwave-beginning-of-statement) 2444 (idlwave-beginning-of-statement)
2445 (message "No nested block before beginning of containing block."))) 2445 (message "No nested block before beginning of containing block.")))
@@ -2447,7 +2447,7 @@ Returns non-nil if successfull."
2447 (let ((eos (save-excursion 2447 (let ((eos (save-excursion
2448 (idlwave-block-jump-out 1 'nomark) 2448 (idlwave-block-jump-out 1 'nomark)
2449 (point)))) 2449 (point))))
2450 (if (setq status (idlwave-find-key 2450 (if (setq status (idlwave-find-key
2451 idlwave-begin-block-reg 1 'nomark eos)) 2451 idlwave-begin-block-reg 1 'nomark eos))
2452 (idlwave-end-of-statement) 2452 (idlwave-end-of-statement)
2453 (message "No nested block before end of containing block.")))) 2453 (message "No nested block before end of containing block."))))
@@ -2461,7 +2461,7 @@ The marks are pushed."
2461 (here (point))) 2461 (here (point)))
2462 (goto-char (point-max)) 2462 (goto-char (point-max))
2463 (if (re-search-backward idlwave-doclib-start nil t) 2463 (if (re-search-backward idlwave-doclib-start nil t)
2464 (progn 2464 (progn
2465 (setq beg (progn (beginning-of-line) (point))) 2465 (setq beg (progn (beginning-of-line) (point)))
2466 (if (re-search-forward idlwave-doclib-end nil t) 2466 (if (re-search-forward idlwave-doclib-end nil t)
2467 (progn 2467 (progn
@@ -2495,7 +2495,7 @@ actual statement."
2495 ((eq major-mode 'idlwave-shell-mode) 2495 ((eq major-mode 'idlwave-shell-mode)
2496 (if (re-search-backward idlwave-shell-prompt-pattern nil t) 2496 (if (re-search-backward idlwave-shell-prompt-pattern nil t)
2497 (goto-char (match-end 0)))) 2497 (goto-char (match-end 0))))
2498 (t 2498 (t
2499 (if (save-excursion (forward-line -1) (idlwave-is-continuation-line)) 2499 (if (save-excursion (forward-line -1) (idlwave-is-continuation-line))
2500 (idlwave-previous-statement) 2500 (idlwave-previous-statement)
2501 (beginning-of-line))))) 2501 (beginning-of-line)))))
@@ -2572,7 +2572,7 @@ If not in a statement just moves to end of line. Returns position."
2572 (let ((save-point (point))) 2572 (let ((save-point (point)))
2573 (when (re-search-forward ".*&" lim t) 2573 (when (re-search-forward ".*&" lim t)
2574 (goto-char (match-end 0)) 2574 (goto-char (match-end 0))
2575 (if (idlwave-quoted) 2575 (if (idlwave-quoted)
2576 (goto-char save-point) 2576 (goto-char save-point)
2577 (if (eq (char-after (- (point) 2)) ?&) (goto-char save-point)))) 2577 (if (eq (char-after (- (point) 2)) ?&) (goto-char save-point))))
2578 (point))) 2578 (point)))
@@ -2589,7 +2589,7 @@ If there is no label point is not moved and nil is returned."
2589 ;; - not in parenthesis (like a[0:3]) 2589 ;; - not in parenthesis (like a[0:3])
2590 ;; - not followed by another ":" in explicit class, ala a->b::c 2590 ;; - not followed by another ":" in explicit class, ala a->b::c
2591 ;; As many in this mode, this function is heuristic and not an exact 2591 ;; As many in this mode, this function is heuristic and not an exact
2592 ;; parser. 2592 ;; parser.
2593 (let* ((start (point)) 2593 (let* ((start (point))
2594 (eos (save-excursion (idlwave-end-of-statement) (point))) 2594 (eos (save-excursion (idlwave-end-of-statement) (point)))
2595 (end (idlwave-find-key ":" 1 'nomark eos))) 2595 (end (idlwave-find-key ":" 1 'nomark eos)))
@@ -2666,7 +2666,7 @@ equal sign will be surrounded by BEFORE and AFTER blanks. If
2666`idlwave-pad-keyword' is t then keyword assignment is treated just 2666`idlwave-pad-keyword' is t then keyword assignment is treated just
2667like assignment statements. When nil, spaces are removed for keyword 2667like assignment statements. When nil, spaces are removed for keyword
2668assignment. Any other value keeps the current space around the `='. 2668assignment. Any other value keeps the current space around the `='.
2669Limits in for loops are treated as keyword assignment. 2669Limits in for loops are treated as keyword assignment.
2670 2670
2671Starting with IDL 6.0, a number of op= assignments are available. 2671Starting with IDL 6.0, a number of op= assignments are available.
2672Since ambiguities of the form: 2672Since ambiguities of the form:
@@ -2681,25 +2681,25 @@ operators, such as ##=, ^=, etc., will be pre-padded.
2681 2681
2682See `idlwave-surround'." 2682See `idlwave-surround'."
2683 (if idlwave-surround-by-blank 2683 (if idlwave-surround-by-blank
2684 (let 2684 (let
2685 ((non-an-ops "\\(##\\|\\*\\|\\+\\|-\\|/\\|<\\|>\\|\\^\\)\\=") 2685 ((non-an-ops "\\(##\\|\\*\\|\\+\\|-\\|/\\|<\\|>\\|\\^\\)\\=")
2686 (an-ops 2686 (an-ops
2687 "\\s-\\(AND\\|EQ\\|GE\\|GT\\|LE\\|LT\\|MOD\\|NE\\|OR\\|XOR\\)\\=") 2687 "\\s-\\(AND\\|EQ\\|GE\\|GT\\|LE\\|LT\\|MOD\\|NE\\|OR\\|XOR\\)\\=")
2688 (len 1)) 2688 (len 1))
2689 2689
2690 (save-excursion 2690 (save-excursion
2691 (let ((case-fold-search t)) 2691 (let ((case-fold-search t))
2692 (backward-char) 2692 (backward-char)
2693 (if (or 2693 (if (or
2694 (re-search-backward non-an-ops nil t) 2694 (re-search-backward non-an-ops nil t)
2695 ;; Why doesn't ##? work for both? 2695 ;; Why doesn't ##? work for both?
2696 (re-search-backward "\\(#\\)\\=" nil t)) 2696 (re-search-backward "\\(#\\)\\=" nil t))
2697 (setq len (1+ (length (match-string 1)))) 2697 (setq len (1+ (length (match-string 1))))
2698 (when (re-search-backward an-ops nil t) 2698 (when (re-search-backward an-ops nil t)
2699 (setq begin nil) ; won't modify begin 2699 (setq begin nil) ; won't modify begin
2700 (setq len (1+ (length (match-string 1)))))))) 2700 (setq len (1+ (length (match-string 1))))))))
2701 2701
2702 (if (eq t idlwave-pad-keyword) 2702 (if (eq t idlwave-pad-keyword)
2703 ;; Everything gets padded equally 2703 ;; Everything gets padded equally
2704 (idlwave-surround before after nil len) 2704 (idlwave-surround before after nil len)
2705 ;; Treating keywords/for variables specially... 2705 ;; Treating keywords/for variables specially...
@@ -2710,22 +2710,22 @@ See `idlwave-surround'."
2710 (skip-chars-backward "= \t") 2710 (skip-chars-backward "= \t")
2711 (nth 2 (idlwave-where))))) 2711 (nth 2 (idlwave-where)))))
2712 (cond ((or (memq what '(function-keyword procedure-keyword)) 2712 (cond ((or (memq what '(function-keyword procedure-keyword))
2713 (memq (caar st) '(for pdef))) 2713 (memq (caar st) '(for pdef)))
2714 (cond 2714 (cond
2715 ((null idlwave-pad-keyword) 2715 ((null idlwave-pad-keyword)
2716 (idlwave-surround 0 0) 2716 (idlwave-surround 0 0)
2717 ) ; remove space 2717 ) ; remove space
2718 (t))) ; leave any spaces alone 2718 (t))) ; leave any spaces alone
2719 (t (idlwave-surround before after nil len)))))))) 2719 (t (idlwave-surround before after nil len))))))))
2720 2720
2721 2721
2722(defun idlwave-indent-and-action (&optional arg) 2722(defun idlwave-indent-and-action (&optional arg)
2723 "Call `idlwave-indent-line' and do expand actions. 2723 "Call `idlwave-indent-line' and do expand actions.
2724With prefix ARG non-nil, indent the entire sub-statement." 2724With prefix ARG non-nil, indent the entire sub-statement."
2725 (interactive "p") 2725 (interactive "p")
2726 (save-excursion 2726 (save-excursion
2727 (if (and idlwave-expand-generic-end 2727 (if (and idlwave-expand-generic-end
2728 (re-search-backward "\\<\\(end\\)\\s-*\\=" 2728 (re-search-backward "\\<\\(end\\)\\s-*\\="
2729 (max 0 (- (point) 10)) t) 2729 (max 0 (- (point) 10)) t)
2730 (looking-at "\\(end\\)\\([ \n\t]\\|\\'\\)")) 2730 (looking-at "\\(end\\)\\([ \n\t]\\|\\'\\)"))
2731 (progn (goto-char (match-end 1)) 2731 (progn (goto-char (match-end 1))
@@ -2735,7 +2735,7 @@ With prefix ARG non-nil, indent the entire sub-statement."
2735 (when (and (not arg) current-prefix-arg) 2735 (when (and (not arg) current-prefix-arg)
2736 (setq arg current-prefix-arg) 2736 (setq arg current-prefix-arg)
2737 (setq current-prefix-arg nil)) 2737 (setq current-prefix-arg nil))
2738 (if arg 2738 (if arg
2739 (idlwave-indent-statement) 2739 (idlwave-indent-statement)
2740 (idlwave-indent-line t))) 2740 (idlwave-indent-line t)))
2741 2741
@@ -2868,7 +2868,7 @@ Inserts spaces before markers at point."
2868 (save-excursion 2868 (save-excursion
2869 (cond 2869 (cond
2870 ;; Beginning of file 2870 ;; Beginning of file
2871 ((prog1 2871 ((prog1
2872 (idlwave-previous-statement) 2872 (idlwave-previous-statement)
2873 (setq beg-prev-pos (point))) 2873 (setq beg-prev-pos (point)))
2874 0) 2874 0)
@@ -2878,7 +2878,7 @@ Inserts spaces before markers at point."
2878 idlwave-main-block-indent)) 2878 idlwave-main-block-indent))
2879 ;; Begin block 2879 ;; Begin block
2880 ((idlwave-look-at idlwave-begin-block-reg t) 2880 ((idlwave-look-at idlwave-begin-block-reg t)
2881 (+ (idlwave-min-current-statement-indent) 2881 (+ (idlwave-min-current-statement-indent)
2882 idlwave-block-indent)) 2882 idlwave-block-indent))
2883 ;; End Block 2883 ;; End Block
2884 ((idlwave-look-at idlwave-end-block-reg t) 2884 ((idlwave-look-at idlwave-end-block-reg t)
@@ -2889,7 +2889,7 @@ Inserts spaces before markers at point."
2889 (idlwave-min-current-statement-indent))) 2889 (idlwave-min-current-statement-indent)))
2890 ;; idlwave-end-offset 2890 ;; idlwave-end-offset
2891 ;; idlwave-block-indent)) 2891 ;; idlwave-block-indent))
2892 2892
2893 ;; Default to current indent 2893 ;; Default to current indent
2894 ((idlwave-current-statement-indent)))))) 2894 ((idlwave-current-statement-indent))))))
2895 ;; adjust the indentation based on the current statement 2895 ;; adjust the indentation based on the current statement
@@ -2905,7 +2905,7 @@ Inserts spaces before markers at point."
2905 2905
2906(defun idlwave-calculate-paren-indent (beg-reg end-reg close-exp) 2906(defun idlwave-calculate-paren-indent (beg-reg end-reg close-exp)
2907 "Calculate the continuation indent inside a paren group. 2907 "Calculate the continuation indent inside a paren group.
2908Returns a cons-cell with (open . indent), where open is the 2908Returns a cons-cell with (open . indent), where open is the
2909location of the open paren" 2909location of the open paren"
2910 (let ((open (nth 1 (parse-partial-sexp beg-reg end-reg)))) 2910 (let ((open (nth 1 (parse-partial-sexp beg-reg end-reg))))
2911 ;; Found an innermost open paren. 2911 ;; Found an innermost open paren.
@@ -2946,24 +2946,24 @@ groupings, are treated separately."
2946 (end-reg (progn (beginning-of-line) (point))) 2946 (end-reg (progn (beginning-of-line) (point)))
2947 (beg-last-statement (save-excursion (idlwave-previous-statement) 2947 (beg-last-statement (save-excursion (idlwave-previous-statement)
2948 (point))) 2948 (point)))
2949 (beg-reg (progn (idlwave-start-of-substatement 'pre) 2949 (beg-reg (progn (idlwave-start-of-substatement 'pre)
2950 (if (eq (line-beginning-position) end-reg) 2950 (if (eq (line-beginning-position) end-reg)
2951 (goto-char beg-last-statement) 2951 (goto-char beg-last-statement)
2952 (point)))) 2952 (point))))
2953 (basic-indent (+ (idlwave-min-current-statement-indent end-reg) 2953 (basic-indent (+ (idlwave-min-current-statement-indent end-reg)
2954 idlwave-continuation-indent)) 2954 idlwave-continuation-indent))
2955 fancy-nonparen-indent fancy-paren-indent) 2955 fancy-nonparen-indent fancy-paren-indent)
2956 (cond 2956 (cond
2957 ;; Align then with its matching if, etc. 2957 ;; Align then with its matching if, etc.
2958 ((let ((matchers '(("\\<if\\>" . "[ \t]*then") 2958 ((let ((matchers '(("\\<if\\>" . "[ \t]*then")
2959 ("\\<\\(if\\|end\\(if\\)?\\)\\>" . "[ \t]*else") 2959 ("\\<\\(if\\|end\\(if\\)?\\)\\>" . "[ \t]*else")
2960 ("\\<\\(for\\|while\\)\\>" . "[ \t]*do") 2960 ("\\<\\(for\\|while\\)\\>" . "[ \t]*do")
2961 ("\\<\\(repeat\\|end\\(rep\\)?\\)\\>" . 2961 ("\\<\\(repeat\\|end\\(rep\\)?\\)\\>" .
2962 "[ \t]*until") 2962 "[ \t]*until")
2963 ("\\<case\\>" . "[ \t]*of"))) 2963 ("\\<case\\>" . "[ \t]*of")))
2964 match cont-re) 2964 match cont-re)
2965 (goto-char end-reg) 2965 (goto-char end-reg)
2966 (and 2966 (and
2967 (setq cont-re 2967 (setq cont-re
2968 (catch 'exit 2968 (catch 'exit
2969 (while (setq match (car matchers)) 2969 (while (setq match (car matchers))
@@ -2972,7 +2972,7 @@ groupings, are treated separately."
2972 (setq matchers (cdr matchers))))) 2972 (setq matchers (cdr matchers)))))
2973 (idlwave-find-key cont-re -1 'nomark beg-last-statement))) 2973 (idlwave-find-key cont-re -1 'nomark beg-last-statement)))
2974 (if (looking-at "end") ;; that one's special 2974 (if (looking-at "end") ;; that one's special
2975 (- (idlwave-current-indent) 2975 (- (idlwave-current-indent)
2976 (+ idlwave-block-indent idlwave-end-offset)) 2976 (+ idlwave-block-indent idlwave-end-offset))
2977 (idlwave-current-indent))) 2977 (idlwave-current-indent)))
2978 2978
@@ -2998,7 +2998,7 @@ groupings, are treated separately."
2998 (let* ((end-reg end-reg) 2998 (let* ((end-reg end-reg)
2999 (close-exp (progn 2999 (close-exp (progn
3000 (goto-char end-reg) 3000 (goto-char end-reg)
3001 (skip-chars-forward " \t") 3001 (skip-chars-forward " \t")
3002 (looking-at "\\s)"))) 3002 (looking-at "\\s)")))
3003 indent-cons) 3003 indent-cons)
3004 (catch 'loop 3004 (catch 'loop
@@ -3032,12 +3032,12 @@ groupings, are treated separately."
3032 (if (save-match-data (looking-at "[ \t$]*\\(;.*\\)?$")) 3032 (if (save-match-data (looking-at "[ \t$]*\\(;.*\\)?$"))
3033 nil 3033 nil
3034 (current-column))) 3034 (current-column)))
3035 3035
3036 ;; Continued assignment (with =): 3036 ;; Continued assignment (with =):
3037 ((catch 'assign ; 3037 ((catch 'assign ;
3038 (while (looking-at "[^=\n\r]*\\(=\\)[ \t]*") 3038 (while (looking-at "[^=\n\r]*\\(=\\)[ \t]*")
3039 (goto-char (match-end 0)) 3039 (goto-char (match-end 0))
3040 (if (null (idlwave-what-function beg-reg)) 3040 (if (null (idlwave-what-function beg-reg))
3041 (throw 'assign t)))) 3041 (throw 'assign t))))
3042 (unless (or 3042 (unless (or
3043 (idlwave-in-quote) 3043 (idlwave-in-quote)
@@ -3099,7 +3099,7 @@ possibility of unbalanced blocks."
3099 (let* ((here (point)) 3099 (let* ((here (point))
3100 (case-fold-search t) 3100 (case-fold-search t)
3101 (limit (if (>= dir 0) (point-max) (point-min))) 3101 (limit (if (>= dir 0) (point-max) (point-min)))
3102 (block-limit (if (>= dir 0) 3102 (block-limit (if (>= dir 0)
3103 idlwave-begin-block-reg 3103 idlwave-begin-block-reg
3104 idlwave-end-block-reg)) 3104 idlwave-end-block-reg))
3105 found 3105 found
@@ -3110,7 +3110,7 @@ possibility of unbalanced blocks."
3110 (idlwave-find-key 3110 (idlwave-find-key
3111 idlwave-begin-unit-reg dir t limit) 3111 idlwave-begin-unit-reg dir t limit)
3112 (end-of-line) 3112 (end-of-line)
3113 (idlwave-find-key 3113 (idlwave-find-key
3114 idlwave-end-unit-reg dir t limit))) 3114 idlwave-end-unit-reg dir t limit)))
3115 limit))) 3115 limit)))
3116 (if (>= dir 0) (end-of-line)) ;Make sure we are in current block 3116 (if (>= dir 0) (end-of-line)) ;Make sure we are in current block
@@ -3135,7 +3135,7 @@ possibility of unbalanced blocks."
3135 (or (null end-reg) (< (point) end-reg))) 3135 (or (null end-reg) (< (point) end-reg)))
3136 (unless comm-or-empty (setq min (min min (idlwave-current-indent))))) 3136 (unless comm-or-empty (setq min (min min (idlwave-current-indent)))))
3137 (if (or comm-or-empty (and end-reg (>= (point) end-reg))) 3137 (if (or comm-or-empty (and end-reg (>= (point) end-reg)))
3138 min 3138 min
3139 (min min (idlwave-current-indent)))))) 3139 (min min (idlwave-current-indent))))))
3140 3140
3141(defun idlwave-current-statement-indent (&optional last-line) 3141(defun idlwave-current-statement-indent (&optional last-line)
@@ -3161,10 +3161,10 @@ Skips any whitespace. Returns 0 if the end-of-line follows the whitespace."
3161Blank or comment-only lines following regular continuation lines (with 3161Blank or comment-only lines following regular continuation lines (with
3162`$') count as continuations too." 3162`$') count as continuations too."
3163 (save-excursion 3163 (save-excursion
3164 (or 3164 (or
3165 (idlwave-look-at "\\<\\$") 3165 (idlwave-look-at "\\<\\$")
3166 (catch 'loop 3166 (catch 'loop
3167 (while (and (looking-at "^[ \t]*\\(;.*\\)?$") 3167 (while (and (looking-at "^[ \t]*\\(;.*\\)?$")
3168 (eq (forward-line -1) 0)) 3168 (eq (forward-line -1) 0))
3169 (if (idlwave-look-at "\\<\\$") (throw 'loop t))))))) 3169 (if (idlwave-look-at "\\<\\$") (throw 'loop t)))))))
3170 3170
@@ -3262,7 +3262,7 @@ ignored."
3262 (beginning-of-line) (point)) 3262 (beginning-of-line) (point))
3263 (point)))) 3263 (point))))
3264 "[^;]")) 3264 "[^;]"))
3265 3265
3266 ;; Mark the beginning and end of the paragraph 3266 ;; Mark the beginning and end of the paragraph
3267 (goto-char bcl) 3267 (goto-char bcl)
3268 (while (and (looking-at fill-prefix-reg) 3268 (while (and (looking-at fill-prefix-reg)
@@ -3326,7 +3326,7 @@ ignored."
3326 (insert (make-string diff ?\ )))) 3326 (insert (make-string diff ?\ ))))
3327 (forward-line -1)) 3327 (forward-line -1))
3328 ) 3328 )
3329 3329
3330 ;; No hang. Instead find minimum indentation of paragraph 3330 ;; No hang. Instead find minimum indentation of paragraph
3331 ;; after first line. 3331 ;; after first line.
3332 ;; For the following while statement, since START is at the 3332 ;; For the following while statement, since START is at the
@@ -3358,7 +3358,7 @@ ignored."
3358 t) 3358 t)
3359 (current-column)) 3359 (current-column))
3360 indent)) 3360 indent))
3361 3361
3362 ;; try to keep point at its original place 3362 ;; try to keep point at its original place
3363 (goto-char here) 3363 (goto-char here)
3364 3364
@@ -3407,7 +3407,7 @@ If not found returns nil."
3407 (current-column))))) 3407 (current-column)))))
3408 3408
3409(defun idlwave-auto-fill () 3409(defun idlwave-auto-fill ()
3410 "Called to break lines in auto fill mode. 3410 "Called to break lines in auto fill mode.
3411Only fills non-comment lines if `idlwave-fill-comment-line-only' is 3411Only fills non-comment lines if `idlwave-fill-comment-line-only' is
3412non-nil. Places a continuation character at the end of the line if 3412non-nil. Places a continuation character at the end of the line if
3413not in a comment. Splits strings with IDL concatenation operator `+' 3413not in a comment. Splits strings with IDL concatenation operator `+'
@@ -3558,7 +3558,7 @@ is non-nil."
3558 (insert (current-time-string)) 3558 (insert (current-time-string))
3559 (insert ", " (user-full-name)) 3559 (insert ", " (user-full-name))
3560 (if (boundp 'user-mail-address) 3560 (if (boundp 'user-mail-address)
3561 (insert " <" user-mail-address ">") 3561 (insert " <" user-mail-address ">")
3562 (insert " <" (user-login-name) "@" (system-name) ">")) 3562 (insert " <" (user-login-name) "@" (system-name) ">"))
3563 ;; Remove extra spaces from line 3563 ;; Remove extra spaces from line
3564 (idlwave-fill-paragraph) 3564 (idlwave-fill-paragraph)
@@ -3584,7 +3584,7 @@ location on mark ring so that the user can return to previous point."
3584 (setq end (match-end 0))) 3584 (setq end (match-end 0)))
3585 (progn 3585 (progn
3586 (goto-char beg) 3586 (goto-char beg)
3587 (if (re-search-forward 3587 (if (re-search-forward
3588 (concat idlwave-doc-modifications-keyword ":") 3588 (concat idlwave-doc-modifications-keyword ":")
3589 end t) 3589 end t)
3590 (end-of-line) 3590 (end-of-line)
@@ -3682,7 +3682,7 @@ constants - a double quote followed by an octal digit."
3682 (not (idlwave-in-quote)) 3682 (not (idlwave-in-quote))
3683 (save-excursion 3683 (save-excursion
3684 (forward-char) 3684 (forward-char)
3685 (re-search-backward (concat "\\(" idlwave-idl-keywords 3685 (re-search-backward (concat "\\(" idlwave-idl-keywords
3686 "\\|[[(*+-/=,^><]\\)\\s-*\\*") limit t))))) 3686 "\\|[[(*+-/=,^><]\\)\\s-*\\*") limit t)))))
3687 3687
3688 3688
@@ -3728,7 +3728,7 @@ unless the optional second argument NOINDENT is non-nil."
3728 (indent-region beg end nil)) 3728 (indent-region beg end nil))
3729 (if (stringp prompt) 3729 (if (stringp prompt)
3730 (message prompt))))) 3730 (message prompt)))))
3731 3731
3732(defun idlwave-rw-case (string) 3732(defun idlwave-rw-case (string)
3733 "Make STRING have the case required by `idlwave-reserved-word-upcase'." 3733 "Make STRING have the case required by `idlwave-reserved-word-upcase'."
3734 (if idlwave-reserved-word-upcase 3734 (if idlwave-reserved-word-upcase
@@ -3746,7 +3746,7 @@ unless the optional second argument NOINDENT is non-nil."
3746(defun idlwave-case () 3746(defun idlwave-case ()
3747 "Build skeleton IDL case statement." 3747 "Build skeleton IDL case statement."
3748 (interactive) 3748 (interactive)
3749 (idlwave-template 3749 (idlwave-template
3750 (idlwave-rw-case "case") 3750 (idlwave-rw-case "case")
3751 (idlwave-rw-case " of\n\nendcase") 3751 (idlwave-rw-case " of\n\nendcase")
3752 "Selector expression")) 3752 "Selector expression"))
@@ -3754,7 +3754,7 @@ unless the optional second argument NOINDENT is non-nil."
3754(defun idlwave-switch () 3754(defun idlwave-switch ()
3755 "Build skeleton IDL switch statement." 3755 "Build skeleton IDL switch statement."
3756 (interactive) 3756 (interactive)
3757 (idlwave-template 3757 (idlwave-template
3758 (idlwave-rw-case "switch") 3758 (idlwave-rw-case "switch")
3759 (idlwave-rw-case " of\n\nendswitch") 3759 (idlwave-rw-case " of\n\nendswitch")
3760 "Selector expression")) 3760 "Selector expression"))
@@ -3762,7 +3762,7 @@ unless the optional second argument NOINDENT is non-nil."
3762(defun idlwave-for () 3762(defun idlwave-for ()
3763 "Build skeleton for loop statment." 3763 "Build skeleton for loop statment."
3764 (interactive) 3764 (interactive)
3765 (idlwave-template 3765 (idlwave-template
3766 (idlwave-rw-case "for") 3766 (idlwave-rw-case "for")
3767 (idlwave-rw-case " do begin\n\nendfor") 3767 (idlwave-rw-case " do begin\n\nendfor")
3768 "Loop expression")) 3768 "Loop expression"))
@@ -3777,14 +3777,14 @@ unless the optional second argument NOINDENT is non-nil."
3777 3777
3778(defun idlwave-procedure () 3778(defun idlwave-procedure ()
3779 (interactive) 3779 (interactive)
3780 (idlwave-template 3780 (idlwave-template
3781 (idlwave-rw-case "pro") 3781 (idlwave-rw-case "pro")
3782 (idlwave-rw-case "\n\nreturn\nend") 3782 (idlwave-rw-case "\n\nreturn\nend")
3783 "Procedure name")) 3783 "Procedure name"))
3784 3784
3785(defun idlwave-function () 3785(defun idlwave-function ()
3786 (interactive) 3786 (interactive)
3787 (idlwave-template 3787 (idlwave-template
3788 (idlwave-rw-case "function") 3788 (idlwave-rw-case "function")
3789 (idlwave-rw-case "\n\nreturn\nend") 3789 (idlwave-rw-case "\n\nreturn\nend")
3790 "Function name")) 3790 "Function name"))
@@ -3798,7 +3798,7 @@ unless the optional second argument NOINDENT is non-nil."
3798 3798
3799(defun idlwave-while () 3799(defun idlwave-while ()
3800 (interactive) 3800 (interactive)
3801 (idlwave-template 3801 (idlwave-template
3802 (idlwave-rw-case "while") 3802 (idlwave-rw-case "while")
3803 (idlwave-rw-case " do begin\n\nendwhile") 3803 (idlwave-rw-case " do begin\n\nendwhile")
3804 "Entry condition")) 3804 "Entry condition"))
@@ -3877,8 +3877,8 @@ Buffer containing unsaved changes require confirmation before they are killed."
3877(defun idlwave-count-outlawed-buffers (tag) 3877(defun idlwave-count-outlawed-buffers (tag)
3878 "How many outlawed buffers have tag TAG?" 3878 "How many outlawed buffers have tag TAG?"
3879 (length (delq nil 3879 (length (delq nil
3880 (mapcar 3880 (mapcar
3881 (lambda (x) (eq (cdr x) tag)) 3881 (lambda (x) (eq (cdr x) tag))
3882 idlwave-outlawed-buffers)))) 3882 idlwave-outlawed-buffers))))
3883 3883
3884(defun idlwave-do-kill-autoloaded-buffers (&rest reasons) 3884(defun idlwave-do-kill-autoloaded-buffers (&rest reasons)
@@ -3892,9 +3892,9 @@ Buffer containing unsaved changes require confirmation before they are killed."
3892 (memq (cdr entry) reasons)) 3892 (memq (cdr entry) reasons))
3893 (kill-buffer (car entry)) 3893 (kill-buffer (car entry))
3894 (incf cnt) 3894 (incf cnt)
3895 (setq idlwave-outlawed-buffers 3895 (setq idlwave-outlawed-buffers
3896 (delq entry idlwave-outlawed-buffers))) 3896 (delq entry idlwave-outlawed-buffers)))
3897 (setq idlwave-outlawed-buffers 3897 (setq idlwave-outlawed-buffers
3898 (delq entry idlwave-outlawed-buffers)))) 3898 (delq entry idlwave-outlawed-buffers))))
3899 (message "%d buffer%s killed" cnt (if (= cnt 1) "" "s")))) 3899 (message "%d buffer%s killed" cnt (if (= cnt 1) "" "s"))))
3900 3900
@@ -3906,7 +3906,7 @@ Intended for `after-save-hook'."
3906 (entry (assq buf idlwave-outlawed-buffers))) 3906 (entry (assq buf idlwave-outlawed-buffers)))
3907 ;; Revoke license 3907 ;; Revoke license
3908 (if entry 3908 (if entry
3909 (setq idlwave-outlawed-buffers 3909 (setq idlwave-outlawed-buffers
3910 (delq entry idlwave-outlawed-buffers))) 3910 (delq entry idlwave-outlawed-buffers)))
3911 ;; Remove this function from the hook. 3911 ;; Remove this function from the hook.
3912 (remove-hook 'after-save-hook 'idlwave-revoke-license-to-kill 'local))) 3912 (remove-hook 'after-save-hook 'idlwave-revoke-license-to-kill 'local)))
@@ -3925,7 +3925,7 @@ Intended for `after-save-hook'."
3925(defun idlwave-expand-lib-file-name (file) 3925(defun idlwave-expand-lib-file-name (file)
3926 ;; Find FILE on the scanned lib path and return a buffer visiting it 3926 ;; Find FILE on the scanned lib path and return a buffer visiting it
3927 ;; This is for, e.g., finding source with no user catalog 3927 ;; This is for, e.g., finding source with no user catalog
3928 (cond 3928 (cond
3929 ((null file) nil) 3929 ((null file) nil)
3930 ((file-name-absolute-p file) file) 3930 ((file-name-absolute-p file) file)
3931 (t (idlwave-locate-lib-file file)))) 3931 (t (idlwave-locate-lib-file file))))
@@ -3940,7 +3940,7 @@ you specify /."
3940 (interactive) 3940 (interactive)
3941 (let (directory directories cmd append status numdirs dir getsubdirs 3941 (let (directory directories cmd append status numdirs dir getsubdirs
3942 buffer save_buffer files numfiles item errbuf) 3942 buffer save_buffer files numfiles item errbuf)
3943 3943
3944 ;; 3944 ;;
3945 ;; Read list of directories 3945 ;; Read list of directories
3946 (setq directory (read-string "Tag Directories: " ".")) 3946 (setq directory (read-string "Tag Directories: " "."))
@@ -3992,7 +3992,7 @@ you specify /."
3992 (message (concat "Tagging " item "...")) 3992 (message (concat "Tagging " item "..."))
3993 (setq errbuf (get-buffer-create "*idltags-error*")) 3993 (setq errbuf (get-buffer-create "*idltags-error*"))
3994 (setq status (+ status 3994 (setq status (+ status
3995 (if (eq 0 (call-process 3995 (if (eq 0 (call-process
3996 "sh" nil errbuf nil "-c" 3996 "sh" nil errbuf nil "-c"
3997 (concat cmd append item))) 3997 (concat cmd append item)))
3998 0 3998 0
@@ -4006,13 +4006,13 @@ you specify /."
4006 (setq numfiles (1+ numfiles)) 4006 (setq numfiles (1+ numfiles))
4007 (setq item (nth numfiles files)) 4007 (setq item (nth numfiles files))
4008 ))) 4008 )))
4009 4009
4010 (setq numdirs (1+ numdirs)) 4010 (setq numdirs (1+ numdirs))
4011 (setq dir (nth numdirs directories))) 4011 (setq dir (nth numdirs directories)))
4012 (progn 4012 (progn
4013 (setq numdirs (1+ numdirs)) 4013 (setq numdirs (1+ numdirs))
4014 (setq dir (nth numdirs directories))))) 4014 (setq dir (nth numdirs directories)))))
4015 4015
4016 (setq errbuf (get-buffer-create "*idltags-error*")) 4016 (setq errbuf (get-buffer-create "*idltags-error*"))
4017 (if (= status 0) 4017 (if (= status 0)
4018 (kill-buffer errbuf)) 4018 (kill-buffer errbuf))
@@ -4088,7 +4088,7 @@ blank lines."
4088 ;; Make sure the hash functions are accessible. 4088 ;; Make sure the hash functions are accessible.
4089 (if (or (not (fboundp 'gethash)) 4089 (if (or (not (fboundp 'gethash))
4090 (not (fboundp 'puthash))) 4090 (not (fboundp 'puthash)))
4091 (progn 4091 (progn
4092 (require 'cl) 4092 (require 'cl)
4093 (or (fboundp 'puthash) 4093 (or (fboundp 'puthash)
4094 (defalias 'puthash 'cl-puthash)))) 4094 (defalias 'puthash 'cl-puthash))))
@@ -4107,7 +4107,7 @@ blank lines."
4107 ;; Reset the system & library hash 4107 ;; Reset the system & library hash
4108 (loop for entry in entries 4108 (loop for entry in entries
4109 for var = (car entry) for size = (nth 1 entry) 4109 for var = (car entry) for size = (nth 1 entry)
4110 do (setcdr (symbol-value var) 4110 do (setcdr (symbol-value var)
4111 (make-hash-table ':size size ':test 'equal))) 4111 (make-hash-table ':size size ':test 'equal)))
4112 (setq idlwave-sint-dirs nil 4112 (setq idlwave-sint-dirs nil
4113 idlwave-sint-libnames nil)) 4113 idlwave-sint-libnames nil))
@@ -4117,7 +4117,7 @@ blank lines."
4117 ;; Reset the buffer & shell hash 4117 ;; Reset the buffer & shell hash
4118 (loop for entry in entries 4118 (loop for entry in entries
4119 for var = (car entry) for size = (nth 1 entry) 4119 for var = (car entry) for size = (nth 1 entry)
4120 do (setcar (symbol-value var) 4120 do (setcar (symbol-value var)
4121 (make-hash-table ':size size ':test 'equal)))))) 4121 (make-hash-table ':size size ':test 'equal))))))
4122 4122
4123(defun idlwave-sintern-routine-or-method (name &optional class set) 4123(defun idlwave-sintern-routine-or-method (name &optional class set)
@@ -4204,11 +4204,11 @@ If DEFAULT-DIR is passed, it is used as the base of the directory"
4204 (setq class (idlwave-sintern-class class set)) 4204 (setq class (idlwave-sintern-class class set))
4205 (setq name (idlwave-sintern-method name set))) 4205 (setq name (idlwave-sintern-method name set)))
4206 (setq name (idlwave-sintern-routine name set))) 4206 (setq name (idlwave-sintern-routine name set)))
4207 4207
4208 ;; The source 4208 ;; The source
4209 (let ((source-type (car source)) 4209 (let ((source-type (car source))
4210 (source-file (nth 1 source)) 4210 (source-file (nth 1 source))
4211 (source-dir (if default-dir 4211 (source-dir (if default-dir
4212 (file-name-as-directory default-dir) 4212 (file-name-as-directory default-dir)
4213 (nth 2 source))) 4213 (nth 2 source)))
4214 (source-lib (nth 3 source))) 4214 (source-lib (nth 3 source)))
@@ -4217,7 +4217,7 @@ If DEFAULT-DIR is passed, it is used as the base of the directory"
4217 (if (stringp source-lib) 4217 (if (stringp source-lib)
4218 (setq source-lib (idlwave-sintern-libname source-lib set))) 4218 (setq source-lib (idlwave-sintern-libname source-lib set)))
4219 (setq source (list source-type source-file source-dir source-lib))) 4219 (setq source (list source-type source-file source-dir source-lib)))
4220 4220
4221 ;; The keywords 4221 ;; The keywords
4222 (setq kwds (mapcar (lambda (x) 4222 (setq kwds (mapcar (lambda (x)
4223 (idlwave-sintern-keyword-list x set)) 4223 (idlwave-sintern-keyword-list x set))
@@ -4355,10 +4355,10 @@ will re-read the catalog."
4355 "-l" (expand-file-name "~/.emacs") 4355 "-l" (expand-file-name "~/.emacs")
4356 "-l" "idlwave" 4356 "-l" "idlwave"
4357 "-f" "idlwave-rescan-catalog-directories")) 4357 "-f" "idlwave-rescan-catalog-directories"))
4358 (process (apply 'start-process "idlcat" 4358 (process (apply 'start-process "idlcat"
4359 nil emacs args))) 4359 nil emacs args)))
4360 (setq idlwave-catalog-process process) 4360 (setq idlwave-catalog-process process)
4361 (set-process-sentinel 4361 (set-process-sentinel
4362 process 4362 process
4363 (lambda (pro why) 4363 (lambda (pro why)
4364 (when (string-match "finished" why) 4364 (when (string-match "finished" why)
@@ -4431,7 +4431,7 @@ information updated immediately, leave NO-CONCATENATE nil."
4431 ;; The override-idle means, even if the idle timer has done some 4431 ;; The override-idle means, even if the idle timer has done some
4432 ;; preparing work, load and renormalize everything anyway. 4432 ;; preparing work, load and renormalize everything anyway.
4433 (override-idle (or arg idlwave-buffer-case-takes-precedence))) 4433 (override-idle (or arg idlwave-buffer-case-takes-precedence)))
4434 4434
4435 (setq idlwave-buffer-routines nil 4435 (setq idlwave-buffer-routines nil
4436 idlwave-compiled-routines nil 4436 idlwave-compiled-routines nil
4437 idlwave-unresolved-routines nil) 4437 idlwave-unresolved-routines nil)
@@ -4442,7 +4442,7 @@ information updated immediately, leave NO-CONCATENATE nil."
4442 (idlwave-reset-sintern (cond (load t) 4442 (idlwave-reset-sintern (cond (load t)
4443 ((null idlwave-system-routines) t) 4443 ((null idlwave-system-routines) t)
4444 (t 'bufsh)))) 4444 (t 'bufsh))))
4445 4445
4446 (if idlwave-buffer-case-takes-precedence 4446 (if idlwave-buffer-case-takes-precedence
4447 ;; We can safely scan the buffer stuff first 4447 ;; We can safely scan the buffer stuff first
4448 (progn 4448 (progn
@@ -4457,9 +4457,9 @@ information updated immediately, leave NO-CONCATENATE nil."
4457 (idlwave-shell-is-running))) 4457 (idlwave-shell-is-running)))
4458 (ask-shell (and shell-is-running 4458 (ask-shell (and shell-is-running
4459 idlwave-query-shell-for-routine-info))) 4459 idlwave-query-shell-for-routine-info)))
4460 4460
4461 ;; Load the library catalogs again, first re-scanning the path 4461 ;; Load the library catalogs again, first re-scanning the path
4462 (when arg 4462 (when arg
4463 (if shell-is-running 4463 (if shell-is-running
4464 (idlwave-shell-send-command idlwave-shell-path-query 4464 (idlwave-shell-send-command idlwave-shell-path-query
4465 '(progn 4465 '(progn
@@ -4479,7 +4479,7 @@ information updated immediately, leave NO-CONCATENATE nil."
4479 ;; Therefore, we do a concatenation now, even though 4479 ;; Therefore, we do a concatenation now, even though
4480 ;; the shell might do it again. 4480 ;; the shell might do it again.
4481 (idlwave-concatenate-rinfo-lists nil 'run-hooks)) 4481 (idlwave-concatenate-rinfo-lists nil 'run-hooks))
4482 4482
4483 (when ask-shell 4483 (when ask-shell
4484 ;; Ask the shell about the routines it knows of. 4484 ;; Ask the shell about the routines it knows of.
4485 (message "Querying the shell") 4485 (message "Querying the shell")
@@ -4541,7 +4541,7 @@ information updated immediately, leave NO-CONCATENATE nil."
4541 (progn 4541 (progn
4542 (setq idlwave-library-routines nil) 4542 (setq idlwave-library-routines nil)
4543 (ding) 4543 (ding)
4544 (message "Outdated user catalog: %s... recreate" 4544 (message "Outdated user catalog: %s... recreate"
4545 idlwave-user-catalog-file)) 4545 idlwave-user-catalog-file))
4546 (message "Loading user catalog in idle time...done")) 4546 (message "Loading user catalog in idle time...done"))
4547 (aset arr 2 t) 4547 (aset arr 2 t)
@@ -4549,15 +4549,15 @@ information updated immediately, leave NO-CONCATENATE nil."
4549 (when (not (aref arr 3)) 4549 (when (not (aref arr 3))
4550 (when idlwave-user-catalog-routines 4550 (when idlwave-user-catalog-routines
4551 (message "Normalizing user catalog routines in idle time...") 4551 (message "Normalizing user catalog routines in idle time...")
4552 (setq idlwave-user-catalog-routines 4552 (setq idlwave-user-catalog-routines
4553 (idlwave-sintern-rinfo-list 4553 (idlwave-sintern-rinfo-list
4554 idlwave-user-catalog-routines 'sys)) 4554 idlwave-user-catalog-routines 'sys))
4555 (message 4555 (message
4556 "Normalizing user catalog routines in idle time...done")) 4556 "Normalizing user catalog routines in idle time...done"))
4557 (aset arr 3 t) 4557 (aset arr 3 t)
4558 (throw 'exit t)) 4558 (throw 'exit t))
4559 (when (not (aref arr 4)) 4559 (when (not (aref arr 4))
4560 (idlwave-scan-library-catalogs 4560 (idlwave-scan-library-catalogs
4561 "Loading and normalizing library catalogs in idle time...") 4561 "Loading and normalizing library catalogs in idle time...")
4562 (aset arr 4 t) 4562 (aset arr 4 t)
4563 (throw 'exit t)) 4563 (throw 'exit t))
@@ -4598,8 +4598,8 @@ information updated immediately, leave NO-CONCATENATE nil."
4598 (setq idlwave-true-path-alist nil) 4598 (setq idlwave-true-path-alist nil)
4599 (when (or force (not (aref idlwave-load-rinfo-steps-done 3))) 4599 (when (or force (not (aref idlwave-load-rinfo-steps-done 3)))
4600 (message "Normalizing user catalog routines...") 4600 (message "Normalizing user catalog routines...")
4601 (setq idlwave-user-catalog-routines 4601 (setq idlwave-user-catalog-routines
4602 (idlwave-sintern-rinfo-list 4602 (idlwave-sintern-rinfo-list
4603 idlwave-user-catalog-routines 'sys)) 4603 idlwave-user-catalog-routines 'sys))
4604 (message "Normalizing user catalog routines...done"))) 4604 (message "Normalizing user catalog routines...done")))
4605 (when (or force (not (aref idlwave-load-rinfo-steps-done 4))) 4605 (when (or force (not (aref idlwave-load-rinfo-steps-done 4)))
@@ -4610,11 +4610,11 @@ information updated immediately, leave NO-CONCATENATE nil."
4610 4610
4611(defun idlwave-update-buffer-routine-info () 4611(defun idlwave-update-buffer-routine-info ()
4612 (let (res) 4612 (let (res)
4613 (cond 4613 (cond
4614 ((eq idlwave-scan-all-buffers-for-routine-info t) 4614 ((eq idlwave-scan-all-buffers-for-routine-info t)
4615 ;; Scan all buffers, current buffer last 4615 ;; Scan all buffers, current buffer last
4616 (message "Scanning all buffers...") 4616 (message "Scanning all buffers...")
4617 (setq res (idlwave-get-routine-info-from-buffers 4617 (setq res (idlwave-get-routine-info-from-buffers
4618 (reverse (buffer-list))))) 4618 (reverse (buffer-list)))))
4619 ((null idlwave-scan-all-buffers-for-routine-info) 4619 ((null idlwave-scan-all-buffers-for-routine-info)
4620 ;; Don't scan any buffers 4620 ;; Don't scan any buffers
@@ -4627,12 +4627,12 @@ information updated immediately, leave NO-CONCATENATE nil."
4627 (setq res (idlwave-get-routine-info-from-buffers 4627 (setq res (idlwave-get-routine-info-from-buffers
4628 (list (current-buffer)))))))) 4628 (list (current-buffer))))))))
4629 ;; Put the result into the correct variable 4629 ;; Put the result into the correct variable
4630 (setq idlwave-buffer-routines 4630 (setq idlwave-buffer-routines
4631 (idlwave-sintern-rinfo-list res 'set)))) 4631 (idlwave-sintern-rinfo-list res 'set))))
4632 4632
4633(defun idlwave-concatenate-rinfo-lists (&optional quiet run-hook) 4633(defun idlwave-concatenate-rinfo-lists (&optional quiet run-hook)
4634 "Put the different sources for routine information together." 4634 "Put the different sources for routine information together."
4635 ;; The sequence here is important because earlier definitions shadow 4635 ;; The sequence here is important because earlier definitions shadow
4636 ;; later ones. We assume that if things in the buffers are newer 4636 ;; later ones. We assume that if things in the buffers are newer
4637 ;; then in the shell of the system, they are meant to be different. 4637 ;; then in the shell of the system, they are meant to be different.
4638 (setcdr idlwave-last-system-routine-info-cons-cell 4638 (setcdr idlwave-last-system-routine-info-cons-cell
@@ -4644,7 +4644,7 @@ information updated immediately, leave NO-CONCATENATE nil."
4644 4644
4645 ;; Give a message with information about the number of routines we have. 4645 ;; Give a message with information about the number of routines we have.
4646 (unless quiet 4646 (unless quiet
4647 (message 4647 (message
4648 "Routines Found: buffer(%d) compiled(%d) library(%d) user(%d) system(%d)" 4648 "Routines Found: buffer(%d) compiled(%d) library(%d) user(%d) system(%d)"
4649 (length idlwave-buffer-routines) 4649 (length idlwave-buffer-routines)
4650 (length idlwave-compiled-routines) 4650 (length idlwave-compiled-routines)
@@ -4662,7 +4662,7 @@ information updated immediately, leave NO-CONCATENATE nil."
4662 (when (and (setq class (nth 2 x)) 4662 (when (and (setq class (nth 2 x))
4663 (not (assq class idlwave-class-alist))) 4663 (not (assq class idlwave-class-alist)))
4664 (push (list class) idlwave-class-alist))) 4664 (push (list class) idlwave-class-alist)))
4665 idlwave-class-alist))) 4665 idlwave-class-alist)))
4666 4666
4667;; Three functions for the hooks 4667;; Three functions for the hooks
4668(defun idlwave-save-buffer-update () 4668(defun idlwave-save-buffer-update ()
@@ -4695,7 +4695,7 @@ information updated immediately, leave NO-CONCATENATE nil."
4695 4695
4696(defun idlwave-replace-buffer-routine-info (file new) 4696(defun idlwave-replace-buffer-routine-info (file new)
4697 "Cut the part from FILE out of `idlwave-buffer-routines' and add NEW." 4697 "Cut the part from FILE out of `idlwave-buffer-routines' and add NEW."
4698 (let ((list idlwave-buffer-routines) 4698 (let ((list idlwave-buffer-routines)
4699 found) 4699 found)
4700 (while list 4700 (while list
4701 ;; The following test uses eq to make sure it works correctly 4701 ;; The following test uses eq to make sure it works correctly
@@ -4706,7 +4706,7 @@ information updated immediately, leave NO-CONCATENATE nil."
4706 (setcar list nil) 4706 (setcar list nil)
4707 (setq found t)) 4707 (setq found t))
4708 (if found 4708 (if found
4709 ;; End of that section reached. Jump. 4709 ;; End of that section reached. Jump.
4710 (setq list nil))) 4710 (setq list nil)))
4711 (setq list (cdr list))) 4711 (setq list (cdr list)))
4712 (setq idlwave-buffer-routines 4712 (setq idlwave-buffer-routines
@@ -4738,11 +4738,11 @@ information updated immediately, leave NO-CONCATENATE nil."
4738 (save-restriction 4738 (save-restriction
4739 (widen) 4739 (widen)
4740 (goto-char (point-min)) 4740 (goto-char (point-min))
4741 (while (re-search-forward 4741 (while (re-search-forward
4742 "^[ \t]*\\(pro\\|function\\)[ \t]" nil t) 4742 "^[ \t]*\\(pro\\|function\\)[ \t]" nil t)
4743 (setq string (buffer-substring-no-properties 4743 (setq string (buffer-substring-no-properties
4744 (match-beginning 0) 4744 (match-beginning 0)
4745 (progn 4745 (progn
4746 (idlwave-end-of-statement) 4746 (idlwave-end-of-statement)
4747 (point)))) 4747 (point))))
4748 (setq entry (idlwave-parse-definition string)) 4748 (setq entry (idlwave-parse-definition string))
@@ -4780,7 +4780,7 @@ information updated immediately, leave NO-CONCATENATE nil."
4780 (push (match-string 1 string) args))) 4780 (push (match-string 1 string) args)))
4781 ;; Normalize and sort. 4781 ;; Normalize and sort.
4782 (setq args (nreverse args)) 4782 (setq args (nreverse args))
4783 (setq keywords (sort keywords (lambda (a b) 4783 (setq keywords (sort keywords (lambda (a b)
4784 (string< (downcase a) (downcase b))))) 4784 (string< (downcase a) (downcase b)))))
4785 ;; Make and return the entry 4785 ;; Make and return the entry
4786 ;; We don't know which argument are optional, so this information 4786 ;; We don't know which argument are optional, so this information
@@ -4790,7 +4790,7 @@ information updated immediately, leave NO-CONCATENATE nil."
4790 class 4790 class
4791 (cond ((not (boundp 'idlwave-scanning-lib)) 4791 (cond ((not (boundp 'idlwave-scanning-lib))
4792 (list 'buffer (buffer-file-name))) 4792 (list 'buffer (buffer-file-name)))
4793; ((string= (downcase 4793; ((string= (downcase
4794; (file-name-sans-extension 4794; (file-name-sans-extension
4795; (file-name-nondirectory (buffer-file-name)))) 4795; (file-name-nondirectory (buffer-file-name))))
4796; (downcase name)) 4796; (downcase name))
@@ -4798,7 +4798,7 @@ information updated immediately, leave NO-CONCATENATE nil."
4798; (t (cons 'lib (file-name-nondirectory (buffer-file-name)))) 4798; (t (cons 'lib (file-name-nondirectory (buffer-file-name))))
4799 (t (list 'user (file-name-nondirectory (buffer-file-name)) 4799 (t (list 'user (file-name-nondirectory (buffer-file-name))
4800 idlwave-scanning-lib-dir "UserLib"))) 4800 idlwave-scanning-lib-dir "UserLib")))
4801 (concat 4801 (concat
4802 (if (string= type "function") "Result = " "") 4802 (if (string= type "function") "Result = " "")
4803 (if class "Obj ->[%s::]" "") 4803 (if class "Obj ->[%s::]" "")
4804 "%s" 4804 "%s"
@@ -4842,10 +4842,10 @@ time - so no widget will pop up."
4842 (> (length idlwave-user-catalog-file) 0) 4842 (> (length idlwave-user-catalog-file) 0)
4843 (file-accessible-directory-p 4843 (file-accessible-directory-p
4844 (file-name-directory idlwave-user-catalog-file)) 4844 (file-name-directory idlwave-user-catalog-file))
4845 (not (string= "" (file-name-nondirectory 4845 (not (string= "" (file-name-nondirectory
4846 idlwave-user-catalog-file)))) 4846 idlwave-user-catalog-file))))
4847 (error "`idlwave-user-catalog-file' does not point to a file in an accessible directory")) 4847 (error "`idlwave-user-catalog-file' does not point to a file in an accessible directory"))
4848 4848
4849 (cond 4849 (cond
4850 ;; Rescan the known directories 4850 ;; Rescan the known directories
4851 ((and arg idlwave-path-alist 4851 ((and arg idlwave-path-alist
@@ -4855,13 +4855,13 @@ time - so no widget will pop up."
4855 ;; Expand the directories from library-path and run the widget 4855 ;; Expand the directories from library-path and run the widget
4856 (idlwave-library-path 4856 (idlwave-library-path
4857 (idlwave-display-user-catalog-widget 4857 (idlwave-display-user-catalog-widget
4858 (if idlwave-true-path-alist 4858 (if idlwave-true-path-alist
4859 ;; Propagate any flags on the existing path-alist 4859 ;; Propagate any flags on the existing path-alist
4860 (mapcar (lambda (x) 4860 (mapcar (lambda (x)
4861 (let ((path-entry (assoc (file-truename x) 4861 (let ((path-entry (assoc (file-truename x)
4862 idlwave-true-path-alist))) 4862 idlwave-true-path-alist)))
4863 (if path-entry 4863 (if path-entry
4864 (cons x (cdr path-entry)) 4864 (cons x (cdr path-entry))
4865 (list x)))) 4865 (list x))))
4866 (idlwave-expand-path idlwave-library-path)) 4866 (idlwave-expand-path idlwave-library-path))
4867 (mapcar 'list (idlwave-expand-path idlwave-library-path))))) 4867 (mapcar 'list (idlwave-expand-path idlwave-library-path)))))
@@ -4886,7 +4886,7 @@ time - so no widget will pop up."
4886 (idlwave-scan-library-catalogs "Locating library catalogs..." 'no-load) 4886 (idlwave-scan-library-catalogs "Locating library catalogs..." 'no-load)
4887 (idlwave-display-user-catalog-widget idlwave-path-alist))) 4887 (idlwave-display-user-catalog-widget idlwave-path-alist)))
4888 4888
4889(defconst idlwave-user-catalog-widget-help-string 4889(defconst idlwave-user-catalog-widget-help-string
4890 "This is the front-end to the creation of the IDLWAVE user catalog. 4890 "This is the front-end to the creation of the IDLWAVE user catalog.
4891Please select the directories on IDL's search path from which you 4891Please select the directories on IDL's search path from which you
4892would like to extract routine information, to be stored in the file: 4892would like to extract routine information, to be stored in the file:
@@ -4921,7 +4921,7 @@ directories and save the routine info.
4921 (make-local-variable 'idlwave-widget) 4921 (make-local-variable 'idlwave-widget)
4922 (widget-insert (format idlwave-user-catalog-widget-help-string 4922 (widget-insert (format idlwave-user-catalog-widget-help-string
4923 idlwave-user-catalog-file)) 4923 idlwave-user-catalog-file))
4924 4924
4925 (widget-create 'push-button 4925 (widget-create 'push-button
4926 :notify 'idlwave-widget-scan-user-lib-files 4926 :notify 'idlwave-widget-scan-user-lib-files
4927 "Scan & Save") 4927 "Scan & Save")
@@ -4931,7 +4931,7 @@ directories and save the routine info.
4931 "Delete File") 4931 "Delete File")
4932 (widget-insert " ") 4932 (widget-insert " ")
4933 (widget-create 'push-button 4933 (widget-create 'push-button
4934 :notify 4934 :notify
4935 '(lambda (&rest ignore) 4935 '(lambda (&rest ignore)
4936 (let ((path-list (widget-get idlwave-widget :path-dirs))) 4936 (let ((path-list (widget-get idlwave-widget :path-dirs)))
4937 (mapcar (lambda (x) 4937 (mapcar (lambda (x)
@@ -4942,7 +4942,7 @@ directories and save the routine info.
4942 "Select All Non-Lib") 4942 "Select All Non-Lib")
4943 (widget-insert " ") 4943 (widget-insert " ")
4944 (widget-create 'push-button 4944 (widget-create 'push-button
4945 :notify 4945 :notify
4946 '(lambda (&rest ignore) 4946 '(lambda (&rest ignore)
4947 (let ((path-list (widget-get idlwave-widget :path-dirs))) 4947 (let ((path-list (widget-get idlwave-widget :path-dirs)))
4948 (mapcar (lambda (x) 4948 (mapcar (lambda (x)
@@ -4958,18 +4958,18 @@ directories and save the routine info.
4958 (widget-insert "\n\n") 4958 (widget-insert "\n\n")
4959 4959
4960 (widget-insert "Select Directories: \n") 4960 (widget-insert "Select Directories: \n")
4961 4961
4962 (setq idlwave-widget 4962 (setq idlwave-widget
4963 (apply 'widget-create 4963 (apply 'widget-create
4964 'checklist 4964 'checklist
4965 :value (delq nil (mapcar (lambda (x) 4965 :value (delq nil (mapcar (lambda (x)
4966 (if (memq 'user (cdr x)) 4966 (if (memq 'user (cdr x))
4967 (car x))) 4967 (car x)))
4968 dirs-list)) 4968 dirs-list))
4969 :greedy t 4969 :greedy t
4970 :tag "List of directories" 4970 :tag "List of directories"
4971 (mapcar (lambda (x) 4971 (mapcar (lambda (x)
4972 (list 'item 4972 (list 'item
4973 (if (memq 'lib (cdr x)) 4973 (if (memq 'lib (cdr x))
4974 (concat "[LIB] " (car x) ) 4974 (concat "[LIB] " (car x) )
4975 (car x)))) dirs-list))) 4975 (car x)))) dirs-list)))
@@ -4979,7 +4979,7 @@ directories and save the routine info.
4979 (widget-setup) 4979 (widget-setup)
4980 (goto-char (point-min)) 4980 (goto-char (point-min))
4981 (delete-other-windows)) 4981 (delete-other-windows))
4982 4982
4983(defun idlwave-delete-user-catalog-file (&rest ignore) 4983(defun idlwave-delete-user-catalog-file (&rest ignore)
4984 (if (yes-or-no-p 4984 (if (yes-or-no-p
4985 (format "Delete file %s " idlwave-user-catalog-file)) 4985 (format "Delete file %s " idlwave-user-catalog-file))
@@ -4995,7 +4995,7 @@ directories and save the routine info.
4995 (this-path-alist path-alist) 4995 (this-path-alist path-alist)
4996 dir-entry) 4996 dir-entry)
4997 (while (setq dir-entry (pop this-path-alist)) 4997 (while (setq dir-entry (pop this-path-alist))
4998 (if (member 4998 (if (member
4999 (if (memq 'lib (cdr dir-entry)) 4999 (if (memq 'lib (cdr dir-entry))
5000 (concat "[LIB] " (car dir-entry)) 5000 (concat "[LIB] " (car dir-entry))
5001 (car dir-entry)) 5001 (car dir-entry))
@@ -5092,7 +5092,7 @@ directories and save the routine info.
5092 ;; Define the variable which knows the value of "!DIR" 5092 ;; Define the variable which knows the value of "!DIR"
5093 (insert (format "\n(setq idlwave-system-directory \"%s\")\n" 5093 (insert (format "\n(setq idlwave-system-directory \"%s\")\n"
5094 idlwave-system-directory)) 5094 idlwave-system-directory))
5095 5095
5096 ;; Define the variable which contains a list of all scanned directories 5096 ;; Define the variable which contains a list of all scanned directories
5097 (insert "\n(setq idlwave-path-alist\n '(") 5097 (insert "\n(setq idlwave-path-alist\n '(")
5098 (let ((standard-output (current-buffer))) 5098 (let ((standard-output (current-buffer)))
@@ -5132,7 +5132,7 @@ directories and save the routine info.
5132 (when (file-directory-p dir) 5132 (when (file-directory-p dir)
5133 (setq files (nreverse (directory-files dir t "[^.]"))) 5133 (setq files (nreverse (directory-files dir t "[^.]")))
5134 (while (setq file (pop files)) 5134 (while (setq file (pop files))
5135 (if (file-directory-p file) 5135 (if (file-directory-p file)
5136 (push (file-name-as-directory file) path))) 5136 (push (file-name-as-directory file) path)))
5137 (push dir path1))) 5137 (push dir path1)))
5138 path1)) 5138 path1))
@@ -5141,7 +5141,7 @@ directories and save the routine info.
5141;;----- Scanning the library catalogs ------------------ 5141;;----- Scanning the library catalogs ------------------
5142 5142
5143(defun idlwave-scan-library-catalogs (&optional message-base no-load) 5143(defun idlwave-scan-library-catalogs (&optional message-base no-load)
5144 "Scan for library catalog files (.idlwave_catalog) and ingest. 5144 "Scan for library catalog files (.idlwave_catalog) and ingest.
5145 5145
5146All directories on `idlwave-path-alist' (or `idlwave-library-path' 5146All directories on `idlwave-path-alist' (or `idlwave-library-path'
5147instead, if present) are searched. Print MESSAGE-BASE along with the 5147instead, if present) are searched. Print MESSAGE-BASE along with the
@@ -5149,7 +5149,7 @@ libraries being loaded, if passed, and skip loading/normalizing if
5149NO-LOAD is non-nil. The variable `idlwave-use-library-catalogs' can 5149NO-LOAD is non-nil. The variable `idlwave-use-library-catalogs' can
5150be set to nil to disable library catalog scanning." 5150be set to nil to disable library catalog scanning."
5151 (when idlwave-use-library-catalogs 5151 (when idlwave-use-library-catalogs
5152 (let ((dirs 5152 (let ((dirs
5153 (if idlwave-library-path 5153 (if idlwave-library-path
5154 (idlwave-expand-path idlwave-library-path) 5154 (idlwave-expand-path idlwave-library-path)
5155 (mapcar 'car idlwave-path-alist))) 5155 (mapcar 'car idlwave-path-alist)))
@@ -5158,7 +5158,7 @@ be set to nil to disable library catalog scanning."
5158 (if message-base (message message-base)) 5158 (if message-base (message message-base))
5159 (while (setq dir (pop dirs)) 5159 (while (setq dir (pop dirs))
5160 (catch 'continue 5160 (catch 'continue
5161 (when (file-readable-p 5161 (when (file-readable-p
5162 (setq catalog (expand-file-name ".idlwave_catalog" dir))) 5162 (setq catalog (expand-file-name ".idlwave_catalog" dir)))
5163 (unless no-load 5163 (unless no-load
5164 (setq idlwave-library-catalog-routines nil) 5164 (setq idlwave-library-catalog-routines nil)
@@ -5166,20 +5166,20 @@ be set to nil to disable library catalog scanning."
5166 (condition-case nil 5166 (condition-case nil
5167 (load catalog t t t) 5167 (load catalog t t t)
5168 (error (throw 'continue t))) 5168 (error (throw 'continue t)))
5169 (when (and 5169 (when (and
5170 message-base 5170 message-base
5171 (not (string= idlwave-library-catalog-libname 5171 (not (string= idlwave-library-catalog-libname
5172 old-libname))) 5172 old-libname)))
5173 (message (concat message-base 5173 (message (concat message-base
5174 idlwave-library-catalog-libname)) 5174 idlwave-library-catalog-libname))
5175 (setq old-libname idlwave-library-catalog-libname)) 5175 (setq old-libname idlwave-library-catalog-libname))
5176 (when idlwave-library-catalog-routines 5176 (when idlwave-library-catalog-routines
5177 (setq all-routines 5177 (setq all-routines
5178 (append 5178 (append
5179 (idlwave-sintern-rinfo-list 5179 (idlwave-sintern-rinfo-list
5180 idlwave-library-catalog-routines 'sys dir) 5180 idlwave-library-catalog-routines 'sys dir)
5181 all-routines)))) 5181 all-routines))))
5182 5182
5183 ;; Add a 'lib flag if on path-alist 5183 ;; Add a 'lib flag if on path-alist
5184 (when (and idlwave-path-alist 5184 (when (and idlwave-path-alist
5185 (setq dir-entry (assoc dir idlwave-path-alist))) 5185 (setq dir-entry (assoc dir idlwave-path-alist)))
@@ -5190,17 +5190,17 @@ be set to nil to disable library catalog scanning."
5190;;----- Communicating with the Shell ------------------- 5190;;----- Communicating with the Shell -------------------
5191 5191
5192;; First, here is the idl program which can be used to query IDL for 5192;; First, here is the idl program which can be used to query IDL for
5193;; defined routines. 5193;; defined routines.
5194(defconst idlwave-routine-info.pro 5194(defconst idlwave-routine-info.pro
5195 " 5195 "
5196;; START OF IDLWAVE SUPPORT ROUTINES 5196;; START OF IDLWAVE SUPPORT ROUTINES
5197pro idlwave_print_info_entry,name,func=func,separator=sep 5197pro idlwave_print_info_entry,name,func=func,separator=sep
5198 ;; See if it's an object method 5198 ;; See if it's an object method
5199 if name eq '' then return 5199 if name eq '' then return
5200 func = keyword_set(func) 5200 func = keyword_set(func)
5201 methsep = strpos(name,'::') 5201 methsep = strpos(name,'::')
5202 meth = methsep ne -1 5202 meth = methsep ne -1
5203 5203
5204 ;; Get routine info 5204 ;; Get routine info
5205 pars = routine_info(name,/parameters,functions=func) 5205 pars = routine_info(name,/parameters,functions=func)
5206 source = routine_info(name,/source,functions=func) 5206 source = routine_info(name,/source,functions=func)
@@ -5208,12 +5208,12 @@ pro idlwave_print_info_entry,name,func=func,separator=sep
5208 nkw = pars.num_kw_args 5208 nkw = pars.num_kw_args
5209 if nargs gt 0 then args = pars.args 5209 if nargs gt 0 then args = pars.args
5210 if nkw gt 0 then kwargs = pars.kw_args 5210 if nkw gt 0 then kwargs = pars.kw_args
5211 5211
5212 ;; Trim the class, and make the name 5212 ;; Trim the class, and make the name
5213 if meth then begin 5213 if meth then begin
5214 class = strmid(name,0,methsep) 5214 class = strmid(name,0,methsep)
5215 name = strmid(name,methsep+2,strlen(name)-1) 5215 name = strmid(name,methsep+2,strlen(name)-1)
5216 if nargs gt 0 then begin 5216 if nargs gt 0 then begin
5217 ;; remove the self argument 5217 ;; remove the self argument
5218 wh = where(args ne 'SELF',nargs) 5218 wh = where(args ne 'SELF',nargs)
5219 if nargs gt 0 then args = args[wh] 5219 if nargs gt 0 then args = args[wh]
@@ -5222,7 +5222,7 @@ pro idlwave_print_info_entry,name,func=func,separator=sep
5222 ;; No class, just a normal routine. 5222 ;; No class, just a normal routine.
5223 class = \"\" 5223 class = \"\"
5224 endelse 5224 endelse
5225 5225
5226 ;; Calling sequence 5226 ;; Calling sequence
5227 cs = \"\" 5227 cs = \"\"
5228 if func then cs = 'Result = ' 5228 if func then cs = 'Result = '
@@ -5243,9 +5243,9 @@ pro idlwave_print_info_entry,name,func=func,separator=sep
5243 kwstring = kwstring + ' ' + kwargs[j] 5243 kwstring = kwstring + ' ' + kwargs[j]
5244 endfor 5244 endfor
5245 endif 5245 endif
5246 5246
5247 ret=(['IDLWAVE-PRO','IDLWAVE-FUN'])[func] 5247 ret=(['IDLWAVE-PRO','IDLWAVE-FUN'])[func]
5248 5248
5249 print,ret + ': ' + name + sep + class + sep + source[0].path $ 5249 print,ret + ': ' + name + sep + class + sep + source[0].path $
5250 + sep + cs + sep + kwstring 5250 + sep + cs + sep + kwstring
5251end 5251end
@@ -5285,7 +5285,7 @@ pro idlwave_get_class_tags, class
5285 if res then print,'IDLWAVE-CLASS-TAGS: '+class+' '+strjoin(tags,' ',/single) 5285 if res then print,'IDLWAVE-CLASS-TAGS: '+class+' '+strjoin(tags,' ',/single)
5286end 5286end
5287;; END OF IDLWAVE SUPPORT ROUTINES 5287;; END OF IDLWAVE SUPPORT ROUTINES
5288" 5288"
5289 "The idl programs to get info from the shell.") 5289 "The idl programs to get info from the shell.")
5290 5290
5291(defvar idlwave-idlwave_routine_info-compiled nil 5291(defvar idlwave-idlwave_routine_info-compiled nil
@@ -5308,12 +5308,12 @@ end
5308 (erase-buffer) 5308 (erase-buffer)
5309 (insert idlwave-routine-info.pro) 5309 (insert idlwave-routine-info.pro)
5310 (save-buffer 0)) 5310 (save-buffer 0))
5311 (idlwave-shell-send-command 5311 (idlwave-shell-send-command
5312 (concat ".run " idlwave-shell-temp-pro-file) 5312 (concat ".run " idlwave-shell-temp-pro-file)
5313 nil 'hide wait) 5313 nil 'hide wait)
5314; (message "SENDING SAVE") ; ???????????????????????? 5314; (message "SENDING SAVE") ; ????????????????????????
5315 (idlwave-shell-send-command 5315 (idlwave-shell-send-command
5316 (format "save,'idlwave_routine_info','idlwave_print_info_entry','idlwave_get_class_tags','idlwave_get_sysvars',FILE='%s',/ROUTINES" 5316 (format "save,'idlwave_routine_info','idlwave_print_info_entry','idlwave_get_class_tags','idlwave_get_sysvars',FILE='%s',/ROUTINES"
5317 (idlwave-shell-temp-file 'rinfo)) 5317 (idlwave-shell-temp-file 'rinfo))
5318 nil 'hide wait)) 5318 nil 'hide wait))
5319 5319
@@ -5396,7 +5396,7 @@ When we force a method or a method keyword, CLASS can specify the class."
5396 (completion-regexp-list 5396 (completion-regexp-list
5397 (if (equal arg '(16)) 5397 (if (equal arg '(16))
5398 (list (read-string (concat "Completion Regexp: ")))))) 5398 (list (read-string (concat "Completion Regexp: "))))))
5399 5399
5400 (if (and module (string-match "::" module)) 5400 (if (and module (string-match "::" module))
5401 (setq class (substring module 0 (match-beginning 0)) 5401 (setq class (substring module 0 (match-beginning 0))
5402 module (substring module (match-end 0)))) 5402 module (substring module (match-end 0))))
@@ -5417,7 +5417,7 @@ When we force a method or a method keyword, CLASS can specify the class."
5417 ;; Check for any special completion functions 5417 ;; Check for any special completion functions
5418 ((and idlwave-complete-special 5418 ((and idlwave-complete-special
5419 (idlwave-call-special idlwave-complete-special))) 5419 (idlwave-call-special idlwave-complete-special)))
5420 5420
5421 ((null what) 5421 ((null what)
5422 (error "Nothing to complete here")) 5422 (error "Nothing to complete here"))
5423 5423
@@ -5434,7 +5434,7 @@ When we force a method or a method keyword, CLASS can specify the class."
5434 (idlwave-all-class-inherits class-selector))) 5434 (idlwave-all-class-inherits class-selector)))
5435 (isa (concat "procedure" (if class-selector "-method" ""))) 5435 (isa (concat "procedure" (if class-selector "-method" "")))
5436 (type-selector 'pro)) 5436 (type-selector 'pro))
5437 (setq idlwave-completion-help-info 5437 (setq idlwave-completion-help-info
5438 (list 'routine nil type-selector class-selector nil super-classes)) 5438 (list 'routine nil type-selector class-selector nil super-classes))
5439 (idlwave-complete-in-buffer 5439 (idlwave-complete-in-buffer
5440 'procedure (if class-selector 'method 'routine) 5440 'procedure (if class-selector 'method 'routine)
@@ -5442,8 +5442,8 @@ When we force a method or a method keyword, CLASS can specify the class."
5442 (format "Select a %s name%s" 5442 (format "Select a %s name%s"
5443 isa 5443 isa
5444 (if class-selector 5444 (if class-selector
5445 (format " (class is %s)" 5445 (format " (class is %s)"
5446 (if (eq class-selector t) 5446 (if (eq class-selector t)
5447 "unknown" class-selector)) 5447 "unknown" class-selector))
5448 "")) 5448 ""))
5449 isa 5449 isa
@@ -5457,7 +5457,7 @@ When we force a method or a method keyword, CLASS can specify the class."
5457 (idlwave-all-class-inherits class-selector))) 5457 (idlwave-all-class-inherits class-selector)))
5458 (isa (concat "function" (if class-selector "-method" ""))) 5458 (isa (concat "function" (if class-selector "-method" "")))
5459 (type-selector 'fun)) 5459 (type-selector 'fun))
5460 (setq idlwave-completion-help-info 5460 (setq idlwave-completion-help-info
5461 (list 'routine nil type-selector class-selector nil super-classes)) 5461 (list 'routine nil type-selector class-selector nil super-classes))
5462 (idlwave-complete-in-buffer 5462 (idlwave-complete-in-buffer
5463 'function (if class-selector 'method 'routine) 5463 'function (if class-selector 'method 'routine)
@@ -5465,7 +5465,7 @@ When we force a method or a method keyword, CLASS can specify the class."
5465 (format "Select a %s name%s" 5465 (format "Select a %s name%s"
5466 isa 5466 isa
5467 (if class-selector 5467 (if class-selector
5468 (format " (class is %s)" 5468 (format " (class is %s)"
5469 (if (eq class-selector t) 5469 (if (eq class-selector t)
5470 "unknown" class-selector)) 5470 "unknown" class-selector))
5471 "")) 5471 ""))
@@ -5495,14 +5495,14 @@ When we force a method or a method keyword, CLASS can specify the class."
5495 (setq list (idlwave-fix-keywords name 'pro class list super-classes)) 5495 (setq list (idlwave-fix-keywords name 'pro class list super-classes))
5496 (unless list (error (format "No keywords available for procedure %s" 5496 (unless list (error (format "No keywords available for procedure %s"
5497 (idlwave-make-full-name class name)))) 5497 (idlwave-make-full-name class name))))
5498 (setq idlwave-completion-help-info 5498 (setq idlwave-completion-help-info
5499 (list 'keyword name type-selector class-selector entry super-classes)) 5499 (list 'keyword name type-selector class-selector entry super-classes))
5500 (idlwave-complete-in-buffer 5500 (idlwave-complete-in-buffer
5501 'keyword 'keyword list nil 5501 'keyword 'keyword list nil
5502 (format "Select keyword for procedure %s%s" 5502 (format "Select keyword for procedure %s%s"
5503 (idlwave-make-full-name class name) 5503 (idlwave-make-full-name class name)
5504 (if (or (member '("_EXTRA") list) 5504 (if (or (member '("_EXTRA") list)
5505 (member '("_REF_EXTRA") list)) 5505 (member '("_REF_EXTRA") list))
5506 " (note _EXTRA)" "")) 5506 " (note _EXTRA)" ""))
5507 isa 5507 isa
5508 'idlwave-attach-keyword-classes))) 5508 'idlwave-attach-keyword-classes)))
@@ -5533,13 +5533,13 @@ When we force a method or a method keyword, CLASS can specify the class."
5533 (idlwave-make-full-name class name))) 5533 (idlwave-make-full-name class name)))
5534 (unless list (error (format "No keywords available for function %s" 5534 (unless list (error (format "No keywords available for function %s"
5535 msg-name))) 5535 msg-name)))
5536 (setq idlwave-completion-help-info 5536 (setq idlwave-completion-help-info
5537 (list 'keyword name type-selector class-selector nil super-classes)) 5537 (list 'keyword name type-selector class-selector nil super-classes))
5538 (idlwave-complete-in-buffer 5538 (idlwave-complete-in-buffer
5539 'keyword 'keyword list nil 5539 'keyword 'keyword list nil
5540 (format "Select keyword for function %s%s" msg-name 5540 (format "Select keyword for function %s%s" msg-name
5541 (if (or (member '("_EXTRA") list) 5541 (if (or (member '("_EXTRA") list)
5542 (member '("_REF_EXTRA") list)) 5542 (member '("_REF_EXTRA") list))
5543 " (note _EXTRA)" "")) 5543 " (note _EXTRA)" ""))
5544 isa 5544 isa
5545 'idlwave-attach-keyword-classes))) 5545 'idlwave-attach-keyword-classes)))
@@ -5577,10 +5577,10 @@ other completions will be tried.")
5577 ("class"))) 5577 ("class")))
5578 (module (idlwave-sintern-routine-or-method module class)) 5578 (module (idlwave-sintern-routine-or-method module class))
5579 (class (idlwave-sintern-class class)) 5579 (class (idlwave-sintern-class class))
5580 (what (cond 5580 (what (cond
5581 ((equal what 0) 5581 ((equal what 0)
5582 (setq what 5582 (setq what
5583 (intern (completing-read 5583 (intern (completing-read
5584 "Complete what? " what-list nil t)))) 5584 "Complete what? " what-list nil t))))
5585 ((integerp what) 5585 ((integerp what)
5586 (setq what (intern (car (nth (1- what) what-list))))) 5586 (setq what (intern (car (nth (1- what) what-list)))))
@@ -5602,7 +5602,7 @@ other completions will be tried.")
5602 (super-classes nil) 5602 (super-classes nil)
5603 (type-selector 'pro) 5603 (type-selector 'pro)
5604 (pro (or module 5604 (pro (or module
5605 (idlwave-completing-read 5605 (idlwave-completing-read
5606 "Procedure: " (idlwave-routines) 'idlwave-selector)))) 5606 "Procedure: " (idlwave-routines) 'idlwave-selector))))
5607 (setq pro (idlwave-sintern-routine pro)) 5607 (setq pro (idlwave-sintern-routine pro))
5608 (list nil-list nil-list 'procedure-keyword 5608 (list nil-list nil-list 'procedure-keyword
@@ -5616,7 +5616,7 @@ other completions will be tried.")
5616 (super-classes nil) 5616 (super-classes nil)
5617 (type-selector 'fun) 5617 (type-selector 'fun)
5618 (func (or module 5618 (func (or module
5619 (idlwave-completing-read 5619 (idlwave-completing-read
5620 "Function: " (idlwave-routines) 'idlwave-selector)))) 5620 "Function: " (idlwave-routines) 'idlwave-selector))))
5621 (setq func (idlwave-sintern-routine func)) 5621 (setq func (idlwave-sintern-routine func))
5622 (list nil-list nil-list 'function-keyword 5622 (list nil-list nil-list 'function-keyword
@@ -5656,7 +5656,7 @@ other completions will be tried.")
5656 5656
5657 ((eq what 'class) 5657 ((eq what 'class)
5658 (list nil-list nil-list 'class nil-list nil)) 5658 (list nil-list nil-list 'class nil-list nil))
5659 5659
5660 (t (error "Invalid value for WHAT"))))) 5660 (t (error "Invalid value for WHAT")))))
5661 5661
5662(defun idlwave-completing-read (&rest args) 5662(defun idlwave-completing-read (&rest args)
@@ -5679,7 +5679,7 @@ other completions will be tried.")
5679 (stringp idlwave-shell-default-directory) 5679 (stringp idlwave-shell-default-directory)
5680 (file-directory-p idlwave-shell-default-directory)) 5680 (file-directory-p idlwave-shell-default-directory))
5681 idlwave-shell-default-directory 5681 idlwave-shell-default-directory
5682 default-directory))) 5682 default-directory)))
5683 (comint-dynamic-complete-filename))) 5683 (comint-dynamic-complete-filename)))
5684 5684
5685(defun idlwave-make-full-name (class name) 5685(defun idlwave-make-full-name (class name)
@@ -5688,7 +5688,7 @@ other completions will be tried.")
5688 5688
5689(defun idlwave-rinfo-assoc (name type class list) 5689(defun idlwave-rinfo-assoc (name type class list)
5690 "Like `idlwave-rinfo-assq', but sintern strings first." 5690 "Like `idlwave-rinfo-assq', but sintern strings first."
5691 (idlwave-rinfo-assq 5691 (idlwave-rinfo-assq
5692 (idlwave-sintern-routine-or-method name class) 5692 (idlwave-sintern-routine-or-method name class)
5693 type (idlwave-sintern-class class) list)) 5693 type (idlwave-sintern-class class) list))
5694 5694
@@ -5712,7 +5712,7 @@ other completions will be tried.")
5712 (setq classes nil))) 5712 (setq classes nil)))
5713 rtn)) 5713 rtn))
5714 5714
5715(defun idlwave-best-rinfo-assq (name type class list &optional with-file 5715(defun idlwave-best-rinfo-assq (name type class list &optional with-file
5716 keep-system) 5716 keep-system)
5717 "Like `idlwave-rinfo-assq', but get all twins and sort, then return first. 5717 "Like `idlwave-rinfo-assq', but get all twins and sort, then return first.
5718If WITH-FILE is passed, find the best rinfo entry with a file 5718If WITH-FILE is passed, find the best rinfo entry with a file
@@ -5737,7 +5737,7 @@ syslib files."
5737 twins))))) 5737 twins)))))
5738 (car twins))) 5738 (car twins)))
5739 5739
5740(defun idlwave-best-rinfo-assoc (name type class list &optional with-file 5740(defun idlwave-best-rinfo-assoc (name type class list &optional with-file
5741 keep-system) 5741 keep-system)
5742 "Like `idlwave-best-rinfo-assq', but sintern strings first." 5742 "Like `idlwave-best-rinfo-assq', but sintern strings first."
5743 (idlwave-best-rinfo-assq 5743 (idlwave-best-rinfo-assq
@@ -5828,7 +5828,7 @@ INFO is as returned by idlwave-what-function or -procedure."
5828Must accept two arguments: `apos' and `info'") 5828Must accept two arguments: `apos' and `info'")
5829 5829
5830(defun idlwave-determine-class (info type) 5830(defun idlwave-determine-class (info type)
5831 ;; Determine the class of a routine call. 5831 ;; Determine the class of a routine call.
5832 ;; INFO is the `cw-list' structure as returned by idlwave-where. 5832 ;; INFO is the `cw-list' structure as returned by idlwave-where.
5833 ;; The second element in this structure is the class. When nil, we 5833 ;; The second element in this structure is the class. When nil, we
5834 ;; return nil. When t, try to get the class from text properties at 5834 ;; return nil. When t, try to get the class from text properties at
@@ -5848,7 +5848,7 @@ Must accept two arguments: `apos' and `info'")
5848 (dassoc (cdr dassoc)) 5848 (dassoc (cdr dassoc))
5849 (t t))) 5849 (t t)))
5850 (arrow (and apos (string= (buffer-substring apos (+ 2 apos)) "->"))) 5850 (arrow (and apos (string= (buffer-substring apos (+ 2 apos)) "->")))
5851 (is-self 5851 (is-self
5852 (and arrow 5852 (and arrow
5853 (save-excursion (goto-char apos) 5853 (save-excursion (goto-char apos)
5854 (forward-word -1) 5854 (forward-word -1)
@@ -5869,19 +5869,19 @@ Must accept two arguments: `apos' and `info'")
5869 (setq class (or (nth 2 (idlwave-current-routine)) class))) 5869 (setq class (or (nth 2 (idlwave-current-routine)) class)))
5870 5870
5871 ;; Before prompting, try any special class determination routines 5871 ;; Before prompting, try any special class determination routines
5872 (when (and (eq t class) 5872 (when (and (eq t class)
5873 idlwave-determine-class-special 5873 idlwave-determine-class-special
5874 (not force-query)) 5874 (not force-query))
5875 (setq special-class 5875 (setq special-class
5876 (idlwave-call-special idlwave-determine-class-special apos)) 5876 (idlwave-call-special idlwave-determine-class-special apos))
5877 (if special-class 5877 (if special-class
5878 (setq class (idlwave-sintern-class special-class) 5878 (setq class (idlwave-sintern-class special-class)
5879 store idlwave-store-inquired-class))) 5879 store idlwave-store-inquired-class)))
5880 5880
5881 ;; Prompt for a class, if we need to 5881 ;; Prompt for a class, if we need to
5882 (when (and (eq class t) 5882 (when (and (eq class t)
5883 (or force-query query)) 5883 (or force-query query))
5884 (setq class-alist 5884 (setq class-alist
5885 (mapcar 'list (idlwave-all-method-classes (car info) type))) 5885 (mapcar 'list (idlwave-all-method-classes (car info) type)))
5886 (setq class 5886 (setq class
5887 (idlwave-sintern-class 5887 (idlwave-sintern-class
@@ -5890,9 +5890,9 @@ Must accept two arguments: `apos' and `info'")
5890 (error "No classes available with method %s" (car info))) 5890 (error "No classes available with method %s" (car info)))
5891 ((and (= (length class-alist) 1) (not force-query)) 5891 ((and (= (length class-alist) 1) (not force-query))
5892 (car (car class-alist))) 5892 (car (car class-alist)))
5893 (t 5893 (t
5894 (setq store idlwave-store-inquired-class) 5894 (setq store idlwave-store-inquired-class)
5895 (idlwave-completing-read 5895 (idlwave-completing-read
5896 (format "Class%s: " (if (stringp (car info)) 5896 (format "Class%s: " (if (stringp (car info))
5897 (format " for %s method %s" 5897 (format " for %s method %s"
5898 type (car info)) 5898 type (car info))
@@ -5904,9 +5904,9 @@ Must accept two arguments: `apos' and `info'")
5904 ;; We have a real class here 5904 ;; We have a real class here
5905 (when (and store arrow) 5905 (when (and store arrow)
5906 (condition-case () 5906 (condition-case ()
5907 (add-text-properties 5907 (add-text-properties
5908 apos (+ apos 2) 5908 apos (+ apos 2)
5909 `(idlwave-class ,class face ,idlwave-class-arrow-face 5909 `(idlwave-class ,class face ,idlwave-class-arrow-face
5910 rear-nonsticky t)) 5910 rear-nonsticky t))
5911 (error nil))) 5911 (error nil)))
5912 (setf (nth 2 info) class)) 5912 (setf (nth 2 info) class))
@@ -5934,14 +5934,14 @@ Must accept two arguments: `apos' and `info'")
5934 5934
5935 5935
5936(defun idlwave-where () 5936(defun idlwave-where ()
5937 "Find out where we are. 5937 "Find out where we are.
5938The return value is a list with the following stuff: 5938The return value is a list with the following stuff:
5939\(PRO-LIST FUNC-LIST COMPLETE-WHAT CW-LIST LAST-CHAR) 5939\(PRO-LIST FUNC-LIST COMPLETE-WHAT CW-LIST LAST-CHAR)
5940 5940
5941PRO-LIST (PRO POINT CLASS ARROW) 5941PRO-LIST (PRO POINT CLASS ARROW)
5942FUNC-LIST (FUNC POINT CLASS ARROW) 5942FUNC-LIST (FUNC POINT CLASS ARROW)
5943COMPLETE-WHAT a symbol indicating what kind of completion makes sense here 5943COMPLETE-WHAT a symbol indicating what kind of completion makes sense here
5944CW-LIST (PRO-OR-FUNC POINT CLASS ARROW) Like PRO-LIST, for what can 5944CW-LIST (PRO-OR-FUNC POINT CLASS ARROW) Like PRO-LIST, for what can
5945 be completed here. 5945 be completed here.
5946LAST-CHAR last relevant character before point (non-white non-comment, 5946LAST-CHAR last relevant character before point (non-white non-comment,
5947 not part of current identifier or leading slash). 5947 not part of current identifier or leading slash).
@@ -5953,7 +5953,7 @@ POINT: Where is this
5953CLASS: What class has the routine (nil=no, t=is method, but class unknown) 5953CLASS: What class has the routine (nil=no, t=is method, but class unknown)
5954ARROW: Location of the arrow" 5954ARROW: Location of the arrow"
5955 (idlwave-routines) 5955 (idlwave-routines)
5956 (let* (;(bos (save-excursion (idlwave-beginning-of-statement) (point))) 5956 (let* (;(bos (save-excursion (idlwave-beginning-of-statement) (point)))
5957 (bos (save-excursion (idlwave-start-of-substatement 'pre) (point))) 5957 (bos (save-excursion (idlwave-start-of-substatement 'pre) (point)))
5958 (func-entry (idlwave-what-function bos)) 5958 (func-entry (idlwave-what-function bos))
5959 (func (car func-entry)) 5959 (func (car func-entry))
@@ -5975,8 +5975,8 @@ ARROW: Location of the arrow"
5975 ((string-match "\\`[ \t]*\\(pro\\|function\\)[ \t]+[a-zA-Z0-9_]*\\'" 5975 ((string-match "\\`[ \t]*\\(pro\\|function\\)[ \t]+[a-zA-Z0-9_]*\\'"
5976 match-string) 5976 match-string)
5977 (setq cw 'class)) 5977 (setq cw 'class))
5978 ((string-match 5978 ((string-match
5979 "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)?\\'" 5979 "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)?\\'"
5980 (if (> pro-point 0) 5980 (if (> pro-point 0)
5981 (buffer-substring pro-point (point)) 5981 (buffer-substring pro-point (point))
5982 match-string)) 5982 match-string))
@@ -5987,11 +5987,11 @@ ARROW: Location of the arrow"
5987 nil) 5987 nil)
5988 ((string-match "OBJ_NEW([ \t]*['\"]\\([a-zA-Z0-9$_]*\\)?\\'" 5988 ((string-match "OBJ_NEW([ \t]*['\"]\\([a-zA-Z0-9$_]*\\)?\\'"
5989 match-string) 5989 match-string)
5990 (setq cw 'class)) 5990 (setq cw 'class))
5991 ((string-match "\\<inherits\\s-+\\([a-zA-Z0-9$_]*\\)?\\'" 5991 ((string-match "\\<inherits\\s-+\\([a-zA-Z0-9$_]*\\)?\\'"
5992 match-string) 5992 match-string)
5993 (setq cw 'class)) 5993 (setq cw 'class))
5994 ((and func 5994 ((and func
5995 (> func-point pro-point) 5995 (> func-point pro-point)
5996 (= func-level 1) 5996 (= func-level 1)
5997 (memq last-char '(?\( ?,))) 5997 (memq last-char '(?\( ?,)))
@@ -6037,7 +6037,7 @@ ARROW: Location of the arrow"
6037 ;; searches to this point. 6037 ;; searches to this point.
6038 6038
6039 (catch 'exit 6039 (catch 'exit
6040 (let (pos 6040 (let (pos
6041 func-point 6041 func-point
6042 (cnt 0) 6042 (cnt 0)
6043 func arrow-start class) 6043 func arrow-start class)
@@ -6052,18 +6052,18 @@ ARROW: Location of the arrow"
6052 (setq pos (point)) 6052 (setq pos (point))
6053 (incf cnt) 6053 (incf cnt)
6054 (when (and (= (following-char) ?\() 6054 (when (and (= (following-char) ?\()
6055 (re-search-backward 6055 (re-search-backward
6056 "\\(::\\|\\<\\)\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\=" 6056 "\\(::\\|\\<\\)\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\="
6057 bound t)) 6057 bound t))
6058 (setq func (match-string 2) 6058 (setq func (match-string 2)
6059 func-point (goto-char (match-beginning 2)) 6059 func-point (goto-char (match-beginning 2))
6060 pos func-point) 6060 pos func-point)
6061 (if (re-search-backward 6061 (if (re-search-backward
6062 "->[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\=" bound t) 6062 "->[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\=" bound t)
6063 (setq arrow-start (copy-marker (match-beginning 0)) 6063 (setq arrow-start (copy-marker (match-beginning 0))
6064 class (or (match-string 2) t))) 6064 class (or (match-string 2) t)))
6065 (throw 6065 (throw
6066 'exit 6066 'exit
6067 (list 6067 (list
6068 (idlwave-sintern-routine-or-method func class) 6068 (idlwave-sintern-routine-or-method func class)
6069 (idlwave-sintern-class class) 6069 (idlwave-sintern-class class)
@@ -6079,18 +6079,18 @@ ARROW: Location of the arrow"
6079 ;; searches to this point. 6079 ;; searches to this point.
6080 (let ((pos (point)) pro-point 6080 (let ((pos (point)) pro-point
6081 pro class arrow-start string) 6081 pro class arrow-start string)
6082 (save-excursion 6082 (save-excursion
6083 ;;(idlwave-beginning-of-statement) 6083 ;;(idlwave-beginning-of-statement)
6084 (idlwave-start-of-substatement 'pre) 6084 (idlwave-start-of-substatement 'pre)
6085 (setq string (buffer-substring (point) pos)) 6085 (setq string (buffer-substring (point) pos))
6086 (if (string-match 6086 (if (string-match
6087 "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\(,\\|\\'\\)" string) 6087 "\\`[ \t]*\\([a-zA-Z][a-zA-Z0-9$_]*\\)[ \t]*\\(,\\|\\'\\)" string)
6088 (setq pro (match-string 1 string) 6088 (setq pro (match-string 1 string)
6089 pro-point (+ (point) (match-beginning 1))) 6089 pro-point (+ (point) (match-beginning 1)))
6090 (if (and (idlwave-skip-object) 6090 (if (and (idlwave-skip-object)
6091 (setq string (buffer-substring (point) pos)) 6091 (setq string (buffer-substring (point) pos))
6092 (string-match 6092 (string-match
6093 "\\`[ \t]*\\(->\\)[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\([a-zA-Z][a-zA-Z0-9$_]*\\)?[ \t]*\\(,\\|\\(\\$\\s *\\(;.*\\)?\\)?$\\)" 6093 "\\`[ \t]*\\(->\\)[ \t]*\\(\\([a-zA-Z][a-zA-Z0-9$_]*\\)::\\)?\\([a-zA-Z][a-zA-Z0-9$_]*\\)?[ \t]*\\(,\\|\\(\\$\\s *\\(;.*\\)?\\)?$\\)"
6094 string)) 6094 string))
6095 (setq pro (if (match-beginning 4) 6095 (setq pro (if (match-beginning 4)
6096 (match-string 4 string)) 6096 (match-string 4 string))
@@ -6134,7 +6134,7 @@ ARROW: Location of the arrow"
6134 (throw 'exit nil)))) 6134 (throw 'exit nil))))
6135 (goto-char pos) 6135 (goto-char pos)
6136 nil))) 6136 nil)))
6137 6137
6138(defun idlwave-last-valid-char () 6138(defun idlwave-last-valid-char ()
6139 "Return the last character before point which is not white or a comment 6139 "Return the last character before point which is not white or a comment
6140and also not part of the current identifier. Since we do this in 6140and also not part of the current identifier. Since we do this in
@@ -6224,23 +6224,23 @@ accumulate information on matching completions."
6224 ((or (eq completion t) 6224 ((or (eq completion t)
6225 (and (= 1 (length (setq all-completions 6225 (and (= 1 (length (setq all-completions
6226 (idlwave-uniquify 6226 (idlwave-uniquify
6227 (all-completions part list 6227 (all-completions part list
6228 (or special-selector 6228 (or special-selector
6229 selector)))))) 6229 selector))))))
6230 (equal dpart dcompletion))) 6230 (equal dpart dcompletion)))
6231 ;; This is already complete 6231 ;; This is already complete
6232 (idlwave-after-successful-completion type slash beg) 6232 (idlwave-after-successful-completion type slash beg)
6233 (message "%s is already the complete %s" part isa) 6233 (message "%s is already the complete %s" part isa)
6234 nil) 6234 nil)
6235 (t 6235 (t
6236 ;; We cannot add something - offer a list. 6236 ;; We cannot add something - offer a list.
6237 (message "Making completion list...") 6237 (message "Making completion list...")
6238 6238
6239 (unless idlwave-completion-help-links ; already set somewhere? 6239 (unless idlwave-completion-help-links ; already set somewhere?
6240 (mapcar (lambda (x) ; Pass link prop through to highlight-linked 6240 (mapcar (lambda (x) ; Pass link prop through to highlight-linked
6241 (let ((link (get-text-property 0 'link (car x)))) 6241 (let ((link (get-text-property 0 'link (car x))))
6242 (if link 6242 (if link
6243 (push (cons (car x) link) 6243 (push (cons (car x) link)
6244 idlwave-completion-help-links)))) 6244 idlwave-completion-help-links))))
6245 list)) 6245 list))
6246 (let* ((list all-completions) 6246 (let* ((list all-completions)
@@ -6250,7 +6250,7 @@ accumulate information on matching completions."
6250; (completion-fixup-function ; Emacs 6250; (completion-fixup-function ; Emacs
6251; (lambda () (and (eq (preceding-char) ?>) 6251; (lambda () (and (eq (preceding-char) ?>)
6252; (re-search-backward " <" beg t))))) 6252; (re-search-backward " <" beg t)))))
6253 6253
6254 (setq list (sort list (lambda (a b) 6254 (setq list (sort list (lambda (a b)
6255 (string< (downcase a) (downcase b))))) 6255 (string< (downcase a) (downcase b)))))
6256 (if prepare-display-function 6256 (if prepare-display-function
@@ -6260,7 +6260,7 @@ accumulate information on matching completions."
6260 idlwave-complete-empty-string-as-lower-case) 6260 idlwave-complete-empty-string-as-lower-case)
6261 (not idlwave-completion-force-default-case)) 6261 (not idlwave-completion-force-default-case))
6262 (setq list (mapcar (lambda (x) 6262 (setq list (mapcar (lambda (x)
6263 (if (listp x) 6263 (if (listp x)
6264 (setcar x (downcase (car x))) 6264 (setcar x (downcase (car x)))
6265 (setq x (downcase x))) 6265 (setq x (downcase x)))
6266 x) 6266 x)
@@ -6280,19 +6280,19 @@ accumulate information on matching completions."
6280 (re-search-backward "\\<\\(pro\\|function\\)[ \t]+\\=" 6280 (re-search-backward "\\<\\(pro\\|function\\)[ \t]+\\="
6281 (- (point) 15) t) 6281 (- (point) 15) t)
6282 (goto-char (point-min)) 6282 (goto-char (point-min))
6283 (re-search-forward 6283 (re-search-forward
6284 "^[ \t]*\\(pro\\|function\\)[ \t]+\\([a-zA-Z0-9_]+::\\)" nil t)))) 6284 "^[ \t]*\\(pro\\|function\\)[ \t]+\\([a-zA-Z0-9_]+::\\)" nil t))))
6285 ;; Yank the full class specification 6285 ;; Yank the full class specification
6286 (insert (match-string 2)) 6286 (insert (match-string 2))
6287 ;; Do the completion, using list gathered from `idlwave-routines' 6287 ;; Do the completion, using list gathered from `idlwave-routines'
6288 (idlwave-complete-in-buffer 6288 (idlwave-complete-in-buffer
6289 'class 'class (idlwave-class-alist) nil 6289 'class 'class (idlwave-class-alist) nil
6290 "Select a class" "class" 6290 "Select a class" "class"
6291 '(lambda (list) ;; Push it to help-links if system help available 6291 '(lambda (list) ;; Push it to help-links if system help available
6292 (mapcar (lambda (x) 6292 (mapcar (lambda (x)
6293 (let* ((entry (idlwave-class-info x)) 6293 (let* ((entry (idlwave-class-info x))
6294 (link (nth 1 (assq 'link entry)))) 6294 (link (nth 1 (assq 'link entry))))
6295 (if link (push (cons x link) 6295 (if link (push (cons x link)
6296 idlwave-completion-help-links)) 6296 idlwave-completion-help-links))
6297 x)) 6297 x))
6298 list))))) 6298 list)))))
@@ -6304,7 +6304,7 @@ accumulate information on matching completions."
6304 ;; SHOW-CLASSES is the value of `idlwave-completion-show-classes'. 6304 ;; SHOW-CLASSES is the value of `idlwave-completion-show-classes'.
6305 (if (or (null show-classes) ; don't want to see classes 6305 (if (or (null show-classes) ; don't want to see classes
6306 (null class-selector) ; not a method call 6306 (null class-selector) ; not a method call
6307 (and 6307 (and
6308 (stringp class-selector) ; the class is already known 6308 (stringp class-selector) ; the class is already known
6309 (not super-classes))) ; no possibilities for inheritance 6309 (not super-classes))) ; no possibilities for inheritance
6310 ;; In these cases, we do not have to do anything 6310 ;; In these cases, we do not have to do anything
@@ -6319,13 +6319,13 @@ accumulate information on matching completions."
6319 (max (abs show-classes)) 6319 (max (abs show-classes))
6320 (lmax (if do-dots (apply 'max (mapcar 'length list)))) 6320 (lmax (if do-dots (apply 'max (mapcar 'length list))))
6321 classes nclasses class-info space) 6321 classes nclasses class-info space)
6322 (mapcar 6322 (mapcar
6323 (lambda (x) 6323 (lambda (x)
6324 ;; get the classes 6324 ;; get the classes
6325 (if (eq type 'class-tag) 6325 (if (eq type 'class-tag)
6326 ;; Just one class for tags 6326 ;; Just one class for tags
6327 (setq classes 6327 (setq classes
6328 (list 6328 (list
6329 (idlwave-class-or-superclass-with-tag class-selector x))) 6329 (idlwave-class-or-superclass-with-tag class-selector x)))
6330 ;; Multiple classes for method or method-keyword 6330 ;; Multiple classes for method or method-keyword
6331 (setq classes 6331 (setq classes
@@ -6334,7 +6334,7 @@ accumulate information on matching completions."
6334 method-selector x type-selector) 6334 method-selector x type-selector)
6335 (idlwave-all-method-classes x type-selector))) 6335 (idlwave-all-method-classes x type-selector)))
6336 (if inherit 6336 (if inherit
6337 (setq classes 6337 (setq classes
6338 (delq nil 6338 (delq nil
6339 (mapcar (lambda (x) (if (memq x inherit) x nil)) 6339 (mapcar (lambda (x) (if (memq x inherit) x nil))
6340 classes))))) 6340 classes)))))
@@ -6371,7 +6371,7 @@ accumulate information on matching completions."
6371(defun idlwave-attach-class-tag-classes (list) 6371(defun idlwave-attach-class-tag-classes (list)
6372 ;; Call idlwave-attach-classes with class structure tags 6372 ;; Call idlwave-attach-classes with class structure tags
6373 (idlwave-attach-classes list 'class-tag idlwave-completion-show-classes)) 6373 (idlwave-attach-classes list 'class-tag idlwave-completion-show-classes))
6374 6374
6375 6375
6376;;---------------------------------------------------------------------- 6376;;----------------------------------------------------------------------
6377;;---------------------------------------------------------------------- 6377;;----------------------------------------------------------------------
@@ -6392,7 +6392,7 @@ sort the list before displaying"
6392 ((= 1 (length list)) 6392 ((= 1 (length list))
6393 (setq rtn (car list))) 6393 (setq rtn (car list)))
6394 ((featurep 'xemacs) 6394 ((featurep 'xemacs)
6395 (if sort (setq list (sort list (lambda (a b) 6395 (if sort (setq list (sort list (lambda (a b)
6396 (string< (upcase a) (upcase b)))))) 6396 (string< (upcase a) (upcase b))))))
6397 (setq menu 6397 (setq menu
6398 (append (list title) 6398 (append (list title)
@@ -6403,7 +6403,7 @@ sort the list before displaying"
6403 (setq resp (get-popup-menu-response menu)) 6403 (setq resp (get-popup-menu-response menu))
6404 (funcall (event-function resp) (event-object resp))) 6404 (funcall (event-function resp) (event-object resp)))
6405 (t 6405 (t
6406 (if sort (setq list (sort list (lambda (a b) 6406 (if sort (setq list (sort list (lambda (a b)
6407 (string< (upcase a) (upcase b)))))) 6407 (string< (upcase a) (upcase b))))))
6408 (setq menu (cons title 6408 (setq menu (cons title
6409 (list 6409 (list
@@ -6494,7 +6494,7 @@ sort the list before displaying"
6494 (setq idlwave-before-completion-wconf (current-window-configuration))) 6494 (setq idlwave-before-completion-wconf (current-window-configuration)))
6495 6495
6496 (if (featurep 'xemacs) 6496 (if (featurep 'xemacs)
6497 (idlwave-display-completion-list-xemacs 6497 (idlwave-display-completion-list-xemacs
6498 list) 6498 list)
6499 (idlwave-display-completion-list-emacs list)) 6499 (idlwave-display-completion-list-emacs list))
6500 6500
@@ -6575,7 +6575,7 @@ If these don't exist, a letter in the string is automatically selected."
6575 (mapcar (lambda(x) 6575 (mapcar (lambda(x)
6576 (princ (nth 1 x)) 6576 (princ (nth 1 x))
6577 (princ "\n")) 6577 (princ "\n"))
6578 keys-alist)) 6578 keys-alist))
6579 (setq char (read-char))) 6579 (setq char (read-char)))
6580 (setq char (read-char))) 6580 (setq char (read-char)))
6581 (message nil) 6581 (message nil)
@@ -6695,7 +6695,7 @@ If these don't exist, a letter in the string is automatically selected."
6695(defun idlwave-make-modified-completion-map-emacs (old-map) 6695(defun idlwave-make-modified-completion-map-emacs (old-map)
6696 "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP." 6696 "Replace `choose-completion' and `mouse-choose-completion' in OLD-MAP."
6697 (let ((new-map (copy-keymap old-map))) 6697 (let ((new-map (copy-keymap old-map)))
6698 (substitute-key-definition 6698 (substitute-key-definition
6699 'choose-completion 'idlwave-choose-completion new-map) 6699 'choose-completion 'idlwave-choose-completion new-map)
6700 (substitute-key-definition 6700 (substitute-key-definition
6701 'mouse-choose-completion 'idlwave-mouse-choose-completion new-map) 6701 'mouse-choose-completion 'idlwave-mouse-choose-completion new-map)
@@ -6721,8 +6721,8 @@ If these don't exist, a letter in the string is automatically selected."
6721;; 6721;;
6722;; - Go again over the documentation how to write a completion 6722;; - Go again over the documentation how to write a completion
6723;; plugin. It is in self.el, but currently still very bad. 6723;; plugin. It is in self.el, but currently still very bad.
6724;; This could be in a separate file in the distribution, or 6724;; This could be in a separate file in the distribution, or
6725;; in an appendix for the manual. 6725;; in an appendix for the manual.
6726 6726
6727(defvar idlwave-struct-skip 6727(defvar idlwave-struct-skip
6728 "[ \t]*\\(\\$.*\n\\(^[ \t]*\\(\\$[ \t]*\\)?\\(;.*\\)?\n\\)*\\)?[ \t]*" 6728 "[ \t]*\\(\\$.*\n\\(^[ \t]*\\(\\$[ \t]*\\)?\\(;.*\\)?\n\\)*\\)?[ \t]*"
@@ -6761,7 +6761,7 @@ Point is expected just before the opening `{' of the struct definition."
6761 (beg (car borders)) 6761 (beg (car borders))
6762 (end (cdr borders)) 6762 (end (cdr borders))
6763 (case-fold-search t)) 6763 (case-fold-search t))
6764 (re-search-forward (concat "\\(^[ \t]*\\|[,{][ \t]*\\)" tag "[ \t]*:") 6764 (re-search-forward (concat "\\(^[ \t]*\\|[,{][ \t]*\\)" tag "[ \t]*:")
6765 end t))) 6765 end t)))
6766 6766
6767(defun idlwave-struct-inherits () 6767(defun idlwave-struct-inherits ()
@@ -6776,7 +6776,7 @@ Point is expected just before the opening `{' of the struct definition."
6776 (goto-char beg) 6776 (goto-char beg)
6777 (save-restriction 6777 (save-restriction
6778 (narrow-to-region beg end) 6778 (narrow-to-region beg end)
6779 (while (re-search-forward 6779 (while (re-search-forward
6780 (concat "[{,]" ;leading comma/brace 6780 (concat "[{,]" ;leading comma/brace
6781 idlwave-struct-skip ; 4 groups 6781 idlwave-struct-skip ; 4 groups
6782 "inherits" ; The INHERITS tag 6782 "inherits" ; The INHERITS tag
@@ -6826,9 +6826,9 @@ backward."
6826 (concat "\\<" (regexp-quote (downcase var)) "\\>" ws) 6826 (concat "\\<" (regexp-quote (downcase var)) "\\>" ws)
6827 "\\(\\)") 6827 "\\(\\)")
6828 "=" ws "\\({\\)" 6828 "=" ws "\\({\\)"
6829 (if name 6829 (if name
6830 (if (stringp name) 6830 (if (stringp name)
6831 (concat ws "\\(\\<" (downcase name) "\\)[^a-zA-Z0-9_$]") 6831 (concat ws "\\(\\<" (downcase name) "\\)[^a-zA-Z0-9_$]")
6832 ;; Just a generic name 6832 ;; Just a generic name
6833 (concat ws "\\<\\([a-zA-Z_0-9$]+\\)" ws ",")) 6833 (concat ws "\\<\\([a-zA-Z_0-9$]+\\)" ws ","))
6834 "")))) 6834 ""))))
@@ -6839,7 +6839,7 @@ backward."
6839 (goto-char (match-beginning 3)) 6839 (goto-char (match-beginning 3))
6840 (match-string-no-properties 5))))) 6840 (match-string-no-properties 5)))))
6841 6841
6842(defvar idlwave-class-info nil) 6842(defvar idlwave-class-info nil)
6843(defvar idlwave-system-class-info nil) ; Gathered from idlw-rinfo 6843(defvar idlwave-system-class-info nil) ; Gathered from idlw-rinfo
6844(defvar idlwave-class-reset nil) ; to reset buffer-local classes 6844(defvar idlwave-class-reset nil) ; to reset buffer-local classes
6845 6845
@@ -6852,13 +6852,13 @@ backward."
6852 (let (list entry) 6852 (let (list entry)
6853 (if idlwave-class-info 6853 (if idlwave-class-info
6854 (if idlwave-class-reset 6854 (if idlwave-class-reset
6855 (setq 6855 (setq
6856 idlwave-class-reset nil 6856 idlwave-class-reset nil
6857 idlwave-class-info ; Remove any visited in a buffer 6857 idlwave-class-info ; Remove any visited in a buffer
6858 (delq nil (mapcar 6858 (delq nil (mapcar
6859 (lambda (x) 6859 (lambda (x)
6860 (let ((filebuf 6860 (let ((filebuf
6861 (idlwave-class-file-or-buffer 6861 (idlwave-class-file-or-buffer
6862 (or (cdr (assq 'found-in x)) (car x))))) 6862 (or (cdr (assq 'found-in x)) (car x)))))
6863 (if (cdr filebuf) 6863 (if (cdr filebuf)
6864 nil 6864 nil
@@ -6896,7 +6896,7 @@ class/struct definition"
6896 (progn 6896 (progn
6897 ;; For everything there 6897 ;; For everything there
6898 (setq end-lim (save-excursion (idlwave-end-of-subprogram) (point))) 6898 (setq end-lim (save-excursion (idlwave-end-of-subprogram) (point)))
6899 (while (setq name 6899 (while (setq name
6900 (idlwave-find-structure-definition nil t end-lim)) 6900 (idlwave-find-structure-definition nil t end-lim))
6901 (funcall all-hook name))) 6901 (funcall all-hook name)))
6902 (idlwave-find-structure-definition nil (or alt-class class)))))) 6902 (idlwave-find-structure-definition nil (or alt-class class))))))
@@ -6934,11 +6934,11 @@ class/struct definition"
6934 (insert-file-contents file)) 6934 (insert-file-contents file))
6935 (save-excursion 6935 (save-excursion
6936 (goto-char 1) 6936 (goto-char 1)
6937 (idlwave-find-class-definition class 6937 (idlwave-find-class-definition class
6938 ;; Scan all of the structures found there 6938 ;; Scan all of the structures found there
6939 (lambda (name) 6939 (lambda (name)
6940 (let* ((this-class (idlwave-sintern-class name)) 6940 (let* ((this-class (idlwave-sintern-class name))
6941 (entry 6941 (entry
6942 (list this-class 6942 (list this-class
6943 (cons 'tags (idlwave-struct-tags)) 6943 (cons 'tags (idlwave-struct-tags))
6944 (cons 'inherits (idlwave-struct-inherits))))) 6944 (cons 'inherits (idlwave-struct-inherits)))))
@@ -6963,7 +6963,7 @@ class/struct definition"
6963 (condition-case err 6963 (condition-case err
6964 (apply 'append (mapcar 'idlwave-class-tags 6964 (apply 'append (mapcar 'idlwave-class-tags
6965 (cons class (idlwave-all-class-inherits class)))) 6965 (cons class (idlwave-all-class-inherits class))))
6966 (error 6966 (error
6967 (idlwave-class-tag-reset) 6967 (idlwave-class-tag-reset)
6968 (error "%s" (error-message-string err))))) 6968 (error "%s" (error-message-string err)))))
6969 6969
@@ -7000,24 +7000,24 @@ The list is cached in `idlwave-class-info' for faster access."
7000 all-inherits)))))) 7000 all-inherits))))))
7001 7001
7002(defun idlwave-entry-keywords (entry &optional record-link) 7002(defun idlwave-entry-keywords (entry &optional record-link)
7003 "Return the flat entry keywords alist from routine-info entry. 7003 "Return the flat entry keywords alist from routine-info entry.
7004If RECORD-LINK is non-nil, the keyword text is copied and a text 7004If RECORD-LINK is non-nil, the keyword text is copied and a text
7005property indicating the link is added." 7005property indicating the link is added."
7006 (let (kwds) 7006 (let (kwds)
7007 (mapcar 7007 (mapcar
7008 (lambda (key-list) 7008 (lambda (key-list)
7009 (let ((file (car key-list))) 7009 (let ((file (car key-list)))
7010 (mapcar (lambda (key-cons) 7010 (mapcar (lambda (key-cons)
7011 (let ((key (car key-cons)) 7011 (let ((key (car key-cons))
7012 (link (cdr key-cons))) 7012 (link (cdr key-cons)))
7013 (when (and record-link file) 7013 (when (and record-link file)
7014 (setq key (copy-sequence key)) 7014 (setq key (copy-sequence key))
7015 (put-text-property 7015 (put-text-property
7016 0 (length key) 7016 0 (length key)
7017 'link 7017 'link
7018 (concat 7018 (concat
7019 file 7019 file
7020 (if link 7020 (if link
7021 (concat idlwave-html-link-sep 7021 (concat idlwave-html-link-sep
7022 (number-to-string link)))) 7022 (number-to-string link))))
7023 key)) 7023 key))
@@ -7030,13 +7030,13 @@ property indicating the link is added."
7030 "Find keyword KEYWORD in entry ENTRY, and return (with link) if set" 7030 "Find keyword KEYWORD in entry ENTRY, and return (with link) if set"
7031 (catch 'exit 7031 (catch 'exit
7032 (mapc 7032 (mapc
7033 (lambda (key-list) 7033 (lambda (key-list)
7034 (let ((file (car key-list)) 7034 (let ((file (car key-list))
7035 (kwd (assoc keyword (cdr key-list)))) 7035 (kwd (assoc keyword (cdr key-list))))
7036 (when kwd 7036 (when kwd
7037 (setq kwd (cons (car kwd) 7037 (setq kwd (cons (car kwd)
7038 (if (and file (cdr kwd)) 7038 (if (and file (cdr kwd))
7039 (concat file 7039 (concat file
7040 idlwave-html-link-sep 7040 idlwave-html-link-sep
7041 (number-to-string (cdr kwd))) 7041 (number-to-string (cdr kwd)))
7042 (cdr kwd)))) 7042 (cdr kwd))))
@@ -7074,14 +7074,14 @@ property indicating the link is added."
7074 ;; Check if we need to update the "current" class 7074 ;; Check if we need to update the "current" class
7075 (if (not (equal class-selector idlwave-current-tags-class)) 7075 (if (not (equal class-selector idlwave-current-tags-class))
7076 (idlwave-prepare-class-tag-completion class-selector)) 7076 (idlwave-prepare-class-tag-completion class-selector))
7077 (setq idlwave-completion-help-info 7077 (setq idlwave-completion-help-info
7078 (list 'idlwave-complete-class-structure-tag-help 7078 (list 'idlwave-complete-class-structure-tag-help
7079 (idlwave-sintern-routine 7079 (idlwave-sintern-routine
7080 (concat class-selector "__define")) 7080 (concat class-selector "__define"))
7081 nil)) 7081 nil))
7082 (let ((idlwave-cpl-bold idlwave-current-native-class-tags)) 7082 (let ((idlwave-cpl-bold idlwave-current-native-class-tags))
7083 (idlwave-complete-in-buffer 7083 (idlwave-complete-in-buffer
7084 'class-tag 'class-tag 7084 'class-tag 'class-tag
7085 idlwave-current-class-tags nil 7085 idlwave-current-class-tags nil
7086 (format "Select a tag of class %s" class-selector) 7086 (format "Select a tag of class %s" class-selector)
7087 "class tag" 7087 "class tag"
@@ -7133,7 +7133,7 @@ Gets set in `idlw-rinfo.el'.")
7133 (skip-chars-backward "[a-zA-Z0-9_$]") 7133 (skip-chars-backward "[a-zA-Z0-9_$]")
7134 (equal (char-before) ?!)) 7134 (equal (char-before) ?!))
7135 (setq idlwave-completion-help-info '(idlwave-complete-sysvar-help)) 7135 (setq idlwave-completion-help-info '(idlwave-complete-sysvar-help))
7136 (idlwave-complete-in-buffer 'sysvar 'sysvar 7136 (idlwave-complete-in-buffer 'sysvar 'sysvar
7137 idlwave-system-variables-alist nil 7137 idlwave-system-variables-alist nil
7138 "Select a system variable" 7138 "Select a system variable"
7139 "system variable") 7139 "system variable")
@@ -7152,7 +7152,7 @@ Gets set in `idlw-rinfo.el'.")
7152 (or tags (error "System variable !%s is not a structure" var)) 7152 (or tags (error "System variable !%s is not a structure" var))
7153 (setq idlwave-completion-help-info 7153 (setq idlwave-completion-help-info
7154 (list 'idlwave-complete-sysvar-tag-help var)) 7154 (list 'idlwave-complete-sysvar-tag-help var))
7155 (idlwave-complete-in-buffer 'sysvartag 'sysvartag 7155 (idlwave-complete-in-buffer 'sysvartag 'sysvartag
7156 tags nil 7156 tags nil
7157 "Select a system variable tag" 7157 "Select a system variable tag"
7158 "system variable tag") 7158 "system variable tag")
@@ -7179,8 +7179,8 @@ Gets set in `idlw-rinfo.el'.")
7179 ((eq mode 'test) ; we can at least link the main 7179 ((eq mode 'test) ; we can at least link the main
7180 (and (stringp word) entry main)) 7180 (and (stringp word) entry main))
7181 ((eq mode 'set) 7181 ((eq mode 'set)
7182 (if entry 7182 (if entry
7183 (setq link 7183 (setq link
7184 (if (setq target (cdr (assoc word tags))) 7184 (if (setq target (cdr (assoc word tags)))
7185 (idlwave-substitute-link-target main target) 7185 (idlwave-substitute-link-target main target)
7186 main)))) ;; setting dynamic!!! 7186 main)))) ;; setting dynamic!!!
@@ -7198,7 +7198,7 @@ Gets set in `idlw-rinfo.el'.")
7198 7198
7199;; Fake help in the source buffer for class structure tags. 7199;; Fake help in the source buffer for class structure tags.
7200;; KWD AND NAME ARE GLOBAL-VARIABLES HERE. 7200;; KWD AND NAME ARE GLOBAL-VARIABLES HERE.
7201(defvar name) 7201(defvar name)
7202(defvar kwd) 7202(defvar kwd)
7203(defvar idlwave-help-do-class-struct-tag nil) 7203(defvar idlwave-help-do-class-struct-tag nil)
7204(defun idlwave-complete-class-structure-tag-help (mode word) 7204(defun idlwave-complete-class-structure-tag-help (mode word)
@@ -7207,13 +7207,13 @@ Gets set in `idlw-rinfo.el'.")
7207 nil) 7207 nil)
7208 ((eq mode 'set) 7208 ((eq mode 'set)
7209 (let (class-with found-in) 7209 (let (class-with found-in)
7210 (when (setq class-with 7210 (when (setq class-with
7211 (idlwave-class-or-superclass-with-tag 7211 (idlwave-class-or-superclass-with-tag
7212 idlwave-current-tags-class 7212 idlwave-current-tags-class
7213 word)) 7213 word))
7214 (if (assq (idlwave-sintern-class class-with) 7214 (if (assq (idlwave-sintern-class class-with)
7215 idlwave-system-class-info) 7215 idlwave-system-class-info)
7216 (error "No help available for system class tags.")) 7216 (error "No help available for system class tags"))
7217 (if (setq found-in (idlwave-class-found-in class-with)) 7217 (if (setq found-in (idlwave-class-found-in class-with))
7218 (setq name (cons (concat found-in "__define") class-with)) 7218 (setq name (cons (concat found-in "__define") class-with))
7219 (setq name (concat class-with "__define"))))) 7219 (setq name (concat class-with "__define")))))
@@ -7224,7 +7224,7 @@ Gets set in `idlw-rinfo.el'.")
7224(defun idlwave-class-or-superclass-with-tag (class tag) 7224(defun idlwave-class-or-superclass-with-tag (class tag)
7225 "Find and return the CLASS or one of its superclass with the 7225 "Find and return the CLASS or one of its superclass with the
7226associated TAG, if any." 7226associated TAG, if any."
7227 (let ((sclasses (cons class (cdr (assq 'all-inherits 7227 (let ((sclasses (cons class (cdr (assq 'all-inherits
7228 (idlwave-class-info class))))) 7228 (idlwave-class-info class)))))
7229 cl) 7229 cl)
7230 (catch 'exit 7230 (catch 'exit
@@ -7233,7 +7233,7 @@ associated TAG, if any."
7233 (let ((tags (idlwave-class-tags cl))) 7233 (let ((tags (idlwave-class-tags cl)))
7234 (while tags 7234 (while tags
7235 (if (eq t (compare-strings tag 0 nil (car tags) 0 nil t)) 7235 (if (eq t (compare-strings tag 0 nil (car tags) 0 nil t))
7236 (throw 'exit cl)) 7236 (throw 'exit cl))
7237 (setq tags (cdr tags)))))))) 7237 (setq tags (cdr tags))))))))
7238 7238
7239 7239
@@ -7256,8 +7256,8 @@ associated TAG, if any."
7256 (setcar entry (idlwave-sintern-sysvar (car entry) 'set)) 7256 (setcar entry (idlwave-sintern-sysvar (car entry) 'set))
7257 (setq tags (assq 'tags entry)) 7257 (setq tags (assq 'tags entry))
7258 (if tags 7258 (if tags
7259 (setcdr tags 7259 (setcdr tags
7260 (mapcar (lambda (x) 7260 (mapcar (lambda (x)
7261 (cons (idlwave-sintern-sysvartag (car x) 'set) 7261 (cons (idlwave-sintern-sysvartag (car x) 'set)
7262 (cdr x))) 7262 (cdr x)))
7263 (cdr tags))))))) 7263 (cdr tags)))))))
@@ -7274,19 +7274,19 @@ associated TAG, if any."
7274 text start) 7274 text start)
7275 (setq start (match-end 0) 7275 (setq start (match-end 0)
7276 var (match-string 1 text) 7276 var (match-string 1 text)
7277 tags (if (match-end 3) 7277 tags (if (match-end 3)
7278 (idlwave-split-string (match-string 3 text)))) 7278 (idlwave-split-string (match-string 3 text))))
7279 ;; Maintain old links, if present 7279 ;; Maintain old links, if present
7280 (setq old-entry (assq (idlwave-sintern-sysvar var) old)) 7280 (setq old-entry (assq (idlwave-sintern-sysvar var) old))
7281 (setq link (assq 'link old-entry)) 7281 (setq link (assq 'link old-entry))
7282 (setq idlwave-system-variables-alist 7282 (setq idlwave-system-variables-alist
7283 (cons (list var 7283 (cons (list var
7284 (cons 7284 (cons
7285 'tags 7285 'tags
7286 (mapcar (lambda (x) 7286 (mapcar (lambda (x)
7287 (cons x 7287 (cons x
7288 (cdr (assq 7288 (cdr (assq
7289 (idlwave-sintern-sysvartag x) 7289 (idlwave-sintern-sysvartag x)
7290 (cdr (assq 'tags old-entry)))))) 7290 (cdr (assq 'tags old-entry))))))
7291 tags)) link) 7291 tags)) link)
7292 idlwave-system-variables-alist))) 7292 idlwave-system-variables-alist)))
@@ -7308,9 +7308,9 @@ associated TAG, if any."
7308 7308
7309(defun idlwave-uniquify (list) 7309(defun idlwave-uniquify (list)
7310 (let ((ht (make-hash-table :size (length list) :test 'equal))) 7310 (let ((ht (make-hash-table :size (length list) :test 'equal)))
7311 (delq nil 7311 (delq nil
7312 (mapcar (lambda (x) 7312 (mapcar (lambda (x)
7313 (unless (gethash x ht) 7313 (unless (gethash x ht)
7314 (puthash x t ht) 7314 (puthash x t ht)
7315 x)) 7315 x))
7316 list)))) 7316 list))))
@@ -7338,11 +7338,11 @@ Restore the pre-completion window configuration if possible."
7338 nil))) 7338 nil)))
7339 7339
7340 ;; Restore the pre-completion window configuration if this is safe. 7340 ;; Restore the pre-completion window configuration if this is safe.
7341 7341
7342 (if (or (eq verify 'force) ; force 7342 (if (or (eq verify 'force) ; force
7343 (and 7343 (and
7344 (get-buffer-window "*Completions*") ; visible 7344 (get-buffer-window "*Completions*") ; visible
7345 (idlwave-local-value 'idlwave-completion-p 7345 (idlwave-local-value 'idlwave-completion-p
7346 "*Completions*") ; cib-buffer 7346 "*Completions*") ; cib-buffer
7347 (eq (marker-buffer idlwave-completion-mark) 7347 (eq (marker-buffer idlwave-completion-mark)
7348 (current-buffer)) ; buffer OK 7348 (current-buffer)) ; buffer OK
@@ -7440,7 +7440,7 @@ With ARG, enforce query for the class of object methods."
7440 (if (string-match "\\(pro\\|function\\)[ \t]+\\(\\(.*\\)::\\)?\\(.*\\)" 7440 (if (string-match "\\(pro\\|function\\)[ \t]+\\(\\(.*\\)::\\)?\\(.*\\)"
7441 resolve) 7441 resolve)
7442 (setq type (match-string 1 resolve) 7442 (setq type (match-string 1 resolve)
7443 class (if (match-beginning 2) 7443 class (if (match-beginning 2)
7444 (match-string 3 resolve) 7444 (match-string 3 resolve)
7445 nil) 7445 nil)
7446 name (match-string 4 resolve))) 7446 name (match-string 4 resolve)))
@@ -7449,15 +7449,15 @@ With ARG, enforce query for the class of object methods."
7449 7449
7450 (cond 7450 (cond
7451 ((null class) 7451 ((null class)
7452 (idlwave-shell-send-command 7452 (idlwave-shell-send-command
7453 (format "resolve_routine,'%s'%s" (downcase name) kwd) 7453 (format "resolve_routine,'%s'%s" (downcase name) kwd)
7454 'idlwave-update-routine-info 7454 'idlwave-update-routine-info
7455 nil t)) 7455 nil t))
7456 (t 7456 (t
7457 (idlwave-shell-send-command 7457 (idlwave-shell-send-command
7458 (format "resolve_routine,'%s__define'%s" (downcase class) kwd) 7458 (format "resolve_routine,'%s__define'%s" (downcase class) kwd)
7459 (list 'idlwave-shell-send-command 7459 (list 'idlwave-shell-send-command
7460 (format "resolve_routine,'%s__%s'%s" 7460 (format "resolve_routine,'%s__%s'%s"
7461 (downcase class) (downcase name) kwd) 7461 (downcase class) (downcase name) kwd)
7462 '(idlwave-update-routine-info) 7462 '(idlwave-update-routine-info)
7463 nil t)))))) 7463 nil t))))))
@@ -7474,19 +7474,19 @@ force class query for object methods."
7474 (this-buffer (equal arg '(4))) 7474 (this-buffer (equal arg '(4)))
7475 (module (idlwave-fix-module-if-obj_new (idlwave-what-module))) 7475 (module (idlwave-fix-module-if-obj_new (idlwave-what-module)))
7476 (default (if module 7476 (default (if module
7477 (concat (idlwave-make-full-name 7477 (concat (idlwave-make-full-name
7478 (nth 2 module) (car module)) 7478 (nth 2 module) (car module))
7479 (if (eq (nth 1 module) 'pro) "<p>" "<f>")) 7479 (if (eq (nth 1 module) 'pro) "<p>" "<f>"))
7480 "none")) 7480 "none"))
7481 (list 7481 (list
7482 (idlwave-uniquify 7482 (idlwave-uniquify
7483 (delq nil 7483 (delq nil
7484 (mapcar (lambda (x) 7484 (mapcar (lambda (x)
7485 (if (eq 'system (car-safe (nth 3 x))) 7485 (if (eq 'system (car-safe (nth 3 x)))
7486 ;; Take out system routines with no source. 7486 ;; Take out system routines with no source.
7487 nil 7487 nil
7488 (list 7488 (list
7489 (concat (idlwave-make-full-name 7489 (concat (idlwave-make-full-name
7490 (nth 2 x) (car x)) 7490 (nth 2 x) (car x))
7491 (if (eq (nth 1 x) 'pro) "<p>" "<f>"))))) 7491 (if (eq (nth 1 x) 'pro) "<p>" "<f>")))))
7492 (if this-buffer 7492 (if this-buffer
@@ -7515,10 +7515,10 @@ force class query for object methods."
7515 (t t))) 7515 (t t)))
7516 (idlwave-do-find-module name type class nil this-buffer))) 7516 (idlwave-do-find-module name type class nil this-buffer)))
7517 7517
7518(defun idlwave-do-find-module (name type class 7518(defun idlwave-do-find-module (name type class
7519 &optional force-source this-buffer) 7519 &optional force-source this-buffer)
7520 (let ((name1 (idlwave-make-full-name class name)) 7520 (let ((name1 (idlwave-make-full-name class name))
7521 source buf1 entry 7521 source buf1 entry
7522 (buf (current-buffer)) 7522 (buf (current-buffer))
7523 (pos (point)) 7523 (pos (point))
7524 file name2) 7524 file name2)
@@ -7528,11 +7528,11 @@ force class query for object methods."
7528 name2 (if (nth 2 entry) 7528 name2 (if (nth 2 entry)
7529 (idlwave-make-full-name (nth 2 entry) name) 7529 (idlwave-make-full-name (nth 2 entry) name)
7530 name1)) 7530 name1))
7531 (if source 7531 (if source
7532 (setq file (idlwave-routine-source-file source))) 7532 (setq file (idlwave-routine-source-file source)))
7533 (unless file ; Try to find it on the path. 7533 (unless file ; Try to find it on the path.
7534 (setq file 7534 (setq file
7535 (idlwave-expand-lib-file-name 7535 (idlwave-expand-lib-file-name
7536 (if class 7536 (if class
7537 (format "%s__define.pro" (downcase class)) 7537 (format "%s__define.pro" (downcase class))
7538 (format "%s.pro" (downcase name)))))) 7538 (format "%s.pro" (downcase name))))))
@@ -7540,14 +7540,14 @@ force class query for object methods."
7540 ((or (null name) (equal name "")) 7540 ((or (null name) (equal name ""))
7541 (error "Abort")) 7541 (error "Abort"))
7542 ((eq (car source) 'system) 7542 ((eq (car source) 'system)
7543 (error "Source code for system routine %s is not available" 7543 (error "Source code for system routine %s is not available"
7544 name2)) 7544 name2))
7545 ((or (not file) (not (file-regular-p file))) 7545 ((or (not file) (not (file-regular-p file)))
7546 (error "Source code for routine %s is not available" 7546 (error "Source code for routine %s is not available"
7547 name2)) 7547 name2))
7548 (t 7548 (t
7549 (when (not this-buffer) 7549 (when (not this-buffer)
7550 (setq buf1 7550 (setq buf1
7551 (idlwave-find-file-noselect file 'find)) 7551 (idlwave-find-file-noselect file 'find))
7552 (pop-to-buffer buf1 t)) 7552 (pop-to-buffer buf1 t))
7553 (goto-char (point-max)) 7553 (goto-char (point-max))
@@ -7557,7 +7557,7 @@ force class query for object methods."
7557 (cond ((eq type 'fun) "function") 7557 (cond ((eq type 'fun) "function")
7558 ((eq type 'pro) "pro") 7558 ((eq type 'pro) "pro")
7559 (t "\\(pro\\|function\\)")) 7559 (t "\\(pro\\|function\\)"))
7560 "\\>[ \t]+" 7560 "\\>[ \t]+"
7561 (regexp-quote (downcase name2)) 7561 (regexp-quote (downcase name2))
7562 "[^a-zA-Z0-9_$]") 7562 "[^a-zA-Z0-9_$]")
7563 nil t) 7563 nil t)
@@ -7594,17 +7594,17 @@ Used by `idlwave-routine-info' and `idlwave-find-module'."
7594 (cond 7594 (cond
7595 ((and (eq cw 'procedure) 7595 ((and (eq cw 'procedure)
7596 (not (equal this-word ""))) 7596 (not (equal this-word "")))
7597 (setq this-word (idlwave-sintern-routine-or-method 7597 (setq this-word (idlwave-sintern-routine-or-method
7598 this-word (nth 2 (nth 3 where)))) 7598 this-word (nth 2 (nth 3 where))))
7599 (list this-word 'pro 7599 (list this-word 'pro
7600 (idlwave-determine-class 7600 (idlwave-determine-class
7601 (cons this-word (cdr (nth 3 where))) 7601 (cons this-word (cdr (nth 3 where)))
7602 'pro))) 7602 'pro)))
7603 ((and (eq cw 'function) 7603 ((and (eq cw 'function)
7604 (not (equal this-word "")) 7604 (not (equal this-word ""))
7605 (or (eq next-char ?\() ; exclude arrays, vars. 7605 (or (eq next-char ?\() ; exclude arrays, vars.
7606 (looking-at "[a-zA-Z0-9_]*[ \t]*("))) 7606 (looking-at "[a-zA-Z0-9_]*[ \t]*(")))
7607 (setq this-word (idlwave-sintern-routine-or-method 7607 (setq this-word (idlwave-sintern-routine-or-method
7608 this-word (nth 2 (nth 3 where)))) 7608 this-word (nth 2 (nth 3 where))))
7609 (list this-word 'fun 7609 (list this-word 'fun
7610 (idlwave-determine-class 7610 (idlwave-determine-class
@@ -7641,7 +7641,7 @@ Used by `idlwave-routine-info' and `idlwave-find-module'."
7641 class))) 7641 class)))
7642 7642
7643(defun idlwave-fix-module-if-obj_new (module) 7643(defun idlwave-fix-module-if-obj_new (module)
7644 "Check if MODULE points to obj_new. 7644 "Check if MODULE points to obj_new.
7645If yes, and if the cursor is in the keyword region, change to the 7645If yes, and if the cursor is in the keyword region, change to the
7646appropriate Init method." 7646appropriate Init method."
7647 (let* ((name (car module)) 7647 (let* ((name (car module))
@@ -7681,30 +7681,30 @@ from all classes if class equals t."
7681 string) 7681 string)
7682 (setq class (idlwave-sintern-class (match-string 1 string))) 7682 (setq class (idlwave-sintern-class (match-string 1 string)))
7683 (setq idlwave-current-obj_new-class class) 7683 (setq idlwave-current-obj_new-class class)
7684 (setq keywords 7684 (setq keywords
7685 (append keywords 7685 (append keywords
7686 (idlwave-entry-keywords 7686 (idlwave-entry-keywords
7687 (idlwave-rinfo-assq 7687 (idlwave-rinfo-assq
7688 (idlwave-sintern-method "INIT") 7688 (idlwave-sintern-method "INIT")
7689 'fun 7689 'fun
7690 class 7690 class
7691 (idlwave-routines)) 'do-link)))))) 7691 (idlwave-routines)) 'do-link))))))
7692 7692
7693 ;; If the class is `t', combine all keywords of all methods NAME 7693 ;; If the class is `t', combine all keywords of all methods NAME
7694 (when (eq class t) 7694 (when (eq class t)
7695 (mapc (lambda (entry) 7695 (mapc (lambda (entry)
7696 (and 7696 (and
7697 (nth 2 entry) ; non-nil class 7697 (nth 2 entry) ; non-nil class
7698 (eq (nth 1 entry) type) ; correct type 7698 (eq (nth 1 entry) type) ; correct type
7699 (setq keywords 7699 (setq keywords
7700 (append keywords 7700 (append keywords
7701 (idlwave-entry-keywords entry 'do-link))))) 7701 (idlwave-entry-keywords entry 'do-link)))))
7702 (idlwave-all-assq name (idlwave-routines))) 7702 (idlwave-all-assq name (idlwave-routines)))
7703 (setq keywords (idlwave-uniquify keywords))) 7703 (setq keywords (idlwave-uniquify keywords)))
7704 7704
7705 ;; If we have inheritance, add all keywords from superclasses, if 7705 ;; If we have inheritance, add all keywords from superclasses, if
7706 ;; the user indicated that method in `idlwave-keyword-class-inheritance' 7706 ;; the user indicated that method in `idlwave-keyword-class-inheritance'
7707 (when (and 7707 (when (and
7708 super-classes 7708 super-classes
7709 idlwave-keyword-class-inheritance 7709 idlwave-keyword-class-inheritance
7710 (stringp class) 7710 (stringp class)
@@ -7724,7 +7724,7 @@ from all classes if class equals t."
7724 (mapcar (lambda (k) (add-to-list 'keywords k)) 7724 (mapcar (lambda (k) (add-to-list 'keywords k))
7725 (idlwave-entry-keywords entry 'do-link)))) 7725 (idlwave-entry-keywords entry 'do-link))))
7726 (setq keywords (idlwave-uniquify keywords))) 7726 (setq keywords (idlwave-uniquify keywords)))
7727 7727
7728 ;; Return the final list 7728 ;; Return the final list
7729 keywords)) 7729 keywords))
7730 7730
@@ -7749,14 +7749,14 @@ If we do not know about MODULE, just return KEYWORD literally."
7749 (assq (idlwave-sintern-keyword "_REF_EXTRA") kwd-alist))) 7749 (assq (idlwave-sintern-keyword "_REF_EXTRA") kwd-alist)))
7750 (completion-ignore-case t) 7750 (completion-ignore-case t)
7751 candidates) 7751 candidates)
7752 (cond ((assq kwd kwd-alist) 7752 (cond ((assq kwd kwd-alist)
7753 kwd) 7753 kwd)
7754 ((setq candidates (all-completions kwd kwd-alist)) 7754 ((setq candidates (all-completions kwd kwd-alist))
7755 (if (= (length candidates) 1) 7755 (if (= (length candidates) 1)
7756 (car candidates) 7756 (car candidates)
7757 candidates)) 7757 candidates))
7758 ((and entry extra) 7758 ((and entry extra)
7759 ;; Inheritance may cause this keyword to be correct 7759 ;; Inheritance may cause this keyword to be correct
7760 keyword) 7760 keyword)
7761 (entry 7761 (entry
7762 ;; We do know the function, which does not have the keyword. 7762 ;; We do know the function, which does not have the keyword.
@@ -7768,13 +7768,13 @@ If we do not know about MODULE, just return KEYWORD literally."
7768 7768
7769(defvar idlwave-rinfo-mouse-map (make-sparse-keymap)) 7769(defvar idlwave-rinfo-mouse-map (make-sparse-keymap))
7770(defvar idlwave-rinfo-map (make-sparse-keymap)) 7770(defvar idlwave-rinfo-map (make-sparse-keymap))
7771(define-key idlwave-rinfo-mouse-map 7771(define-key idlwave-rinfo-mouse-map
7772 (if (featurep 'xemacs) [button2] [mouse-2]) 7772 (if (featurep 'xemacs) [button2] [mouse-2])
7773 'idlwave-mouse-active-rinfo) 7773 'idlwave-mouse-active-rinfo)
7774(define-key idlwave-rinfo-mouse-map 7774(define-key idlwave-rinfo-mouse-map
7775 (if (featurep 'xemacs) [(shift button2)] [(shift mouse-2)]) 7775 (if (featurep 'xemacs) [(shift button2)] [(shift mouse-2)])
7776 'idlwave-mouse-active-rinfo-shift) 7776 'idlwave-mouse-active-rinfo-shift)
7777(define-key idlwave-rinfo-mouse-map 7777(define-key idlwave-rinfo-mouse-map
7778 (if (featurep 'xemacs) [button3] [mouse-3]) 7778 (if (featurep 'xemacs) [button3] [mouse-3])
7779 'idlwave-mouse-active-rinfo-right) 7779 'idlwave-mouse-active-rinfo-right)
7780(define-key idlwave-rinfo-mouse-map " " 'idlwave-active-rinfo-space) 7780(define-key idlwave-rinfo-mouse-map " " 'idlwave-active-rinfo-space)
@@ -7800,7 +7800,7 @@ If we do not know about MODULE, just return KEYWORD literally."
7800 (let* ((initial-class (or initial-class class)) 7800 (let* ((initial-class (or initial-class class))
7801 (entry (or (idlwave-best-rinfo-assq name type class 7801 (entry (or (idlwave-best-rinfo-assq name type class
7802 (idlwave-routines)) 7802 (idlwave-routines))
7803 (idlwave-rinfo-assq name type class 7803 (idlwave-rinfo-assq name type class
7804 idlwave-unresolved-routines))) 7804 idlwave-unresolved-routines)))
7805 (name (or (car entry) name)) 7805 (name (or (car entry) name))
7806 (class (or (nth 2 entry) class)) 7806 (class (or (nth 2 entry) class))
@@ -7825,7 +7825,7 @@ If we do not know about MODULE, just return KEYWORD literally."
7825 (km-prop (if (featurep 'xemacs) 'keymap 'local-map)) 7825 (km-prop (if (featurep 'xemacs) 'keymap 'local-map))
7826 (face 'idlwave-help-link-face) 7826 (face 'idlwave-help-link-face)
7827 beg props win cnt total) 7827 beg props win cnt total)
7828 ;; Fix keywords, but don't add chained super-classes, since these 7828 ;; Fix keywords, but don't add chained super-classes, since these
7829 ;; are shown separately for that super-class 7829 ;; are shown separately for that super-class
7830 (setq keywords (idlwave-fix-keywords name type class keywords)) 7830 (setq keywords (idlwave-fix-keywords name type class keywords))
7831 (cond 7831 (cond
@@ -7867,7 +7867,7 @@ If we do not know about MODULE, just return KEYWORD literally."
7867 km-prop idlwave-rinfo-mouse-map 7867 km-prop idlwave-rinfo-mouse-map
7868 'help-echo help-echo-use 7868 'help-echo help-echo-use
7869 'data (cons 'usage data))) 7869 'data (cons 'usage data)))
7870 (if html-file (setq props (append (list 'face face 'link html-file) 7870 (if html-file (setq props (append (list 'face face 'link html-file)
7871 props))) 7871 props)))
7872 (insert "Usage: ") 7872 (insert "Usage: ")
7873 (setq beg (point)) 7873 (setq beg (point))
@@ -7876,14 +7876,14 @@ If we do not know about MODULE, just return KEYWORD literally."
7876 (format calling-seq name name name name)) 7876 (format calling-seq name name name name))
7877 "\n") 7877 "\n")
7878 (add-text-properties beg (point) props) 7878 (add-text-properties beg (point) props)
7879 7879
7880 (insert "Keywords:") 7880 (insert "Keywords:")
7881 (if (null keywords) 7881 (if (null keywords)
7882 (insert " No keywords accepted.") 7882 (insert " No keywords accepted.")
7883 (setq col 9) 7883 (setq col 9)
7884 (mapcar 7884 (mapcar
7885 (lambda (x) 7885 (lambda (x)
7886 (if (>= (+ col 1 (length (car x))) 7886 (if (>= (+ col 1 (length (car x)))
7887 (window-width)) 7887 (window-width))
7888 (progn 7888 (progn
7889 (insert "\n ") 7889 (insert "\n ")
@@ -7901,7 +7901,7 @@ If we do not know about MODULE, just return KEYWORD literally."
7901 (add-text-properties beg (point) props) 7901 (add-text-properties beg (point) props)
7902 (setq col (+ col 1 (length (car x))))) 7902 (setq col (+ col 1 (length (car x)))))
7903 keywords)) 7903 keywords))
7904 7904
7905 (setq cnt 1 total (length all)) 7905 (setq cnt 1 total (length all))
7906 ;; Here entry is (key file (list of type-conses)) 7906 ;; Here entry is (key file (list of type-conses))
7907 (while (setq entry (pop all)) 7907 (while (setq entry (pop all))
@@ -7914,7 +7914,7 @@ If we do not know about MODULE, just return KEYWORD literally."
7914 (cdr (car (nth 2 entry)))) 7914 (cdr (car (nth 2 entry))))
7915 'data (cons 'source data))) 7915 'data (cons 'source data)))
7916 (idlwave-insert-source-location 7916 (idlwave-insert-source-location
7917 (format "\n%-8s %s" 7917 (format "\n%-8s %s"
7918 (if (equal cnt 1) 7918 (if (equal cnt 1)
7919 (if (> total 1) "Sources:" "Source:") 7919 (if (> total 1) "Sources:" "Source:")
7920 "") 7920 "")
@@ -7923,7 +7923,7 @@ If we do not know about MODULE, just return KEYWORD literally."
7923 (incf cnt) 7923 (incf cnt)
7924 (when (and all (> cnt idlwave-rinfo-max-source-lines)) 7924 (when (and all (> cnt idlwave-rinfo-max-source-lines))
7925 ;; No more source lines, please 7925 ;; No more source lines, please
7926 (insert (format 7926 (insert (format
7927 "\n Source information truncated to %d entries." 7927 "\n Source information truncated to %d entries."
7928 idlwave-rinfo-max-source-lines)) 7928 idlwave-rinfo-max-source-lines))
7929 (setq all nil))) 7929 (setq all nil)))
@@ -7937,7 +7937,7 @@ If we do not know about MODULE, just return KEYWORD literally."
7937 (unwind-protect 7937 (unwind-protect
7938 (progn 7938 (progn
7939 (select-window win) 7939 (select-window win)
7940 (enlarge-window (- (/ (frame-height) 2) 7940 (enlarge-window (- (/ (frame-height) 2)
7941 (window-height))) 7941 (window-height)))
7942 (shrink-window-if-larger-than-buffer)) 7942 (shrink-window-if-larger-than-buffer))
7943 (select-window ww))))))))) 7943 (select-window ww)))))))))
@@ -7974,9 +7974,9 @@ it."
7974 ((and (not file) shell-flag) 7974 ((and (not file) shell-flag)
7975 (insert "Unresolved")) 7975 (insert "Unresolved"))
7976 7976
7977 ((null file) 7977 ((null file)
7978 (insert "ERROR")) 7978 (insert "ERROR"))
7979 7979
7980 ((idlwave-syslib-p file) 7980 ((idlwave-syslib-p file)
7981 (if (string-match "obsolete" (file-name-directory file)) 7981 (if (string-match "obsolete" (file-name-directory file))
7982 (insert "Obsolete ") 7982 (insert "Obsolete ")
@@ -7990,7 +7990,7 @@ it."
7990 ;; Old special syntax: a matching regexp 7990 ;; Old special syntax: a matching regexp
7991 ((setq special (idlwave-special-lib-test file)) 7991 ((setq special (idlwave-special-lib-test file))
7992 (insert (format "%-10s" special))) 7992 (insert (format "%-10s" special)))
7993 7993
7994 ;; Catch-all with file 7994 ;; Catch-all with file
7995 ((idlwave-lib-p file) (insert "Library ")) 7995 ((idlwave-lib-p file) (insert "Library "))
7996 7996
@@ -8005,7 +8005,7 @@ it."
8005 (if shell-flag "S" "-") 8005 (if shell-flag "S" "-")
8006 (if buffer-flag "B" "-") 8006 (if buffer-flag "B" "-")
8007 "] "))) 8007 "] ")))
8008 (when (> ndupl 1) 8008 (when (> ndupl 1)
8009 (setq beg (point)) 8009 (setq beg (point))
8010 (insert (format "(%dx) " ndupl)) 8010 (insert (format "(%dx) " ndupl))
8011 (add-text-properties beg (point) (list 'face 'bold))) 8011 (add-text-properties beg (point) (list 'face 'bold)))
@@ -8029,7 +8029,7 @@ Return the name of the special lib if there is a match."
8029 alist nil))) 8029 alist nil)))
8030 rtn) 8030 rtn)
8031 (t nil)))) 8031 (t nil))))
8032 8032
8033(defun idlwave-mouse-active-rinfo-right (ev) 8033(defun idlwave-mouse-active-rinfo-right (ev)
8034 (interactive "e") 8034 (interactive "e")
8035 (idlwave-mouse-active-rinfo ev 'right)) 8035 (idlwave-mouse-active-rinfo ev 'right))
@@ -8062,9 +8062,9 @@ was pressed."
8062 8062
8063 (cond ((eq id 'class) ; Switch class being displayed 8063 (cond ((eq id 'class) ; Switch class being displayed
8064 (if (window-live-p bufwin) (select-window bufwin)) 8064 (if (window-live-p bufwin) (select-window bufwin))
8065 (idlwave-display-calling-sequence 8065 (idlwave-display-calling-sequence
8066 (idlwave-sintern-method name) 8066 (idlwave-sintern-method name)
8067 type (idlwave-sintern-class word) 8067 type (idlwave-sintern-class word)
8068 initial-class)) 8068 initial-class))
8069 ((eq id 'usage) ; Online help on this routine 8069 ((eq id 'usage) ; Online help on this routine
8070 (idlwave-online-help link name type class)) 8070 (idlwave-online-help link name type class))
@@ -8105,9 +8105,9 @@ was pressed."
8105 (setq bwin (get-buffer-window buffer))) 8105 (setq bwin (get-buffer-window buffer)))
8106 (if (eq (preceding-char) ?/) 8106 (if (eq (preceding-char) ?/)
8107 (insert keyword) 8107 (insert keyword)
8108 (unless (save-excursion 8108 (unless (save-excursion
8109 (re-search-backward 8109 (re-search-backward
8110 "[(,][ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\)?[ \t]*\\=" 8110 "[(,][ \t]*\\(\\$[ \t]*\\(;.*\\)?\n\\)?[ \t]*\\="
8111 (min (- (point) 100) (point-min)) t)) 8111 (min (- (point) 100) (point-min)) t))
8112 (insert ", ")) 8112 (insert ", "))
8113 (if shift (insert "/")) 8113 (if shift (insert "/"))
@@ -8159,7 +8159,7 @@ the load path in order to find a definition. The output of this
8159command can be used to detect possible name clashes during this process." 8159command can be used to detect possible name clashes during this process."
8160 (idlwave-routines) ; Make sure everything is loaded. 8160 (idlwave-routines) ; Make sure everything is loaded.
8161 (unless (or idlwave-user-catalog-routines idlwave-library-catalog-routines) 8161 (unless (or idlwave-user-catalog-routines idlwave-library-catalog-routines)
8162 (or (y-or-n-p 8162 (or (y-or-n-p
8163 "You don't have any user or library catalogs. Continue anyway? ") 8163 "You don't have any user or library catalogs. Continue anyway? ")
8164 (error "Abort"))) 8164 (error "Abort")))
8165 (let* ((routines (append idlwave-system-routines 8165 (let* ((routines (append idlwave-system-routines
@@ -8172,7 +8172,7 @@ command can be used to detect possible name clashes during this process."
8172 (keymap (make-sparse-keymap)) 8172 (keymap (make-sparse-keymap))
8173 (props (list 'mouse-face 'highlight 8173 (props (list 'mouse-face 'highlight
8174 km-prop keymap 8174 km-prop keymap
8175 'help-echo "Mouse2: Find source")) 8175 'help-echo "Mouse2: Find source"))
8176 (nroutines (length (or special-routines routines))) 8176 (nroutines (length (or special-routines routines)))
8177 (step (/ nroutines 99)) 8177 (step (/ nroutines 99))
8178 (n 0) 8178 (n 0)
@@ -8196,13 +8196,13 @@ command can be used to detect possible name clashes during this process."
8196 (message "Sorting routines...done") 8196 (message "Sorting routines...done")
8197 8197
8198 (define-key keymap (if (featurep 'xemacs) [(button2)] [(mouse-2)]) 8198 (define-key keymap (if (featurep 'xemacs) [(button2)] [(mouse-2)])
8199 (lambda (ev) 8199 (lambda (ev)
8200 (interactive "e") 8200 (interactive "e")
8201 (mouse-set-point ev) 8201 (mouse-set-point ev)
8202 (apply 'idlwave-do-find-module 8202 (apply 'idlwave-do-find-module
8203 (get-text-property (point) 'find-args)))) 8203 (get-text-property (point) 'find-args))))
8204 (define-key keymap [(return)] 8204 (define-key keymap [(return)]
8205 (lambda () 8205 (lambda ()
8206 (interactive) 8206 (interactive)
8207 (apply 'idlwave-do-find-module 8207 (apply 'idlwave-do-find-module
8208 (get-text-property (point) 'find-args)))) 8208 (get-text-property (point) 'find-args))))
@@ -8230,13 +8230,13 @@ command can be used to detect possible name clashes during this process."
8230 (> (idlwave-count-memq 'buffer (nth 2 (car dtwins))) 1)) 8230 (> (idlwave-count-memq 'buffer (nth 2 (car dtwins))) 1))
8231 (incf cnt) 8231 (incf cnt)
8232 (insert (format "\n%s%s" 8232 (insert (format "\n%s%s"
8233 (idlwave-make-full-name (nth 2 routine) 8233 (idlwave-make-full-name (nth 2 routine)
8234 (car routine)) 8234 (car routine))
8235 (if (eq (nth 1 routine) 'fun) "()" ""))) 8235 (if (eq (nth 1 routine) 'fun) "()" "")))
8236 (while (setq twin (pop dtwins)) 8236 (while (setq twin (pop dtwins))
8237 (setq props1 (append (list 'find-args 8237 (setq props1 (append (list 'find-args
8238 (list (nth 0 routine) 8238 (list (nth 0 routine)
8239 (nth 1 routine) 8239 (nth 1 routine)
8240 (nth 2 routine))) 8240 (nth 2 routine)))
8241 props)) 8241 props))
8242 (idlwave-insert-source-location "\n - " twin props1)))) 8242 (idlwave-insert-source-location "\n - " twin props1))))
@@ -8259,7 +8259,7 @@ command can be used to detect possible name clashes during this process."
8259 (or (not (stringp sfile)) 8259 (or (not (stringp sfile))
8260 (not (string-match "\\S-" sfile)))) 8260 (not (string-match "\\S-" sfile))))
8261 (setq stype 'unresolved)) 8261 (setq stype 'unresolved))
8262 (princ (format " %-10s %s\n" 8262 (princ (format " %-10s %s\n"
8263 stype 8263 stype
8264 (if sfile sfile "No source code available"))))) 8264 (if sfile sfile "No source code available")))))
8265 8265
@@ -8278,20 +8278,20 @@ ENTRY will also be returned, as the first item of this list."
8278 (eq type (nth 1 candidate)) 8278 (eq type (nth 1 candidate))
8279 (eq class (nth 2 candidate))) 8279 (eq class (nth 2 candidate)))
8280 (push candidate twins))) 8280 (push candidate twins)))
8281 (if (setq candidate (idlwave-rinfo-assq name type class 8281 (if (setq candidate (idlwave-rinfo-assq name type class
8282 idlwave-unresolved-routines)) 8282 idlwave-unresolved-routines))
8283 (push candidate twins)) 8283 (push candidate twins))
8284 (cons entry (nreverse twins)))) 8284 (cons entry (nreverse twins))))
8285 8285
8286(defun idlwave-study-twins (entries) 8286(defun idlwave-study-twins (entries)
8287 "Return dangerous twins of first entry in ENTRIES. 8287 "Return dangerous twins of first entry in ENTRIES.
8288Dangerous twins are routines with same name, but in different files on 8288Dangerous twins are routines with same name, but in different files on
8289the load path. If a file is in the system library and has an entry in 8289the load path. If a file is in the system library and has an entry in
8290the `idlwave-system-routines' list, we omit the latter as 8290the `idlwave-system-routines' list, we omit the latter as
8291non-dangerous because many IDL routines are implemented as library 8291non-dangerous because many IDL routines are implemented as library
8292routines, and may have been scanned." 8292routines, and may have been scanned."
8293 (let* ((entry (car entries)) 8293 (let* ((entry (car entries))
8294 (name (car entry)) ; 8294 (name (car entry)) ;
8295 (type (nth 1 entry)) ; Must be bound for 8295 (type (nth 1 entry)) ; Must be bound for
8296 (class (nth 2 entry)) ; idlwave-routine-twin-compare 8296 (class (nth 2 entry)) ; idlwave-routine-twin-compare
8297 (cnt 0) 8297 (cnt 0)
@@ -8309,23 +8309,23 @@ routines, and may have been scanned."
8309 (t 'unresolved))) 8309 (t 'unresolved)))
8310 8310
8311 ;; Check for an entry in the system library 8311 ;; Check for an entry in the system library
8312 (if (and file 8312 (if (and file
8313 (not syslibp) 8313 (not syslibp)
8314 (idlwave-syslib-p file)) 8314 (idlwave-syslib-p file))
8315 (setq syslibp t)) 8315 (setq syslibp t))
8316 8316
8317 ;; If there's more than one matching entry for the same file, just 8317 ;; If there's more than one matching entry for the same file, just
8318 ;; append the type-cons to the type list. 8318 ;; append the type-cons to the type list.
8319 (if (setq entry (assoc key alist)) 8319 (if (setq entry (assoc key alist))
8320 (push type-cons (nth 2 entry)) 8320 (push type-cons (nth 2 entry))
8321 (push (list key file (list type-cons)) alist))) 8321 (push (list key file (list type-cons)) alist)))
8322 8322
8323 (setq alist (nreverse alist)) 8323 (setq alist (nreverse alist))
8324 8324
8325 (when syslibp 8325 (when syslibp
8326 ;; File is in system *library* - remove any 'system entry 8326 ;; File is in system *library* - remove any 'system entry
8327 (setq alist (delq (assq 'system alist) alist))) 8327 (setq alist (delq (assq 'system alist) alist)))
8328 8328
8329 ;; If 'system remains and we've scanned the syslib, it's a builtin 8329 ;; If 'system remains and we've scanned the syslib, it's a builtin
8330 ;; (rather than a !DIR/lib/.pro file bundled as source). 8330 ;; (rather than a !DIR/lib/.pro file bundled as source).
8331 (when (and (idlwave-syslib-scanned-p) 8331 (when (and (idlwave-syslib-scanned-p)
@@ -8362,7 +8362,7 @@ compares twins on the basis of their file names and path locations."
8362 ((not (eq type (nth 1 b))) 8362 ((not (eq type (nth 1 b)))
8363 ;; Type decides 8363 ;; Type decides
8364 (< (if (eq type 'fun) 1 0) (if (eq (nth 1 b) 'fun) 1 0))) 8364 (< (if (eq type 'fun) 1 0) (if (eq (nth 1 b) 'fun) 1 0)))
8365 (t 8365 (t
8366 ;; A and B are twins - so the decision is more complicated. 8366 ;; A and B are twins - so the decision is more complicated.
8367 ;; Call twin-compare with the proper arguments. 8367 ;; Call twin-compare with the proper arguments.
8368 (idlwave-routine-entry-compare-twins a b))))) 8368 (idlwave-routine-entry-compare-twins a b)))))
@@ -8414,7 +8414,7 @@ This expects NAME TYPE CLASS to be bound to the right values."
8414 (tpath-alist (idlwave-true-path-alist)) 8414 (tpath-alist (idlwave-true-path-alist))
8415 (apathp (and (stringp akey) 8415 (apathp (and (stringp akey)
8416 (assoc (file-name-directory akey) tpath-alist))) 8416 (assoc (file-name-directory akey) tpath-alist)))
8417 (bpathp (and (stringp bkey) 8417 (bpathp (and (stringp bkey)
8418 (assoc (file-name-directory bkey) tpath-alist))) 8418 (assoc (file-name-directory bkey) tpath-alist)))
8419 ;; How early on search path? High number means early since we 8419 ;; How early on search path? High number means early since we
8420 ;; measure the tail of the path list 8420 ;; measure the tail of the path list
@@ -8450,7 +8450,7 @@ This expects NAME TYPE CLASS to be bound to the right values."
8450 (t nil)))) ; Default 8450 (t nil)))) ; Default
8451 8451
8452(defun idlwave-routine-source-file (source) 8452(defun idlwave-routine-source-file (source)
8453 (if (nth 2 source) 8453 (if (nth 2 source)
8454 (expand-file-name (nth 1 source) (nth 2 source)) 8454 (expand-file-name (nth 1 source) (nth 2 source))
8455 (nth 1 source))) 8455 (nth 1 source)))
8456 8456
@@ -8540,7 +8540,7 @@ Assumes that point is at the beginning of the unit as found by
8540 (forward-sexp 2) 8540 (forward-sexp 2)
8541 (forward-sexp -1) 8541 (forward-sexp -1)
8542 (let ((begin (point))) 8542 (let ((begin (point)))
8543 (re-search-forward 8543 (re-search-forward
8544 "[a-zA-Z_][a-zA-Z0-9$_]+\\(::[a-zA-Z_][a-zA-Z0-9$_]+\\)?") 8544 "[a-zA-Z_][a-zA-Z0-9$_]+\\(::[a-zA-Z_][a-zA-Z0-9$_]+\\)?")
8545 (if (fboundp 'buffer-substring-no-properties) 8545 (if (fboundp 'buffer-substring-no-properties)
8546 (buffer-substring-no-properties begin (point)) 8546 (buffer-substring-no-properties begin (point))
@@ -8580,12 +8580,12 @@ Assumes that point is at the beginning of the unit as found by
8580 (start-process "idldeclient" nil 8580 (start-process "idldeclient" nil
8581 idlwave-shell-explicit-file-name "-c" "-e" 8581 idlwave-shell-explicit-file-name "-c" "-e"
8582 (buffer-file-name) "&")) 8582 (buffer-file-name) "&"))
8583 8583
8584(defun idlwave-launch-idlhelp () 8584(defun idlwave-launch-idlhelp ()
8585 "Start the IDLhelp application." 8585 "Start the IDLhelp application."
8586 (interactive) 8586 (interactive)
8587 (start-process "idlhelp" nil idlwave-help-application)) 8587 (start-process "idlhelp" nil idlwave-help-application))
8588 8588
8589;; Menus - using easymenu.el 8589;; Menus - using easymenu.el
8590(defvar idlwave-mode-menu-def 8590(defvar idlwave-mode-menu-def
8591 `("IDLWAVE" 8591 `("IDLWAVE"
@@ -8672,7 +8672,7 @@ Assumes that point is at the beginning of the unit as found by
8672 ("Customize" 8672 ("Customize"
8673 ["Browse IDLWAVE Group" idlwave-customize t] 8673 ["Browse IDLWAVE Group" idlwave-customize t]
8674 "--" 8674 "--"
8675 ["Build Full Customize Menu" idlwave-create-customize-menu 8675 ["Build Full Customize Menu" idlwave-create-customize-menu
8676 (fboundp 'customize-menu-create)]) 8676 (fboundp 'customize-menu-create)])
8677 ("Documentation" 8677 ("Documentation"
8678 ["Describe Mode" describe-mode t] 8678 ["Describe Mode" describe-mode t]
@@ -8689,22 +8689,22 @@ Assumes that point is at the beginning of the unit as found by
8689 '("Debug" 8689 '("Debug"
8690 ["Start IDL shell" idlwave-shell t] 8690 ["Start IDL shell" idlwave-shell t]
8691 ["Save and .RUN buffer" idlwave-shell-save-and-run 8691 ["Save and .RUN buffer" idlwave-shell-save-and-run
8692 (and (boundp 'idlwave-shell-automatic-start) 8692 (and (boundp 'idlwave-shell-automatic-start)
8693 idlwave-shell-automatic-start)])) 8693 idlwave-shell-automatic-start)]))
8694 8694
8695(if (or (featurep 'easymenu) (load "easymenu" t)) 8695(if (or (featurep 'easymenu) (load "easymenu" t))
8696 (progn 8696 (progn
8697 (easy-menu-define idlwave-mode-menu idlwave-mode-map 8697 (easy-menu-define idlwave-mode-menu idlwave-mode-map
8698 "IDL and WAVE CL editing menu" 8698 "IDL and WAVE CL editing menu"
8699 idlwave-mode-menu-def) 8699 idlwave-mode-menu-def)
8700 (easy-menu-define idlwave-mode-debug-menu idlwave-mode-map 8700 (easy-menu-define idlwave-mode-debug-menu idlwave-mode-map
8701 "IDL and WAVE CL editing menu" 8701 "IDL and WAVE CL editing menu"
8702 idlwave-mode-debug-menu-def))) 8702 idlwave-mode-debug-menu-def)))
8703 8703
8704(defun idlwave-customize () 8704(defun idlwave-customize ()
8705 "Call the customize function with idlwave as argument." 8705 "Call the customize function with idlwave as argument."
8706 (interactive) 8706 (interactive)
8707 ;; Try to load the code for the shell, so that we can customize it 8707 ;; Try to load the code for the shell, so that we can customize it
8708 ;; as well. 8708 ;; as well.
8709 (or (featurep 'idlw-shell) 8709 (or (featurep 'idlw-shell)
8710 (load "idlw-shell" t)) 8710 (load "idlw-shell" t))
@@ -8715,11 +8715,11 @@ Assumes that point is at the beginning of the unit as found by
8715 (interactive) 8715 (interactive)
8716 (if (fboundp 'customize-menu-create) 8716 (if (fboundp 'customize-menu-create)
8717 (progn 8717 (progn
8718 ;; Try to load the code for the shell, so that we can customize it 8718 ;; Try to load the code for the shell, so that we can customize it
8719 ;; as well. 8719 ;; as well.
8720 (or (featurep 'idlw-shell) 8720 (or (featurep 'idlw-shell)
8721 (load "idlw-shell" t)) 8721 (load "idlw-shell" t))
8722 (easy-menu-change 8722 (easy-menu-change
8723 '("IDLWAVE") "Customize" 8723 '("IDLWAVE") "Customize"
8724 `(["Browse IDLWAVE group" idlwave-customize t] 8724 `(["Browse IDLWAVE group" idlwave-customize t]
8725 "--" 8725 "--"
@@ -8767,7 +8767,7 @@ This function was written since `list-abbrevs' looks terrible for IDLWAVE mode."
8767 (let ((table (symbol-value 'idlwave-mode-abbrev-table)) 8767 (let ((table (symbol-value 'idlwave-mode-abbrev-table))
8768 abbrevs 8768 abbrevs
8769 str rpl func fmt (len-str 0) (len-rpl 0)) 8769 str rpl func fmt (len-str 0) (len-rpl 0))
8770 (mapatoms 8770 (mapatoms
8771 (lambda (sym) 8771 (lambda (sym)
8772 (if (symbol-value sym) 8772 (if (symbol-value sym)
8773 (progn 8773 (progn
@@ -8793,7 +8793,7 @@ This function was written since `list-abbrevs' looks terrible for IDLWAVE mode."
8793 (with-output-to-temp-buffer "*Help*" 8793 (with-output-to-temp-buffer "*Help*"
8794 (if arg 8794 (if arg
8795 (progn 8795 (progn
8796 (princ "Abbreviations and Actions in IDLWAVE-Mode\n") 8796 (princ "Abbreviations and Actions in IDLWAVE-Mode\n")
8797 (princ "=========================================\n\n") 8797 (princ "=========================================\n\n")
8798 (princ (format fmt "KEY" "REPLACE" "HOOK")) 8798 (princ (format fmt "KEY" "REPLACE" "HOOK"))
8799 (princ (format fmt "---" "-------" "----"))) 8799 (princ (format fmt "---" "-------" "----")))
diff --git a/lisp/progmodes/ld-script.el b/lisp/progmodes/ld-script.el
index 120cae538d5..ef24604ba7b 100644
--- a/lisp/progmodes/ld-script.el
+++ b/lisp/progmodes/ld-script.el
@@ -1,6 +1,6 @@
1;;; ld-script.el --- GNU linker script editing mode for Emacs 1;;; ld-script.el --- GNU linker script editing mode for Emacs
2 2
3;; Copyright (C) 2003 Free Software Foundation, Inc. 3;; Copyright (C) 2003, 2005 Free Software Foundation, Inc.
4 4
5;; Author: Masatake YAMATO<jet@gyve.org> 5;; Author: Masatake YAMATO<jet@gyve.org>
6;; Keywords: languages, faces 6;; Keywords: languages, faces
@@ -34,11 +34,13 @@
34 :prefix "ld-script-" 34 :prefix "ld-script-"
35 :group 'languages) 35 :group 'languages)
36 36
37(defvar ld-script-location-counter-face 'ld-script-location-counter-face) 37(defvar ld-script-location-counter-face 'ld-script-location-counter)
38(defface ld-script-location-counter-face 38(defface ld-script-location-counter
39 '((t (:weight bold :inherit font-lock-builtin-face))) 39 '((t (:weight bold :inherit font-lock-builtin-face)))
40 "Face for location counter in GNU ld script." 40 "Face for location counter in GNU ld script."
41 :group 'ld-script) 41 :group 'ld-script)
42;; backward-compatibility alias
43(put 'ld-script-location-counter-face 'face-alias 'ld-script-location-counter)
42 44
43;; Syntax rules 45;; Syntax rules
44(defvar ld-script-mode-syntax-table 46(defvar ld-script-mode-syntax-table
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index 055cdf7fc7d..d9c38349b49 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -99,35 +99,38 @@
99 :group 'tools 99 :group 'tools
100 :prefix "makefile-") 100 :prefix "makefile-")
101 101
102(defface makefile-space-face 102(defface makefile-space
103 '((((class color)) (:background "hotpink")) 103 '((((class color)) (:background "hotpink"))
104 (t (:reverse-video t))) 104 (t (:reverse-video t)))
105 "Face to use for highlighting leading spaces in Font-Lock mode." 105 "Face to use for highlighting leading spaces in Font-Lock mode."
106 :group 'faces 106 :group 'faces
107 :group 'makefile) 107 :group 'makefile)
108 108
109(defface makefile-targets-face 109(defface makefile-targets
110 ;; This needs to go along both with foreground and background colors (i.e. shell) 110 ;; This needs to go along both with foreground and background colors (i.e. shell)
111 '((t (:underline t))) 111 '((t (:inherit font-lock-function-name-face)))
112 "Face to use for additionally highlighting rule targets in Font-Lock mode." 112 "Face to use for additionally highlighting rule targets in Font-Lock mode."
113 :group 'faces 113 :group 'faces
114 :group 'makefile) 114 :group 'makefile
115 :version "22.1")
115 116
116(defface makefile-shell-face 117(defface makefile-shell
117 '((((class color) (background light)) (:background "seashell1")) 118 ()
118 (((class color) (background dark)) (:background "seashell4")) 119 ;;'((((class color) (min-colors 88) (background light)) (:background "seashell1"))
119 (t (:reverse-video t))) 120 ;; (((class color) (min-colors 88) (background dark)) (:background "seashell4")))
120 "Face to use for additionally highlighting Shell commands in Font-Lock mode." 121 "Face to use for additionally highlighting Shell commands in Font-Lock mode."
121 :group 'faces 122 :group 'faces
122 :group 'makefile) 123 :group 'makefile
124 :version "22.1")
123 125
124(defface makefile-makepp-perl-face 126(defface makefile-makepp-perl
125 '((((class color) (background light)) (:background "LightBlue1")) ; Camel Book 127 '((((class color) (background light)) (:background "LightBlue1")) ; Camel Book
126 (((class color) (background dark)) (:background "DarkBlue")) 128 (((class color) (background dark)) (:background "DarkBlue"))
127 (t (:reverse-video t))) 129 (t (:reverse-video t)))
128 "Face to use for additionally highlighting Perl code in Font-Lock mode." 130 "Face to use for additionally highlighting Perl code in Font-Lock mode."
129 :group 'faces 131 :group 'faces
130 :group 'makefile) 132 :group 'makefile
133 :version "22.1")
131 134
132(defcustom makefile-browser-buffer-name "*Macros and Targets*" 135(defcustom makefile-browser-buffer-name "*Macros and Targets*"
133 "*Name of the macro- and target browser buffer." 136 "*Name of the macro- and target browser buffer."
@@ -259,9 +262,14 @@ not be enclosed in { } or ( )."
259;; index in makefile-imenu-generic-expression. 262;; index in makefile-imenu-generic-expression.
260(defvar makefile-dependency-regex 263(defvar makefile-dependency-regex
261 ;; Allow for two nested levels $(v1:$(v2:$(v3:a=b)=c)=d) 264 ;; Allow for two nested levels $(v1:$(v2:$(v3:a=b)=c)=d)
262 "^ *\\(\\(?: *\\$\\(?:[({]\\(?:\\$\\(?:[({]\\(?:\\$\\(?:[^({]\\|.[^\n$#})]+?[})]\\)\\|[^\n$#)}]\\)+?[})]\\|[^({]\\)\\|[^\n$#)}]\\)+?[})]\\|[^({]\\)\\| *[^ \n$#:=]+\\)+?\\)[ \t]*\\(:\\)\\(?:[ \t]*$\\|[^=\n]\\(?:[^#\n]*?;[ \t]*\\(.+\\)\\)?\\)" 265 "^\\(\\(?:\\$\\(?:[({]\\(?:\\$\\(?:[({]\\(?:\\$\\(?:[^({]\\|.[^\n$#})]+?[})]\\)\\|[^\n$#)}]\\)+?[})]\\|[^({]\\)\\|[^\n$#)}]\\)+?[})]\\|[^({]\\)\\|[^\n$#:=]\\)+?\\)\\(:\\)\\(?:[ \t]*$\\|[^=\n]\\(?:[^#\n]*?;[ \t]*\\(.+\\)\\)?\\)"
263 "Regex used to find dependency lines in a makefile.") 266 "Regex used to find dependency lines in a makefile.")
264 267
268(defconst makefile-bsdmake-dependency-regex
269 (progn (string-match (regexp-quote "\\(:\\)") makefile-dependency-regex)
270 (replace-match "\\([:!]\\)" t t makefile-dependency-regex))
271 "Regex used to find dependency lines in a BSD makefile.")
272
265(defvar makefile-dependency-skip "^:" 273(defvar makefile-dependency-skip "^:"
266 "Characters to skip to find a line that might be a dependency.") 274 "Characters to skip to find a line that might be a dependency.")
267 275
@@ -269,11 +277,21 @@ not be enclosed in { } or ( )."
269 "^\t[ \t]*\\([-@]*\\)[ \t]*\\(\\(?:.*\\\\\n\\)*.*\\)" 277 "^\t[ \t]*\\([-@]*\\)[ \t]*\\(\\(?:.*\\\\\n\\)*.*\\)"
270 "Regex used to highlight rule action lines in font lock mode.") 278 "Regex used to highlight rule action lines in font lock mode.")
271 279
280(defconst makefile-makepp-rule-action-regex
281 ;; Don't care about initial tab, but I don't know how to font-lock correctly without.
282 "^\t[ \t]*\\(\\(?:\\(?:noecho\\|ignore[-_]error\\|[-@]+\\)[ \t]*\\)*\\)\\(\\(&\\S +\\)?\\(?:.*\\\\\n\\)*.*\\)"
283 "Regex used to highlight makepp rule action lines in font lock mode.")
284
285(defconst makefile-bsdmake-rule-action-regex
286 (progn (string-match "-@" makefile-rule-action-regex)
287 (replace-match "-+@" t t makefile-rule-action-regex))
288 "Regex used to highlight BSD rule action lines in font lock mode.")
289
272;; Note that the first and second subexpression is used by font lock. Note 290;; Note that the first and second subexpression is used by font lock. Note
273;; that if you change this regexp you might have to fix the imenu index in 291;; that if you change this regexp you might have to fix the imenu index in
274;; makefile-imenu-generic-expression. 292;; makefile-imenu-generic-expression.
275(defconst makefile-macroassign-regex 293(defconst makefile-macroassign-regex
276 "^ *\\([^ \n\t][^:#= \t\n]*\\)[ \t]*\\(?:!=[ \t]*\\(\\(?:.+\\\\\n\\)*.+\\)\\|[*:+]?[:?]?=[ \t]*\\(\\(?:.*\\\\\n\\)*.*\\)\\)" 294 "^ *\\([^ \n\t][^:#= \t\n]*\\)[ \t]*\\(?:!=\\|[*:+]?[:?]?=\\)"
277 "Regex used to find macro assignment lines in a makefile.") 295 "Regex used to find macro assignment lines in a makefile.")
278 296
279(defconst makefile-var-use-regex 297(defconst makefile-var-use-regex
@@ -285,8 +303,8 @@ not be enclosed in { } or ( )."
285 "Regex for filenames that will NOT be included in the target list.") 303 "Regex for filenames that will NOT be included in the target list.")
286 304
287(if (fboundp 'facemenu-unlisted-faces) 305(if (fboundp 'facemenu-unlisted-faces)
288 (add-to-list 'facemenu-unlisted-faces 'makefile-space-face)) 306 (add-to-list 'facemenu-unlisted-faces 'makefile-space))
289(defvar makefile-space-face 'makefile-space-face 307(defvar makefile-space 'makefile-space
290 "Face to use for highlighting leading spaces in Font-Lock mode.") 308 "Face to use for highlighting leading spaces in Font-Lock mode.")
291 309
292;; These lists were inspired by the old solution. But they are silly, because 310;; These lists were inspired by the old solution. But they are silly, because
@@ -331,14 +349,14 @@ not be enclosed in { } or ( )."
331 (,makefile-macroassign-regex 349 (,makefile-macroassign-regex
332 (1 font-lock-variable-name-face) 350 (1 font-lock-variable-name-face)
333 ;; This is for after != 351 ;; This is for after !=
334 (2 'makefile-shell-face prepend t) 352 (2 'makefile-shell prepend t)
335 ;; This is for after normal assignment 353 ;; This is for after normal assignment
336 (3 'font-lock-string-face prepend t)) 354 (3 'font-lock-string-face prepend t))
337 355
338 ;; Rule actions. 356 ;; Rule actions.
339 (makefile-match-action 357 (makefile-match-action
340 (1 font-lock-type-face) 358 (1 font-lock-type-face)
341 (2 'makefile-shell-face prepend) 359 (2 'makefile-shell prepend)
342 ;; Only makepp has builtin commands. 360 ;; Only makepp has builtin commands.
343 (3 font-lock-builtin-face prepend t)) 361 (3 font-lock-builtin-face prepend t))
344 362
@@ -350,7 +368,7 @@ not be enclosed in { } or ( )."
350 ("[^$]\\$\\([@%<?^+*_]\\|[a-zA-Z0-9]\\>\\)" 368 ("[^$]\\$\\([@%<?^+*_]\\|[a-zA-Z0-9]\\>\\)"
351 1 font-lock-constant-face prepend) 369 1 font-lock-constant-face prepend)
352 ("[^$]\\(\\$[@%*]\\)" 370 ("[^$]\\(\\$[@%*]\\)"
353 1 'makefile-targets-face prepend) 371 1 'makefile-targets append)
354 372
355 ;; Fontify conditionals and includes. 373 ;; Fontify conditionals and includes.
356 (,(concat "^\\(?: [ \t]*\\)?" 374 (,(concat "^\\(?: [ \t]*\\)?"
@@ -365,22 +383,22 @@ not be enclosed in { } or ( )."
365 ,@(if space 383 ,@(if space
366 '(;; Highlight lines that contain just whitespace. 384 '(;; Highlight lines that contain just whitespace.
367 ;; They can cause trouble, especially if they start with a tab. 385 ;; They can cause trouble, especially if they start with a tab.
368 ("^[ \t]+$" . makefile-space-face) 386 ("^[ \t]+$" . makefile-space)
369 387
370 ;; Highlight shell comments that Make treats as commands, 388 ;; Highlight shell comments that Make treats as commands,
371 ;; since these can fool people. 389 ;; since these can fool people.
372 ("^\t+#" 0 makefile-space-face t) 390 ("^\t+#" 0 makefile-space t)
373 391
374 ;; Highlight spaces that precede tabs. 392 ;; Highlight spaces that precede tabs.
375 ;; They can make a tab fail to be effective. 393 ;; They can make a tab fail to be effective.
376 ("^\\( +\\)\t" 1 makefile-space-face))) 394 ("^\\( +\\)\t" 1 makefile-space)))
377 395
378 ,@font-lock-keywords 396 ,@font-lock-keywords
379 397
380 ;; Do dependencies. 398 ;; Do dependencies.
381 (makefile-match-dependency 399 (makefile-match-dependency
382 (1 'makefile-targets-face prepend) 400 (1 'makefile-targets prepend)
383 (3 'makefile-shell-face prepend t)))) 401 (3 'makefile-shell prepend t))))
384 402
385(defconst makefile-font-lock-keywords 403(defconst makefile-font-lock-keywords
386 (makefile-make-font-lock-keywords 404 (makefile-make-font-lock-keywords
@@ -402,7 +420,7 @@ not be enclosed in { } or ( )."
402 "^\\(?: [ \t]*\\)?if\\(n\\)\\(?:def\\|eq\\)\\>" 420 "^\\(?: [ \t]*\\)?if\\(n\\)\\(?:def\\|eq\\)\\>"
403 421
404 '("[^$]\\(\\$[({][@%*][DF][})]\\)" 422 '("[^$]\\(\\$[({][@%*][DF][})]\\)"
405 1 'makefile-targets-face prepend) 423 1 'makefile-targets append)
406 424
407 ;; $(function ...) ${function ...} 425 ;; $(function ...) ${function ...}
408 '("[^$]\\$[({]\\([-a-zA-Z0-9_.]+\\s \\)" 426 '("[^$]\\$[({]\\([-a-zA-Z0-9_.]+\\s \\)"
@@ -411,7 +429,7 @@ not be enclosed in { } or ( )."
411 ;; $(shell ...) ${shell ...} 429 ;; $(shell ...) ${shell ...}
412 '("[^$]\\$\\([({]\\)shell[ \t]+" 430 '("[^$]\\$\\([({]\\)shell[ \t]+"
413 makefile-match-function-end nil nil 431 makefile-match-function-end nil nil
414 (1 'makefile-shell-face prepend t)))) 432 (1 'makefile-shell prepend t))))
415 433
416(defconst makefile-makepp-font-lock-keywords 434(defconst makefile-makepp-font-lock-keywords
417 (makefile-make-font-lock-keywords 435 (makefile-make-font-lock-keywords
@@ -421,7 +439,7 @@ not be enclosed in { } or ( )."
421 "^\\(?: [ \t]*\\)?\\(?:and[ \t]+\\|else[ \t]+\\|or[ \t]+\\)?if\\(n\\)\\(?:def\\|eq\\|sys\\)\\>" 439 "^\\(?: [ \t]*\\)?\\(?:and[ \t]+\\|else[ \t]+\\|or[ \t]+\\)?if\\(n\\)\\(?:def\\|eq\\|sys\\)\\>"
422 440
423 '("[^$]\\(\\$[({]\\(?:output\\|stem\\|target\\)s?\\_>.*?[})]\\)" 441 '("[^$]\\(\\$[({]\\(?:output\\|stem\\|target\\)s?\\_>.*?[})]\\)"
424 1 'makefile-targets-face prepend) 442 1 'makefile-targets append)
425 443
426 ;; Colon modifier keywords. 444 ;; Colon modifier keywords.
427 '("\\(:\\s *\\)\\(build_c\\(?:ache\\|heck\\)\\|env\\(?:ironment\\)?\\|foreach\\|signature\\|scanner\\|quickscan\\|smartscan\\)\\>\\([^:\n]*\\)" 445 '("\\(:\\s *\\)\\(build_c\\(?:ache\\|heck\\)\\|env\\(?:ironment\\)?\\|foreach\\|signature\\|scanner\\|quickscan\\|smartscan\\)\\>\\([^:\n]*\\)"
@@ -436,32 +454,32 @@ not be enclosed in { } or ( )."
436 ;; $(shell ...) $((shell ...)) ${shell ...} ${{shell ...}} 454 ;; $(shell ...) $((shell ...)) ${shell ...} ${{shell ...}}
437 '("[^$]\\$\\(((?\\|{{?\\)shell\\(?:[-_]\\(?:global[-_]\\)?once\\)?[ \t]+" 455 '("[^$]\\$\\(((?\\|{{?\\)shell\\(?:[-_]\\(?:global[-_]\\)?once\\)?[ \t]+"
438 makefile-match-function-end nil nil 456 makefile-match-function-end nil nil
439 (1 'makefile-shell-face prepend t)) 457 (1 'makefile-shell prepend t))
440 458
441 ;; $(perl ...) $((perl ...)) ${perl ...} ${{perl ...}} 459 ;; $(perl ...) $((perl ...)) ${perl ...} ${{perl ...}}
442 '("[^$]\\$\\(((?\\|{{?\\)makeperl[ \t]+" 460 '("[^$]\\$\\(((?\\|{{?\\)makeperl[ \t]+"
443 makefile-match-function-end nil nil 461 makefile-match-function-end nil nil
444 (1 'makefile-makepp-perl-face prepend t)) 462 (1 'makefile-makepp-perl prepend t))
445 '("[^$]\\$\\(((?\\|{{?\\)perl[ \t]+" 463 '("[^$]\\$\\(((?\\|{{?\\)perl[ \t]+"
446 makefile-match-function-end nil nil 464 makefile-match-function-end nil nil
447 (1 'makefile-makepp-perl-face t t)) 465 (1 'makefile-makepp-perl t t))
448 466
449 ;; Can we unify these with (if (match-end 1) 'prepend t)? 467 ;; Can we unify these with (if (match-end 1) 'prepend t)?
450 '("ifmakeperl\\s +\\(.*\\)" 1 'makefile-makepp-perl-face prepend) 468 '("ifmakeperl\\s +\\(.*\\)" 1 'makefile-makepp-perl prepend)
451 '("ifperl\\s +\\(.*\\)" 1 'makefile-makepp-perl-face t) 469 '("ifperl\\s +\\(.*\\)" 1 'makefile-makepp-perl t)
452 470
453 ;; Perl block single- or multiline, as statement or rule action. 471 ;; Perl block single- or multiline, as statement or rule action.
454 ;; Don't know why the initial newline in 2nd variant of group 2 doesn't get skipped. 472 ;; Don't know why the initial newline in 2nd variant of group 2 doesn't get skipped.
455 '("\\<make\\(?:perl\\|sub\\s +\\S +\\)\\s *\n?\\s *{\\(?:{\\s *\n?\\(\\(?:.*\n\\)+?\\)\\s *}\\|\\s *\\(\\(?:.*?\\|\n?\\(?:.*\n\\)+?\\)\\)\\)}" 473 '("\\<make\\(?:perl\\|sub\\s +\\S +\\)\\s *\n?\\s *{\\(?:{\\s *\n?\\(\\(?:.*\n\\)+?\\)\\s *}\\|\\s *\\(\\(?:.*?\\|\n?\\(?:.*\n\\)+?\\)\\)\\)}"
456 (1 'makefile-makepp-perl-face prepend t) 474 (1 'makefile-makepp-perl prepend t)
457 (2 'makefile-makepp-perl-face prepend t)) 475 (2 'makefile-makepp-perl prepend t))
458 '("\\<\\(?:perl\\|sub\\s +\\S +\\)\\s *\n?\\s *{\\(?:{\\s *\n?\\(\\(?:.*\n\\)+?\\)\\s *}\\|\\s *\\(\\(?:.*?\\|\n?\\(?:.*\n\\)+?\\)\\)\\)}" 476 '("\\<\\(?:perl\\|sub\\s +\\S +\\)\\s *\n?\\s *{\\(?:{\\s *\n?\\(\\(?:.*\n\\)+?\\)\\s *}\\|\\s *\\(\\(?:.*?\\|\n?\\(?:.*\n\\)+?\\)\\)\\)}"
459 (1 'makefile-makepp-perl-face t t) 477 (1 'makefile-makepp-perl t t)
460 (2 'makefile-makepp-perl-face t t)) 478 (2 'makefile-makepp-perl t t))
461 479
462 ;; Statement style perl block. 480 ;; Statement style perl block.
463 '("perl[-_]begin\\s *\\(?:\\s #.*\\)?\n\\(\\(?:.*\n\\)+?\\)\\s *perl[-_]end\\>" 481 '("perl[-_]begin\\s *\\(?:\\s #.*\\)?\n\\(\\(?:.*\n\\)+?\\)\\s *perl[-_]end\\>"
464 1 'makefile-makepp-perl-face t))) 482 1 'makefile-makepp-perl t)))
465 483
466(defconst makefile-bsdmake-font-lock-keywords 484(defconst makefile-bsdmake-font-lock-keywords
467 (makefile-make-font-lock-keywords 485 (makefile-make-font-lock-keywords
@@ -849,10 +867,8 @@ Makefile mode can be configured by modifying the following variables:
849;;;###autoload 867;;;###autoload
850(define-derived-mode makefile-makepp-mode makefile-mode "Makeppfile" 868(define-derived-mode makefile-makepp-mode makefile-mode "Makeppfile"
851 "An adapted `makefile-mode' that knows about makepp." 869 "An adapted `makefile-mode' that knows about makepp."
852 (set (make-local-variable 'makefile-rule-action-regex) 870 (set (make-local-variable 'makefile-rule-action-regex)
853 ;; Don't care about initial tab, but I don't know how to font-lock correctly without. 871 makefile-makepp-rule-action-regex)
854 "^\t[ \t]*\\(\\(?:\\(?:noecho\\|ignore[-_]error\\|[-@]+\\)[ \t]*\\)*\\)\\(\\(&\\S +\\)?\\(?:.*\\\\\n\\)*.*\\)")
855
856 (setq font-lock-defaults 872 (setq font-lock-defaults
857 `(makefile-makepp-font-lock-keywords ,@(cdr font-lock-defaults)) 873 `(makefile-makepp-font-lock-keywords ,@(cdr font-lock-defaults))
858 imenu-generic-expression 874 imenu-generic-expression
@@ -863,11 +879,10 @@ Makefile mode can be configured by modifying the following variables:
863(define-derived-mode makefile-bsdmake-mode makefile-mode "BSDmakefile" 879(define-derived-mode makefile-bsdmake-mode makefile-mode "BSDmakefile"
864 "An adapted `makefile-mode' that knows about BSD make." 880 "An adapted `makefile-mode' that knows about BSD make."
865 (set (make-local-variable 'makefile-dependency-regex) 881 (set (make-local-variable 'makefile-dependency-regex)
866 ;; Identical to default, except allows `!' instead of `:'. 882 makefile-bsdmake-dependency-regex)
867 "^ *\\(\\(?: *\\$\\(?:[({]\\(?:\\$\\(?:[({]\\(?:\\$\\(?:[^({]\\|.[^\n$#})]+?[})]\\)\\|[^\n$#)}]\\)+?[})]\\|[^({]\\)\\|[^\n$#)}]\\)+?[})]\\|[^({]\\)\\| *[^ \n$#:=]+\\)+?\\)[ \t]*\\([:!]\\)\\(?:[ \t]*$\\|[^=\n]\\(?:[^#\n]*?;[ \t]*\\(.+\\)\\)?\\)")
868 (set (make-local-variable 'makefile-dependency-skip) "^:!") 883 (set (make-local-variable 'makefile-dependency-skip) "^:!")
869 (set (make-local-variable 'makefile-rule-action-regex) 884 (set (make-local-variable 'makefile-rule-action-regex)
870 "^\t[ \t]*\\([-+@]*\\)[ \t]*\\(\\(?:.*\\\\\n\\)*.*\\)") 885 makefile-bsdmake-rule-action-regex)
871 (setq font-lock-defaults 886 (setq font-lock-defaults
872 `(makefile-bsdmake-font-lock-keywords ,@(cdr font-lock-defaults)))) 887 `(makefile-bsdmake-font-lock-keywords ,@(cdr font-lock-defaults))))
873 888
@@ -897,6 +912,8 @@ Makefile mode can be configured by modifying the following variables:
897 (backward-char)) 912 (backward-char))
898 (get-text-property (point) 'face) 913 (get-text-property (point) 'face)
899 (beginning-of-line) 914 (beginning-of-line)
915 (if (> (point) (+ (point-min) 2))
916 (eq (char-before (1- (point))) ?\\))
900 (if (looking-at makefile-dependency-regex) 917 (if (looking-at makefile-dependency-regex)
901 (throw 'found t)))) 918 (throw 'found t))))
902 (goto-char pt) 919 (goto-char pt)
@@ -1686,9 +1703,24 @@ matched in a rule action."
1686 (forward-char) 1703 (forward-char)
1687 (or (eq (char-after) ?=) 1704 (or (eq (char-after) ?=)
1688 (get-text-property (1- (point)) 'face) 1705 (get-text-property (1- (point)) 'face)
1706 (if (> (line-beginning-position) (+ (point-min) 2))
1707 (eq (char-before (line-end-position 0)) ?\\))
1689 (when (save-excursion 1708 (when (save-excursion
1690 (beginning-of-line) 1709 (beginning-of-line)
1691 (looking-at makefile-dependency-regex)) 1710 (looking-at makefile-dependency-regex))
1711 (save-excursion
1712 (let ((deps-end (match-end 1))
1713 (match-data (match-data)))
1714 (goto-char deps-end)
1715 (skip-chars-backward " \t")
1716 (setq deps-end (point))
1717 (beginning-of-line)
1718 (skip-chars-forward " \t")
1719 ;; Alter the bounds recorded for subexp 1,
1720 ;; which is what is supposed to match the targets.
1721 (setcar (nthcdr 2 match-data) (point))
1722 (setcar (nthcdr 3 match-data) deps-end)
1723 (store-match-data match-data)))
1692 (end-of-line) 1724 (end-of-line)
1693 (throw 'found (point))))) 1725 (throw 'found (point)))))
1694 (goto-char pt)) 1726 (goto-char pt))
diff --git a/lisp/progmodes/octave-inf.el b/lisp/progmodes/octave-inf.el
index 250d00171f2..a45976eef32 100644
--- a/lisp/progmodes/octave-inf.el
+++ b/lisp/progmodes/octave-inf.el
@@ -129,7 +129,7 @@ buffer.
129Entry to this mode successively runs the hooks `comint-mode-hook' and 129Entry to this mode successively runs the hooks `comint-mode-hook' and
130`inferior-octave-mode-hook'." 130`inferior-octave-mode-hook'."
131 (interactive) 131 (interactive)
132 (comint-mode) 132 (delay-mode-hooks (comint-mode))
133 (setq comint-prompt-regexp inferior-octave-prompt 133 (setq comint-prompt-regexp inferior-octave-prompt
134 major-mode 'inferior-octave-mode 134 major-mode 'inferior-octave-mode
135 mode-name "Inferior Octave" 135 mode-name "Inferior Octave"
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index 604ff8c1e78..23d8374818e 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -792,7 +792,7 @@ See `sh-feature'.")
792 792
793;; Font-Lock support 793;; Font-Lock support
794 794
795(defface sh-heredoc-face 795(defface sh-heredoc
796 '((((min-colors 88) (class color) 796 '((((min-colors 88) (class color)
797 (background dark)) 797 (background dark))
798 (:foreground "yellow1" :weight bold)) 798 (:foreground "yellow1" :weight bold))
@@ -806,7 +806,9 @@ See `sh-feature'.")
806 (:weight bold))) 806 (:weight bold)))
807 "Face to show a here-document" 807 "Face to show a here-document"
808 :group 'sh-indentation) 808 :group 'sh-indentation)
809(defvar sh-heredoc-face 'sh-heredoc-face) 809;; backward-compatibility alias
810(put 'sh-heredoc-face 'face-alias 'sh-heredoc)
811(defvar sh-heredoc-face 'sh-heredoc)
810 812
811(defface sh-escaped-newline '((t :inherit font-lock-string-face)) 813(defface sh-escaped-newline '((t :inherit font-lock-string-face))
812 "Face used for (non-escaped) backslash at end of a line in Shell-script mode." 814 "Face used for (non-escaped) backslash at end of a line in Shell-script mode."
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index add4493e5f8..9b819ceae00 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -2328,7 +2328,7 @@ you entered, right above the output it created.
2328 2328
2329\(setq comint-output-filter-functions 2329\(setq comint-output-filter-functions
2330 \(function (lambda (STR) (comint-show-output))))" 2330 \(function (lambda (STR) (comint-show-output))))"
2331 (comint-mode) 2331 (delay-mode-hooks (comint-mode))
2332 ;; Get the `sql-product' for this interactive session. 2332 ;; Get the `sql-product' for this interactive session.
2333 (set (make-local-variable 'sql-product) 2333 (set (make-local-variable 'sql-product)
2334 (or sql-interactive-product 2334 (or sql-interactive-product
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index ebccb1bf5bf..9885e9ae039 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -1379,11 +1379,11 @@ Option `vhdl-align-groups' still applies within these blocks."
1379(defcustom vhdl-highlight-keywords t 1379(defcustom vhdl-highlight-keywords t
1380 "*Non-nil means highlight VHDL keywords and other standardized words. 1380 "*Non-nil means highlight VHDL keywords and other standardized words.
1381The following faces are used: 1381The following faces are used:
1382 `font-lock-keyword-face' : keywords 1382 `font-lock-keyword-face' : keywords
1383 `font-lock-type-face' : standardized types 1383 `font-lock-type' : standardized types
1384 `vhdl-font-lock-attribute-face': standardized attributes 1384 `vhdl-attribute' : standardized attributes
1385 `vhdl-font-lock-enumvalue-face': standardized enumeration values 1385 `vhdl-enumvalue' : standardized enumeration values
1386 `vhdl-font-lock-function-face' : standardized function and package names 1386 `vhdl-function' : standardized function and package names
1387 1387
1388NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu 1388NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1389 entry \"Fontify Buffer\")." 1389 entry \"Fontify Buffer\")."
@@ -1398,7 +1398,7 @@ The following faces are used:
1398 `font-lock-function-name-face' : names in declarations of units, 1398 `font-lock-function-name-face' : names in declarations of units,
1399 subprograms, components, as well as labels of VHDL constructs 1399 subprograms, components, as well as labels of VHDL constructs
1400 `font-lock-type-face' : names in type/nature declarations 1400 `font-lock-type-face' : names in type/nature declarations
1401 `vhdl-font-lock-attribute-face': names in attribute declarations 1401 `vhdl-attribute' : names in attribute declarations
1402 `font-lock-variable-name-face' : names in declarations of signals, 1402 `font-lock-variable-name-face' : names in declarations of signals,
1403 variables, constants, subprogram parameters, generics, and ports 1403 variables, constants, subprogram parameters, generics, and ports
1404 1404
@@ -1426,7 +1426,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1426 "*Non-nil means highlight forbidden words. 1426 "*Non-nil means highlight forbidden words.
1427The reserved words specified in option `vhdl-forbidden-words' or having the 1427The reserved words specified in option `vhdl-forbidden-words' or having the
1428syntax specified in option `vhdl-forbidden-syntax' are highlighted in a 1428syntax specified in option `vhdl-forbidden-syntax' are highlighted in a
1429warning color (face `vhdl-font-lock-reserved-words-face') to indicate not to 1429warning color (face `vhdl-reserved-word') to indicate not to
1430use them. 1430use them.
1431 1431
1432NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu 1432NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
@@ -1440,7 +1440,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1440(defcustom vhdl-highlight-verilog-keywords nil 1440(defcustom vhdl-highlight-verilog-keywords nil
1441 "*Non-nil means highlight Verilog keywords as reserved words. 1441 "*Non-nil means highlight Verilog keywords as reserved words.
1442Verilog keywords are highlighted in a warning color (face 1442Verilog keywords are highlighted in a warning color (face
1443`vhdl-font-lock-reserved-words-face') to indicate not to use them. 1443`vhdl-reserved-word') to indicate not to use them.
1444 1444
1445NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu 1445NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1446 entry \"Fontify Buffer\")." 1446 entry \"Fontify Buffer\")."
@@ -1454,7 +1454,7 @@ NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1454 "*Non-nil means background-highlight code excluded from translation. 1454 "*Non-nil means background-highlight code excluded from translation.
1455That is, all code between \"-- pragma translate_off\" and 1455That is, all code between \"-- pragma translate_off\" and
1456\"-- pragma translate_on\" is highlighted using a different background color 1456\"-- pragma translate_on\" is highlighted using a different background color
1457\(face `vhdl-font-lock-translate-off-face'). 1457\(face `vhdl-translate-off').
1458Note: this might slow down on-the-fly fontification (and thus editing). 1458Note: this might slow down on-the-fly fontification (and thus editing).
1459 1459
1460NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu 1460NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
@@ -1501,7 +1501,7 @@ different kinds of signals (e.g. \"Clk50\", \"Rst_n\") or objects (e.g.
1501\"Signal_s\", \"Variable_v\", \"Constant_c\") by distinguishing them using 1501\"Signal_s\", \"Variable_v\", \"Constant_c\") by distinguishing them using
1502common substrings or name suffices. 1502common substrings or name suffices.
1503For each entry, a new face is generated with the specified colors and name 1503For each entry, a new face is generated with the specified colors and name
1504\"vhdl-font-lock-\" + name + \"-face\". 1504\"vhdl-\" + name.
1505 1505
1506NOTE: Activate a changed regexp in a VHDL buffer by re-fontifying it (menu 1506NOTE: Activate a changed regexp in a VHDL buffer by re-fontifying it (menu
1507 entry \"Fontify Buffer\"). All other changes require restarting Emacs." 1507 entry \"Fontify Buffer\"). All other changes require restarting Emacs."
@@ -12484,7 +12484,7 @@ This does highlighting of keywords and standard identifiers.")
12484 (list 12484 (list
12485 (concat 12485 (concat
12486 "^\\s-*attribute\\s-+\\(\\w+\\)") 12486 "^\\s-*attribute\\s-+\\(\\w+\\)")
12487 1 'vhdl-font-lock-attribute-face) 12487 1 'vhdl-attribute)
12488 12488
12489 ;; highlight type/nature name in (sub)type/(sub)nature declarations 12489 ;; highlight type/nature name in (sub)type/(sub)nature declarations
12490 (list 12490 (list
@@ -12542,40 +12542,39 @@ This does highlighting of additional reserved words.")
12542 12542
12543(defconst vhdl-font-lock-keywords-5 12543(defconst vhdl-font-lock-keywords-5
12544 ;; background highlight translate-off regions 12544 ;; background highlight translate-off regions
12545 '((vhdl-match-translate-off (0 vhdl-font-lock-translate-off-face append))) 12545 '((vhdl-match-translate-off (0 vhdl-translate-off-face append)))
12546 "For consideration as a value of `vhdl-font-lock-keywords'. 12546 "For consideration as a value of `vhdl-font-lock-keywords'.
12547This does background highlighting of translate-off regions.") 12547This does background highlighting of translate-off regions.")
12548 12548
12549;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12549;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12550;; Font and color definitions 12550;; Font and color definitions
12551 12551
12552(defvar vhdl-font-lock-prompt-face 'vhdl-font-lock-prompt-face 12552(defvar vhdl-prompt-face 'vhdl-prompt
12553 "Face name to use for prompts.") 12553 "Face name to use for prompts.")
12554 12554
12555(defvar vhdl-font-lock-attribute-face 'vhdl-font-lock-attribute-face 12555(defvar vhdl-attribute-face 'vhdl-attribute
12556 "Face name to use for standardized attributes.") 12556 "Face name to use for standardized attributes.")
12557 12557
12558(defvar vhdl-font-lock-enumvalue-face 'vhdl-font-lock-enumvalue-face 12558(defvar vhdl-enumvalue-face 'vhdl-enumvalue
12559 "Face name to use for standardized enumeration values.") 12559 "Face name to use for standardized enumeration values.")
12560 12560
12561(defvar vhdl-font-lock-function-face 'vhdl-font-lock-function-face 12561(defvar vhdl-function-face 'vhdl-function
12562 "Face name to use for standardized functions and packages.") 12562 "Face name to use for standardized functions and packages.")
12563 12563
12564(defvar vhdl-font-lock-directive-face 'vhdl-font-lock-directive-face 12564(defvar vhdl-directive-face 'vhdl-directive
12565 "Face name to use for directives.") 12565 "Face name to use for directives.")
12566 12566
12567(defvar vhdl-font-lock-reserved-words-face 'vhdl-font-lock-reserved-words-face 12567(defvar vhdl-reserved-words-face 'vhdl-reserved-words
12568 "Face name to use for additional reserved words.") 12568 "Face name to use for additional reserved words.")
12569 12569
12570(defvar vhdl-font-lock-translate-off-face 'vhdl-font-lock-translate-off-face 12570(defvar vhdl-translate-off-face 'vhdl-translate-off
12571 "Face name to use for translate-off regions.") 12571 "Face name to use for translate-off regions.")
12572 12572
12573;; face names to use for words with special syntax. 12573;; face names to use for words with special syntax.
12574(let ((syntax-alist vhdl-special-syntax-alist) 12574(let ((syntax-alist vhdl-special-syntax-alist)
12575 name) 12575 name)
12576 (while syntax-alist 12576 (while syntax-alist
12577 (setq name (vhdl-function-name 12577 (setq name (vhdl-function-name "vhdl" (nth 0 (car syntax-alist))))
12578 "vhdl-font-lock" (nth 0 (car syntax-alist)) "face"))
12579 (eval `(defvar ,name ',name 12578 (eval `(defvar ,name ',name
12580 ,(concat "Face name to use for " 12579 ,(concat "Face name to use for "
12581 (nth 0 (car syntax-alist)) "."))) 12580 (nth 0 (car syntax-alist)) ".")))
@@ -12599,8 +12598,8 @@ This does background highlighting of translate-off regions.")
12599(custom-add-to-group 12598(custom-add-to-group
12600 'vhdl-highlight-faces 'font-lock-variable-name-face 'custom-face) 12599 'vhdl-highlight-faces 'font-lock-variable-name-face 'custom-face)
12601 12600
12602(defface vhdl-font-lock-prompt-face 12601(defface vhdl-prompt
12603 '((((min-colors 88) (class color) (background light)) 12602 '((((min-colors 88) (class color) (background light))
12604 (:foreground "Red1" :bold t)) 12603 (:foreground "Red1" :bold t))
12605 (((class color) (background light)) (:foreground "Red" :bold t)) 12604 (((class color) (background light)) (:foreground "Red" :bold t))
12606 (((class color) (background dark)) (:foreground "Pink" :bold t)) 12605 (((class color) (background dark)) (:foreground "Pink" :bold t))
@@ -12608,62 +12607,75 @@ This does background highlighting of translate-off regions.")
12608 "Font lock mode face used to highlight prompts." 12607 "Font lock mode face used to highlight prompts."
12609 :group 'vhdl-highlight-faces 12608 :group 'vhdl-highlight-faces
12610 :group 'font-lock-highlighting-faces) 12609 :group 'font-lock-highlighting-faces)
12610;; backward-compatibility alias
12611(put 'vhdl-font-lock-prompt-face 'face-alias 'vhdl-prompt)
12611 12612
12612(defface vhdl-font-lock-attribute-face 12613(defface vhdl-attribute
12613 '((((class color) (background light)) (:foreground "Orchid")) 12614 '((((class color) (background light)) (:foreground "Orchid"))
12614 (((class color) (background dark)) (:foreground "LightSteelBlue")) 12615 (((class color) (background dark)) (:foreground "LightSteelBlue"))
12615 (t (:italic t :bold t))) 12616 (t (:italic t :bold t)))
12616 "Font lock mode face used to highlight standardized attributes." 12617 "Font lock mode face used to highlight standardized attributes."
12617 :group 'vhdl-highlight-faces 12618 :group 'vhdl-highlight-faces
12618 :group 'font-lock-highlighting-faces) 12619 :group 'font-lock-highlighting-faces)
12620;; backward-compatibility alias
12621(put 'vhdl-font-lock-attribute-face 'face-alias 'vhdl-attribute)
12619 12622
12620(defface vhdl-font-lock-enumvalue-face 12623(defface vhdl-enumvalue
12621 '((((class color) (background light)) (:foreground "SaddleBrown")) 12624 '((((class color) (background light)) (:foreground "SaddleBrown"))
12622 (((class color) (background dark)) (:foreground "BurlyWood")) 12625 (((class color) (background dark)) (:foreground "BurlyWood"))
12623 (t (:italic t :bold t))) 12626 (t (:italic t :bold t)))
12624 "Font lock mode face used to highlight standardized enumeration values." 12627 "Font lock mode face used to highlight standardized enumeration values."
12625 :group 'vhdl-highlight-faces 12628 :group 'vhdl-highlight-faces
12626 :group 'font-lock-highlighting-faces) 12629 :group 'font-lock-highlighting-faces)
12630;; backward-compatibility alias
12631(put 'vhdl-font-lock-enumvalue-face 'face-alias 'vhdl-enumvalue)
12627 12632
12628(defface vhdl-font-lock-function-face 12633(defface vhdl-function
12629 '((((class color) (background light)) (:foreground "Cyan4")) 12634 '((((class color) (background light)) (:foreground "Cyan4"))
12630 (((class color) (background dark)) (:foreground "Orchid1")) 12635 (((class color) (background dark)) (:foreground "Orchid1"))
12631 (t (:italic t :bold t))) 12636 (t (:italic t :bold t)))
12632 "Font lock mode face used to highlight standardized functions and packages." 12637 "Font lock mode face used to highlight standardized functions and packages."
12633 :group 'vhdl-highlight-faces 12638 :group 'vhdl-highlight-faces
12634 :group 'font-lock-highlighting-faces) 12639 :group 'font-lock-highlighting-faces)
12640;; backward-compatibility alias
12641(put 'vhdl-font-lock-function-face 'face-alias 'vhdl-function)
12635 12642
12636(defface vhdl-font-lock-directive-face 12643(defface vhdl-directive
12637 '((((class color) (background light)) (:foreground "CadetBlue")) 12644 '((((class color) (background light)) (:foreground "CadetBlue"))
12638 (((class color) (background dark)) (:foreground "Aquamarine")) 12645 (((class color) (background dark)) (:foreground "Aquamarine"))
12639 (t (:italic t :bold t))) 12646 (t (:italic t :bold t)))
12640 "Font lock mode face used to highlight directives." 12647 "Font lock mode face used to highlight directives."
12641 :group 'vhdl-highlight-faces 12648 :group 'vhdl-highlight-faces
12642 :group 'font-lock-highlighting-faces) 12649 :group 'font-lock-highlighting-faces)
12650;; backward-compatibility alias
12651(put 'vhdl-font-lock-directive-face 'face-alias 'vhdl-directive)
12643 12652
12644(defface vhdl-font-lock-reserved-words-face 12653(defface vhdl-reserved-word
12645 '((((class color) (background light)) (:foreground "Orange" :bold t)) 12654 '((((class color) (background light)) (:foreground "Orange" :bold t))
12646 (((min-colors 88) (class color) (background dark)) 12655 (((min-colors 88) (class color) (background dark))
12647 (:foreground "Yellow1" :bold t)) 12656 (:foreground "Yellow1" :bold t))
12648 (((class color) (background dark)) (:foreground "Yellow" :bold t)) 12657 (((class color) (background dark)) (:foreground "Yellow" :bold t))
12649 (t ())) 12658 (t ()))
12650 "Font lock mode face used to highlight additional reserved words." 12659 "Font lock mode face used to highlight additional reserved words."
12651 :group 'vhdl-highlight-faces 12660 :group 'vhdl-highlight-faces
12652 :group 'font-lock-highlighting-faces) 12661 :group 'font-lock-highlighting-faces)
12662;; backward-compatibility alias
12663(put 'vhdl-font-lock-reserved-words-face 'face-alias 'vhdl-reserved-word)
12653 12664
12654(defface vhdl-font-lock-translate-off-face 12665(defface vhdl-translate-off
12655 '((((class color) (background light)) (:background "LightGray")) 12666 '((((class color) (background light)) (:background "LightGray"))
12656 (((class color) (background dark)) (:background "DimGray")) 12667 (((class color) (background dark)) (:background "DimGray"))
12657 (t ())) 12668 (t ()))
12658 "Font lock mode face used to background highlight translate-off regions." 12669 "Font lock mode face used to background highlight translate-off regions."
12659 :group 'vhdl-highlight-faces 12670 :group 'vhdl-highlight-faces
12660 :group 'font-lock-highlighting-faces) 12671 :group 'font-lock-highlighting-faces)
12672;; backward-compatibility alias
12673(put 'vhdl-font-lock-translate-off-face 'face-alias 'vhdl-translate-off)
12661 12674
12662;; font lock mode faces used to highlight words with special syntax. 12675;; font lock mode faces used to highlight words with special syntax.
12663(let ((syntax-alist vhdl-special-syntax-alist)) 12676(let ((syntax-alist vhdl-special-syntax-alist))
12664 (while syntax-alist 12677 (while syntax-alist
12665 (eval `(defface ,(vhdl-function-name 12678 (eval `(defface ,(vhdl-function-name "vhdl" (caar syntax-alist))
12666 "vhdl-font-lock" (caar syntax-alist) "face")
12667 '((((class color) (background light)) 12679 '((((class color) (background light))
12668 (:foreground ,(nth 2 (car syntax-alist)))) 12680 (:foreground ,(nth 2 (car syntax-alist))))
12669 (((class color) (background dark)) 12681 (((class color) (background dark))
@@ -12684,20 +12696,19 @@ This does background highlighting of translate-off regions.")
12684 (setq vhdl-font-lock-keywords-0 12696 (setq vhdl-font-lock-keywords-0
12685 (list (list (concat "\\(^\\|[ \t(.']\\)\\(<" 12697 (list (list (concat "\\(^\\|[ \t(.']\\)\\(<"
12686 vhdl-template-prompt-syntax ">\\)") 12698 vhdl-template-prompt-syntax ">\\)")
12687 2 'vhdl-font-lock-prompt-face t) 12699 2 'vhdl-prompt t)
12688 (list (concat "--\\s-*" 12700 (list (concat "--\\s-*"
12689 vhdl-directive-keywords-regexp "\\s-+\\(.*\\)$") 12701 vhdl-directive-keywords-regexp "\\s-+\\(.*\\)$")
12690 2 'vhdl-font-lock-directive-face t))) 12702 2 'vhdl-directive t)))
12691 ;; highlight keywords and standardized types, attributes, enumeration 12703 ;; highlight keywords and standardized types, attributes, enumeration
12692 ;; values, and subprograms 12704 ;; values, and subprograms
12693 (setq vhdl-font-lock-keywords-1 12705 (setq vhdl-font-lock-keywords-1
12694 (list 12706 (list
12695 (list (concat "'" vhdl-attributes-regexp) 12707 (list (concat "'" vhdl-attributes-regexp) 1 'vhdl-attribute)
12696 1 'vhdl-font-lock-attribute-face)
12697 (list vhdl-types-regexp 1 'font-lock-type-face) 12708 (list vhdl-types-regexp 1 'font-lock-type-face)
12698 (list vhdl-functions-regexp 1 'vhdl-font-lock-function-face) 12709 (list vhdl-functions-regexp 1 'vhdl-function)
12699 (list vhdl-packages-regexp 1 'vhdl-font-lock-function-face) 12710 (list vhdl-packages-regexp 1 'vhdl-function)
12700 (list vhdl-enum-values-regexp 1 'vhdl-font-lock-enumvalue-face) 12711 (list vhdl-enum-values-regexp 1 'vhdl-enumvalue)
12701 (list vhdl-keywords-regexp 1 'font-lock-keyword-face))) 12712 (list vhdl-keywords-regexp 1 'font-lock-keyword-face)))
12702 ;; highlight words with special syntax. 12713 ;; highlight words with special syntax.
12703 (setq vhdl-font-lock-keywords-3 12714 (setq vhdl-font-lock-keywords-3
@@ -12708,14 +12719,13 @@ This does background highlighting of translate-off regions.")
12708 (cons 12719 (cons
12709 (cons (concat "\\<\\(" (nth 1 (car syntax-alist)) "\\)\\>") 12720 (cons (concat "\\<\\(" (nth 1 (car syntax-alist)) "\\)\\>")
12710 (vhdl-function-name 12721 (vhdl-function-name
12711 "vhdl-font-lock" (nth 0 (car syntax-alist)) "face")) 12722 "vhdl" (nth 0 (car syntax-alist))))
12712 keywords)) 12723 keywords))
12713 (setq syntax-alist (cdr syntax-alist))) 12724 (setq syntax-alist (cdr syntax-alist)))
12714 keywords)) 12725 keywords))
12715 ;; highlight additional reserved words 12726 ;; highlight additional reserved words
12716 (setq vhdl-font-lock-keywords-4 12727 (setq vhdl-font-lock-keywords-4
12717 (list (list vhdl-reserved-words-regexp 1 12728 (list (list vhdl-reserved-words-regexp 1 'vhdl-reserved-word)))
12718 'vhdl-font-lock-reserved-words-face)))
12719 ;; highlight everything together 12729 ;; highlight everything together
12720 (setq vhdl-font-lock-keywords 12730 (setq vhdl-font-lock-keywords
12721 (append 12731 (append
@@ -12753,18 +12763,12 @@ This does background highlighting of translate-off regions.")
12753 (unless (or (not vhdl-print-customize-faces) 12763 (unless (or (not vhdl-print-customize-faces)
12754 ps-print-color-p) 12764 ps-print-color-p)
12755 (set (make-local-variable 'ps-bold-faces) 12765 (set (make-local-variable 'ps-bold-faces)
12756 '(font-lock-keyword-face 12766 '(font-lock-keyword-face font-lock-type-face
12757 font-lock-type-face 12767 vhdl-attribute vhdl-enumvalue vhdl-directive))
12758 vhdl-font-lock-attribute-face
12759 vhdl-font-lock-enumvalue-face
12760 vhdl-font-lock-directive-face))
12761 (set (make-local-variable 'ps-italic-faces) 12768 (set (make-local-variable 'ps-italic-faces)
12762 '(font-lock-comment-face 12769 '(font-lock-comment-face
12763 font-lock-function-name-face 12770 font-lock-function-name-face font-lock-type-face
12764 font-lock-type-face 12771 vhdl-attribute vhdl-enumvalue vhdl-directive))
12765 vhdl-font-lock-attribute-face
12766 vhdl-font-lock-enumvalue-face
12767 vhdl-font-lock-directive-face))
12768 (set (make-local-variable 'ps-underlined-faces) 12772 (set (make-local-variable 'ps-underlined-faces)
12769 '(font-lock-string-face)) 12773 '(font-lock-string-face))
12770 (setq ps-always-build-face-reference t)) 12774 (setq ps-always-build-face-reference t))
@@ -13973,7 +13977,7 @@ otherwise use cached data."
13973 'bracket ?+ 'vhdl-speedbar-expand-entity (nth 0 ent-entry) 13977 'bracket ?+ 'vhdl-speedbar-expand-entity (nth 0 ent-entry)
13974 (nth 1 ent-entry) 'vhdl-speedbar-find-file 13978 (nth 1 ent-entry) 'vhdl-speedbar-find-file
13975 (cons (nth 2 ent-entry) (nth 3 ent-entry)) 13979 (cons (nth 2 ent-entry) (nth 3 ent-entry))
13976 'vhdl-speedbar-entity-face depth) 13980 'vhdl-speedbar-entity depth)
13977 (unless (nth 2 ent-entry) 13981 (unless (nth 2 ent-entry)
13978 (end-of-line 0) (insert "!") (forward-char 1)) 13982 (end-of-line 0) (insert "!") (forward-char 1))
13979 (unless (member (nth 0 ent-entry) ent-inst-list) 13983 (unless (member (nth 0 ent-entry) ent-inst-list)
@@ -13987,7 +13991,7 @@ otherwise use cached data."
13987 'bracket ?+ 'vhdl-speedbar-expand-config (nth 0 conf-entry) 13991 'bracket ?+ 'vhdl-speedbar-expand-config (nth 0 conf-entry)
13988 (nth 1 conf-entry) 'vhdl-speedbar-find-file 13992 (nth 1 conf-entry) 'vhdl-speedbar-find-file
13989 (cons (nth 2 conf-entry) (nth 3 conf-entry)) 13993 (cons (nth 2 conf-entry) (nth 3 conf-entry))
13990 'vhdl-speedbar-configuration-face depth) 13994 'vhdl-speedbar-configuration depth)
13991 (setq conf-alist (cdr conf-alist))) 13995 (setq conf-alist (cdr conf-alist)))
13992 ;; insert packages 13996 ;; insert packages
13993 (when pack-alist (vhdl-speedbar-make-title-line "Packages:" depth)) 13997 (when pack-alist (vhdl-speedbar-make-title-line "Packages:" depth))
@@ -14178,7 +14182,7 @@ otherwise use cached data."
14178 (cons token (nth 0 arch-entry)) 14182 (cons token (nth 0 arch-entry))
14179 (nth 1 arch-entry) 'vhdl-speedbar-find-file 14183 (nth 1 arch-entry) 'vhdl-speedbar-find-file
14180 (cons (nth 2 arch-entry) (nth 3 arch-entry)) 14184 (cons (nth 2 arch-entry) (nth 3 arch-entry))
14181 'vhdl-speedbar-architecture-face (1+ indent)) 14185 'vhdl-speedbar-architecture (1+ indent))
14182 (setq arch-alist (cdr arch-alist))) 14186 (setq arch-alist (cdr arch-alist)))
14183 ;; insert instantiations 14187 ;; insert instantiations
14184 (when inst-alist 14188 (when inst-alist
@@ -14361,7 +14365,7 @@ otherwise use cached data."
14361 (cons token (nth 0 comp-entry)) 14365 (cons token (nth 0 comp-entry))
14362 (nth 1 comp-entry) 'vhdl-speedbar-find-file 14366 (nth 1 comp-entry) 'vhdl-speedbar-find-file
14363 (cons (nth 2 comp-entry) (nth 3 comp-entry)) 14367 (cons (nth 2 comp-entry) (nth 3 comp-entry))
14364 'vhdl-speedbar-entity-face (1+ indent)) 14368 'vhdl-speedbar-entity (1+ indent))
14365 (setq comp-alist (cdr comp-alist))) 14369 (setq comp-alist (cdr comp-alist)))
14366 ;; insert subprograms 14370 ;; insert subprograms
14367 (when func-alist 14371 (when func-alist
@@ -14477,43 +14481,43 @@ NO-POSITION non-nil means do not re-position cursor."
14477 (let* ((file-entry (aget file-alist speedbar-last-selected-file t))) 14481 (let* ((file-entry (aget file-alist speedbar-last-selected-file t)))
14478 (vhdl-speedbar-update-units 14482 (vhdl-speedbar-update-units
14479 "\\[.\\] " (nth 0 file-entry) 14483 "\\[.\\] " (nth 0 file-entry)
14480 speedbar-last-selected-file 'vhdl-speedbar-entity-face) 14484 speedbar-last-selected-file 'vhdl-speedbar-entity)
14481 (vhdl-speedbar-update-units 14485 (vhdl-speedbar-update-units
14482 "{.} " (nth 1 file-entry) 14486 "{.} " (nth 1 file-entry)
14483 speedbar-last-selected-file 'vhdl-speedbar-architecture-face) 14487 speedbar-last-selected-file 'vhdl-speedbar-architecture)
14484 (vhdl-speedbar-update-units 14488 (vhdl-speedbar-update-units
14485 "\\[.\\] " (nth 3 file-entry) 14489 "\\[.\\] " (nth 3 file-entry)
14486 speedbar-last-selected-file 'vhdl-speedbar-configuration-face) 14490 speedbar-last-selected-file 'vhdl-speedbar-configuration)
14487 (vhdl-speedbar-update-units 14491 (vhdl-speedbar-update-units
14488 "[]>] " (nth 4 file-entry) 14492 "[]>] " (nth 4 file-entry)
14489 speedbar-last-selected-file 'vhdl-speedbar-package-face) 14493 speedbar-last-selected-file 'vhdl-speedbar-package)
14490 (vhdl-speedbar-update-units 14494 (vhdl-speedbar-update-units
14491 "\\[.\\].+(" '("body") 14495 "\\[.\\].+(" '("body")
14492 speedbar-last-selected-file 'vhdl-speedbar-package-face) 14496 speedbar-last-selected-file 'vhdl-speedbar-package)
14493 (vhdl-speedbar-update-units 14497 (vhdl-speedbar-update-units
14494 "> " (nth 6 file-entry) 14498 "> " (nth 6 file-entry)
14495 speedbar-last-selected-file 'vhdl-speedbar-instantiation-face)) 14499 speedbar-last-selected-file 'vhdl-speedbar-instantiation))
14496 ;; highlight current units 14500 ;; highlight current units
14497 (let* ((file-entry (aget file-alist file-name t))) 14501 (let* ((file-entry (aget file-alist file-name t)))
14498 (setq 14502 (setq
14499 pos (vhdl-speedbar-update-units 14503 pos (vhdl-speedbar-update-units
14500 "\\[.\\] " (nth 0 file-entry) 14504 "\\[.\\] " (nth 0 file-entry)
14501 file-name 'vhdl-speedbar-entity-selected-face pos) 14505 file-name 'vhdl-speedbar-entity-selected pos)
14502 pos (vhdl-speedbar-update-units 14506 pos (vhdl-speedbar-update-units
14503 "{.} " (nth 1 file-entry) 14507 "{.} " (nth 1 file-entry)
14504 file-name 'vhdl-speedbar-architecture-selected-face pos) 14508 file-name 'vhdl-speedbar-architecture-selected pos)
14505 pos (vhdl-speedbar-update-units 14509 pos (vhdl-speedbar-update-units
14506 "\\[.\\] " (nth 3 file-entry) 14510 "\\[.\\] " (nth 3 file-entry)
14507 file-name 'vhdl-speedbar-configuration-selected-face pos) 14511 file-name 'vhdl-speedbar-configuration-selected pos)
14508 pos (vhdl-speedbar-update-units 14512 pos (vhdl-speedbar-update-units
14509 "[]>] " (nth 4 file-entry) 14513 "[]>] " (nth 4 file-entry)
14510 file-name 'vhdl-speedbar-package-selected-face pos) 14514 file-name 'vhdl-speedbar-package-selected pos)
14511 pos (vhdl-speedbar-update-units 14515 pos (vhdl-speedbar-update-units
14512 "\\[.\\].+(" '("body") 14516 "\\[.\\].+(" '("body")
14513 file-name 'vhdl-speedbar-package-selected-face pos) 14517 file-name 'vhdl-speedbar-package-selected pos)
14514 pos (vhdl-speedbar-update-units 14518 pos (vhdl-speedbar-update-units
14515 "> " (nth 6 file-entry) 14519 "> " (nth 6 file-entry)
14516 file-name 'vhdl-speedbar-instantiation-selected-face pos)))))) 14520 file-name 'vhdl-speedbar-instantiation-selected pos))))))
14517 ;; move speedbar so the first highlighted unit is visible 14521 ;; move speedbar so the first highlighted unit is visible
14518 (when (and pos (not no-position)) 14522 (when (and pos (not no-position))
14519 (goto-char pos) 14523 (goto-char pos)
@@ -14564,21 +14568,21 @@ NO-POSITION non-nil means do not re-position cursor."
14564 (insert "(top)") 14568 (insert "(top)")
14565 (insert inst-name) 14569 (insert inst-name)
14566 (speedbar-make-button 14570 (speedbar-make-button
14567 start (point) 'vhdl-speedbar-instantiation-face 'speedbar-highlight-face 14571 start (point) 'vhdl-speedbar-instantiation 'speedbar-highlight-face
14568 'vhdl-speedbar-find-file inst-file-marker)) 14572 'vhdl-speedbar-find-file inst-file-marker))
14569 (insert delimiter) 14573 (insert delimiter)
14570 (when ent-name 14574 (when ent-name
14571 (setq start (point)) 14575 (setq start (point))
14572 (insert ent-name) 14576 (insert ent-name)
14573 (speedbar-make-button 14577 (speedbar-make-button
14574 start (point) 'vhdl-speedbar-entity-face 'speedbar-highlight-face 14578 start (point) 'vhdl-speedbar-entity 'speedbar-highlight-face
14575 'vhdl-speedbar-find-file ent-file-marker) 14579 'vhdl-speedbar-find-file ent-file-marker)
14576 (when arch-name 14580 (when arch-name
14577 (insert " (") 14581 (insert " (")
14578 (setq start (point)) 14582 (setq start (point))
14579 (insert arch-name) 14583 (insert arch-name)
14580 (speedbar-make-button 14584 (speedbar-make-button
14581 start (point) 'vhdl-speedbar-architecture-face 'speedbar-highlight-face 14585 start (point) 'vhdl-speedbar-architecture 'speedbar-highlight-face
14582 'vhdl-speedbar-find-file arch-file-marker) 14586 'vhdl-speedbar-find-file arch-file-marker)
14583 (insert ")")) 14587 (insert ")"))
14584 (when conf-name 14588 (when conf-name
@@ -14586,14 +14590,14 @@ NO-POSITION non-nil means do not re-position cursor."
14586 (setq start (point)) 14590 (setq start (point))
14587 (insert conf-name) 14591 (insert conf-name)
14588 (speedbar-make-button 14592 (speedbar-make-button
14589 start (point) 'vhdl-speedbar-configuration-face 'speedbar-highlight-face 14593 start (point) 'vhdl-speedbar-configuration 'speedbar-highlight-face
14590 'vhdl-speedbar-find-file conf-file-marker) 14594 'vhdl-speedbar-find-file conf-file-marker)
14591 (insert ")"))) 14595 (insert ")")))
14592 (when (and lib-name (not (equal lib-name (downcase (vhdl-work-library))))) 14596 (when (and lib-name (not (equal lib-name (downcase (vhdl-work-library)))))
14593 (setq start (point)) 14597 (setq start (point))
14594 (insert " (" lib-name ")") 14598 (insert " (" lib-name ")")
14595 (put-text-property (+ 2 start) (1- (point)) 'face 14599 (put-text-property (+ 2 start) (1- (point)) 'face
14596 'vhdl-speedbar-library-face)) 14600 'vhdl-speedbar-library))
14597 (insert-char ?\n 1) 14601 (insert-char ?\n 1)
14598 (put-text-property visible-start (point) 'invisible nil))) 14602 (put-text-property visible-start (point) 'invisible nil)))
14599 14603
@@ -14617,7 +14621,7 @@ NO-POSITION non-nil means do not re-position cursor."
14617 (setq start (point)) 14621 (setq start (point))
14618 (insert pack-name) 14622 (insert pack-name)
14619 (speedbar-make-button 14623 (speedbar-make-button
14620 start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face 14624 start (point) 'vhdl-speedbar-package 'speedbar-highlight-face
14621 'vhdl-speedbar-find-file pack-file-marker) 14625 'vhdl-speedbar-find-file pack-file-marker)
14622 (unless (car pack-file-marker) 14626 (unless (car pack-file-marker)
14623 (insert "!")) 14627 (insert "!"))
@@ -14626,7 +14630,7 @@ NO-POSITION non-nil means do not re-position cursor."
14626 (setq start (point)) 14630 (setq start (point))
14627 (insert "body") 14631 (insert "body")
14628 (speedbar-make-button 14632 (speedbar-make-button
14629 start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face 14633 start (point) 'vhdl-speedbar-package 'speedbar-highlight-face
14630 'vhdl-speedbar-find-file body-file-marker) 14634 'vhdl-speedbar-find-file body-file-marker)
14631 (insert ")")) 14635 (insert ")"))
14632 (insert-char ?\n 1) 14636 (insert-char ?\n 1)
@@ -14650,12 +14654,12 @@ NO-POSITION non-nil means do not re-position cursor."
14650 (setq start (point)) 14654 (setq start (point))
14651 (insert pack-name) 14655 (insert pack-name)
14652 (speedbar-make-button 14656 (speedbar-make-button
14653 start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face 14657 start (point) 'vhdl-speedbar-package 'speedbar-highlight-face
14654 'vhdl-speedbar-find-file pack-file-marker) 14658 'vhdl-speedbar-find-file pack-file-marker)
14655 (setq start (point)) 14659 (setq start (point))
14656 (insert " (" lib-name ")") 14660 (insert " (" lib-name ")")
14657 (put-text-property (+ 2 start) (1- (point)) 'face 14661 (put-text-property (+ 2 start) (1- (point)) 'face
14658 'vhdl-speedbar-library-face) 14662 'vhdl-speedbar-library)
14659 (insert-char ?\n 1) 14663 (insert-char ?\n 1)
14660 (put-text-property visible-start (point) 'invisible nil))) 14664 (put-text-property visible-start (point) 'invisible nil)))
14661 14665
@@ -14678,14 +14682,14 @@ NO-POSITION non-nil means do not re-position cursor."
14678 (setq start (point)) 14682 (setq start (point))
14679 (insert func-name) 14683 (insert func-name)
14680 (speedbar-make-button 14684 (speedbar-make-button
14681 start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face 14685 start (point) 'vhdl-speedbar-subprogram 'speedbar-highlight-face
14682 'vhdl-speedbar-find-file func-file-marker) 14686 'vhdl-speedbar-find-file func-file-marker)
14683 (when (car func-body-file-marker) 14687 (when (car func-body-file-marker)
14684 (insert " (") 14688 (insert " (")
14685 (setq start (point)) 14689 (setq start (point))
14686 (insert "body") 14690 (insert "body")
14687 (speedbar-make-button 14691 (speedbar-make-button
14688 start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face 14692 start (point) 'vhdl-speedbar-subprogram 'speedbar-highlight-face
14689 'vhdl-speedbar-find-file func-body-file-marker) 14693 'vhdl-speedbar-find-file func-body-file-marker)
14690 (insert ")")) 14694 (insert ")"))
14691 (insert-char ?\n 1) 14695 (insert-char ?\n 1)
@@ -14773,22 +14777,22 @@ NO-POSITION non-nil means do not re-position cursor."
14773 (message 14777 (message
14774 "%s \"%s\" in \"%s\"" 14778 "%s \"%s\" in \"%s\""
14775 ;; design unit kind 14779 ;; design unit kind
14776 (cond ((or (eq face 'vhdl-speedbar-entity-face) 14780 (cond ((or (eq face 'vhdl-speedbar-entity)
14777 (eq face 'vhdl-speedbar-entity-selected-face)) 14781 (eq face 'vhdl-speedbar-entity-selected))
14778 (if (equal (match-string 2) ">") "Component" "Entity")) 14782 (if (equal (match-string 2) ">") "Component" "Entity"))
14779 ((or (eq face 'vhdl-speedbar-architecture-face) 14783 ((or (eq face 'vhdl-speedbar-architecture)
14780 (eq face 'vhdl-speedbar-architecture-selected-face)) 14784 (eq face 'vhdl-speedbar-architecture-selected))
14781 "Architecture") 14785 "Architecture")
14782 ((or (eq face 'vhdl-speedbar-configuration-face) 14786 ((or (eq face 'vhdl-speedbar-configuration)
14783 (eq face 'vhdl-speedbar-configuration-selected-face)) 14787 (eq face 'vhdl-speedbar-configuration-selected))
14784 "Configuration") 14788 "Configuration")
14785 ((or (eq face 'vhdl-speedbar-package-face) 14789 ((or (eq face 'vhdl-speedbar-package)
14786 (eq face 'vhdl-speedbar-package-selected-face)) 14790 (eq face 'vhdl-speedbar-package-selected))
14787 "Package") 14791 "Package")
14788 ((or (eq face 'vhdl-speedbar-instantiation-face) 14792 ((or (eq face 'vhdl-speedbar-instantiation)
14789 (eq face 'vhdl-speedbar-instantiation-selected-face)) 14793 (eq face 'vhdl-speedbar-instantiation-selected))
14790 "Instantiation") 14794 "Instantiation")
14791 ((eq face 'vhdl-speedbar-subprogram-face) 14795 ((eq face 'vhdl-speedbar-subprogram)
14792 "Subprogram") 14796 "Subprogram")
14793 (t "")) 14797 (t ""))
14794 ;; design unit name 14798 ;; design unit name
@@ -14924,7 +14928,7 @@ is already shown in a buffer."
14924 "Place the entity/component under the cursor as component." 14928 "Place the entity/component under the cursor as component."
14925 (interactive) 14929 (interactive)
14926 (if (not (vhdl-speedbar-check-unit 'entity)) 14930 (if (not (vhdl-speedbar-check-unit 'entity))
14927 (error "ERROR: No entity/component under cursor.") 14931 (error "ERROR: No entity/component under cursor")
14928 (vhdl-speedbar-port-copy) 14932 (vhdl-speedbar-port-copy)
14929 (if (fboundp 'speedbar-select-attached-frame) 14933 (if (fboundp 'speedbar-select-attached-frame)
14930 (speedbar-select-attached-frame) 14934 (speedbar-select-attached-frame)
@@ -14964,11 +14968,11 @@ expansion function)."
14964 (speedbar-position-cursor-on-line) 14968 (speedbar-position-cursor-on-line)
14965 (cond ((eq design-unit 'entity) 14969 (cond ((eq design-unit 'entity)
14966 (memq (get-text-property (match-end 0) 'face) 14970 (memq (get-text-property (match-end 0) 'face)
14967 '(vhdl-speedbar-entity-face 14971 '(vhdl-speedbar-entity
14968 vhdl-speedbar-entity-selected-face))) 14972 vhdl-speedbar-entity-selected)))
14969 ((eq design-unit 'subprogram) 14973 ((eq design-unit 'subprogram)
14970 (eq (get-text-property (match-end 0) 'face) 14974 (eq (get-text-property (match-end 0) 'face)
14971 'vhdl-speedbar-subprogram-face)) 14975 'vhdl-speedbar-subprogram))
14972 (t nil)))) 14976 (t nil))))
14973 14977
14974(defun vhdl-speedbar-set-depth (depth) 14978(defun vhdl-speedbar-set-depth (depth)
@@ -14979,82 +14983,106 @@ expansion function)."
14979;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 14983;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14980;; Fontification 14984;; Fontification
14981 14985
14982(defface vhdl-speedbar-entity-face 14986(defface vhdl-speedbar-entity
14983 '((((class color) (background light)) (:foreground "ForestGreen")) 14987 '((((class color) (background light)) (:foreground "ForestGreen"))
14984 (((class color) (background dark)) (:foreground "PaleGreen"))) 14988 (((class color) (background dark)) (:foreground "PaleGreen")))
14985 "Face used for displaying entity names." 14989 "Face used for displaying entity names."
14986 :group 'speedbar-faces) 14990 :group 'speedbar-faces)
14991;; backward-compatibility alias
14992(put 'vhdl-speedbar-entity-face 'face-alias 'vhdl-speedbar-entity)
14987 14993
14988(defface vhdl-speedbar-architecture-face 14994(defface vhdl-speedbar-architecture
14989 '((((min-colors 88) (class color) (background light)) (:foreground "Blue1")) 14995 '((((min-colors 88) (class color) (background light)) (:foreground "Blue1"))
14990 (((class color) (background light)) (:foreground "Blue")) 14996 (((class color) (background light)) (:foreground "Blue"))
14991 (((class color) (background dark)) (:foreground "LightSkyBlue"))) 14997 (((class color) (background dark)) (:foreground "LightSkyBlue")))
14992 "Face used for displaying architecture names." 14998 "Face used for displaying architecture names."
14993 :group 'speedbar-faces) 14999 :group 'speedbar-faces)
15000;; backward-compatibility alias
15001(put 'vhdl-speedbar-architecture-face 'face-alias 'vhdl-speedbar-architecture)
14994 15002
14995(defface vhdl-speedbar-configuration-face 15003(defface vhdl-speedbar-configuration
14996 '((((class color) (background light)) (:foreground "DarkGoldenrod")) 15004 '((((class color) (background light)) (:foreground "DarkGoldenrod"))
14997 (((class color) (background dark)) (:foreground "Salmon"))) 15005 (((class color) (background dark)) (:foreground "Salmon")))
14998 "Face used for displaying configuration names." 15006 "Face used for displaying configuration names."
14999 :group 'speedbar-faces) 15007 :group 'speedbar-faces)
15008;; backward-compatibility alias
15009(put 'vhdl-speedbar-configuration-face 'face-alias 'vhdl-speedbar-configuration)
15000 15010
15001(defface vhdl-speedbar-package-face 15011(defface vhdl-speedbar-package
15002 '((((class color) (background light)) (:foreground "Grey50")) 15012 '((((class color) (background light)) (:foreground "Grey50"))
15003 (((class color) (background dark)) (:foreground "Grey80"))) 15013 (((class color) (background dark)) (:foreground "Grey80")))
15004 "Face used for displaying package names." 15014 "Face used for displaying package names."
15005 :group 'speedbar-faces) 15015 :group 'speedbar-faces)
15016;; backward-compatibility alias
15017(put 'vhdl-speedbar-package-face 'face-alias 'vhdl-speedbar-package)
15006 15018
15007(defface vhdl-speedbar-library-face 15019(defface vhdl-speedbar-library
15008 '((((class color) (background light)) (:foreground "Purple")) 15020 '((((class color) (background light)) (:foreground "Purple"))
15009 (((class color) (background dark)) (:foreground "Orchid1"))) 15021 (((class color) (background dark)) (:foreground "Orchid1")))
15010 "Face used for displaying library names." 15022 "Face used for displaying library names."
15011 :group 'speedbar-faces) 15023 :group 'speedbar-faces)
15024;; backward-compatibility alias
15025(put 'vhdl-speedbar-library-face 'face-alias 'vhdl-speedbar-library)
15012 15026
15013(defface vhdl-speedbar-instantiation-face 15027(defface vhdl-speedbar-instantiation
15014 '((((class color) (background light)) (:foreground "Brown")) 15028 '((((class color) (background light)) (:foreground "Brown"))
15015 (((min-colors 88) (class color) (background dark)) (:foreground "Yellow1")) 15029 (((min-colors 88) (class color) (background dark)) (:foreground "Yellow1"))
15016 (((class color) (background dark)) (:foreground "Yellow"))) 15030 (((class color) (background dark)) (:foreground "Yellow")))
15017 "Face used for displaying instantiation names." 15031 "Face used for displaying instantiation names."
15018 :group 'speedbar-faces) 15032 :group 'speedbar-faces)
15033;; backward-compatibility alias
15034(put 'vhdl-speedbar-instantiation-face 'face-alias 'vhdl-speedbar-instantiation)
15019 15035
15020(defface vhdl-speedbar-subprogram-face 15036(defface vhdl-speedbar-subprogram
15021 '((((class color) (background light)) (:foreground "Orchid4")) 15037 '((((class color) (background light)) (:foreground "Orchid4"))
15022 (((class color) (background dark)) (:foreground "BurlyWood2"))) 15038 (((class color) (background dark)) (:foreground "BurlyWood2")))
15023 "Face used for displaying subprogram names." 15039 "Face used for displaying subprogram names."
15024 :group 'speedbar-faces) 15040 :group 'speedbar-faces)
15041;; backward-compatibility alias
15042(put 'vhdl-speedbar-subprogram-face 'face-alias 'vhdl-speedbar-subprogram)
15025 15043
15026(defface vhdl-speedbar-entity-selected-face 15044(defface vhdl-speedbar-entity-selected
15027 '((((class color) (background light)) (:foreground "ForestGreen" :underline t)) 15045 '((((class color) (background light)) (:foreground "ForestGreen" :underline t))
15028 (((class color) (background dark)) (:foreground "PaleGreen" :underline t))) 15046 (((class color) (background dark)) (:foreground "PaleGreen" :underline t)))
15029 "Face used for displaying entity names." 15047 "Face used for displaying entity names."
15030 :group 'speedbar-faces) 15048 :group 'speedbar-faces)
15049;; backward-compatibility alias
15050(put 'vhdl-speedbar-entity-selected-face 'face-alias 'vhdl-speedbar-entity-selected)
15031 15051
15032(defface vhdl-speedbar-architecture-selected-face 15052(defface vhdl-speedbar-architecture-selected
15033 '((((min-colors 88) (class color) (background light)) (:foreground "Blue1" :underline t)) 15053 '((((min-colors 88) (class color) (background light)) (:foreground "Blue1" :underline t))
15034 (((min-colors 88) (class color) (background light)) (:foreground "Blue1" :underline t)) 15054 (((min-colors 88) (class color) (background light)) (:foreground "Blue1" :underline t))
15035 (((class color) (background light)) (:foreground "Blue" :underline t)) 15055 (((class color) (background light)) (:foreground "Blue" :underline t))
15036 (((class color) (background dark)) (:foreground "LightSkyBlue" :underline t))) 15056 (((class color) (background dark)) (:foreground "LightSkyBlue" :underline t)))
15037 "Face used for displaying architecture names." 15057 "Face used for displaying architecture names."
15038 :group 'speedbar-faces) 15058 :group 'speedbar-faces)
15059;; backward-compatibility alias
15060(put 'vhdl-speedbar-architecture-selected-face 'face-alias 'vhdl-speedbar-architecture-selected)
15039 15061
15040(defface vhdl-speedbar-configuration-selected-face 15062(defface vhdl-speedbar-configuration-selected
15041 '((((class color) (background light)) (:foreground "DarkGoldenrod" :underline t)) 15063 '((((class color) (background light)) (:foreground "DarkGoldenrod" :underline t))
15042 (((class color) (background dark)) (:foreground "Salmon" :underline t))) 15064 (((class color) (background dark)) (:foreground "Salmon" :underline t)))
15043 "Face used for displaying configuration names." 15065 "Face used for displaying configuration names."
15044 :group 'speedbar-faces) 15066 :group 'speedbar-faces)
15067;; backward-compatibility alias
15068(put 'vhdl-speedbar-configuration-selected-face 'face-alias 'vhdl-speedbar-configuration-selected)
15045 15069
15046(defface vhdl-speedbar-package-selected-face 15070(defface vhdl-speedbar-package-selected
15047 '((((class color) (background light)) (:foreground "Grey50" :underline t)) 15071 '((((class color) (background light)) (:foreground "Grey50" :underline t))
15048 (((class color) (background dark)) (:foreground "Grey80" :underline t))) 15072 (((class color) (background dark)) (:foreground "Grey80" :underline t)))
15049 "Face used for displaying package names." 15073 "Face used for displaying package names."
15050 :group 'speedbar-faces) 15074 :group 'speedbar-faces)
15075;; backward-compatibility alias
15076(put 'vhdl-speedbar-package-selected-face 'face-alias 'vhdl-speedbar-package-selected)
15051 15077
15052(defface vhdl-speedbar-instantiation-selected-face 15078(defface vhdl-speedbar-instantiation-selected
15053 '((((class color) (background light)) (:foreground "Brown" :underline t)) 15079 '((((class color) (background light)) (:foreground "Brown" :underline t))
15054 (((min-colors 88) (class color) (background dark)) (:foreground "Yellow1" :underline t)) 15080 (((min-colors 88) (class color) (background dark)) (:foreground "Yellow1" :underline t))
15055 (((class color) (background dark)) (:foreground "Yellow" :underline t))) 15081 (((class color) (background dark)) (:foreground "Yellow" :underline t)))
15056 "Face used for displaying instantiation names." 15082 "Face used for displaying instantiation names."
15057 :group 'speedbar-faces) 15083 :group 'speedbar-faces)
15084;; backward-compatibility alias
15085(put 'vhdl-speedbar-instantiation-selected-face 'face-alias 'vhdl-speedbar-instantiation-selected)
15058 15086
15059;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 15087;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15060;; Initialization 15088;; Initialization
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el
index 1fa37532ab0..a96bd076e12 100644
--- a/lisp/progmodes/which-func.el
+++ b/lisp/progmodes/which-func.el
@@ -113,17 +113,40 @@ Zero means compute the Imenu menu regardless of size."
113 map) 113 map)
114 "Keymap to display on mode line which-func.") 114 "Keymap to display on mode line which-func.")
115 115
116(defface which-func-face 116(defface which-func
117 '((t (:inherit font-lock-function-name-face))) 117 ;; Whether `font-lock-function-name-face' is an appropriate face to
118 "Face used to highlight mode line function names. 118 ;; inherit depends on the mode-line face; define several variants based
119Defaults to `font-lock-function-name-face' if font-lock is loaded." 119 ;; on the default mode-line face.
120 '(;; The default mode-line face on a high-color display is a relatively
121 ;; light color ("grey75"), and only the light-background variant of
122 ;; `font-lock-function-name-face' is visible against it.
123 (((class color) (min-colors 88) (background light))
124 :inherit font-lock-function-name-face)
125 ;; The default mode-line face on other display types is inverse-video;
126 ;; it seems that only in the dark-background case is
127 ;; `font-lock-function-name-face' visible against it.
128 (((class grayscale mono) (background dark))
129 :inherit font-lock-function-name-face)
130 (((class color) (background light))
131 :inherit font-lock-function-name-face)
132 ;; If none of the above cases, use an explicit color chosen to contrast
133 ;; well with the default mode-line face.
134 (((class color) (min-colors 88) (background dark))
135 :foreground "Blue1")
136 (((background dark))
137 :foreground "Blue1")
138 (t
139 :foreground "LightSkyBlue"))
140 "Face used to highlight mode line function names."
120 :group 'which-func) 141 :group 'which-func)
142;; backward-compatibility alias
143(put 'which-func-face 'face-alias 'which-func)
121 144
122(defcustom which-func-format 145(defcustom which-func-format
123 `("[" 146 `("["
124 (:propertize which-func-current 147 (:propertize which-func-current
125 local-map ,which-func-keymap 148 local-map ,which-func-keymap
126 face which-func-face 149 face which-func
127 ;;mouse-face highlight ; currently not evaluated :-( 150 ;;mouse-face highlight ; currently not evaluated :-(
128 help-echo "mouse-1: go to beginning, mouse-2: toggle rest visibility, mouse-3: go to end") 151 help-echo "mouse-1: go to beginning, mouse-2: toggle rest visibility, mouse-3: go to end")
129 "]") 152 "]")
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index b47ea3d4f89..2868ae7d97b 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -3019,7 +3019,7 @@ Valid values are:
3019 NUMBER It's a real value between 0.0 (black) and 1.0 (white) that 3019 NUMBER It's a real value between 0.0 (black) and 1.0 (white) that
3020 indicate the gray color. 3020 indicate the gray color.
3021 3021
3022 COLOR-NAME It's a string wich contains the color name. For example: 3022 COLOR-NAME It's a string which contains the color name. For example:
3023 \"yellow\". 3023 \"yellow\".
3024 3024
3025 LIST It's a list of RGB values, that is a list of three real values 3025 LIST It's a list of RGB values, that is a list of three real values
@@ -3059,7 +3059,7 @@ Valid values are:
3059 NUMBER It's a real value between 0.0 (black) and 1.0 (white) that 3059 NUMBER It's a real value between 0.0 (black) and 1.0 (white) that
3060 indicate the gray color. 3060 indicate the gray color.
3061 3061
3062 COLOR-NAME It's a string wich contains the color name. For example: 3062 COLOR-NAME It's a string which contains the color name. For example:
3063 \"yellow\". 3063 \"yellow\".
3064 3064
3065 LIST It's a list of RGB values, that is a list of three real values 3065 LIST It's a list of RGB values, that is a list of three real values
@@ -6155,7 +6155,7 @@ XSTART YSTART are the relative position for the first page in a sheet.")
6155 (if (and (boundp 'ucs-mule-8859-to-mule-unicode) 6155 (if (and (boundp 'ucs-mule-8859-to-mule-unicode)
6156 (char-table-p ucs-mule-8859-to-mule-unicode)) 6156 (char-table-p ucs-mule-8859-to-mule-unicode))
6157 (map-char-table 6157 (map-char-table
6158 #'(lambda (k v) 6158 #'(lambda (k v)
6159 (if (and v (eq (char-charset v) 'latin-iso8859-1) (/= k v)) 6159 (if (and v (eq (char-charset v) 'latin-iso8859-1) (/= k v))
6160 (aset tbl k v))) 6160 (aset tbl k v)))
6161 ucs-mule-8859-to-mule-unicode)) 6161 ucs-mule-8859-to-mule-unicode))
diff --git a/lisp/recentf.el b/lisp/recentf.el
index bb462bc71d7..1ea3ae6ecb2 100644
--- a/lisp/recentf.el
+++ b/lisp/recentf.el
@@ -923,9 +923,11 @@ IGNORE arguments."
923 923
924\\{recentf-dialog-mode-map}" 924\\{recentf-dialog-mode-map}"
925 (interactive) 925 (interactive)
926 (kill-all-local-variables)
926 (setq major-mode 'recentf-dialog-mode) 927 (setq major-mode 'recentf-dialog-mode)
927 (setq mode-name "recentf-dialog") 928 (setq mode-name "recentf-dialog")
928 (use-local-map recentf-dialog-mode-map)) 929 (use-local-map recentf-dialog-mode-map)
930 (run-mode-hooks 'recentf-dialog-mode-hook))
929 931
930;;; Hooks 932;;; Hooks
931;; 933;;
@@ -1002,13 +1004,13 @@ That is to select files to be deleted from the recent list."
1002 (get-buffer-create (format "*%s - Edit list*" recentf-menu-title)) 1004 (get-buffer-create (format "*%s - Edit list*" recentf-menu-title))
1003 (switch-to-buffer (current-buffer)) 1005 (switch-to-buffer (current-buffer))
1004 ;; Cleanup buffer 1006 ;; Cleanup buffer
1005 (kill-all-local-variables)
1006 (let ((inhibit-read-only t) 1007 (let ((inhibit-read-only t)
1007 (ol (overlay-lists))) 1008 (ol (overlay-lists)))
1008 (erase-buffer) 1009 (erase-buffer)
1009 ;; Delete all the overlays. 1010 ;; Delete all the overlays.
1010 (mapc 'delete-overlay (car ol)) 1011 (mapc 'delete-overlay (car ol))
1011 (mapc 'delete-overlay (cdr ol))) 1012 (mapc 'delete-overlay (cdr ol)))
1013 (recentf-dialog-mode)
1012 (setq recentf-edit-selected-items nil) 1014 (setq recentf-edit-selected-items nil)
1013 ;; Insert the dialog header 1015 ;; Insert the dialog header
1014 (widget-insert 1016 (widget-insert
@@ -1045,7 +1047,6 @@ Click on Cancel or type \"q\" to quit.\n")
1045 'push-button 1047 'push-button
1046 :notify 'recentf-cancel-dialog 1048 :notify 'recentf-cancel-dialog
1047 "Cancel") 1049 "Cancel")
1048 (recentf-dialog-mode)
1049 (widget-setup) 1050 (widget-setup)
1050 (goto-char (point-min)))) 1051 (goto-char (point-min))))
1051 1052
@@ -1101,13 +1102,13 @@ default."
1101 (with-current-buffer (get-buffer-create buffer-name) 1102 (with-current-buffer (get-buffer-create buffer-name)
1102 (switch-to-buffer (current-buffer)) 1103 (switch-to-buffer (current-buffer))
1103 ;; Cleanup buffer 1104 ;; Cleanup buffer
1104 (kill-all-local-variables)
1105 (let ((inhibit-read-only t) 1105 (let ((inhibit-read-only t)
1106 (ol (overlay-lists))) 1106 (ol (overlay-lists)))
1107 (erase-buffer) 1107 (erase-buffer)
1108 ;; Delete all the overlays. 1108 ;; Delete all the overlays.
1109 (mapc 'delete-overlay (car ol)) 1109 (mapc 'delete-overlay (car ol))
1110 (mapc 'delete-overlay (cdr ol))) 1110 (mapc 'delete-overlay (cdr ol)))
1111 (recentf-dialog-mode)
1111 ;; Insert the dialog header 1112 ;; Insert the dialog header
1112 (widget-insert "Click on a file to open it. ") 1113 (widget-insert "Click on a file to open it. ")
1113 (widget-insert "Click on Cancel or type \"q\" to quit.\n\n" ) 1114 (widget-insert "Click on Cancel or type \"q\" to quit.\n\n" )
@@ -1123,7 +1124,6 @@ default."
1123 'push-button 1124 'push-button
1124 :notify 'recentf-cancel-dialog 1125 :notify 'recentf-cancel-dialog
1125 "Cancel") 1126 "Cancel")
1126 (recentf-dialog-mode)
1127 (widget-setup) 1127 (widget-setup)
1128 (goto-char (point-min)))) 1128 (goto-char (point-min))))
1129 1129
diff --git a/lisp/replace.el b/lisp/replace.el
index ba3d5fcfbf4..d5ccd8723c2 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -217,7 +217,7 @@ Fourth and fifth arg START and END specify the region to operate on.
217 217
218To customize possible responses, change the \"bindings\" in `query-replace-map'." 218To customize possible responses, change the \"bindings\" in `query-replace-map'."
219 (interactive (let ((common 219 (interactive (let ((common
220 (query-replace-read-args 220 (query-replace-read-args
221 (if (and transient-mark-mode mark-active) 221 (if (and transient-mark-mode mark-active)
222 "Query replace in region" 222 "Query replace in region"
223 "Query replace") 223 "Query replace")
@@ -281,7 +281,7 @@ text, TO-STRING is actually made a list instead of a string.
281Use \\[repeat-complex-command] after this command for details." 281Use \\[repeat-complex-command] after this command for details."
282 (interactive 282 (interactive
283 (let ((common 283 (let ((common
284 (query-replace-read-args 284 (query-replace-read-args
285 (if (and transient-mark-mode mark-active) 285 (if (and transient-mark-mode mark-active)
286 "Query replace regexp in region" 286 "Query replace regexp in region"
287 "Query replace regexp") 287 "Query replace regexp")
@@ -431,7 +431,7 @@ which will run faster and will not set the mark or print anything.
431and TO-STRING is also null.)" 431and TO-STRING is also null.)"
432 (interactive 432 (interactive
433 (let ((common 433 (let ((common
434 (query-replace-read-args 434 (query-replace-read-args
435 (if (and transient-mark-mode mark-active) 435 (if (and transient-mark-mode mark-active)
436 "Replace string in region" 436 "Replace string in region"
437 "Replace string") 437 "Replace string")
@@ -489,10 +489,10 @@ What you probably want is a loop like this:
489which will run faster and will not set the mark or print anything." 489which will run faster and will not set the mark or print anything."
490 (interactive 490 (interactive
491 (let ((common 491 (let ((common
492 (query-replace-read-args 492 (query-replace-read-args
493 (if (and transient-mark-mode mark-active) 493 (if (and transient-mark-mode mark-active)
494 "Replace regexp in region" 494 "Replace regexp in region"
495 "Replace regexp") 495 "Replace regexp")
496 t))) 496 t)))
497 (list (nth 0 common) (nth 1 common) (nth 2 common) 497 (list (nth 0 common) (nth 1 common) (nth 2 common)
498 (if (and transient-mark-mode mark-active) 498 (if (and transient-mark-mode mark-active)
@@ -1268,12 +1268,7 @@ but coerced to the correct value of INTEGERS."
1268 (and (eq new reuse) 1268 (and (eq new reuse)
1269 (eq (null integers) (markerp (car reuse))) 1269 (eq (null integers) (markerp (car reuse)))
1270 new))) 1270 new)))
1271 (match-data integers 1271 (match-data integers reuse t)))
1272 (prog1 reuse
1273 (while reuse
1274 (if (markerp (car reuse))
1275 (set-marker (car reuse) nil))
1276 (setq reuse (cdr reuse)))))))
1277 1272
1278(defun replace-match-maybe-edit (newtext fixedcase literal noedit match-data) 1273(defun replace-match-maybe-edit (newtext fixedcase literal noedit match-data)
1279 "Make a replacement with `replace-match', editing `\\?'. 1274 "Make a replacement with `replace-match', editing `\\?'.
diff --git a/lisp/rfn-eshadow.el b/lisp/rfn-eshadow.el
index 5fb31561c41..84731115d1a 100644
--- a/lisp/rfn-eshadow.el
+++ b/lisp/rfn-eshadow.el
@@ -113,10 +113,7 @@ system, `file-name-shadow-properties' is used instead."
113 :group 'minibuffer) 113 :group 'minibuffer)
114 114
115(defface file-name-shadow 115(defface file-name-shadow
116 '((((background dark)) 116 '((t :inherit shadow))
117 :foreground "grey50")
118 (t
119 :foreground "grey70"))
120 "Face used by `file-name-shadow-mode' for the shadow." 117 "Face used by `file-name-shadow-mode' for the shadow."
121 :group 'minibuffer) 118 :group 'minibuffer)
122 119
diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el
index 46a28ce5069..9e85b7846ca 100644
--- a/lisp/ruler-mode.el
+++ b/lisp/ruler-mode.el
@@ -1,6 +1,6 @@
1;;; ruler-mode.el --- display a ruler in the header line 1;;; ruler-mode.el --- display a ruler in the header line
2 2
3;; Copyright (C) 2001, 2002, 2003, 2004 Free Software Foundation, Inc. 3;; Copyright (C) 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
4 4
5;; Author: David Ponce <david@dponce.com> 5;; Author: David Ponce <david@dponce.com>
6;; Maintainer: David Ponce <david@dponce.com> 6;; Maintainer: David Ponce <david@dponce.com>
@@ -70,26 +70,26 @@
70;; 70;;
71;; The following faces are customizable: 71;; The following faces are customizable:
72;; 72;;
73;; - `ruler-mode-default-face' the ruler default face. 73;; - `ruler-mode-default' the ruler default face.
74;; - `ruler-mode-fill-column-face' the face used to highlight the 74;; - `ruler-mode-fill-column' the face used to highlight the
75;; `fill-column' character. 75;; `fill-column' character.
76;; - `ruler-mode-comment-column-face' the face used to highlight the 76;; - `ruler-mode-comment-column' the face used to highlight the
77;; `comment-column' character. 77;; `comment-column' character.
78;; - `ruler-mode-goal-column-face' the face used to highlight the 78;; - `ruler-mode-goal-column' the face used to highlight the
79;; `goal-column' character. 79;; `goal-column' character.
80;; - `ruler-mode-current-column-face' the face used to highlight the 80;; - `ruler-mode-current-column' the face used to highlight the
81;; `current-column' character. 81;; `current-column' character.
82;; - `ruler-mode-tab-stop-face' the face used to highlight tab stop 82;; - `ruler-mode-tab-stop' the face used to highlight tab stop
83;; characters. 83;; characters.
84;; - `ruler-mode-margins-face' the face used to highlight graduations 84;; - `ruler-mode-margins' the face used to highlight graduations
85;; in the `window-margins' areas. 85;; in the `window-margins' areas.
86;; - `ruler-mode-fringes-face' the face used to highlight graduations 86;; - `ruler-mode-fringes' the face used to highlight graduations
87;; in the `window-fringes' areas. 87;; in the `window-fringes' areas.
88;; - `ruler-mode-column-number-face' the face used to highlight the 88;; - `ruler-mode-column-number' the face used to highlight the
89;; numbered graduations. 89;; numbered graduations.
90;; 90;;
91;; `ruler-mode-default-face' inherits from the built-in `default' face. 91;; `ruler-mode-default' inherits from the built-in `default' face.
92;; All `ruler-mode' faces inherit from `ruler-mode-default-face'. 92;; All `ruler-mode' faces inherit from `ruler-mode-default'.
93;; 93;;
94;; WARNING: To keep ruler graduations aligned on text columns it is 94;; WARNING: To keep ruler graduations aligned on text columns it is
95;; important to use the same font family and size for ruler and text 95;; important to use the same font family and size for ruler and text
@@ -205,7 +205,7 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
205 :group 'ruler-mode 205 :group 'ruler-mode
206 :type 'boolean) 206 :type 'boolean)
207 207
208(defface ruler-mode-default-face 208(defface ruler-mode-default
209 '((((type tty)) 209 '((((type tty))
210 (:inherit default 210 (:inherit default
211 :background "grey64" 211 :background "grey64"
@@ -221,83 +221,103 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
221 ))) 221 )))
222 "Default face used by the ruler." 222 "Default face used by the ruler."
223 :group 'ruler-mode) 223 :group 'ruler-mode)
224;; backward-compatibility alias
225(put 'ruler-mode-default-face 'face-alias 'ruler-mode-default)
224 226
225(defface ruler-mode-pad-face 227(defface ruler-mode-pad
226 '((((type tty)) 228 '((((type tty))
227 (:inherit ruler-mode-default-face 229 (:inherit ruler-mode-default
228 :background "grey50" 230 :background "grey50"
229 )) 231 ))
230 (t 232 (t
231 (:inherit ruler-mode-default-face 233 (:inherit ruler-mode-default
232 :background "grey64" 234 :background "grey64"
233 ))) 235 )))
234 "Face used to pad inactive ruler areas." 236 "Face used to pad inactive ruler areas."
235 :group 'ruler-mode) 237 :group 'ruler-mode)
238;; backward-compatibility alias
239(put 'ruler-mode-pad-face 'face-alias 'ruler-mode-pad)
236 240
237(defface ruler-mode-margins-face 241(defface ruler-mode-margins
238 '((t 242 '((t
239 (:inherit ruler-mode-default-face 243 (:inherit ruler-mode-default
240 :foreground "white" 244 :foreground "white"
241 ))) 245 )))
242 "Face used to highlight margin areas." 246 "Face used to highlight margin areas."
243 :group 'ruler-mode) 247 :group 'ruler-mode)
248;; backward-compatibility alias
249(put 'ruler-mode-margins-face 'face-alias 'ruler-mode-margins)
244 250
245(defface ruler-mode-fringes-face 251(defface ruler-mode-fringes
246 '((t 252 '((t
247 (:inherit ruler-mode-default-face 253 (:inherit ruler-mode-default
248 :foreground "green" 254 :foreground "green"
249 ))) 255 )))
250 "Face used to highlight fringes areas." 256 "Face used to highlight fringes areas."
251 :group 'ruler-mode) 257 :group 'ruler-mode)
258;; backward-compatibility alias
259(put 'ruler-mode-fringes-face 'face-alias 'ruler-mode-fringes)
252 260
253(defface ruler-mode-column-number-face 261(defface ruler-mode-column-number
254 '((t 262 '((t
255 (:inherit ruler-mode-default-face 263 (:inherit ruler-mode-default
256 :foreground "black" 264 :foreground "black"
257 ))) 265 )))
258 "Face used to highlight number graduations." 266 "Face used to highlight number graduations."
259 :group 'ruler-mode) 267 :group 'ruler-mode)
268;; backward-compatibility alias
269(put 'ruler-mode-column-number-face 'face-alias 'ruler-mode-column-number)
260 270
261(defface ruler-mode-fill-column-face 271(defface ruler-mode-fill-column
262 '((t 272 '((t
263 (:inherit ruler-mode-default-face 273 (:inherit ruler-mode-default
264 :foreground "red" 274 :foreground "red"
265 ))) 275 )))
266 "Face used to highlight the fill column character." 276 "Face used to highlight the fill column character."
267 :group 'ruler-mode) 277 :group 'ruler-mode)
278;; backward-compatibility alias
279(put 'ruler-mode-fill-column-face 'face-alias 'ruler-mode-fill-column)
268 280
269(defface ruler-mode-comment-column-face 281(defface ruler-mode-comment-column
270 '((t 282 '((t
271 (:inherit ruler-mode-default-face 283 (:inherit ruler-mode-default
272 :foreground "red" 284 :foreground "red"
273 ))) 285 )))
274 "Face used to highlight the comment column character." 286 "Face used to highlight the comment column character."
275 :group 'ruler-mode) 287 :group 'ruler-mode)
288;; backward-compatibility alias
289(put 'ruler-mode-comment-column-face 'face-alias 'ruler-mode-comment-column)
276 290
277(defface ruler-mode-goal-column-face 291(defface ruler-mode-goal-column
278 '((t 292 '((t
279 (:inherit ruler-mode-default-face 293 (:inherit ruler-mode-default
280 :foreground "red" 294 :foreground "red"
281 ))) 295 )))
282 "Face used to highlight the goal column character." 296 "Face used to highlight the goal column character."
283 :group 'ruler-mode) 297 :group 'ruler-mode)
298;; backward-compatibility alias
299(put 'ruler-mode-goal-column-face 'face-alias 'ruler-mode-goal-column)
284 300
285(defface ruler-mode-tab-stop-face 301(defface ruler-mode-tab-stop
286 '((t 302 '((t
287 (:inherit ruler-mode-default-face 303 (:inherit ruler-mode-default
288 :foreground "steelblue" 304 :foreground "steelblue"
289 ))) 305 )))
290 "Face used to highlight tab stop characters." 306 "Face used to highlight tab stop characters."
291 :group 'ruler-mode) 307 :group 'ruler-mode)
308;; backward-compatibility alias
309(put 'ruler-mode-tab-stop-face 'face-alias 'ruler-mode-tab-stop)
292 310
293(defface ruler-mode-current-column-face 311(defface ruler-mode-current-column
294 '((t 312 '((t
295 (:inherit ruler-mode-default-face 313 (:inherit ruler-mode-default
296 :weight bold 314 :weight bold
297 :foreground "yellow" 315 :foreground "yellow"
298 ))) 316 )))
299 "Face used to highlight the `current-column' character." 317 "Face used to highlight the `current-column' character."
300 :group 'ruler-mode) 318 :group 'ruler-mode)
319;; backward-compatibility alias
320(put 'ruler-mode-current-column-face 'face-alias 'ruler-mode-current-column)
301 321
302 322
303(defsubst ruler-mode-full-window-width () 323(defsubst ruler-mode-full-window-width ()
@@ -419,7 +439,7 @@ dragging. See also the variable `ruler-mode-dragged-symbol'."
419 (message "Goal column set to %d (click on %s again to unset it)" 439 (message "Goal column set to %d (click on %s again to unset it)"
420 newc 440 newc
421 (propertize (char-to-string ruler-mode-goal-column-char) 441 (propertize (char-to-string ruler-mode-goal-column-char)
422 'face 'ruler-mode-goal-column-face)) 442 'face 'ruler-mode-goal-column))
423 nil) ;; Don't start dragging. 443 nil) ;; Don't start dragging.
424 ) 444 )
425 (if (eq 'click (ruler-mode-mouse-drag-any-column-iteration 445 (if (eq 'click (ruler-mode-mouse-drag-any-column-iteration
@@ -629,34 +649,34 @@ Optional argument PROPS specifies other text properties to apply."
629 ;; Setup the scrollbar, fringes, and margins areas. 649 ;; Setup the scrollbar, fringes, and margins areas.
630 (lf (ruler-mode-space 650 (lf (ruler-mode-space
631 'left-fringe 651 'left-fringe
632 'face 'ruler-mode-fringes-face 652 'face 'ruler-mode-fringes
633 'help-echo (format ruler-mode-fringe-help-echo 653 'help-echo (format ruler-mode-fringe-help-echo
634 "Left" (or (car f) 0)))) 654 "Left" (or (car f) 0))))
635 (rf (ruler-mode-space 655 (rf (ruler-mode-space
636 'right-fringe 656 'right-fringe
637 'face 'ruler-mode-fringes-face 657 'face 'ruler-mode-fringes
638 'help-echo (format ruler-mode-fringe-help-echo 658 'help-echo (format ruler-mode-fringe-help-echo
639 "Right" (or (cadr f) 0)))) 659 "Right" (or (cadr f) 0))))
640 (lm (ruler-mode-space 660 (lm (ruler-mode-space
641 'left-margin 661 'left-margin
642 'face 'ruler-mode-margins-face 662 'face 'ruler-mode-margins
643 'help-echo (format ruler-mode-margin-help-echo 663 'help-echo (format ruler-mode-margin-help-echo
644 "Left" (or (car m) 0)))) 664 "Left" (or (car m) 0))))
645 (rm (ruler-mode-space 665 (rm (ruler-mode-space
646 'right-margin 666 'right-margin
647 'face 'ruler-mode-margins-face 667 'face 'ruler-mode-margins
648 'help-echo (format ruler-mode-margin-help-echo 668 'help-echo (format ruler-mode-margin-help-echo
649 "Right" (or (cdr m) 0)))) 669 "Right" (or (cdr m) 0))))
650 (sb (ruler-mode-space 670 (sb (ruler-mode-space
651 'scroll-bar 671 'scroll-bar
652 'face 'ruler-mode-pad-face)) 672 'face 'ruler-mode-pad))
653 ;; Remember the scrollbar vertical type. 673 ;; Remember the scrollbar vertical type.
654 (sbvt (car (window-current-scroll-bars))) 674 (sbvt (car (window-current-scroll-bars)))
655 ;; Create an "clean" ruler. 675 ;; Create an "clean" ruler.
656 (ruler 676 (ruler
657 (propertize 677 (propertize
658 (make-string w ruler-mode-basic-graduation-char) 678 (make-string w ruler-mode-basic-graduation-char)
659 'face 'ruler-mode-default-face 679 'face 'ruler-mode-default
660 'local-map ruler-mode-map 680 'local-map ruler-mode-map
661 'help-echo (cond 681 'help-echo (cond
662 (ruler-mode-show-tab-stops 682 (ruler-mode-show-tab-stops
@@ -675,7 +695,7 @@ Optional argument PROPS specifies other text properties to apply."
675 m (length c) 695 m (length c)
676 k i) 696 k i)
677 (put-text-property 697 (put-text-property
678 i (1+ i) 'face 'ruler-mode-column-number-face 698 i (1+ i) 'face 'ruler-mode-column-number
679 ruler) 699 ruler)
680 (while (and (> m 0) (>= k 0)) 700 (while (and (> m 0) (>= k 0))
681 (aset ruler k (aref c (setq m (1- m)))) 701 (aset ruler k (aref c (setq m (1- m))))
@@ -689,13 +709,13 @@ Optional argument PROPS specifies other text properties to apply."
689 ((= j (current-column)) 709 ((= j (current-column))
690 (aset ruler i ruler-mode-current-column-char) 710 (aset ruler i ruler-mode-current-column-char)
691 (put-text-property 711 (put-text-property
692 i (1+ i) 'face 'ruler-mode-current-column-face 712 i (1+ i) 'face 'ruler-mode-current-column
693 ruler)) 713 ruler))
694 ;; Show the `goal-column' marker. 714 ;; Show the `goal-column' marker.
695 ((and goal-column (= j goal-column)) 715 ((and goal-column (= j goal-column))
696 (aset ruler i ruler-mode-goal-column-char) 716 (aset ruler i ruler-mode-goal-column-char)
697 (put-text-property 717 (put-text-property
698 i (1+ i) 'face 'ruler-mode-goal-column-face 718 i (1+ i) 'face 'ruler-mode-goal-column
699 ruler) 719 ruler)
700 (put-text-property 720 (put-text-property
701 i (1+ i) 'mouse-face 'mode-line-highlight 721 i (1+ i) 'mouse-face 'mode-line-highlight
@@ -707,7 +727,7 @@ Optional argument PROPS specifies other text properties to apply."
707 ((= j comment-column) 727 ((= j comment-column)
708 (aset ruler i ruler-mode-comment-column-char) 728 (aset ruler i ruler-mode-comment-column-char)
709 (put-text-property 729 (put-text-property
710 i (1+ i) 'face 'ruler-mode-comment-column-face 730 i (1+ i) 'face 'ruler-mode-comment-column
711 ruler) 731 ruler)
712 (put-text-property 732 (put-text-property
713 i (1+ i) 'mouse-face 'mode-line-highlight 733 i (1+ i) 'mouse-face 'mode-line-highlight
@@ -719,7 +739,7 @@ Optional argument PROPS specifies other text properties to apply."
719 ((= j fill-column) 739 ((= j fill-column)
720 (aset ruler i ruler-mode-fill-column-char) 740 (aset ruler i ruler-mode-fill-column-char)
721 (put-text-property 741 (put-text-property
722 i (1+ i) 'face 'ruler-mode-fill-column-face 742 i (1+ i) 'face 'ruler-mode-fill-column
723 ruler) 743 ruler)
724 (put-text-property 744 (put-text-property
725 i (1+ i) 'mouse-face 'mode-line-highlight 745 i (1+ i) 'mouse-face 'mode-line-highlight
@@ -731,7 +751,7 @@ Optional argument PROPS specifies other text properties to apply."
731 ((and ruler-mode-show-tab-stops (member j tab-stop-list)) 751 ((and ruler-mode-show-tab-stops (member j tab-stop-list))
732 (aset ruler i ruler-mode-tab-stop-char) 752 (aset ruler i ruler-mode-tab-stop-char)
733 (put-text-property 753 (put-text-property
734 i (1+ i) 'face 'ruler-mode-tab-stop-face 754 i (1+ i) 'face 'ruler-mode-tab-stop
735 ruler))) 755 ruler)))
736 (setq i (1+ i) 756 (setq i (1+ i)
737 j (1+ j))) 757 j (1+ j)))
diff --git a/lisp/ses.el b/lisp/ses.el
index d01a8307ffd..1107f21d510 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -1361,7 +1361,7 @@ execute cell formulas or print functions."
1361 (ses-set-parameter 'ses--file-format 2) 1361 (ses-set-parameter 'ses--file-format 2)
1362 (message "Upgrading from SES-1 file format"))) 1362 (message "Upgrading from SES-1 file format")))
1363 (or (= ses--file-format 2) 1363 (or (= ses--file-format 2)
1364 (error "This file needs a newer version of the SES library code.")) 1364 (error "This file needs a newer version of the SES library code"))
1365 (ses-create-cell-variable-range 0 (1- ses--numrows) 0 (1- ses--numcols)) 1365 (ses-create-cell-variable-range 0 (1- ses--numrows) 0 (1- ses--numcols))
1366 ;;Initialize cell array 1366 ;;Initialize cell array
1367 (setq ses--cells (make-vector ses--numrows nil)) 1367 (setq ses--cells (make-vector ses--numrows nil))
diff --git a/lisp/simple.el b/lisp/simple.el
index cd7a90b5111..bd2de4121d3 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -920,21 +920,21 @@ in *Help* buffer. See also the command `describe-char'."
920(defvar read-expression-history nil) 920(defvar read-expression-history nil)
921 921
922(defcustom eval-expression-print-level 4 922(defcustom eval-expression-print-level 4
923 "*Value to use for `print-level' when printing value in `eval-expression'. 923 "Value for `print-level' while printing value in `eval-expression'.
924A value of nil means no limit." 924A value of nil means no limit."
925 :group 'lisp 925 :group 'lisp
926 :type '(choice (const :tag "No Limit" nil) integer) 926 :type '(choice (const :tag "No Limit" nil) integer)
927 :version "21.1") 927 :version "21.1")
928 928
929(defcustom eval-expression-print-length 12 929(defcustom eval-expression-print-length 12
930 "*Value to use for `print-length' when printing value in `eval-expression'. 930 "Value for `print-length' while printing value in `eval-expression'.
931A value of nil means no limit." 931A value of nil means no limit."
932 :group 'lisp 932 :group 'lisp
933 :type '(choice (const :tag "No Limit" nil) integer) 933 :type '(choice (const :tag "No Limit" nil) integer)
934 :version "21.1") 934 :version "21.1")
935 935
936(defcustom eval-expression-debug-on-error t 936(defcustom eval-expression-debug-on-error t
937 "*Non-nil means set `debug-on-error' when evaluating in `eval-expression'. 937 "If non-nil set `debug-on-error' to t in `eval-expression'.
938If nil, don't change the value of `debug-on-error'." 938If nil, don't change the value of `debug-on-error'."
939 :group 'lisp 939 :group 'lisp
940 :type 'boolean 940 :type 'boolean
@@ -3346,34 +3346,43 @@ Outline mode sets this."
3346 (or (memq prop buffer-invisibility-spec) 3346 (or (memq prop buffer-invisibility-spec)
3347 (assq prop buffer-invisibility-spec))))) 3347 (assq prop buffer-invisibility-spec)))))
3348 3348
3349;; Perform vertical scrolling of tall images if necessary. 3349;; This is like line-move-1 except that it also performs
3350;; Don't vscroll in a keyboard macro. 3350;; vertical scrolling of tall images if appropriate.
3351;; That is not really a clean thing to do, since it mixes
3352;; scrolling with cursor motion. But so far we don't have
3353;; a cleaner solution to the problem of making C-n do something
3354;; useful given a tall image.
3351(defun line-move (arg &optional noerror to-end try-vscroll) 3355(defun line-move (arg &optional noerror to-end try-vscroll)
3352 (if (and auto-window-vscroll try-vscroll 3356 (if (and auto-window-vscroll try-vscroll
3357 ;; But don't vscroll in a keyboard macro.
3353 (not defining-kbd-macro) 3358 (not defining-kbd-macro)
3354 (not executing-kbd-macro)) 3359 (not executing-kbd-macro))
3355 (let ((forward (> arg 0)) 3360 (let ((forward (> arg 0))
3356 (part (nth 2 (pos-visible-in-window-p (point) nil t)))) 3361 (part (nth 2 (pos-visible-in-window-p (point) nil t))))
3357 (if (and (consp part) 3362 (if (and (consp part)
3358 (> (setq part (if forward (cdr part) (car part))) 0)) 3363 (> (if forward (cdr part) (car part)) 0))
3359 (set-window-vscroll nil 3364 (set-window-vscroll nil
3360 (if forward 3365 (if forward
3361 (+ (window-vscroll nil t) 3366 (+ (window-vscroll nil t)
3362 (min part 3367 (min (cdr part)
3363 (* (frame-char-height) arg))) 3368 (* (frame-char-height) arg)))
3364 (max 0 3369 (max 0
3365 (- (window-vscroll nil t) 3370 (- (window-vscroll nil t)
3366 (min part 3371 (min (car part)
3367 (* (frame-char-height) (- arg)))))) 3372 (* (frame-char-height) (- arg))))))
3368 t) 3373 t)
3369 (set-window-vscroll nil 0) 3374 (set-window-vscroll nil 0)
3370 (when (line-move-1 arg noerror to-end) 3375 (when (line-move-1 arg noerror to-end)
3371 (sit-for 0) 3376 (when (not forward)
3372 (if (and (not forward) 3377 ;; Update display before calling pos-visible-in-window-p,
3373 (setq part (nth 2 (pos-visible-in-window-p 3378 ;; because it depends on window-start being up-to-date.
3374 (line-beginning-position) nil t))) 3379 (sit-for 0)
3375 (> (cdr part) 0)) 3380 ;; If the current line is partly hidden at the bottom,
3376 (set-window-vscroll nil (cdr part) t)) 3381 ;; scroll it partially up so as to unhide the bottom.
3382 (if (and (setq part (nth 2 (pos-visible-in-window-p
3383 (line-beginning-position) nil t)))
3384 (> (cdr part) 0))
3385 (set-window-vscroll nil (cdr part) t)))
3377 t))) 3386 t)))
3378 (line-move-1 arg noerror to-end))) 3387 (line-move-1 arg noerror to-end)))
3379 3388
@@ -4835,7 +4844,11 @@ of the differing parts is, by contrast, slightly highlighted."
4835 (- (point) (minibuffer-prompt-end))))) 4844 (- (point) (minibuffer-prompt-end)))))
4836 ;; Otherwise, in minibuffer, the whole input is being completed. 4845 ;; Otherwise, in minibuffer, the whole input is being completed.
4837 (if (minibufferp mainbuf) 4846 (if (minibufferp mainbuf)
4838 (setq completion-base-size 0))) 4847 (if (and (symbolp minibuffer-completion-table)
4848 (get minibuffer-completion-table 'completion-base-size-function))
4849 (setq completion-base-size
4850 (funcall (get minibuffer-completion-table 'completion-base-size-function)))
4851 (setq completion-base-size 0))))
4839 ;; Put faces on first uncommon characters and common parts. 4852 ;; Put faces on first uncommon characters and common parts.
4840 (when completion-base-size 4853 (when completion-base-size
4841 (let* ((common-string-length 4854 (let* ((common-string-length
diff --git a/lisp/skeleton.el b/lisp/skeleton.el
index d4caca3ca42..5f25e881218 100644
--- a/lisp/skeleton.el
+++ b/lisp/skeleton.el
@@ -50,7 +50,7 @@ Typical examples might be `upcase' or `capitalize'.")
50 50
51 51
52(defvar skeleton-autowrap t 52(defvar skeleton-autowrap t
53 "Controls wrapping behaviour of functions created with `define-skeleton'. 53 "Controls wrapping behavior of functions created with `define-skeleton'.
54When the region is visible (due to `transient-mark-mode' or marking a region 54When the region is visible (due to `transient-mark-mode' or marking a region
55with the mouse) and this is non-nil and the function was called without an 55with the mouse) and this is non-nil and the function was called without an
56explicit ARG, then the ARG defaults to -1, i.e. wrapping around the visible 56explicit ARG, then the ARG defaults to -1, i.e. wrapping around the visible
diff --git a/lisp/smerge-mode.el b/lisp/smerge-mode.el
index 0cab4b31404..cf93ad12cd9 100644
--- a/lisp/smerge-mode.el
+++ b/lisp/smerge-mode.el
@@ -75,7 +75,7 @@ Used in `smerge-diff-base-mine' and related functions."
75 :group 'smerge 75 :group 'smerge
76 :type 'boolean) 76 :type 'boolean)
77 77
78(defface smerge-mine-face 78(defface smerge-mine
79 '((((min-colors 88) (background light)) 79 '((((min-colors 88) (background light))
80 (:foreground "blue1")) 80 (:foreground "blue1"))
81 (((background light)) 81 (((background light))
@@ -86,18 +86,22 @@ Used in `smerge-diff-base-mine' and related functions."
86 (:foreground "cyan"))) 86 (:foreground "cyan")))
87 "Face for your code." 87 "Face for your code."
88 :group 'smerge) 88 :group 'smerge)
89(defvar smerge-mine-face 'smerge-mine-face) 89;; backward-compatibility alias
90(put 'smerge-mine-face 'face-alias 'smerge-mine)
91(defvar smerge-mine-face 'smerge-mine)
90 92
91(defface smerge-other-face 93(defface smerge-other
92 '((((background light)) 94 '((((background light))
93 (:foreground "darkgreen")) 95 (:foreground "darkgreen"))
94 (((background dark)) 96 (((background dark))
95 (:foreground "lightgreen"))) 97 (:foreground "lightgreen")))
96 "Face for the other code." 98 "Face for the other code."
97 :group 'smerge) 99 :group 'smerge)
98(defvar smerge-other-face 'smerge-other-face) 100;; backward-compatibility alias
101(put 'smerge-other-face 'face-alias 'smerge-other)
102(defvar smerge-other-face 'smerge-other)
99 103
100(defface smerge-base-face 104(defface smerge-base
101 '((((min-colors 88) (background light)) 105 '((((min-colors 88) (background light))
102 (:foreground "red1")) 106 (:foreground "red1"))
103 (((background light)) 107 (((background light))
@@ -106,16 +110,20 @@ Used in `smerge-diff-base-mine' and related functions."
106 (:foreground "orange"))) 110 (:foreground "orange")))
107 "Face for the base code." 111 "Face for the base code."
108 :group 'smerge) 112 :group 'smerge)
109(defvar smerge-base-face 'smerge-base-face) 113;; backward-compatibility alias
114(put 'smerge-base-face 'face-alias 'smerge-base)
115(defvar smerge-base-face 'smerge-base)
110 116
111(defface smerge-markers-face 117(defface smerge-markers
112 '((((background light)) 118 '((((background light))
113 (:background "grey85")) 119 (:background "grey85"))
114 (((background dark)) 120 (((background dark))
115 (:background "grey30"))) 121 (:background "grey30")))
116 "Face for the conflict markers." 122 "Face for the conflict markers."
117 :group 'smerge) 123 :group 'smerge)
118(defvar smerge-markers-face 'smerge-markers-face) 124;; backward-compatibility alias
125(put 'smerge-markers-face 'face-alias 'smerge-markers)
126(defvar smerge-markers-face 'smerge-markers)
119 127
120(easy-mmode-defmap smerge-basic-map 128(easy-mmode-defmap smerge-basic-map
121 `(("n" . smerge-next) 129 `(("n" . smerge-next)
diff --git a/lisp/strokes.el b/lisp/strokes.el
index f1121d1fee5..644ec2c4f62 100644
--- a/lisp/strokes.el
+++ b/lisp/strokes.el
@@ -1,6 +1,6 @@
1;;; strokes.el --- control Emacs through mouse strokes 1;;; strokes.el --- control Emacs through mouse strokes
2 2
3;; Copyright (C) 1997, 2000, 2002 Free Software Foundation, Inc. 3;; Copyright (C) 1997, 2000, 2002, 2005 Free Software Foundation, Inc.
4 4
5;; Author: David Bakhash <cadet@alum.mit.edu> 5;; Author: David Bakhash <cadet@alum.mit.edu>
6;; Maintainer: FSF 6;; Maintainer: FSF
@@ -1418,10 +1418,12 @@ Encode/decode your strokes with \\[strokes-encode-buffer],
1418;; This is the stuff that will eventually be used for composing letters in 1418;; This is the stuff that will eventually be used for composing letters in
1419;; any language, compression, decompression, graphics, editing, etc. 1419;; any language, compression, decompression, graphics, editing, etc.
1420 1420
1421(defface strokes-char-face '((t (:background "lightgray"))) 1421(defface strokes-char '((t (:background "lightgray")))
1422 "Face for strokes characters." 1422 "Face for strokes characters."
1423 :version "21.1" 1423 :version "21.1"
1424 :group 'strokes) 1424 :group 'strokes)
1425;; backward-compatibility alias
1426(put 'strokes-char-face 'face-alias 'strokes-char)
1425 1427
1426(put 'strokes 'char-table-extra-slots 0) 1428(put 'strokes 'char-table-extra-slots 0)
1427(defconst strokes-char-table (make-char-table 'strokes) ; 1429(defconst strokes-char-table (make-char-table 'strokes) ;
@@ -1695,7 +1697,7 @@ Optional FORCE non-nil will ignore the buffer's read-only status."
1695 (delete-char 1) 1697 (delete-char 1)
1696 (add-text-properties start (point) 1698 (add-text-properties start (point)
1697 (list 'type 'stroke-string 1699 (list 'type 'stroke-string
1698 'face 'strokes-char-face 1700 'face 'strokes-char
1699 'stroke-glyph glyph 1701 'stroke-glyph glyph
1700 'display nil)))) 1702 'display nil))))
1701 (message "Encoding strokes in %s...done" buffer))))) 1703 (message "Encoding strokes in %s...done" buffer)))))
diff --git a/lisp/subr.el b/lisp/subr.el
index b322bce3fb1..2b631b17e20 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -957,6 +957,43 @@ other hooks, such as major mode hooks, can do the job."
957 (append (symbol-value list-var) (list element)) 957 (append (symbol-value list-var) (list element))
958 (cons element (symbol-value list-var)))))) 958 (cons element (symbol-value list-var))))))
959 959
960
961(defun add-to-ordered-list (list-var element &optional order)
962 "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
963The test for presence of ELEMENT is done with `equal'.
964
965The resulting list is reordered so that the elements are in the
966order given by each element's numeric list order. Elements which
967are not symbols, and symbol elements without a numeric list order
968are placed at the end of the list.
969
970If the third optional argument ORDER is non-nil and ELEMENT is
971a symbol, set the symbol's list order to the given value.
972
973The list order for each symbol is stored in LIST-VAR's
974`list-order' property.
975
976The return value is the new value of LIST-VAR."
977 (let* ((ordering (get list-var 'list-order))
978 (cur (and (symbolp element) (assq element ordering))))
979 (when order
980 (unless (symbolp element)
981 (error "cannot specify order for non-symbols"))
982 (if cur
983 (setcdr cur order)
984 (setq cur (cons element order))
985 (setq ordering (cons cur ordering))
986 (put list-var 'list-order ordering)))
987 (add-to-list list-var element)
988 (set list-var (sort (symbol-value list-var)
989 (lambda (a b)
990 (let ((oa (and (symbolp a) (assq a ordering)))
991 (ob (and (symbolp b) (assq b ordering))))
992 (cond
993 ((not oa) nil)
994 ((not ob) t)
995 (t (< (cdr oa) (cdr ob))))))))))
996
960 997
961;;; Load history 998;;; Load history
962 999
@@ -1561,7 +1598,7 @@ Strip text properties from the inserted text according to
1561`yank-excluded-properties'. Otherwise just like (insert STRING). 1598`yank-excluded-properties'. Otherwise just like (insert STRING).
1562 1599
1563If STRING has a non-nil `yank-handler' property on the first character, 1600If STRING has a non-nil `yank-handler' property on the first character,
1564the normal insert behaviour is modified in various ways. The value of 1601the normal insert behavior is modified in various ways. The value of
1565the yank-handler property must be a list with one to five elements 1602the yank-handler property must be a list with one to five elements
1566with the following format: (FUNCTION PARAM NOEXCLUDE UNDO). 1603with the following format: (FUNCTION PARAM NOEXCLUDE UNDO).
1567When FUNCTION is present and non-nil, it is called instead of `insert' 1604When FUNCTION is present and non-nil, it is called instead of `insert'
@@ -1935,6 +1972,7 @@ entered.
1935The result of the `dynamic-completion-table' form is a function 1972The result of the `dynamic-completion-table' form is a function
1936that can be used as the ALIST argument to `try-completion' and 1973that can be used as the ALIST argument to `try-completion' and
1937`all-completion'. See Info node `(elisp)Programmed Completion'." 1974`all-completion'. See Info node `(elisp)Programmed Completion'."
1975 (declare (debug (lambda-expr)))
1938 (let ((win (make-symbol "window")) 1976 (let ((win (make-symbol "window"))
1939 (string (make-symbol "string")) 1977 (string (make-symbol "string"))
1940 (predicate (make-symbol "predicate")) 1978 (predicate (make-symbol "predicate"))
@@ -1956,12 +1994,29 @@ ARGS. FUN must return the completion table that will be stored in VAR.
1956If completion is requested in the minibuffer, FUN will be called in the buffer 1994If completion is requested in the minibuffer, FUN will be called in the buffer
1957from which the minibuffer was entered. The return value of 1995from which the minibuffer was entered. The return value of
1958`lazy-completion-table' must be used to initialize the value of VAR." 1996`lazy-completion-table' must be used to initialize the value of VAR."
1997 (declare (debug (symbol lambda-expr def-body)))
1959 (let ((str (make-symbol "string"))) 1998 (let ((str (make-symbol "string")))
1960 `(dynamic-completion-table 1999 `(dynamic-completion-table
1961 (lambda (,str) 2000 (lambda (,str)
1962 (unless (listp ,var) 2001 (unless (listp ,var)
1963 (setq ,var (funcall ',fun ,@args))) 2002 (setq ,var (,fun ,@args)))
1964 ,var)))) 2003 ,var))))
2004
2005(defmacro complete-in-turn (a b)
2006 "Create a completion table that first tries completion in A and then in B.
2007A and B should not be costly (or side-effecting) expressions."
2008 (declare (debug (def-form def-form)))
2009 `(lambda (string predicate mode)
2010 (cond
2011 ((eq mode t)
2012 (or (all-completions string ,a predicate)
2013 (all-completions string ,b predicate)))
2014 ((eq mode nil)
2015 (or (try-completion string ,a predicate)
2016 (try-completion string ,b predicate)))
2017 (t
2018 (or (test-completion string ,a predicate)
2019 (test-completion string ,b predicate))))))
1965 2020
1966;;; Matching and substitution 2021;;; Matching and substitution
1967 2022
@@ -1982,7 +2037,7 @@ The value returned is the value of the last form in BODY."
1982 '((save-match-data-internal (match-data))) 2037 '((save-match-data-internal (match-data)))
1983 (list 'unwind-protect 2038 (list 'unwind-protect
1984 (cons 'progn body) 2039 (cons 'progn body)
1985 '(set-match-data save-match-data-internal)))) 2040 '(set-match-data save-match-data-internal 'evaporate))))
1986 2041
1987(defun match-string (num &optional string) 2042(defun match-string (num &optional string)
1988 "Return string of text matched by last search. 2043 "Return string of text matched by last search.
diff --git a/lisp/tempo.el b/lisp/tempo.el
index 43f90b64766..49a73ef1098 100644
--- a/lisp/tempo.el
+++ b/lisp/tempo.el
@@ -125,7 +125,7 @@ user for text to insert in the templates"
125 "*Automatically insert current region when there is a `r' in the template 125 "*Automatically insert current region when there is a `r' in the template
126If this variable is nil, `r' elements will be treated just like `p' 126If this variable is nil, `r' elements will be treated just like `p'
127elements, unless the template function is given a prefix (or a non-nil 127elements, unless the template function is given a prefix (or a non-nil
128argument). If this variable is non-nil, the behaviour is reversed. 128argument). If this variable is non-nil, the behavior is reversed.
129 129
130In Transient Mark mode, this option is unused." 130In Transient Mark mode, this option is unused."
131 :type 'boolean 131 :type 'boolean
diff --git a/lisp/term.el b/lisp/term.el
index 47411b5099a..00c1083892e 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -597,7 +597,7 @@ This variable is buffer-local.")
597 "Function to actually send to PROCESS the STRING submitted by user. 597 "Function to actually send to PROCESS the STRING submitted by user.
598Usually this is just 'term-simple-send, but if your mode needs to 598Usually this is just 'term-simple-send, but if your mode needs to
599massage the input string, this is your hook. This is called from 599massage the input string, this is your hook. This is called from
600the user command term-send-input. term-simple-send just sends 600the user command term-send-input. `term-simple-send' just sends
601the string plus a newline.") 601the string plus a newline.")
602 602
603(defcustom term-eol-on-send t 603(defcustom term-eol-on-send t
@@ -888,7 +888,7 @@ is buffer-local.")
888 (while (< i 128) 888 (while (< i 128)
889 (define-key map (make-string 1 i) 'term-send-raw) 889 (define-key map (make-string 1 i) 'term-send-raw)
890 ;; Avoid O and [. They are used in escape sequences for various keys. 890 ;; Avoid O and [. They are used in escape sequences for various keys.
891 (unless (or (eq i ?O) (eq i 91)) 891 (unless (or (eq i ?O) (eq i 91))
892 (define-key esc-map (make-string 1 i) 'term-send-raw-meta)) 892 (define-key esc-map (make-string 1 i) 'term-send-raw-meta))
893 (setq i (1+ i))) 893 (setq i (1+ i)))
894 (dolist (elm (generic-character-list)) 894 (dolist (elm (generic-character-list))
@@ -941,11 +941,11 @@ is buffer-local.")
941 (make-display-table))) 941 (make-display-table)))
942 i) 942 i)
943 ;; avoid changing the display table for ^J 943 ;; avoid changing the display table for ^J
944 (setq i 0) 944 (setq i 0)
945 (while (< i 10) 945 (while (< i 10)
946 (aset dt i (vector i)) 946 (aset dt i (vector i))
947 (setq i (1+ i))) 947 (setq i (1+ i)))
948 (setq i 11) 948 (setq i 11)
949 (while (< i 32) 949 (while (< i 32)
950 (aset dt i (vector i)) 950 (aset dt i (vector i))
951 (setq i (1+ i))) 951 (setq i (1+ i)))
@@ -983,7 +983,7 @@ and `term-scroll-to-bottom-on-output'.
983If you accidentally suspend your process, use \\[term-continue-subjob] 983If you accidentally suspend your process, use \\[term-continue-subjob]
984to continue it. 984to continue it.
985 985
986This mode can be customised to create specific modes for running 986This mode can be customized to create specific modes for running
987particular subprocesses. This can be done by setting the hooks 987particular subprocesses. This can be done by setting the hooks
988`term-input-filter-functions', `term-input-filter', 988`term-input-filter-functions', `term-input-filter',
989`term-input-sender' and `term-get-old-input' to appropriate functions, 989`term-input-sender' and `term-get-old-input' to appropriate functions,
@@ -1273,7 +1273,7 @@ you type \\[term-send-input] which sends the current line to the inferior."
1273(defun term-check-proc (buffer) 1273(defun term-check-proc (buffer)
1274 "True if there is a process associated w/buffer BUFFER, and 1274 "True if there is a process associated w/buffer BUFFER, and
1275it is alive (status RUN or STOP). BUFFER can be either a buffer or the 1275it is alive (status RUN or STOP). BUFFER can be either a buffer or the
1276name of one" 1276name of one."
1277 (let ((proc (get-buffer-process buffer))) 1277 (let ((proc (get-buffer-process buffer)))
1278 (and proc (memq (process-status proc) '(run stop))))) 1278 (and proc (memq (process-status proc) '(run stop)))))
1279 1279
@@ -2088,7 +2088,7 @@ If this takes us past the end of the current line, don't skip at all."
2088(defun term-simple-send (proc string) 2088(defun term-simple-send (proc string)
2089 "Default function for sending to PROC input STRING. 2089 "Default function for sending to PROC input STRING.
2090This just sends STRING plus a newline. To override this, 2090This just sends STRING plus a newline. To override this,
2091set the hook TERM-INPUT-SENDER." 2091set the hook `term-input-sender'."
2092 (term-send-string proc string) 2092 (term-send-string proc string)
2093 (term-send-string proc "\n")) 2093 (term-send-string proc "\n"))
2094 2094
@@ -2180,7 +2180,7 @@ Security bug: your string can still be temporarily recovered with
2180If your process is choking on big inputs, try lowering the value.") 2180If your process is choking on big inputs, try lowering the value.")
2181 2181
2182(defun term-send-string (proc str) 2182(defun term-send-string (proc str)
2183 "Send PROCESS the contents of STRING as input. 2183 "Send to PROC the contents of STR as input.
2184This is equivalent to process-send-string, except that long input strings 2184This is equivalent to process-send-string, except that long input strings
2185are broken up into chunks of size term-input-chunk-size. Processes 2185are broken up into chunks of size term-input-chunk-size. Processes
2186are given a chance to output between chunks. This can help prevent processes 2186are given a chance to output between chunks. This can help prevent processes
@@ -2195,9 +2195,9 @@ from hanging when you send them long inputs on some OS's."
2195 (setq i next-i))))) 2195 (setq i next-i)))))
2196 2196
2197(defun term-send-region (proc start end) 2197(defun term-send-region (proc start end)
2198 "Sends to PROC the region delimited by START and END. 2198 "Send to PROC the region delimited by START and END.
2199This is a replacement for process-send-region that tries to keep 2199This is a replacement for process-send-region that tries to keep
2200your process from hanging on long inputs. See term-send-string." 2200your process from hanging on long inputs. See `term-send-string'."
2201 (term-send-string proc (buffer-substring start end))) 2201 (term-send-string proc (buffer-substring start end)))
2202 2202
2203 2203
@@ -2427,7 +2427,7 @@ See `term-prompt-regexp'."
2427;;; This is pretty stupid about strings. It decides we're in a string 2427;;; This is pretty stupid about strings. It decides we're in a string
2428;;; if there's a quote on both sides of point on the current line. 2428;;; if there's a quote on both sides of point on the current line.
2429(defun term-extract-string () 2429(defun term-extract-string ()
2430 "Returns string around POINT that starts the current line or nil." 2430 "Return string around `point' that starts the current line or nil."
2431 (save-excursion 2431 (save-excursion
2432 (let* ((point (point)) 2432 (let* ((point (point))
2433 (bol (progn (beginning-of-line) (point))) 2433 (bol (progn (beginning-of-line) (point)))
@@ -2601,7 +2601,7 @@ See `term-prompt-regexp'."
2601 2601
2602(defun term-adjust-current-row-cache (delta) 2602(defun term-adjust-current-row-cache (delta)
2603 (when term-current-row 2603 (when term-current-row
2604 (setq term-current-row 2604 (setq term-current-row
2605 (max 0 (+ term-current-row delta))))) 2605 (max 0 (+ term-current-row delta)))))
2606 2606
2607(defun term-terminal-pos () 2607(defun term-terminal-pos ()
@@ -2781,11 +2781,11 @@ See `term-prompt-regexp'."
2781 ;; In insert if the if the current line 2781 ;; In insert if the if the current line
2782 ;; has become too long it needs to be 2782 ;; has become too long it needs to be
2783 ;; chopped off. 2783 ;; chopped off.
2784 (when term-insert-mode 2784 (when term-insert-mode
2785 (setq pos (point)) 2785 (setq pos (point))
2786 (end-of-line) 2786 (end-of-line)
2787 (when (> (current-column) term-width) 2787 (when (> (current-column) term-width)
2788 (delete-region (- (point) (- (current-column) term-width)) 2788 (delete-region (- (point) (- (current-column) term-width))
2789 (point))) 2789 (point)))
2790 (goto-char pos))) 2790 (goto-char pos)))
2791 (setq term-current-column nil) 2791 (setq term-current-column nil)
@@ -2804,15 +2804,15 @@ See `term-prompt-regexp'."
2804 (setq count (term-current-column)) 2804 (setq count (term-current-column))
2805 ;; The line cannot exceed term-width. TAB at 2805 ;; The line cannot exceed term-width. TAB at
2806 ;; the end of a line should not cause wrapping. 2806 ;; the end of a line should not cause wrapping.
2807 (setq count (min term-width 2807 (setq count (min term-width
2808 (+ count 8 (- (mod count 8))))) 2808 (+ count 8 (- (mod count 8)))))
2809 (if (> term-width count) 2809 (if (> term-width count)
2810 (progn 2810 (progn
2811 (term-move-columns 2811 (term-move-columns
2812 (- count (term-current-column))) 2812 (- count (term-current-column)))
2813 (setq term-current-column count)) 2813 (setq term-current-column count))
2814 (when (> term-width (term-current-column)) 2814 (when (> term-width (term-current-column))
2815 (term-move-columns 2815 (term-move-columns
2816 (1- (- term-width (term-current-column))))) 2816 (1- (- term-width (term-current-column)))))
2817 (when (= term-width (term-current-column)) 2817 (when (= term-width (term-current-column))
2818 (term-move-columns -1)))) 2818 (term-move-columns -1))))
@@ -2903,7 +2903,7 @@ See `term-prompt-regexp'."
2903 (term-goto (car term-saved-cursor) 2903 (term-goto (car term-saved-cursor)
2904 (cdr term-saved-cursor))) 2904 (cdr term-saved-cursor)))
2905 (setq term-terminal-state 0)) 2905 (setq term-terminal-state 0))
2906 ((eq char ?c) ;; \Ec - Reset (terminfo: rs1) 2906 ((eq char ?c) ;; \Ec - Reset (terminfo: rs1)
2907 ;; This is used by the "clear" program. 2907 ;; This is used by the "clear" program.
2908 (setq term-terminal-state 0) 2908 (setq term-terminal-state 0)
2909 (term-reset-terminal)) 2909 (term-reset-terminal))
@@ -3035,7 +3035,7 @@ See `term-prompt-regexp'."
3035 (setq term-current-row (1- term-height)))))) 3035 (setq term-current-row (1- term-height))))))
3036 3036
3037;;; Reset the terminal, delete all the content and set the face to the 3037;;; Reset the terminal, delete all the content and set the face to the
3038;;; default one. 3038;;; default one.
3039(defun term-reset-terminal () 3039(defun term-reset-terminal ()
3040 (erase-buffer) 3040 (erase-buffer)
3041 (setq term-current-row 0) 3041 (setq term-current-row 0)
@@ -3189,7 +3189,7 @@ See `term-prompt-regexp'."
3189 ((or (eq char ?H) ; cursor motion (terminfo: cup) 3189 ((or (eq char ?H) ; cursor motion (terminfo: cup)
3190 ;; (eq char ?f) ; xterm seems to handle this sequence too, not 3190 ;; (eq char ?f) ; xterm seems to handle this sequence too, not
3191 ;; needed for now 3191 ;; needed for now
3192 ) 3192 )
3193 (if (<= term-terminal-parameter 0) 3193 (if (<= term-terminal-parameter 0)
3194 (setq term-terminal-parameter 1)) 3194 (setq term-terminal-parameter 1))
3195 (if (<= term-terminal-previous-parameter 0) 3195 (if (<= term-terminal-previous-parameter 0)
@@ -3210,8 +3210,8 @@ See `term-prompt-regexp'."
3210 (term-down (max 1 term-terminal-parameter) t)) 3210 (term-down (max 1 term-terminal-parameter) t))
3211 ;; \E[C - cursor right (terminfo: cuf) 3211 ;; \E[C - cursor right (terminfo: cuf)
3212 ((eq char ?C) 3212 ((eq char ?C)
3213 (term-move-columns 3213 (term-move-columns
3214 (max 1 3214 (max 1
3215 (if (>= (+ term-terminal-parameter (term-current-column)) term-width) 3215 (if (>= (+ term-terminal-parameter (term-current-column)) term-width)
3216 (- term-width (term-current-column) 1) 3216 (- term-width (term-current-column) 1)
3217 term-terminal-parameter)))) 3217 term-terminal-parameter))))
@@ -3252,7 +3252,7 @@ See `term-prompt-regexp'."
3252 )) 3252 ))
3253 3253
3254;;; Modified to allow ansi coloring -mm 3254;;; Modified to allow ansi coloring -mm
3255 ;; \E[m - Set/reset modes, set bg/fg 3255 ;; \E[m - Set/reset modes, set bg/fg
3256 ;;(terminfo: smso,rmso,smul,rmul,rev,bold,sgr0,invis,op,setab,setaf) 3256 ;;(terminfo: smso,rmso,smul,rmul,rev,bold,sgr0,invis,op,setab,setaf)
3257 ((eq char ?m) 3257 ((eq char ?m)
3258 (when (= term-terminal-more-parameters 1) 3258 (when (= term-terminal-more-parameters 1)
@@ -3297,7 +3297,7 @@ The top-most line is line 0."
3297 (not (and (= term-scroll-start 0) 3297 (not (and (= term-scroll-start 0)
3298 (= term-scroll-end term-height))))) 3298 (= term-scroll-end term-height)))))
3299 (term-move-columns (- (term-current-column))) 3299 (term-move-columns (- (term-current-column)))
3300 (term-goto 3300 (term-goto
3301 term-scroll-start (term-current-column))) 3301 term-scroll-start (term-current-column)))
3302 3302
3303;; (defun term-switch-to-alternate-sub-buffer (set) 3303;; (defun term-switch-to-alternate-sub-buffer (set)
@@ -3846,7 +3846,7 @@ directory tracking functions.")
3846 3846
3847 3847
3848(defun term-word (word-chars) 3848(defun term-word (word-chars)
3849 "Return the word of WORD-CHARS at point, or nil if non is found. 3849 "Return the word of WORD-CHARS at point, or nil if none is found.
3850Word constituents are considered to be those in WORD-CHARS, which is like the 3850Word constituents are considered to be those in WORD-CHARS, which is like the
3851inside of a \"[...]\" (see `skip-chars-forward')." 3851inside of a \"[...]\" (see `skip-chars-forward')."
3852 (save-excursion 3852 (save-excursion
@@ -3863,7 +3863,7 @@ inside of a \"[...]\" (see `skip-chars-forward')."
3863 3863
3864 3864
3865(defun term-match-partial-filename () 3865(defun term-match-partial-filename ()
3866 "Return the filename at point, or nil if non is found. 3866 "Return the filename at point, or nil if none is found.
3867Environment variables are substituted. See `term-word'." 3867Environment variables are substituted. See `term-word'."
3868 (let ((filename (term-word "~/A-Za-z0-9+@:_.$#,={}-"))) 3868 (let ((filename (term-word "~/A-Za-z0-9+@:_.$#,={}-")))
3869 (and filename (substitute-in-file-name filename)))) 3869 (and filename (substitute-in-file-name filename))))
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index 5d2cb1afad2..ae36e208bff 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -2187,6 +2187,11 @@ order until succeed.")
2187 ctext 2187 ctext
2188 utf8))))) 2188 utf8)))))
2189 2189
2190;; Get a selection value of type TYPE by calling x-get-selection with
2191;; an appropiate DATA-TYPE argument decidd by `x-select-request-type'.
2192;; The return value is already decoded. If x-get-selection causes an
2193;; error, this function return nil.
2194
2190(defun x-selection-value (type) 2195(defun x-selection-value (type)
2191 (let (text) 2196 (let (text)
2192 (cond ((null x-select-request-type) 2197 (cond ((null x-select-request-type)
@@ -2341,10 +2346,7 @@ order until succeed.")
2341(defun x-clipboard-yank () 2346(defun x-clipboard-yank ()
2342 "Insert the clipboard contents, or the last stretch of killed text." 2347 "Insert the clipboard contents, or the last stretch of killed text."
2343 (interactive) 2348 (interactive)
2344 (let ((clipboard-text 2349 (let ((clipboard-text (x-selection-value 'CLIPBOARD))
2345 (condition-case nil
2346 (x-get-selection 'CLIPBOARD)
2347 (error nil)))
2348 (x-select-enable-clipboard t)) 2350 (x-select-enable-clipboard t))
2349 (if (and clipboard-text (> (length clipboard-text) 0)) 2351 (if (and clipboard-text (> (length clipboard-text) 0))
2350 (kill-new clipboard-text)) 2352 (kill-new clipboard-text))
diff --git a/lisp/terminal.el b/lisp/terminal.el
index 6b055200359..afce6f51287 100644
--- a/lisp/terminal.el
+++ b/lisp/terminal.el
@@ -1089,7 +1089,7 @@ This escape character may be changed using the variable `terminal-escape-char'.
1089 1089
1090`Meta' characters may not currently be sent through the terminal emulator. 1090`Meta' characters may not currently be sent through the terminal emulator.
1091 1091
1092Here is a list of some of the variables which control the behaviour 1092Here is a list of some of the variables which control the behavior
1093of the emulator -- see their documentation for more information: 1093of the emulator -- see their documentation for more information:
1094terminal-escape-char, terminal-scrolling, terminal-more-processing, 1094terminal-escape-char, terminal-scrolling, terminal-more-processing,
1095terminal-redisplay-interval. 1095terminal-redisplay-interval.
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
index 1615da60910..7d4ee6ec00d 100644
--- a/lisp/textmodes/fill.el
+++ b/lisp/textmodes/fill.el
@@ -1,7 +1,7 @@
1;;; fill.el --- fill commands for Emacs -*- coding: iso-2022-7bit -*- 1;;; fill.el --- fill commands for Emacs -*- coding: iso-2022-7bit -*-
2 2
3;; Copyright (C) 1985,86,92,94,95,96,97,1999,2001,02,03,2004 3;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1996, 1997, 1999, 2001, 2002,
4;; Free Software Foundation, Inc. 4;; 2003, 2004, 2005 Free Software Foundation, Inc.
5 5
6;; Maintainer: FSF 6;; Maintainer: FSF
7;; Keywords: wp 7;; Keywords: wp
@@ -115,7 +115,7 @@ if it would act as a paragraph-starter on the second line."
115 115
116(defcustom adaptive-fill-function nil 116(defcustom adaptive-fill-function nil
117 "*Function to call to choose a fill prefix for a paragraph, or nil. 117 "*Function to call to choose a fill prefix for a paragraph, or nil.
118This function is used when `adaptive-fill-regexp' does not match." 118nil means the function has not determined the fill prefix."
119 :type '(choice (const nil) function) 119 :type '(choice (const nil) function)
120 :group 'fill) 120 :group 'fill)
121 121
@@ -205,6 +205,16 @@ Remove indentation from each line."
205 (unless (zerop cmp) 205 (unless (zerop cmp)
206 (substring s1 0 cmp))))) 206 (substring s1 0 cmp)))))
207 207
208(defun fill-match-adaptive-prefix ()
209 (let ((str (or
210 (and adaptive-fill-function (funcall adaptive-fill-function))
211 (and adaptive-fill-regexp (looking-at adaptive-fill-regexp)
212 (match-string-no-properties 0)))))
213 (if (>= (+ (current-left-margin) (length str)) (current-fill-column))
214 ;; Death to insanely long prefixes.
215 nil
216 str)))
217
208(defun fill-context-prefix (from to &optional first-line-regexp) 218(defun fill-context-prefix (from to &optional first-line-regexp)
209 "Compute a fill prefix from the text between FROM and TO. 219 "Compute a fill prefix from the text between FROM and TO.
210This uses the variables `adaptive-fill-regexp' and `adaptive-fill-function' 220This uses the variables `adaptive-fill-regexp' and `adaptive-fill-function'
@@ -218,55 +228,45 @@ act as a paragraph-separator."
218 (if (eolp) (forward-line 1)) 228 (if (eolp) (forward-line 1))
219 ;; Move to the second line unless there is just one. 229 ;; Move to the second line unless there is just one.
220 (move-to-left-margin) 230 (move-to-left-margin)
221 (let ((firstline (point)) 231 (let (first-line-prefix
222 first-line-prefix
223 ;; Non-nil if we are on the second line. 232 ;; Non-nil if we are on the second line.
224 second-line-prefix 233 second-line-prefix)
225 start)
226 (setq start (point))
227 (setq first-line-prefix 234 (setq first-line-prefix
228 ;; We don't need to consider `paragraph-start' here since it 235 ;; We don't need to consider `paragraph-start' here since it
229 ;; will be explicitly checked later on. 236 ;; will be explicitly checked later on.
230 ;; Also setting first-line-prefix to nil prevents 237 ;; Also setting first-line-prefix to nil prevents
231 ;; second-line-prefix from being used. 238 ;; second-line-prefix from being used.
232 (cond ;; ((looking-at paragraph-start) nil) 239 ;; ((looking-at paragraph-start) nil)
233 ((and adaptive-fill-regexp (looking-at adaptive-fill-regexp)) 240 (fill-match-adaptive-prefix))
234 (match-string-no-properties 0))
235 (adaptive-fill-function (funcall adaptive-fill-function))))
236 (forward-line 1) 241 (forward-line 1)
237 (if (< (point) to) 242 (if (< (point) to)
238 (progn 243 (progn
239 (move-to-left-margin) 244 (move-to-left-margin)
240 (setq start (point)) 245 (setq second-line-prefix
241 (setq second-line-prefix 246 (cond ((looking-at paragraph-start) nil) ;Can it happen? -Stef
242 (cond ((looking-at paragraph-start) nil) ;Can it happen ? -stef 247 (t (fill-match-adaptive-prefix))))
243 ((and adaptive-fill-regexp 248 ;; If we get a fill prefix from the second line,
244 (looking-at adaptive-fill-regexp)) 249 ;; make sure it or something compatible is on the first line too.
245 (buffer-substring-no-properties start (match-end 0))) 250 (when second-line-prefix
246 (adaptive-fill-function 251 (unless first-line-prefix (setq first-line-prefix ""))
247 (funcall adaptive-fill-function)))) 252 ;; If the non-whitespace chars match the first line,
248 ;; If we get a fill prefix from the second line, 253 ;; just use it (this subsumes the 2 checks used previously).
249 ;; make sure it or something compatible is on the first line too. 254 ;; Used when first line is `/* ...' and second-line is
250 (when second-line-prefix 255 ;; ` * ...'.
251 (unless first-line-prefix (setq first-line-prefix "")) 256 (let ((tmp second-line-prefix)
252 ;; If the non-whitespace chars match the first line, 257 (re "\\`"))
253 ;; just use it (this subsumes the 2 checks used previously). 258 (while (string-match "\\`[ \t]*\\([^ \t]+\\)" tmp)
254 ;; Used when first line is `/* ...' and second-line is 259 (setq re (concat re ".*" (regexp-quote (match-string 1 tmp))))
255 ;; ` * ...'. 260 (setq tmp (substring tmp (match-end 0))))
256 (let ((tmp second-line-prefix) 261 ;; (assert (string-match "\\`[ \t]*\\'" tmp))
257 (re "\\`")) 262
258 (while (string-match "\\`[ \t]*\\([^ \t]+\\)" tmp) 263 (if (string-match re first-line-prefix)
259 (setq re (concat re ".*" (regexp-quote (match-string 1 tmp)))) 264 second-line-prefix
260 (setq tmp (substring tmp (match-end 0)))) 265
261 ;; (assert (string-match "\\`[ \t]*\\'" tmp)) 266 ;; Use the longest common substring of both prefixes,
262 267 ;; if there is one.
263 (if (string-match re first-line-prefix) 268 (fill-common-string-prefix first-line-prefix
264 second-line-prefix 269 second-line-prefix)))))
265
266 ;; Use the longest common substring of both prefixes,
267 ;; if there is one.
268 (fill-common-string-prefix first-line-prefix
269 second-line-prefix)))))
270 ;; If we get a fill prefix from a one-line paragraph, 270 ;; If we get a fill prefix from a one-line paragraph,
271 ;; maybe change it to whitespace, 271 ;; maybe change it to whitespace,
272 ;; and check that it isn't a paragraph starter. 272 ;; and check that it isn't a paragraph starter.
@@ -333,7 +333,7 @@ be tested. If it returns t, fill commands do not break the line there."
333Can be customized with the variables `fill-nobreak-predicate' 333Can be customized with the variables `fill-nobreak-predicate'
334and `fill-nobreak-invisible'." 334and `fill-nobreak-invisible'."
335 (or 335 (or
336 (and fill-nobreak-invisible (line-move-invisible (point))) 336 (and fill-nobreak-invisible (line-move-invisible-p (point)))
337 (unless (bolp) 337 (unless (bolp)
338 (or 338 (or
339 ;; Don't break after a period followed by just one space. 339 ;; Don't break after a period followed by just one space.
@@ -1128,8 +1128,6 @@ otherwise it is made canonical."
1128 ncols ; new indent point or offset 1128 ncols ; new indent point or offset
1129 (nspaces 0) ; number of spaces between words 1129 (nspaces 0) ; number of spaces between words
1130 ; in line (not space characters) 1130 ; in line (not space characters)
1131 fracspace ; fractional amount of space to be
1132 ; added between each words
1133 (curr-fracspace 0) ; current fractional space amount 1131 (curr-fracspace 0) ; current fractional space amount
1134 count) 1132 count)
1135 (end-of-line) 1133 (end-of-line)
@@ -1338,7 +1336,7 @@ Also, if CITATION-REGEXP is non-nil, don't fill header lines."
1338 (forward-line 1)))) 1336 (forward-line 1))))
1339 (narrow-to-region (point) max) 1337 (narrow-to-region (point) max)
1340 ;; Loop over paragraphs. 1338 ;; Loop over paragraphs.
1341 (while (let ((here (point))) 1339 (while (progn
1342 ;; Skip over all paragraph-separating lines 1340 ;; Skip over all paragraph-separating lines
1343 ;; so as to not include them in any paragraph. 1341 ;; so as to not include them in any paragraph.
1344 (while (and (not (eobp)) 1342 (while (and (not (eobp))
@@ -1446,5 +1444,5 @@ Also, if CITATION-REGEXP is non-nil, don't fill header lines."
1446 "") 1444 "")
1447 string)) 1445 string))
1448 1446
1449;;; arch-tag: 727ad455-1161-4fa9-8df5-0f74b179216d 1447;; arch-tag: 727ad455-1161-4fa9-8df5-0f74b179216d
1450;;; fill.el ends here 1448;;; fill.el ends here
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index 0b65993df3c..8c2d0937a5a 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -94,7 +94,7 @@ Non-nil means use highlight, nil means use minibuffer messages."
94 "*The maximum distance for finding duplicates of unrecognized words. 94 "*The maximum distance for finding duplicates of unrecognized words.
95This applies to the feature that when a word is not found in the dictionary, 95This applies to the feature that when a word is not found in the dictionary,
96if the same spelling occurs elsewhere in the buffer, 96if the same spelling occurs elsewhere in the buffer,
97Flyspell uses a different face (`flyspell-duplicate-face') to highlight it. 97Flyspell uses a different face (`flyspell-duplicate') to highlight it.
98This variable specifies how far to search to find such a duplicate. 98This variable specifies how far to search to find such a duplicate.
99-1 means no limit (search the whole buffer). 99-1 means no limit (search the whole buffer).
1000 means do not search for duplicate unrecognized spellings." 1000 means do not search for duplicate unrecognized spellings."
@@ -172,7 +172,7 @@ command was not the very same command."
172 "*List of functions to be called when incorrect words are encountered. 172 "*List of functions to be called when incorrect words are encountered.
173Each function is given three arguments: the beginning and the end 173Each function is given three arguments: the beginning and the end
174of the incorrect region. The third is either the symbol 'doublon' or the list 174of the incorrect region. The third is either the symbol 'doublon' or the list
175of possible corrections as returned by 'ispell-parse-output'. 175of possible corrections as returned by `ispell-parse-output'.
176 176
177If any of the functions return non-Nil, the word is not highlighted as 177If any of the functions return non-Nil, the word is not highlighted as
178incorrect." 178incorrect."
@@ -228,7 +228,6 @@ http://strw.leidenuniv.nl/~dominik/Tools"
228 :version "21.1" 228 :version "21.1"
229 :type 'boolean) 229 :type 'boolean)
230 230
231;;;###autoload
232(defcustom flyspell-mode-line-string " Fly" 231(defcustom flyspell-mode-line-string " Fly"
233 "*String displayed on the modeline when flyspell is active. 232 "*String displayed on the modeline when flyspell is active.
234Set this to nil if you don't want a modeline indicator." 233Set this to nil if you don't want a modeline indicator."
@@ -268,11 +267,7 @@ If `flyspell-large-region' is nil, all regions are treated as small."
268 :type 'boolean) 267 :type 'boolean)
269 268
270(defcustom flyspell-auto-correct-binding 269(defcustom flyspell-auto-correct-binding
271 (cond 270 [(control ?\;)]
272 ((eq flyspell-emacs 'xemacs)
273 [(control \;)])
274 (t
275 [?\C-\;]))
276 "The key binding for flyspell auto correction." 271 "The key binding for flyspell auto correction."
277 :group 'flyspell) 272 :group 'flyspell)
278 273
@@ -410,10 +405,6 @@ property of the major mode name.")
410;*---------------------------------------------------------------------*/ 405;*---------------------------------------------------------------------*/
411(eval-when-compile (defvar flyspell-local-mouse-map)) 406(eval-when-compile (defvar flyspell-local-mouse-map))
412 407
413;;;###autoload
414(defvar flyspell-mode nil)
415(make-variable-buffer-local 'flyspell-mode)
416
417(defvar flyspell-mouse-map 408(defvar flyspell-mouse-map
418 (let ((map (make-sparse-keymap))) 409 (let ((map (make-sparse-keymap)))
419 (if flyspell-use-meta-tab 410 (if flyspell-use-meta-tab
@@ -425,26 +416,18 @@ property of the major mode name.")
425 (define-key map [(control \.)] 'flyspell-auto-correct-word) 416 (define-key map [(control \.)] 'flyspell-auto-correct-word)
426 map)) 417 map))
427 418
428;;;###autoload 419(defvar flyspell-mode-map
429(defvar flyspell-mode-map (make-sparse-keymap)) 420 (let ((map (make-sparse-keymap)))
430 421 ;; mouse, keyboard bindings and misc definition
431;; mouse, keyboard bindings and misc definition 422 (if flyspell-use-meta-tab
432(when (or (assoc 'flyspell-mode minor-mode-map-alist) 423 (define-key map "\M-\t" 'flyspell-auto-correct-word))
433 (setq minor-mode-map-alist 424 (cond
434 (cons (cons 'flyspell-mode flyspell-mode-map) 425 ;; I don't understand this test, so I left it as is. --Stef
435 minor-mode-map-alist))) 426 ((or (featurep 'xemacs) flyspell-use-local-map)
436 (if flyspell-use-meta-tab 427 (define-key map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word)
437 (define-key flyspell-mode-map "\M-\t" 'flyspell-auto-correct-word)) 428 (define-key map [(control ?\,)] 'flyspell-goto-next-error)
438 (cond 429 (define-key map [(control ?\.)] 'flyspell-auto-correct-word)))
439 ((eq flyspell-emacs 'xemacs) 430 map))
440 (define-key flyspell-mode-map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word)
441 (define-key flyspell-mode-map [(control \,)] 'flyspell-goto-next-error)
442 (define-key flyspell-mode-map [(control \.)] 'flyspell-auto-correct-word))
443 (flyspell-use-local-map
444 (define-key flyspell-mode-map flyspell-auto-correct-binding 'flyspell-auto-correct-previous-word)
445 (define-key flyspell-mode-map [?\C-\,] 'flyspell-goto-next-error)
446 (define-key flyspell-mode-map [?\C-\.] 'flyspell-auto-correct-word))))
447
448 431
449;; the name of the overlay property that defines the keymap 432;; the name of the overlay property that defines the keymap
450(defvar flyspell-overlay-keymap-property-name 'keymap) 433(defvar flyspell-overlay-keymap-property-name 'keymap)
@@ -461,24 +444,22 @@ property of the major mode name.")
461;*---------------------------------------------------------------------*/ 444;*---------------------------------------------------------------------*/
462;* Highlighting */ 445;* Highlighting */
463;*---------------------------------------------------------------------*/ 446;*---------------------------------------------------------------------*/
464(defface flyspell-incorrect-face 447(defface flyspell-incorrect
465 (if (eq flyspell-emacs 'xemacs) 448 '((((class color)) (:foreground "OrangeRed" :bold t :underline t))
466 '((((class color)) (:foreground "OrangeRed" :bold t :underline t)) 449 (t (:bold t)))
467 (t (:bold t)))
468 '((((class color)) (:foreground "OrangeRed" :weight bold :underline t))
469 (t (:weight bold))))
470 "Face used for marking a misspelled word in Flyspell." 450 "Face used for marking a misspelled word in Flyspell."
471 :group 'flyspell) 451 :group 'flyspell)
452;; backward-compatibility alias
453(put 'flyspell-incorrect-face 'face-alias 'flyspell-incorrect)
472 454
473(defface flyspell-duplicate-face 455(defface flyspell-duplicate
474 (if (eq flyspell-emacs 'xemacs) 456 '((((class color)) (:foreground "Gold3" :bold t :underline t))
475 '((((class color)) (:foreground "Gold3" :bold t :underline t)) 457 (t (:bold t)))
476 (t (:bold t)))
477 '((((class color)) (:foreground "Gold3" :weight bold :underline t))
478 (t (:weight bold))))
479 "Face used for marking a misspelled word that appears twice in the buffer. 458 "Face used for marking a misspelled word that appears twice in the buffer.
480See also `flyspell-duplicate-distance'." 459See also `flyspell-duplicate-distance'."
481 :group 'flyspell) 460 :group 'flyspell)
461;; backward-compatibility alias
462(put 'flyspell-duplicate-face 'face-alias 'flyspell-duplicate)
482 463
483(defvar flyspell-overlay nil) 464(defvar flyspell-overlay nil)
484 465
@@ -486,7 +467,7 @@ See also `flyspell-duplicate-distance'."
486;* flyspell-mode ... */ 467;* flyspell-mode ... */
487;*---------------------------------------------------------------------*/ 468;*---------------------------------------------------------------------*/
488;;;###autoload 469;;;###autoload
489(defun flyspell-mode (&optional arg) 470(define-minor-mode flyspell-mode
490 "Minor mode performing on-the-fly spelling checking. 471 "Minor mode performing on-the-fly spelling checking.
491This spawns a single Ispell process and checks each word. 472This spawns a single Ispell process and checks each word.
492The default flyspell behavior is to highlight incorrect words. 473The default flyspell behavior is to highlight incorrect words.
@@ -514,28 +495,12 @@ in your .emacs file.
514 495
515\\[flyspell-region] checks all words inside a region. 496\\[flyspell-region] checks all words inside a region.
516\\[flyspell-buffer] checks the whole buffer." 497\\[flyspell-buffer] checks the whole buffer."
517 (interactive "P") 498 :lighter flyspell-mode-line-string
518 (let ((old-flyspell-mode flyspell-mode)) 499 :keymap flyspell-mode-map
519 ;; Mark the mode as on or off. 500 :group 'flyspell
520 (setq flyspell-mode (not (or (and (null arg) flyspell-mode) 501 (if flyspell-mode
521 (<= (prefix-numeric-value arg) 0)))) 502 (flyspell-mode-on)
522 ;; Do the real work. 503 (flyspell-mode-off)))
523 (unless (eq flyspell-mode old-flyspell-mode)
524 (if flyspell-mode
525 (flyspell-mode-on)
526 (flyspell-mode-off))
527 ;; Force modeline redisplay.
528 (set-buffer-modified-p (buffer-modified-p)))))
529
530;*---------------------------------------------------------------------*/
531;* Autoloading */
532;*---------------------------------------------------------------------*/
533;;;###autoload
534(add-minor-mode 'flyspell-mode
535 'flyspell-mode-line-string
536 flyspell-mode-map
537 nil
538 'flyspell-mode)
539 504
540;*---------------------------------------------------------------------*/ 505;*---------------------------------------------------------------------*/
541;* flyspell-buffers ... */ 506;* flyspell-buffers ... */
@@ -579,7 +544,7 @@ in your .emacs file.
579;*---------------------------------------------------------------------*/ 544;*---------------------------------------------------------------------*/
580(defun flyspell-mode-on () 545(defun flyspell-mode-on ()
581 "Turn Flyspell mode on. Do not use this; use `flyspell-mode' instead." 546 "Turn Flyspell mode on. Do not use this; use `flyspell-mode' instead."
582 (setq ispell-highlight-face 'flyspell-incorrect-face) 547 (setq ispell-highlight-face 'flyspell-incorrect)
583 ;; local dictionaries setup 548 ;; local dictionaries setup
584 (or ispell-local-dictionary ispell-dictionary 549 (or ispell-local-dictionary ispell-dictionary
585 (if flyspell-default-dictionary 550 (if flyspell-default-dictionary
@@ -830,9 +795,7 @@ Mostly we check word delimiters."
830 ((get this-command 'flyspell-delayed) 795 ((get this-command 'flyspell-delayed)
831 ;; the current command is not delayed, that 796 ;; the current command is not delayed, that
832 ;; is that we must check the word now 797 ;; is that we must check the word now
833 (if (fboundp 'about-xemacs) 798 (sit-for flyspell-delay))
834 (sit-for flyspell-delay nil)
835 (sit-for flyspell-delay 0 nil)))
836 (t t))) 799 (t t)))
837 (t t))) 800 (t t)))
838 801
@@ -1019,7 +982,7 @@ Mostly we check word delimiters."
1019 (setq r p) 982 (setq r p)
1020 (goto-char p)))) 983 (goto-char p))))
1021 r))) 984 r)))
1022 985
1023;*---------------------------------------------------------------------*/ 986;*---------------------------------------------------------------------*/
1024;* flyspell-word-search-forward ... */ 987;* flyspell-word-search-forward ... */
1025;*---------------------------------------------------------------------*/ 988;*---------------------------------------------------------------------*/
@@ -1033,7 +996,7 @@ Mostly we check word delimiters."
1033 (setq r p) 996 (setq r p)
1034 (goto-char (1+ p))))) 997 (goto-char (1+ p)))))
1035 r))) 998 r)))
1036 999
1037;*---------------------------------------------------------------------*/ 1000;*---------------------------------------------------------------------*/
1038;* flyspell-word ... */ 1001;* flyspell-word ... */
1039;*---------------------------------------------------------------------*/ 1002;*---------------------------------------------------------------------*/
@@ -1059,12 +1022,11 @@ Mostly we check word delimiters."
1059 (cond 1022 (cond
1060 ((and (or (not (eq ispell-parser 'tex)) 1023 ((and (or (not (eq ispell-parser 'tex))
1061 (and (> start (point-min)) 1024 (and (> start (point-min))
1062 (not (eq (char-after (1- start)) ?})) 1025 (not (memq (char-after (1- start)) '(?\} ?\\)))))
1063 (not (eq (char-after (1- start)) ?\\))))
1064 flyspell-mark-duplications-flag 1026 flyspell-mark-duplications-flag
1065 (save-excursion 1027 (save-excursion
1066 (goto-char (1- start)) 1028 (goto-char (1- start))
1067 (let ((p (flyspell-word-search-backward 1029 (let ((p (flyspell-word-search-backward
1068 word 1030 word
1069 (- start (1+ (- end start)))))) 1031 (- start (1+ (- end start))))))
1070 (and p (/= p (1- start)))))) 1032 (and p (/= p (1- start))))))
@@ -1164,7 +1126,7 @@ Mostly we check word delimiters."
1164 (flyspell-notify-misspell start end word poss)) 1126 (flyspell-notify-misspell start end word poss))
1165 nil)))) 1127 nil))))
1166 ;; return to original location 1128 ;; return to original location
1167 (goto-char cursor-location) 1129 (goto-char cursor-location)
1168 (if ispell-quit (setq ispell-quit nil)) 1130 (if ispell-quit (setq ispell-quit nil))
1169 res)))))))) 1131 res))))))))
1170 1132
@@ -1183,20 +1145,21 @@ Mostly we check word delimiters."
1183;* time that function is called. */ 1145;* time that function is called. */
1184;*---------------------------------------------------------------------*/ 1146;*---------------------------------------------------------------------*/
1185(defun flyspell-math-tex-command-p () 1147(defun flyspell-math-tex-command-p ()
1186 (cond 1148 (when (fboundp 'texmathp)
1187 (flyspell-check-tex-math-command 1149 (cond
1188 nil) 1150 (flyspell-check-tex-math-command
1189 ((eq flyspell-tex-math-initialized t) 1151 nil)
1190 (texmathp)) 1152 ((eq flyspell-tex-math-initialized t)
1191 ((eq flyspell-tex-math-initialized 'error) 1153 (texmathp))
1192 nil) 1154 ((eq flyspell-tex-math-initialized 'error)
1193 (t 1155 nil)
1194 (setq flyspell-tex-math-initialized t) 1156 (t
1195 (condition-case nil 1157 (setq flyspell-tex-math-initialized t)
1196 (texmathp) 1158 (condition-case nil
1197 (error (progn 1159 (texmathp)
1198 (setq flyspell-tex-math-initialized 'error) 1160 (error (progn
1199 nil)))))) 1161 (setq flyspell-tex-math-initialized 'error)
1162 nil)))))))
1200 1163
1201;*---------------------------------------------------------------------*/ 1164;*---------------------------------------------------------------------*/
1202;* flyspell-tex-command-p ... */ 1165;* flyspell-tex-command-p ... */
@@ -1383,9 +1346,7 @@ Word syntax described by `flyspell-dictionary-alist' (which see)."
1383 (let ((buffer flyspell-external-ispell-buffer)) 1346 (let ((buffer flyspell-external-ispell-buffer))
1384 (set-buffer buffer) 1347 (set-buffer buffer)
1385 (goto-char (point-min)) 1348 (goto-char (point-min))
1386 (let ((size (- flyspell-large-region-end flyspell-large-region-beg)) 1349 (let ((pword "")
1387 (start flyspell-large-region-beg)
1388 (pword "")
1389 (pcount 1)) 1350 (pcount 1))
1390 ;; now we are done with ispell, we have to find the word in 1351 ;; now we are done with ispell, we have to find the word in
1391 ;; the initial buffer 1352 ;; the initial buffer
@@ -1613,7 +1574,7 @@ for the overlay."
1613 (overlay-put flyspell-overlay 1574 (overlay-put flyspell-overlay
1614 flyspell-overlay-keymap-property-name 1575 flyspell-overlay-keymap-property-name
1615 flyspell-mouse-map)) 1576 flyspell-mouse-map))
1616 (when (eq face 'flyspell-incorrect-face) 1577 (when (eq face 'flyspell-incorrect)
1617 (and (stringp flyspell-before-incorrect-word-string) 1578 (and (stringp flyspell-before-incorrect-word-string)
1618 (overlay-put flyspell-overlay 'before-string 1579 (overlay-put flyspell-overlay 'before-string
1619 flyspell-before-incorrect-word-string)) 1580 flyspell-before-incorrect-word-string))
@@ -1653,7 +1614,7 @@ for the overlay."
1653 ;; now we can use a new overlay 1614 ;; now we can use a new overlay
1654 (setq flyspell-overlay 1615 (setq flyspell-overlay
1655 (make-flyspell-overlay 1616 (make-flyspell-overlay
1656 beg end 'flyspell-incorrect-face 'highlight))))))) 1617 beg end 'flyspell-incorrect 'highlight)))))))
1657 1618
1658;*---------------------------------------------------------------------*/ 1619;*---------------------------------------------------------------------*/
1659;* flyspell-highlight-duplicate-region ... */ 1620;* flyspell-highlight-duplicate-region ... */
@@ -1679,7 +1640,7 @@ for the overlay."
1679 ;; now we can use a new overlay 1640 ;; now we can use a new overlay
1680 (setq flyspell-overlay 1641 (setq flyspell-overlay
1681 (make-flyspell-overlay beg end 1642 (make-flyspell-overlay beg end
1682 'flyspell-duplicate-face 1643 'flyspell-duplicate
1683 'highlight))))))) 1644 'highlight)))))))
1684 1645
1685;*---------------------------------------------------------------------*/ 1646;*---------------------------------------------------------------------*/
@@ -1741,8 +1702,7 @@ misspelled words backwards."
1741 (let ((num (car pos))) 1702 (let ((num (car pos)))
1742 (put-text-property num 1703 (put-text-property num
1743 (+ num (length flyspell-auto-correct-word)) 1704 (+ num (length flyspell-auto-correct-word))
1744 'face 1705 'face 'flyspell-incorrect
1745 'flyspell-incorrect-face
1746 string)) 1706 string))
1747 (setq pos (cdr pos))) 1707 (setq pos (cdr pos)))
1748 (if (fboundp 'display-message) 1708 (if (fboundp 'display-message)
@@ -1879,7 +1839,7 @@ This command proposes various successive corrections for the current word."
1879(defun flyspell-auto-correct-previous-hook () 1839(defun flyspell-auto-correct-previous-hook ()
1880 "Hook to track successive calls to `flyspell-auto-correct-previous-word'. 1840 "Hook to track successive calls to `flyspell-auto-correct-previous-word'.
1881Sets `flyspell-auto-correct-previous-pos' to nil" 1841Sets `flyspell-auto-correct-previous-pos' to nil"
1882 (interactive) 1842 (interactive)
1883 (remove-hook 'pre-command-hook (function flyspell-auto-correct-previous-hook) t) 1843 (remove-hook 'pre-command-hook (function flyspell-auto-correct-previous-hook) t)
1884 (unless (eq this-command (function flyspell-auto-correct-previous-word)) 1844 (unless (eq this-command (function flyspell-auto-correct-previous-word))
1885 (setq flyspell-auto-correct-previous-pos nil))) 1845 (setq flyspell-auto-correct-previous-pos nil)))
@@ -1887,7 +1847,7 @@ Sets `flyspell-auto-correct-previous-pos' to nil"
1887;*---------------------------------------------------------------------*/ 1847;*---------------------------------------------------------------------*/
1888;* flyspell-auto-correct-previous-word ... */ 1848;* flyspell-auto-correct-previous-word ... */
1889;*---------------------------------------------------------------------*/ 1849;*---------------------------------------------------------------------*/
1890(defun flyspell-auto-correct-previous-word (position) 1850(defun flyspell-auto-correct-previous-word (position)
1891 "*Auto correct the first mispelled word that occurs before point. 1851 "*Auto correct the first mispelled word that occurs before point.
1892But don't look beyond what's visible on the screen." 1852But don't look beyond what's visible on the screen."
1893 (interactive "d") 1853 (interactive "d")
@@ -1903,29 +1863,29 @@ But don't look beyond what's visible on the screen."
1903 (narrow-to-region top bot) 1863 (narrow-to-region top bot)
1904 (overlay-recenter (point)) 1864 (overlay-recenter (point))
1905 1865
1906 (add-hook 'pre-command-hook 1866 (add-hook 'pre-command-hook
1907 (function flyspell-auto-correct-previous-hook) t t) 1867 (function flyspell-auto-correct-previous-hook) t t)
1908 1868
1909 (unless flyspell-auto-correct-previous-pos 1869 (unless flyspell-auto-correct-previous-pos
1910 ;; only reset if a new overlay exists 1870 ;; only reset if a new overlay exists
1911 (setq flyspell-auto-correct-previous-pos nil) 1871 (setq flyspell-auto-correct-previous-pos nil)
1912 1872
1913 (let ((overlay-list (overlays-in (point-min) position)) 1873 (let ((overlay-list (overlays-in (point-min) position))
1914 (new-overlay 'dummy-value)) 1874 (new-overlay 'dummy-value))
1915 1875
1916 ;; search for previous (new) flyspell overlay 1876 ;; search for previous (new) flyspell overlay
1917 (while (and new-overlay 1877 (while (and new-overlay
1918 (or (not (flyspell-overlay-p new-overlay)) 1878 (or (not (flyspell-overlay-p new-overlay))
1919 ;; check if its face has changed 1879 ;; check if its face has changed
1920 (not (eq (get-char-property 1880 (not (eq (get-char-property
1921 (overlay-start new-overlay) 'face) 1881 (overlay-start new-overlay) 'face)
1922 'flyspell-incorrect-face)))) 1882 'flyspell-incorrect))))
1923 (setq new-overlay (car-safe overlay-list)) 1883 (setq new-overlay (car-safe overlay-list))
1924 (setq overlay-list (cdr-safe overlay-list))) 1884 (setq overlay-list (cdr-safe overlay-list)))
1925 1885
1926 ;; if nothing new exits new-overlay should be nil 1886 ;; if nothing new exits new-overlay should be nil
1927 (if new-overlay ;; the length of the word may change so go to the start 1887 (if new-overlay ;; the length of the word may change so go to the start
1928 (setq flyspell-auto-correct-previous-pos 1888 (setq flyspell-auto-correct-previous-pos
1929 (overlay-start new-overlay))))) 1889 (overlay-start new-overlay)))))
1930 1890
1931 (when flyspell-auto-correct-previous-pos 1891 (when flyspell-auto-correct-previous-pos
@@ -1956,7 +1916,7 @@ The word checked is the word at the mouse position."
1956 (let ((start (car (cdr word))) 1916 (let ((start (car (cdr word)))
1957 (end (car (cdr (cdr word)))) 1917 (end (car (cdr (cdr word))))
1958 (word (car word)) 1918 (word (car word))
1959 poss replace) 1919 poss)
1960 ;; now check spelling of word. 1920 ;; now check spelling of word.
1961 (process-send-string ispell-process "%\n") ;put in verbose mode 1921 (process-send-string ispell-process "%\n") ;put in verbose mode
1962 (process-send-string ispell-process (concat "^" word "\n")) 1922 (process-send-string ispell-process (concat "^" word "\n"))
@@ -1974,89 +1934,65 @@ The word checked is the word at the mouse position."
1974 ((null poss) 1934 ((null poss)
1975 ;; ispell error 1935 ;; ispell error
1976 (error "Ispell: error in Ispell process")) 1936 (error "Ispell: error in Ispell process"))
1977 ((string-match "GNU" (emacs-version)) 1937 ((featurep 'xemacs)
1978 ;; the word is incorrect, we have to propose a replacement
1979 (setq replace (flyspell-emacs-popup event poss word))
1980 (cond ((eq replace 'ignore)
1981 (goto-char save)
1982 nil)
1983 ((eq replace 'save)
1984 (goto-char save)
1985 (process-send-string ispell-process
1986 (concat "*" word "\n"))
1987 (flyspell-unhighlight-at cursor-location)
1988 (setq ispell-pdict-modified-p '(t)))
1989 ((or (eq replace 'buffer) (eq replace 'session))
1990 (process-send-string ispell-process
1991 (concat "@" word "\n"))
1992 (if (null ispell-pdict-modified-p)
1993 (setq ispell-pdict-modified-p
1994 (list ispell-pdict-modified-p)))
1995 (flyspell-unhighlight-at cursor-location)
1996 (goto-char save)
1997 (if (eq replace 'buffer)
1998 (ispell-add-per-file-word-list word)))
1999 (replace
2000 (flyspell-unhighlight-at cursor-location)
2001 (let ((new-word (if (atom replace)
2002 replace
2003 (car replace)))
2004 (cursor-location
2005 (+ (- (length word) (- end start))
2006 cursor-location)))
2007 (if (not (equal new-word (car poss)))
2008 (let ((old-max (point-max)))
2009 (delete-region start end)
2010 (funcall flyspell-insert-function new-word)
2011 (if flyspell-abbrev-p
2012 (flyspell-define-abbrev word new-word))
2013 (flyspell-ajust-cursor-point save
2014 cursor-location
2015 old-max)))))
2016 (t
2017 (goto-char save)
2018 nil)))
2019 ((eq flyspell-emacs 'xemacs)
2020 (flyspell-xemacs-popup 1938 (flyspell-xemacs-popup
2021 event poss word cursor-location start end save) 1939 event poss word cursor-location start end save))
2022 (goto-char save))) 1940 (t
1941 ;; The word is incorrect, we have to propose a replacement.
1942 (flyspell-do-correct (flyspell-emacs-popup event poss word)
1943 poss word cursor-location start end save)))
2023 (ispell-pdict-save t)))))) 1944 (ispell-pdict-save t))))))
2024 1945
2025;*---------------------------------------------------------------------*/ 1946;*---------------------------------------------------------------------*/
2026;* flyspell-xemacs-correct ... */ 1947;* flyspell-do-correct ... */
2027;*---------------------------------------------------------------------*/ 1948;*---------------------------------------------------------------------*/
2028(defun flyspell-xemacs-correct (replace poss word cursor-location start end save) 1949(defun flyspell-do-correct (replace poss word cursor-location start end save)
2029 "The xemacs popup menu callback." 1950 "The popup menu callback."
1951 ;; Originally, the XEmacs code didn't do the (goto-char save) here and did
1952 ;; it instead right after calling the function.
2030 (cond ((eq replace 'ignore) 1953 (cond ((eq replace 'ignore)
1954 (goto-char save)
2031 nil) 1955 nil)
2032 ((eq replace 'save) 1956 ((eq replace 'save)
2033 (process-send-string ispell-process (concat "*" word "\n")) 1957 (goto-char save)
2034 (process-send-string ispell-process "#\n") 1958 (ispell-send-string (concat "*" word "\n"))
1959 ;; This was added only to the XEmacs side in revision 1.18 of
1960 ;; flyspell. I assume its absence on the Emacs side was an
1961 ;; oversight. --Stef
1962 (ispell-send-string "#\n")
2035 (flyspell-unhighlight-at cursor-location) 1963 (flyspell-unhighlight-at cursor-location)
2036 (setq ispell-pdict-modified-p '(t))) 1964 (setq ispell-pdict-modified-p '(t)))
2037 ((or (eq replace 'buffer) (eq replace 'session)) 1965 ((or (eq replace 'buffer) (eq replace 'session))
2038 (process-send-string ispell-process (concat "@" word "\n")) 1966 (ispell-send-string (concat "@" word "\n"))
2039 (flyspell-unhighlight-at cursor-location) 1967 (flyspell-unhighlight-at cursor-location)
2040 (if (null ispell-pdict-modified-p) 1968 (if (null ispell-pdict-modified-p)
2041 (setq ispell-pdict-modified-p 1969 (setq ispell-pdict-modified-p
2042 (list ispell-pdict-modified-p))) 1970 (list ispell-pdict-modified-p)))
1971 (goto-char save)
2043 (if (eq replace 'buffer) 1972 (if (eq replace 'buffer)
2044 (ispell-add-per-file-word-list word))) 1973 (ispell-add-per-file-word-list word)))
2045 (replace 1974 (replace
1975 ;; This was added only to the Emacs side. I assume its absence on
1976 ;; the XEmacs side was an oversight. --Stef
1977 (flyspell-unhighlight-at cursor-location)
2046 (let ((old-max (point-max)) 1978 (let ((old-max (point-max))
2047 (new-word (if (atom replace) 1979 (new-word (if (atom replace)
2048 replace 1980 replace
2049 (car replace))) 1981 (car replace)))
2050 (cursor-location (+ (- (length word) (- end start)) 1982 (cursor-location (+ (- (length word) (- end start))
2051 cursor-location))) 1983 cursor-location)))
2052 (if (not (equal new-word (car poss))) 1984 (unless (equal new-word (car poss))
2053 (progn 1985 (delete-region start end)
2054 (delete-region start end) 1986 (goto-char start)
2055 (goto-char start) 1987 (funcall flyspell-insert-function new-word)
2056 (funcall flyspell-insert-function new-word) 1988 (if flyspell-abbrev-p
2057 (if flyspell-abbrev-p 1989 (flyspell-define-abbrev word new-word)))
2058 (flyspell-define-abbrev word new-word)))) 1990 ;; In the original Emacs code, this was only called in the body
2059 (flyspell-ajust-cursor-point save cursor-location old-max))))) 1991 ;; of the if. I arbitrarily kept the XEmacs behavior instead.
1992 (flyspell-ajust-cursor-point save cursor-location old-max)))
1993 (t
1994 (goto-char save)
1995 nil)))
2060 1996
2061;*---------------------------------------------------------------------*/ 1997;*---------------------------------------------------------------------*/
2062;* flyspell-ajust-cursor-point ... */ 1998;* flyspell-ajust-cursor-point ... */
@@ -2125,7 +2061,7 @@ The word checked is the word at the mouse position."
2125 (cor-menu (if (consp corrects) 2061 (cor-menu (if (consp corrects)
2126 (mapcar (lambda (correct) 2062 (mapcar (lambda (correct)
2127 (vector correct 2063 (vector correct
2128 (list 'flyspell-xemacs-correct 2064 (list 'flyspell-do-correct
2129 correct 2065 correct
2130 (list 'quote poss) 2066 (list 'quote poss)
2131 word 2067 word
@@ -2140,7 +2076,7 @@ The word checked is the word at the mouse position."
2140 (menu (let ((save (if (consp affix) 2076 (menu (let ((save (if (consp affix)
2141 (vector 2077 (vector
2142 (concat "Save affix: " (car affix)) 2078 (concat "Save affix: " (car affix))
2143 (list 'flyspell-xemacs-correct 2079 (list 'flyspell-do-correct
2144 ''save 2080 ''save
2145 (list 'quote poss) 2081 (list 'quote poss)
2146 word 2082 word
@@ -2151,7 +2087,7 @@ The word checked is the word at the mouse position."
2151 t) 2087 t)
2152 (vector 2088 (vector
2153 "Save word" 2089 "Save word"
2154 (list 'flyspell-xemacs-correct 2090 (list 'flyspell-do-correct
2155 ''save 2091 ''save
2156 (list 'quote poss) 2092 (list 'quote poss)
2157 word 2093 word
@@ -2161,7 +2097,7 @@ The word checked is the word at the mouse position."
2161 save) 2097 save)
2162 t))) 2098 t)))
2163 (session (vector "Accept (session)" 2099 (session (vector "Accept (session)"
2164 (list 'flyspell-xemacs-correct 2100 (list 'flyspell-do-correct
2165 ''session 2101 ''session
2166 (list 'quote poss) 2102 (list 'quote poss)
2167 word 2103 word
@@ -2171,7 +2107,7 @@ The word checked is the word at the mouse position."
2171 save) 2107 save)
2172 t)) 2108 t))
2173 (buffer (vector "Accept (buffer)" 2109 (buffer (vector "Accept (buffer)"
2174 (list 'flyspell-xemacs-correct 2110 (list 'flyspell-do-correct
2175 ''buffer 2111 ''buffer
2176 (list 'quote poss) 2112 (list 'quote poss)
2177 word 2113 word
@@ -2198,9 +2134,9 @@ Ispell, after transposing two adjacent characters, correct the text,
2198and return t. 2134and return t.
2199 2135
2200The third arg POSS is either the symbol 'doublon' or a list of 2136The third arg POSS is either the symbol 'doublon' or a list of
2201possible corrections as returned by 'ispell-parse-output'. 2137possible corrections as returned by `ispell-parse-output'.
2202 2138
2203This function is meant to be added to 'flyspell-incorrect-hook'." 2139This function is meant to be added to `flyspell-incorrect-hook'."
2204 (when (consp poss) 2140 (when (consp poss)
2205 (catch 'done 2141 (catch 'done
2206 (let ((str (buffer-substring beg end)) 2142 (let ((str (buffer-substring beg end))
@@ -2228,9 +2164,9 @@ Ispell, after removing a pair of doubled characters, correct the text,
2228and return t. 2164and return t.
2229 2165
2230The third arg POSS is either the symbol 'doublon' or a list of 2166The third arg POSS is either the symbol 'doublon' or a list of
2231possible corrections as returned by 'ispell-parse-output'. 2167possible corrections as returned by `ispell-parse-output'.
2232 2168
2233This function is meant to be added to 'flyspell-incorrect-hook'." 2169This function is meant to be added to `flyspell-incorrect-hook'."
2234 (when (consp poss) 2170 (when (consp poss)
2235 (catch 'done 2171 (catch 'done
2236 (let ((str (buffer-substring beg end)) 2172 (let ((str (buffer-substring beg end))
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 1de27265b08..afdfc951b96 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -796,19 +796,16 @@ Otherwise returns the library directory name, if that is defined."
796 nil t) 796 nil t)
797 case-fold-search case-fold-search-val) 797 case-fold-search case-fold-search-val)
798 (if (or (not status) ; major version mismatch 798 (if (or (not status) ; major version mismatch
799 (< (car (read-from-string (buffer-substring-no-properties 799 (< (car (read-from-string (match-string-no-properties 2)))
800 (match-beginning 2) (match-end 2))))
801 (car (cdr ispell-required-version)))) ; minor version mismatch 800 (car (cdr ispell-required-version)))) ; minor version mismatch
802 (error "%s version 3 release %d.%d.%d or greater is required" 801 (error "%s version 3 release %d.%d.%d or greater is required"
803 ispell-program-name (car ispell-required-version) 802 ispell-program-name (car ispell-required-version)
804 (car (cdr ispell-required-version)) 803 (car (cdr ispell-required-version))
805 (car (cdr (cdr ispell-required-version)))) 804 (car (cdr (cdr ispell-required-version))))
806 ;; check that it is the correct version. 805 ;; check that it is the correct version.
807 (if (and (= (car (read-from-string (buffer-substring-no-properties 806 (if (and (= (car (read-from-string (match-string-no-properties 2)))
808 (match-beginning 2)(match-end 2))))
809 (car (cdr ispell-required-version))) 807 (car (cdr ispell-required-version)))
810 (< (car (read-from-string (buffer-substring-no-properties 808 (< (car (read-from-string (match-string-no-properties 3)))
811 (match-beginning 3)(match-end 3))))
812 (car (cdr (cdr ispell-required-version))))) 809 (car (cdr (cdr ispell-required-version)))))
813 (setq ispell-offset 0)) 810 (setq ispell-offset 0))
814 ;; Check to see if it's really aspell. 811 ;; Check to see if it's really aspell.
@@ -945,7 +942,7 @@ The variable `ispell-library-directory' defines the library location."
945 '(menu-item "Automatic spell checking (Flyspell)" 942 '(menu-item "Automatic spell checking (Flyspell)"
946 flyspell-mode 943 flyspell-mode
947 :help "Check spelling while you edit the text" 944 :help "Check spelling while you edit the text"
948 :button (:toggle . flyspell-mode))) 945 :button (:toggle . (bound-and-true-p flyspell-mode))))
949 (define-key ispell-menu-map [ispell-complete-word] 946 (define-key ispell-menu-map [ispell-complete-word]
950 '(menu-item "Complete Word" ispell-complete-word 947 '(menu-item "Complete Word" ispell-complete-word
951 :help "Complete word at cursor using dictionary")) 948 :help "Complete word at cursor using dictionary"))
@@ -2567,9 +2564,7 @@ Return nil if spell session is quit,
2567 (ispell-begin-skip-region-regexp) 2564 (ispell-begin-skip-region-regexp)
2568 ispell-region-end t)) 2565 ispell-region-end t))
2569 (progn 2566 (progn
2570 (setq key (buffer-substring-no-properties 2567 (setq key (match-string-no-properties 0))
2571 (car (match-data))
2572 (car (cdr (match-data)))))
2573 (set-marker skip-region-start 2568 (set-marker skip-region-start
2574 (- (point) (length key))) 2569 (- (point) (length key)))
2575 (goto-char rstart)) 2570 (goto-char rstart))
@@ -3510,8 +3505,7 @@ Includes Latex/Nroff modes and extended character mode."
3510 (search-forward ispell-parsing-keyword) 3505 (search-forward ispell-parsing-keyword)
3511 (while (re-search-forward " *\\([^ \"]+\\)" end t) 3506 (while (re-search-forward " *\\([^ \"]+\\)" end t)
3512 ;; space separated definitions. 3507 ;; space separated definitions.
3513 (setq string (downcase (buffer-substring-no-properties 3508 (setq string (downcase (match-string-no-properties 1)))
3514 (match-beginning 1) (match-end 1))))
3515 (cond ((and (string-match "latex-mode" string) 3509 (cond ((and (string-match "latex-mode" string)
3516 (not (eq 'exclusive ispell-check-comments))) 3510 (not (eq 'exclusive ispell-check-comments)))
3517 (ispell-send-string "+\n~tex\n")) 3511 (ispell-send-string "+\n~tex\n"))
@@ -3544,8 +3538,7 @@ Both should not be used to define a buffer-local dictionary."
3544 (setq end (save-excursion (end-of-line) (point))) 3538 (setq end (save-excursion (end-of-line) (point)))
3545 (if (re-search-forward " *\\([^ \"]+\\)" end t) 3539 (if (re-search-forward " *\\([^ \"]+\\)" end t)
3546 (setq ispell-local-dictionary 3540 (setq ispell-local-dictionary
3547 (buffer-substring-no-properties (match-beginning 1) 3541 (match-string-no-properties 1))))))
3548 (match-end 1)))))))
3549 (goto-char (point-max)) 3542 (goto-char (point-max))
3550 (if (search-backward ispell-pdict-keyword nil t) 3543 (if (search-backward ispell-pdict-keyword nil t)
3551 (progn 3544 (progn
@@ -3553,8 +3546,7 @@ Both should not be used to define a buffer-local dictionary."
3553 (setq end (save-excursion (end-of-line) (point))) 3546 (setq end (save-excursion (end-of-line) (point)))
3554 (if (re-search-forward " *\\([^ \"]+\\)" end t) 3547 (if (re-search-forward " *\\([^ \"]+\\)" end t)
3555 (setq ispell-local-pdict 3548 (setq ispell-local-pdict
3556 (buffer-substring-no-properties (match-beginning 1) 3549 (match-string-no-properties 1)))))))
3557 (match-end 1))))))))
3558 ;; Reload if new personal dictionary defined. 3550 ;; Reload if new personal dictionary defined.
3559 (if (and ispell-local-pdict 3551 (if (and ispell-local-pdict
3560 (not (equal ispell-local-pdict ispell-personal-dictionary))) 3552 (not (equal ispell-local-pdict ispell-personal-dictionary)))
@@ -3584,8 +3576,7 @@ Both should not be used to define a buffer-local dictionary."
3584 ;; buffer-local words separated by a space, and can contain 3576 ;; buffer-local words separated by a space, and can contain
3585 ;; any character other than a space. Not rigorous enough. 3577 ;; any character other than a space. Not rigorous enough.
3586 (while (re-search-forward " *\\([^ ]+\\)" end t) 3578 (while (re-search-forward " *\\([^ ]+\\)" end t)
3587 (setq string (buffer-substring-no-properties (match-beginning 1) 3579 (setq string (match-string-no-properties 1))
3588 (match-end 1)))
3589 ;; This can fail when string contains a word with illegal chars. 3580 ;; This can fail when string contains a word with illegal chars.
3590 ;; Error handling needs to be added between ispell and emacs. 3581 ;; Error handling needs to be added between ispell and emacs.
3591 (if (and (< 1 (length string)) 3582 (if (and (< 1 (length string))
diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el
index bbc59768aaf..635bb6b5a98 100644
--- a/lisp/textmodes/org.el
+++ b/lisp/textmodes/org.el
@@ -1,11 +1,11 @@
1;; org.el --- Outline-based notes management and organizer 1;;; org.el --- Outline-based notes management and organizer
2;; Carstens outline-mode for keeping track of everything. 2;; Carstens outline-mode for keeping track of everything.
3;; Copyright (c) 2004, 2005 Free Software Foundation 3;; Copyright (c) 2004, 2005 Free Software Foundation
4;; 4;;
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.10 8;; Version: 3.11
9;; 9;;
10;; This file is part of GNU Emacs. 10;; This file is part of GNU Emacs.
11;; 11;;
@@ -80,6 +80,17 @@
80;; 80;;
81;; Changes: 81;; Changes:
82;; ------- 82;; -------
83;; Version 3.11
84;; - Links inserted with C-c C-l are now by default enclosed in angle
85;; brackets. See the new variable `org-link-format'.
86;; - ">" terminates a link, this is a way to have several links in a line.
87;; - Archiving of finished tasks.
88;; - C-<up>/<down> bindings removed, to allow access to paragraph commands.
89;; - Compatibility with CUA-mode (see variable `org-CUA-compatible').
90;; - Compatibility problems with viper-mode fixed.
91;; - Improved html export of tables.
92;; - Various clean-up changes.
93;;
83;; Version 3.10 94;; Version 3.10
84;; - Using `define-derived-mode' to derive `org-mode' from `outline-mode'. 95;; - Using `define-derived-mode' to derive `org-mode' from `outline-mode'.
85;; 96;;
@@ -154,12 +165,10 @@
154(require 'outline) 165(require 'outline)
155(require 'time-date) 166(require 'time-date)
156(require 'easymenu) 167(require 'easymenu)
157(or (fboundp 'run-mode-hooks)
158 (defalias 'run-mode-hooks 'run-hooks))
159 168
160;;; Customization variables 169;;; Customization variables
161 170
162(defvar org-version "3.10" 171(defvar org-version "3.11"
163 "The version number of the file org.el.") 172 "The version number of the file org.el.")
164(defun org-version () 173(defun org-version ()
165 (interactive) 174 (interactive)
@@ -185,6 +194,44 @@
185 :tag "Org Startup" 194 :tag "Org Startup"
186 :group 'org) 195 :group 'org)
187 196
197(defcustom org-CUA-compatible nil
198 "Non-nil means use alternative key bindings for S-<cursor movement>.
199Org-mode used S-<cursor movement> for changing timestamps and priorities.
200S-<cursor movement> is also used for example by `CUA-mode' to select text.
201If you want to use Org-mode together with `CUA-mode', Org-mode needs to use
202alternative bindings. Setting this variable to t will replace the following
203keys both in Org-mode and in the Org-agenda buffer.
204
205S-RET -> C-S-RET
206S-up -> M-p
207S-down -> M-n
208S-left -> M--
209S-right -> M-+
210
211If you do not like the alternative keys, take a look at the variable
212`org-disputed-keys'.
213
214This option is only relevant at load-time of Org-mode. Changing it requires
215a restart of Emacs to become effective."
216 :group 'org-startup
217 :type 'boolean)
218
219(defvar org-disputed-keys
220 '((S-up [(shift up)] [(meta ?p)])
221 (S-down [(shift down)] [(meta ?n)])
222 (S-left [(shift left)] [(meta ?-)])
223 (S-right [(shift right)] [(meta ?+)])
224 (S-return [(shift return)] [(control shift return)]))
225 "Keys for which Org-mode and other modes compete.
226This is an alist, cars are symbols for lookup, 1st element is the default key,
227second element will be used when `org-CUA-compatible' is t.")
228
229(defun org-key (key)
230 "Select a key according to `org-CUA-compatible'."
231 (nth (if org-CUA-compatible 2 1)
232 (or (assq key org-disputed-keys)
233 (error "Invalid Key %s in `org-key'" key))))
234
188(defcustom org-startup-folded t 235(defcustom org-startup-folded t
189 "Non-nil means, entering Org-mode will switch to OVERVIEW. 236 "Non-nil means, entering Org-mode will switch to OVERVIEW.
190This can also be configured on a per-file basis by adding one of 237This can also be configured on a per-file basis by adding one of
@@ -388,16 +435,17 @@ is used instead.")
388 "Precompute regular expressions for current buffer." 435 "Precompute regular expressions for current buffer."
389 (when (eq major-mode 'org-mode) 436 (when (eq major-mode 'org-mode)
390 (let ((re (org-make-options-regexp 437 (let ((re (org-make-options-regexp
391 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" "STARTUP"))) 438 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO"
439 "STARTUP" "ARCHIVE")))
392 (splitre "[ \t]+") 440 (splitre "[ \t]+")
393 kwds int key value cat) 441 kwds int key value cat arch)
394 (save-excursion 442 (save-excursion
395 (save-restriction 443 (save-restriction
396 (widen) 444 (widen)
397 (goto-char (point-min)) 445 (goto-char (point-min))
398 (while (re-search-forward re nil t) 446 (while (re-search-forward re nil t)
399 (setq key (match-string 1) value (match-string 2)) 447 (setq key (match-string 1) value (match-string 2))
400 (cond 448 (cond
401 ((equal key "CATEGORY") 449 ((equal key "CATEGORY")
402 (if (string-match "[ \t]+$" value) 450 (if (string-match "[ \t]+$" value)
403 (setq value (replace-match "" t t value))) 451 (setq value (replace-match "" t t value)))
@@ -421,17 +469,23 @@ is used instead.")
421 l var val) 469 l var val)
422 (while (setq l (assoc (pop opts) set)) 470 (while (setq l (assoc (pop opts) set))
423 (setq var (nth 1 l) val (nth 2 l)) 471 (setq var (nth 1 l) val (nth 2 l))
424 (set (make-local-variable var) val))))) 472 (set (make-local-variable var) val))))
473 ((equal key "ARCHIVE")
474 (string-match " *$" value)
475 (setq arch (replace-match "" t t value))
476 (remove-text-properties 0 (length arch)
477 '(face t fontified t) arch)))
425 ))) 478 )))
426 (and cat (set (make-local-variable 'org-category) cat)) 479 (and cat (set (make-local-variable 'org-category) cat))
427 (and kwds (set (make-local-variable 'org-todo-keywords) kwds)) 480 (and kwds (set (make-local-variable 'org-todo-keywords) kwds))
481 (and arch (set (make-local-variable 'org-archive-location) arch))
428 (and int (set (make-local-variable 'org-todo-interpretation) int))) 482 (and int (set (make-local-variable 'org-todo-interpretation) int)))
429 ;; Compute the regular expressions and other local variables 483 ;; Compute the regular expressions and other local variables
430 (setq org-todo-kwd-priority-p (equal org-todo-interpretation 'priority) 484 (setq org-todo-kwd-priority-p (equal org-todo-interpretation 'priority)
431 org-todo-kwd-max-priority (1- (length org-todo-keywords)) 485 org-todo-kwd-max-priority (1- (length org-todo-keywords))
432 org-ds-keyword-length (+ 2 (max (length org-deadline-string) 486 org-ds-keyword-length (+ 2 (max (length org-deadline-string)
433 (length org-scheduled-string))) 487 (length org-scheduled-string)))
434 org-done-string 488 org-done-string
435 (nth (1- (length org-todo-keywords)) org-todo-keywords) 489 (nth (1- (length org-todo-keywords)) org-todo-keywords)
436 org-todo-regexp 490 org-todo-regexp
437 (concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords 491 (concat "\\<\\(" (mapconcat 'regexp-quote org-todo-keywords
@@ -465,6 +519,11 @@ is used instead.")
465 :tag "Org Time" 519 :tag "Org Time"
466 :group 'org) 520 :group 'org)
467 521
522(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>")
523 "Formats for `format-time-string' which are used for time stamps.
524It is not recommended to change this constant.")
525
526
468(defcustom org-deadline-warning-days 30 527(defcustom org-deadline-warning-days 30
469 "No. of days before expiration during which a deadline becomes active. 528 "No. of days before expiration during which a deadline becomes active.
470This variable governs the display in the org file." 529This variable governs the display in the org file."
@@ -506,7 +565,7 @@ When nil, cursor will remain in the current window."
506 565
507(defcustom org-select-agenda-window t 566(defcustom org-select-agenda-window t
508 "Non-nil means, after creating an agenda, move cursor into Agenda window. 567 "Non-nil means, after creating an agenda, move cursor into Agenda window.
509When nil, cursor will remain in the current window." 568When nil, cursor will remain in the current window."
510 :group 'org-agenda 569 :group 'org-agenda
511 :type 'boolean) 570 :type 'boolean)
512 571
@@ -542,7 +601,7 @@ When nil, always start on the current day."
542When nil, date-less entries will only be shown if `org-agenda' is called 601When nil, date-less entries will only be shown if `org-agenda' is called
543with a prefix argument. 602with a prefix argument.
544When non-nil, the TODO entries will be listed at the top of the agenda, before 603When non-nil, the TODO entries will be listed at the top of the agenda, before
545the entries for specific days." 604the entries for specific days."
546 :group 'org-agenda 605 :group 'org-agenda
547 :type 'boolean) 606 :type 'boolean)
548 607
@@ -587,7 +646,7 @@ priority.
587Leaving out `category-keep' would mean that items will be sorted across 646Leaving out `category-keep' would mean that items will be sorted across
588categories by priority." 647categories by priority."
589 :group 'org-agenda 648 :group 'org-agenda
590 :type '(repeat 649 :type '(repeat
591 (choice 650 (choice
592 (const time-up) 651 (const time-up)
593 (const time-down) 652 (const time-down)
@@ -663,14 +722,26 @@ the variable `org-agenda-time-grid'."
663 :group 'org-agenda 722 :group 'org-agenda
664 :type 'boolean) 723 :type 'boolean)
665 724
666(defcustom org-agenda-time-grid 725(defcustom org-agenda-time-grid
667 '((daily today require-timed) 726 '((daily today require-timed)
668 "----------------" 727 "----------------"
669 (800 1000 1200 1400 1600 1800 2000)) 728 (800 1000 1200 1400 1600 1800 2000))
670 729
671 "FIXME: document" 730 "The settings for time grid for agenda display.
731This is a list of three items. The first item is again a list. It contains
732symbols specifying conditions when the grid should be displayed:
733
734 daily if the agenda shows a single day
735 weekly if the agenda shows an entire week
736 today show grid on current date, independent of daily/weekly display
737 require-timed show grid only if at least on item has a time specification
738
739The second item is a string which will be places behing the grid time.
740
741The third item is a list of integers, indicating the times that should have
742a grid line."
672 :group 'org-agenda 743 :group 'org-agenda
673 :type 744 :type
674 '(list 745 '(list
675 (set :greedy t :tag "Grid Display Options" 746 (set :greedy t :tag "Grid Display Options"
676 (const :tag "Show grid in single day agenda display" daily) 747 (const :tag "Show grid in single day agenda display" daily)
@@ -752,10 +823,6 @@ t Everywhere except in headlines"
752 (const :tag "Everywhere except in headlines" t) 823 (const :tag "Everywhere except in headlines" t)
753 )) 824 ))
754 825
755(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>")
756 "Formats for `format-time-string' which are used for time stamps.
757It is not recommended to change this constant.")
758
759(defcustom org-show-following-heading t 826(defcustom org-show-following-heading t
760 "Non-nil means, show heading following match in `org-occur'. 827 "Non-nil means, show heading following match in `org-occur'.
761When doing an `org-occur' it is useful to show the headline which 828When doing an `org-occur' it is useful to show the headline which
@@ -766,12 +833,73 @@ unnecessary clutter."
766 :group 'org-structure 833 :group 'org-structure
767 :type 'boolean) 834 :type 'boolean)
768 835
836(defcustom org-archive-location "%s_archive::"
837 "The location where subtrees should be archived.
838This string consists of two parts, separated by a double-colon.
839
840The first part is a file name - when omitted, archiving happens in the same
841file. %s will be replaced by the current file name (without directory part).
842Archiving to a different file is useful to keep archived entries from
843contributing to the Org-mode Agenda.
844
845The part after the double colon is a headline. The archived entries will be
846filed under that headline. When omitted, the subtrees are simply filed away
847at the end of the file, as top-level entries.
848
849Here are a few examples:
850\"%s_archive::\"
851 If the current file is Projects.org, archive in file
852 Projects.org_archive, as top-level trees. This is the default.
853
854\"::* Archived Tasks\"
855 Archive in the current file, under the top-level headline
856 \"* Archived Tasks\".
857
858\"~/org/archive.org::\"
859 Archive in file ~/org/archive.org (absolute path), as top-level trees.
860
861\"basement::** Finished Tasks\"
862 Archive in file ./basement (relative path), as level 3 trees
863 below the level 2 heading \"** Finished Tasks\".
864
865You may set this option on a per-file basis by adding to the buffer a
866line like
867
868#+ARCHIVE: basement::** Finished Tasks"
869 :group 'org-structure
870 :type 'string)
871
872(defcustom org-archive-mark-done t
873 "Non-nil means, mark archived entries as DONE."
874 :group 'org-structure
875 :type 'boolean)
876
877(defcustom org-archive-stamp-time t
878 "Non-nil means, add a time stamp to archived entries.
879The time stamp will be added directly after the TODO state keyword in the
880first line, so it is probably best to use this in combinations with
881`org-archive-mark-done'."
882 :group 'org-structure
883 :type 'boolean)
769 884
770(defgroup org-link nil 885(defgroup org-link nil
771 "Options concerning links in Org-mode." 886 "Options concerning links in Org-mode."
772 :tag "Org Link" 887 :tag "Org Link"
773 :group 'org) 888 :group 'org)
774 889
890(defcustom org-link-format "<%s>"
891 "Default format for linkes in the buffer.
892This is a format string for printf, %s will be replaced by the link text.
893If you want to make sure that your link is always properly terminated,
894include angle brackets into this format, like \"<%s>\". Some people also
895recommend an additional URL: prefix, so the format would be \"<URL:%s>\"."
896 :group 'org-link
897 :type '(choice
898 (const :tag "\"%s\" (e.g. http://www.there.com)" "%s")
899 (const :tag "\"<%s>\" (e.g. <http://www.there.com>)" "<%s>")
900 (const :tag "\"<URL:%s>\" (e.g. <URL:http://www.there.com>)" "<URL:%s>")
901 (string :tag "Other" :value "<%s>")))
902
775(defcustom org-allow-space-in-links t 903(defcustom org-allow-space-in-links t
776 "Non-nil means, file names in links may contain space characters. 904 "Non-nil means, file names in links may contain space characters.
777When nil, it becomes possible to put several links into a line. 905When nil, it becomes possible to put several links into a line.
@@ -1310,7 +1438,7 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
1310 :tag "Org Faces" 1438 :tag "Org Faces"
1311 :group 'org) 1439 :group 'org)
1312 1440
1313(defface org-level-1-face ;; font-lock-function-name-face 1441(defface org-level-1 ;; font-lock-function-name-face
1314 '((((type tty) (class color)) (:foreground "blue" :weight bold)) 1442 '((((type tty) (class color)) (:foreground "blue" :weight bold))
1315 (((class color) (background light)) (:foreground "Blue")) 1443 (((class color) (background light)) (:foreground "Blue"))
1316 (((class color) (background dark)) (:foreground "LightSkyBlue")) 1444 (((class color) (background dark)) (:foreground "LightSkyBlue"))
@@ -1318,7 +1446,7 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
1318 "Face used for level 1 headlines." 1446 "Face used for level 1 headlines."
1319 :group 'org-faces) 1447 :group 'org-faces)
1320 1448
1321(defface org-level-2-face ;; font-lock-variable-name-face 1449(defface org-level-2 ;; font-lock-variable-name-face
1322 '((((type tty) (class color)) (:foreground "yellow" :weight light)) 1450 '((((type tty) (class color)) (:foreground "yellow" :weight light))
1323 (((class color) (background light)) (:foreground "DarkGoldenrod")) 1451 (((class color) (background light)) (:foreground "DarkGoldenrod"))
1324 (((class color) (background dark)) (:foreground "LightGoldenrod")) 1452 (((class color) (background dark)) (:foreground "LightGoldenrod"))
@@ -1326,7 +1454,7 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
1326 "Face used for level 2 headlines." 1454 "Face used for level 2 headlines."
1327 :group 'org-faces) 1455 :group 'org-faces)
1328 1456
1329(defface org-level-3-face ;; font-lock-keyword-face 1457(defface org-level-3 ;; font-lock-keyword-face
1330 '((((type tty) (class color)) (:foreground "cyan" :weight bold)) 1458 '((((type tty) (class color)) (:foreground "cyan" :weight bold))
1331 (((class color) (background light)) (:foreground "Purple")) 1459 (((class color) (background light)) (:foreground "Purple"))
1332 (((class color) (background dark)) (:foreground "Cyan")) 1460 (((class color) (background dark)) (:foreground "Cyan"))
@@ -1334,7 +1462,7 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
1334 "Face used for level 3 headlines." 1462 "Face used for level 3 headlines."
1335 :group 'org-faces) 1463 :group 'org-faces)
1336 1464
1337(defface org-level-4-face ;; font-lock-comment-face 1465(defface org-level-4 ;; font-lock-comment-face
1338 '((((type tty pc) (class color) (background light)) (:foreground "red")) 1466 '((((type tty pc) (class color) (background light)) (:foreground "red"))
1339 (((type tty pc) (class color) (background dark)) (:foreground "red1")) 1467 (((type tty pc) (class color) (background dark)) (:foreground "red1"))
1340 (((class color) (background light)) (:foreground "Firebrick")) 1468 (((class color) (background light)) (:foreground "Firebrick"))
@@ -1343,7 +1471,7 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
1343 "Face used for level 4 headlines." 1471 "Face used for level 4 headlines."
1344 :group 'org-faces) 1472 :group 'org-faces)
1345 1473
1346(defface org-level-5-face ;; font-lock-type-face 1474(defface org-level-5 ;; font-lock-type-face
1347 '((((type tty) (class color)) (:foreground "green")) 1475 '((((type tty) (class color)) (:foreground "green"))
1348 (((class color) (background light)) (:foreground "ForestGreen")) 1476 (((class color) (background light)) (:foreground "ForestGreen"))
1349 (((class color) (background dark)) (:foreground "PaleGreen")) 1477 (((class color) (background dark)) (:foreground "PaleGreen"))
@@ -1351,7 +1479,7 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
1351 "Face used for level 5 headlines." 1479 "Face used for level 5 headlines."
1352 :group 'org-faces) 1480 :group 'org-faces)
1353 1481
1354(defface org-level-6-face ;; font-lock-constant-face 1482(defface org-level-6 ;; font-lock-constant-face
1355 '((((type tty) (class color)) (:foreground "magenta")) 1483 '((((type tty) (class color)) (:foreground "magenta"))
1356 (((class color) (background light)) (:foreground "CadetBlue")) 1484 (((class color) (background light)) (:foreground "CadetBlue"))
1357 (((class color) (background dark)) (:foreground "Aquamarine")) 1485 (((class color) (background dark)) (:foreground "Aquamarine"))
@@ -1359,7 +1487,7 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
1359 "Face used for level 6 headlines." 1487 "Face used for level 6 headlines."
1360 :group 'org-faces) 1488 :group 'org-faces)
1361 1489
1362(defface org-level-7-face ;; font-lock-builtin-face 1490(defface org-level-7 ;; font-lock-builtin-face
1363 '((((type tty) (class color)) (:foreground "blue" :weight light)) 1491 '((((type tty) (class color)) (:foreground "blue" :weight light))
1364 (((class color) (background light)) (:foreground "Orchid")) 1492 (((class color) (background light)) (:foreground "Orchid"))
1365 (((class color) (background dark)) (:foreground "LightSteelBlue")) 1493 (((class color) (background dark)) (:foreground "LightSteelBlue"))
@@ -1367,7 +1495,7 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
1367 "Face used for level 7 headlines." 1495 "Face used for level 7 headlines."
1368 :group 'org-faces) 1496 :group 'org-faces)
1369 1497
1370(defface org-level-8-face ;; font-lock-string-face 1498(defface org-level-8 ;; font-lock-string-face
1371 '((((type tty) (class color)) (:foreground "green")) 1499 '((((type tty) (class color)) (:foreground "green"))
1372 (((class color) (background light)) (:foreground "RosyBrown")) 1500 (((class color) (background light)) (:foreground "RosyBrown"))
1373 (((class color) (background dark)) (:foreground "LightSalmon")) 1501 (((class color) (background dark)) (:foreground "LightSalmon"))
@@ -1375,7 +1503,7 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
1375 "Face used for level 8 headlines." 1503 "Face used for level 8 headlines."
1376 :group 'org-faces) 1504 :group 'org-faces)
1377 1505
1378(defface org-warning-face ;; font-lock-warning-face 1506(defface org-warning ;; font-lock-warning-face
1379 '((((type tty) (class color)) (:foreground "red")) 1507 '((((type tty) (class color)) (:foreground "red"))
1380 (((class color) (background light)) (:foreground "Red" :bold t)) 1508 (((class color) (background light)) (:foreground "Red" :bold t))
1381 (((class color) (background dark)) (:foreground "Red1" :bold t)) 1509 (((class color) (background dark)) (:foreground "Red1" :bold t))
@@ -1388,11 +1516,11 @@ Otherwise, the buffer will just be saved to a file and stay hidden."
1388 "Non-nil means, change the face of a headline if it is marked DONE. 1516 "Non-nil means, change the face of a headline if it is marked DONE.
1389Normally, only the TODO/DONE keyword indicates the state of a headline. 1517Normally, only the TODO/DONE keyword indicates the state of a headline.
1390When this is non-nil, the headline after the keyword is set to the 1518When this is non-nil, the headline after the keyword is set to the
1391`org-headline-done-face' as an additional indication." 1519`org-headline-done' as an additional indication."
1392 :group 'org-faces 1520 :group 'org-faces
1393 :type 'boolean) 1521 :type 'boolean)
1394 1522
1395(defface org-headline-done-face ;; font-lock-string-face 1523(defface org-headline-done ;; font-lock-string-face
1396 '((((type tty) (class color)) (:foreground "green")) 1524 '((((type tty) (class color)) (:foreground "green"))
1397 (((class color) (background light)) (:foreground "RosyBrown")) 1525 (((class color) (background light)) (:foreground "RosyBrown"))
1398 (((class color) (background dark)) (:foreground "LightSalmon")) 1526 (((class color) (background dark)) (:foreground "LightSalmon"))
@@ -1403,7 +1531,7 @@ When this is non-nil, the headline after the keyword is set to the
1403 1531
1404;; Inheritance does not yet work for xemacs. So we just copy... 1532;; Inheritance does not yet work for xemacs. So we just copy...
1405 1533
1406(defface org-deadline-announce-face 1534(defface org-deadline-announce
1407 '((((type tty) (class color)) (:foreground "blue" :weight bold)) 1535 '((((type tty) (class color)) (:foreground "blue" :weight bold))
1408 (((class color) (background light)) (:foreground "Blue")) 1536 (((class color) (background light)) (:foreground "Blue"))
1409 (((class color) (background dark)) (:foreground "LightSkyBlue")) 1537 (((class color) (background dark)) (:foreground "LightSkyBlue"))
@@ -1411,7 +1539,7 @@ When this is non-nil, the headline after the keyword is set to the
1411 "Face for upcoming deadlines." 1539 "Face for upcoming deadlines."
1412 :group 'org-faces) 1540 :group 'org-faces)
1413 1541
1414(defface org-scheduled-today-face 1542(defface org-scheduled-today
1415 '((((type tty) (class color)) (:foreground "green")) 1543 '((((type tty) (class color)) (:foreground "green"))
1416 (((class color) (background light)) (:foreground "DarkGreen")) 1544 (((class color) (background light)) (:foreground "DarkGreen"))
1417 (((class color) (background dark)) (:foreground "PaleGreen")) 1545 (((class color) (background dark)) (:foreground "PaleGreen"))
@@ -1419,7 +1547,7 @@ When this is non-nil, the headline after the keyword is set to the
1419 "Face for items scheduled for a certain day." 1547 "Face for items scheduled for a certain day."
1420 :group 'org-faces) 1548 :group 'org-faces)
1421 1549
1422(defface org-scheduled-previously-face 1550(defface org-scheduled-previously
1423 '((((type tty pc) (class color) (background light)) (:foreground "red")) 1551 '((((type tty pc) (class color) (background light)) (:foreground "red"))
1424 (((type tty pc) (class color) (background dark)) (:foreground "red1")) 1552 (((type tty pc) (class color) (background dark)) (:foreground "red1"))
1425 (((class color) (background light)) (:foreground "Firebrick")) 1553 (((class color) (background light)) (:foreground "Firebrick"))
@@ -1428,7 +1556,7 @@ When this is non-nil, the headline after the keyword is set to the
1428 "Face for items scheduled previously, and not yet done." 1556 "Face for items scheduled previously, and not yet done."
1429 :group 'org-faces) 1557 :group 'org-faces)
1430 1558
1431(defface org-link-face 1559(defface org-link
1432 '((((type tty) (class color)) (:foreground "cyan" :weight bold)) 1560 '((((type tty) (class color)) (:foreground "cyan" :weight bold))
1433 (((class color) (background light)) (:foreground "Purple")) 1561 (((class color) (background light)) (:foreground "Purple"))
1434 (((class color) (background dark)) (:foreground "Cyan")) 1562 (((class color) (background dark)) (:foreground "Cyan"))
@@ -1436,7 +1564,7 @@ When this is non-nil, the headline after the keyword is set to the
1436 "Face for links." 1564 "Face for links."
1437 :group 'org-faces) 1565 :group 'org-faces)
1438 1566
1439(defface org-done-face ;; font-lock-type-face 1567(defface org-done ;; font-lock-type-face
1440 '((((type tty) (class color)) (:foreground "green")) 1568 '((((type tty) (class color)) (:foreground "green"))
1441 (((class color) (background light)) (:foreground "ForestGreen" :bold t)) 1569 (((class color) (background light)) (:foreground "ForestGreen" :bold t))
1442 (((class color) (background dark)) (:foreground "PaleGreen" :bold t)) 1570 (((class color) (background dark)) (:foreground "PaleGreen" :bold t))
@@ -1444,7 +1572,7 @@ When this is non-nil, the headline after the keyword is set to the
1444 "Face used for DONE." 1572 "Face used for DONE."
1445 :group 'org-faces) 1573 :group 'org-faces)
1446 1574
1447(defface org-table-face ;; font-lock-function-name-face 1575(defface org-table ;; font-lock-function-name-face
1448 '((((type tty) (class color)) (:foreground "blue" :weight bold)) 1576 '((((type tty) (class color)) (:foreground "blue" :weight bold))
1449 (((class color) (background light)) (:foreground "Blue")) 1577 (((class color) (background light)) (:foreground "Blue"))
1450 (((class color) (background dark)) (:foreground "LightSkyBlue")) 1578 (((class color) (background dark)) (:foreground "LightSkyBlue"))
@@ -1452,7 +1580,7 @@ When this is non-nil, the headline after the keyword is set to the
1452 "Face used for tables." 1580 "Face used for tables."
1453 :group 'org-faces) 1581 :group 'org-faces)
1454 1582
1455(defface org-time-grid-face ;; font-lock-variable-name-face 1583(defface org-time-grid ;; font-lock-variable-name-face
1456 '((((type tty) (class color)) (:foreground "yellow" :weight light)) 1584 '((((type tty) (class color)) (:foreground "yellow" :weight light))
1457 (((class color) (background light)) (:foreground "DarkGoldenrod")) 1585 (((class color) (background light)) (:foreground "DarkGoldenrod"))
1458 (((class color) (background dark)) (:foreground "LightGoldenrod")) 1586 (((class color) (background dark)) (:foreground "LightGoldenrod"))
@@ -1462,14 +1590,14 @@ When this is non-nil, the headline after the keyword is set to the
1462 1590
1463(defvar org-level-faces 1591(defvar org-level-faces
1464 '( 1592 '(
1465 org-level-1-face 1593 org-level-1
1466 org-level-2-face 1594 org-level-2
1467 org-level-3-face 1595 org-level-3
1468 org-level-4-face 1596 org-level-4
1469 org-level-5-face 1597 org-level-5
1470 org-level-6-face 1598 org-level-6
1471 org-level-7-face 1599 org-level-7
1472 org-level-8-face 1600 org-level-8
1473 )) 1601 ))
1474(defvar org-n-levels (length org-level-faces)) 1602(defvar org-n-levels (length org-level-faces))
1475 1603
@@ -1535,7 +1663,7 @@ sets it back to nil.")
1535 1663
1536;;;###autoload 1664;;;###autoload
1537(define-derived-mode org-mode outline-mode "Org" 1665(define-derived-mode org-mode outline-mode "Org"
1538 "Outline-based notes management and organizer, alias 1666 "Outline-based notes management and organizer, alias
1539\"Carstens outline-mode for keeping track of everything.\" 1667\"Carstens outline-mode for keeping track of everything.\"
1540 1668
1541Org-mode develops organizational tasks around a NOTES file which 1669Org-mode develops organizational tasks around a NOTES file which
@@ -1564,6 +1692,9 @@ The following commands are available:
1564 (make-local-hook 'before-change-functions) ;; needed for XEmacs 1692 (make-local-hook 'before-change-functions) ;; needed for XEmacs
1565 (add-hook 'before-change-functions 'org-before-change-function nil 1693 (add-hook 'before-change-functions 'org-before-change-function nil
1566 'local) 1694 'local)
1695 ;; Paragraph regular expressions
1696 (set (make-local-variable 'paragraph-separate) "\f\\|[ ]*$")
1697 (set (make-local-variable 'paragraph-start) "\f\\|[ ]*$\\|\\([*\f]+\\)")
1567 ;; Inhibit auto-fill for headers, tables and fixed-width lines. 1698 ;; Inhibit auto-fill for headers, tables and fixed-width lines.
1568 (set (make-local-variable 'auto-fill-inhibit-regexp) 1699 (set (make-local-variable 'auto-fill-inhibit-regexp)
1569 (concat "\\*" 1700 (concat "\\*"
@@ -1573,6 +1704,7 @@ The following commands are available:
1573 (if org-enable-table-editor "|" "") 1704 (if org-enable-table-editor "|" "")
1574 (if org-enable-fixed-width-editor ":" "") 1705 (if org-enable-fixed-width-editor ":" "")
1575 "]")))) 1706 "]"))))
1707 (set (make-local-variable 'fill-paragraph-function) 'org-fill-paragraph)
1576 (if (and org-insert-mode-line-in-empty-file 1708 (if (and org-insert-mode-line-in-empty-file
1577 (interactive-p) 1709 (interactive-p)
1578 (= (point-min) (point-max))) 1710 (= (point-min) (point-max)))
@@ -1587,25 +1719,38 @@ The following commands are available:
1587 (let ((this-command 'org-cycle) (last-command 'org-cycle)) 1719 (let ((this-command 'org-cycle) (last-command 'org-cycle))
1588 (org-cycle '(4)) (org-cycle '(4)))))))) 1720 (org-cycle '(4)) (org-cycle '(4))))))))
1589 1721
1722(defun org-fill-paragraph (&optional justify)
1723 "Re-align a table, pass through to fill-paragraph if no table."
1724 (save-excursion
1725 (beginning-of-line 1)
1726 (looking-at "\\s-*\\(|\\|\\+-+\\)")))
1727
1590;;; Font-Lock stuff 1728;;; Font-Lock stuff
1591 1729
1592(defvar org-mouse-map (make-sparse-keymap)) 1730(defvar org-mouse-map (make-sparse-keymap))
1593(define-key org-mouse-map 1731(define-key org-mouse-map
1594 (if org-xemacs-p [button2] [mouse-2]) 'org-open-at-mouse) 1732 (if org-xemacs-p [button2] [mouse-2]) 'org-open-at-mouse)
1595(define-key org-mouse-map 1733(define-key org-mouse-map
1596 (if org-xemacs-p [button3] [mouse-3]) 'org-find-file-at-mouse) 1734 (if org-xemacs-p [button3] [mouse-3]) 'org-find-file-at-mouse)
1597 1735
1598(require 'font-lock) 1736(require 'font-lock)
1599 1737
1600(defconst org-non-link-chars "\t\n\r|") 1738(defconst org-non-link-chars "\t\n\r|<>\000")
1601(defconst org-link-regexp 1739(defconst org-link-regexp
1602 (if org-allow-space-in-links 1740 (if org-allow-space-in-links
1603 (concat 1741 (concat
1604 "\\(https?\\|ftp\\|mailto|\\|file\\|news\\|bbdb\\|vm\\|wl\\|rmail\\|gnus\\|shell\\):\\([^" org-non-link-chars "]+[^ " org-non-link-chars "]\\)") 1742 "\\(https?\\|ftp\\|mailto\\|file\\|news\\|bbdb\\|vm\\|wl\\|rmail\\|gnus\\|shell\\):\\([^" org-non-link-chars "]+[^ " org-non-link-chars "]\\)")
1605 (concat 1743 (concat
1606 "\\(https?\\|ftp\\|mailto\\|file\\|news\\|bbdb\\|vm\\|wl\\|rmail\\|gnus\\|shell\\):\\([^ " org-non-link-chars "]+\\)") 1744 "\\(https?\\|ftp\\|mailto\\|file\\|news\\|bbdb\\|vm\\|wl\\|rmail\\|gnus\\|shell\\):\\([^ " org-non-link-chars "]+\\)")
1607 ) 1745 )
1608 "Regular expression for matching links.") 1746 "Regular expression for matching links.")
1747(defconst org-link-maybe-angles-regexp
1748 (concat "<?\\(" org-link-regexp "\\)>?")
1749 "Matches a link and optionally surrounding angle brackets.")
1750(defconst org-protected-link-regexp
1751 (concat "\000" org-link-regexp "\000")
1752 "Matches a link and optionally surrounding angle brackets.")
1753
1609(defconst org-ts-lengths 1754(defconst org-ts-lengths
1610 (cons (length (format-time-string (car org-time-stamp-formats))) 1755 (cons (length (format-time-string (car org-time-stamp-formats)))
1611 (length (format-time-string (cdr org-time-stamp-formats)))) 1756 (length (format-time-string (cdr org-time-stamp-formats))))
@@ -1650,37 +1795,37 @@ The following commands are available:
1650(defun org-set-font-lock-defaults () 1795(defun org-set-font-lock-defaults ()
1651 (let ((org-font-lock-extra-keywords 1796 (let ((org-font-lock-extra-keywords
1652 (list 1797 (list
1653 '(org-activate-links (0 'org-link-face)) 1798 '(org-activate-links (0 'org-link))
1654 '(org-activate-dates (0 'org-link-face)) 1799 '(org-activate-dates (0 'org-link))
1655 (list (concat "^\\*+[ \t]*" org-not-done-regexp) 1800 (list (concat "^\\*+[ \t]*" org-not-done-regexp)
1656 '(1 'org-warning-face t)) 1801 '(1 'org-warning t))
1657 (list (concat "\\[#[A-Z]\\]") '(0 'org-warning-face t)) 1802 (list (concat "\\[#[A-Z]\\]") '(0 'org-warning t))
1658 (list (concat "\\<" org-deadline-string) '(0 'org-warning-face t)) 1803 (list (concat "\\<" org-deadline-string) '(0 'org-warning t))
1659 (list (concat "\\<" org-scheduled-string) '(0 'org-warning-face t)) 1804 (list (concat "\\<" org-scheduled-string) '(0 'org-warning t))
1660 ;; '("\\(\\s-\\|^\\)\\(\\*\\([a-zA-Z]+\\)\\*\\)\\([^a-zA-Z*]\\|$\\)" 1805 ;; '("\\(\\s-\\|^\\)\\(\\*\\([a-zA-Z]+\\)\\*\\)\\([^a-zA-Z*]\\|$\\)"
1661 ;; (3 'bold)) 1806 ;; (3 'bold))
1662 ;; '("\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)" 1807 ;; '("\\(\\s-\\|^\\)\\(/\\([a-zA-Z]+\\)/\\)\\([^a-zA-Z*]\\|$\\)"
1663 ;; (3 'italic)) 1808 ;; (3 'italic))
1664 ;; '("\\(\\s-\\|^\\)\\(_\\([a-zA-Z]+\\)_\\)\\([^a-zA-Z*]\\|$\\)" 1809 ;; '("\\(\\s-\\|^\\)\\(_\\([a-zA-Z]+\\)_\\)\\([^a-zA-Z*]\\|$\\)"
1665 ;; (3 'underline)) 1810 ;; (3 'underline))
1666 '("\\<FIXME\\>" (0 'org-warning-face t)) 1811 '("\\<FIXME\\>" (0 'org-warning t))
1667 (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\)\\>") 1812 (list (concat "^\\*+[ \t]*\\<\\(" org-comment-string "\\)\\>")
1668 '(1 'org-warning-face t)) 1813 '(1 'org-warning t))
1669 '("^#.*" (0 'font-lock-comment-face t)) 1814 '("^#.*" (0 'font-lock-comment-face t))
1670 (if org-fontify-done-headline 1815 (if org-fontify-done-headline
1671 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\(.*\\)\\>") 1816 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\(.*\\)\\>")
1672 '(1 'org-done-face t) '(2 'org-headline-done-face t)) 1817 '(1 'org-done t) '(2 'org-headline-done t))
1673 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>") 1818 (list (concat "^[*]+ +\\<\\(" org-done-string "\\)\\>")
1674 '(1 'org-done-face t))) 1819 '(1 'org-done t)))
1675 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" 1820 '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)"
1676 (1 'org-table-face t)) 1821 (1 'org-table t))
1677 '("^[ \t]*\\(:.*\\)" (1 'org-table-face t))))) 1822 '("^[ \t]*\\(:.*\\)" (1 'org-table t)))))
1678 (set (make-local-variable 'org-font-lock-keywords) 1823 (set (make-local-variable 'org-font-lock-keywords)
1679 (append 1824 (append
1680 (if org-noutline-p ; FIXME: I am not sure if eval will work 1825 (if org-noutline-p ; FIXME: I am not sure if eval will work
1681 ; on XEmacs if noutline is ever ported 1826 ; on XEmacs if noutline is ever ported
1682 '((eval . (list "^\\(\\*+\\).*" 1827 '((eval . (list "^\\(\\*+\\).*"
1683 0 '(nth 1828 0 '(nth
1684 (% (- (match-end 1) (match-beginning 1) 1) 1829 (% (- (match-end 1) (match-beginning 1) 1)
1685 org-n-levels) 1830 org-n-levels)
1686 org-level-faces) 1831 org-level-faces)
@@ -1694,7 +1839,7 @@ The following commands are available:
1694 (set (make-local-variable 'font-lock-defaults) 1839 (set (make-local-variable 'font-lock-defaults)
1695 '(org-font-lock-keywords t nil nil backward-paragraph)) 1840 '(org-font-lock-keywords t nil nil backward-paragraph))
1696 (kill-local-variable 'font-lock-keywords) nil)) 1841 (kill-local-variable 'font-lock-keywords) nil))
1697 1842
1698(defun org-unfontify-region (beg end &optional maybe_loudly) 1843(defun org-unfontify-region (beg end &optional maybe_loudly)
1699 "Remove fontification and activation overlays from links." 1844 "Remove fontification and activation overlays from links."
1700 (font-lock-default-unfontify-region beg end) 1845 (font-lock-default-unfontify-region beg end)
@@ -1885,12 +2030,12 @@ Optional argument N means, put the headline into the Nth line of the window."
1885(let ((cmds '(isearch-forward isearch-backward)) cmd) 2030(let ((cmds '(isearch-forward isearch-backward)) cmd)
1886 (while (setq cmd (pop cmds)) 2031 (while (setq cmd (pop cmds))
1887 (substitute-key-definition cmd cmd org-goto-map global-map))) 2032 (substitute-key-definition cmd cmd org-goto-map global-map)))
1888(define-key org-goto-map [(return)] 'org-goto-ret) 2033(define-key org-goto-map "\C-m" 'org-goto-ret)
1889(define-key org-goto-map [(left)] 'org-goto-left) 2034(define-key org-goto-map [(left)] 'org-goto-left)
1890(define-key org-goto-map [(right)] 'org-goto-right) 2035(define-key org-goto-map [(right)] 'org-goto-right)
1891(define-key org-goto-map [(?q)] 'org-goto-quit) 2036(define-key org-goto-map [(?q)] 'org-goto-quit)
1892(define-key org-goto-map [(control ?g)] 'org-goto-quit) 2037(define-key org-goto-map [(control ?g)] 'org-goto-quit)
1893(define-key org-goto-map [(tab)] 'org-cycle) 2038(define-key org-goto-map "\C-i" 'org-cycle)
1894(define-key org-goto-map [(down)] 'outline-next-visible-heading) 2039(define-key org-goto-map [(down)] 'outline-next-visible-heading)
1895(define-key org-goto-map [(up)] 'outline-previous-visible-heading) 2040(define-key org-goto-map [(up)] 'outline-previous-visible-heading)
1896(define-key org-goto-map "n" 'outline-next-visible-heading) 2041(define-key org-goto-map "n" 'outline-next-visible-heading)
@@ -2094,7 +2239,7 @@ in the region."
2094 (org-back-to-heading t) 2239 (org-back-to-heading t)
2095 (let* ((level (save-match-data (funcall outline-level))) 2240 (let* ((level (save-match-data (funcall outline-level)))
2096 (up-head (make-string (1- level) ?*))) 2241 (up-head (make-string (1- level) ?*)))
2097 (if (= level 1) (error "Cannot promote to level 0. UNDO to recover.")) 2242 (if (= level 1) (error "Cannot promote to level 0. UNDO to recover"))
2098 (replace-match up-head nil t) 2243 (replace-match up-head nil t)
2099 (if org-adapt-indentation 2244 (if org-adapt-indentation
2100 (org-fixup-indentation "^ " "" "^ ?\\S-")))) 2245 (org-fixup-indentation "^ " "" "^ ?\\S-"))))
@@ -2275,15 +2420,21 @@ If optional TREE is given, use this text instead of the kill ring."
2275 (- (match-end 0) (match-beginning 0))) 2420 (- (match-end 0) (match-beginning 0)))
2276 (t nil))) 2421 (t nil)))
2277 (previous-level (save-excursion 2422 (previous-level (save-excursion
2278 (outline-previous-visible-heading 1) 2423 (condition-case nil
2279 (if (looking-at re) 2424 (progn
2280 (- (match-end 0) (match-beginning 0)) 2425 (outline-previous-visible-heading 1)
2281 1))) 2426 (if (looking-at re)
2427 (- (match-end 0) (match-beginning 0))
2428 1))
2429 (error 1))))
2282 (next-level (save-excursion 2430 (next-level (save-excursion
2283 (outline-next-visible-heading 1) 2431 (condition-case nil
2284 (if (looking-at re) 2432 (progn
2285 (- (match-end 0) (match-beginning 0)) 2433 (outline-next-visible-heading 1)
2286 1))) 2434 (if (looking-at re)
2435 (- (match-end 0) (match-beginning 0))
2436 1))
2437 (error 1))))
2287 (new-level (or force-level (max previous-level next-level))) 2438 (new-level (or force-level (max previous-level next-level)))
2288 (shift (if (or (= old-level -1) 2439 (shift (if (or (= old-level -1)
2289 (= new-level -1) 2440 (= new-level -1)
@@ -2342,6 +2493,102 @@ If optional TXT is given, check this string instead of the current kill."
2342 (throw 'exit nil))) 2493 (throw 'exit nil)))
2343 t)))) 2494 t))))
2344 2495
2496(defun org-archive-subtree ()
2497 "Move the current subtree to the archive.
2498The archive can be a certain top-level heading in the current file, or in
2499a different file. The tree will be moved to that location, the subtree
2500heading be marked DONE, and the current time will be added."
2501 (interactive)
2502 ;; Save all relevant TODO keyword-relatex variables
2503 (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler
2504 (tr-org-todo-keywords org-todo-keywords)
2505 (tr-org-todo-interpretation org-todo-interpretation)
2506 (tr-org-done-string org-done-string)
2507 (tr-org-todo-regexp org-todo-regexp)
2508 (tr-org-todo-line-regexp org-todo-line-regexp)
2509 (this-buffer (current-buffer))
2510 file heading buffer level newfile-p)
2511 (if (string-match "\\(.*\\)::\\(.*\\)" org-archive-location)
2512 (progn
2513 (setq file (format (match-string 1 org-archive-location)
2514 (file-name-nondirectory (buffer-file-name)))
2515 heading (match-string 2 org-archive-location)))
2516 (error "Invalid `org-archive-location'"))
2517 (if (> (length file) 0)
2518 (setq newfile-p (not (file-exists-p file))
2519 buffer (find-file-noselect file))
2520 (setq buffer (current-buffer)))
2521 (unless buffer
2522 (error "Cannot access file \"%s\"" file))
2523 (if (and (> (length heading) 0)
2524 (string-match "^\\*+" heading))
2525 (setq level (match-end 0))
2526 (setq heading nil level 0))
2527 (save-excursion
2528 (org-copy-subtree) ; We first only copy, in case something goes wrong
2529 (set-buffer buffer)
2530 ;; Enforce org-mode for the archive buffer
2531 (if (not (eq major-mode 'org-mode))
2532 ;; Force the mode for future visits.
2533 (let ((org-insert-mode-line-in-empty-file t))
2534 (call-interactively 'org-mode)))
2535 (when newfile-p
2536 (goto-char (point-max))
2537 (insert (format "\nArchived entries from file %s\n\n"
2538 (buffer-file-name this-buffer))))
2539 ;; Force the TODO keywords of the original buffer
2540 (let ((org-todo-line-regexp tr-org-todo-line-regexp)
2541 (org-todo-keywords tr-org-todo-keywords)
2542 (org-todo-interpretation tr-org-todo-interpretation)
2543 (org-done-string tr-org-done-string)
2544 (org-todo-regexp tr-org-todo-regexp)
2545 (org-todo-line-regexp tr-org-todo-line-regexp))
2546 (goto-char (point-min))
2547 (if heading
2548 (progn
2549 (if (re-search-forward
2550 (concat "\\(^\\|\r\\)"
2551 (regexp-quote heading) "[ \t]*\\($\\|\r\\)")
2552 nil t)
2553 (goto-char (match-end 0))
2554 ;; Heading not found, just insert it at the end
2555 (goto-char (point-max))
2556 (or (bolp) (insert "\n"))
2557 (insert "\n" heading "\n")
2558 (end-of-line 0))
2559 ;; Make the heading visible, and the following as well
2560 (let ((org-show-following-heading t)) (org-show-hierarchy-above))
2561 (if (re-search-forward
2562 (concat "^" (regexp-quote (make-string level ?*)) "[ \t]")
2563 nil t)
2564 (progn (goto-char (match-beginning 0)) (insert "\n")
2565 (beginning-of-line 0))
2566 (goto-char (point-max)) (insert "\n")))
2567 (goto-char (point-max)) (insert "\n"))
2568 ;; Paste
2569 (org-paste-subtree (1+ level))
2570 ;; Mark the entry as done, i.e. set to last work in org-todo-keywords
2571 (if org-archive-mark-done
2572 (org-todo (length org-todo-keywords)))
2573 ;; Move cursor to right after the TODO keyword
2574 (when org-archive-stamp-time
2575 (beginning-of-line 1)
2576 (looking-at org-todo-line-regexp)
2577 (goto-char (or (match-end 2) (match-beginning 3)))
2578 (insert "(" (format-time-string (cdr org-time-stamp-formats)
2579 (current-time))
2580 ")"))
2581 ;; Save the buffer, if it is not the same buffer.
2582 (if (not (eq this-buffer buffer)) (save-buffer))))
2583 ;; Here we are back in the original buffer. Everything seems to have
2584 ;; worked. So now cut the tree and finish up.
2585 (org-cut-subtree)
2586 (if (looking-at "[ \t]*$") (kill-line))
2587 (message "Subtree archived %s"
2588 (if (eq this-buffer buffer)
2589 (concat "under heading: " heading)
2590 (concat "in file: " (abbreviate-file-name file))))))
2591
2345;;; Completion 2592;;; Completion
2346 2593
2347(defun org-complete (&optional arg) 2594(defun org-complete (&optional arg)
@@ -2370,11 +2617,11 @@ At all other locations, this simply calls `ispell-complete-word'."
2370 (table (cond 2617 (table (cond
2371 (opt 2618 (opt
2372 (setq type :opt) 2619 (setq type :opt)
2373 (mapcar (lambda (x) 2620 (mapcar (lambda (x)
2374 (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x) 2621 (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x)
2375 (cons (match-string 2 x) (match-string 1 x))) 2622 (cons (match-string 2 x) (match-string 1 x)))
2376 (org-split-string (org-get-current-options) "\n"))) 2623 (org-split-string (org-get-current-options) "\n")))
2377 (texp 2624 (texp
2378 (setq type :tex) 2625 (setq type :tex)
2379 org-html-entities) 2626 org-html-entities)
2380 ((string-match "\\`\\*+[ \t]*\\'" 2627 ((string-match "\\`\\*+[ \t]*\\'"
@@ -2384,7 +2631,7 @@ At all other locations, this simply calls `ispell-complete-word'."
2384 (t (progn (ispell-complete-word arg) (throw 'exit nil))))) 2631 (t (progn (ispell-complete-word arg) (throw 'exit nil)))))
2385 (completion (try-completion pattern table))) 2632 (completion (try-completion pattern table)))
2386 (cond ((eq completion t) 2633 (cond ((eq completion t)
2387 (if (equal type :opt) 2634 (if (equal type :opt)
2388 (insert (substring (cdr (assoc (upcase pattern) table)) 2635 (insert (substring (cdr (assoc (upcase pattern) table))
2389 (length pattern))))) 2636 (length pattern)))))
2390 ((null completion) 2637 ((null completion)
@@ -2392,7 +2639,7 @@ At all other locations, this simply calls `ispell-complete-word'."
2392 (ding)) 2639 (ding))
2393 ((not (string= pattern completion)) 2640 ((not (string= pattern completion))
2394 (delete-region beg end) 2641 (delete-region beg end)
2395 (if (string-match " +$" completion) 2642 (if (string-match " +$" completion)
2396 (setq completion (replace-match "" t t completion))) 2643 (setq completion (replace-match "" t t completion)))
2397 (insert completion) 2644 (insert completion)
2398 (if (get-buffer-window "*Completions*") 2645 (if (get-buffer-window "*Completions*")
@@ -2629,9 +2876,9 @@ ACTION can be set, up, or down."
2629 (save-match-data 2876 (save-match-data
2630 (if (not (string-match org-priority-regexp s)) 2877 (if (not (string-match org-priority-regexp s))
2631 (* 1000 (- org-lowest-priority org-default-priority)) 2878 (* 1000 (- org-lowest-priority org-default-priority))
2632 (* 1000 (- org-lowest-priority 2879 (* 1000 (- org-lowest-priority
2633 (string-to-char (match-string 2 s))))))) 2880 (string-to-char (match-string 2 s)))))))
2634 2881
2635;;; Timestamps 2882;;; Timestamps
2636 2883
2637(defvar org-last-changed-timestamp nil) 2884(defvar org-last-changed-timestamp nil)
@@ -2663,7 +2910,7 @@ at the cursor, it will be modified."
2663 (setq time (let ((this-command this-command)) 2910 (setq time (let ((this-command this-command))
2664 (org-read-date arg 'totime))) 2911 (org-read-date arg 'totime)))
2665 (and (org-at-timestamp-p) (replace-match 2912 (and (org-at-timestamp-p) (replace-match
2666 (setq org-last-changed-timestamp 2913 (setq org-last-changed-timestamp
2667 (format-time-string fmt time)) 2914 (format-time-string fmt time))
2668 t t)) 2915 t t))
2669 (message "Timestamp updated")) 2916 (message "Timestamp updated"))
@@ -2693,8 +2940,8 @@ but this can be configured with the variables `parse-time-months' and
2693 2940
2694While prompting, a calendar is popped up - you can also select the 2941While prompting, a calendar is popped up - you can also select the
2695date with the mouse (button 1). The calendar shows a period of three 2942date with the mouse (button 1). The calendar shows a period of three
2696month. To scroll it to other months, use the keys `>' and `<'. 2943month. To scroll it to other months, use the keys `>' and `<'.
2697If you don't like the calendar, turn it off with 2944If you don't like the calendar, turn it off with
2698 \(setq org-popup-calendar-for-date-prompt nil). 2945 \(setq org-popup-calendar-for-date-prompt nil).
2699 2946
2700With optional argument TO-TIME, the date will immediately be converted 2947With optional argument TO-TIME, the date will immediately be converted
@@ -2708,7 +2955,7 @@ used to insert the time stamp into the buffer to include the time."
2708 ;; Default time is either today, or, when entering a range, 2955 ;; Default time is either today, or, when entering a range,
2709 ;; the range start. 2956 ;; the range start.
2710 (if (save-excursion 2957 (if (save-excursion
2711 (re-search-backward 2958 (re-search-backward
2712 (concat org-ts-regexp "--\\=") 2959 (concat org-ts-regexp "--\\=")
2713 (- (point) 20) t)) 2960 (- (point) 20) t))
2714 (apply 2961 (apply
@@ -2819,7 +3066,7 @@ This is used by `org-read-date' in a temporary keymap for the calendar buffer."
2819 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) 3066 (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
2820 (setq ans1 (format-time-string "%Y-%m-%d" time))) 3067 (setq ans1 (format-time-string "%Y-%m-%d" time)))
2821 (if (active-minibuffer-window) (exit-minibuffer)))) 3068 (if (active-minibuffer-window) (exit-minibuffer))))
2822 3069
2823(defun org-check-deadlines (ndays) 3070(defun org-check-deadlines (ndays)
2824 "Check if there are any deadlines due or past due. 3071 "Check if there are any deadlines due or past due.
2825A deadline is considered due if it happens within `org-deadline-warning-days' 3072A deadline is considered due if it happens within `org-deadline-warning-days'
@@ -2859,7 +3106,7 @@ days in order to avoid rounding problems."
2859 (goto-char (point-at-bol)) 3106 (goto-char (point-at-bol))
2860 (re-search-forward org-tr-regexp (point-at-eol) t)) 3107 (re-search-forward org-tr-regexp (point-at-eol) t))
2861 (if (not (org-at-date-range-p)) 3108 (if (not (org-at-date-range-p))
2862 (error "Not at a time-stamp range, and none found in current line."))) 3109 (error "Not at a time-stamp range, and none found in current line")))
2863 (let* ((ts1 (match-string 1)) 3110 (let* ((ts1 (match-string 1))
2864 (ts2 (match-string 2)) 3111 (ts2 (match-string 2))
2865 (havetime (or (> (length ts1) 15) (> (length ts2) 15))) 3112 (havetime (or (> (length ts1) 15) (> (length ts2) 15)))
@@ -3092,6 +3339,7 @@ If there is already a time stamp at the cursor position, update it."
3092(defvar org-agenda-follow-mode nil) 3339(defvar org-agenda-follow-mode nil)
3093(defvar org-agenda-buffer-name "*Org Agenda*") 3340(defvar org-agenda-buffer-name "*Org Agenda*")
3094(defvar org-agenda-redo-command nil) 3341(defvar org-agenda-redo-command nil)
3342(defvar org-agenda-mode-hook nil)
3095 3343
3096;;;###autoload 3344;;;###autoload
3097(defun org-agenda-mode () 3345(defun org-agenda-mode ()
@@ -3110,27 +3358,29 @@ The following commands are available:
3110 (add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local) 3358 (add-hook 'post-command-hook 'org-agenda-post-command-hook nil 'local)
3111 (add-hook 'pre-command-hook 'org-unhighlight nil 'local) 3359 (add-hook 'pre-command-hook 'org-unhighlight nil 'local)
3112 (setq org-agenda-follow-mode nil) 3360 (setq org-agenda-follow-mode nil)
3113 (easy-menu-change 3361 (easy-menu-change
3114 '("Agenda") "Agenda Files" 3362 '("Agenda") "Agenda Files"
3115 (append 3363 (append
3116 (list 3364 (list
3117 ["Edit File List" (customize-variable 'org-agenda-files) t] 3365 ["Edit File List" (customize-variable 'org-agenda-files) t]
3118 "--") 3366 "--")
3119 (mapcar 'org-file-menu-entry org-agenda-files))) 3367 (mapcar 'org-file-menu-entry org-agenda-files)))
3120 (org-agenda-set-mode-name) 3368 (org-agenda-set-mode-name)
3121 (run-mode-hooks 'org-agenda-mode-hook)) 3369 (apply
3370 (if (fboundp 'run-mode-hooks) 'run-mode-hooks 'run-hooks)
3371 org-agenda-mode-hook))
3122 3372
3123(define-key org-agenda-mode-map [(tab)] 'org-agenda-goto) 3373(define-key org-agenda-mode-map "\C-i" 'org-agenda-goto)
3124(define-key org-agenda-mode-map [(return)] 'org-agenda-switch-to) 3374(define-key org-agenda-mode-map "\C-m" 'org-agenda-switch-to)
3125(define-key org-agenda-mode-map " " 'org-agenda-show) 3375(define-key org-agenda-mode-map " " 'org-agenda-show)
3126(define-key org-agenda-mode-map "\C-c\C-t" 'org-agenda-todo) 3376(define-key org-agenda-mode-map "\C-c\C-t" 'org-agenda-todo)
3127(define-key org-agenda-mode-map "o" 'delete-other-windows) 3377(define-key org-agenda-mode-map "o" 'delete-other-windows)
3128(define-key org-agenda-mode-map "l" 'org-agenda-recenter) 3378(define-key org-agenda-mode-map "l" 'org-agenda-recenter)
3129(define-key org-agenda-mode-map "t" 'org-agenda-todo) 3379(define-key org-agenda-mode-map "t" 'org-agenda-todo)
3130(define-key org-agenda-mode-map "." 'org-agenda-goto-today) 3380(define-key org-agenda-mode-map "." 'org-agenda-goto-today)
3131(define-key org-agenda-mode-map "w" 'org-agenda-toggle-week-view) 3381(define-key org-agenda-mode-map "w" 'org-agenda-toggle-week-view)
3132(define-key org-agenda-mode-map [(shift right)] 'org-agenda-date-later) 3382(define-key org-agenda-mode-map (org-key 'S-right) 'org-agenda-date-later)
3133(define-key org-agenda-mode-map [(shift left)] 'org-agenda-date-earlier) 3383(define-key org-agenda-mode-map (org-key 'S-left) 'org-agenda-date-earlier)
3134 3384
3135(define-key org-agenda-mode-map ">" 'org-agenda-date-prompt) 3385(define-key org-agenda-mode-map ">" 'org-agenda-date-prompt)
3136(let ((l '(1 2 3 4 5 6 7 8 9 0))) 3386(let ((l '(1 2 3 4 5 6 7 8 9 0)))
@@ -3164,15 +3414,15 @@ The following commands are available:
3164(define-key org-agenda-mode-map "H" 'org-agenda-holidays) 3414(define-key org-agenda-mode-map "H" 'org-agenda-holidays)
3165(define-key org-agenda-mode-map "+" 'org-agenda-priority-up) 3415(define-key org-agenda-mode-map "+" 'org-agenda-priority-up)
3166(define-key org-agenda-mode-map "-" 'org-agenda-priority-down) 3416(define-key org-agenda-mode-map "-" 'org-agenda-priority-down)
3167(define-key org-agenda-mode-map [(shift up)] 'org-agenda-priority-up) 3417(define-key org-agenda-mode-map (org-key 'S-up) 'org-agenda-priority-up)
3168(define-key org-agenda-mode-map [(shift down)] 'org-agenda-priority-down) 3418(define-key org-agenda-mode-map (org-key 'S-down) 'org-agenda-priority-down)
3169(define-key org-agenda-mode-map [(right)] 'org-agenda-later) 3419(define-key org-agenda-mode-map [(right)] 'org-agenda-later)
3170(define-key org-agenda-mode-map [(left)] 'org-agenda-earlier) 3420(define-key org-agenda-mode-map [(left)] 'org-agenda-earlier)
3171 3421
3172(defvar org-agenda-keymap (copy-keymap org-agenda-mode-map) 3422(defvar org-agenda-keymap (copy-keymap org-agenda-mode-map)
3173 "Local keymap for agenda entries from Org-mode.") 3423 "Local keymap for agenda entries from Org-mode.")
3174 3424
3175(define-key org-agenda-keymap 3425(define-key org-agenda-keymap
3176 (if org-xemacs-p [(button2)] [(mouse-2)]) 'org-agenda-goto-mouse) 3426 (if org-xemacs-p [(button2)] [(mouse-2)]) 'org-agenda-goto-mouse)
3177(define-key org-agenda-keymap 3427(define-key org-agenda-keymap
3178 (if org-xemacs-p [(button3)] [(mouse-3)]) 'org-agenda-show-mouse) 3428 (if org-xemacs-p [(button3)] [(mouse-3)]) 'org-agenda-show-mouse)
@@ -3184,7 +3434,7 @@ The following commands are available:
3184 ["Show" org-agenda-show t] 3434 ["Show" org-agenda-show t]
3185 ["Go To (other window)" org-agenda-goto t] 3435 ["Go To (other window)" org-agenda-goto t]
3186 ["Go To (one window)" org-agenda-switch-to t] 3436 ["Go To (one window)" org-agenda-switch-to t]
3187 ["Follow Mode" org-agenda-follow-mode 3437 ["Follow Mode" org-agenda-follow-mode
3188 :style toggle :selected org-agenda-follow-mode :active t] 3438 :style toggle :selected org-agenda-follow-mode :active t]
3189 "--" 3439 "--"
3190 ["Cycle TODO" org-agenda-todo t] 3440 ["Cycle TODO" org-agenda-todo t]
@@ -3302,7 +3552,7 @@ dates."
3302 (org-respect-restriction t) 3552 (org-respect-restriction t)
3303 (past t) 3553 (past t)
3304 s e rtn d) 3554 s e rtn d)
3305 (setq org-agenda-redo-command 3555 (setq org-agenda-redo-command
3306 (list 'progn 3556 (list 'progn
3307 (list 'switch-to-buffer-other-window (current-buffer)) 3557 (list 'switch-to-buffer-other-window (current-buffer))
3308 (list 'org-timeline include-all))) 3558 (list 'org-timeline include-all)))
@@ -3311,7 +3561,7 @@ dates."
3311 (setq day-numbers (delq nil (mapcar (lambda(x) 3561 (setq day-numbers (delq nil (mapcar (lambda(x)
3312 (if (>= x today) x nil)) 3562 (if (>= x today) x nil))
3313 day-numbers)))) 3563 day-numbers))))
3314 (switch-to-buffer-other-window 3564 (switch-to-buffer-other-window
3315 (get-buffer-create org-agenda-buffer-name)) 3565 (get-buffer-create org-agenda-buffer-name))
3316 (setq buffer-read-only nil) 3566 (setq buffer-read-only nil)
3317 (erase-buffer) 3567 (erase-buffer)
@@ -3326,7 +3576,7 @@ dates."
3326 (setq date (calendar-gregorian-from-absolute d)) 3576 (setq date (calendar-gregorian-from-absolute d))
3327 (setq s (point)) 3577 (setq s (point))
3328 (if dotodo 3578 (if dotodo
3329 (setq rtn (org-agenda-get-day-entries 3579 (setq rtn (org-agenda-get-day-entries
3330 entry date :todo :timestamp)) 3580 entry date :todo :timestamp))
3331 (setq rtn (org-agenda-get-day-entries entry date :timestamp))) 3581 (setq rtn (org-agenda-get-day-entries entry date :timestamp)))
3332 (if (or rtn (equal d today)) 3582 (if (or rtn (equal d today))
@@ -3336,7 +3586,7 @@ dates."
3336 (calendar-month-name (extract-calendar-month date)) " " 3586 (calendar-month-name (extract-calendar-month date)) " "
3337 (number-to-string (extract-calendar-year date)) "\n") 3587 (number-to-string (extract-calendar-year date)) "\n")
3338 (put-text-property s (1- (point)) 'face 3588 (put-text-property s (1- (point)) 'face
3339 'org-link-face) 3589 'org-link)
3340 (if (equal d today) 3590 (if (equal d today)
3341 (put-text-property s (1- (point)) 'org-today t)) 3591 (put-text-property s (1- (point)) 'org-today t))
3342 (insert (org-finalize-agenda-entries rtn) "\n") 3592 (insert (org-finalize-agenda-entries rtn) "\n")
@@ -3382,7 +3632,7 @@ NDAYS defaults to `org-agenda-ndays'."
3382 (day-numbers (list start)) 3632 (day-numbers (list start))
3383 (inhibit-redisplay t) 3633 (inhibit-redisplay t)
3384 s e rtn rtnall file date d start-pos end-pos todayp nd) 3634 s e rtn rtnall file date d start-pos end-pos todayp nd)
3385 (setq org-agenda-redo-command 3635 (setq org-agenda-redo-command
3386 (list 'org-agenda include-all start-day ndays)) 3636 (list 'org-agenda include-all start-day ndays))
3387 ;; Make the list of days 3637 ;; Make the list of days
3388 (setq ndays (or ndays org-agenda-ndays) 3638 (setq ndays (or ndays org-agenda-ndays)
@@ -3394,7 +3644,7 @@ NDAYS defaults to `org-agenda-ndays'."
3394 (if (not (equal (current-buffer) (get-buffer org-agenda-buffer-name))) 3644 (if (not (equal (current-buffer) (get-buffer org-agenda-buffer-name)))
3395 (progn 3645 (progn
3396 (delete-other-windows) 3646 (delete-other-windows)
3397 (switch-to-buffer-other-window 3647 (switch-to-buffer-other-window
3398 (get-buffer-create org-agenda-buffer-name)))) 3648 (get-buffer-create org-agenda-buffer-name))))
3399 (setq buffer-read-only nil) 3649 (setq buffer-read-only nil)
3400 (erase-buffer) 3650 (erase-buffer)
@@ -3412,10 +3662,10 @@ NDAYS defaults to `org-agenda-ndays'."
3412 rtn (org-agenda-get-day-entries 3662 rtn (org-agenda-get-day-entries
3413 file date :todo)) 3663 file date :todo))
3414 (setq rtnall (append rtnall rtn)))) 3664 (setq rtnall (append rtnall rtn))))
3415 (when rtnall 3665 (when rtnall
3416 (insert "ALL CURRENTLY OPEN TODO ITEMS:\n") 3666 (insert "ALL CURRENTLY OPEN TODO ITEMS:\n")
3417 (add-text-properties (point-min) (1- (point)) 3667 (add-text-properties (point-min) (1- (point))
3418 (list 'face 'org-link-face)) 3668 (list 'face 'org-link))
3419 (insert (org-finalize-agenda-entries rtnall) "\n"))) 3669 (insert (org-finalize-agenda-entries rtnall) "\n")))
3420 (while (setq d (pop day-numbers)) 3670 (while (setq d (pop day-numbers))
3421 (setq date (calendar-gregorian-from-absolute d) 3671 (setq date (calendar-gregorian-from-absolute d)
@@ -3445,13 +3695,13 @@ NDAYS defaults to `org-agenda-ndays'."
3445 (calendar-month-name (extract-calendar-month date)) 3695 (calendar-month-name (extract-calendar-month date))
3446 (extract-calendar-year date))) 3696 (extract-calendar-year date)))
3447 (put-text-property s (1- (point)) 'face 3697 (put-text-property s (1- (point)) 'face
3448 'org-link-face) 3698 'org-link)
3449 (if rtnall (insert 3699 (if rtnall (insert
3450 (org-finalize-agenda-entries ;; FIXME: condition needed 3700 (org-finalize-agenda-entries ;; FIXME: condition needed
3451 (org-agenda-add-time-grid-maybe 3701 (org-agenda-add-time-grid-maybe
3452 rtnall nd todayp)) 3702 rtnall nd todayp))
3453 "\n")) 3703 "\n"))
3454 (put-text-property s (1- (point)) 'day d)))) 3704 (put-text-property s (1- (point)) 'day d))))
3455 (goto-char (point-min)) 3705 (goto-char (point-min))
3456 (setq buffer-read-only t) 3706 (setq buffer-read-only t)
3457 (if org-fit-agenda-window 3707 (if org-fit-agenda-window
@@ -3541,7 +3791,7 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
3541 (error "Not allowed")) 3791 (error "Not allowed"))
3542 (setq org-agenda-ndays 3792 (setq org-agenda-ndays
3543 (if (equal org-agenda-ndays 1) 7 1)) 3793 (if (equal org-agenda-ndays 1) 7 1))
3544 (org-agenda include-all-loc 3794 (org-agenda include-all-loc
3545 (or (get-text-property (point) 'day) 3795 (or (get-text-property (point) 'day)
3546 starting-day)) 3796 starting-day))
3547 (org-agenda-set-mode-name) 3797 (org-agenda-set-mode-name)
@@ -3556,7 +3806,7 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
3556 (if (not (re-search-forward "^\\S-" nil t arg)) 3806 (if (not (re-search-forward "^\\S-" nil t arg))
3557 (progn 3807 (progn
3558 (backward-char 1) 3808 (backward-char 1)
3559 (error "No next date after this line in this buffer."))) 3809 (error "No next date after this line in this buffer")))
3560 (goto-char (match-beginning 0))) 3810 (goto-char (match-beginning 0)))
3561 3811
3562(defun org-agenda-previous-date-line (&optional arg) 3812(defun org-agenda-previous-date-line (&optional arg)
@@ -3564,7 +3814,7 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
3564 (interactive "p") 3814 (interactive "p")
3565 (beginning-of-line 1) 3815 (beginning-of-line 1)
3566 (if (not (re-search-backward "^\\S-" nil t arg)) 3816 (if (not (re-search-backward "^\\S-" nil t arg))
3567 (error "No previous date before this line in this buffer."))) 3817 (error "No previous date before this line in this buffer")))
3568 3818
3569;; Initialize the highlight 3819;; Initialize the highlight
3570(defvar org-hl (funcall (if org-xemacs-p 'make-extent 'make-overlay) 1 1)) 3820(defvar org-hl (funcall (if org-xemacs-p 'make-extent 'make-overlay) 1 1))
@@ -3630,7 +3880,7 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
3630 "Get the (Emacs Calendar) diary entries for DATE." 3880 "Get the (Emacs Calendar) diary entries for DATE."
3631 (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*") 3881 (let* ((fancy-diary-buffer "*temporary-fancy-diary-buffer*")
3632 (diary-display-hook '(fancy-diary-display)) 3882 (diary-display-hook '(fancy-diary-display))
3633 (list-diary-entries-hook 3883 (list-diary-entries-hook
3634 (cons 'org-diary-default-entry list-diary-entries-hook)) 3884 (cons 'org-diary-default-entry list-diary-entries-hook))
3635 entries 3885 entries
3636 (org-disable-diary t)) 3886 (org-disable-diary t))
@@ -3654,12 +3904,12 @@ With prefix ARG, go back that many times `org-agenda-ndays'."
3654 (kill-buffer fancy-diary-buffer))) 3904 (kill-buffer fancy-diary-buffer)))
3655 (when entries 3905 (when entries
3656 (setq entries (org-split-string entries "\n")) 3906 (setq entries (org-split-string entries "\n"))
3657 (setq entries 3907 (setq entries
3658 (mapcar 3908 (mapcar
3659 (lambda (x) 3909 (lambda (x)
3660 (setq x (org-format-agenda-item "" x "Diary" 'time)) 3910 (setq x (org-format-agenda-item "" x "Diary" 'time))
3661 ;; Extend the text properties to the beginning of the line 3911 ;; Extend the text properties to the beginning of the line
3662 (add-text-properties 3912 (add-text-properties
3663 0 (length x) 3913 0 (length x)
3664 (text-properties-at (1- (length x)) x) 3914 (text-properties-at (1- (length x)) x)
3665 x) 3915 x)
@@ -3700,7 +3950,7 @@ date. Itt also removes lines that contain only whitespace."
3700 0 (length string) 3950 0 (length string)
3701 (list 'mouse-face 'highlight 3951 (list 'mouse-face 'highlight
3702 'keymap org-agenda-keymap 3952 'keymap org-agenda-keymap
3703 'help-echo 3953 'help-echo
3704 (format 3954 (format
3705 "mouse-2 or RET jump to diary file %s" 3955 "mouse-2 or RET jump to diary file %s"
3706 (abbreviate-file-name (buffer-file-name))) 3956 (abbreviate-file-name (buffer-file-name)))
@@ -3722,7 +3972,7 @@ Needed to avoid empty dates which mess up holiday display."
3722These are the files which are being checked for agenda entries. 3972These are the files which are being checked for agenda entries.
3723Optional argument FILE means, use this file instead of the current. 3973Optional argument FILE means, use this file instead of the current.
3724It is possible (but not recommended) to add this function to the 3974It is possible (but not recommended) to add this function to the
3725`org-mode-hook'." 3975`org-mode-hook'."
3726 (interactive) 3976 (interactive)
3727 (catch 'exit 3977 (catch 'exit
3728 (let* ((file (or file (buffer-file-name) 3978 (let* ((file (or file (buffer-file-name)
@@ -3737,7 +3987,7 @@ It is possible (but not recommended) to add this function to the
3737 org-agenda-files)))) 3987 org-agenda-files))))
3738 (if (not present) 3988 (if (not present)
3739 (progn 3989 (progn
3740 (setq org-agenda-files 3990 (setq org-agenda-files
3741 (cons afile org-agenda-files)) 3991 (cons afile org-agenda-files))
3742 ;; Make sure custom.el does not end up with Org-mode 3992 ;; Make sure custom.el does not end up with Org-mode
3743 (let ((org-mode-hook nil) (default-major-mode 'fundamental-mode)) 3993 (let ((org-mode-hook nil) (default-major-mode 'fundamental-mode))
@@ -3754,7 +4004,7 @@ Optional argument FILE means, use this file instead of the current."
3754 (let* ((file (or file (buffer-file-name))) 4004 (let* ((file (or file (buffer-file-name)))
3755 (true-file (file-truename file)) 4005 (true-file (file-truename file))
3756 (afile (abbreviate-file-name file)) 4006 (afile (abbreviate-file-name file))
3757 (files (delq nil (mapcar 4007 (files (delq nil (mapcar
3758 (lambda (x) 4008 (lambda (x)
3759 (if (equal true-file 4009 (if (equal true-file
3760 (file-truename x)) 4010 (file-truename x))
@@ -3839,7 +4089,7 @@ also be written as
3839 4089
3840The function expects the lisp variables `entry' and `date' to be provided 4090The function expects the lisp variables `entry' and `date' to be provided
3841by the caller, because this is how the calendar works. Don't use this 4091by the caller, because this is how the calendar works. Don't use this
3842function from a program - use `org-agenda-get-day-entries' instead." 4092function from a program - use `org-agenda-get-day-entries' instead."
3843 (org-agenda-maybe-reset-markers) 4093 (org-agenda-maybe-reset-markers)
3844 (org-compile-agenda-prefix-format org-agenda-prefix-format) 4094 (org-compile-agenda-prefix-format org-agenda-prefix-format)
3845 (setq args (or args '(:deadline :scheduled :timestamp))) 4095 (setq args (or args '(:deadline :scheduled :timestamp)))
@@ -3881,7 +4131,7 @@ the documentation of `org-diary'."
3881 (if (org-region-active-p) 4131 (if (org-region-active-p)
3882 ;; Respect a region to restrict search 4132 ;; Respect a region to restrict search
3883 (narrow-to-region (region-beginning) (region-end))) 4133 (narrow-to-region (region-beginning) (region-end)))
3884 ;; If we work for the calendar or many files, 4134 ;; If we work for the calendar or many files,
3885 ;; get rid of any restriction 4135 ;; get rid of any restriction
3886 (widen)) 4136 (widen))
3887 ;; The way we repeatedly append to `results' makes it O(n^2) :-( 4137 ;; The way we repeatedly append to `results' makes it O(n^2) :-(
@@ -3932,7 +4182,7 @@ the documentation of `org-diary'."
3932(defun org-agenda-get-todos () 4182(defun org-agenda-get-todos ()
3933 "Return the TODO information for agenda display." 4183 "Return the TODO information for agenda display."
3934 (let* ((props (list 'face nil 4184 (let* ((props (list 'face nil
3935 'done-face 'org-done-face 4185 'done-face 'org-done
3936 'mouse-face 'highlight 4186 'mouse-face 'highlight
3937 'keymap org-agenda-keymap 4187 'keymap org-agenda-keymap
3938 'help-echo 4188 'help-echo
@@ -3947,7 +4197,7 @@ the documentation of `org-diary'."
3947 (goto-char (match-beginning 1)) 4197 (goto-char (match-beginning 1))
3948 (setq marker (org-agenda-new-marker (point-at-bol)) 4198 (setq marker (org-agenda-new-marker (point-at-bol))
3949 txt (org-format-agenda-item "" (match-string 1)) 4199 txt (org-format-agenda-item "" (match-string 1))
3950 priority 4200 priority
3951 (+ (org-get-priority txt) 4201 (+ (org-get-priority txt)
3952 (if org-todo-kwd-priority-p 4202 (if org-todo-kwd-priority-p
3953 (- org-todo-kwd-max-priority -2 4203 (- org-todo-kwd-max-priority -2
@@ -4019,18 +4269,18 @@ the documentation of `org-diary'."
4019 (if deadlinep 4269 (if deadlinep
4020 (add-text-properties 4270 (add-text-properties
4021 0 (length txt) 4271 0 (length txt)
4022 (list 'face 4272 (list 'face
4023 (if donep 'org-done-face 'org-warning-face) 4273 (if donep 'org-done 'org-warning)
4024 'undone-face 'org-warning-face 4274 'undone-face 'org-warning
4025 'done-face 'org-done-face 4275 'done-face 'org-done
4026 'priority (+ 100 priority)) 4276 'priority (+ 100 priority))
4027 txt) 4277 txt)
4028 (if scheduledp 4278 (if scheduledp
4029 (add-text-properties 4279 (add-text-properties
4030 0 (length txt) 4280 0 (length txt)
4031 (list 'face 'org-scheduled-today-face 4281 (list 'face 'org-scheduled-today
4032 'undone-face 'org-scheduled-today-face 4282 'undone-face 'org-scheduled-today
4033 'done-face 'org-done-face 4283 'done-face 'org-done
4034 priority (+ 99 priority)) 4284 priority (+ 99 priority))
4035 txt) 4285 txt)
4036 (add-text-properties 4286 (add-text-properties
@@ -4079,19 +4329,19 @@ the documentation of `org-diary'."
4079 (setq txt org-agenda-no-heading-message)) 4329 (setq txt org-agenda-no-heading-message))
4080 (when txt 4330 (when txt
4081 (add-text-properties 4331 (add-text-properties
4082 0 (length txt) 4332 0 (length txt)
4083 (append 4333 (append
4084 (list 'org-marker (org-agenda-new-marker pos) 4334 (list 'org-marker (org-agenda-new-marker pos)
4085 'org-hd-marker (org-agenda-new-marker pos1) 4335 'org-hd-marker (org-agenda-new-marker pos1)
4086 'priority (+ (- 10 diff) (org-get-priority txt)) 4336 'priority (+ (- 10 diff) (org-get-priority txt))
4087 'face (cond ((<= diff 0) 'org-warning-face) 4337 'face (cond ((<= diff 0) 'org-warning)
4088 ((<= diff 5) 'org-scheduled-previously-face) 4338 ((<= diff 5) 'org-scheduled-previously)
4089 (t nil)) 4339 (t nil))
4090 'undone-face (cond 4340 'undone-face (cond
4091 ((<= diff 0) 'org-warning-face) 4341 ((<= diff 0) 'org-warning)
4092 ((<= diff 5) 'org-scheduled-previously-face) 4342 ((<= diff 5) 'org-scheduled-previously)
4093 (t nil)) 4343 (t nil))
4094 'done-face 'org-done-face) 4344 'done-face 'org-done)
4095 props) 4345 props)
4096 txt) 4346 txt)
4097 (push txt ee))))) 4347 (push txt ee)))))
@@ -4099,9 +4349,9 @@ the documentation of `org-diary'."
4099 4349
4100(defun org-agenda-get-scheduled () 4350(defun org-agenda-get-scheduled ()
4101 "Return the scheduled information for agenda display." 4351 "Return the scheduled information for agenda display."
4102 (let* ((props (list 'face 'org-scheduled-previously-face 4352 (let* ((props (list 'face 'org-scheduled-previously
4103 'undone-face 'org-scheduled-previously-face 4353 'undone-face 'org-scheduled-previously
4104 'done-face 'org-done-face 4354 'done-face 'org-done
4105 'mouse-face 'highlight 4355 'mouse-face 'highlight
4106 'keymap org-agenda-keymap 4356 'keymap org-agenda-keymap
4107 'help-echo 4357 'help-echo
@@ -4172,7 +4422,7 @@ the documentation of `org-diary'."
4172 (setq hdmarker (org-agenda-new-marker (match-end 1))) 4422 (setq hdmarker (org-agenda-new-marker (match-end 1)))
4173 (goto-char (match-end 1)) 4423 (goto-char (match-end 1))
4174 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)") 4424 (looking-at "\\*+[ \t]*\\([^\r\n]+\\)")
4175 (setq txt (org-format-agenda-item 4425 (setq txt (org-format-agenda-item
4176 (format (if (= d1 d2) "" "(%d/%d): ") 4426 (format (if (= d1 d2) "" "(%d/%d): ")
4177 (1+ (- d0 d1)) (1+ (- d2 d1))) 4427 (1+ (- d0 d1)) (1+ (- d2 d1)))
4178 (match-string 1) nil (if (= d0 d1) timestr)))) 4428 (match-string 1) nil (if (= d0 d1) timestr))))
@@ -4254,7 +4504,7 @@ only the correctly processes TXT should be returned - this is used by
4254 (setq s0 (match-string 0 ts) 4504 (setq s0 (match-string 0 ts)
4255 s1 (match-string (if plain 1 2) ts) 4505 s1 (match-string (if plain 1 2) ts)
4256 s2 (match-string (if plain 8 4) ts)) 4506 s2 (match-string (if plain 8 4) ts))
4257 4507
4258 ;; If the times are in TXT (not in DOTIMES), and the prefix will list 4508 ;; If the times are in TXT (not in DOTIMES), and the prefix will list
4259 ;; them, we might want to remove them there to avoid duplication. 4509 ;; them, we might want to remove them there to avoid duplication.
4260 ;; The user can turn this off with a variable. 4510 ;; The user can turn this off with a variable.
@@ -4267,7 +4517,7 @@ only the correctly processes TXT should be returned - this is used by
4267 ;; Normalize the time(s) to 24 hour 4517 ;; Normalize the time(s) to 24 hour
4268 (if s1 (setq s1 (org-get-time-of-day s1 'string))) 4518 (if s1 (setq s1 (org-get-time-of-day s1 'string)))
4269 (if s2 (setq s2 (org-get-time-of-day s2 'string)))) 4519 (if s2 (setq s2 (org-get-time-of-day s2 'string))))
4270 4520
4271 ;; Create the final string 4521 ;; Create the final string
4272 (if noprefix 4522 (if noprefix
4273 (setq rtn txt) 4523 (setq rtn txt)
@@ -4279,7 +4529,7 @@ only the correctly processes TXT should be returned - this is used by
4279 category (if (symbolp category) (symbol-name category) category)) 4529 category (if (symbolp category) (symbol-name category) category))
4280 ;; Evaluate the compiled format 4530 ;; Evaluate the compiled format
4281 (setq rtn (concat (eval org-prefix-format-compiled) txt))) 4531 (setq rtn (concat (eval org-prefix-format-compiled) txt)))
4282 4532
4283 ;; And finally add the text properties 4533 ;; And finally add the text properties
4284 (add-text-properties 4534 (add-text-properties
4285 0 (length rtn) (list 'category (downcase category) 4535 0 (length rtn) (list 'category (downcase category)
@@ -4310,12 +4560,12 @@ only the correctly processes TXT should be returned - this is used by
4310 (while (setq time (pop gridtimes)) 4560 (while (setq time (pop gridtimes))
4311 (unless (and remove (member time have)) 4561 (unless (and remove (member time have))
4312 (setq time (int-to-string time)) 4562 (setq time (int-to-string time))
4313 (push (org-format-agenda-item 4563 (push (org-format-agenda-item
4314 nil string "" ;; FIXME: put a category? 4564 nil string "" ;; FIXME: put a category?
4315 (concat (substring time 0 -2) ":" (substring time -2))) 4565 (concat (substring time 0 -2) ":" (substring time -2)))
4316 new) 4566 new)
4317 (put-text-property 4567 (put-text-property
4318 1 (length (car new)) 'face 'org-time-grid-face (car new)))) 4568 1 (length (car new)) 'face 'org-time-grid (car new))))
4319 (if (member 'time-up org-agenda-sorting-strategy) 4569 (if (member 'time-up org-agenda-sorting-strategy)
4320 (append new list) 4570 (append new list)
4321 (append list new))))) 4571 (append list new)))))
@@ -4353,7 +4603,7 @@ If not found, return nil.
4353The optional STRING argument forces conversion into a 5 character wide string 4603The optional STRING argument forces conversion into a 5 character wide string
4354HH:MM." 4604HH:MM."
4355 (save-match-data 4605 (save-match-data
4356 (when 4606 (when
4357 (or 4607 (or
4358 (string-match 4608 (string-match
4359 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s) 4609 "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s)
@@ -4401,6 +4651,7 @@ HH:MM."
4401 4651
4402(defun org-entries-lessp (a b) 4652(defun org-entries-lessp (a b)
4403 "Predicate for sorting agenda entries." 4653 "Predicate for sorting agenda entries."
4654 ;; The following variables will be used when the form is evaluated.
4404 (let* ((time-up (org-cmp-time a b)) 4655 (let* ((time-up (org-cmp-time a b))
4405 (time-down (if time-up (- time-up) nil)) 4656 (time-down (if time-up (- time-up) nil))
4406 (priority-up (org-cmp-priority a b)) 4657 (priority-up (org-cmp-priority a b))
@@ -4408,7 +4659,7 @@ HH:MM."
4408 (category-up (org-cmp-category a b)) 4659 (category-up (org-cmp-category a b))
4409 (category-down (if category-up (- category-up) nil)) 4660 (category-down (if category-up (- category-up) nil))
4410 (category-keep (if category-up +1 nil))) ; FIXME +1 or -1? 4661 (category-keep (if category-up +1 nil))) ; FIXME +1 or -1?
4411 (cdr (assoc 4662 (cdr (assoc
4412 (eval (cons 'or org-agenda-sorting-strategy)) 4663 (eval (cons 'or org-agenda-sorting-strategy))
4413 '((-1 . t) (1 . nil) (nil . nil)))))) 4664 '((-1 . t) (1 . nil) (nil . nil))))))
4414 4665
@@ -4423,7 +4674,7 @@ and by additional input from the age of a schedules or deadline entry."
4423(defun org-agenda-goto (&optional highlight) 4674(defun org-agenda-goto (&optional highlight)
4424 "Go to the Org-mode file which contains the item at point." 4675 "Go to the Org-mode file which contains the item at point."
4425 (interactive) 4676 (interactive)
4426 (let* ((marker (or (get-text-property (point) 'org-marker) 4677 (let* ((marker (or (get-text-property (point) 'org-marker)
4427 (org-agenda-error))) 4678 (org-agenda-error)))
4428 (buffer (marker-buffer marker)) 4679 (buffer (marker-buffer marker))
4429 (pos (marker-position marker))) 4680 (pos (marker-position marker)))
@@ -4440,7 +4691,7 @@ and by additional input from the age of a schedules or deadline entry."
4440(defun org-agenda-switch-to () 4691(defun org-agenda-switch-to ()
4441 "Go to the Org-mode file which contains the item at point." 4692 "Go to the Org-mode file which contains the item at point."
4442 (interactive) 4693 (interactive)
4443 (let* ((marker (or (get-text-property (point) 'org-marker) 4694 (let* ((marker (or (get-text-property (point) 'org-marker)
4444 (org-agenda-error))) 4695 (org-agenda-error)))
4445 (buffer (marker-buffer marker)) 4696 (buffer (marker-buffer marker))
4446 (pos (marker-position marker))) 4697 (pos (marker-position marker)))
@@ -4487,7 +4738,7 @@ and by additional input from the age of a schedules or deadline entry."
4487 (org-agenda-error))) 4738 (org-agenda-error)))
4488 4739
4489(defun org-agenda-error () 4740(defun org-agenda-error ()
4490 (error "Command not allowed in this line.")) 4741 (error "Command not allowed in this line"))
4491 4742
4492(defvar org-last-heading-marker (make-marker) 4743(defvar org-last-heading-marker (make-marker)
4493 "Marker pointing to the headline that last changed its TODO state 4744 "Marker pointing to the headline that last changed its TODO state
@@ -4554,7 +4805,7 @@ the new TODO state."
4554 (beginning-of-line 1) 4805 (beginning-of-line 1)
4555 (add-text-properties (point-at-bol) (point-at-eol) props) 4806 (add-text-properties (point-at-bol) (point-at-eol) props)
4556 (if fixface 4807 (if fixface
4557 (add-text-properties 4808 (add-text-properties
4558 (point-at-bol) (point-at-eol) 4809 (point-at-bol) (point-at-eol)
4559 (list 'face 4810 (list 'face
4560 (if org-last-todo-state-is-todo 4811 (if org-last-todo-state-is-todo
@@ -4651,7 +4902,7 @@ be used to request time specification in the time stamp."
4651All the standard commands work: block, weekly etc" 4902All the standard commands work: block, weekly etc"
4652 (interactive) 4903 (interactive)
4653 (require 'diary-lib) 4904 (require 'diary-lib)
4654 (let* ((char (progn 4905 (let* ((char (progn
4655 (message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic") 4906 (message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic")
4656 (read-char-exclusive))) 4907 (read-char-exclusive)))
4657 (cmd (cdr (assoc char 4908 (cmd (cdr (assoc char
@@ -4681,7 +4932,7 @@ All the standard commands work: block, weekly etc"
4681 (progn 4932 (progn
4682 (fset 'calendar-cursor-to-date 4933 (fset 'calendar-cursor-to-date
4683 (lambda (&optional error) 4934 (lambda (&optional error)
4684 (calendar-gregorian-from-absolute 4935 (calendar-gregorian-from-absolute
4685 (get-text-property point 'day)))) 4936 (get-text-property point 'day))))
4686 (call-interactively cmd)) 4937 (call-interactively cmd))
4687 (fset 'calendar-cursor-to-date oldf))))) 4938 (fset 'calendar-cursor-to-date oldf)))))
@@ -4704,7 +4955,7 @@ the cursor position."
4704 (progn 4955 (progn
4705 (fset 'calendar-cursor-to-date 4956 (fset 'calendar-cursor-to-date
4706 (lambda (&optional error) 4957 (lambda (&optional error)
4707 (calendar-gregorian-from-absolute 4958 (calendar-gregorian-from-absolute
4708 (get-text-property point 'day)))) 4959 (get-text-property point 'day))))
4709 (call-interactively cmd)) 4960 (call-interactively cmd))
4710 (fset 'calendar-cursor-to-date oldf)))) 4961 (fset 'calendar-cursor-to-date oldf))))
@@ -4754,7 +5005,7 @@ This is a command that has to be installed in `calendar-mode-map'."
4754 (unless day 5005 (unless day
4755 (error "Don't know which date to convert")) 5006 (error "Don't know which date to convert"))
4756 (setq date (calendar-gregorian-from-absolute day)) 5007 (setq date (calendar-gregorian-from-absolute day))
4757 (setq s (concat 5008 (setq s (concat
4758 "Gregorian: " (calendar-date-string date) "\n" 5009 "Gregorian: " (calendar-date-string date) "\n"
4759 "ISO: " (calendar-iso-date-string date) "\n" 5010 "ISO: " (calendar-iso-date-string date) "\n"
4760 "Day of Yr: " (calendar-day-of-year-string date) "\n" 5011 "Day of Yr: " (calendar-day-of-year-string date) "\n"
@@ -4801,7 +5052,8 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
4801 (let (type path line (pos (point))) 5052 (let (type path line (pos (point)))
4802 (save-excursion 5053 (save-excursion
4803 (skip-chars-backward 5054 (skip-chars-backward
4804 (if org-allow-space-in-links "^\t\n\r" "^ \t\n\r")) 5055 (concat (if org-allow-space-in-links "^" "^ ")
5056 org-non-link-chars))
4805 (if (re-search-forward 5057 (if (re-search-forward
4806 org-link-regexp 5058 org-link-regexp
4807 (save-excursion 5059 (save-excursion
@@ -4812,7 +5064,7 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
4812 (setq type (match-string 1) 5064 (setq type (match-string 1)
4813 path (match-string 2))) 5065 path (match-string 2)))
4814 (unless path 5066 (unless path
4815 (error "No link found.")) 5067 (error "No link found"))
4816 ;; Remove any trailing spaces in path 5068 ;; Remove any trailing spaces in path
4817 (if (string-match " +\\'" path) 5069 (if (string-match " +\\'" path)
4818 (setq path (replace-match "" t t path))) 5070 (setq path (replace-match "" t t path)))
@@ -4866,6 +5118,10 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
4866 5118
4867 ((string= type "shell") 5119 ((string= type "shell")
4868 (let ((cmd path)) 5120 (let ((cmd path))
5121 (while (string-match "@{" cmd)
5122 (setq cmd (replace-match "<" t t cmd)))
5123 (while (string-match "@}" cmd)
5124 (setq cmd (replace-match ">" t t cmd)))
4869 (if (or (not org-confirm-shell-links) 5125 (if (or (not org-confirm-shell-links)
4870 (yes-or-no-p (format "Execute \"%s\" in the shell? " cmd))) 5126 (yes-or-no-p (format "Execute \"%s\" in the shell? " cmd)))
4871 (shell-command cmd) 5127 (shell-command cmd)
@@ -4961,7 +5217,7 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file."
4961 (widen) 5217 (widen)
4962 (goto-char (point-max)) 5218 (goto-char (point-max))
4963 (if (re-search-backward 5219 (if (re-search-backward
4964 (concat "^Message-ID:\\s-+" (regexp-quote 5220 (concat "^Message-ID:\\s-+" (regexp-quote
4965 (or article ""))) 5221 (or article "")))
4966 nil t) 5222 nil t)
4967 (rmail-what-message)))))) 5223 (rmail-what-message))))))
@@ -4997,7 +5253,7 @@ If the file does not exist, an error is thrown."
4997 (cdr (assoc t apps))))) 5253 (cdr (assoc t apps)))))
4998 (cond 5254 (cond
4999 ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) 5255 ((and (stringp cmd) (not (string-match "^\\s-*$" cmd)))
5000 (setq cmd (format cmd file)) 5256 (setq cmd (format cmd (concat "\"" file "\"")))
5001 (save-window-excursion 5257 (save-window-excursion
5002 (shell-command (concat cmd " & &")))) 5258 (shell-command (concat cmd " & &"))))
5003 ((or (stringp cmd) 5259 ((or (stringp cmd)
@@ -5043,10 +5299,12 @@ For file links, arg negates `org-line-numbers-in-file-links'."
5043 (cond 5299 (cond
5044 5300
5045 ((eq major-mode 'bbdb-mode) 5301 ((eq major-mode 'bbdb-mode)
5046 (setq link (concat "bbdb:" 5302 (setq cpltxt (concat
5047 (or (bbdb-record-name (bbdb-current-record)) 5303 "bbdb:"
5048 (bbdb-record-company (bbdb-current-record)))))) 5304 (or (bbdb-record-name (bbdb-current-record))
5049 5305 (bbdb-record-company (bbdb-current-record))))
5306 link (org-make-link cpltxt)))
5307
5050 ((eq major-mode 'calendar-mode) 5308 ((eq major-mode 'calendar-mode)
5051 (let ((cd (calendar-cursor-to-date))) 5309 (let ((cd (calendar-cursor-to-date)))
5052 (setq link 5310 (setq link
@@ -5072,8 +5330,9 @@ For file links, arg negates `org-line-numbers-in-file-links'."
5072 folder) 5330 folder)
5073 (setq folder (replace-match "" t t folder))) 5331 (setq folder (replace-match "" t t folder)))
5074 (setq cpltxt (concat author " on: " subject)) 5332 (setq cpltxt (concat author " on: " subject))
5075 (setq link (concat cpltxt "\n " "vm:" folder 5333 (setq link (concat cpltxt "\n "
5076 "#" message-id))))) 5334 (org-make-link
5335 "vm:" folder "#" message-id))))))
5077 5336
5078 ((eq major-mode 'wl-summary-mode) 5337 ((eq major-mode 'wl-summary-mode)
5079 (let* ((msgnum (wl-summary-message-number)) 5338 (let* ((msgnum (wl-summary-message-number))
@@ -5084,8 +5343,10 @@ For file links, arg negates `org-line-numbers-in-file-links'."
5084 (author (wl-summary-line-from)) ; FIXME: how to get author name? 5343 (author (wl-summary-line-from)) ; FIXME: how to get author name?
5085 (subject "???")) ; FIXME: How to get subject of email? 5344 (subject "???")) ; FIXME: How to get subject of email?
5086 (setq cpltxt (concat author " on: " subject)) 5345 (setq cpltxt (concat author " on: " subject))
5087 (setq link (concat cpltxt "\n " "wl:" wl-summary-buffer-folder-name 5346 (setq link (concat cpltxt "\n "
5088 "#" message-id)))) 5347 (org-make-link
5348 "wl:" wl-summary-buffer-folder-name
5349 "#" message-id)))))
5089 5350
5090 ((eq major-mode 'rmail-mode) 5351 ((eq major-mode 'rmail-mode)
5091 (save-excursion 5352 (save-excursion
@@ -5096,8 +5357,9 @@ For file links, arg negates `org-line-numbers-in-file-links'."
5096 (author (mail-fetch-field "from")) 5357 (author (mail-fetch-field "from"))
5097 (subject (mail-fetch-field "subject"))) 5358 (subject (mail-fetch-field "subject")))
5098 (setq cpltxt (concat author " on: " subject)) 5359 (setq cpltxt (concat author " on: " subject))
5099 (setq link (concat cpltxt "\n " "rmail:" folder 5360 (setq link (concat cpltxt "\n "
5100 "#" message-id)))))) 5361 (org-make-link
5362 "rmail:" folder "#" message-id)))))))
5101 5363
5102 ((eq major-mode 'gnus-group-mode) 5364 ((eq major-mode 'gnus-group-mode)
5103 (let ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus 5365 (let ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus
@@ -5105,11 +5367,12 @@ For file links, arg negates `org-line-numbers-in-file-links'."
5105 ((fboundp 'gnus-group-name) 5367 ((fboundp 'gnus-group-name)
5106 (gnus-group-name)) 5368 (gnus-group-name))
5107 (t "???")))) 5369 (t "???"))))
5108 (setq link (concat 5370 (setq cpltxt (concat
5109 (if (org-xor arg org-usenet-links-prefer-google) 5371 (if (org-xor arg org-usenet-links-prefer-google)
5110 "http://groups.google.com/groups?group=" 5372 "http://groups.google.com/groups?group="
5111 "gnus:") 5373 "gnus:")
5112 group)))) 5374 group)
5375 link (org-make-link cpltxt))))
5113 5376
5114 ((memq major-mode '(gnus-summary-mode gnus-article-mode)) 5377 ((memq major-mode '(gnus-summary-mode gnus-article-mode))
5115 (and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary)) 5378 (and (eq major-mode 'gnus-article-mode) (gnus-article-show-summary))
@@ -5128,27 +5391,34 @@ For file links, arg negates `org-line-numbers-in-file-links'."
5128 cpltxt "\n " 5391 cpltxt "\n "
5129 (format "http://groups.google.com/groups?as_umsgid=%s" 5392 (format "http://groups.google.com/groups?as_umsgid=%s"
5130 (org-fixup-message-id-for-http message-id)))) 5393 (org-fixup-message-id-for-http message-id))))
5131 (setq link (concat cpltxt "\n" "gnus:" group 5394 (setq link (concat cpltxt "\n"
5132 "#" (number-to-string article)))))) 5395 (org-make-link
5396 "gnus:" group
5397 "#" (number-to-string article)))))))
5133 5398
5134 ((eq major-mode 'w3-mode) 5399 ((eq major-mode 'w3-mode)
5135 (setq link (url-view-url t))) 5400 (setq cpltxt (url-view-url t)
5401 link (org-make-link cpltxt)))
5136 ((eq major-mode 'w3m-mode) 5402 ((eq major-mode 'w3m-mode)
5137 (setq link w3m-current-url)) 5403 (setq cpltxt w3m-current-url
5404 link (org-make-link cpltxt)))
5138 5405
5139 ((buffer-file-name) 5406 ((buffer-file-name)
5140 ;; Just link to this file here. 5407 ;; Just link to this file here.
5141 (setq link (concat "file:" 5408 (setq cpltxt (concat "file:"
5142 (abbreviate-file-name (buffer-file-name)))) 5409 (abbreviate-file-name (buffer-file-name))))
5143 ;; Add the line number? 5410 ;; Add the line number?
5144 (if (org-xor org-line-numbers-in-file-links arg) 5411 (if (org-xor org-line-numbers-in-file-links arg)
5145 (setq link 5412 (setq cpltxt
5146 (concat link 5413 (concat cpltxt
5147 ":" (int-to-string 5414 ":" (int-to-string
5148 (+ (if (bolp) 1 0) (count-lines 5415 (+ (if (bolp) 1 0) (count-lines
5149 (point-min) (point)))))))) 5416 (point-min) (point)))))))
5417 (setq link (org-make-link cpltxt)))
5418
5150 ((interactive-p) 5419 ((interactive-p)
5151 (error "Cannot link to a buffer which is not visiting a file")) 5420 (error "Cannot link to a buffer which is not visiting a file"))
5421
5152 (t (setq link nil))) 5422 (t (setq link nil)))
5153 5423
5154 (if (and (interactive-p) link) 5424 (if (and (interactive-p) link)
@@ -5158,6 +5428,10 @@ For file links, arg negates `org-line-numbers-in-file-links'."
5158 (message "Stored: %s" (or cpltxt link))) 5428 (message "Stored: %s" (or cpltxt link)))
5159 link))) 5429 link)))
5160 5430
5431(defun org-make-link (&rest strings)
5432 "Concatenate STRINGS, format resulting string with `org-link-format'."
5433 (format org-link-format (apply 'concat strings)))
5434
5161(defun org-xor (a b) 5435(defun org-xor (a b)
5162 "Exclusive or." 5436 "Exclusive or."
5163 (if a (not b) b)) 5437 (if a (not b) b))
@@ -5202,7 +5476,8 @@ For file links, arg negates `org-line-numbers-in-file-links'."
5202Completion can be used to select a link previously stored with 5476Completion can be used to select a link previously stored with
5203`org-store-link'. When the empty string is entered (i.e. if you just 5477`org-store-link'. When the empty string is entered (i.e. if you just
5204press RET at the prompt), the link defaults to the most recently 5478press RET at the prompt), the link defaults to the most recently
5205stored link. 5479stored link. As SPC triggers completion in the minibuffer, you need to
5480use M-SPC or C-q SPC to force the insertion of a space character.
5206 5481
5207With a \\[universal-argument] prefix, prompts for a file to link to. The file name can be 5482With a \\[universal-argument] prefix, prompts for a file to link to. The file name can be
5208selected using completion. The path to the file will be relative to 5483selected using completion. The path to the file will be relative to
@@ -5226,15 +5501,20 @@ is in the current directory or below."
5226 (let ((pwd (file-name-as-directory (expand-file-name ".")))) 5501 (let ((pwd (file-name-as-directory (expand-file-name "."))))
5227 (cond 5502 (cond
5228 ((equal complete-file '(16)) 5503 ((equal complete-file '(16))
5229 (insert "file:" (abbreviate-file-name (expand-file-name link)))) 5504 (insert
5505 (org-make-link
5506 "file:" (abbreviate-file-name (expand-file-name link)))))
5230 ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)") 5507 ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)")
5231 (expand-file-name link)) 5508 (expand-file-name link))
5232 (insert "file:" (match-string 1 (expand-file-name link)))) 5509 (insert
5233 (t (insert "file:" link)))) 5510 (org-make-link
5511 "file:" (match-string 1 (expand-file-name link)))))
5512 (t (insert (org-make-link "file:" link)))))
5234 (setq linktxt (cdr (assoc link org-stored-links))) 5513 (setq linktxt (cdr (assoc link org-stored-links)))
5235 (if (not org-keep-stored-link-after-insertion) 5514 (if (not org-keep-stored-link-after-insertion)
5236 (setq org-stored-links (delq (assoc link org-stored-links) 5515 (setq org-stored-links (delq (assoc link org-stored-links)
5237 org-stored-links))) 5516 org-stored-links)))
5517 (if (not linktxt) (setq link (org-make-link link)))
5238 (let ((lines (org-split-string (or linktxt link) "\n"))) 5518 (let ((lines (org-split-string (or linktxt link) "\n")))
5239 (insert (car lines)) 5519 (insert (car lines))
5240 (setq matched (string-match org-link-regexp (car lines))) 5520 (setq matched (string-match org-link-regexp (car lines)))
@@ -5301,7 +5581,7 @@ If the variable `org-adapt-indentation' is non-nil, the entire text is
5301also indented so that it starts in the same column as the headline 5581also indented so that it starts in the same column as the headline
5302\(i.e. after the stars). 5582\(i.e. after the stars).
5303 5583
5304See also the variable `org-reverse-note-order'." 5584See also the variable `org-reverse-note-order'."
5305 (catch 'quit 5585 (catch 'quit
5306 (let* ((txt (buffer-substring (point-min) (point-max))) 5586 (let* ((txt (buffer-substring (point-min) (point-max)))
5307 (fastp current-prefix-arg) 5587 (fastp current-prefix-arg)
@@ -5791,7 +6071,7 @@ If the field at the cursor is empty, copy into it the content of the nearest
5791non-empty field above. With argument N, use the Nth non-empty field. 6071non-empty field above. With argument N, use the Nth non-empty field.
5792If the current field is not empty, it is copied down to the next row, and 6072If the current field is not empty, it is copied down to the next row, and
5793the cursor is moved with it. Therefore, repeating this command causes the 6073the cursor is moved with it. Therefore, repeating this command causes the
5794column to be filled row-by-row. 6074column to be filled row-by-row.
5795If the variable `org-table-copy-increment' is non-nil and the field is an 6075If the variable `org-table-copy-increment' is non-nil and the field is an
5796integer, it will be incremented while copying." 6076integer, it will be incremented while copying."
5797 (interactive "p") 6077 (interactive "p")
@@ -5882,7 +6162,7 @@ When called interactively, column is also displayed in echo area."
5882(defun org-table-goto-column (n &optional on-delim force) 6162(defun org-table-goto-column (n &optional on-delim force)
5883 "Move the cursor to the Nth column in the current table line. 6163 "Move the cursor to the Nth column in the current table line.
5884With optional argument ON-DELIM, stop with point before the left delimiter 6164With optional argument ON-DELIM, stop with point before the left delimiter
5885of the field. 6165of the field.
5886If there are less than N fields, just go to after the last delimiter. 6166If there are less than N fields, just go to after the last delimiter.
5887However, when FORCE is non-nil, create new columns if necessary." 6167However, when FORCE is non-nil, create new columns if necessary."
5888 (let ((pos (point-at-eol))) 6168 (let ((pos (point-at-eol)))
@@ -5902,7 +6182,8 @@ However, when FORCE is non-nil, create new columns if necessary."
5902 (if (looking-at " ") (forward-char 1)))))) 6182 (if (looking-at " ") (forward-char 1))))))
5903 6183
5904(defun org-at-table-p (&optional table-type) 6184(defun org-at-table-p (&optional table-type)
5905 "Return t if the cursor is inside an org-type table." 6185 "Return t if the cursor is inside an org-type table.
6186If TABLE-TYPE is non-nil, also chack for table.el-type tables."
5906 (if org-enable-table-editor 6187 (if org-enable-table-editor
5907 (save-excursion 6188 (save-excursion
5908 (beginning-of-line 1) 6189 (beginning-of-line 1)
@@ -6082,7 +6363,7 @@ However, when FORCE is non-nil, create new columns if necessary."
6082 (if (not (org-at-table-p)) 6363 (if (not (org-at-table-p))
6083 (progn 6364 (progn
6084 (goto-char pos) 6365 (goto-char pos)
6085 (error "Cannot move row further."))) 6366 (error "Cannot move row further")))
6086 (goto-char pos) 6367 (goto-char pos)
6087 (beginning-of-line 1) 6368 (beginning-of-line 1)
6088 (setq pos (point)) 6369 (setq pos (point))
@@ -6169,7 +6450,7 @@ with `org-table-paste-rectangle'"
6169 (goto-char beg) 6450 (goto-char beg)
6170 (org-table-check-inside-data-field) 6451 (org-table-check-inside-data-field)
6171 (setq l01 (count-lines (point-min) (point)) 6452 (setq l01 (count-lines (point-min) (point))
6172 c01 (org-table-current-column)) 6453 c01 (org-table-current-column))
6173 (goto-char end) 6454 (goto-char end)
6174 (org-table-check-inside-data-field) 6455 (org-table-check-inside-data-field)
6175 (setq l02 (count-lines (point-min) (point)) 6456 (setq l02 (count-lines (point-min) (point))
@@ -6190,7 +6471,7 @@ with `org-table-paste-rectangle'"
6190 (setq l1 (1+ l1))))) 6471 (setq l1 (1+ l1)))))
6191 (setq org-table-clip (nreverse region)) 6472 (setq org-table-clip (nreverse region))
6192 (if cut (org-table-align)))) 6473 (if cut (org-table-align))))
6193 6474
6194(defun org-table-paste-rectangle () 6475(defun org-table-paste-rectangle ()
6195 "Paste a rectangular region into a table. 6476 "Paste a rectangular region into a table.
6196The upper right corner ends up in the current field. All involved fields 6477The upper right corner ends up in the current field. All involved fields
@@ -6301,7 +6582,7 @@ blank, and the content is appended to the field above."
6301 (+ (length org-table-clip) arg) 6582 (+ (length org-table-clip) arg)
6302 arg) 6583 arg)
6303 (length org-table-clip))) 6584 (length org-table-clip)))
6304 (setq org-table-clip 6585 (setq org-table-clip
6305 (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ") 6586 (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ")
6306 nil nlines))) 6587 nil nlines)))
6307 (goto-char beg) 6588 (goto-char beg)
@@ -6356,7 +6637,7 @@ The return value is a list of lines, without newlines at the end."
6356 (setq ll (org-do-wrap words w))) 6637 (setq ll (org-do-wrap words w)))
6357 ll)) 6638 ll))
6358 (t (error "Cannot wrap this"))))) 6639 (t (error "Cannot wrap this")))))
6359 6640
6360 6641
6361(defun org-do-wrap (words width) 6642(defun org-do-wrap (words width)
6362 "Create lines of maximum width WIDTH (in characters) from word list WORDS." 6643 "Create lines of maximum width WIDTH (in characters) from word list WORDS."
@@ -6681,28 +6962,32 @@ table editor in arbitrary modes.")
6681 6962
6682;;;###autoload 6963;;;###autoload
6683(defun orgtbl-mode (&optional arg) 6964(defun orgtbl-mode (&optional arg)
6684 "The `org-mode' table editor as a minor mode for use in other modes." 6965 "The `org-mode' table editor as a minor mode for use in other modes."
6685 (interactive) 6966 (interactive)
6686 (setq orgtbl-mode 6967 (if (eq major-mode 'org-mode)
6687 (if arg (> (prefix-numeric-value arg) 0) (not orgtbl-mode))) 6968 ;; Exit without error, in case some hook functions calls this
6688 (if orgtbl-mode 6969 ;; by accident in org-mode.
6689 (progn 6970 (message "Orgtbl-mode is not useful in org-mode, command ignored")
6690 (set (make-local-variable (quote org-table-may-need-update)) t) 6971 (setq orgtbl-mode
6691 (make-local-hook (quote before-change-functions)) 6972 (if arg (> (prefix-numeric-value arg) 0) (not orgtbl-mode)))
6692 (add-hook 'before-change-functions 'org-before-change-function 6973 (if orgtbl-mode
6693 nil 'local) 6974 (progn
6694 (set (make-local-variable 'org-old-auto-fill-inhibit-regexp) 6975 (set (make-local-variable (quote org-table-may-need-update)) t)
6695 auto-fill-inhibit-regexp) 6976 (make-local-hook (quote before-change-functions))
6696 (set (make-local-variable 'auto-fill-inhibit-regexp) 6977 (add-hook 'before-change-functions 'org-before-change-function
6697 (if auto-fill-inhibit-regexp 6978 nil 'local)
6698 (concat "\\([ \t]*|\\|" auto-fill-inhibit-regexp) 6979 (set (make-local-variable 'org-old-auto-fill-inhibit-regexp)
6699 "[ \t]*|")) 6980 auto-fill-inhibit-regexp)
6700 (easy-menu-add orgtbl-mode-menu) 6981 (set (make-local-variable 'auto-fill-inhibit-regexp)
6701 (run-hooks 'orgtbl-mode-hook)) 6982 (if auto-fill-inhibit-regexp
6702 (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp) 6983 (concat "\\([ \t]*|\\|" auto-fill-inhibit-regexp)
6703 (remove-hook 'before-change-functions 'org-before-change-function t) 6984 "[ \t]*|"))
6704 (easy-menu-remove orgtbl-mode-menu) 6985 (easy-menu-add orgtbl-mode-menu)
6705 (force-mode-line-update 'all))) 6986 (run-hooks 'orgtbl-mode-hook))
6987 (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp)
6988 (remove-hook 'before-change-functions 'org-before-change-function t)
6989 (easy-menu-remove orgtbl-mode-menu)
6990 (force-mode-line-update 'all))))
6706 6991
6707;; Install it as a minor mode. 6992;; Install it as a minor mode.
6708(put 'orgtbl-mode :included t) 6993(put 'orgtbl-mode :included t)
@@ -6711,7 +6996,9 @@ table editor in arbitrary modes.")
6711 6996
6712(defun orgtbl-make-binding (fun &rest keys) 6997(defun orgtbl-make-binding (fun &rest keys)
6713 "Create a function for binding in the table minor mode." 6998 "Create a function for binding in the table minor mode."
6714 (list 'lambda '(arg) '(interactive "p") 6999 (list 'lambda '(arg)
7000 (concat "Run `" (symbol-name fun) "' or the default binding.")
7001 '(interactive "p")
6715 (list 'if 7002 (list 'if
6716 '(org-at-table-p) 7003 '(org-at-table-p)
6717 (list 'call-interactively (list 'quote fun)) 7004 (list 'call-interactively (list 'quote fun))
@@ -6730,29 +7017,30 @@ table editor in arbitrary modes.")
6730 7017
6731;; Keybindings for the minor mode 7018;; Keybindings for the minor mode
6732(let ((bindings 7019(let ((bindings
6733 '(([(meta shift left)] org-table-delete-column) 7020 (list
6734 ([(meta left)] org-table-move-column-left) 7021 '([(meta shift left)] org-table-delete-column)
6735 ([(meta right)] org-table-move-column-right) 7022 '([(meta left)] org-table-move-column-left)
6736 ([(meta shift right)] org-table-insert-column) 7023 '([(meta right)] org-table-move-column-right)
6737 ([(meta shift up)] org-table-kill-row) 7024 '([(meta shift right)] org-table-insert-column)
6738 ([(meta shift down)] org-table-insert-row) 7025 '([(meta shift up)] org-table-kill-row)
6739 ([(meta up)] org-table-move-row-up) 7026 '([(meta shift down)] org-table-insert-row)
6740 ([(meta down)] org-table-move-row-down) 7027 '([(meta up)] org-table-move-row-up)
6741 ("\C-c\C-w" org-table-cut-region) 7028 '([(meta down)] org-table-move-row-down)
6742 ("\C-c\M-w" org-table-copy-region) 7029 '("\C-c\C-w" org-table-cut-region)
6743 ("\C-c\C-y" org-table-paste-rectangle) 7030 '("\C-c\M-w" org-table-copy-region)
6744 ("\C-c-" org-table-insert-hline) 7031 '("\C-c\C-y" org-table-paste-rectangle)
6745 ([(shift tab)] org-table-previous-field) 7032 '("\C-c-" org-table-insert-hline)
6746 ("\C-c\C-c" org-table-align) 7033 '([(shift tab)] org-table-previous-field)
6747 ([(return)] org-table-next-row) 7034 '("\C-c\C-c" org-table-align)
6748 ([(shift return)] org-table-copy-down) 7035 '("\C-m" org-table-next-row)
6749 ([(meta return)] org-table-wrap-region) 7036 (list (org-key 'S-return) 'org-table-copy-down)
6750 ("\C-c\C-q" org-table-wrap-region) 7037 '([(meta return)] org-table-wrap-region)
6751 ("\C-c?" org-table-current-column) 7038 '("\C-c\C-q" org-table-wrap-region)
6752 ("\C-c " org-table-blank-field) 7039 '("\C-c?" org-table-current-column)
6753 ("\C-c+" org-table-sum) 7040 '("\C-c " org-table-blank-field)
6754 ("\C-c|" org-table-toggle-vline-visibility) 7041 '("\C-c+" org-table-sum)
6755 ("\C-c=" org-table-eval-formula))) 7042 '("\C-c|" org-table-toggle-vline-visibility)
7043 '("\C-c=" org-table-eval-formula)))
6756 elt key fun cmd) 7044 elt key fun cmd)
6757 (while (setq elt (pop bindings)) 7045 (while (setq elt (pop bindings))
6758 (setq key (car elt) 7046 (setq key (car elt)
@@ -6761,20 +7049,12 @@ table editor in arbitrary modes.")
6761 (define-key orgtbl-mode-map key cmd))) 7049 (define-key orgtbl-mode-map key cmd)))
6762 7050
6763;; Special treatment needed for TAB and RET 7051;; Special treatment needed for TAB and RET
6764;(define-key orgtbl-mode-map [(return)] 7052
6765; (orgtbl-make-binding 'org-table-next-row [(return)] "\C-m")) 7053(define-key orgtbl-mode-map [(return)]
6766;(define-key orgtbl-mode-map "\C-m"
6767; (orgtbl-make-binding 'org-table-next-row "\C-m" [(return)]))
6768;(define-key orgtbl-mode-map [(tab)]
6769; (orgtbl-make-binding 'org-table-next-field [(tab)] "\C-i"))
6770;(define-key orgtbl-mode-map "\C-i"
6771; (orgtbl-make-binding 'org-table-next-field "\C-i" [(tab)]))
6772
6773(define-key orgtbl-mode-map [(return)]
6774 (orgtbl-make-binding 'orgtbl-ret [(return)] "\C-m")) 7054 (orgtbl-make-binding 'orgtbl-ret [(return)] "\C-m"))
6775(define-key orgtbl-mode-map "\C-m" 7055(define-key orgtbl-mode-map "\C-m"
6776 (orgtbl-make-binding 'orgtbl-ret "\C-m" [(return)])) 7056 (orgtbl-make-binding 'orgtbl-ret "\C-m" [(return)]))
6777(define-key orgtbl-mode-map [(tab)] 7057(define-key orgtbl-mode-map [(tab)]
6778 (orgtbl-make-binding 'orgtbl-tab [(tab)] "\C-i")) 7058 (orgtbl-make-binding 'orgtbl-tab [(tab)] "\C-i"))
6779(define-key orgtbl-mode-map "\C-i" 7059(define-key orgtbl-mode-map "\C-i"
6780 (orgtbl-make-binding 'orgtbl-tab "\C-i" [(tab)])) 7060 (orgtbl-make-binding 'orgtbl-tab "\C-i" [(tab)]))
@@ -6884,7 +7164,7 @@ a reduced column width."
6884 ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p) :keys "C-c C-q"]) 7164 ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p) :keys "C-c C-q"])
6885 "--" 7165 "--"
6886 ["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"] 7166 ["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"]
6887 ["Sum Column/Rectangle" org-table-sum 7167 ["Sum Column/Rectangle" org-table-sum
6888 :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"] 7168 :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"]
6889 ["Eval Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="] 7169 ["Eval Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="]
6890 )) 7170 ))
@@ -7396,9 +7676,10 @@ and all options lines."
7396 (let* ((filename (concat (file-name-sans-extension (buffer-file-name)) 7676 (let* ((filename (concat (file-name-sans-extension (buffer-file-name))
7397 ".txt")) 7677 ".txt"))
7398 (buffer (find-file-noselect filename)) 7678 (buffer (find-file-noselect filename))
7399 (ore (concat 7679 (ore (concat
7400 (org-make-options-regexp 7680 (org-make-options-regexp
7401 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO" "STARTUP" 7681 '("CATEGORY" "SEQ_TODO" "PRI_TODO" "TYP_TODO"
7682 "STARTUP" "ARCHIVE"
7402 "TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE")) 7683 "TITLE" "AUTHOR" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"))
7403 (if org-noutline-p "\\(\n\\|$\\)" ""))) 7684 (if org-noutline-p "\\(\n\\|$\\)" "")))
7404 s e) 7685 s e)
@@ -7453,6 +7734,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff."
7453#+SEQ_TODO: %s 7734#+SEQ_TODO: %s
7454#+TYP_TODO: %s 7735#+TYP_TODO: %s
7455#+STARTUP: %s %s 7736#+STARTUP: %s %s
7737#+ARCHIVE: %s
7456" 7738"
7457 (buffer-name) (user-full-name) user-mail-address org-export-default-language 7739 (buffer-name) (user-full-name) user-mail-address org-export-default-language
7458 org-export-headline-levels 7740 org-export-headline-levels
@@ -7475,6 +7757,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff."
7475 (cdr (assoc org-startup-folded 7757 (cdr (assoc org-startup-folded
7476 '((nil . "nofold")(t . "fold")(content . "content")))) 7758 '((nil . "nofold")(t . "fold")(content . "content"))))
7477 (if org-startup-with-deadline-check "dlcheck" "nodlcheck") 7759 (if org-startup-with-deadline-check "dlcheck" "nodlcheck")
7760 org-archive-location
7478 )) 7761 ))
7479 7762
7480(defun org-insert-export-options-template () 7763(defun org-insert-export-options-template ()
@@ -7571,6 +7854,7 @@ headlines. The default is 3. Lower levels will become bulleted lists."
7571 (text nil) 7854 (text nil)
7572 (lang-words nil) 7855 (lang-words nil)
7573 (head-count 0) cnt 7856 (head-count 0) cnt
7857 (start 0)
7574 table-open type 7858 table-open type
7575 table-buffer table-orig-buffer 7859 table-buffer table-orig-buffer
7576 ) 7860 )
@@ -7624,7 +7908,7 @@ headlines. The default is 3. Lower levels will become bulleted lists."
7624 ;; This is a headline 7908 ;; This is a headline
7625 (progn 7909 (progn
7626 (setq level (- (match-end 1) (match-beginning 1)) 7910 (setq level (- (match-end 1) (match-beginning 1))
7627 txt (save-match-data 7911 txt (save-match-data
7628 (org-html-expand 7912 (org-html-expand
7629 (match-string 3 line))) 7913 (match-string 3 line)))
7630 todo 7914 todo
@@ -7668,8 +7952,15 @@ headlines. The default is 3. Lower levels will become bulleted lists."
7668 )) 7952 ))
7669 (setq head-count 0) 7953 (setq head-count 0)
7670 (org-init-section-numbers) 7954 (org-init-section-numbers)
7671
7672 (while (setq line (pop lines) origline line) 7955 (while (setq line (pop lines) origline line)
7956 ;; Protect the links
7957 (setq start 0)
7958 (while (string-match org-link-maybe-angles-regexp line start)
7959 (setq start (match-end 0))
7960 (setq line (replace-match
7961 (concat "\000" (match-string 1 line) "\000")
7962 t t line)))
7963
7673 ;; replace "<" and ">" by "&lt;" and "&gt;" 7964 ;; replace "<" and ">" by "&lt;" and "&gt;"
7674 ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>") 7965 ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>")
7675 (setq line (org-html-expand line)) 7966 (setq line (org-html-expand line))
@@ -7687,27 +7978,34 @@ headlines. The default is 3. Lower levels will become bulleted lists."
7687 (not (string-match "^[ \t]+\\(:.*\\)" 7978 (not (string-match "^[ \t]+\\(:.*\\)"
7688 (car lines)))) 7979 (car lines))))
7689 "<br>\n" "\n")))) 7980 "<br>\n" "\n"))))
7690 7981 (setq start 0)
7691 (when (string-match org-link-regexp line) 7982 (while (string-match org-protected-link-regexp line start)
7983 (setq start (- (match-end 0) 2))
7692 (setq type (match-string 1 line)) 7984 (setq type (match-string 1 line))
7693 (cond 7985 (cond
7694 ((member type '("http" "https" "ftp" "mailto" "news")) 7986 ((member type '("http" "https" "ftp" "mailto" "news"))
7695 ;; standard URL 7987 ;; standard URL
7696 (setq line (replace-match 7988 (setq line (replace-match
7697 "<a href=\"\\1:\\2\">&lt;\\1:\\2&gt;</a>" 7989; "<a href=\"\\1:\\2\">&lt;\\1:\\2&gt;</a>"
7990 "<a href=\"\\1:\\2\">\\1:\\2</a>"
7698 nil nil line))) 7991 nil nil line)))
7699 ((string= type "file") 7992 ((string= type "file")
7700 ;; FILE link 7993 ;; FILE link
7701
7702 (let* ((filename (match-string 2 line)) 7994 (let* ((filename (match-string 2 line))
7995 (abs-p (file-name-absolute-p filename))
7996 (thefile (if abs-p (expand-file-name filename) filename))
7997 (thefile (save-match-data
7998 (if (string-match ":[0-9]+$" thefile)
7999 (replace-match "" t t thefile)
8000 thefile)))
7703 (file-is-image-p 8001 (file-is-image-p
7704 (save-match-data 8002 (save-match-data
7705 (string-match (org-image-file-name-regexp) filename)))) 8003 (string-match (org-image-file-name-regexp) thefile))))
7706 (setq line (replace-match 8004 (setq line (replace-match
7707 (if (and org-export-html-inline-images 8005 (if (and org-export-html-inline-images
7708 file-is-image-p) 8006 file-is-image-p)
7709 "<img src=\"\\2\"/>" 8007 (concat "<img src=\"" thefile "\"/>")
7710 "<a href=\"\\2\">\\1:\\2</a>") 8008 (concat "<a href=\"" thefile "\">\\1:\\2</a>"))
7711 nil nil line)))) 8009 nil nil line))))
7712 8010
7713 ((member type '("bbdb" "vm" "wl" "rmail" "gnus" "shell")) 8011 ((member type '("bbdb" "vm" "wl" "rmail" "gnus" "shell"))
@@ -7805,20 +8103,15 @@ headlines. The default is 3. Lower levels will become bulleted lists."
7805 (let ((head (and org-export-highlight-first-table-line 8103 (let ((head (and org-export-highlight-first-table-line
7806 (delq nil (mapcar 8104 (delq nil (mapcar
7807 (lambda (x) (string-match "^[ \t]*|-" x)) 8105 (lambda (x) (string-match "^[ \t]*|-" x))
7808 lines)))) 8106 (cdr lines)))))
7809 lastline line fields html empty) 8107 line fields html)
7810 (setq html (concat org-export-html-table-tag "\n")) 8108 (setq html (concat org-export-html-table-tag "\n"))
7811 (while (setq lastline line 8109 (while (setq line (pop lines))
7812 line (pop lines))
7813 (setq empty "&nbsp")
7814 (catch 'next-line 8110 (catch 'next-line
7815 (if (string-match "^[ \t]*|-" line) 8111 (if (string-match "^[ \t]*|-" line)
7816 (if lastline 8112 (progn
7817 ;; A hline: simulate an empty table row instead. 8113 (setq head nil) ;; head ends here, first time around
7818 (setq line (org-fake-empty-table-line lastline) 8114 ;; ignore this line
7819 head nil
7820 empty "")
7821 ;; Ignore this line
7822 (throw 'next-line t))) 8115 (throw 'next-line t)))
7823 ;; Break the line into fields 8116 ;; Break the line into fields
7824 (setq fields (org-split-string line "[ \t]*|[ \t]*")) 8117 (setq fields (org-split-string line "[ \t]*|[ \t]*"))
@@ -7826,7 +8119,6 @@ headlines. The default is 3. Lower levels will become bulleted lists."
7826 html 8119 html
7827 "<tr>" 8120 "<tr>"
7828 (mapconcat (lambda (x) 8121 (mapconcat (lambda (x)
7829 (if (equal x "") (setq x empty))
7830 (if head 8122 (if head
7831 (concat "<th>" x "</th>") 8123 (concat "<th>" x "</th>")
7832 (concat "<td valign=\"top\">" x "</td>"))) 8124 (concat "<td valign=\"top\">" x "</td>")))
@@ -7899,7 +8191,7 @@ But it has the disadvantage, that Org-mode's HTML conversions cannot be used."
7899 (insert (mapconcat 'identity lines "\n")) 8191 (insert (mapconcat 'identity lines "\n"))
7900 (goto-char (point-min)) 8192 (goto-char (point-min))
7901 (if (not (re-search-forward "|[^+]" nil t)) 8193 (if (not (re-search-forward "|[^+]" nil t))
7902 (error "Error processing table.")) 8194 (error "Error processing table"))
7903 (table-recognize-table) 8195 (table-recognize-table)
7904 (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer)) 8196 (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer))
7905 (table-generate-source 'html " org-tmp2 ") 8197 (table-generate-source 'html " org-tmp2 ")
@@ -7915,9 +8207,9 @@ But it has the disadvantage, that Org-mode's HTML conversions cannot be used."
7915 (r (if m (substring string m) ""))) 8207 (r (if m (substring string m) "")))
7916 ;; convert < to &lt; and > to &gt; 8208 ;; convert < to &lt; and > to &gt;
7917 (while (string-match "<" s) 8209 (while (string-match "<" s)
7918 (setq s (replace-match "&lt;" nil nil s))) 8210 (setq s (replace-match "&lt;" t t s)))
7919 (while (string-match ">" s) 8211 (while (string-match ">" s)
7920 (setq s (replace-match "&gt;" nil nil s))) 8212 (setq s (replace-match "&gt;" t t s)))
7921 (if org-export-html-expand 8213 (if org-export-html-expand
7922 (while (string-match "@&lt;\\([^&]*\\)&gt;" s) 8214 (while (string-match "@&lt;\\([^&]*\\)&gt;" s)
7923 (setq s (replace-match "<\\1>" nil nil s)))) 8215 (setq s (replace-match "<\\1>" nil nil s))))
@@ -8126,7 +8418,6 @@ When LEVEL is non-nil, increase section numbers on that level."
8126;; i k @ expendable from outline-mode 8418;; i k @ expendable from outline-mode
8127;; 0123456789 ! $%^& * ()_{} " ~`' free 8419;; 0123456789 ! $%^& * ()_{} " ~`' free
8128 8420
8129(define-key org-mode-map [(tab)] 'org-cycle)
8130(define-key org-mode-map "\C-i" 'org-cycle) 8421(define-key org-mode-map "\C-i" 'org-cycle)
8131(define-key org-mode-map [(meta tab)] 'org-complete) 8422(define-key org-mode-map [(meta tab)] 'org-complete)
8132(define-key org-mode-map "\M-\C-i" 'org-complete) 8423(define-key org-mode-map "\M-\C-i" 'org-complete)
@@ -8144,6 +8435,7 @@ When LEVEL is non-nil, increase section numbers on that level."
8144(define-key org-mode-map "\C-c\C-h\C-w" 'org-cut-special) 8435(define-key org-mode-map "\C-c\C-h\C-w" 'org-cut-special)
8145(define-key org-mode-map "\C-c\C-h\M-w" 'org-copy-special) 8436(define-key org-mode-map "\C-c\C-h\M-w" 'org-copy-special)
8146(define-key org-mode-map "\C-c\C-h\C-y" 'org-paste-special) 8437(define-key org-mode-map "\C-c\C-h\C-y" 'org-paste-special)
8438(define-key org-mode-map "\C-c$" 'org-archive-subtree)
8147(define-key org-mode-map "\C-c\C-j" 'org-goto) 8439(define-key org-mode-map "\C-c\C-j" 'org-goto)
8148(define-key org-mode-map "\C-c\C-t" 'org-todo) 8440(define-key org-mode-map "\C-c\C-t" 'org-todo)
8149(define-key org-mode-map "\C-c\C-s" 'org-schedule) 8441(define-key org-mode-map "\C-c\C-s" 'org-schedule)
@@ -8166,21 +8458,19 @@ When LEVEL is non-nil, increase section numbers on that level."
8166(define-key org-mode-map "\C-c[" 'org-add-file) 8458(define-key org-mode-map "\C-c[" 'org-add-file)
8167(define-key org-mode-map "\C-c]" 'org-remove-file) 8459(define-key org-mode-map "\C-c]" 'org-remove-file)
8168(define-key org-mode-map "\C-c\C-r" 'org-timeline) 8460(define-key org-mode-map "\C-c\C-r" 'org-timeline)
8169(define-key org-mode-map [(shift up)] 'org-shiftup) 8461(define-key org-mode-map (org-key 'S-up) 'org-shiftup)
8170(define-key org-mode-map [(shift down)] 'org-shiftdown) 8462(define-key org-mode-map (org-key 'S-down) 'org-shiftdown)
8171(define-key org-mode-map [(shift left)] 'org-timestamp-down-day) 8463(define-key org-mode-map (org-key 'S-left) 'org-timestamp-down-day)
8172(define-key org-mode-map [(shift right)] 'org-timestamp-up-day) 8464(define-key org-mode-map (org-key 'S-right) 'org-timestamp-up-day)
8173(define-key org-mode-map "\C-c-" 'org-table-insert-hline) 8465(define-key org-mode-map "\C-c-" 'org-table-insert-hline)
8174;; The following line is e.g. necessary for German keyboards under Suse Linux 8466;; The following line is e.g. necessary for German keyboards under Suse Linux
8175(unless org-xemacs-p 8467(unless org-xemacs-p
8176 (define-key org-mode-map [S-iso-lefttab] 'org-shifttab)) 8468 (define-key org-mode-map [S-iso-lefttab] 'org-shifttab))
8177(define-key org-mode-map [(shift tab)] 'org-shifttab) 8469(define-key org-mode-map [(shift tab)] 'org-shifttab)
8178(define-key org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) 8470(define-key org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c)
8179(define-key org-mode-map [(return)] 'org-return) 8471(define-key org-mode-map "\C-m" 'org-return)
8180(define-key org-mode-map [(shift return)] 'org-table-copy-down) 8472(define-key org-mode-map (org-key 'S-return) 'org-table-copy-down)
8181(define-key org-mode-map [(meta return)] 'org-meta-return) 8473(define-key org-mode-map [(meta return)] 'org-meta-return)
8182(define-key org-mode-map [(control up)] 'org-move-line-up)
8183(define-key org-mode-map [(control down)] 'org-move-line-down)
8184(define-key org-mode-map "\C-c?" 'org-table-current-column) 8474(define-key org-mode-map "\C-c?" 'org-table-current-column)
8185(define-key org-mode-map "\C-c " 'org-table-blank-field) 8475(define-key org-mode-map "\C-c " 'org-table-blank-field)
8186(define-key org-mode-map "\C-c+" 'org-table-sum) 8476(define-key org-mode-map "\C-c+" 'org-table-sum)
@@ -8199,15 +8489,12 @@ When LEVEL is non-nil, increase section numbers on that level."
8199(define-key org-mode-map "\C-c\C-xh" 'org-export-as-html) 8489(define-key org-mode-map "\C-c\C-xh" 'org-export-as-html)
8200(define-key org-mode-map "\C-c\C-x\C-h" 'org-export-as-html-and-open) 8490(define-key org-mode-map "\C-c\C-x\C-h" 'org-export-as-html-and-open)
8201 8491
8202
8203;; FIXME: Do we really need to save match data in these commands?
8204;; I would like to remove it in order to minimize impact.
8205;; Self-insert already does not preserve it. How much resources used by this???
8206
8207(defsubst org-table-p () 8492(defsubst org-table-p ()
8208 (if (and (eq major-mode 'org-mode) font-lock-mode) 8493 (if (and (eq major-mode 'org-mode) font-lock-mode)
8209 (eq (get-text-property (point) 'face) 'org-table-face) 8494 (eq (get-text-property (point) 'face) 'org-table)
8210 (save-match-data (org-at-table-p)))) 8495 ;; (save-match-data (org-at-table-p)))) ; FIXME: OK to not use this?
8496 (org-at-table-p)))
8497
8211 8498
8212(defun org-self-insert-command (N) 8499(defun org-self-insert-command (N)
8213 "Like `self-insert-command', use overwrite-mode for whitespace in tables. 8500 "Like `self-insert-command', use overwrite-mode for whitespace in tables.
@@ -8279,7 +8566,7 @@ a reduced column width."
8279 8566
8280(defun org-shiftcursor-error () 8567(defun org-shiftcursor-error ()
8281 "Throw an error because Shift-Cursor command was applied in wrong context." 8568 "Throw an error because Shift-Cursor command was applied in wrong context."
8282 (error "This command is only active in tables and on headlines.")) 8569 (error "This command is only active in tables and on headlines"))
8283 8570
8284(defun org-shifttab () 8571(defun org-shifttab ()
8285 "Call `(org-cycle t)' or `org-table-previous-field'." 8572 "Call `(org-cycle t)' or `org-table-previous-field'."
@@ -8410,7 +8697,7 @@ the automatic table editor has been turned off."
8410 (if (y-or-n-p "Convert inactive region to table? ") 8697 (if (y-or-n-p "Convert inactive region to table? ")
8411 (org-table-convert-region (region-beginning) (region-end) arg) 8698 (org-table-convert-region (region-beginning) (region-end) arg)
8412 (error "Abort"))) 8699 (error "Abort")))
8413 (t (error "No table at point, and no region to make one."))))) 8700 (t (error "No table at point, and no region to make one")))))
8414 8701
8415(defun org-return () 8702(defun org-return ()
8416 "Call `org-table-next-row' or `newline'." 8703 "Call `org-table-next-row' or `newline'."
@@ -8469,7 +8756,9 @@ the automatic table editor has been turned off."
8469 ["Promote Heading" org-metaleft (not (org-at-table-p))] 8756 ["Promote Heading" org-metaleft (not (org-at-table-p))]
8470 ["Promote Subtree" org-shiftmetaleft (not (org-at-table-p))] 8757 ["Promote Subtree" org-shiftmetaleft (not (org-at-table-p))]
8471 ["Demote Heading" org-metaright (not (org-at-table-p))] 8758 ["Demote Heading" org-metaright (not (org-at-table-p))]
8472 ["Demote Subtree" org-shiftmetaright (not (org-at-table-p))]) 8759 ["Demote Subtree" org-shiftmetaright (not (org-at-table-p))]
8760 "--"
8761 ["Archive Subtree" org-archive-subtree t])
8473 "--" 8762 "--"
8474 ("TODO Lists" 8763 ("TODO Lists"
8475 ["TODO/DONE/-" org-todo t] 8764 ["TODO/DONE/-" org-todo t]
@@ -8533,7 +8822,7 @@ the automatic table editor has been turned off."
8533 ["Fill Rectangle" org-table-wrap-region (org-at-table-p)]) 8822 ["Fill Rectangle" org-table-wrap-region (org-at-table-p)])
8534 "--" 8823 "--"
8535 ["Which Column?" org-table-current-column (org-at-table-p)] 8824 ["Which Column?" org-table-current-column (org-at-table-p)]
8536 ["Sum Column/Rectangle" org-table-sum 8825 ["Sum Column/Rectangle" org-table-sum
8537 (or (org-at-table-p) (org-region-active-p))] 8826 (or (org-at-table-p) (org-region-active-p))]
8538 ["Eval Formula" org-table-eval-formula (org-at-table-p)] 8827 ["Eval Formula" org-table-eval-formula (org-at-table-p)]
8539 "--" 8828 "--"
@@ -8576,10 +8865,10 @@ With optional NODE, go directly to that node."
8576 (Info-goto-node (format "(org)%s" (or node "")))) 8865 (Info-goto-node (format "(org)%s" (or node ""))))
8577 8866
8578(defun org-install-agenda-files-menu () 8867(defun org-install-agenda-files-menu ()
8579 (easy-menu-change 8868 (easy-menu-change
8580 '("Org") "File List for Agenda" 8869 '("Org") "File List for Agenda"
8581 (append 8870 (append
8582 (list 8871 (list
8583 ["Edit File List" (customize-variable 'org-agenda-files) t] 8872 ["Edit File List" (customize-variable 'org-agenda-files) t]
8584 ["Add Current File to List" org-add-file t] 8873 ["Add Current File to List" org-add-file t]
8585 ["Remove Current File from List" org-remove-file t] 8874 ["Remove Current File from List" org-remove-file t]
@@ -8694,7 +8983,7 @@ that can be added."
8694;; Functions needed for compatibility with old outline.el 8983;; Functions needed for compatibility with old outline.el
8695 8984
8696;; The following functions capture almost the entire compatibility code 8985;; The following functions capture almost the entire compatibility code
8697;; between the different versions of outline-mode. The only other place 8986;; between the different versions of outline-mode. The only other place
8698;; where this is important are the font-lock-keywords. Search for 8987;; where this is important are the font-lock-keywords. Search for
8699;; `org-noutline-p' to find it. 8988;; `org-noutline-p' to find it.
8700 8989
@@ -8734,11 +9023,11 @@ Only visible heading lines are considered, unless INVISIBLE-OK is non-nil."
8734 (outline-back-to-heading invisible-ok) 9023 (outline-back-to-heading invisible-ok)
8735 (if (looking-at outline-regexp) 9024 (if (looking-at outline-regexp)
8736 t 9025 t
8737 (if (re-search-backward (concat (if invisible-ok "[\r\n]" "^") 9026 (if (re-search-backward (concat (if invisible-ok "\\([\r\n]\\|^\\)" "^")
8738 outline-regexp) 9027 outline-regexp)
8739 nil t) 9028 nil t)
8740 (if invisible-ok 9029 (if invisible-ok
8741 (progn (forward-char 1) 9030 (progn (goto-char (match-end 1))
8742 (looking-at outline-regexp))) 9031 (looking-at outline-regexp)))
8743 (error "Before first heading"))))) 9032 (error "Before first heading")))))
8744 9033
@@ -8759,7 +9048,7 @@ If INVISIBLE-OK is non-nil, an invisible heading line is ok too."
8759This function considers both visible and invisible heading lines. 9048This function considers both visible and invisible heading lines.
8760With argument, move up ARG levels." 9049With argument, move up ARG levels."
8761 (if org-noutline-p 9050 (if org-noutline-p
8762 (if (fboundp 'outline-up-heading-all) 9051 (if (fboundp 'outline-up-heading-all)
8763 (outline-up-heading-all arg) ; emacs 21 version of outline.el 9052 (outline-up-heading-all arg) ; emacs 21 version of outline.el
8764 (outline-up-heading arg t)) ; emacs 22 version of outline.el 9053 (outline-up-heading arg t)) ; emacs 22 version of outline.el
8765 (org-back-to-heading t) 9054 (org-back-to-heading t)
@@ -8815,8 +9104,8 @@ When ENTRY is non-nil, show the entire entry."
8815 9104
8816(defun org-show-subtree () 9105(defun org-show-subtree ()
8817 "Show everything after this heading at deeper levels." 9106 "Show everything after this heading at deeper levels."
8818 (outline-flag-region 9107 (outline-flag-region
8819 (point) 9108 (point)
8820 (save-excursion 9109 (save-excursion
8821 (outline-end-of-subtree) (outline-next-heading) (point)) 9110 (outline-end-of-subtree) (outline-next-heading) (point))
8822 (if org-noutline-p nil ?\n))) 9111 (if org-noutline-p nil ?\n)))
@@ -8827,7 +9116,7 @@ Show the heading too, if it is currently invisible."
8827 (interactive) 9116 (interactive)
8828 (save-excursion 9117 (save-excursion
8829 (org-back-to-heading t) 9118 (org-back-to-heading t)
8830 (outline-flag-region 9119 (outline-flag-region
8831 (1- (point)) 9120 (1- (point))
8832 (save-excursion 9121 (save-excursion
8833 (re-search-forward (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move) 9122 (re-search-forward (concat "[\r\n]\\(" outline-regexp "\\)") nil 'move)
@@ -8860,6 +9149,4 @@ Show the heading too, if it is currently invisible."
8860(run-hooks 'org-load-hook) 9149(run-hooks 'org-load-hook)
8861 9150
8862;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd 9151;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd
8863
8864;;; org.el ends here 9152;;; org.el ends here
8865
diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el
index b5edba97f4b..e2c58882d2a 100644
--- a/lisp/textmodes/reftex-toc.el
+++ b/lisp/textmodes/reftex-toc.el
@@ -149,7 +149,7 @@ When called with a raw C-u prefix, rescan the document first."
149 (frame-parameter (selected-frame) 'unsplittable))) 149 (frame-parameter (selected-frame) 'unsplittable)))
150 offset toc-window) 150 offset toc-window)
151 151
152 (if (setq toc-window (get-buffer-window 152 (if (setq toc-window (get-buffer-window
153 "*toc*" 153 "*toc*"
154 (if reuse 'visible))) 154 (if reuse 'visible)))
155 (select-window toc-window) 155 (select-window toc-window)
@@ -165,7 +165,7 @@ When called with a raw C-u prefix, rescan the document first."
165 (split-window-horizontally 165 (split-window-horizontally
166 (floor (* (window-width) 166 (floor (* (window-width)
167 reftex-toc-split-windows-fraction))) 167 reftex-toc-split-windows-fraction)))
168 (split-window-vertically 168 (split-window-vertically
169 (floor (* (window-height) 169 (floor (* (window-height)
170 reftex-toc-split-windows-fraction))))) 170 reftex-toc-split-windows-fraction)))))
171 171
@@ -210,11 +210,11 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help
210 reftex-toc-include-context 210 reftex-toc-include-context
211 nil ; counter 211 nil ; counter
212 nil ; commented 212 nil ; commented
213 here-I-am 213 here-I-am
214 "" ; xr-prefix 214 "" ; xr-prefix
215 t ; a toc buffer 215 t ; a toc buffer
216 )) 216 ))
217 217
218 (run-hooks 'reftex-display-copied-context-hook) 218 (run-hooks 'reftex-display-copied-context-hook)
219 (message "Building *toc* buffer...done.") 219 (message "Building *toc* buffer...done.")
220 (setq buffer-read-only t)) 220 (setq buffer-read-only t))
@@ -226,7 +226,7 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help
226 t 226 t
227 reftex-toc-include-index-entries 227 reftex-toc-include-index-entries
228 reftex-toc-include-file-boundaries) 228 reftex-toc-include-file-boundaries)
229 (reftex-last-assoc-before-elt 229 (reftex-last-assoc-before-elt
230 'toc here-I-am 230 'toc here-I-am
231 (symbol-value reftex-docstruct-symbol)))) 231 (symbol-value reftex-docstruct-symbol))))
232 (put 'reftex-toc :reftex-line 3) 232 (put 'reftex-toc :reftex-line 3)
@@ -251,7 +251,7 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help
251 (not (get-text-property (point) 'intangible)) 251 (not (get-text-property (point) 'intangible))
252 (memq reftex-highlight-selection '(cursor both)) 252 (memq reftex-highlight-selection '(cursor both))
253 (reftex-highlight 2 253 (reftex-highlight 2
254 (or (previous-single-property-change 254 (or (previous-single-property-change
255 (min (point-max) (1+ (point))) :data) 255 (min (point-max) (1+ (point))) :data)
256 (point-min)) 256 (point-min))
257 (or (next-single-property-change (point) :data) 257 (or (next-single-property-change (point) :data)
@@ -298,16 +298,16 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help
298 (window-height)))))) 298 (window-height))))))
299 299
300(defun reftex-toc-dframe-p (&optional frame error) 300(defun reftex-toc-dframe-p (&optional frame error)
301 ;; Check if FRAME is the dedicated TOC frame. 301 ;; Check if FRAME is the dedicated TOC frame.
302 ;; If yes, and ERROR is non-nil, throw an error. 302 ;; If yes, and ERROR is non-nil, throw an error.
303 (setq frame (or frame (selected-frame))) 303 (setq frame (or frame (selected-frame)))
304 (let ((res (equal 304 (let ((res (equal
305 (if (fboundp 'frame-property) 305 (if (fboundp 'frame-property)
306 (frame-property frame 'name) 306 (frame-property frame 'name)
307 (frame-parameter frame 'name)) 307 (frame-parameter frame 'name))
308 "RefTeX TOC Frame"))) 308 "RefTeX TOC Frame")))
309 (if (and res error) 309 (if (and res error)
310 (error "This frame is view-only. Use `C-c =' to create toc window for commands.")) 310 (error "This frame is view-only. Use `C-c =' to create toc window for commands"))
311 res)) 311 res))
312 312
313(defun reftex-toc-show-help () 313(defun reftex-toc-show-help ()
@@ -327,7 +327,7 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help
327 (if (boundp 'zmacs-region-stays) (setq zmacs-region-stays t)) 327 (if (boundp 'zmacs-region-stays) (setq zmacs-region-stays t))
328 (setq reftex-callback-fwd t) 328 (setq reftex-callback-fwd t)
329 (or (eobp) (forward-char 1)) 329 (or (eobp) (forward-char 1))
330 (goto-char (or (next-single-property-change (point) :data) 330 (goto-char (or (next-single-property-change (point) :data)
331 (point)))) 331 (point))))
332(defun reftex-toc-previous (&optional arg) 332(defun reftex-toc-previous (&optional arg)
333 "Move to previous selectable item." 333 "Move to previous selectable item."
@@ -364,7 +364,7 @@ SPC=view TAB=goto RET=goto+hide [q]uit [r]escan [l]abels [f]ollow [x]r [?]Help
364With prefix ARG, prompt for a label type and include only labels of 364With prefix ARG, prompt for a label type and include only labels of
365that specific type." 365that specific type."
366 (interactive "P") 366 (interactive "P")
367 (setq reftex-toc-include-labels 367 (setq reftex-toc-include-labels
368 (if arg (reftex-query-label-type) 368 (if arg (reftex-query-label-type)
369 (not reftex-toc-include-labels))) 369 (not reftex-toc-include-labels)))
370 (reftex-toc-revert)) 370 (reftex-toc-revert))
@@ -468,7 +468,7 @@ With prefix arg 1, restrict index to the section at point."
468(defun reftex-toc-rescan (&rest ignore) 468(defun reftex-toc-rescan (&rest ignore)
469 "Regenerate the *toc* buffer by reparsing file of section at point." 469 "Regenerate the *toc* buffer by reparsing file of section at point."
470 (interactive) 470 (interactive)
471 (if (and reftex-enable-partial-scans 471 (if (and reftex-enable-partial-scans
472 (null current-prefix-arg)) 472 (null current-prefix-arg))
473 (let* ((data (get-text-property (point) :data)) 473 (let* ((data (get-text-property (point) :data))
474 (what (car data)) 474 (what (car data))
@@ -502,7 +502,7 @@ With prefix arg 1, restrict index to the section at point."
502(defun reftex-toc-revert (&rest ignore) 502(defun reftex-toc-revert (&rest ignore)
503 "Regenerate the *toc* from the internal lists." 503 "Regenerate the *toc* from the internal lists."
504 (interactive) 504 (interactive)
505 (let ((unsplittable 505 (let ((unsplittable
506 (if (fboundp 'frame-property) 506 (if (fboundp 'frame-property)
507 (frame-property (selected-frame) 'unsplittable) 507 (frame-property (selected-frame) 'unsplittable)
508 (frame-parameter (selected-frame) 'unsplittable))) 508 (frame-parameter (selected-frame) 'unsplittable)))
@@ -589,7 +589,7 @@ point."
589 (goto-char start-pos) 589 (goto-char start-pos)
590 (setq sections (reftex-toc-extract-section-number (car entries))) 590 (setq sections (reftex-toc-extract-section-number (car entries)))
591 (if (> (setq nsec (length entries)) 1) 591 (if (> (setq nsec (length entries)) 1)
592 (setq sections 592 (setq sections
593 (concat sections "-" 593 (concat sections "-"
594 (reftex-toc-extract-section-number 594 (reftex-toc-extract-section-number
595 (nth (1- nsec) entries))))) 595 (nth (1- nsec) entries)))))
@@ -614,7 +614,7 @@ point."
614 (save-window-excursion 614 (save-window-excursion
615 (reftex-toc-Rescan)) 615 (reftex-toc-Rescan))
616 (reftex-toc-restore-region start-line mark-line) 616 (reftex-toc-restore-region start-line mark-line)
617 (message "%d section%s %smoted" 617 (message "%d section%s %smoted"
618 nsec (if (= 1 nsec) "" "s") pro-or-de) 618 nsec (if (= 1 nsec) "" "s") pro-or-de)
619 nil)) 619 nil))
620 (if msg (progn (ding) (message msg))))) 620 (if msg (progn (ding) (message msg)))))
@@ -667,7 +667,7 @@ promotion/demotion later."
667 (beginning-of-line 1) 667 (beginning-of-line 1)
668 (if (looking-at reftex-section-regexp) 668 (if (looking-at reftex-section-regexp)
669 (setq name (reftex-match-string 2)) 669 (setq name (reftex-match-string 2))
670 (error "Something is wrong! Contact maintainer!"))) 670 (error "Something is wrong! Contact maintainer!")))
671 ;; Section has changed, request scan and loading 671 ;; Section has changed, request scan and loading
672 ;; We use a variable to delay until after the safe-exc. 672 ;; We use a variable to delay until after the safe-exc.
673 ;; because otherwise we loose the region. 673 ;; because otherwise we loose the region.
@@ -776,7 +776,7 @@ label prefix determines the wording of a reference."
776 (error "This is not a label entry.")) 776 (error "This is not a label entry."))
777 (setq newlabel (read-string (format "Rename label \"%s\" to:" label))) 777 (setq newlabel (read-string (format "Rename label \"%s\" to:" label)))
778 (if (assoc newlabel (symbol-value reftex-docstruct-symbol)) 778 (if (assoc newlabel (symbol-value reftex-docstruct-symbol))
779 (if (not (y-or-n-p 779 (if (not (y-or-n-p
780 (format "Label '%s' exists. Use anyway? " label))) 780 (format "Label '%s' exists. Use anyway? " label)))
781 (error "Abort"))) 781 (error "Abort")))
782 (save-excursion 782 (save-excursion
@@ -786,7 +786,7 @@ label prefix determines the wording of a reference."
786 (reftex-query-replace-document 786 (reftex-query-replace-document
787 (concat "{" (regexp-quote label) "}") 787 (concat "{" (regexp-quote label) "}")
788 (format "{%s}" newlabel)) 788 (format "{%s}" newlabel))
789 (error t)))) 789 (error t))))
790 (reftex-toc-rescan))) 790 (reftex-toc-rescan)))
791 791
792 792
@@ -805,9 +805,9 @@ label prefix determines the wording of a reference."
805 show-window show-buffer match) 805 show-window show-buffer match)
806 806
807 (unless toc (error "Don't know which toc line to visit")) 807 (unless toc (error "Don't know which toc line to visit"))
808 808
809 (cond 809 (cond
810 810
811 ((eq (car toc) 'toc) 811 ((eq (car toc) 'toc)
812 ;; a toc entry 812 ;; a toc entry
813 (setq match (reftex-toc-find-section toc no-revisit))) 813 (setq match (reftex-toc-find-section toc no-revisit)))
@@ -823,7 +823,7 @@ label prefix determines the wording of a reference."
823 (file (nth 1 toc))) 823 (file (nth 1 toc)))
824 (if (or (not no-revisit) (reftex-get-buffer-visiting file)) 824 (if (or (not no-revisit) (reftex-get-buffer-visiting file))
825 (progn 825 (progn
826 (switch-to-buffer-other-window 826 (switch-to-buffer-other-window
827 (reftex-get-file-buffer-force file nil)) 827 (reftex-get-file-buffer-force file nil))
828 (goto-char (if (eq where 'bof) (point-min) (point-max)))) 828 (goto-char (if (eq where 'bof) (point-min) (point-max))))
829 (message reftex-no-follow-message) nil)))) 829 (message reftex-no-follow-message) nil))))
@@ -876,8 +876,8 @@ label prefix determines the wording of a reference."
876 (looking-at (reftex-make-desperate-section-regexp literal)) 876 (looking-at (reftex-make-desperate-section-regexp literal))
877 (looking-at (concat "\\\\" 877 (looking-at (concat "\\\\"
878 (regexp-quote 878 (regexp-quote
879 (car 879 (car
880 (rassq level 880 (rassq level
881 reftex-section-levels-all))) 881 reftex-section-levels-all)))
882 "[[{]?")))) 882 "[[{]?"))))
883 ((or (not no-revisit) 883 ((or (not no-revisit)
@@ -1047,7 +1047,7 @@ always show the current section in connection with the option
1047 (define-key reftex-toc-map (vector (list key)) 'digit-argument)) 1047 (define-key reftex-toc-map (vector (list key)) 'digit-argument))
1048(define-key reftex-toc-map "-" 'negative-argument) 1048(define-key reftex-toc-map "-" 'negative-argument)
1049 1049
1050(easy-menu-define 1050(easy-menu-define
1051 reftex-toc-menu reftex-toc-map 1051 reftex-toc-menu reftex-toc-map
1052 "Menu for Table of Contents buffer" 1052 "Menu for Table of Contents buffer"
1053 '("TOC" 1053 '("TOC"
@@ -1080,7 +1080,7 @@ always show the current section in connection with the option
1080 ["Context" reftex-toc-toggle-context :style toggle 1080 ["Context" reftex-toc-toggle-context :style toggle
1081 :selected reftex-toc-include-context] 1081 :selected reftex-toc-include-context]
1082 "--" 1082 "--"
1083 ["Follow Mode" reftex-toc-toggle-follow :style toggle 1083 ["Follow Mode" reftex-toc-toggle-follow :style toggle
1084 :selected reftex-toc-follow-mode] 1084 :selected reftex-toc-follow-mode]
1085 ["Auto Recenter" reftex-toggle-auto-toc-recenter :style toggle 1085 ["Auto Recenter" reftex-toggle-auto-toc-recenter :style toggle
1086 :selected reftex-toc-auto-recenter-timer] 1086 :selected reftex-toc-auto-recenter-timer]
diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el
index f8b4cba65ae..574c17a07f9 100644
--- a/lisp/textmodes/reftex.el
+++ b/lisp/textmodes/reftex.el
@@ -26,7 +26,7 @@
26;;--------------------------------------------------------------------------- 26;;---------------------------------------------------------------------------
27;; 27;;
28;;; Commentary: 28;;; Commentary:
29;; 29;;
30;; RefTeX is a minor mode with distinct support for \ref, \label, \cite, 30;; RefTeX is a minor mode with distinct support for \ref, \label, \cite,
31;; and \index commands in (multi-file) LaTeX documents. 31;; and \index commands in (multi-file) LaTeX documents.
32;; - A table of contents provides easy access to any part of a document. 32;; - A table of contents provides easy access to any part of a document.
@@ -71,7 +71,7 @@
71;; 71;;
72;; Introduction 72;; Introduction
73;; ************ 73;; ************
74;; 74;;
75;; RefTeX is a specialized package for support of labels, references, 75;; RefTeX is a specialized package for support of labels, references,
76;; citations, and the index in LaTeX. RefTeX wraps itself round 4 LaTeX 76;; citations, and the index in LaTeX. RefTeX wraps itself round 4 LaTeX
77;; macros: `\label', `\ref', `\cite', and `\index'. Using these macros 77;; macros: `\label', `\ref', `\cite', and `\index'. Using these macros
@@ -80,13 +80,13 @@
80;; time-consuming tasks almost entirely. It also provides functions to 80;; time-consuming tasks almost entirely. It also provides functions to
81;; display the structure of a document and to move around in this 81;; display the structure of a document and to move around in this
82;; structure quickly. 82;; structure quickly.
83;; 83;;
84;; *Note Imprint::, for information about who to contact for help, bug 84;; *Note Imprint::, for information about who to contact for help, bug
85;; reports or suggestions. 85;; reports or suggestions.
86;; 86;;
87;; Environment 87;; Environment
88;; =========== 88;; ===========
89;; 89;;
90;; RefTeX needs to access all files which are part of a multifile 90;; RefTeX needs to access all files which are part of a multifile
91;; document, and the BibTeX database files requested by the 91;; document, and the BibTeX database files requested by the
92;; `\bibliography' command. To find these files, RefTeX will require a 92;; `\bibliography' command. To find these files, RefTeX will require a
@@ -95,26 +95,26 @@
95;; which are also used by RefTeX. However, on some systems these 95;; which are also used by RefTeX. However, on some systems these
96;; variables do not contain the full search path. If RefTeX does not work 96;; variables do not contain the full search path. If RefTeX does not work
97;; for you because it cannot find some files, read *Note Finding Files::. 97;; for you because it cannot find some files, read *Note Finding Files::.
98;; 98;;
99;; Entering RefTeX Mode 99;; Entering RefTeX Mode
100;; ==================== 100;; ====================
101;; 101;;
102;; To turn RefTeX Mode on and off in a particular buffer, use `M-x 102;; To turn RefTeX Mode on and off in a particular buffer, use `M-x
103;; reftex-mode'. To turn on RefTeX Mode for all LaTeX files, add the 103;; reftex-mode'. To turn on RefTeX Mode for all LaTeX files, add the
104;; following lines to your `.emacs' file: 104;; following lines to your `.emacs' file:
105;; 105;;
106;; (add-hook 'LaTeX-mode-hook 'turn-on-reftex) ; with AUCTeX LaTeX mode 106;; (add-hook 'LaTeX-mode-hook 'turn-on-reftex) ; with AUCTeX LaTeX mode
107;; (add-hook 'latex-mode-hook 'turn-on-reftex) ; with Emacs latex mode 107;; (add-hook 'latex-mode-hook 'turn-on-reftex) ; with Emacs latex mode
108;; 108;;
109;; RefTeX in a Nutshell 109;; RefTeX in a Nutshell
110;; ==================== 110;; ====================
111;; 111;;
112;; 1. Table of Contents 112;; 1. Table of Contents
113;; Typing `C-c =' (`reftex-toc') will show a table of contents of the 113;; Typing `C-c =' (`reftex-toc') will show a table of contents of the
114;; document. This buffer can display sections, labels and index 114;; document. This buffer can display sections, labels and index
115;; entries defined in the document. From the buffer, you can jump 115;; entries defined in the document. From the buffer, you can jump
116;; quickly to every part of your document. Press `?' to get help. 116;; quickly to every part of your document. Press `?' to get help.
117;; 117;;
118;; 2. Labels and References 118;; 2. Labels and References
119;; RefTeX helps to create unique labels and to find the correct key 119;; RefTeX helps to create unique labels and to find the correct key
120;; for references quickly. It distinguishes labels for different 120;; for references quickly. It distinguishes labels for different
@@ -122,7 +122,7 @@
122;; others), and can be configured to recognize any additional labeled 122;; others), and can be configured to recognize any additional labeled
123;; environments you have defined yourself (variable 123;; environments you have defined yourself (variable
124;; `reftex-label-alist'). 124;; `reftex-label-alist').
125;; 125;;
126;; * Creating Labels 126;; * Creating Labels
127;; Type `C-c (' (`reftex-label') to insert a label at point. 127;; Type `C-c (' (`reftex-label') to insert a label at point.
128;; RefTeX will either 128;; RefTeX will either
@@ -131,17 +131,17 @@
131;; tables) or 131;; tables) or
132;; - insert a simple label made of a prefix and a number (all 132;; - insert a simple label made of a prefix and a number (all
133;; other environments) 133;; other environments)
134;; 134;;
135;; Which labels are created how is configurable with the variable 135;; Which labels are created how is configurable with the variable
136;; `reftex-insert-label-flags'. 136;; `reftex-insert-label-flags'.
137;; 137;;
138;; * Referencing Labels 138;; * Referencing Labels
139;; To make a reference, type `C-c )' (`reftex-reference'). This 139;; To make a reference, type `C-c )' (`reftex-reference'). This
140;; shows an outline of the document with all labels of a certain 140;; shows an outline of the document with all labels of a certain
141;; type (figure, equation,...) and some label context. 141;; type (figure, equation,...) and some label context.
142;; Selecting a label inserts a `\ref{LABEL}' macro into the 142;; Selecting a label inserts a `\ref{LABEL}' macro into the
143;; original buffer. 143;; original buffer.
144;; 144;;
145;; 3. Citations 145;; 3. Citations
146;; Typing `C-c [' (`reftex-citation') will let you specify a regular 146;; Typing `C-c [' (`reftex-citation') will let you specify a regular
147;; expression to search in current BibTeX database files (as 147;; expression to search in current BibTeX database files (as
@@ -150,7 +150,7 @@
150;; sorted. The selected article is referenced as `\cite{KEY}' (see 150;; sorted. The selected article is referenced as `\cite{KEY}' (see
151;; the variable `reftex-cite-format' if you want to insert different 151;; the variable `reftex-cite-format' if you want to insert different
152;; macros). 152;; macros).
153;; 153;;
154;; 4. Index Support 154;; 4. Index Support
155;; RefTeX helps to enter index entries. It also compiles all entries 155;; RefTeX helps to enter index entries. It also compiles all entries
156;; into an alphabetically sorted `*Index*' buffer which you can use 156;; into an alphabetically sorted `*Index*' buffer which you can use
@@ -158,25 +158,25 @@
158;; index macros and can be configured to recognize any additional 158;; index macros and can be configured to recognize any additional
159;; macros you have defined (`reftex-index-macros'). Multiple indices 159;; macros you have defined (`reftex-index-macros'). Multiple indices
160;; are supported. 160;; are supported.
161;; 161;;
162;; * Creating Index Entries 162;; * Creating Index Entries
163;; To index the current selection or the word at point, type 163;; To index the current selection or the word at point, type
164;; `C-c /' (`reftex-index-selection-or-word'). The default macro 164;; `C-c /' (`reftex-index-selection-or-word'). The default macro
165;; `reftex-index-default-macro' will be used. For a more 165;; `reftex-index-default-macro' will be used. For a more
166;; complex entry type `C-c <' (`reftex-index'), select any of 166;; complex entry type `C-c <' (`reftex-index'), select any of
167;; the index macros and enter the arguments with completion. 167;; the index macros and enter the arguments with completion.
168;; 168;;
169;; * The Index Phrases File (Delayed Indexing) 169;; * The Index Phrases File (Delayed Indexing)
170;; Type `C-c \' (`reftex-index-phrase-selection-or-word') to add 170;; Type `C-c \' (`reftex-index-phrase-selection-or-word') to add
171;; the current word or selection to a special _index phrase 171;; the current word or selection to a special _index phrase
172;; file_. RefTeX can later search the document for occurrences 172;; file_. RefTeX can later search the document for occurrences
173;; of these phrases and let you interactively index the matches. 173;; of these phrases and let you interactively index the matches.
174;; 174;;
175;; * Displaying and Editing the Index 175;; * Displaying and Editing the Index
176;; To display the compiled index in a special buffer, type `C-c 176;; To display the compiled index in a special buffer, type `C-c
177;; >' (`reftex-display-index'). From that buffer you can check 177;; >' (`reftex-display-index'). From that buffer you can check
178;; and edit all entries. 178;; and edit all entries.
179;; 179;;
180;; 5. Viewing Cross-References 180;; 5. Viewing Cross-References
181;; When point is on the KEY argument of a cross-referencing macro 181;; When point is on the KEY argument of a cross-referencing macro
182;; (`\label', `\ref', `\cite', `\bibitem', `\index', and variations) 182;; (`\label', `\ref', `\cite', `\bibitem', `\index', and variations)
@@ -186,14 +186,14 @@
186;; When the enclosing macro is `\cite' or `\ref' and no other message 186;; When the enclosing macro is `\cite' or `\ref' and no other message
187;; occupies the echo area, information about the citation or label 187;; occupies the echo area, information about the citation or label
188;; will automatically be displayed in the echo area. 188;; will automatically be displayed in the echo area.
189;; 189;;
190;; 6. Multifile Documents 190;; 6. Multifile Documents
191;; Multifile Documents are fully supported. The included files must 191;; Multifile Documents are fully supported. The included files must
192;; have a file variable `TeX-master' or `tex-main-file' pointing to 192;; have a file variable `TeX-master' or `tex-main-file' pointing to
193;; the master file. RefTeX provides cross-referencing information 193;; the master file. RefTeX provides cross-referencing information
194;; from all parts of the document, and across document borders 194;; from all parts of the document, and across document borders
195;; (`xr.sty'). 195;; (`xr.sty').
196;; 196;;
197;; 7. Document Parsing 197;; 7. Document Parsing
198;; RefTeX needs to parse the document in order to find labels and 198;; RefTeX needs to parse the document in order to find labels and
199;; other information. It does it automatically once and updates its 199;; other information. It does it automatically once and updates its
@@ -202,23 +202,23 @@
202;; with a raw `C-u' prefix, or press the `r' key in the label 202;; with a raw `C-u' prefix, or press the `r' key in the label
203;; selection buffer, the table of contents buffer, or the index 203;; selection buffer, the table of contents buffer, or the index
204;; buffer. 204;; buffer.
205;; 205;;
206;; 8. AUCTeX 206;; 8. AUCTeX
207;; If your major LaTeX mode is AUCTeX, RefTeX can cooperate with it 207;; If your major LaTeX mode is AUCTeX, RefTeX can cooperate with it
208;; (see variable `reftex-plug-into-AUCTeX'). AUCTeX contains style 208;; (see variable `reftex-plug-into-AUCTeX'). AUCTeX contains style
209;; files which trigger appropriate settings in RefTeX, so that for 209;; files which trigger appropriate settings in RefTeX, so that for
210;; many of the popular LaTeX packages no additional customizations 210;; many of the popular LaTeX packages no additional customizations
211;; will be necessary. 211;; will be necessary.
212;; 212;;
213;; 9. Useful Settings 213;; 9. Useful Settings
214;; To make RefTeX faster for large documents, try these: 214;; To make RefTeX faster for large documents, try these:
215;; (setq reftex-enable-partial-scans t) 215;; (setq reftex-enable-partial-scans t)
216;; (setq reftex-save-parse-info t) 216;; (setq reftex-save-parse-info t)
217;; (setq reftex-use-multiple-selection-buffers t) 217;; (setq reftex-use-multiple-selection-buffers t)
218;; 218;;
219;; To integrate with AUCTeX, use 219;; To integrate with AUCTeX, use
220;; (setq reftex-plug-into-AUCTeX t) 220;; (setq reftex-plug-into-AUCTeX t)
221;; 221;;
222;; To make your own LaTeX macro definitions known to RefTeX, 222;; To make your own LaTeX macro definitions known to RefTeX,
223;; customize the variables 223;; customize the variables
224;; `reftex-label-alist' (for label macros/environments) 224;; `reftex-label-alist' (for label macros/environments)
@@ -228,7 +228,7 @@
228;; `reftex-index-default-macro' (to set the default macro) 228;; `reftex-index-default-macro' (to set the default macro)
229;; If you have a large number of macros defined, you may want to write 229;; If you have a large number of macros defined, you may want to write
230;; an AUCTeX style file to support them with both AUCTeX and RefTeX. 230;; an AUCTeX style file to support them with both AUCTeX and RefTeX.
231;; 231;;
232;; 10. Where Next? 232;; 10. Where Next?
233;; Go ahead and use RefTeX. Use its menus until you have picked up 233;; Go ahead and use RefTeX. Use its menus until you have picked up
234;; the key bindings. For an overview of what you can do in each of 234;; the key bindings. For an overview of what you can do in each of
@@ -237,7 +237,7 @@
237;; The first part of the manual explains in a tutorial way how to use 237;; The first part of the manual explains in a tutorial way how to use
238;; and customize RefTeX. The second part is a command and variable 238;; and customize RefTeX. The second part is a command and variable
239;; reference. 239;; reference.
240;; 240;;
241;;--------------------------------------------------------------------------- 241;;---------------------------------------------------------------------------
242;; 242;;
243;; AUTHOR 243;; AUTHOR
@@ -319,7 +319,7 @@
319 (setq reftex-syntax-table (copy-syntax-table)) 319 (setq reftex-syntax-table (copy-syntax-table))
320 (modify-syntax-entry ?\( "." reftex-syntax-table) 320 (modify-syntax-entry ?\( "." reftex-syntax-table)
321 (modify-syntax-entry ?\) "." reftex-syntax-table)) 321 (modify-syntax-entry ?\) "." reftex-syntax-table))
322 322
323(unless reftex-syntax-table-for-bib 323(unless reftex-syntax-table-for-bib
324 (setq reftex-syntax-table-for-bib 324 (setq reftex-syntax-table-for-bib
325 (copy-syntax-table reftex-syntax-table)) 325 (copy-syntax-table reftex-syntax-table))
@@ -395,7 +395,7 @@ on the menu bar.
395 (setq reftex-syntax-table (copy-syntax-table (syntax-table))) 395 (setq reftex-syntax-table (copy-syntax-table (syntax-table)))
396 (modify-syntax-entry ?\( "." reftex-syntax-table) 396 (modify-syntax-entry ?\( "." reftex-syntax-table)
397 (modify-syntax-entry ?\) "." reftex-syntax-table) 397 (modify-syntax-entry ?\) "." reftex-syntax-table)
398 398
399 (setq reftex-syntax-table-for-bib 399 (setq reftex-syntax-table-for-bib
400 (copy-syntax-table reftex-syntax-table)) 400 (copy-syntax-table reftex-syntax-table))
401 (modify-syntax-entry ?\' "." reftex-syntax-table-for-bib) 401 (modify-syntax-entry ?\' "." reftex-syntax-table-for-bib)
@@ -536,7 +536,7 @@ on the menu bar.
536 ((master 536 ((master
537 (cond 537 (cond
538 ((fboundp 'TeX-master-file) ; AUCTeX is loaded. Use its mechanism. 538 ((fboundp 'TeX-master-file) ; AUCTeX is loaded. Use its mechanism.
539 (condition-case nil 539 (condition-case nil
540 (TeX-master-file t) 540 (TeX-master-file t)
541 (error (buffer-file-name)))) 541 (error (buffer-file-name))))
542 ((fboundp 'tex-main-file) (tex-main-file)) ; Emacs LaTeX mode 542 ((fboundp 'tex-main-file) (tex-main-file)) ; Emacs LaTeX mode
@@ -737,14 +737,14 @@ the label information is recompiled on next use."
737 737
738;; A list of all variables in the cache. 738;; A list of all variables in the cache.
739;; The cache is used to save the compiled versions of some variables. 739;; The cache is used to save the compiled versions of some variables.
740(defconst reftex-cache-variables 740(defconst reftex-cache-variables
741 '(reftex-memory ;; This MUST ALWAYS be the first! 741 '(reftex-memory ;; This MUST ALWAYS be the first!
742 742
743 ;; Outline 743 ;; Outline
744 reftex-section-levels-all 744 reftex-section-levels-all
745 745
746 ;; Labels 746 ;; Labels
747 reftex-env-or-mac-alist 747 reftex-env-or-mac-alist
748 reftex-special-env-parsers 748 reftex-special-env-parsers
749 reftex-macros-with-labels 749 reftex-macros-with-labels
750 reftex-label-mac-list 750 reftex-label-mac-list
@@ -761,7 +761,7 @@ the label information is recompiled on next use."
761 reftex-index-macro-alist 761 reftex-index-macro-alist
762 reftex-macros-with-index 762 reftex-macros-with-index
763 reftex-query-index-macro-prompt 763 reftex-query-index-macro-prompt
764 reftex-query-index-macro-help 764 reftex-query-index-macro-help
765 reftex-key-to-index-macro-alist 765 reftex-key-to-index-macro-alist
766 766
767 ;; Regular expressions 767 ;; Regular expressions
@@ -806,7 +806,7 @@ the label information is recompiled on next use."
806 (t (reftex-compile-variables))))) 806 (t (reftex-compile-variables)))))
807 807
808(defun reftex-reset-mode () 808(defun reftex-reset-mode ()
809 "Reset RefTeX Mode. 809 "Reset RefTeX Mode.
810This will re-compile the configuration information and remove all 810This will re-compile the configuration information and remove all
811current scanning information and the parse file to enforce a rescan 811current scanning information and the parse file to enforce a rescan
812on next use." 812on next use."
@@ -857,12 +857,12 @@ This enforces rescanning the buffer on next use."
857 857
858(defun reftex-erase-all-selection-and-index-buffers () 858(defun reftex-erase-all-selection-and-index-buffers ()
859 ;; Remove all selection buffers associated with current document. 859 ;; Remove all selection buffers associated with current document.
860 (mapcar 860 (mapcar
861 (lambda (type) 861 (lambda (type)
862 (reftex-erase-buffer (reftex-make-selection-buffer-name type))) 862 (reftex-erase-buffer (reftex-make-selection-buffer-name type)))
863 reftex-typekey-list) 863 reftex-typekey-list)
864 ;; Kill all index buffers 864 ;; Kill all index buffers
865 (mapcar 865 (mapcar
866 (lambda (tag) 866 (lambda (tag)
867 (reftex-kill-buffer (reftex-make-index-buffer-name tag))) 867 (reftex-kill-buffer (reftex-make-index-buffer-name tag)))
868 (cdr (assoc 'index-tags (symbol-value reftex-docstruct-symbol))))) 868 (cdr (assoc 'index-tags (symbol-value reftex-docstruct-symbol)))))
@@ -878,7 +878,7 @@ This enforces rescanning the buffer on next use."
878 878
879 ;; Record that we have done this, and what we have used. 879 ;; Record that we have done this, and what we have used.
880 (setq reftex-tables-dirty nil) 880 (setq reftex-tables-dirty nil)
881 (setq reftex-memory 881 (setq reftex-memory
882 (list reftex-label-alist 882 (list reftex-label-alist
883 (get reftex-docstruct-symbol 'reftex-section-levels) 883 (get reftex-docstruct-symbol 'reftex-section-levels)
884 (get reftex-docstruct-symbol 'reftex-label-alist-style) 884 (get reftex-docstruct-symbol 'reftex-label-alist-style)
@@ -897,7 +897,7 @@ This enforces rescanning the buffer on next use."
897 '(nil))) 897 '(nil)))
898 (all-index (reftex-uniquify-by-car 898 (all-index (reftex-uniquify-by-car
899 (reftex-splice-symbols-into-list 899 (reftex-splice-symbols-into-list
900 (append reftex-index-macros 900 (append reftex-index-macros
901 (get reftex-docstruct-symbol 901 (get reftex-docstruct-symbol
902 'reftex-index-macros-style) 902 'reftex-index-macros-style)
903 '(default)) 903 '(default))
@@ -908,7 +908,7 @@ This enforces rescanning the buffer on next use."
908 macro verify repeat nindex tag key toc-level toc-levels) 908 macro verify repeat nindex tag key toc-level toc-levels)
909 909
910 (setq reftex-words-to-typekey-alist nil 910 (setq reftex-words-to-typekey-alist nil
911 reftex-prefix-to-typekey-alist 911 reftex-prefix-to-typekey-alist
912 '(("sec:" . "s") ("cha:" . "s") ("chap:" . "s")) 912 '(("sec:" . "s") ("cha:" . "s") ("chap:" . "s"))
913 reftex-typekey-list nil 913 reftex-typekey-list nil
914 reftex-typekey-to-format-alist nil 914 reftex-typekey-to-format-alist nil
@@ -964,7 +964,7 @@ This enforces rescanning the buffer on next use."
964 ((symbolp env-or-mac) 964 ((symbolp env-or-mac)
965 ;; A special parser function 965 ;; A special parser function
966 (unless (fboundp env-or-mac) 966 (unless (fboundp env-or-mac)
967 (message "Warning: %s does not seem to be a valid function" 967 (message "Warning: %s does not seem to be a valid function"
968 env-or-mac)) 968 env-or-mac))
969 (setq nargs nil nlabel nil opt-args nil) 969 (setq nargs nil nlabel nil opt-args nil)
970 (add-to-list 'reftex-special-env-parsers env-or-mac) 970 (add-to-list 'reftex-special-env-parsers env-or-mac)
@@ -992,8 +992,8 @@ This enforces rescanning the buffer on next use."
992 (push (cons string toc-level) toc-levels)))))))) 992 (push (cons string toc-level) toc-levels))))))))
993 ;; Translate some special context cases 993 ;; Translate some special context cases
994 (when (assq context reftex-default-context-regexps) 994 (when (assq context reftex-default-context-regexps)
995 (setq context 995 (setq context
996 (format 996 (format
997 (cdr (assq context reftex-default-context-regexps)) 997 (cdr (assq context reftex-default-context-regexps))
998 (regexp-quote env-or-mac)))) 998 (regexp-quote env-or-mac))))
999 ;; See if this is the first format for this typekey 999 ;; See if this is the first format for this typekey
@@ -1026,7 +1026,7 @@ This enforces rescanning the buffer on next use."
1026 (nreverse reftex-typekey-to-prefix-alist)) 1026 (nreverse reftex-typekey-to-prefix-alist))
1027 1027
1028 ;; Prepare the typekey query prompt and help string. 1028 ;; Prepare the typekey query prompt and help string.
1029 (setq qh-list 1029 (setq qh-list
1030 (sort qh-list 1030 (sort qh-list
1031 (lambda (x1 x2) 1031 (lambda (x1 x2)
1032 (string< (downcase (car x1)) (downcase (car x2)))))) 1032 (string< (downcase (car x1)) (downcase (car x2))))))
@@ -1037,7 +1037,7 @@ This enforces rescanning the buffer on next use."
1037 "]")) 1037 "]"))
1038 ;; In the help string, we need to wrap lines... 1038 ;; In the help string, we need to wrap lines...
1039 (setq reftex-type-query-help 1039 (setq reftex-type-query-help
1040 (concat 1040 (concat
1041 "SELECT A LABEL TYPE:\n--------------------\n" 1041 "SELECT A LABEL TYPE:\n--------------------\n"
1042 (mapconcat 1042 (mapconcat
1043 (lambda(x) 1043 (lambda(x)
@@ -1057,7 +1057,7 @@ This enforces rescanning the buffer on next use."
1057 ;; which allow for some chars from the ref format to be in the buffer. 1057 ;; which allow for some chars from the ref format to be in the buffer.
1058 ;; These characters will be seen and removed. 1058 ;; These characters will be seen and removed.
1059 (setq reftex-words-to-typekey-alist 1059 (setq reftex-words-to-typekey-alist
1060 (mapcar 1060 (mapcar
1061 (lambda (x) 1061 (lambda (x)
1062 (setq word (car x) 1062 (setq word (car x)
1063 typekey (cdr x) 1063 typekey (cdr x)
@@ -1110,18 +1110,18 @@ This enforces rescanning the buffer on next use."
1110 (setq reftex-key-to-index-macro-alist 1110 (setq reftex-key-to-index-macro-alist
1111 (sort reftex-key-to-index-macro-alist 1111 (sort reftex-key-to-index-macro-alist
1112 (lambda (a b) (< (downcase (car a)) (downcase (car b)))))) 1112 (lambda (a b) (< (downcase (car a)) (downcase (car b))))))
1113 (setq reftex-query-index-macro-prompt 1113 (setq reftex-query-index-macro-prompt
1114 (concat "Index macro: [" 1114 (concat "Index macro: ["
1115 (mapconcat (lambda (x) (char-to-string (car x))) 1115 (mapconcat (lambda (x) (char-to-string (car x)))
1116 reftex-key-to-index-macro-alist "") 1116 reftex-key-to-index-macro-alist "")
1117 "]")) 1117 "]"))
1118 (setq i 0 1118 (setq i 0
1119 reftex-query-index-macro-help 1119 reftex-query-index-macro-help
1120 (concat 1120 (concat
1121 "SELECT A MACRO:\n---------------\n" 1121 "SELECT A MACRO:\n---------------\n"
1122 (mapconcat 1122 (mapconcat
1123 (lambda(x) 1123 (lambda(x)
1124 (format "[%c] %-20.20s%s" (car x) (nth 1 x) 1124 (format "[%c] %-20.20s%s" (car x) (nth 1 x)
1125 (if (= 0 (mod (incf i) 3)) "\n" ""))) 1125 (if (= 0 (mod (incf i) 3)) "\n" "")))
1126 reftex-key-to-index-macro-alist ""))) 1126 reftex-key-to-index-macro-alist "")))
1127 1127
@@ -1135,11 +1135,11 @@ This enforces rescanning the buffer on next use."
1135 (let* ( 1135 (let* (
1136; (wbol "\\(\\`\\|[\n\r]\\)[ \t]*") 1136; (wbol "\\(\\`\\|[\n\r]\\)[ \t]*")
1137 (wbol "\\(^\\)[ \t]*") ; Need to keep the empty group because 1137 (wbol "\\(^\\)[ \t]*") ; Need to keep the empty group because
1138 ;;; because match number are hard coded 1138 ;;; because match number are hard coded
1139 (label-re "\\\\label{\\([^}]*\\)}") 1139 (label-re "\\\\label{\\([^}]*\\)}")
1140 (include-re (concat wbol 1140 (include-re (concat wbol
1141 "\\\\\\(" 1141 "\\\\\\("
1142 (mapconcat 'identity 1142 (mapconcat 'identity
1143 reftex-include-file-commands "\\|") 1143 reftex-include-file-commands "\\|")
1144 "\\)[{ \t]+\\([^} \t\n\r]+\\)")) 1144 "\\)[{ \t]+\\([^} \t\n\r]+\\)"))
1145 (section-re 1145 (section-re
@@ -1193,7 +1193,7 @@ This enforces rescanning the buffer on next use."
1193 reftex-macros-with-labels macros-with-labels 1193 reftex-macros-with-labels macros-with-labels
1194 reftex-find-index-entry-regexp-format find-index-re-format 1194 reftex-find-index-entry-regexp-format find-index-re-format
1195 reftex-find-label-regexp-format find-label-re-format 1195 reftex-find-label-regexp-format find-label-re-format
1196 reftex-find-label-regexp-format2 1196 reftex-find-label-regexp-format2
1197 "\\([]} \t\n\r]\\)\\([[{]\\)\\(%s\\)[]}]") 1197 "\\([]} \t\n\r]\\)\\([[{]\\)\\(%s\\)[]}]")
1198 (message "Compiling label environment definitions...done"))) 1198 (message "Compiling label environment definitions...done")))
1199 (put reftex-docstruct-symbol 'reftex-cache 1199 (put reftex-docstruct-symbol 'reftex-cache
@@ -1232,7 +1232,7 @@ This enforces rescanning the buffer on next use."
1232 ;; Error out in a buffer without a file. 1232 ;; Error out in a buffer without a file.
1233 (if (and reftex-mode 1233 (if (and reftex-mode
1234 (not (buffer-file-name))) 1234 (not (buffer-file-name)))
1235 (error "RefTeX works only in buffers visiting a file.")) 1235 (error "RefTeX works only in buffers visiting a file"))
1236 1236
1237 ;; Make sure we have the symbols tied 1237 ;; Make sure we have the symbols tied
1238 (if (eq reftex-docstruct-symbol nil) 1238 (if (eq reftex-docstruct-symbol nil)
@@ -1270,7 +1270,7 @@ This enforces rescanning the buffer on next use."
1270 (and (symbolp reftex-docstruct-symbol) 1270 (and (symbolp reftex-docstruct-symbol)
1271 (symbol-value reftex-docstruct-symbol) 1271 (symbol-value reftex-docstruct-symbol)
1272 t)) 1272 t))
1273 1273
1274(defun reftex-silence-toc-markers (list n) 1274(defun reftex-silence-toc-markers (list n)
1275 ;; Set all toc markers in the first N entries in list to nil 1275 ;; Set all toc markers in the first N entries in list to nil
1276 (while (and list (> (decf n) -1)) 1276 (while (and list (> (decf n) -1))
@@ -1287,7 +1287,7 @@ Valid actions are: readable, restore, read, kill, write."
1287 (master (reftex-TeX-master-file)) 1287 (master (reftex-TeX-master-file))
1288 (enable-local-variables nil) 1288 (enable-local-variables nil)
1289 (file (if (string-match "\\.[a-zA-Z]+\\'" master) 1289 (file (if (string-match "\\.[a-zA-Z]+\\'" master)
1290 (concat (substring master 0 (match-beginning 0)) 1290 (concat (substring master 0 (match-beginning 0))
1291 reftex-parse-file-extension) 1291 reftex-parse-file-extension)
1292 (concat master reftex-parse-file-extension)))) 1292 (concat master reftex-parse-file-extension))))
1293 (cond 1293 (cond
@@ -1366,7 +1366,7 @@ Valid actions are: readable, restore, read, kill, write."
1366 1366
1367 ;; Check if the master is the same: when moving a document, this will see it. 1367 ;; Check if the master is the same: when moving a document, this will see it.
1368 (let* ((real-master (reftex-TeX-master-file)) 1368 (let* ((real-master (reftex-TeX-master-file))
1369 (parsed-master 1369 (parsed-master
1370 (nth 1 (assq 'bof (symbol-value reftex-docstruct-symbol))))) 1370 (nth 1 (assq 'bof (symbol-value reftex-docstruct-symbol)))))
1371 (unless (string= (file-truename real-master) (file-truename parsed-master)) 1371 (unless (string= (file-truename real-master) (file-truename parsed-master))
1372 (message "Master file name in load file is different: %s versus %s" 1372 (message "Master file name in load file is different: %s versus %s"
@@ -1386,7 +1386,7 @@ Valid actions are: readable, restore, read, kill, write."
1386(defun reftex-select-external-document (xr-alist xr-index) 1386(defun reftex-select-external-document (xr-alist xr-index)
1387 ;; Return index of an external document. 1387 ;; Return index of an external document.
1388 (let* ((len (length xr-alist)) (highest (1- (+ ?0 len))) 1388 (let* ((len (length xr-alist)) (highest (1- (+ ?0 len)))
1389 (prompt (format "[%c-%c] Select TAB: Read prefix with completion" 1389 (prompt (format "[%c-%c] Select TAB: Read prefix with completion"
1390 ?0 highest)) 1390 ?0 highest))
1391 key prefix) 1391 key prefix)
1392 (cond 1392 (cond
@@ -1397,7 +1397,7 @@ Valid actions are: readable, restore, read, kill, write."
1397 (- 1 xr-index)) 1397 (- 1 xr-index))
1398 (t 1398 (t
1399 (save-excursion 1399 (save-excursion
1400 (let* ((length (apply 'max (mapcar 1400 (let* ((length (apply 'max (mapcar
1401 (lambda(x) (length (car x))) xr-alist))) 1401 (lambda(x) (length (car x))) xr-alist)))
1402 (fmt (format " [%%c] %%-%ds %%s\n" length)) 1402 (fmt (format " [%%c] %%-%ds %%s\n" length))
1403 (n (1- ?0))) 1403 (n (1- ?0)))
@@ -1407,7 +1407,7 @@ Valid actions are: readable, restore, read, kill, write."
1407 (concat 1407 (concat
1408 "SELECT EXTERNAL DOCUMENT\n------------------------\n" 1408 "SELECT EXTERNAL DOCUMENT\n------------------------\n"
1409 (mapconcat 1409 (mapconcat
1410 (lambda (x) 1410 (lambda (x)
1411 (format fmt (incf n) (or (car x) "") 1411 (format fmt (incf n) (or (car x) "")
1412 (abbreviate-file-name (cdr x)))) 1412 (abbreviate-file-name (cdr x))))
1413 xr-alist "")) 1413 xr-alist ""))
@@ -1431,7 +1431,7 @@ When DIE is non-nil, throw an error if file not found."
1431 (let* ((rec-values (if reftex-search-unrecursed-path-first '(nil t) '(t))) 1431 (let* ((rec-values (if reftex-search-unrecursed-path-first '(nil t) '(t)))
1432 (extensions (cdr (assoc type reftex-file-extensions))) 1432 (extensions (cdr (assoc type reftex-file-extensions)))
1433 (def-ext (car extensions)) 1433 (def-ext (car extensions))
1434 (ext-re (concat "\\(" 1434 (ext-re (concat "\\("
1435 (mapconcat 'regexp-quote extensions "\\|") 1435 (mapconcat 'regexp-quote extensions "\\|")
1436 "\\)\\'")) 1436 "\\)\\'"))
1437 (files (if (string-match ext-re file) 1437 (files (if (string-match ext-re file)
@@ -1440,8 +1440,8 @@ When DIE is non-nil, throw an error if file not found."
1440 path old-path file1) 1440 path old-path file1)
1441 (cond 1441 (cond
1442 ((file-name-absolute-p file) 1442 ((file-name-absolute-p file)
1443 (setq file1 1443 (setq file1
1444 (or 1444 (or
1445 (and (car files) (file-regular-p (car files)) (car files)) 1445 (and (car files) (file-regular-p (car files)) (car files))
1446 (and (cdr files) (file-regular-p (cdr files)) (cdr files))))) 1446 (and (cdr files) (file-regular-p (cdr files)) (cdr files)))))
1447 ((and reftex-use-external-file-finders 1447 ((and reftex-use-external-file-finders
@@ -1456,10 +1456,10 @@ When DIE is non-nil, throw an error if file not found."
1456 (setq old-path path 1456 (setq old-path path
1457 path (cons master-dir path) 1457 path (cons master-dir path)
1458 file1 (or (and (car files) 1458 file1 (or (and (car files)
1459 (reftex-find-file-on-path 1459 (reftex-find-file-on-path
1460 (car files) path master-dir)) 1460 (car files) path master-dir))
1461 (and (cdr files) 1461 (and (cdr files)
1462 (reftex-find-file-on-path 1462 (reftex-find-file-on-path
1463 (cdr files) path master-dir)))))))) 1463 (cdr files) path master-dir))))))))
1464 (cond (file1 file1) 1464 (cond (file1 file1)
1465 (die (error "No such file: %s" file) nil) 1465 (die (error "No such file: %s" file) nil)
@@ -1504,7 +1504,7 @@ When DIE is non-nil, throw an error if file not found."
1504 (reftex-uniquify 1504 (reftex-uniquify
1505 (reftex-parse-colon-path 1505 (reftex-parse-colon-path
1506 (mapconcat 1506 (mapconcat
1507 (lambda(x) 1507 (lambda(x)
1508 (if (string-match "^!" x) 1508 (if (string-match "^!" x)
1509 (apply 'reftex-process-string 1509 (apply 'reftex-process-string
1510 (split-string (substring x 1))) 1510 (split-string (substring x 1)))
@@ -1513,7 +1513,7 @@ When DIE is non-nil, throw an error if file not found."
1513 ;; (cdr (assoc type reftex-path-environment)) 1513 ;; (cdr (assoc type reftex-path-environment))
1514 ;; However, historically we have separate options for the 1514 ;; However, historically we have separate options for the
1515 ;; environment variables, so we have to do this: 1515 ;; environment variables, so we have to do this:
1516 (symbol-value (intern (concat "reftex-" type 1516 (symbol-value (intern (concat "reftex-" type
1517 "path-environment-variables"))) 1517 "path-environment-variables")))
1518 path-separator)))) 1518 path-separator))))
1519 (put pathvar 'status 'split) 1519 (put pathvar 'status 'split)
@@ -1539,11 +1539,11 @@ When DIE is non-nil, throw an error if file not found."
1539 ;; or: Relative recursive path elements need to be expanded 1539 ;; or: Relative recursive path elements need to be expanded
1540 ;; relative to new default directory 1540 ;; relative to new default directory
1541 (message "Expanding search path to find %s file: %s ..." type file) 1541 (message "Expanding search path to find %s file: %s ..." type file)
1542 (put pathvar 'recursive-path 1542 (put pathvar 'recursive-path
1543 (reftex-expand-path (symbol-value pathvar) master-dir)) 1543 (reftex-expand-path (symbol-value pathvar) master-dir))
1544 (put pathvar 'master-dir master-dir) 1544 (put pathvar 'master-dir master-dir)
1545 (get pathvar 'recursive-path)) 1545 (get pathvar 'recursive-path))
1546 (t 1546 (t
1547 ;; Recursive path computed earlier is still OK. 1547 ;; Recursive path computed earlier is still OK.
1548 (get pathvar 'recursive-path))) 1548 (get pathvar 'recursive-path)))
1549 ;; The simple path was requested 1549 ;; The simple path was requested
@@ -1572,7 +1572,7 @@ When DIE is non-nil, throw an error if file not found."
1572 ;; Trailing ! or !! will be converted into `//' (emTeX convention) 1572 ;; Trailing ! or !! will be converted into `//' (emTeX convention)
1573 (mapcar 1573 (mapcar
1574 (lambda (dir) 1574 (lambda (dir)
1575 (if (string-match "\\(//+\\|/*!+\\)\\'" dir) 1575 (if (string-match "\\(//+\\|/*!+\\)\\'" dir)
1576 (setq dir (replace-match "//" t t dir))) 1576 (setq dir (replace-match "//" t t dir)))
1577 (file-name-as-directory dir)) 1577 (file-name-as-directory dir))
1578 (delete "" (split-string path (concat path-separator "+"))))) 1578 (delete "" (split-string path (concat path-separator "+")))))
@@ -1601,7 +1601,7 @@ When DIE is non-nil, throw an error if file not found."
1601 (when (file-directory-p dir) 1601 (when (file-directory-p dir)
1602 (setq files (nreverse (directory-files dir t "[^.]"))) 1602 (setq files (nreverse (directory-files dir t "[^.]")))
1603 (while (setq file (pop files)) 1603 (while (setq file (pop files))
1604 (if (file-directory-p file) 1604 (if (file-directory-p file)
1605 (push (file-name-as-directory file) path))) 1605 (push (file-name-as-directory file) path)))
1606 (push dir path1))) 1606 (push dir path1)))
1607 path1)) 1607 path1))
@@ -1664,7 +1664,7 @@ When DIE is non-nil, throw an error if file not found."
1664 "Show the table of contents for the current document." t) 1664 "Show the table of contents for the current document." t)
1665(autoload 'reftex-toc-recenter "reftex-toc" 1665(autoload 'reftex-toc-recenter "reftex-toc"
1666 "Display the TOC window and highlight line corresponding to current position." t) 1666 "Display the TOC window and highlight line corresponding to current position." t)
1667(autoload 'reftex-toggle-auto-toc-recenter "reftex-toc" 1667(autoload 'reftex-toggle-auto-toc-recenter "reftex-toc"
1668 "Toggle automatic recentering of TOC window." t) 1668 "Toggle automatic recentering of TOC window." t)
1669 1669
1670;;; ========================================================================= 1670;;; =========================================================================
@@ -1883,7 +1883,7 @@ Works on both Emacs and XEmacs."
1883 (while list 1883 (while list
1884 (if (funcall predicate (car list)) 1884 (if (funcall predicate (car list))
1885 (push (if completion 1885 (push (if completion
1886 (list (nth nth (car list))) 1886 (list (nth nth (car list)))
1887 (nth nth (car list))) 1887 (nth nth (car list)))
1888 rtn)) 1888 rtn))
1889 (setq list (cdr list))) 1889 (setq list (cdr list)))
@@ -1919,7 +1919,7 @@ Works on both Emacs and XEmacs."
1919 ;; If POS is given, calculate distances relative to it. 1919 ;; If POS is given, calculate distances relative to it.
1920 ;; Return nil if there is no match. 1920 ;; Return nil if there is no match.
1921 (let ((pos (point)) 1921 (let ((pos (point))
1922 (dist (or max-length (length regexp))) 1922 (dist (or max-length (length regexp)))
1923 match1 match2 match) 1923 match1 match2 match)
1924 (goto-char (min (+ pos dist) (point-max))) 1924 (goto-char (min (+ pos dist) (point-max)))
1925 (when (re-search-backward regexp nil t) 1925 (when (re-search-backward regexp nil t)
@@ -2005,10 +2005,10 @@ Works on both Emacs and XEmacs."
2005 ((and scroll (equal char ?\C-? )) 2005 ((and scroll (equal char ?\C-? ))
2006 (condition-case nil (scroll-down) (error nil)) 2006 (condition-case nil (scroll-down) (error nil))
2007 (message prompt)) 2007 (message prompt))
2008 (t (message "") 2008 (t (message "")
2009 (throw 'exit char))) 2009 (throw 'exit char)))
2010 (setq char (read-char-exclusive))))))) 2010 (setq char (read-char-exclusive)))))))
2011 2011
2012 2012
2013(defun reftex-make-regexp-allow-for-ctrl-m (string) 2013(defun reftex-make-regexp-allow-for-ctrl-m (string)
2014 ;; convert STRING into a regexp, allowing ^M for \n and vice versa 2014 ;; convert STRING into a regexp, allowing ^M for \n and vice versa
@@ -2206,10 +2206,10 @@ IGNORE-WORDS List of words which should be removed from the string."
2206 ;; Restrict number of words 2206 ;; Restrict number of words
2207 (if (> (length words) nwords) 2207 (if (> (length words) nwords)
2208 (setcdr (nthcdr (1- nwords) words) nil)) 2208 (setcdr (nthcdr (1- nwords) words) nil))
2209 2209
2210 ;; First, try to use all words 2210 ;; First, try to use all words
2211 (setq string (mapconcat 'identity words sep)) 2211 (setq string (mapconcat 'identity words sep))
2212 2212
2213 ;; Abbreviate words if enforced by user settings or string length 2213 ;; Abbreviate words if enforced by user settings or string length
2214 (if (or (eq t abbrev) 2214 (if (or (eq t abbrev)
2215 (and abbrev 2215 (and abbrev
@@ -2301,7 +2301,7 @@ IGNORE-WORDS List of words which should be removed from the string."
2301 (font-lock-set-defaults-1) 2301 (font-lock-set-defaults-1)
2302 (reftex-select-font-lock-fontify-region (point-min) (point-max)))) 2302 (reftex-select-font-lock-fontify-region (point-min) (point-max))))
2303 (t 2303 (t
2304 ;; Oops? 2304 ;; Oops?
2305 (message "Sorry: cannot refontify RefTeX Select buffer.")))) 2305 (message "Sorry: cannot refontify RefTeX Select buffer."))))
2306 (rename-buffer oldname)))) 2306 (rename-buffer oldname))))
2307 2307
@@ -2350,7 +2350,7 @@ IGNORE-WORDS List of words which should be removed from the string."
2350 2350
2351;; Initialize the overlays 2351;; Initialize the overlays
2352(aset reftex-highlight-overlays 0 (reftex-make-overlay 1 1)) 2352(aset reftex-highlight-overlays 0 (reftex-make-overlay 1 1))
2353(reftex-overlay-put (aref reftex-highlight-overlays 0) 2353(reftex-overlay-put (aref reftex-highlight-overlays 0)
2354 'face 'highlight) 2354 'face 'highlight)
2355(aset reftex-highlight-overlays 1 (reftex-make-overlay 1 1)) 2355(aset reftex-highlight-overlays 1 (reftex-make-overlay 1 1))
2356(reftex-overlay-put (aref reftex-highlight-overlays 1) 2356(reftex-overlay-put (aref reftex-highlight-overlays 1)
@@ -2375,7 +2375,7 @@ IGNORE-WORDS List of words which should be removed from the string."
2375 2375
2376;;; ========================================================================= 2376;;; =========================================================================
2377;;; 2377;;;
2378;;; Keybindings 2378;;; Keybindings
2379 2379
2380;; The default bindings in the mode map. 2380;; The default bindings in the mode map.
2381(loop for x in 2381(loop for x in
@@ -2395,10 +2395,10 @@ IGNORE-WORDS List of words which should be removed from the string."
2395;; Bind `reftex-mouse-view-crossref' only when the key is still free 2395;; Bind `reftex-mouse-view-crossref' only when the key is still free
2396(if (featurep 'xemacs) 2396(if (featurep 'xemacs)
2397 (unless (key-binding [(shift button2)]) 2397 (unless (key-binding [(shift button2)])
2398 (define-key reftex-mode-map [(shift button2)] 2398 (define-key reftex-mode-map [(shift button2)]
2399 'reftex-mouse-view-crossref)) 2399 'reftex-mouse-view-crossref))
2400 (unless (key-binding [(shift mouse-2)]) 2400 (unless (key-binding [(shift mouse-2)])
2401 (define-key reftex-mode-map [(shift mouse-2)] 2401 (define-key reftex-mode-map [(shift mouse-2)]
2402 'reftex-mouse-view-crossref))) 2402 'reftex-mouse-view-crossref)))
2403 2403
2404;; Bind `reftex-view-crossref-from-bibtex' in BibTeX mode map 2404;; Bind `reftex-view-crossref-from-bibtex' in BibTeX mode map
@@ -2502,7 +2502,7 @@ IGNORE-WORDS List of words which should be removed from the string."
2502 ("Reference Style" 2502 ("Reference Style"
2503 ["Default" (setq reftex-vref-is-default nil 2503 ["Default" (setq reftex-vref-is-default nil
2504 reftex-fref-is-default nil) 2504 reftex-fref-is-default nil)
2505 :style radio :selected (not (or reftex-vref-is-default 2505 :style radio :selected (not (or reftex-vref-is-default
2506 reftex-fref-is-default))] 2506 reftex-fref-is-default))]
2507 ["Varioref" (setq reftex-vref-is-default t 2507 ["Varioref" (setq reftex-vref-is-default t
2508 reftex-fref-is-default nil) 2508 reftex-fref-is-default nil)
@@ -2537,7 +2537,7 @@ IGNORE-WORDS List of words which should be removed from the string."
2537 (list 'reftex-add-index-macros (list 'list (list 'quote (car x)))) 2537 (list 'reftex-add-index-macros (list 'list (list 'quote (car x))))
2538 :style 'radio :selected 2538 :style 'radio :selected
2539 (list 'memq (list 'quote (car x)) 2539 (list 'memq (list 'quote (car x))
2540 (list 'get 'reftex-docstruct-symbol 2540 (list 'get 'reftex-docstruct-symbol
2541 (list 'quote 'reftex-index-macros-style))))) 2541 (list 'quote 'reftex-index-macros-style)))))
2542 reftex-index-macros-builtin)) 2542 reftex-index-macros-builtin))
2543 "--" 2543 "--"
@@ -2546,7 +2546,7 @@ IGNORE-WORDS List of words which should be removed from the string."
2546 ("Customize" 2546 ("Customize"
2547 ["Browse RefTeX Group" reftex-customize t] 2547 ["Browse RefTeX Group" reftex-customize t]
2548 "--" 2548 "--"
2549 ["Build Full Customize Menu" reftex-create-customize-menu 2549 ["Build Full Customize Menu" reftex-create-customize-menu
2550 (fboundp 'customize-menu-create)]) 2550 (fboundp 'customize-menu-create)])
2551 ("Documentation" 2551 ("Documentation"
2552 ["Info" reftex-info t] 2552 ["Info" reftex-info t]
@@ -2562,7 +2562,7 @@ IGNORE-WORDS List of words which should be removed from the string."
2562 (interactive) 2562 (interactive)
2563 (if (fboundp 'customize-menu-create) 2563 (if (fboundp 'customize-menu-create)
2564 (progn 2564 (progn
2565 (easy-menu-change 2565 (easy-menu-change
2566 '("Ref") "Customize" 2566 '("Ref") "Customize"
2567 `(["Browse RefTeX group" reftex-customize t] 2567 `(["Browse RefTeX group" reftex-customize t]
2568 "--" 2568 "--"
@@ -2600,7 +2600,7 @@ With optional NODE, go directly to that node."
2600;;; That's it! ---------------------------------------------------------------- 2600;;; That's it! ----------------------------------------------------------------
2601 2601
2602(setq reftex-tables-dirty t) ; in case this file is evaluated by hand 2602(setq reftex-tables-dirty t) ; in case this file is evaluated by hand
2603(provide 'reftex) 2603(provide 'reftex)
2604 2604
2605;;;============================================================================ 2605;;;============================================================================
2606 2606
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index cdc2916e799..7e1167a9396 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -248,11 +248,13 @@ separated by a space."
248 "Regular expression that matches a non-empty start tag. 248 "Regular expression that matches a non-empty start tag.
249Any terminating `>' or `/' is not matched.") 249Any terminating `>' or `/' is not matched.")
250 250
251(defface sgml-namespace-face 251(defface sgml-namespace
252 '((t (:inherit font-lock-builtin-face))) 252 '((t (:inherit font-lock-builtin-face)))
253 "`sgml-mode' face used to highlight the namespace part of identifiers." 253 "`sgml-mode' face used to highlight the namespace part of identifiers."
254 :group 'sgml) 254 :group 'sgml)
255(defvar sgml-namespace-face 'sgml-namespace-face) 255;; backward-compatibility alias
256(put 'sgml-namespace-face 'face-alias 'sgml-namespace)
257(defvar sgml-namespace-face 'sgml-namespace)
256 258
257;; internal 259;; internal
258(defconst sgml-font-lock-keywords-1 260(defconst sgml-font-lock-keywords-1
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index 430a196166f..af13c2fe61c 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -682,7 +682,7 @@ height."
682 :tag "Table Command Prefix" 682 :tag "Table Command Prefix"
683 :group 'table) 683 :group 'table)
684 684
685(defface table-cell-face 685(defface table-cell
686 '((((min-colors 88) (class color)) 686 '((((min-colors 88) (class color))
687 (:foreground "gray90" :background "blue1")) 687 (:foreground "gray90" :background "blue1"))
688 (((class color)) 688 (((class color))
@@ -691,6 +691,8 @@ height."
691 "*Face used for table cell contents." 691 "*Face used for table cell contents."
692 :tag "Cell Face" 692 :tag "Cell Face"
693 :group 'table) 693 :group 'table)
694;; backward-compatibility alias
695(put 'table-cell-face 'face-alias 'table-cell)
694 696
695(defcustom table-cell-horizontal-chars "-=" 697(defcustom table-cell-horizontal-chars "-="
696 "*Characters that may be used for table cell's horizontal border line." 698 "*Characters that may be used for table cell's horizontal border line."
@@ -5264,7 +5266,7 @@ and the right cell border character."
5264 5266
5265(defun table--put-cell-face-property (beg end &optional object) 5267(defun table--put-cell-face-property (beg end &optional object)
5266 "Put cell face property." 5268 "Put cell face property."
5267 (put-text-property beg end 'face 'table-cell-face object)) 5269 (put-text-property beg end 'face 'table-cell object))
5268 5270
5269(defun table--put-cell-keymap-property (beg end &optional object) 5271(defun table--put-cell-keymap-property (beg end &optional object)
5270 "Put cell keymap property." 5272 "Put cell keymap property."
@@ -5303,8 +5305,8 @@ instead of the current buffer and returns the OBJECT."
5303(defun table--update-cell-face () 5305(defun table--update-cell-face ()
5304 "Update cell face according to the current mode." 5306 "Update cell face according to the current mode."
5305 (if (featurep 'xemacs) 5307 (if (featurep 'xemacs)
5306 (set-face-property 'table-cell-face 'underline table-fixed-width-mode) 5308 (set-face-property 'table-cell 'underline table-fixed-width-mode)
5307 (set-face-inverse-video-p 'table-cell-face table-fixed-width-mode))) 5309 (set-face-inverse-video-p 'table-cell table-fixed-width-mode)))
5308 5310
5309(table--update-cell-face) 5311(table--update-cell-face)
5310 5312
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index 66dc7b83507..7d04464346a 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -650,17 +650,22 @@ An alternative value is \" . \", if you use a font with a narrow period."
650 "Face used for subscripts." 650 "Face used for subscripts."
651 :group 'tex) 651 :group 'tex)
652 652
653(defface tex-math-face 653(defface tex-math
654 '((t :inherit font-lock-string-face)) 654 '((t :inherit font-lock-string-face))
655 "Face used to highlight TeX math expressions." 655 "Face used to highlight TeX math expressions."
656 :group 'tex) 656 :group 'tex)
657(defvar tex-math-face 'tex-math-face) 657;; backward-compatibility alias
658(defface tex-verbatim-face 658(put 'tex-math-face 'face-alias 'tex-math)
659(defvar tex-math-face 'tex-math)
660
661(defface tex-verbatim
659 ;; '((t :inherit font-lock-string-face)) 662 ;; '((t :inherit font-lock-string-face))
660 '((t :family "courier")) 663 '((t :family "courier"))
661 "Face used to highlight TeX verbatim environments." 664 "Face used to highlight TeX verbatim environments."
662 :group 'tex) 665 :group 'tex)
663(defvar tex-verbatim-face 'tex-verbatim-face) 666;; backward-compatibility alias
667(put 'tex-verbatim-face 'face-alias 'tex-verbatim)
668(defvar tex-verbatim-face 'tex-verbatim)
664 669
665;; Use string syntax but math face for $...$. 670;; Use string syntax but math face for $...$.
666(defun tex-font-lock-syntactic-face-function (state) 671(defun tex-font-lock-syntactic-face-function (state)
@@ -795,7 +800,7 @@ Inherits `shell-mode-map' with a few additions.")
795 (regexp-opt '("documentstyle" "documentclass" 800 (regexp-opt '("documentstyle" "documentclass"
796 "begin" "subsection" "section" 801 "begin" "subsection" "section"
797 "part" "chapter" "newcommand" 802 "part" "chapter" "newcommand"
798 "renewcommand") 'words) 803 "renewcommand" "RequirePackage") 'words)
799 "\\|NeedsTeXFormat{LaTeX"))) 804 "\\|NeedsTeXFormat{LaTeX")))
800 (if (and (looking-at 805 (if (and (looking-at
801 "document\\(style\\|class\\)\\(\\[.*\\]\\)?{slides}") 806 "document\\(style\\|class\\)\\(\\[.*\\]\\)?{slides}")
@@ -1101,7 +1106,7 @@ Inserts the value of `tex-open-quote' (normally ``) or `tex-close-quote'
1101inserts \" characters." 1106inserts \" characters."
1102 (interactive "*P") 1107 (interactive "*P")
1103 (if (or arg (memq (char-syntax (preceding-char)) '(?/ ?\\)) 1108 (if (or arg (memq (char-syntax (preceding-char)) '(?/ ?\\))
1104 (eq (get-text-property (point) 'face) 'tex-verbatim-face) 1109 (eq (get-text-property (point) 'face) tex-verbatim-face)
1105 (save-excursion 1110 (save-excursion
1106 (backward-char (length tex-open-quote)) 1111 (backward-char (length tex-open-quote))
1107 (when (or (looking-at (regexp-quote tex-open-quote)) 1112 (when (or (looking-at (regexp-quote tex-open-quote))
@@ -1639,9 +1644,12 @@ If NOT-ALL is non-nil, save the `.dvi' file."
1639 " " (if (< 0 (length tex-start-commands)) 1644 " " (if (< 0 (length tex-start-commands))
1640 (shell-quote-argument tex-start-commands)) " %f") 1645 (shell-quote-argument tex-start-commands)) " %f")
1641 t "%r.dvi") 1646 t "%r.dvi")
1642 ("yap %r &" "%r.dvi")
1643 ("xdvi %r &" "%r.dvi") 1647 ("xdvi %r &" "%r.dvi")
1648 ("xpdf %r.pdf &" "%r.pdf")
1649 ("gv %r.ps &" "%r.ps")
1650 ("yap %r &" "%r.dvi")
1644 ("advi %r &" "%r.dvi") 1651 ("advi %r &" "%r.dvi")
1652 ("gv %r.pdf &" "%r.pdf")
1645 ("bibtex %r" "%r.aux" "%r.bbl") 1653 ("bibtex %r" "%r.aux" "%r.bbl")
1646 ("makeindex %r" "%r.idx" "%r.ind") 1654 ("makeindex %r" "%r.idx" "%r.ind")
1647 ("texindex %r.??") 1655 ("texindex %r.??")
@@ -1649,9 +1657,6 @@ If NOT-ALL is non-nil, save the `.dvi' file."
1649 ("dvipdf %r" "%r.dvi" "%r.pdf") 1657 ("dvipdf %r" "%r.dvi" "%r.pdf")
1650 ("dvips -o %r.ps %r" "%r.dvi" "%r.ps") 1658 ("dvips -o %r.ps %r" "%r.dvi" "%r.ps")
1651 ("ps2pdf %r.ps" "%r.ps" "%r.pdf") 1659 ("ps2pdf %r.ps" "%r.ps" "%r.pdf")
1652 ("gv %r.ps &" "%r.ps")
1653 ("gv %r.pdf &" "%r.pdf")
1654 ("xpdf %r.pdf &" "%r.pdf")
1655 ("lpr %r.ps" "%r.ps")) 1660 ("lpr %r.ps" "%r.ps"))
1656 "List of commands for `tex-compile'. 1661 "List of commands for `tex-compile'.
1657Each element should be of the form (FORMAT IN OUT) where 1662Each element should be of the form (FORMAT IN OUT) where
@@ -1830,8 +1835,7 @@ FILE is typically the output DVI or PDF file."
1830 (push cmd cmds) 1835 (push cmd cmds)
1831 (push (nth 1 cmd) unchanged-in)))) 1836 (push (nth 1 cmd) unchanged-in))))
1832 ;; If no command seems to be applicable, arbitrarily pick the first one. 1837 ;; If no command seems to be applicable, arbitrarily pick the first one.
1833 (unless cmds 1838 (setq cmds (if cmds (nreverse cmds) (list (car tex-compile-commands))))
1834 (setq cmds (list (car tex-compile-commands))))
1835 ;; Remove those commands whose input was considered stable for 1839 ;; Remove those commands whose input was considered stable for
1836 ;; some other command (typically if (t . "%.pdf") is inactive 1840 ;; some other command (typically if (t . "%.pdf") is inactive
1837 ;; then we're using pdflatex and the fact that the dvi file 1841 ;; then we're using pdflatex and the fact that the dvi file
@@ -1841,7 +1845,7 @@ FILE is typically the output DVI or PDF file."
1841 (unless (member (nth 1 cmd) unchanged-in) 1845 (unless (member (nth 1 cmd) unchanged-in)
1842 (push cmd tmp))) 1846 (push cmd tmp)))
1843 ;; Only remove if there's something left. 1847 ;; Only remove if there's something left.
1844 (if tmp (setq cmds tmp))) 1848 (if tmp (setq cmds (nreverse tmp))))
1845 ;; Remove commands whose input is not uptodate either. 1849 ;; Remove commands whose input is not uptodate either.
1846 (let ((outs (delq nil (mapcar (lambda (x) (nth 2 x)) cmds))) 1850 (let ((outs (delq nil (mapcar (lambda (x) (nth 2 x)) cmds)))
1847 (tmp nil)) 1851 (tmp nil))
@@ -1849,7 +1853,7 @@ FILE is typically the output DVI or PDF file."
1849 (unless (member (nth 1 cmd) outs) 1853 (unless (member (nth 1 cmd) outs)
1850 (push cmd tmp))) 1854 (push cmd tmp)))
1851 ;; Only remove if there's something left. 1855 ;; Only remove if there's something left.
1852 (if tmp (setq cmds tmp))) 1856 (if tmp (setq cmds (nreverse tmp))))
1853 ;; Select which file we're going to operate on (the latest). 1857 ;; Select which file we're going to operate on (the latest).
1854 (let ((latest (nth 1 (car cmds)))) 1858 (let ((latest (nth 1 (car cmds))))
1855 (dolist (cmd (prog1 (cdr cmds) (setq cmds (list (car cmds))))) 1859 (dolist (cmd (prog1 (cdr cmds) (setq cmds (list (car cmds)))))
diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el
index bd14c658379..2be01d630f9 100644
--- a/lisp/textmodes/texinfo.el
+++ b/lisp/textmodes/texinfo.el
@@ -1,7 +1,7 @@
1;;; texinfo.el --- major mode for editing Texinfo files 1;;; texinfo.el --- major mode for editing Texinfo files
2 2
3;; Copyright (C) 1985, 1988, 1989, 1990, 1991, 1992, 1993, 1996, 1997, 3;; Copyright (C) 1985, 1988, 1989, 1990, 1991, 1992, 1993, 1996, 1997,
4;; 2000, 2001, 2003, 2004 Free Software Foundation, Inc. 4;; 2000, 2001, 2003, 2004, 2005 Free Software Foundation, Inc.
5 5
6;; Author: Robert J. Chassell 6;; Author: Robert J. Chassell
7;; Date: [See date below for texinfo-version] 7;; Date: [See date below for texinfo-version]
@@ -343,11 +343,13 @@ chapter."
343 "Regexp for environment-like Texinfo list commands. 343 "Regexp for environment-like Texinfo list commands.
344Subexpression 1 is what goes into the corresponding `@end' statement.") 344Subexpression 1 is what goes into the corresponding `@end' statement.")
345 345
346(defface texinfo-heading-face 346(defface texinfo-heading
347 '((t (:inherit font-lock-function-name-face))) 347 '((t (:inherit font-lock-function-name-face)))
348 "Face used for section headings in `texinfo-mode'." 348 "Face used for section headings in `texinfo-mode'."
349 :group 'texinfo) 349 :group 'texinfo)
350(defvar texinfo-heading-face 'texinfo-heading-face) 350;; backward-compatibility alias
351(put 'texinfo-heading-face 'face-alias 'texinfo-heading)
352(defvar texinfo-heading-face 'texinfo-heading)
351 353
352(defvar texinfo-font-lock-keywords 354(defvar texinfo-font-lock-keywords
353 `(;; All but the first had an OVERRIDE of t. 355 `(;; All but the first had an OVERRIDE of t.
diff --git a/lisp/thumbs.el b/lisp/thumbs.el
index 321fe7266cc..09fe77cf352 100644
--- a/lisp/thumbs.el
+++ b/lisp/thumbs.el
@@ -65,8 +65,7 @@
65 :version "22.1" 65 :version "22.1"
66 :group 'multimedia) 66 :group 'multimedia)
67 67
68(defcustom thumbs-thumbsdir 68(defcustom thumbs-thumbsdir "~/.emacs-thumbs"
69 (expand-file-name "~/.emacs-thumbs")
70 "*Directory to store thumbnails." 69 "*Directory to store thumbnails."
71 :type 'directory 70 :type 'directory
72 :group 'thumbs) 71 :group 'thumbs)
@@ -78,17 +77,17 @@
78 77
79(defcustom thumbs-per-line 5 78(defcustom thumbs-per-line 5
80 "*Number of thumbnails per line to show in directory." 79 "*Number of thumbnails per line to show in directory."
81 :type 'string 80 :type 'integer
82 :group 'thumbs) 81 :group 'thumbs)
83 82
84(defcustom thumbs-thumbsdir-max-size 50000000 83(defcustom thumbs-thumbsdir-max-size 50000000
85 "Max size for thumbnails directory. 84 "Max size for thumbnails directory.
86When it reachs that size (in bytes), a warning is sent." 85When it reaches that size (in bytes), a warning is sent."
87 :type 'string 86 :type 'integer
88 :group 'thumbs) 87 :group 'thumbs)
89 88
90(defcustom thumbs-conversion-program 89(defcustom thumbs-conversion-program
91 (if (equal 'windows-nt system-type) 90 (if (eq system-type 'windows-nt)
92 "convert.exe" 91 "convert.exe"
93 (or (executable-find "convert") 92 (or (executable-find "convert")
94 "/usr/X11R6/bin/convert")) 93 "/usr/X11R6/bin/convert"))
@@ -105,32 +104,31 @@ It must be 'convert'."
105 104
106(defcustom thumbs-relief 5 105(defcustom thumbs-relief 5
107 "*Size of button-like border around thumbnails." 106 "*Size of button-like border around thumbnails."
108 :type 'string 107 :type 'integer
109 :group 'thumbs) 108 :group 'thumbs)
110 109
111(defcustom thumbs-margin 2 110(defcustom thumbs-margin 2
112 "*Size of the margin around thumbnails. 111 "*Size of the margin around thumbnails.
113This is where you see the cursor." 112This is where you see the cursor."
114 :type 'string 113 :type 'integer
115 :group 'thumbs) 114 :group 'thumbs)
116 115
117(defcustom thumbs-thumbsdir-auto-clean t 116(defcustom thumbs-thumbsdir-auto-clean t
118 "If set, delete older file in the thumbnails directory. 117 "If set, delete older file in the thumbnails directory.
119Deletion is done at load time when the directory size is bigger 118Deletion is done at load time when the directory size is bigger
120than 'thumbs-thumbsdir-max-size'." 119than `thumbs-thumbsdir-max-size'."
121 :type 'boolean 120 :type 'boolean
122 :group 'thumbs) 121 :group 'thumbs)
123 122
124(defcustom thumbs-image-resizing-step 10 123(defcustom thumbs-image-resizing-step 10
125 "Step by wich to resize image." 124 "Step by which to resize image."
126 :type 'string 125 :type 'integer
127 :group 'thumbs) 126 :group 'thumbs)
128 127
129(defcustom thumbs-temp-dir 128(defcustom thumbs-temp-dir temporary-file-directory
130 "/tmp/"
131 "Temporary directory to use. 129 "Temporary directory to use.
132Leaving it to default '/tmp/' can let another user 130Defaults to `temporary-file-directory'. Leaving it to
133see some of your images." 131this value can let another user see some of your images."
134 :type 'directory 132 :type 'directory
135 :group 'thumbs) 133 :group 'thumbs)
136 134
@@ -140,10 +138,6 @@ see some of your images."
140 :group 'thumbs) 138 :group 'thumbs)
141 139
142;; Initialize some variable, for later use. 140;; Initialize some variable, for later use.
143(defvar thumbs-temp-file
144 (concat thumbs-temp-dir thumbs-temp-prefix)
145 "Temporary filename for images.")
146
147(defvar thumbs-current-tmp-filename 141(defvar thumbs-current-tmp-filename
148 nil 142 nil
149 "Temporary filename of current image.") 143 "Temporary filename of current image.")
@@ -163,28 +157,40 @@ see some of your images."
163 nil 157 nil
164 "List of marked files.") 158 "List of marked files.")
165 159
166;; Make sure auto-image-file-mode is ON. 160(defalias 'thumbs-gensym
167(auto-image-file-mode t) 161 (if (fboundp 'gensym)
168 162 'gensym
169;; Create the thumbs directory if it does not exists. 163 ;; Copied from cl-macs.el
170(setq thumbs-thumbsdir (expand-file-name thumbs-thumbsdir)) 164 (defvar thumbs-gensym-counter 0)
171 165 (lambda (&optional prefix)
172(when (not (file-directory-p thumbs-thumbsdir)) 166 "Generate a new uninterned symbol.
173 (progn 167The name is made by appending a number to PREFIX, default \"G\"."
174 (make-directory thumbs-thumbsdir) 168 (let ((pfix (if (stringp prefix) prefix "G"))
175 (message "Creating thumbnails directory"))) 169 (num (if (integerp prefix) prefix
176 170 (prog1 thumbs-gensym-counter
177(defvar thumbs-gensym-counter 0) 171 (setq thumbs-gensym-counter
178 172 (1+ thumbs-gensym-counter))))))
179(defun thumbs-gensym (&optional arg) 173 (make-symbol (format "%s%d" pfix num))))))
180 "Generate a new uninterned symbol. 174
181The name is made by appending a number to PREFIX, default \"Thumbs\"." 175(defsubst thumbs-temp-dir ()
182 (let ((prefix (if (stringp arg) arg "Thumbs")) 176 (file-name-as-directory (expand-file-name thumbs-temp-dir)))
183 (num (if (integerp arg) arg 177
184 (prog1 178(defun thumbs-temp-file ()
185 thumbs-gensym-counter 179 "Return a unique temporary filename for an image."
186 (setq thumbs-gensym-counter (1+ thumbs-gensym-counter)))))) 180 (format "%s%s-%s.jpg"
187 (make-symbol (format "%s%d" prefix num)))) 181 (thumbs-temp-dir)
182 thumbs-temp-prefix
183 (thumbs-gensym "T")))
184
185(defun thumbs-thumbsdir ()
186 "Return the current thumbnails directory (from `thumbs-thumbsdir').
187Create the thumbnails directory if it does not exist."
188 (let ((thumbs-thumbsdir (file-name-as-directory
189 (expand-file-name thumbs-thumbsdir))))
190 (unless (file-directory-p thumbs-thumbsdir)
191 (make-directory thumbs-thumbsdir)
192 (message "Creating thumbnails directory"))
193 thumbs-thumbsdir))
188 194
189(defun thumbs-cleanup-thumbsdir () 195(defun thumbs-cleanup-thumbsdir ()
190 "Clean the thumbnails directory. 196 "Clean the thumbnails directory.
@@ -197,8 +203,8 @@ reached."
197 (lambda (f) 203 (lambda (f)
198 (let ((fattribsL (file-attributes f))) 204 (let ((fattribsL (file-attributes f)))
199 `(,(nth 4 fattribsL) ,(nth 7 fattribsL) ,f))) 205 `(,(nth 4 fattribsL) ,(nth 7 fattribsL) ,f)))
200 (directory-files thumbs-thumbsdir t (image-file-name-regexp))) 206 (directory-files (thumbs-thumbsdir) t (image-file-name-regexp)))
201 '(lambda (l1 l2) (time-less-p (car l1)(car l2))))) 207 '(lambda (l1 l2) (time-less-p (car l1) (car l2)))))
202 (dirsize (apply '+ (mapcar (lambda (x) (cadr x)) filesL)))) 208 (dirsize (apply '+ (mapcar (lambda (x) (cadr x)) filesL))))
203 (while (> dirsize thumbs-thumbsdir-max-size) 209 (while (> dirsize thumbs-thumbsdir-max-size)
204 (progn 210 (progn
@@ -258,14 +264,14 @@ ACTION-PREFIX is the symbol to place before the ACTION command
258 264
259(defun thumbs-resize-image (&optional increment size) 265(defun thumbs-resize-image (&optional increment size)
260 "Resize image in current buffer. 266 "Resize image in current buffer.
261if INCREMENT is set, make the image bigger, else smaller. 267If INCREMENT is set, make the image bigger, else smaller.
262Or, alternatively, a SIZE may be specified." 268Or, alternatively, a SIZE may be specified."
263 (interactive) 269 (interactive)
264 ;; cleaning of old temp file 270 ;; cleaning of old temp file
265 (condition-case nil 271 (condition-case nil
266 (apply 'delete-file 272 (apply 'delete-file
267 (directory-files 273 (directory-files
268 thumbs-temp-dir t 274 (thumbs-temp-dir) t
269 thumbs-temp-prefix)) 275 thumbs-temp-prefix))
270 (error nil)) 276 (error nil))
271 (let ((buffer-read-only nil) 277 (let ((buffer-read-only nil)
@@ -276,7 +282,7 @@ Or, alternatively, a SIZE may be specified."
276 thumbs-current-image-size) 282 thumbs-current-image-size)
277 (thumbs-decrement-image-size 283 (thumbs-decrement-image-size
278 thumbs-current-image-size)))) 284 thumbs-current-image-size))))
279 (tmp (format "%s%s.jpg" thumbs-temp-file (thumbs-gensym)))) 285 (tmp (thumbs-temp-file)))
280 (erase-buffer) 286 (erase-buffer)
281 (thumbs-call-convert thumbs-current-image-filename 287 (thumbs-call-convert thumbs-current-image-filename
282 tmp "sample" 288 tmp "sample"
@@ -286,7 +292,7 @@ Or, alternatively, a SIZE may be specified."
286 (setq thumbs-current-tmp-filename tmp))) 292 (setq thumbs-current-tmp-filename tmp)))
287 293
288(defun thumbs-resize-interactive (width height) 294(defun thumbs-resize-interactive (width height)
289 "Resize Image interactively to specified WIDTH and HEIGHT." 295 "Resize image interactively to specified WIDTH and HEIGHT."
290 (interactive "nWidth: \nnHeight: ") 296 (interactive "nWidth: \nnHeight: ")
291 (thumbs-resize-image nil (cons width height))) 297 (thumbs-resize-image nil (cons width height)))
292 298
@@ -304,8 +310,8 @@ Or, alternatively, a SIZE may be specified."
304 "Return a thumbnail name for the image IMG." 310 "Return a thumbnail name for the image IMG."
305 (convert-standard-filename 311 (convert-standard-filename
306 (let ((filename (expand-file-name img))) 312 (let ((filename (expand-file-name img)))
307 (format "%s/%08x-%s.jpg" 313 (format "%s%08x-%s.jpg"
308 thumbs-thumbsdir 314 (thumbs-thumbsdir)
309 (sxhash filename) 315 (sxhash filename)
310 (subst-char-in-string 316 (subst-char-in-string
311 ?\s ?\_ 317 ?\s ?\_
@@ -562,11 +568,7 @@ Open another window."
562(defun thumbs-kill-buffer () 568(defun thumbs-kill-buffer ()
563 "Kill the current buffer." 569 "Kill the current buffer."
564 (interactive) 570 (interactive)
565 (let ((buffer (current-buffer))) 571 (quit-window t (selected-window)))
566 (condition-case nil
567 (delete-window (selected-window))
568 (error nil))
569 (kill-buffer buffer)))
570 572
571(defun thumbs-show-image-num (num) 573(defun thumbs-show-image-num (num)
572 "Show the image with number NUM." 574 "Show the image with number NUM."
@@ -639,11 +641,11 @@ ACTION and ARG should be a valid convert command."
639 ;; cleaning of old temp file 641 ;; cleaning of old temp file
640 (mapc 'delete-file 642 (mapc 'delete-file
641 (directory-files 643 (directory-files
642 thumbs-temp-dir 644 (thumbs-temp-dir)
643 t 645 t
644 thumbs-temp-prefix)) 646 thumbs-temp-prefix))
645 (let ((buffer-read-only nil) 647 (let ((buffer-read-only nil)
646 (tmp (format "%s%s.jpg" thumbs-temp-file (thumbs-gensym)))) 648 (tmp (thumbs-temp-file)))
647 (erase-buffer) 649 (erase-buffer)
648 (thumbs-call-convert thumbs-current-image-filename 650 (thumbs-call-convert thumbs-current-image-filename
649 tmp 651 tmp
diff --git a/lisp/time.el b/lisp/time.el
index 180d7c44cf3..f6ddced4d38 100644
--- a/lisp/time.el
+++ b/lisp/time.el
@@ -127,8 +127,8 @@ This runs the normal hook `display-time-hook' after each update."
127(defcustom display-time-mail-face nil 127(defcustom display-time-mail-face nil
128 "Face to use for `display-time-mail-string'. 128 "Face to use for `display-time-mail-string'.
129If `display-time-use-mail-icon' is non-nil, the image's 129If `display-time-use-mail-icon' is non-nil, the image's
130background colour is the background of this face. Set this to 130background color is the background of this face. Set this to
131make the mail indicator stand out on a colour display." 131make the mail indicator stand out on a color display."
132 :group 'faces 132 :group 'faces
133 :group 'display-time 133 :group 'display-time
134 :version "22.1" 134 :version "22.1"
diff --git a/lisp/tmm.el b/lisp/tmm.el
index 168dbdd14dc..aa47012c642 100644
--- a/lisp/tmm.el
+++ b/lisp/tmm.el
@@ -133,6 +133,11 @@ specify nil for this variable."
133 :type '(choice integer (const nil)) 133 :type '(choice integer (const nil))
134 :group 'tmm) 134 :group 'tmm)
135 135
136(defface tmm-inactive
137 '((t :inherit shadow))
138 "Face used for inactive menu items."
139 :group 'tmm)
140
136;;;###autoload 141;;;###autoload
137(defun tmm-prompt (menu &optional in-popup default-item) 142(defun tmm-prompt (menu &optional in-popup default-item)
138 "Text-mode emulation of calling the bindings in keymap. 143 "Text-mode emulation of calling the bindings in keymap.
@@ -193,7 +198,14 @@ Its value should be an event that has a binding in MENU."
193 (eq (car-safe (cdr (car tail))) 'menu-item))) 198 (eq (car-safe (cdr (car tail))) 'menu-item)))
194 (setq index-of-default (1+ index-of-default))) 199 (setq index-of-default (1+ index-of-default)))
195 (setq tail (cdr tail))))) 200 (setq tail (cdr tail)))))
196 (setq history (reverse (mapcar 'car tmm-km-list))) 201 (let ((prompt (concat "^." (regexp-quote tmm-mid-prompt))))
202 (setq history
203 (reverse (delq nil
204 (mapcar
205 (lambda (elt)
206 (if (string-match prompt (car elt))
207 (car elt)))
208 tmm-km-list)))))
197 (setq history-len (length history)) 209 (setq history-len (length history))
198 (setq history (append history history history history)) 210 (setq history (append history history history history))
199 (setq tmm-c-prompt (nth (- history-len 1 index-of-default) history)) 211 (setq tmm-c-prompt (nth (- history-len 1 index-of-default) history))
@@ -259,37 +271,43 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
259 271
260(defsubst tmm-add-one-shortcut (elt) 272(defsubst tmm-add-one-shortcut (elt)
261;; uses the free vars tmm-next-shortcut-digit and tmm-short-cuts 273;; uses the free vars tmm-next-shortcut-digit and tmm-short-cuts
262 (let* ((str (car elt)) 274 (cond
263 (paren (string-match "(" str)) 275 ((eq (cddr elt) 'ignore)
264 (pos 0) (word 0) char) 276 (cons (concat " " (make-string (length tmm-mid-prompt) ?\-)
265 (catch 'done ; ??? is this slow? 277 (car elt))
266 (while (and (or (not tmm-shortcut-words) ; no limit on words 278 (cdr elt)))
267 (< word tmm-shortcut-words)) ; try n words 279 (t
268 (setq pos (string-match "\\w+" str pos)) ; get next word 280 (let* ((str (car elt))
269 (not (and paren (> pos paren)))) ; don't go past "(binding.." 281 (paren (string-match "(" str))
270 (if (or (= pos 0) 282 (pos 0) (word 0) char)
271 (/= (aref str (1- pos)) ?.)) ; avoid file extensions 283 (catch 'done ; ??? is this slow?
272 (let ((shortcut-style 284 (while (and (or (not tmm-shortcut-words) ; no limit on words
273 (if (listp tmm-shortcut-style) ; convert to list 285 (< word tmm-shortcut-words)) ; try n words
274 tmm-shortcut-style 286 (setq pos (string-match "\\w+" str pos)) ; get next word
275 (list tmm-shortcut-style)))) 287 (not (and paren (> pos paren)))) ; don't go past "(binding.."
276 (while shortcut-style ; try upcase and downcase variants 288 (if (or (= pos 0)
277 (setq char (funcall (car shortcut-style) (aref str pos))) 289 (/= (aref str (1- pos)) ?.)) ; avoid file extensions
278 (if (not (memq char tmm-short-cuts)) (throw 'done char)) 290 (let ((shortcut-style
279 (setq shortcut-style (cdr shortcut-style))))) 291 (if (listp tmm-shortcut-style) ; convert to list
280 (setq word (1+ word)) 292 tmm-shortcut-style
281 (setq pos (match-end 0))) 293 (list tmm-shortcut-style))))
282 (while (<= tmm-next-shortcut-digit ?9) ; no letter shortcut, pick a digit 294 (while shortcut-style ; try upcase and downcase variants
283 (setq char tmm-next-shortcut-digit) 295 (setq char (funcall (car shortcut-style) (aref str pos)))
284 (setq tmm-next-shortcut-digit (1+ tmm-next-shortcut-digit)) 296 (if (not (memq char tmm-short-cuts)) (throw 'done char))
285 (if (not (memq char tmm-short-cuts)) (throw 'done char))) 297 (setq shortcut-style (cdr shortcut-style)))))
286 (setq char nil)) 298 (setq word (1+ word))
287 (if char (setq tmm-short-cuts (cons char tmm-short-cuts))) 299 (setq pos (match-end 0)))
288 (cons (concat (if char (concat (char-to-string char) tmm-mid-prompt) 300 (while (<= tmm-next-shortcut-digit ?9) ; no letter shortcut, pick a digit
289 ;; keep them lined up in columns 301 (setq char tmm-next-shortcut-digit)
290 (make-string (1+ (length tmm-mid-prompt)) ?\ )) 302 (setq tmm-next-shortcut-digit (1+ tmm-next-shortcut-digit))
291 str) 303 (if (not (memq char tmm-short-cuts)) (throw 'done char)))
292 (cdr elt)))) 304 (setq char nil))
305 (if char (setq tmm-short-cuts (cons char tmm-short-cuts)))
306 (cons (concat (if char (concat (char-to-string char) tmm-mid-prompt)
307 ;; keep them lined up in columns
308 (make-string (1+ (length tmm-mid-prompt)) ?\ ))
309 str)
310 (cdr elt))))))
293 311
294;; This returns the old map. 312;; This returns the old map.
295(defun tmm-define-keys (minibuffer) 313(defun tmm-define-keys (minibuffer)
@@ -319,9 +337,27 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
319 (goto-char 1) 337 (goto-char 1)
320 (delete-region 1 (search-forward "Possible completions are:\n"))) 338 (delete-region 1 (search-forward "Possible completions are:\n")))
321 339
340(defun tmm-remove-inactive-mouse-face ()
341 "Remove the mouse-face property from inactive menu items."
342 (let ((inhibit-read-only t)
343 (inactive-string
344 (concat " " (make-string (length tmm-mid-prompt) ?\-)))
345 next)
346 (save-excursion
347 (goto-char (point-min))
348 (while (not (eobp))
349 (setq next (next-single-char-property-change (point) 'mouse-face))
350 (when (looking-at inactive-string)
351 (remove-text-properties (point) next '(mouse-face))
352 (add-text-properties (point) next '(face tmm-inactive)))
353 (goto-char next)))
354 (set-buffer-modified-p nil)))
355
322(defun tmm-add-prompt () 356(defun tmm-add-prompt ()
323 (remove-hook 'minibuffer-setup-hook 'tmm-add-prompt) 357 (remove-hook 'minibuffer-setup-hook 'tmm-add-prompt)
324 (add-hook 'minibuffer-exit-hook 'tmm-delete-map nil t) 358 (add-hook 'minibuffer-exit-hook 'tmm-delete-map nil t)
359 (unless tmm-c-prompt
360 (error "No active menu entries"))
325 (let ((win (selected-window))) 361 (let ((win (selected-window)))
326 (setq tmm-old-mb-map (tmm-define-keys t)) 362 (setq tmm-old-mb-map (tmm-define-keys t))
327 ;; Get window and hide it for electric mode to get correct size 363 ;; Get window and hide it for electric mode to get correct size
@@ -334,8 +370,9 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
334 (with-output-to-temp-buffer "*Completions*" 370 (with-output-to-temp-buffer "*Completions*"
335 (display-completion-list completions)) 371 (display-completion-list completions))
336 (remove-hook 'completion-setup-hook 'tmm-completion-delete-prompt)) 372 (remove-hook 'completion-setup-hook 'tmm-completion-delete-prompt))
373 (set-buffer "*Completions*")
374 (tmm-remove-inactive-mouse-face)
337 (when tmm-completion-prompt 375 (when tmm-completion-prompt
338 (set-buffer "*Completions*")
339 (let ((buffer-read-only nil)) 376 (let ((buffer-read-only nil))
340 (goto-char (point-min)) 377 (goto-char (point-min))
341 (insert tmm-completion-prompt)))) 378 (insert tmm-completion-prompt))))
@@ -345,7 +382,6 @@ Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
345 (Electric-pop-up-window "*Completions*") 382 (Electric-pop-up-window "*Completions*")
346 (with-current-buffer "*Completions*" 383 (with-current-buffer "*Completions*"
347 (setq tmm-old-comp-map (tmm-define-keys nil)))) 384 (setq tmm-old-comp-map (tmm-define-keys nil))))
348
349 (insert tmm-c-prompt))) 385 (insert tmm-c-prompt)))
350 386
351(defun tmm-delete-map () 387(defun tmm-delete-map ()
@@ -438,7 +474,7 @@ It uses the free variable `tmm-table-undef' to keep undefined keys."
438 (setq km (and (eval visible) km))) 474 (setq km (and (eval visible) km)))
439 (setq enable (plist-get plist :enable)) 475 (setq enable (plist-get plist :enable))
440 (if enable 476 (if enable
441 (setq km (and (eval enable) km))) 477 (setq km (if (eval enable) km 'ignore)))
442 (and str 478 (and str
443 (consp (nth 3 elt)) 479 (consp (nth 3 elt))
444 (stringp (cdr (nth 3 elt))) ; keyseq cache 480 (stringp (cdr (nth 3 elt))) ; keyseq cache
@@ -467,8 +503,7 @@ It uses the free variable `tmm-table-undef' to keep undefined keys."
467 ;; Verify that the command is enabled; 503 ;; Verify that the command is enabled;
468 ;; if not, don't mention it. 504 ;; if not, don't mention it.
469 (when (and km (symbolp km) (get km 'menu-enable)) 505 (when (and km (symbolp km) (get km 'menu-enable))
470 (unless (eval (get km 'menu-enable)) 506 (setq km (if (eval (get km 'menu-enable)) km 'ignore)))
471 (setq km nil)))
472 (and km str 507 (and km str
473 (or (assoc str tmm-km-list) 508 (or (assoc str tmm-km-list)
474 (push (cons str (cons event km)) tmm-km-list)))))) 509 (push (cons str (cons event km)) tmm-km-list))))))
diff --git a/lisp/toolbar/gud-break.xpm b/lisp/toolbar/gud-break.xpm
index 419955dd109..2ffc2748271 100644
--- a/lisp/toolbar/gud-break.xpm
+++ b/lisp/toolbar/gud-break.xpm
@@ -1,7 +1,7 @@
1/* XPM */ 1/* XPM */
2static char * stop_xpm[] = { 2static char * stop_xpm[] = {
3"24 24 3 1", 3"24 24 3 1",
4" c #C0C0C0C0C0C0", 4" c None",
5". c #F8F810104040", 5". c #F8F810104040",
6"X c #F8F8FCFCF8F8", 6"X c #F8F8FCFCF8F8",
7" ", 7" ",
diff --git a/lisp/toolbar/gud-cont.xpm b/lisp/toolbar/gud-cont.xpm
index 4863a955bec..9da91af994f 100644
--- a/lisp/toolbar/gud-cont.xpm
+++ b/lisp/toolbar/gud-cont.xpm
@@ -1,7 +1,7 @@
1/* XPM */ 1/* XPM */
2static char * continue_xpm[] = { 2static char * continue_xpm[] = {
3"24 24 6 1", 3"24 24 6 1",
4" c #c0c0c0", 4" c None",
5". c #cc0033", 5". c #cc0033",
6"X c #d99faa", 6"X c #d99faa",
7"o c #616161", 7"o c #616161",
diff --git a/lisp/toolbar/gud-down.xpm b/lisp/toolbar/gud-down.xpm
index 77e93fdfa19..30f3af89cce 100644
--- a/lisp/toolbar/gud-down.xpm
+++ b/lisp/toolbar/gud-down.xpm
@@ -1,7 +1,7 @@
1/* XPM */ 1/* XPM */
2static char * down_xpm[] = { 2static char * down_xpm[] = {
3"24 24 14 1", 3"24 24 14 1",
4" c #C0C0C0C0C0C0", 4" c None",
5". c #000000000000", 5". c #000000000000",
6"X c #7F7F7F7F7F7F", 6"X c #7F7F7F7F7F7F",
7"o c #2D2D2D2D2D2D", 7"o c #2D2D2D2D2D2D",
diff --git a/lisp/toolbar/gud-finish.xpm b/lisp/toolbar/gud-finish.xpm
index 59066450ee3..0310f07e8da 100644
--- a/lisp/toolbar/gud-finish.xpm
+++ b/lisp/toolbar/gud-finish.xpm
@@ -1,7 +1,7 @@
1/* XPM */ 1/* XPM */
2static char * finish_xpm[] = { 2static char * finish_xpm[] = {
3"24 24 7 1", 3"24 24 7 1",
4" c #c0c0c0", 4" c None",
5". c #cc0033", 5". c #cc0033",
6"X c #616161", 6"X c #616161",
7"o c #2a1f55", 7"o c #2a1f55",
diff --git a/lisp/toolbar/gud-n.xpm b/lisp/toolbar/gud-n.xpm
index 0e631de18e1..f0257da5cf0 100644
--- a/lisp/toolbar/gud-n.xpm
+++ b/lisp/toolbar/gud-n.xpm
@@ -1,7 +1,7 @@
1/* XPM */ 1/* XPM */
2static char * next_xpm[] = { 2static char * next_xpm[] = {
3"24 24 7 1", 3"24 24 7 1",
4" c #c0c0c0", 4" c None",
5". c #cc0033", 5". c #cc0033",
6"X c #616161", 6"X c #616161",
7"o c #2a1f55", 7"o c #2a1f55",
diff --git a/lisp/toolbar/gud-ni.xpm b/lisp/toolbar/gud-ni.xpm
index cdb8c38e8d4..bd4f02db12e 100644
--- a/lisp/toolbar/gud-ni.xpm
+++ b/lisp/toolbar/gud-ni.xpm
@@ -1,7 +1,7 @@
1/* XPM */ 1/* XPM */
2static char * gud_nexti_xpm[] = { 2static char * gud_nexti_xpm[] = {
3"24 24 6 1", 3"24 24 6 1",
4" c #C0C0C0C0C0C0", 4" c None",
5". c #CCCC00003333", 5". c #CCCC00003333",
6"X c #616161616161", 6"X c #616161616161",
7"o c #D4D400000000", 7"o c #D4D400000000",
diff --git a/lisp/toolbar/gud-print.xpm b/lisp/toolbar/gud-print.xpm
index cab2b7d6109..e1e7c623355 100644
--- a/lisp/toolbar/gud-print.xpm
+++ b/lisp/toolbar/gud-print.xpm
@@ -1,7 +1,7 @@
1/* XPM */ 1/* XPM */
2static char * print_xpm[] = { 2static char * print_xpm[] = {
3"24 24 2 1", 3"24 24 2 1",
4" c #C0C0C0C0C0C0", 4" c None",
5". c #000000000000", 5". c #000000000000",
6" ", 6" ",
7" ", 7" ",
diff --git a/lisp/toolbar/gud-pstar.pbm b/lisp/toolbar/gud-pstar.pbm
new file mode 100644
index 00000000000..1f5967107a0
--- /dev/null
+++ b/lisp/toolbar/gud-pstar.pbm
Binary files differ
diff --git a/lisp/toolbar/gud-pstar.xpm b/lisp/toolbar/gud-pstar.xpm
new file mode 100644
index 00000000000..6edc603db14
--- /dev/null
+++ b/lisp/toolbar/gud-pstar.xpm
@@ -0,0 +1,29 @@
1/* XPM */
2static char * gud_pstar_xpm[] = {
3"24 24 2 1",
4" c #BDBDBEBEBDBD",
5". c #000000000000",
6" ",
7" ",
8" ",
9" ",
10" ",
11" ",
12" ",
13" ",
14" ... ... ",
15" ... ... ",
16" .. .. . ",
17" .. .. . . . ",
18" .. .. ... ",
19" .. .. . . . ",
20" .. .. . ",
21" ... .. ",
22" .. .. ",
23" .. ",
24" .. ",
25" .. ",
26" .... ",
27" ",
28" ",
29" "};
diff --git a/lisp/toolbar/gud-remove.xpm b/lisp/toolbar/gud-remove.xpm
index c61b6b2b8f3..5f38bd416ed 100644
--- a/lisp/toolbar/gud-remove.xpm
+++ b/lisp/toolbar/gud-remove.xpm
@@ -1,7 +1,7 @@
1/* XPM */ 1/* XPM */
2static char * go_xpm[] = { 2static char * go_xpm[] = {
3"24 24 4 1", 3"24 24 4 1",
4" c #C0C0C0C0C0C0", 4" c None",
5". c #000080800000", 5". c #000080800000",
6"X c #FFFFFFFFFFFF", 6"X c #FFFFFFFFFFFF",
7"o c #F8F8FCFCF8F8", 7"o c #F8F8FCFCF8F8",
diff --git a/lisp/toolbar/gud-run.xpm b/lisp/toolbar/gud-run.xpm
index 6e077a11659..ef29662ed24 100644
--- a/lisp/toolbar/gud-run.xpm
+++ b/lisp/toolbar/gud-run.xpm
@@ -1,7 +1,7 @@
1/* XPM */ 1/* XPM */
2static char * run_xpm[] = { 2static char * run_xpm[] = {
3"24 24 9 1", 3"24 24 9 1",
4" c #c0c0c0", 4" c None",
5". c #000080", 5". c #000080",
6"X c #aa9faa", 6"X c #aa9faa",
7"o c #b5b9b5", 7"o c #b5b9b5",
diff --git a/lisp/toolbar/gud-s.xpm b/lisp/toolbar/gud-s.xpm
index 7b4eb876235..4ee3eccaee2 100644
--- a/lisp/toolbar/gud-s.xpm
+++ b/lisp/toolbar/gud-s.xpm
@@ -1,7 +1,7 @@
1/* XPM */ 1/* XPM */
2static char * step_xpm[] = { 2static char * step_xpm[] = {
3"24 24 6 1", 3"24 24 6 1",
4" c #c0c0c0", 4" c None",
5". c #d40000", 5". c #d40000",
6"X c #616161", 6"X c #616161",
7"o c #2a1f55", 7"o c #2a1f55",
diff --git a/lisp/toolbar/gud-si.xpm b/lisp/toolbar/gud-si.xpm
index d2667fc70b6..b20eb6243f7 100644
--- a/lisp/toolbar/gud-si.xpm
+++ b/lisp/toolbar/gud-si.xpm
@@ -1,7 +1,7 @@
1/* XPM */ 1/* XPM */
2static char * gud_stepi_xpm[] = { 2static char * gud_stepi_xpm[] = {
3"24 24 5 1", 3"24 24 5 1",
4" c #C0C0C0C0C0C0", 4" c None",
5". c #D4D400000000", 5". c #D4D400000000",
6"X c #616161616161", 6"X c #616161616161",
7"o c #2A2A1F1F5555", 7"o c #2A2A1F1F5555",
diff --git a/lisp/toolbar/gud-until.xpm b/lisp/toolbar/gud-until.xpm
index 8801320a2d1..f82da6700b2 100644
--- a/lisp/toolbar/gud-until.xpm
+++ b/lisp/toolbar/gud-until.xpm
@@ -1,7 +1,7 @@
1/* XPM */ 1/* XPM */
2static char * goto_xpm[] = { 2static char * goto_xpm[] = {
3"24 24 6 1", 3"24 24 6 1",
4" c #c0c0c0", 4" c None",
5". c #ff0000", 5". c #ff0000",
6"X c #616161", 6"X c #616161",
7"o c #2a1f55", 7"o c #2a1f55",
diff --git a/lisp/toolbar/gud-up.xpm b/lisp/toolbar/gud-up.xpm
index 10d8c1278c9..c2e4c9f8ff4 100644
--- a/lisp/toolbar/gud-up.xpm
+++ b/lisp/toolbar/gud-up.xpm
@@ -1,7 +1,7 @@
1/* XPM */ 1/* XPM */
2static char * up_xpm[] = { 2static char * up_xpm[] = {
3"24 24 14 1", 3"24 24 14 1",
4" c #C0C0C0C0C0C0", 4" c None",
5". c #000000000000", 5". c #000000000000",
6"X c #7F7F7F7F7F7F", 6"X c #7F7F7F7F7F7F",
7"o c #2D2D2D2D2D2D", 7"o c #2D2D2D2D2D2D",
diff --git a/lisp/toolbar/gud-watch.xpm b/lisp/toolbar/gud-watch.xpm
index 41361dc32b2..52052212390 100644
--- a/lisp/toolbar/gud-watch.xpm
+++ b/lisp/toolbar/gud-watch.xpm
@@ -1,7 +1,7 @@
1/* XPM */ 1/* XPM */
2static char * watch_xpm[] = { 2static char * watch_xpm[] = {
3"24 24 11 1", 3"24 24 11 1",
4" c #C0C0C0C0C0C0", 4" c None",
5". c #808080808080", 5". c #808080808080",
6"X c #000000000000", 6"X c #000000000000",
7"o c #A5A59F9FA3A3", 7"o c #A5A59F9FA3A3",
diff --git a/lisp/tooltip.el b/lisp/tooltip.el
index 7a2865b9dfa..904f2bf8770 100644
--- a/lisp/tooltip.el
+++ b/lisp/tooltip.el
@@ -113,6 +113,17 @@ position to pop up the tooltip."
113 "Face for tooltips." 113 "Face for tooltips."
114 :group 'tooltip) 114 :group 'tooltip)
115 115
116(defcustom tooltip-use-echo-area nil
117 "Use the echo area instead of tooltip frames for help and GUD tooltips."
118 :type 'boolean
119 :tag "Use echo area"
120 :group 'tooltip)
121
122(make-obsolete-variable 'tooltip-use-echo-area
123"To display help tooltips in the echo area turn tooltip-mode off.
124To display GUD tooltips in the echo area turn gud-tooltip-mode on and set
125gud-tooltip-echo-area to t." "22.1")
126
116 127
117;;; Variables that are not customizable. 128;;; Variables that are not customizable.
118 129
@@ -169,7 +180,7 @@ With ARG, turn tooltip mode on if and only if ARG is positive."
169 (remove-hook 'pre-command-hook 'tooltip-hide)) 180 (remove-hook 'pre-command-hook 'tooltip-hide))
170 (remove-hook 'tooltip-hook 'tooltip-help-tips)) 181 (remove-hook 'tooltip-hook 'tooltip-help-tips))
171 (setq show-help-function 182 (setq show-help-function
172 (if tooltip-mode 'tooltip-show-help-function nil))) 183 (if tooltip-mode 'tooltip-show-help nil)))
173 184
174 185
175;;; Timeout for tooltip display 186;;; Timeout for tooltip display
@@ -314,9 +325,9 @@ of PROCESS."
314;;; Tooltip help. 325;;; Tooltip help.
315 326
316(defvar tooltip-help-message nil 327(defvar tooltip-help-message nil
317 "The last help message received via `tooltip-show-help-function'.") 328 "The last help message received via `tooltip-show-help'.")
318 329
319(defun tooltip-show-help-function (msg) 330(defun tooltip-show-help (msg)
320 "Function installed as `show-help-function'. 331 "Function installed as `show-help-function'.
321MSG is either a help string to display, or nil to cancel the display." 332MSG is either a help string to display, or nil to cancel the display."
322 (let ((previous-help tooltip-help-message)) 333 (let ((previous-help tooltip-help-message))
@@ -341,7 +352,7 @@ This is installed on the hook `tooltip-hook', which is run when
341the timer with ID `tooltip-timeout-id' fires. 352the timer with ID `tooltip-timeout-id' fires.
342Value is non-nil if this function handled the tip." 353Value is non-nil if this function handled the tip."
343 (when (stringp tooltip-help-message) 354 (when (stringp tooltip-help-message)
344 (tooltip-show tooltip-help-message) 355 (tooltip-show tooltip-help-message tooltip-use-echo-area)
345 t)) 356 t))
346 357
347(provide 'tooltip) 358(provide 'tooltip)
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 546af477106..5718346b89b 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,27 @@
12005-06-14 Juanma Barranquero <lekktu@gmail.com>
2
3 * url-history.el (url-completion-function): Follow error
4 conventions.
5
62005-06-13 Stefan Monnier <monnier@iro.umontreal.ca>
7
8 * url-file.el (url-file, url-file-asynch-callback): with-current-buffer.
9
102005-06-10 Stefan Monnier <monnier@iro.umontreal.ca>
11
12 * url-dav.el: Remove most autoload cookies.
13 Don't hook into the url-file-handler since it currently breaks all
14 non-HTTP URLs.
15
16 * url-handlers.el (vc-registered): Explicitly disable VC for URL files.
17
18 * url.el (url-retrieve-synchronously): Don't exit precipitously when
19 fetching a file via ange-ftp.
20
212005-06-10 Juanma Barranquero <lekktu@gmail.com>
22
23 * url-cookie.el (url-cookie-multiple-line): Fix spelling in docstring.
24
12005-05-19 Juanma Barranquero <lekktu@gmail.com> 252005-05-19 Juanma Barranquero <lekktu@gmail.com>
2 26
3 * url-cookie.el (url-cookie-multiple-line): 27 * url-cookie.el (url-cookie-multiple-line):
diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el
index 328e60b63bc..7cee222c373 100644
--- a/lisp/url/url-cookie.el
+++ b/lisp/url/url-cookie.el
@@ -73,7 +73,7 @@
73 73
74(defvar url-cookie-storage nil "Where cookies are stored.") 74(defvar url-cookie-storage nil "Where cookies are stored.")
75(defvar url-cookie-secure-storage nil "Where secure cookies are stored.") 75(defvar url-cookie-secure-storage nil "Where secure cookies are stored.")
76(defcustom url-cookie-file nil "*Where cookies are stored on disk." 76(defcustom url-cookie-file nil "*Where cookies are stored on disk."
77 :type '(choice (const :tag "Default" :value nil) file) 77 :type '(choice (const :tag "Default" :value nil) file)
78 :group 'url-file 78 :group 'url-file
79 :group 'url-cookie) 79 :group 'url-cookie)
@@ -86,7 +86,7 @@
86(defcustom url-cookie-multiple-line nil 86(defcustom url-cookie-multiple-line nil
87 "*If nil, HTTP requests put all cookies for the server on one line. 87 "*If nil, HTTP requests put all cookies for the server on one line.
88Some web servers, such as http://www.hotmail.com/, only accept cookies 88Some web servers, such as http://www.hotmail.com/, only accept cookies
89when they are on one line. This is broken behaviour, but just try 89when they are on one line. This is broken behavior, but just try
90telling Microsoft that." 90telling Microsoft that."
91 :type 'boolean 91 :type 'boolean
92 :group 'url-cookie) 92 :group 'url-cookie)
diff --git a/lisp/url/url-dav.el b/lisp/url/url-dav.el
index a0f1ae1ebe7..a3320f88e96 100644
--- a/lisp/url/url-dav.el
+++ b/lisp/url/url-dav.el
@@ -457,7 +457,6 @@ added to this list, so most requests can just pass in nil."
457 "</" (symbol-name tag) ">\n")))) 457 "</" (symbol-name tag) ">\n"))))
458 (url-dav-process-response (url-retrieve-synchronously url) url))) 458 (url-dav-process-response (url-retrieve-synchronously url) url)))
459 459
460;;;###autoload
461(defun url-dav-get-properties (url &optional attributes depth namespaces) 460(defun url-dav-get-properties (url &optional attributes depth namespaces)
462 "Return properties for URL, up to DEPTH levels deep. 461 "Return properties for URL, up to DEPTH levels deep.
463 462
@@ -487,7 +486,6 @@ identify the owner of a LOCK when requesting it. This will be shown
487to other users when the DAV:lockdiscovery property is requested, so 486to other users when the DAV:lockdiscovery property is requested, so
488make sure you are comfortable with it leaking to the outside world.") 487make sure you are comfortable with it leaking to the outside world.")
489 488
490;;;###autoload
491(defun url-dav-lock-resource (url exclusive &optional depth) 489(defun url-dav-lock-resource (url exclusive &optional depth)
492 "Request a lock on URL. If EXCLUSIVE is non-nil, get an exclusive lock. 490 "Request a lock on URL. If EXCLUSIVE is non-nil, get an exclusive lock.
493Optional 3rd argument DEPTH says how deep the lock should go, default is 0 491Optional 3rd argument DEPTH says how deep the lock should go, default is 0
@@ -528,7 +526,6 @@ FAILURE-RESULTS is a list of (URL STATUS)."
528 (push (list url child-status) failures))) 526 (push (list url child-status) failures)))
529 (cons successes failures))) 527 (cons successes failures)))
530 528
531;;;###autoload
532(defun url-dav-active-locks (url &optional depth) 529(defun url-dav-active-locks (url &optional depth)
533 "Return an assoc list of all active locks on URL." 530 "Return an assoc list of all active locks on URL."
534 (let ((response (url-dav-get-properties url '(DAV:lockdiscovery) depth)) 531 (let ((response (url-dav-get-properties url '(DAV:lockdiscovery) depth))
@@ -563,7 +560,6 @@ FAILURE-RESULTS is a list of (URL STATUS)."
563 results))) 560 results)))
564 results)) 561 results))
565 562
566;;;###autoload
567(defun url-dav-unlock-resource (url lock-token) 563(defun url-dav-unlock-resource (url lock-token)
568 "Release the lock on URL represented by LOCK-TOKEN. 564 "Release the lock on URL represented by LOCK-TOKEN.
569Returns t iff the lock was successfully released." 565Returns t iff the lock was successfully released."
@@ -624,7 +620,6 @@ Returns t iff the lock was successfully released."
624 620
625(autoload 'url-http-head-file-attributes "url-http") 621(autoload 'url-http-head-file-attributes "url-http")
626 622
627;;;###autoload
628(defun url-dav-file-attributes (url &optional id-format) 623(defun url-dav-file-attributes (url &optional id-format)
629 (let ((properties (cdar (url-dav-get-properties url))) 624 (let ((properties (cdar (url-dav-get-properties url)))
630 (attributes nil)) 625 (attributes nil))
@@ -680,7 +675,6 @@ Returns t iff the lock was successfully released."
680 (setq attributes (url-http-head-file-attributes url id-format))) 675 (setq attributes (url-http-head-file-attributes url id-format)))
681 attributes)) 676 attributes))
682 677
683;;;###autoload
684(defun url-dav-save-resource (url obj &optional content-type lock-token) 678(defun url-dav-save-resource (url obj &optional content-type lock-token)
685 "Save OBJ as URL using WebDAV. 679 "Save OBJ as URL using WebDAV.
686URL must be a fully qualified URL. 680URL must be a fully qualified URL.
@@ -736,7 +730,6 @@ Use with care, and even then think three times.
736 (concat "(<" ,lock-token ">)")))))))) 730 (concat "(<" ,lock-token ">)"))))))))
737 731
738 732
739;;;###autoload
740(defun url-dav-delete-directory (url &optional recursive lock-token) 733(defun url-dav-delete-directory (url &optional recursive lock-token)
741 "Delete the WebDAV collection URL. 734 "Delete the WebDAV collection URL.
742If optional second argument RECURSIVE is non-nil, then delete all 735If optional second argument RECURSIVE is non-nil, then delete all
@@ -761,7 +754,6 @@ files in the collection as well."
761 props)) 754 props))
762 nil) 755 nil)
763 756
764;;;###autoload
765(defun url-dav-delete-file (url &optional lock-token) 757(defun url-dav-delete-file (url &optional lock-token)
766 "Delete file named URL." 758 "Delete file named URL."
767 (let ((props nil) 759 (let ((props nil)
@@ -781,7 +773,6 @@ files in the collection as well."
781 props)) 773 props))
782 nil) 774 nil)
783 775
784;;;###autoload
785(defun url-dav-directory-files (url &optional full match nosort files-only) 776(defun url-dav-directory-files (url &optional full match nosort files-only)
786 "Return a list of names of files in DIRECTORY. 777 "Return a list of names of files in DIRECTORY.
787There are three optional arguments: 778There are three optional arguments:
@@ -828,13 +819,11 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
828 files 819 files
829 (sort files 'string-lessp)))) 820 (sort files 'string-lessp))))
830 821
831;;;###autoload
832(defun url-dav-file-directory-p (url) 822(defun url-dav-file-directory-p (url)
833 "Return t if URL names an existing DAV collection." 823 "Return t if URL names an existing DAV collection."
834 (let ((properties (cdar (url-dav-get-properties url '(DAV:resourcetype))))) 824 (let ((properties (cdar (url-dav-get-properties url '(DAV:resourcetype)))))
835 (eq (plist-get properties 'DAV:resourcetype) 'DAV:collection))) 825 (eq (plist-get properties 'DAV:resourcetype) 'DAV:collection)))
836 826
837;;;###autoload
838(defun url-dav-make-directory (url &optional parents) 827(defun url-dav-make-directory (url &optional parents)
839 "Create the directory DIR and any nonexistent parent dirs." 828 "Create the directory DIR and any nonexistent parent dirs."
840 (declare (special url-http-response-status)) 829 (declare (special url-http-response-status))
@@ -864,7 +853,6 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
864 (kill-buffer buffer))) 853 (kill-buffer buffer)))
865 result)) 854 result))
866 855
867;;;###autoload
868(defun url-dav-rename-file (oldname newname &optional overwrite) 856(defun url-dav-rename-file (oldname newname &optional overwrite)
869 (if (not (and (string-match url-handler-regexp oldname) 857 (if (not (and (string-match url-handler-regexp oldname)
870 (string-match url-handler-regexp newname))) 858 (string-match url-handler-regexp newname)))
@@ -905,13 +893,11 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
905 props) 893 props)
906 t)) 894 t))
907 895
908;;;###autoload
909(defun url-dav-file-name-all-completions (file url) 896(defun url-dav-file-name-all-completions (file url)
910 "Return a list of all completions of file name FILE in directory DIRECTORY. 897 "Return a list of all completions of file name FILE in directory DIRECTORY.
911These are all file names in directory DIRECTORY which begin with FILE." 898These are all file names in directory DIRECTORY which begin with FILE."
912 (url-dav-directory-files url nil (concat "^" file ".*"))) 899 (url-dav-directory-files url nil (concat "^" file ".*")))
913 900
914;;;###autoload
915(defun url-dav-file-name-completion (file url) 901(defun url-dav-file-name-completion (file url)
916 "Complete file name FILE in directory DIRECTORY. 902 "Complete file name FILE in directory DIRECTORY.
917Returns the longest string 903Returns the longest string
@@ -951,15 +937,18 @@ Returns nil if DIR contains no name starting with FILE."
951 (put op 'url-file-handlers (intern-soft (format "url-dav-%s" op)))) 937 (put op 'url-file-handlers (intern-soft (format "url-dav-%s" op))))
952 938
953(mapcar 'url-dav-register-handler 939(mapcar 'url-dav-register-handler
954 '(file-name-all-completions 940 ;; These handlers are disabled because they incorrectly presume that
955 file-name-completion 941 ;; the URL specifies an HTTP location and thus break FTP URLs.
956 rename-file 942 '(;; file-name-all-completions
957 make-directory 943 ;; file-name-completion
958 file-directory-p 944 ;; rename-file
959 directory-files 945 ;; make-directory
960 delete-file 946 ;; file-directory-p
961 delete-directory 947 ;; directory-files
962 file-attributes)) 948 ;; delete-file
949 ;; delete-directory
950 ;; file-attributes
951 ))
963 952
964 953
965;;; Version Control backend cruft 954;;; Version Control backend cruft
diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el
index 0aa23acc0ec..c39d255304b 100644
--- a/lisp/url/url-file.el
+++ b/lisp/url/url-file.el
@@ -73,8 +73,7 @@ to them."
73 func args 73 func args
74 args efs)) 74 args efs))
75 (let ((size (nth 7 (file-attributes name)))) 75 (let ((size (nth 7 (file-attributes name))))
76 (save-excursion 76 (with-current-buffer buff
77 (set-buffer buff)
78 (goto-char (point-max)) 77 (goto-char (point-max))
79 (if (/= -1 size) 78 (if (/= -1 size)
80 (insert (format "Content-length: %d\n" size))) 79 (insert (format "Content-length: %d\n" size)))
@@ -177,9 +176,8 @@ to them."
177 (if (file-directory-p filename) 176 (if (file-directory-p filename)
178 ;; A directory is done the same whether we are local or remote 177 ;; A directory is done the same whether we are local or remote
179 (url-find-file-dired filename) 178 (url-find-file-dired filename)
180 (save-excursion 179 (with-current-buffer
181 (setq buffer (generate-new-buffer " *url-file*")) 180 (setq buffer (generate-new-buffer " *url-file*"))
182 (set-buffer buffer)
183 (mm-disable-multibyte) 181 (mm-disable-multibyte)
184 (setq url-current-object url) 182 (setq url-current-object url)
185 (insert "Content-type: " (or content-type "application/octet-stream") "\n") 183 (insert "Content-type: " (or content-type "application/octet-stream") "\n")
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index 68bf0ec7ab5..12db63aade8 100644
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -155,6 +155,9 @@ the arguments that would have been passed to OPERATION."
155;; These are operations that we do not support yet (DAV!!!) 155;; These are operations that we do not support yet (DAV!!!)
156(put 'file-writable-p 'url-file-handlers 'ignore) 156(put 'file-writable-p 'url-file-handlers 'ignore)
157(put 'file-symlink-p 'url-file-handlers 'ignore) 157(put 'file-symlink-p 'url-file-handlers 'ignore)
158;; Just like for ange-ftp: let's not waste time trying to look for RCS/foo,v
159;; files and such since we can't do anything clever with them anyway.
160(put 'vc-registered 'url-file-handlers 'ignore)
158 161
159(defun url-handler-expand-file-name (file &optional base) 162(defun url-handler-expand-file-name (file &optional base)
160 (if (file-name-absolute-p file) 163 (if (file-name-absolute-p file)
diff --git a/lisp/url/url-history.el b/lisp/url/url-history.el
index e2bc9b17f69..3f9a82b9afd 100644
--- a/lisp/url/url-history.el
+++ b/lisp/url/url-history.el
@@ -84,7 +84,7 @@ to run the `url-history-setup-save-timer' function manually."
84(defun url-history-setup-save-timer () 84(defun url-history-setup-save-timer ()
85 "Reset the history list timer." 85 "Reset the history list timer."
86 (interactive) 86 (interactive)
87 (ignore-errors 87 (ignore-errors
88 (cond ((fboundp 'cancel-timer) (cancel-timer url-history-timer)) 88 (cond ((fboundp 'cancel-timer) (cancel-timer url-history-timer))
89 ((fboundp 'delete-itimer) (delete-itimer url-history-timer)))) 89 ((fboundp 'delete-itimer) (delete-itimer url-history-timer))))
90 (setq url-history-timer nil) 90 (setq url-history-timer nil)
@@ -192,7 +192,7 @@ user for what type to save as."
192 (gethash string url-history-hash-table) 192 (gethash string url-history-hash-table)
193 t)) 193 t))
194 (t 194 (t
195 (error "url-completion-function very confused.")))) 195 (error "url-completion-function very confused"))))
196 196
197(provide 'url-history) 197(provide 'url-history)
198 198
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 16d51a0258c..f5bbf4a7bf4 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -500,7 +500,8 @@ should be shown to the user."
500 (url-request-data url-http-data) 500 (url-request-data url-http-data)
501 (url-request-extra-headers url-http-extra-headers)) 501 (url-request-extra-headers url-http-extra-headers))
502 (url-retrieve redirect-uri url-callback-function 502 (url-retrieve redirect-uri url-callback-function
503 url-callback-arguments) 503 (cons redirect-uri
504 (cdr url-callback-arguments)))
504 (url-mark-buffer-as-dead (current-buffer)))))) 505 (url-mark-buffer-as-dead (current-buffer))))))
505 (4 ; Client error 506 (4 ; Client error
506 ;; 400 Bad Request 507 ;; 400 Bad Request
@@ -849,7 +850,7 @@ the end of the document."
849 (url-display-percentage nil nil) 850 (url-display-percentage nil nil)
850 (goto-char (match-end 1)) 851 (goto-char (match-end 1))
851 (if (re-search-forward "^\r*$" nil t) 852 (if (re-search-forward "^\r*$" nil t)
852 (message "Saw end of trailers...")) 853 (url-http-debug "Saw end of trailers..."))
853 (if (url-http-parse-headers) 854 (if (url-http-parse-headers)
854 (url-http-activate-callback)))))))))) 855 (url-http-activate-callback))))))))))
855 856
diff --git a/lisp/url/url.el b/lisp/url/url.el
index 05ef85c9300..8b57d885949 100644
--- a/lisp/url/url.el
+++ b/lisp/url/url.el
@@ -170,17 +170,26 @@ no further processing). URL is either a string or a parsed URL."
170 (url-debug 'retrieval "Synchronous fetching done (%S)" (current-buffer)) 170 (url-debug 'retrieval "Synchronous fetching done (%S)" (current-buffer))
171 (setq retrieval-done t 171 (setq retrieval-done t
172 asynch-buffer (current-buffer))))) 172 asynch-buffer (current-buffer)))))
173 (let ((proc (and asynch-buffer (get-buffer-process asynch-buffer)))) 173 (if (null asynch-buffer)
174 (if (null proc) 174 ;; We do not need to do anything, it was a mailto or something
175 ;; We do not need to do anything, it was a mailto or something 175 ;; similar that takes processing completely outside of the URL
176 ;; similar that takes processing completely outside of the URL 176 ;; package.
177 ;; package. 177 nil
178 nil 178 (let ((proc (get-buffer-process asynch-buffer)))
179 ;; If the access method was synchronous, `retrieval-done' should
180 ;; hopefully already be set to t. If it is nil, and `proc' is also
181 ;; nil, it implies that the async process is not running in
182 ;; asynch-buffer. This happens e.g. for FTP files. In such a case
183 ;; url-file.el should probably set something like a `url-process'
184 ;; buffer-local variable so we can find the exact process that we
185 ;; should be waiting for. In the mean time, we'll just wait for any
186 ;; process output.
179 (while (not retrieval-done) 187 (while (not retrieval-done)
180 (url-debug 'retrieval 188 (url-debug 'retrieval
181 "Spinning in url-retrieve-synchronously: %S (%S)" 189 "Spinning in url-retrieve-synchronously: %S (%S)"
182 retrieval-done asynch-buffer) 190 retrieval-done asynch-buffer)
183 (if (memq (process-status proc) '(closed exit signal failed)) 191 (if (and proc (memq (process-status proc)
192 '(closed exit signal failed)))
184 ;; FIXME: It's not clear whether url-retrieve's callback is 193 ;; FIXME: It's not clear whether url-retrieve's callback is
185 ;; guaranteed to be called or not. It seems that url-http 194 ;; guaranteed to be called or not. It seems that url-http
186 ;; decides sometimes consciously not to call it, so it's not 195 ;; decides sometimes consciously not to call it, so it's not
@@ -193,7 +202,7 @@ no further processing). URL is either a string or a parsed URL."
193 ;; interrupt it before it got a chance to handle process input. 202 ;; interrupt it before it got a chance to handle process input.
194 ;; `sleep-for' was tried but it lead to other forms of 203 ;; `sleep-for' was tried but it lead to other forms of
195 ;; hanging. --Stef 204 ;; hanging. --Stef
196 (unless (accept-process-output proc) 205 (unless (or (accept-process-output proc) (null proc))
197 ;; accept-process-output returned nil, maybe because the process 206 ;; accept-process-output returned nil, maybe because the process
198 ;; exited (and may have been replaced with another). 207 ;; exited (and may have been replaced with another).
199 (setq proc (get-buffer-process asynch-buffer)))))) 208 (setq proc (get-buffer-process asynch-buffer))))))
@@ -201,9 +210,9 @@ no further processing). URL is either a string or a parsed URL."
201 210
202(defun url-mm-callback (&rest ignored) 211(defun url-mm-callback (&rest ignored)
203 (let ((handle (mm-dissect-buffer t))) 212 (let ((handle (mm-dissect-buffer t)))
204 (save-excursion 213 (url-mark-buffer-as-dead (current-buffer))
205 (url-mark-buffer-as-dead (current-buffer)) 214 (with-current-buffer
206 (set-buffer (generate-new-buffer (url-recreate-url url-current-object))) 215 (generate-new-buffer (url-recreate-url url-current-object))
207 (if (eq (mm-display-part handle) 'external) 216 (if (eq (mm-display-part handle) 'external)
208 (progn 217 (progn
209 (set-process-sentinel 218 (set-process-sentinel
diff --git a/lisp/vc-arch.el b/lisp/vc-arch.el
index b821928c539..569f864c0ea 100644
--- a/lisp/vc-arch.el
+++ b/lisp/vc-arch.el
@@ -178,7 +178,7 @@ Only the value `maybe' can be trusted :-(."
178(defun vc-arch-root (file) 178(defun vc-arch-root (file)
179 "Return the root directory of a Arch project, if any." 179 "Return the root directory of a Arch project, if any."
180 (or (vc-file-getprop file 'arch-root) 180 (or (vc-file-getprop file 'arch-root)
181 (vc-file-setprop 181 (vc-file-setprop
182 ;; Check the =tagging-method, in case someone naively manually 182 ;; Check the =tagging-method, in case someone naively manually
183 ;; creates a {arch} directory somewhere. 183 ;; creates a {arch} directory somewhere.
184 file 'arch-root (vc-find-root file "{arch}/=tagging-method")))) 184 file 'arch-root (vc-find-root file "{arch}/=tagging-method"))))
@@ -357,7 +357,7 @@ Return non-nil if FILE is unchanged."
357(defun vc-arch-checkout-model (file) 'implicit) 357(defun vc-arch-checkout-model (file) 'implicit)
358 358
359(defun vc-arch-checkin (file rev comment) 359(defun vc-arch-checkin (file rev comment)
360 (if rev (error "Committing to a specific revision is unsupported.")) 360 (if rev (error "Committing to a specific revision is unsupported"))
361 (let ((summary (file-relative-name file (vc-arch-root file)))) 361 (let ((summary (file-relative-name file (vc-arch-root file))))
362 ;; Extract a summary from the comment. 362 ;; Extract a summary from the comment.
363 (when (or (string-match "\\`Summary:[ \t]*\\(.*[^ \t\n]\\)\\([ \t]*\n\\)*" comment) 363 (when (or (string-match "\\`Summary:[ \t]*\\(.*[^ \t\n]\\)\\([ \t]*\n\\)*" comment)
@@ -376,7 +376,7 @@ Return non-nil if FILE is unchanged."
376 ;; so we can diff with the current file. 376 ;; so we can diff with the current file.
377 (setq newvers nil)) 377 (setq newvers nil))
378 (if newvers 378 (if newvers
379 (error "Diffing specific revisions not implemented.") 379 (error "Diffing specific revisions not implemented")
380 (let* ((async (and (not vc-disable-async-diff) (fboundp 'start-process))) 380 (let* ((async (and (not vc-disable-async-diff) (fboundp 'start-process)))
381 ;; Run the command from the root dir. 381 ;; Run the command from the root dir.
382 (default-directory (vc-arch-root file)) 382 (default-directory (vc-arch-root file))
diff --git a/lisp/vc.el b/lisp/vc.el
index 24fae514ea5..b89298604eb 100644
--- a/lisp/vc.el
+++ b/lisp/vc.el
@@ -3043,12 +3043,12 @@ use; you may override this using the second optional arg MODE."
3043 3043
3044;;;###autoload 3044;;;###autoload
3045(defun vc-annotate (prefix &optional revision display-mode) 3045(defun vc-annotate (prefix &optional revision display-mode)
3046 "Display the edit history of the current file using colours. 3046 "Display the edit history of the current file using colors.
3047 3047
3048This command creates a buffer that shows, for each line of the current 3048This command creates a buffer that shows, for each line of the current
3049file, when it was last edited and by whom. Additionally, colours are 3049file, when it was last edited and by whom. Additionally, colors are
3050used to show the age of each line--blue means oldest, red means 3050used to show the age of each line--blue means oldest, red means
3051youngest, and intermediate colours indicate intermediate ages. By 3051youngest, and intermediate colors indicate intermediate ages. By
3052default, the time scale stretches back one year into the past; 3052default, the time scale stretches back one year into the past;
3053everything that is older than that is shown in blue. 3053everything that is older than that is shown in blue.
3054 3054
diff --git a/lisp/vcursor.el b/lisp/vcursor.el
index 4de92f02f0b..ac04603dbf8 100644
--- a/lisp/vcursor.el
+++ b/lisp/vcursor.el
@@ -1116,7 +1116,7 @@ is called interactively, so prefix argument etc. are usable."
1116 "Copy up to ARGth line after virtual cursor position. 1116 "Copy up to ARGth line after virtual cursor position.
1117With no argument, copy to the end of the current line. 1117With no argument, copy to the end of the current line.
1118 1118
1119Behaviour with regard to newlines is similar (but not identical) to 1119Behavior with regard to newlines is similar (but not identical) to
1120`kill-line'; the main difference is that whitespace at the end of the 1120`kill-line'; the main difference is that whitespace at the end of the
1121line is treated like ordinary characters." 1121line is treated like ordinary characters."
1122 1122
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index c0d9280a441..a119793c3a9 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -307,8 +307,8 @@ To disable timer scans, set this to zero."
307 :group 'whitespace) 307 :group 'whitespace)
308 308
309(defcustom whitespace-display-spaces-in-color t 309(defcustom whitespace-display-spaces-in-color t
310 "Display the bogus whitespaces by coloring them with 310 "Display the bogus whitespaces by coloring them with the face
311`whitespace-highlight-face'." 311`whitespace-highlight'."
312 :type 'boolean 312 :type 'boolean
313 :group 'whitespace) 313 :group 'whitespace)
314 314
@@ -318,18 +318,20 @@ To disable timer scans, set this to zero."
318 :group 'whitespace 318 :group 'whitespace
319 :group 'faces) 319 :group 'faces)
320 320
321(defface whitespace-highlight-face '((((class color) (background light)) 321(defface whitespace-highlight '((((class color) (background light))
322 (:background "green1")) 322 (:background "green1"))
323 (((class color) (background dark)) 323 (((class color) (background dark))
324 (:background "sea green")) 324 (:background "sea green"))
325 (((class grayscale mono) 325 (((class grayscale mono)
326 (background light)) 326 (background light))
327 (:background "black")) 327 (:background "black"))
328 (((class grayscale mono) 328 (((class grayscale mono)
329 (background dark)) 329 (background dark))
330 (:background "white"))) 330 (:background "white")))
331 "Face used for highlighting the bogus whitespaces that exist in the buffer." 331 "Face used for highlighting the bogus whitespaces that exist in the buffer."
332 :group 'whitespace-faces) 332 :group 'whitespace-faces)
333;; backward-compatibility alias
334(put 'whitespace-highlight-face 'face-alias 'whitespace-highlight)
333 335
334(if (not (assoc 'whitespace-mode minor-mode-alist)) 336(if (not (assoc 'whitespace-mode minor-mode-alist))
335 (setq minor-mode-alist (cons '(whitespace-mode whitespace-mode-line) 337 (setq minor-mode-alist (cons '(whitespace-mode whitespace-mode-line)
@@ -734,7 +736,7 @@ Also with whitespaces whose testing has been turned off."
734 (if whitespace-display-spaces-in-color 736 (if whitespace-display-spaces-in-color
735 (let ((ol (whitespace-make-overlay b e))) 737 (let ((ol (whitespace-make-overlay b e)))
736 (push ol whitespace-highlighted-space) 738 (push ol whitespace-highlighted-space)
737 (whitespace-overlay-put ol 'face 'whitespace-highlight-face)))) 739 (whitespace-overlay-put ol 'face 'whitespace-highlight))))
738;; (add-hook 'pre-command-hook 'whitespace-unhighlight-the-space)) 740;; (add-hook 'pre-command-hook 'whitespace-unhighlight-the-space))
739 741
740(defun whitespace-unhighlight-the-space() 742(defun whitespace-unhighlight-the-space()
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index d1ea8197fec..fbd76c6931a 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -89,28 +89,32 @@
89 :group 'widgets 89 :group 'widgets
90 :group 'faces) 90 :group 'faces)
91 91
92(defvar widget-documentation-face 'widget-documentation-face 92(defvar widget-documentation-face 'widget-documentation
93 "Face used for documentation strings in widgets. 93 "Face used for documentation strings in widgets.
94This exists as a variable so it can be set locally in certain buffers.") 94This exists as a variable so it can be set locally in certain buffers.")
95 95
96(defface widget-documentation-face '((((class color) 96(defface widget-documentation '((((class color)
97 (background dark)) 97 (background dark))
98 (:foreground "lime green")) 98 (:foreground "lime green"))
99 (((class color) 99 (((class color)
100 (background light)) 100 (background light))
101 (:foreground "dark green")) 101 (:foreground "dark green"))
102 (t nil)) 102 (t nil))
103 "Face used for documentation text." 103 "Face used for documentation text."
104 :group 'widget-documentation 104 :group 'widget-documentation
105 :group 'widget-faces) 105 :group 'widget-faces)
106;; backward compatibility alias
107(put 'widget-documentation-face 'face-alias 'widget-documentation)
106 108
107(defvar widget-button-face 'widget-button-face 109(defvar widget-button-face 'widget-button
108 "Face used for buttons in widgets. 110 "Face used for buttons in widgets.
109This exists as a variable so it can be set locally in certain buffers.") 111This exists as a variable so it can be set locally in certain buffers.")
110 112
111(defface widget-button-face '((t (:weight bold))) 113(defface widget-button '((t (:weight bold)))
112 "Face used for widget buttons." 114 "Face used for widget buttons."
113 :group 'widget-faces) 115 :group 'widget-faces)
116;; backward compatibility alias
117(put 'widget-button-face 'face-alias 'widget-button)
114 118
115(defcustom widget-mouse-face 'highlight 119(defcustom widget-mouse-face 'highlight
116 "Face used for widget buttons when the mouse is above them." 120 "Face used for widget buttons when the mouse is above them."
@@ -120,33 +124,37 @@ This exists as a variable so it can be set locally in certain buffers.")
120;; TTY gets special definitions here and in the next defface, because 124;; TTY gets special definitions here and in the next defface, because
121;; the gray colors defined for other displays cause black text on a black 125;; the gray colors defined for other displays cause black text on a black
122;; background, at least on light-background TTYs. 126;; background, at least on light-background TTYs.
123(defface widget-field-face '((((type tty)) 127(defface widget-field '((((type tty))
124 :background "yellow3" 128 :background "yellow3"
125 :foreground "black") 129 :foreground "black")
126 (((class grayscale color) 130 (((class grayscale color)
127 (background light)) 131 (background light))
128 :background "gray85") 132 :background "gray85")
129 (((class grayscale color) 133 (((class grayscale color)
130 (background dark)) 134 (background dark))
131 :background "dim gray") 135 :background "dim gray")
132 (t 136 (t
133 :slant italic)) 137 :slant italic))
134 "Face used for editable fields." 138 "Face used for editable fields."
135 :group 'widget-faces) 139 :group 'widget-faces)
136 140;; backward-compatibility alias
137(defface widget-single-line-field-face '((((type tty)) 141(put 'widget-field-face 'face-alias 'widget-field)
138 :background "green3" 142
139 :foreground "black") 143(defface widget-single-line-field '((((type tty))
140 (((class grayscale color) 144 :background "green3"
141 (background light)) 145 :foreground "black")
142 :background "gray85") 146 (((class grayscale color)
143 (((class grayscale color) 147 (background light))
144 (background dark)) 148 :background "gray85")
145 :background "dim gray") 149 (((class grayscale color)
146 (t 150 (background dark))
147 :slant italic)) 151 :background "dim gray")
152 (t
153 :slant italic))
148 "Face used for editable fields spanning only a single line." 154 "Face used for editable fields spanning only a single line."
149 :group 'widget-faces) 155 :group 'widget-faces)
156;; backward-compatibility alias
157(put 'widget-single-line-field-face 'face-alias 'widget-single-line-field)
150 158
151;;; This causes display-table to be loaded, and not usefully. 159;;; This causes display-table to be loaded, and not usefully.
152;;;(defvar widget-single-line-display-table 160;;;(defvar widget-single-line-display-table
@@ -325,7 +333,7 @@ new value.")
325 (insert-and-inherit " "))) 333 (insert-and-inherit " ")))
326 (setq to (point))) 334 (setq to (point)))
327 (let ((keymap (widget-get widget :keymap)) 335 (let ((keymap (widget-get widget :keymap))
328 (face (or (widget-get widget :value-face) 'widget-field-face)) 336 (face (or (widget-get widget :value-face) 'widget-field))
329 (help-echo (widget-get widget :help-echo)) 337 (help-echo (widget-get widget :help-echo))
330 (follow-link (widget-get widget :follow-link)) 338 (follow-link (widget-get widget :follow-link))
331 (rear-sticky 339 (rear-sticky
@@ -433,24 +441,26 @@ new value.")
433 (prog1 (progn ,@form) 441 (prog1 (progn ,@form)
434 (goto-char (point-max)))))) 442 (goto-char (point-max))))))
435 443
436(defface widget-inactive-face '((((class grayscale color) 444(defface widget-inactive '((((class grayscale color)
437 (background dark)) 445 (background dark))
438 (:foreground "light gray")) 446 (:foreground "light gray"))
439 (((class grayscale color) 447 (((class grayscale color)
440 (background light)) 448 (background light))
441 (:foreground "dim gray")) 449 (:foreground "dim gray"))
442 (t 450 (t
443 (:slant italic))) 451 (:slant italic)))
444 "Face used for inactive widgets." 452 "Face used for inactive widgets."
445 :group 'widget-faces) 453 :group 'widget-faces)
454;; backward-compatibility alias
455(put 'widget-inactive-face 'face-alias 'widget-inactive)
446 456
447(defun widget-specify-inactive (widget from to) 457(defun widget-specify-inactive (widget from to)
448 "Make WIDGET inactive for user modifications." 458 "Make WIDGET inactive for user modifications."
449 (unless (widget-get widget :inactive) 459 (unless (widget-get widget :inactive)
450 (let ((overlay (make-overlay from to nil t nil))) 460 (let ((overlay (make-overlay from to nil t nil)))
451 (overlay-put overlay 'face 'widget-inactive-face) 461 (overlay-put overlay 'face 'widget-inactive)
452 ;; This is disabled, as it makes the mouse cursor change shape. 462 ;; This is disabled, as it makes the mouse cursor change shape.
453 ;; (overlay-put overlay 'mouse-face 'widget-inactive-face) 463 ;; (overlay-put overlay 'mouse-face 'widget-inactive)
454 (overlay-put overlay 'evaporate t) 464 (overlay-put overlay 'evaporate t)
455 (overlay-put overlay 'priority 100) 465 (overlay-put overlay 'priority 100)
456 (overlay-put overlay 'modification-hooks '(widget-overlay-inactive)) 466 (overlay-put overlay 'modification-hooks '(widget-overlay-inactive))
@@ -633,7 +643,7 @@ extension (xpm, xbm, gif, jpg, or png) located in
633 ;; Oh well. 643 ;; Oh well.
634 nil))) 644 nil)))
635 645
636(defvar widget-button-pressed-face 'widget-button-pressed-face 646(defvar widget-button-pressed-face 'widget-button-pressed
637 "Face used for pressed buttons in widgets. 647 "Face used for pressed buttons in widgets.
638This exists as a variable so it can be set locally in certain 648This exists as a variable so it can be set locally in certain
639buffers.") 649buffers.")
@@ -882,7 +892,7 @@ Recommended as a parent keymap for modes using widgets.")
882 (call-interactively 892 (call-interactively
883 (lookup-key widget-global-map (this-command-keys)))))) 893 (lookup-key widget-global-map (this-command-keys))))))
884 894
885(defface widget-button-pressed-face 895(defface widget-button-pressed
886 '((((min-colors 88) (class color)) 896 '((((min-colors 88) (class color))
887 (:foreground "red1")) 897 (:foreground "red1"))
888 (((class color)) 898 (((class color))
@@ -891,6 +901,8 @@ Recommended as a parent keymap for modes using widgets.")
891 (:weight bold :underline t))) 901 (:weight bold :underline t)))
892 "Face used for pressed buttons." 902 "Face used for pressed buttons."
893 :group 'widget-faces) 903 :group 'widget-faces)
904;; backward-compatibility alias
905(put 'widget-button-pressed-face 'face-alias 'widget-button-pressed)
894 906
895(defun widget-button-click (event) 907(defun widget-button-click (event)
896 "Invoke the button that the mouse is pointing at." 908 "Invoke the button that the mouse is pointing at."
@@ -2953,7 +2965,7 @@ as the value."
2953 :match 'widget-regexp-match 2965 :match 'widget-regexp-match
2954 :validate 'widget-regexp-validate 2966 :validate 'widget-regexp-validate
2955 ;; Doesn't work well with terminating newline. 2967 ;; Doesn't work well with terminating newline.
2956 ;; :value-face 'widget-single-line-field-face 2968 ;; :value-face 'widget-single-line-field
2957 :tag "Regexp") 2969 :tag "Regexp")
2958 2970
2959(defun widget-regexp-match (widget value) 2971(defun widget-regexp-match (widget value)
@@ -2979,7 +2991,7 @@ It will read a file name from the minibuffer when invoked."
2979 :prompt-value 'widget-file-prompt-value 2991 :prompt-value 'widget-file-prompt-value
2980 :format "%{%t%}: %v" 2992 :format "%{%t%}: %v"
2981 ;; Doesn't work well with terminating newline. 2993 ;; Doesn't work well with terminating newline.
2982 ;; :value-face 'widget-single-line-field-face 2994 ;; :value-face 'widget-single-line-field
2983 :tag "File") 2995 :tag "File")
2984 2996
2985(defun widget-file-complete () 2997(defun widget-file-complete ()
diff --git a/lisp/window.el b/lisp/window.el
index c797111f111..09fac6c520f 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -31,7 +31,7 @@
31 31
32(defvar window-size-fixed nil 32(defvar window-size-fixed nil
33 "*Non-nil in a buffer means windows displaying the buffer are fixed-size. 33 "*Non-nil in a buffer means windows displaying the buffer are fixed-size.
34If the value is`height', then only the window's height is fixed. 34If the value is `height', then only the window's height is fixed.
35If the value is `width', then only the window's width is fixed. 35If the value is `width', then only the window's width is fixed.
36Any other non-nil value fixes both the width and the height. 36Any other non-nil value fixes both the width and the height.
37Emacs won't change the size of any window displaying that buffer, 37Emacs won't change the size of any window displaying that buffer,
@@ -92,9 +92,9 @@ If ALL-FRAMES is anything else, count only the selected frame."
92 92
93(defun window-current-scroll-bars (&optional window) 93(defun window-current-scroll-bars (&optional window)
94 "Return the current scroll-bar settings in window WINDOW. 94 "Return the current scroll-bar settings in window WINDOW.
95Value is a cons (VERTICAL . HORISONTAL) where VERTICAL specifies the 95Value is a cons (VERTICAL . HORIZONTAL) where VERTICAL specifies the
96current location of the vertical scroll-bars (left, right, or nil), 96current location of the vertical scroll-bars (left, right, or nil),
97and HORISONTAL specifies the current location of the horisontal scroll 97and HORIZONTAL specifies the current location of the horizontal scroll
98bars (top, bottom, or nil)." 98bars (top, bottom, or nil)."
99 (let ((vert (nth 2 (window-scroll-bars window))) 99 (let ((vert (nth 2 (window-scroll-bars window)))
100 (hor nil)) 100 (hor nil))
@@ -542,7 +542,7 @@ If WINDOW is omitted or nil, it defaults to the selected window.
542Do not shrink to less than `window-min-height' lines. 542Do not shrink to less than `window-min-height' lines.
543Do nothing if the buffer contains more lines than the present window height, 543Do nothing if the buffer contains more lines than the present window height,
544or if some of the window's contents are scrolled out of view, 544or if some of the window's contents are scrolled out of view,
545or if shrinking this window would also shrink another window. 545or if shrinking this window would also shrink another window,
546or if the window is the only window of its frame." 546or if the window is the only window of its frame."
547 (interactive) 547 (interactive)
548 (when (null window) 548 (when (null window)
diff --git a/lisp/woman.el b/lisp/woman.el
index 4d92c9ee0c7..de7d557f856 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -823,13 +823,13 @@ Set this variable to 7 to emulate GNU man formatting."
823 823
824(defcustom woman-bold-headings t 824(defcustom woman-bold-headings t
825 "*If non-nil then embolden section and subsection headings. Default is t. 825 "*If non-nil then embolden section and subsection headings. Default is t.
826Heading emboldening is NOT standard `man' behaviour." 826Heading emboldening is NOT standard `man' behavior."
827 :type 'boolean 827 :type 'boolean
828 :group 'woman-formatting) 828 :group 'woman-formatting)
829 829
830(defcustom woman-ignore t 830(defcustom woman-ignore t
831 "*If non-nil then unrecognised requests etc. are ignored. Default is t. 831 "*If non-nil then unrecognised requests etc. are ignored. Default is t.
832This gives the standard ?roff behaviour. If nil then they are left in 832This gives the standard ?roff behavior. If nil then they are left in
833the buffer, which may aid debugging." 833the buffer, which may aid debugging."
834 :type 'boolean 834 :type 'boolean
835 :group 'woman-formatting) 835 :group 'woman-formatting)
@@ -875,49 +875,56 @@ or different fonts."
875;; This is overkill! Troff uses just italic; Nroff uses just underline. 875;; This is overkill! Troff uses just italic; Nroff uses just underline.
876;; You should probably select either italic or underline as you prefer, but 876;; You should probably select either italic or underline as you prefer, but
877;; not both, although italic and underline work together perfectly well! 877;; not both, although italic and underline work together perfectly well!
878(defface woman-italic-face 878(defface woman-italic
879 `((((min-colors 88) (background light)) 879 `((((min-colors 88) (background light))
880 (:slant italic :underline t :foreground "red1")) 880 (:slant italic :underline t :foreground "red1"))
881 (((background light)) (:slant italic :underline t :foreground "red")) 881 (((background light)) (:slant italic :underline t :foreground "red"))
882 (((background dark)) (:slant italic :underline t))) 882 (((background dark)) (:slant italic :underline t)))
883 "Face for italic font in man pages." 883 "Face for italic font in man pages."
884 :group 'woman-faces) 884 :group 'woman-faces)
885;; backward-compatibility alias
886(put 'woman-italic-face 'face-alias 'woman-italic)
885 887
886(defface woman-bold-face 888(defface woman-bold
887 '((((min-colors 88) (background light)) (:weight bold :foreground "blue1")) 889 '((((min-colors 88) (background light)) (:weight bold :foreground "blue1"))
888 (((background light)) (:weight bold :foreground "blue")) 890 (((background light)) (:weight bold :foreground "blue"))
889 (((background dark)) (:weight bold :foreground "green2"))) 891 (((background dark)) (:weight bold :foreground "green2")))
890 "Face for bold font in man pages." 892 "Face for bold font in man pages."
891 :group 'woman-faces) 893 :group 'woman-faces)
894;; backward-compatibility alias
895(put 'woman-bold-face 'face-alias 'woman-bold)
892 896
893;; Brown is a good compromise: it is distinguishable from the default 897;; Brown is a good compromise: it is distinguishable from the default
894;; but not enough so to make font errors look terrible. (Files that use 898;; but not enough so to make font errors look terrible. (Files that use
895;; non-standard fonts seem to do so badly or in idiosyncratic ways!) 899;; non-standard fonts seem to do so badly or in idiosyncratic ways!)
896(defface woman-unknown-face 900(defface woman-unknown
897 '((((background light)) (:foreground "brown")) 901 '((((background light)) (:foreground "brown"))
898 (((min-colors 88) (background dark)) (:foreground "cyan1")) 902 (((min-colors 88) (background dark)) (:foreground "cyan1"))
899 (((background dark)) (:foreground "cyan"))) 903 (((background dark)) (:foreground "cyan")))
900 "Face for all unknown fonts in man pages." 904 "Face for all unknown fonts in man pages."
901 :group 'woman-faces) 905 :group 'woman-faces)
906;; backward-compatibility alias
907(put 'woman-unknown-face 'face-alias 'woman-unknown)
902 908
903(defface woman-addition-face 909(defface woman-addition
904 '((t (:foreground "orange"))) 910 '((t (:foreground "orange")))
905 "Face for all WoMan additions to man pages." 911 "Face for all WoMan additions to man pages."
906 :group 'woman-faces) 912 :group 'woman-faces)
913;; backward-compatibility alias
914(put 'woman-addition-face 'face-alias 'woman-addition)
907 915
908(defun woman-default-faces () 916(defun woman-default-faces ()
909 "Set foreground colours of italic and bold faces to their default values." 917 "Set foreground colors of italic and bold faces to their default values."
910 (interactive) 918 (interactive)
911 (face-spec-set 'woman-italic-face 919 (face-spec-set 'woman-italic (face-user-default-spec 'woman-italic))
912 (face-user-default-spec 'woman-italic-face)) 920 (face-spec-set 'woman-bold (face-user-default-spec 'woman-bold)))
913 (face-spec-set 'woman-bold-face (face-user-default-spec 'woman-bold-face)))
914 921
915(defun woman-monochrome-faces () 922(defun woman-monochrome-faces ()
916 "Set foreground colours of italic and bold faces to that of the default face. 923 "Set foreground colors of italic and bold faces to that of the default face.
917This is usually either black or white." 924This is usually either black or white."
918 (interactive) 925 (interactive)
919 (set-face-foreground 'woman-italic-face 'unspecified) 926 (set-face-foreground 'woman-italic 'unspecified)
920 (set-face-foreground 'woman-bold-face 'unspecified)) 927 (set-face-foreground 'woman-bold 'unspecified))
921 928
922;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 929;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
923;; Experimental font support, initially only for MS-Windows. 930;; Experimental font support, initially only for MS-Windows.
@@ -938,7 +945,7 @@ This is usually either black or white."
938 symbol-fonts)) 945 symbol-fonts))
939 946
940(when woman-font-support 947(when woman-font-support
941 (make-face 'woman-symbol-face) 948 (make-face 'woman-symbol)
942 949
943 ;; Set the symbol font only if `woman-use-symbol-font' is true, to 950 ;; Set the symbol font only if `woman-use-symbol-font' is true, to
944 ;; avoid unnecessarily upsetting the line spacing in NTEmacs 20.5! 951 ;; avoid unnecessarily upsetting the line spacing in NTEmacs 20.5!
@@ -1028,18 +1035,6 @@ Set by `.ns' request; reset by any output or `.rs' request")
1028 "Set `woman-nospace' to nil." 1035 "Set `woman-nospace' to nil."
1029 (setq woman-nospace nil)) 1036 (setq woman-nospace nil))
1030 1037
1031(defconst woman-mode-line-format
1032 ;; This is essentially the Man-mode format with page numbers removed
1033 ;; and line numbers added. (Online documents do not have pages, but
1034 ;; they do have lines!)
1035 '("-" mode-line-mule-info mode-line-modified
1036 mode-line-frame-identification mode-line-buffer-identification
1037 " " global-mode-string
1038 " %[(WoMan" mode-line-process minor-mode-alist ")%]--"
1039 (line-number-mode "L%l--")
1040 (-3 . "%p") "-%-")
1041 "Mode line format for WoMan buffer.")
1042
1043(defconst woman-request-regexp "^[.'][ \t]*\\(\\S +\\) *" 1038(defconst woman-request-regexp "^[.'][ \t]*\\(\\S +\\) *"
1044 ;; Was "^\\.[ \t]*\\([a-z0-9]+\\) *" but cvs.1 uses a macro named 1039 ;; Was "^\\.[ \t]*\\([a-z0-9]+\\) *" but cvs.1 uses a macro named
1045 ;; "`" and CGI.man uses a macro named "''"! 1040 ;; "`" and CGI.man uses a macro named "''"!
@@ -1673,24 +1668,24 @@ Do not call directly!"
1673 (goto-char (point-min)) 1668 (goto-char (point-min))
1674 (while (search-forward "__\b\b" nil t) 1669 (while (search-forward "__\b\b" nil t)
1675 (backward-delete-char 4) 1670 (backward-delete-char 4)
1676 (woman-set-face (point) (1+ (point)) 'woman-italic-face)) 1671 (woman-set-face (point) (1+ (point)) 'woman-italic))
1677 (goto-char (point-min)) 1672 (goto-char (point-min))
1678 (while (search-forward "\b\b__" nil t) 1673 (while (search-forward "\b\b__" nil t)
1679 (backward-delete-char 4) 1674 (backward-delete-char 4)
1680 (woman-set-face (1- (point)) (point) 'woman-italic-face)))) 1675 (woman-set-face (1- (point)) (point) 'woman-italic))))
1681 1676
1682 ;; Interpret overprinting to indicate bold face: 1677 ;; Interpret overprinting to indicate bold face:
1683 (goto-char (point-min)) 1678 (goto-char (point-min))
1684 (while (re-search-forward "\\(.\\)\\(\\(+\\1\\)+\\)" nil t) 1679 (while (re-search-forward "\\(.\\)\\(\\(+\\1\\)+\\)" nil t)
1685 (woman-delete-match 2) 1680 (woman-delete-match 2)
1686 (woman-set-face (1- (point)) (point) 'woman-bold-face)) 1681 (woman-set-face (1- (point)) (point) 'woman-bold))
1687 1682
1688 ;; Interpret underlining to indicate italic face: 1683 ;; Interpret underlining to indicate italic face:
1689 ;; (Must be AFTER emboldening to interpret bold _ correctly!) 1684 ;; (Must be AFTER emboldening to interpret bold _ correctly!)
1690 (goto-char (point-min)) 1685 (goto-char (point-min))
1691 (while (search-forward "_" nil t) 1686 (while (search-forward "_" nil t)
1692 (delete-char -2) 1687 (delete-char -2)
1693 (woman-set-face (point) (1+ (point)) 'woman-italic-face)) 1688 (woman-set-face (point) (1+ (point)) 'woman-italic))
1694 1689
1695 ;; Leave any other uninterpreted ^H's in the buffer for now! (They 1690 ;; Leave any other uninterpreted ^H's in the buffer for now! (They
1696 ;; might indicate composite special characters, which could be 1691 ;; might indicate composite special characters, which could be
@@ -1703,7 +1698,7 @@ Do not call directly!"
1703 (goto-char (point-min)) 1698 (goto-char (point-min))
1704 (forward-line) 1699 (forward-line)
1705 (while (re-search-forward "^\\( \\)?\\([A-Z].*\\)" nil t) 1700 (while (re-search-forward "^\\( \\)?\\([A-Z].*\\)" nil t)
1706 (woman-set-face (match-beginning 2) (match-end 2) 'woman-bold-face)))) 1701 (woman-set-face (match-beginning 2) (match-end 2) 'woman-bold))))
1707 ) 1702 )
1708 1703
1709(defun woman-insert-file-contents (filename compressed) 1704(defun woman-insert-file-contents (filename compressed)
@@ -1738,15 +1733,10 @@ Leave point at end of new text. Return length of inserted text."
1738 1733
1739(defvar woman-mode-map nil "Keymap for woman mode.") 1734(defvar woman-mode-map nil "Keymap for woman mode.")
1740 1735
1741(if woman-mode-map 1736(unless woman-mode-map
1742 () 1737 (setq woman-mode-map (make-sparse-keymap))
1743 ;; Set up the keymap, mostly inherited from Man-mode-map. Normally
1744 ;; button-buffer-map is used as a parent keymap, but we can't have two
1745 ;; parents, so we just copy it.
1746 (setq woman-mode-map (copy-keymap button-buffer-map))
1747 (set-keymap-parent woman-mode-map Man-mode-map) 1738 (set-keymap-parent woman-mode-map Man-mode-map)
1748 ;; Above two lines were 1739
1749 ;; (setq woman-mode-map (cons 'keymap Man-mode-map))
1750 (define-key woman-mode-map "R" 'woman-reformat-last-file) 1740 (define-key woman-mode-map "R" 'woman-reformat-last-file)
1751 (define-key woman-mode-map "w" 'woman) 1741 (define-key woman-mode-map "w" 'woman)
1752 (define-key woman-mode-map "\en" 'WoMan-next-manpage) 1742 (define-key woman-mode-map "\en" 'WoMan-next-manpage)
@@ -1834,6 +1824,8 @@ Argument EVENT is the invoking mouse event."
1834 (setq woman-emulation value) 1824 (setq woman-emulation value)
1835 (woman-reformat-last-file)) 1825 (woman-reformat-last-file))
1836 1826
1827(put 'woman-mode 'mode-class 'special)
1828
1837(defun woman-mode () 1829(defun woman-mode ()
1838 "Turn on (most of) Man mode to browse a buffer formatted by WoMan. 1830 "Turn on (most of) Man mode to browse a buffer formatted by WoMan.
1839WoMan is an ELisp emulation of much of the functionality of the Emacs 1831WoMan is an ELisp emulation of much of the functionality of the Emacs
@@ -1851,34 +1843,33 @@ See `Man-mode' for additional details."
1851 (fset 'Man-unindent 'ignore) 1843 (fset 'Man-unindent 'ignore)
1852 (fset 'Man-goto-page 'ignore) 1844 (fset 'Man-goto-page 'ignore)
1853 (unwind-protect 1845 (unwind-protect
1854 (progn 1846 (delay-mode-hooks (Man-mode))
1855 (set (make-local-variable 'Man-mode-map) woman-mode-map)
1856 ;; Install Man mode:
1857 (Man-mode)
1858 ;; Reset inappropriate definitions:
1859 (setq mode-line-format woman-mode-line-format)
1860 (put 'Man-mode 'mode-class 'special))
1861 ;; Restore the status quo: 1847 ;; Restore the status quo:
1862 (fset 'Man-build-page-list Man-build-page-list) 1848 (fset 'Man-build-page-list Man-build-page-list)
1863 (fset 'Man-strip-page-headers Man-strip-page-headers) 1849 (fset 'Man-strip-page-headers Man-strip-page-headers)
1864 (fset 'Man-unindent Man-unindent) 1850 (fset 'Man-unindent Man-unindent)
1865 (fset 'Man-goto-page Man-goto-page) 1851 (fset 'Man-goto-page Man-goto-page)))
1866 ) 1852 (setq major-mode 'woman-mode
1867 ;; Imenu support: 1853 mode-name "WoMan")
1868 (set (make-local-variable 'imenu-generic-expression) 1854 ;; Don't show page numbers like Man-mode does. (Online documents do
1869 ;; `make-local-variable' in case imenu not yet loaded! 1855 ;; not have pages)
1870 woman-imenu-generic-expression) 1856 (kill-local-variable 'mode-line-buffer-identification)
1871 (set (make-local-variable 'imenu-space-replacement) " ") 1857 (use-local-map woman-mode-map)
1872 ;; For reformat ... 1858 ;; Imenu support:
1873 ;; necessary when reformatting a file in its old buffer: 1859 (set (make-local-variable 'imenu-generic-expression)
1874 (setq imenu--last-menubar-index-alist nil) 1860 ;; `make-local-variable' in case imenu not yet loaded!
1875 ;; necessary to avoid re-installing the same imenu: 1861 woman-imenu-generic-expression)
1876 (setq woman-imenu-done nil) 1862 (set (make-local-variable 'imenu-space-replacement) " ")
1877 (if woman-imenu (woman-imenu)) 1863 ;; For reformat ...
1878 (setq buffer-read-only nil) 1864 ;; necessary when reformatting a file in its old buffer:
1879 (Man-highlight-references) 1865 (setq imenu--last-menubar-index-alist nil)
1880 (setq buffer-read-only t) 1866 ;; necessary to avoid re-installing the same imenu:
1881 (set-buffer-modified-p nil))) 1867 (setq woman-imenu-done nil)
1868 (if woman-imenu (woman-imenu))
1869 (let (buffer-read-only)
1870 (Man-highlight-references))
1871 (set-buffer-modified-p nil)
1872 (run-mode-hooks 'woman-mode-hook))
1882 1873
1883(defun woman-imenu (&optional redraw) 1874(defun woman-imenu (&optional redraw)
1884 "Add a \"Contents\" menu to the menubar. 1875 "Add a \"Contents\" menu to the menubar.
@@ -1955,7 +1946,7 @@ Optional argument REDRAW, if non-nil, forces mode line to be updated."
1955 (around Man-getpage-in-background-advice (topic) activate) 1946 (around Man-getpage-in-background-advice (topic) activate)
1956 "Use WoMan unless invoked outside a WoMan buffer or invoked explicitly. 1947 "Use WoMan unless invoked outside a WoMan buffer or invoked explicitly.
1957Otherwise use Man and record start of formatting time." 1948Otherwise use Man and record start of formatting time."
1958 (if (and (eq mode-line-format woman-mode-line-format) 1949 (if (and (eq major-mode 'woman-mode)
1959 (not (eq (caar command-history) 'man))) 1950 (not (eq (caar command-history) 'man)))
1960 (WoMan-getpage-in-background topic) 1951 (WoMan-getpage-in-background topic)
1961 ;; Initiates man processing 1952 ;; Initiates man processing
@@ -2204,11 +2195,11 @@ Currently set only from '\" t in the first line of the source file.")
2204 2195
2205 ;; Prepare non-underlined versions of underlined faces: 2196 ;; Prepare non-underlined versions of underlined faces:
2206 (woman-non-underline-faces) 2197 (woman-non-underline-faces)
2207 ;; Set font of `woman-symbol-face' to `woman-symbol-font' if 2198 ;; Set font of `woman-symbol' face to `woman-symbol-font' if
2208 ;; `woman-symbol-font' is well defined. 2199 ;; `woman-symbol-font' is well defined.
2209 (and woman-use-symbol-font 2200 (and woman-use-symbol-font
2210 (stringp woman-symbol-font) 2201 (stringp woman-symbol-font)
2211 (set-face-font 'woman-symbol-face woman-symbol-font 2202 (set-face-font 'woman-symbol woman-symbol-font
2212 (and (frame-live-p woman-frame) woman-frame))) 2203 (and (frame-live-p woman-frame) woman-frame)))
2213 2204
2214 ;; Set syntax and display tables: 2205 ;; Set syntax and display tables:
@@ -2293,8 +2284,7 @@ Currently set only from '\" t in the first line of the source file.")
2293 "^" "_"))) 2284 "^" "_")))
2294 (cond (first 2285 (cond (first
2295 (replace-match repl nil t) 2286 (replace-match repl nil t)
2296 (put-text-property (1- (point)) (point) 2287 (put-text-property (1- (point)) (point) 'face 'woman-addition)
2297 'face 'woman-addition-face)
2298 (WoMan-warn 2288 (WoMan-warn
2299 "Initial vertical motion escape \\%s simulated" esc) 2289 "Initial vertical motion escape \\%s simulated" esc)
2300 (WoMan-log 2290 (WoMan-log
@@ -2919,8 +2909,7 @@ map accessory to help construct this alist.")
2919Set NEWTEXT in face FACE if specified." 2909Set NEWTEXT in face FACE if specified."
2920 (woman-delete-match 0) 2910 (woman-delete-match 0)
2921 (insert-before-markers newtext) 2911 (insert-before-markers newtext)
2922 (if face (put-text-property (1- (point)) (point) 2912 (if face (put-text-property (1- (point)) (point) 'face 'woman-symbol))
2923 'face 'woman-symbol-face))
2924 t) 2913 t)
2925 2914
2926(defun woman-special-characters (to) 2915(defun woman-special-characters (to)
@@ -2938,7 +2927,7 @@ Set NEWTEXT in face FACE if specified."
2938 ;; Need symbol font: 2927 ;; Need symbol font:
2939 (if woman-use-symbol-font 2928 (if woman-use-symbol-font
2940 (woman-replace-match (nth 2 replacement) 2929 (woman-replace-match (nth 2 replacement)
2941 'woman-symbol-face)) 2930 'woman-symbol))
2942 ;; Need extended font: 2931 ;; Need extended font:
2943 (if woman-use-extended-font 2932 (if woman-use-extended-font
2944 (woman-replace-match (nth 2 replacement)))))) 2933 (woman-replace-match (nth 2 replacement))))))
@@ -2963,7 +2952,7 @@ Useful for constructing the alist variable `woman-special-characters'."
2963 (while (< i 256) 2952 (while (< i 256)
2964 (insert (format "\\%03o " i) (string i) " " (string i)) 2953 (insert (format "\\%03o " i) (string i) " " (string i))
2965 (put-text-property (1- (point)) (point) 2954 (put-text-property (1- (point)) (point)
2966 'face 'woman-symbol-face) 2955 'face 'woman-symbol)
2967 (insert " ") 2956 (insert " ")
2968 (setq i (1+ i)) 2957 (setq i (1+ i))
2969 (when (= i 128) (setq i 160) (insert "\n")) 2958 (when (= i 128) (setq i 160) (insert "\n"))
@@ -3231,12 +3220,12 @@ If optional arg CONCAT is non-nil then join arguments."
3231 3220
3232(defconst woman-font-alist 3221(defconst woman-font-alist
3233 '(("R" . default) 3222 '(("R" . default)
3234 ("I" . woman-italic-face) 3223 ("I" . woman-italic)
3235 ("B" . woman-bold-face) 3224 ("B" . woman-bold)
3236 ("P" . previous) 3225 ("P" . previous)
3237 ("1" . default) 3226 ("1" . default)
3238 ("2" . woman-italic-face) 3227 ("2" . woman-italic)
3239 ("3" . woman-bold-face) ; used in bash.1 3228 ("3" . woman-bold) ; used in bash.1
3240 ) 3229 )
3241 "Alist of ?roff font indicators and woman font variables and names.") 3230 "Alist of ?roff font indicators and woman font variables and names.")
3242 3231
@@ -3284,9 +3273,9 @@ If optional arg CONCAT is non-nil then join arguments."
3284 (WoMan-warn "Unknown font %s." fontstring) 3273 (WoMan-warn "Unknown font %s." fontstring)
3285 ;; Output this message once only per call ... 3274 ;; Output this message once only per call ...
3286 (setq font-alist 3275 (setq font-alist
3287 (cons (cons fontstring 'woman-unknown-face) 3276 (cons (cons fontstring 'woman-unknown)
3288 font-alist)) 3277 font-alist))
3289 'woman-unknown-face) 3278 'woman-unknown)
3290 ))) 3279 )))
3291 ;; Delete font control line or escape sequence: 3280 ;; Delete font control line or escape sequence:
3292 (cond (beg (delete-region beg (point)) 3281 (cond (beg (delete-region beg (point))
@@ -3747,7 +3736,7 @@ v alters page foot left; m alters page head center.
3747 )) 3736 ))
3748 ;; Embolden heading (point is at end of heading): 3737 ;; Embolden heading (point is at end of heading):
3749 (woman-set-face 3738 (woman-set-face
3750 (save-excursion (beginning-of-line) (point)) (point) 'woman-bold-face) 3739 (save-excursion (beginning-of-line) (point)) (point) 'woman-bold)
3751 (forward-line) 3740 (forward-line)
3752 (delete-blank-lines) 3741 (delete-blank-lines)
3753 (setq woman-left-margin woman-default-indent) 3742 (setq woman-left-margin woman-default-indent)
@@ -3767,7 +3756,7 @@ Format paragraphs upto TO. Set prevailing indent to 5."
3767 ;; Optionally embolden heading (point is at beginning of heading): 3756 ;; Optionally embolden heading (point is at beginning of heading):
3768 (if woman-bold-headings 3757 (if woman-bold-headings
3769 (woman-set-face 3758 (woman-set-face
3770 (point) (save-excursion (end-of-line) (point)) 'woman-bold-face)) 3759 (point) (save-excursion (end-of-line) (point)) 'woman-bold))
3771 (forward-line) 3760 (forward-line)
3772 (setq woman-left-margin woman-default-indent 3761 (setq woman-left-margin woman-default-indent
3773 woman-nofill nil) ; fill output lines 3762 woman-nofill nil) ; fill output lines
diff --git a/lisp/xml.el b/lisp/xml.el
index f9527a276b1..f4300817836 100644
--- a/lisp/xml.el
+++ b/lisp/xml.el
@@ -211,6 +211,35 @@ If PARSE-NS is non-nil, then QNAMES are expanded."
211 (defvar xml-pe-reference-re (concat "%" xml-name-re ";")) 211 (defvar xml-pe-reference-re (concat "%" xml-name-re ";"))
212;;[67] Reference ::= EntityRef | CharRef 212;;[67] Reference ::= EntityRef | CharRef
213 (defvar xml-reference-re (concat "\\(?:" xml-entity-ref "\\|" xml-char-ref-re "\\)")) 213 (defvar xml-reference-re (concat "\\(?:" xml-entity-ref "\\|" xml-char-ref-re "\\)"))
214;;[10] AttValue ::= '"' ([^<&"] | Reference)* '"' | "'" ([^<&'] | Reference)* "'"
215 (defvar xml-att-value-re (concat "\\(?:\"\\(?:[^&\"]\\|" xml-reference-re "\\)*\"\\|"
216 "'\\(?:[^&']\\|" xml-reference-re "\\)*'\\)"))
217;;[56] TokenizedType ::= 'ID' [VC: ID] [VC: One ID per Element Type] [VC: ID Attribute Default]
218;; | 'IDREF' [VC: IDREF]
219;; | 'IDREFS' [VC: IDREF]
220;; | 'ENTITY' [VC: Entity Name]
221;; | 'ENTITIES' [VC: Entity Name]
222;; | 'NMTOKEN' [VC: Name Token]
223;; | 'NMTOKENS' [VC: Name Token]
224 (defvar xml-tokenized-type-re "\\(?:ID\\|IDREF\\|IDREFS\\|ENTITY\\|ENTITIES\\|NMTOKEN\\|NMTOKENS\\)")
225;;[58] NotationType ::= 'NOTATION' S '(' S? Name (S? '|' S? Name)* S? ')'
226 (defvar xml-notation-type-re (concat "\\(?:NOTATION" whitespace "(" whitespace "*" xml-name-re
227 "\\(?:" whitespace "*|" whitespace "*" xml-name-re "\\)*" whitespace "*)\\)"))
228;;[59] Enumeration ::= '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')' [VC: Enumeration] [VC: No Duplicate Tokens]
229 (defvar xml-enumeration-re (concat "\\(?:(" whitespace "*" xml-nmtoken-re
230 "\\(?:" whitespace "*|" whitespace "*" xml-nmtoken-re "\\)*"
231 whitespace ")\\)"))
232;;[57] EnumeratedType ::= NotationType | Enumeration
233 (defvar xml-enumerated-type-re (concat "\\(?:" xml-notation-type-re "\\|" xml-enumeration-re "\\)"))
234;;[54] AttType ::= StringType | TokenizedType | EnumeratedType
235;;[55] StringType ::= 'CDATA'
236 (defvar xml-att-type-re (concat "\\(?:CDATA\\|" xml-tokenized-type-re "\\|" xml-notation-type-re"\\|" xml-enumerated-type-re "\\)"))
237;;[60] DefaultDecl ::= '#REQUIRED' | '#IMPLIED' | (('#FIXED' S)? AttValue)
238 (defvar xml-default-decl-re (concat "\\(?:#REQUIRED\\|#IMPLIED\\|\\(?:#FIXED" whitespace "\\)*" xml-att-value-re "\\)"))
239;;[53] AttDef ::= S Name S AttType S DefaultDecl
240 (defvar xml-att-def-re (concat "\\(?:" whitespace "*" xml-name-re
241 whitespace "*" xml-att-type-re
242 whitespace "*" xml-default-decl-re "\\)"))
214;;[9] EntityValue ::= '"' ([^%&"] | PEReference | Reference)* '"' 243;;[9] EntityValue ::= '"' ([^%&"] | PEReference | Reference)* '"'
215;; | "'" ([^%&'] | PEReference | Reference)* "'" 244;; | "'" ([^%&'] | PEReference | Reference)* "'"
216 (defvar xml-entity-value-re (concat "\\(?:\"\\(?:[^%&\"]\\|" xml-pe-reference-re 245 (defvar xml-entity-value-re (concat "\\(?:\"\\(?:[^%&\"]\\|" xml-pe-reference-re
@@ -580,7 +609,7 @@ This follows the rule [28] in the XML specifications."
580 (error "XML: Bad DTD") 609 (error "XML: Bad DTD")
581 (forward-char) 610 (forward-char)
582 ;; Parse the rest of the DTD 611 ;; Parse the rest of the DTD
583 ;; Fixme: Deal with ATTLIST, NOTATION, PIs. 612 ;; Fixme: Deal with NOTATION, PIs.
584 (while (not (looking-at "\\s-*\\]")) 613 (while (not (looking-at "\\s-*\\]"))
585 (skip-syntax-forward " ") 614 (skip-syntax-forward " ")
586 (cond 615 (cond
@@ -616,16 +645,24 @@ This follows the rule [28] in the XML specifications."
616 ;; Store the element in the DTD 645 ;; Store the element in the DTD
617 (push (list element type) dtd) 646 (push (list element type) dtd)
618 (goto-char end-pos)) 647 (goto-char end-pos))
648
649 ;; Translation of rule [52] of XML specifications
650 ((looking-at (concat "<!ATTLIST[ \t\n\r]*\\(" xml-name-re
651 "\\)[ \t\n\r]*\\(" xml-att-def-re
652 "\\)*[ \t\n\r]*>"))
653
654 ;; We don't do anything with ATTLIST currently
655 (goto-char (match-end 0)))
656
619 ((looking-at "<!--") 657 ((looking-at "<!--")
620 (search-forward "-->")) 658 (search-forward "-->"))
621 ((looking-at (concat "<!ENTITY[ \t\n\r]*\\(" xml-name-re 659 ((looking-at (concat "<!ENTITY[ \t\n\r]*\\(" xml-name-re
622 "\\)[ \t\n\r]*\\(" xml-entity-value-re 660 "\\)[ \t\n\r]*\\(" xml-entity-value-re
623 "\\)[ \t\n\r]*>")) 661 "\\)[ \t\n\r]*>"))
624 (let ((name (buffer-substring (nth 2 (match-data)) 662 (let ((name (match-string 1))
625 (nth 3 (match-data)))) 663 (value (substring (match-string 2) 1
626 (value (buffer-substring (+ (nth 4 (match-data)) 1) 664 (- (length (match-string 2)) 1))))
627 (- (nth 5 (match-data)) 1)))) 665 (goto-char (match-end 0))
628 (goto-char (nth 1 (match-data)))
629 (setq xml-entity-alist 666 (setq xml-entity-alist
630 (append xml-entity-alist 667 (append xml-entity-alist
631 (list (cons name 668 (list (cons name
@@ -644,11 +681,10 @@ This follows the rule [28] in the XML specifications."
644 "\\|'[- \r\na-zA-Z0-9()+,./:=?;!*#@$_%]*'" 681 "\\|'[- \r\na-zA-Z0-9()+,./:=?;!*#@$_%]*'"
645 "[ \t\n\r]+\\(\"[^\"]*\"\\|'[^']*'\\)" 682 "[ \t\n\r]+\\(\"[^\"]*\"\\|'[^']*'\\)"
646 "[ \t\n\r]*>"))) 683 "[ \t\n\r]*>")))
647 (let ((name (buffer-substring (nth 2 (match-data)) 684 (let ((name (match-string 1))
648 (nth 3 (match-data)))) 685 (file (substring (match-string 2) 1
649 (file (buffer-substring (+ (nth 4 (match-data)) 1) 686 (- (length (match-string 2)) 1))))
650 (- (nth 5 (match-data)) 1)))) 687 (goto-char (match-end 0))
651 (goto-char (nth 1 (match-data)))
652 (setq xml-entity-alist 688 (setq xml-entity-alist
653 (append xml-entity-alist 689 (append xml-entity-alist
654 (list (cons name (with-temp-buffer 690 (list (cons name (with-temp-buffer
@@ -677,7 +713,7 @@ This follows the rule [28] in the XML specifications."
677 (when xml-validating-parser 713 (when xml-validating-parser
678 (error "XML: (Validity) Invalid DTD item")))))) 714 (error "XML: (Validity) Invalid DTD item"))))))
679 (if (looking-at "\\s-*]>") 715 (if (looking-at "\\s-*]>")
680 (goto-char (nth 1 (match-data))))) 716 (goto-char (match-end 0))))
681 (nreverse dtd))) 717 (nreverse dtd)))
682 718
683(defun xml-parse-elem-type (string) 719(defun xml-parse-elem-type (string)